FreeImage library
lazarus / 39-Graphics

----------------------------------------------------------------------
phoenix27 · 2023-08-11 14:21

In my app i draw images on a TPanel in the paint event. This is the
relevant code:
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i function
PFBitmap2TBitmap(var pbmp: PFIBITMAP): TBitmap;var  i:integer; 
src:^byte;  dst:^byte;  w,h:cardinal;  sz:cardinal; begin   // 
 h:=FreeImage_GetHeight(pbmp);   w:=FreeImage_GetWidth(pbmp);   sz:=
FreeImage_GetPitch(pbmp);//  w *  FreeImage_GetBPP(pbmp);   result :=
TBitmap.Create;   result.SetSize(w,h);   for i := 0 to h - 1 do begin 
    Src := FreeImage_GetScanLine(pbmp, i);      Dst :=
(result.ScanLine[h-i-1]);      move(Src^, Dst^, sz); 
 end; end;procedure renderBricksExec(var trec:TMThreadRec;
tr:TMThread);var   i:integer;   mi:MediaItem; 
 fif:FREE_IMAGE_FORMAT;   pfbmp, pfbmp1:PFIBITMAP;   bmp:TBitmap; 
 mitems:ArrayOfMediaItems;begin    mitems:=
ArrayOfMediaItems(trec.pData^);    for i:=trec.fstart to trec.fend do
begin       mi := mitems[i];       if mi = nil then continue;     
 fif := FreeImage_GetFileType(PChar(mi.thumbAbsPath));     
 pfbmp:=FreeImage_Load(fif, PChar(mi.thumbAbsPath), JPEG_FAST);     
 if pfbmp <> nil then begin          pfbmp1:= FreeImage_Rescale(pfbmp,
mi.width, mi.Height, FILTER_BOX);            try             bmp :=
PFBitmap2TBitmap(pfbmp1);              mi.bmp := bmp;             if
mi.favourite then               drawFavIco(bmp);             if
trec.mtype=video then                  drawDurLabel(VideoItem(mi),
bmp);           finally             FreeImage_Unload(pfbmp);         
  FreeImage_Unload(pfbmp1);           end;       end    end;end;  In
the TPanel paint event i essntially do:
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i
canvas.Draw(mi.left, mi.top, mi.bmp); It works flawlessly. Then i
decided to try the code in Delphi. As you know, the Paint event there 
is protected so i decided to create Timage controls for every media
item and assign the bitmaps to them. This is the code:
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i function
PFBitmap2TBitmap(var pbmp: PFIBITMAP): TBitmap; var  i:integer; 
src:PByte;  dst:PByte;  w,h:cardinal;  sz:cardinal; begin 
 h:=FreeImage_GetHeight(pbmp);   w:=FreeImage_GetWidth(pbmp);   sz:=
FreeImage_GetPitch(pbmp);//  w *  FreeImage_GetBPP(pbmp);   result
:=Tbitmap.create();   result.SetSize(w,h);   for i := 0 to h - 1 do
begin      Src := FreeImage_GetScanLine(pbmp, i);      Dst :=
PByte(result.ScanLine[h-i-1]);      move(Src^, Dst^, sz); 
 end; end;function getBrickBmp(mi: TMediaItem):
TBitmap;var fif:FREE_IMAGE_FORMAT; pfbmp, pfbmp1:PFIBITMAP; begin 
 fif :=
FreeImage_GetFileType(PAnsiChar(AnsiString(mi.thumbAbsPath))); 
 pfbmp:=FreeImage_Load(fif, PAnsiChar(AnsiString(mi.thumbAbsPath)),
JPEG_FAST);   if pfbmp <> nil then begin      pfbmp1:=
FreeImage_Rescale(pfbmp, mi.width, mi.Height, FILTER_BOX);       try 
          result := PFBitmap2TBitmap(pfbmp1);         finally       
 FreeImage_Unload(pfbmp);         FreeImage_Unload(pfbmp1);     
 end;   endend;procedure TForm1.drawItems(DisplayCtrl: TWinControl;
mitems: TArrayOfMediaItems;                        scrollTop: integer
= 0);var   v: TMediaItem;   img: TImage32;   imageCtrl: TimageCtrl; 
 bottPos, i: integer;   r: TRect;   bmp: TBitmap;begin   bottPos :=
scrollTop + DisplayCtrl.ClientHeight;   for i := 0 to high(mitems) do
begin      v := mitems[i];      imageCtrl :=
TImageCtrl.Create(DisplayCtrl);      imageCtrl.Name := 'm_' +
inttostr(v.id);      imageCtrl.Parent:= DisplayCtrl;     
imageCtrl.Width := v.width;      imageCtrl.Height := v.height;     
imageCtrl.Left:= v.left;      imageCtrl.Top:= v.top;     
//imageCtrl.Visible := True;     
imageCtrl.Picture.Bitmap.SetSize(v.width, v.height);     
//imageCtrl.OnClick:= ImageCtrlClick;      imageCtrl.OnMouseEnter :=
imageCtrlOnMouseEnter;      imageCtrl.OnMouseLeave :=
imageCtrlOnMouseExit;      imageCtrl.mi:= v;     
imageCtrl.Stretch:=false;      imageCtrl.Proportional:=false;      if
(v.bottom + v.yOffset >= scrollTop) and (v.top + v.yOffset <= bottPos)
then begin          bmp := getBrickBmp(v);          try           
imageCtrl.Picture.Bitmap := bmp;            imageCtrl.loaded := true; 
        finally             bmp.Free;          end;       end; 
 end; end; But it doesn't work in Delphi. What i'm doing wrong? Maybe
the TImage doesn't work that way?

----------------------------------------------------------------------
phoenix27 · 2023-08-11 14:46

Update. I tried the same approach in Lazarus and so i created Timage
controls and assigned them the bitmaps and it worked. Why in Delphi it
doesn't? Isn't Lazarus supposes to be as close as possible to Delphi?
I mean, quite frankly Lazarus seems to be better in this respect.

----------------------------------------------------------------------
KodeZwerg · 2023-08-11 15:14

I just can guess since I do not know nothing about PFIBITMAP right
now, it is working in Lazarus since TBitmap is bugged.
Try in Delphi to set for Result a PixelFormat before playing with it.

----------------------------------------------------------------------
phoenix27 · 2023-08-11 15:38

Thank you KodeZwerg!! I added this line in the PFBitmap2TBitmap
function
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i
result.PixelFormat := TPixelFormat.pf24bit; and it works!! Thank you
again!!