Recent

Author Topic: Define a bitmap inside the code  (Read 5356 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:



type
  //Delphi < 4: TRGBquad = PACKED RECORD rgbBlue,rgbGreen,rgbRed,rgbreserved: byte; end;
  RGBQuadRA = array [1..1] of TRGBQuad;
  RGBQuadp = ^RGBQuadRA;

procedure QuickBMP32(lPGHt,lPGWid:integer; lBuff: RGBQuadp; var lImage: TImage);
var
 sbBits : PByteArray;
 lBMP: TBitmap;
begin
    lBMP := TBitmap.Create;
    lBMP.PixelFormat := pf32bit;
    lBMP.Width := lPGwid;
    lBMP.Height := lPGHt;
    sbBits := lBmp.ScanLine[lPGHt-1];
    CopyMemory(Pointer(sbBits),Pointer(lBuff),lPGWid*lPGHt * 4);
    lImage.Width := (lBmp.Width);
    lImage.Height := (lBmp.Height);
    lImage.Picture.Graphic := lBMP;
    lBMP.Free;
end; //proc QuickBMP32

procedure TForm1.SpeedButton1Click(Sender: TObject);
var
   lHt,lWid,lH,lW,lI: integer;
   lQuadP: RGBQuadp;
begin
  lHt := 255;
  lWid := 511;
  GetMem ( lQuadP ,  lHt*lWid*sizeof(TRGBquad));
  lI := 0;
  for lH := 1 to lHt do begin
   for lW := 1 to lWid do begin
      inc(lI);//indexed from zero
      lQuadP[lI].rgbRed := lW mod 256 ;
      lQuadP[lI].rgbGreen := lH mod 256 ;
      if lW < 255 then
         lQuadP[lI].rgbBlue := 0
      else
         lQuadP[lI].rgbBlue := 255;
      lQuadP[lI].rgbReserved := 255;
   end; //for lW: each column
  end; //for lH: each row
  QuickBMP32(lHt,lWid,lQuadP,Image1);
  Freemem(lQuadP);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 Form1.DoubleBuffered := true;
end;