Changing size of bitmap graphic at run-time
lazarus / 39-Graphics

----------------------------------------------------------------------
crlab · 2006-04-14 14:14

Hello-

I have written code that automatically generates a bitmap image at
runtime. However, after I draw this image to a canvas, the canvas size
becomes fixed to the size of the pasted image. For example, in the
code below, pressing either of the 3 buttons works the first time,
creating a small (128x128), medium (256x256) or large (512x512)
bitmap. However, if you first create a smaller image, you will be
unable to see all of a larger image. Is there a way to resize the
convas's bitmap dynamically?

//the code GenerateBMP will create a bitmap image on a TImage
Component named 'Image1'
const
     PixelCountMax = 32768;
     gDown : boolean = False;
type
  TRGBquad = PACKED RECORD
           rgbRed,rgbGreen,rgbBlue,rgbreserved: byte;
           //note order of bytes is RGB for Lazarus
  end;
  pRGBQuadArray = ^TRGBQuad;
  TRGBQuadeArray = ARRAY[0..PixelCountMax-1] OF TRGBQuad;
  RGBQuadRA = array [1..1] of TRGBQuad;
  RGBQuadp = ^RGBQuadRA;
  LongIntRA = array [1..1] of LongInt;
  LongIntp = ^LongIntRA;

procedure DrawBMP( lx, ly: integer; lRGBBuff: RGBQuadp);
var
  x, y,lPos: Integer;
  Bitmap: TBitmap;
  CurColor: TFPColor;
  lLongBuff: LongIntp;
begin
  Bitmap := TBitmap.Create;
  lLongBuff := LongIntp(lRGBBuff);
  try
    Bitmap.Height := ly;
    Bitmap.Width := lx;
    lPos := 0;
    for y:=0 to ly-1 do begin
      for x:=0 to lx-1 do begin
        inc(lPos);
        Bitmap.Canvas.Pixels[x,y] := lLongBuff^[lPos];
      end;
    end;
    Form1.Image1.Width := lx;
    Form1.Image1.Height := ly;
    Form1.Image1.Canvas.Draw(0, 0, Bitmap);
  finally
    Bitmap.Free;
  end;
end;

procedure GenerateBMP (lX,lY: integer);
var
   lPos,lXp,lYp: integer;
   lRGB : TRGBQuad;
   lRGBBuff: RGBQuadp;
begin
  //initialize RGB values - note rgbreserved not used by Lazarus
  lRGB.rgbRed := 0;
  lRGB.rgbgreen := 0;
  lRGB.rgbblue := 0;
  lRGB.rgbreserved := 0;
  GetMem ( lRGBBuff ,  lX*lY*sizeof(TRGBquad));
  lPos := 0;
  for lXp := 0 to lX-1 do
      for lYp := 0 to lY-1 do begin
          inc(lPos);
          lRGB.rgbgreen := lXp and 255;
          lRGB.rgbRed := lYp and 255;
          lRGBBuff^[lPos] := lRGB;
      end;
  DrawBMP(lX,lY,lRGBBuff);
  Freemem(lRGBBuff);
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
 GenerateBMP(128,128);
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
var
   lID: TClipBoardFormat;
begin
    GenerateBMP(255,255);
end;

procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
    GenerateBMP(512,512);
end;

----------------------------------------------------------------------
crlab · 2006-04-14 16:24

I think I have found a solution, changing
 Form1.Image1.Canvas.Draw(0, 0, Bitmap);
to
   Form1.Image1.Picture.Bitmap := Bitmap;

----------------------------------------------------------------------
Anonymous · 2006-04-16 16:53

I guess instead
    Form1.Image1.Canvas.Draw(0, 0, Bitmap);
should be used
    Form1.Image1.Picture.Bitmap.Canvas.Draw(0, 0, Bitmap);

----------------------------------------------------------------------
Valdas · 2006-04-16 18:56

When you resizing Image1 also resize Image1.Picture.Bitmap: after

Form1.Image1.Width := lx;
Form1.Image1.Height := ly;

in DrawBMP procedure simply put

Form1.Image1.Picture.Bitmap.Width:= lx;
Form1.Image1.Picture.Bitmap.Height:= ly;

I tested this- worked.