procedure TForm1.DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); var
c: TCanvas;
dx, dy, dw, dh: Integer; begin
c := DrawGrid1.Canvas;
dx := -1;
dh := 30; // nur geschätzt nicht gemessen
dw := 31; case ACol of// irgnedwelche Randombedingungen
1: begin case ARow of
1: begin
dx := 5 * dw;
dy := 3 * dh; end;
4 .. 6: begin
dx := Random(10) * dw;
dy := 2 * dh; end end; end;
2: if ARow > 0 then begin
dx := ARow * dw;
dy := ACol * dh; end end; if dx > -1 then
Stretchblt(c.Handle, Rect.Left, Rect.Top, Rect.Right - Rect.Left, Rect.Bottom - Rect.Top, Image1.Canvas.Handle, dx, dy, dw, dh, srcCopy) end;
procedure TForm1.FormCreate(Sender: TObject); var
bmp: TBitmap; begin
DrawGrid1.ColCount := 10;
DrawGrid1.RowCount := 10;
DrawGrid1.DefaultColWidth := 60; // etwas größer als die Bilder um Strech zu zeigen
DrawGrid1.DefaultRowHeight := 60;
if Assigned(Image1.Picture.Graphic) then// kein Bitmap sondern etwas anderes geladen begin
bmp := TBitmap.Create; try
bmp.Width := Image1.Picture.Graphic.Width;
bmp.Height := Image1.Picture.Graphic.Height;
bmp.Canvas.Draw(0, 0, Image1.Picture.Graphic);
Image1.Picture.Assign(bmp); finally
bmp.Free; end; end;
Image1.Picture.Bitmap; // Dummyzugriff um ein (leeres) Bitmap zu erzeugen wenn keines vorhanden ist end;
Thomas Wassermann H₂♂ Das Problem steckt meistens zwischen den Ohren
DRY DRY KISS
H₂♂ (wenn bei meinen Snipplets nichts anderes angegeben ist Lizenz: WTFPL)