// Eine Grafik
(außer Icon)
kann auf verschiedene Art
type
kind = (center, fit, relative, stretch);
function InsertGraphic(src: TGraphic; dst: TBitmap;
wdth, hgth: Integer; ground: TColor; like: kind): byte;
var
rct: TRect;
begin
if (wdth < 3) or (hgth < 3) then begin
Result := 1;
exit;
end;
if (src.Width < 3) or (src.Height < 3) then begin
Result := 2;
exit;
end;
if src is TIcon then begin
Result := 3;
exit;
end;
try
dst.Width := wdth;
dst.Height := hgth;
case like of
stretch: rct := rect(0, 0, wdth, hgth);
fit: begin
if (wdth / src.Width) < (hgth / src.Height) then
hgth := round((wdth * src.Height) / src.Width)
else wdth := round((src.Width * hgth) / src.Height);
rct.Left := ((dst.Width - wdth) div 2);
rct.Top := ((dst.Height - hgth) div 2);
rct.Right := rct.Left + wdth;
rct.Bottom := rct.Top + hgth;
end;
relative: begin
wdth := dst.Width;
hgth := round(wdth * (src.Height / src.Width));
if hgth < dst.Height then begin
hgth := dst.Height;
wdth := round(hgth * (src.Width / src.Height));
end;
rct.Left := ((dst.Width - wdth) div 2);
rct.Top := ((dst.Height - hgth) div 2);
rct.Right := rct.Left + wdth;
rct.Bottom := rct.Top + hgth;
end;
else begin
rct.Left := ((dst.Width - src.Width) div 2);
rct.Top := ((dst.Height - src.Height) div 2);
rct.Right := rct.Left + src.Width;
rct.Bottom := rct.Top + src.Height;
end;
end;
dst.Canvas.Brush.Color := ground;
dst.Canvas.FillRect(dst.Canvas.ClipRect);
SetStretchBltMode(dst.Canvas.handle, STRETCH_HALFTONE);
dst.Canvas.StretchDraw(rct, src);
Result := 0;
except
Result := 4;
end;
end;
// Beispielaufruf
procedure TForm1.Button1Click(Sender: TObject);
var
bm: TBitmap;
begin
bm := TBitmap.create;
case InsertGraphic(Image1.picture.graphic, bm, 200, 100, clred, fit) of
0: canvas.draw(10, 10, bm);
1: showmessage('Abmaße des Zielbildes zu gering');
2: showmessage('Abmaße des Quellbildes zu gering');
3: showmessage('Icons werden nicht unterstützt');
else showmessage('Unerwarteter Fehler');
end;
bm.free;
end;
|
Zugriffe seit 6.9.2001 auf Delphi-Ecke





