// 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