2007. december 29., szombat
How to autoscale a TBitmap while keeping the aspect ratio
Problem/Question/Abstract:
How to autoscale a TBitmap while keeping the aspect ratio
Answer:
Explanation on explicit demand!
procedure TForm1.Image1Paint(Sender: TObject);
var
Bitmap: TBitmap;
Breite, Hoehe: Real;
links, rechts, oben, unten: integer;
Feld: TRect;
begin
Image1.Canvas.Pen.Color := Form1.Color;
Image1.Canvas.Brush.Color := Form1.Color;
Feld.Left := 0;
Feld.Right := Image1.Width;
Feld.Top := 0;
Feld.Bottom := Image1.Height;
Image1.Canvas.Rectangle(Feld);
Application.ProcessMessages;
Bitmap := TBitmap.Create;
Bitmap.PixelFormat := pf24bit;
Bitmap.LoadFromFile('C:\Bild.bmp');
Breite := Bitmap.Width / Image1.Width;
Hoehe := Bitmap.Height / Image1.Height;
if Breite >= Hoehe then
begin
links := 0;
rechts := Image1.Width;
oben := (Image1.Height - Trunc(Bitmap.Height / Breite)) div 2;
unten := oben + Trunc(Bitmap.Height / Breite);
end
else
begin
oben := 0;
unten := Image1.Height;
links := (Image1.Width - Trunc(Bitmap.Width / Hoehe)) div 2;
rechts := links + Trunc(Bitmap.Width / Hoehe)
end;
Feld.Left := links;
Feld.Right := rechts;
Feld.Top := oben;
Feld.Bottom := unten;
Image1.Canvas.StretchDraw(Feld, Bitmap);
Bitmap.Free;
end;
Feliratkozás:
Megjegyzések küldése (Atom)
Nincsenek megjegyzések:
Megjegyzés küldése