Recent

Author Topic: Define a bitmap inside the code  (Read 6599 times)

crlab

  • Guest
Define a bitmap inside the code
« on: November 04, 2005, 02:55:43 pm »
On April 26, 2004 the user pepecito asked if it was possible to generate a bitmap within the Lazarus code. Both intfgraphics.pas and the lazintfimage example program show how to open/save/manipulate a bitmap, but do not describe how to generate a bitmap on the fly. In my case, I want to be able to create a 32-bit bitmap that will be platform independent. Can anyone explain how to do this? Below is a very simple example from Delphi. If anyone can send me a Lazarus version of QuickBMP32, I will be forever in their debt and promise to post a sample program on the web so other users can solve this....

-chris

The Delphi program below assumes a form with a TImage component named Image1 and a TSpeedbutton named Speedbutton1. Clicking on SpeedButton1 calls SpeedButton1Click. Note that with Delphi >3 you can turn on doublebuffering to eliminate flicker:


Code: Pascal  [Select][+][-]
  1. type
  2.   //Delphi < 4: TRGBquad = PACKED RECORD rgbBlue,rgbGreen,rgbRed,rgbreserved: byte; end;
  3.   RGBQuadRA = array [1..1] of TRGBQuad;
  4.   RGBQuadp = ^RGBQuadRA;
  5.  
  6. procedure QuickBMP32(lPGHt,lPGWid:integer; lBuff: RGBQuadp; var lImage: TImage);
  7. var
  8.  sbBits : PByteArray;
  9.  lBMP: TBitmap;
  10. begin
  11.          lBMP := TBitmap.Create;
  12.          lBMP.PixelFormat := pf32bit;
  13.          lBMP.Width := lPGwid;
  14.          lBMP.Height := lPGHt;
  15.          sbBits := lBmp.ScanLine[lPGHt-1];
  16.          CopyMemory(Pointer(sbBits),Pointer(lBuff),lPGWid*lPGHt * 4);
  17.          lImage.Width := (lBmp.Width);
  18.          lImage.Height := (lBmp.Height);
  19.          lImage.Picture.Graphic := lBMP;
  20.          lBMP.Free;
  21. end; //proc QuickBMP32
  22.  
  23. procedure TForm1.SpeedButton1Click(Sender: TObject);
  24. var
  25.         lHt,lWid,lH,lW,lI: integer;
  26.         lQuadP: RGBQuadp;
  27. begin
  28.   lHt := 255;
  29.   lWid := 511;
  30.   GetMem ( lQuadP ,  lHt*lWid*sizeof(TRGBquad));
  31.   lI := 0;
  32.   for lH := 1 to lHt do begin
  33.         for lW := 1 to lWid do begin
  34.                 inc(lI);//indexed from zero
  35.                 lQuadP[lI].rgbRed := lW mod 256 ;
  36.                 lQuadP[lI].rgbGreen := lH mod 256 ;
  37.                 if lW < 255 then
  38.                         lQuadP[lI].rgbBlue := 0
  39.                 else
  40.                         lQuadP[lI].rgbBlue := 255;
  41.                 lQuadP[lI].rgbReserved := 255;
  42.         end; //for lW: each column
  43.   end; //for lH: each row
  44.   QuickBMP32(lHt,lWid,lQuadP,Image1);
  45.   Freemem(lQuadP);
  46. end;
  47.  
  48. procedure TForm1.FormCreate(Sender: TObject);
  49. begin
  50.  Form1.DoubleBuffered := true;
  51. end;

[Edited to add code tags]
« Last Edit: November 17, 2021, 09:13:42 pm by trev »

 

TinyPortal © 2005-2018