How to autoscale a TBitmap while keeping the aspect ratio (Views: 27)
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; |