xnView:GFL_SDK GFL_BITMAP을 TBitmap으로 복사

//GFL_BITMAP 정보를 TBitmap에 반영한다.
procedure TGflBitmap.SaveGflImageToBitmap(AGflImage : PGFL_BITMAP; ABitmap : TBitmap);
var
  finfo: TGFL_FILE_INFORMATION;
  lp: TGFL_LOAD_PARAMS;
  gfl_bmp : PGFL_BITMAP;
  e: GFL_ERROR;
  filename: string;
  bmp: TBitmap;
  x, y, k: Integer;
  LineSrc: Pointer;
  LineDest: Pointer;
  LineIn: PLine1;
  LineOut: PByteArray;
  Mask1: Byte;
  Mask: Byte;
  pal: PLogPalette;
  i, bpp: Integer;
  Arect: TRect;
begin
  gfl_bmp := AGflImage;
  gflEnableLZW(GFL_TRUE);

  pal := nil;
  //bpp := finfo.BitsPerPlane * finfo.NumberOfPlanes;
  if (gfl_bmp.Btype = GFL_BINARY) then begin
    bpp := 1;
  end else begin
    bpp := gfl_bmp.BytesPerPixel * 8;
  end;

  if not (bpp in [1, 4, 8, 24, 32]) then begin
    GFL_LastErrorMsg := 'Only 1, 4, 8, 24 or 32 BitsPerPixel are supported in this Library(function:SaveToGflImageToBitmap)!';
    gflFreeBitmap(gfl_bmp);
    exit;
  end;

  // Create Delphi Bitmap. If paletted, minimize memory by setting size after pixel format
  bmp := TBitmap.Create;
  try
    bmp.PixelFormat := IntToPixelFormat(bpp);
    bmp.Width := gfl_bmp.Width;
    bmp.Height := gfl_bmp.Height;
    NewPalette := 0;
    //-------------------------------------
    //Fixed. I. Scollar al001@mail1.rrz.uni-koeln.de 6.3.2002


    case bmp.PixelFormat of

      //-------------------
      pf1bit:
        begin
          try
            //pf1bit has a bug. It's palette has only zero entries
            GetMem(pal, sizeof(TLogPalette) + sizeof(TPaletteEntry) * 256);
            pal.palVersion := $300;
            pal.palNumEntries := 2;
            for i := 0 to 1 do with pal.palPalEntry[i] do begin
              peRed := i * 255;  peGreen := i * 255;  peBlue := i * 255;
              peFlags := PC_NOCOLLAPSE;
            end;
            if (NewPalette <> 0) then
              DeleteObject(NewPalette);
            NewPalette := CreatePalette(pal^);
          finally
            FreeMem(pal);
          end;
          DeleteObject(bmp.ReleasePalette);
          bmp.Palette := NewPalette;

          //set canvas to white, since positive image usually wanted
          ARect := Bounds(0, 0, bmp.Width, bmp.Height);
          bmp.canvas.Brush.Color := clWhite;
          bmp.Canvas.FillRect(ARect);

          Mask1 := 128; //leftmost bit set

          for y := 0 to gfl_bmp.Height - 1 do begin
            move(  Pointer(Integer(gfl_bmp.data) + (y * gfl_bmp.BytesPerLine))^,
              bmp.Scanline[y]^, gfl_bmp.BytesPerLine);
          end;
          ABitmap.Assign(bmp);
        end;

      //-------------------
      pf4Bit:
        begin
          try
            GetMem(pal, sizeof(TLogPalette) + sizeof(TPaletteEntry) * 256);
            pal.palVersion := $300;
            pal.palNumEntries := 16;
            for i := 0 to 15 do with pal.palPalEntry[i] do begin
                peRed   := gfl_bmp.ColorMap^.Red[i];
                peGreen := gfl_bmp.ColorMap^.Green[i];
                peBlue  := gfl_bmp.ColorMap^.Blue[i];
                peFlags := PC_NOCOLLAPSE;
            end;
            if (NewPalette <> 0) then
              DeleteObject(NewPalette);
            NewPalette := CreatePalette(pal^);
          finally
            FreeMem(pal);
          end;
          DeleteObject(bmp.ReleasePalette);
          bmp.Palette := NewPalette;

          for y := 0 to gfl_bmp.Height - 1 do begin
            move(  Pointer(Integer(gfl_bmp.data) + (y * gfl_bmp.BytesPerLine))^,
              bmp.Scanline[y]^, gfl_bmp.BytesPerLine);
          end;
          ABitmap.Assign(bmp);
        end;

      //-------------------
      pf8Bit:
        begin
          if gfl_bmp.ColorMap <> nil then begin
            try
              GetMem(pal, sizeof(TLogPalette) + sizeof(TPaletteEntry) * 256);
              pal.palVersion := $300;
              pal.palNumEntries := 256;
              for i := 0 to 255 do with pal.palPalEntry[i] do begin
                  peRed   := gfl_bmp.ColorMap^.Red[i];
                  peGreen := gfl_bmp.ColorMap^.Green[i];
                  peBlue  := gfl_bmp.ColorMap^.Blue[i];
                  peFlags := PC_NOCOLLAPSE;
              end;
              if (NewPalette <> 0) then
                DeleteObject(NewPalette);

              NewPalette := CreatePalette(pal^);
            finally
              FreeMem(pal);
            end;
          end else begin
            //PCX bug in GflLib, pcx has no color palette, so make gray palette
            try
              GetMem(pal, sizeof(TLogPalette) + sizeof(TPaletteEntry) * 256);
              pal.palVersion := $300;
              pal.palNumEntries := 256;
              for i := 0 to 255 do begin
                pal.palPalEntry[i].peRed := i;
                pal.palPalEntry[i].peGreen := i;
                pal.palPalEntry[i].peBlue := i;
                pal.palPalEntry[i].peFlags := PC_NOCOLLAPSE;
              end;
              if (NewPalette <> 0) then
                DeleteObject(NewPalette);
              NewPalette := CreatePalette(pal^);
            finally
              FreeMem(pal);
            end;
          end;

          DeleteObject(bmp.ReleasePalette);
          bmp.Palette := NewPalette;
          // Copy Pixel Data
          for y := 0 to gfl_bmp.Height - 1 do
                     // Pointer to Scanline of TGFL_Bitmap
              move(  Pointer(Integer(gfl_bmp.data) + (y * gfl_bmp.BytesPerLine))^,
                     // Pointer to Scanline of TBitmap
                     bmp.Scanline[y]^, gfl_bmp.BytesPerLine);

          ABitmap.Assign(bmp);
        end;

      //-------------------
      // 24 + 32 Bit images
      pf24Bit, pf32Bit:
        begin
          for y := 0 to gfl_bmp.Height - 1 do begin
            // get Pointer to Scanlines
            lineSrc  := Pointer(Integer(gfl_bmp.data) + (y * gfl_bmp.BytesPerLine));
            lineDest := bmp.Scanline[y];
            // copy Pixel Data
            move(lineSrc^, lineDest^, gfl_bmp.BytesPerLine);
          end;
          ABitmap.Assign(bmp);
        end;
    end;
    // Free Resources
  finally
    bmp.Free;
  end;

  if isApplyLive then
    Apply;

end;