Zoom Picture High Quality

Mit diesem Beispiel lassen sich Bilder in hoher Qualität Zoomen.

Es wird benötigt : 1xPaintBox, 1xTrackBar, 5xCheckBox, 1xButton, 2xLabel, 1xOpenPictueDialog

Type
  T2DFace = Array[0..2] Of TPoint;

Var
    BMP : TBitmap;
    VertFlip : Boolean = False;
    HorzFlip : Boolean = False;
    
//

procedure TForm1.FormCreate(Sender: TObject);
begin
  BMP := TBitmap.Create;
  BMP.LoadFromFile(ExtractFilePath(Application.ExeName)+'Flag.bmp');
  DoubleBuffered := True;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  BMP.Free;
end;

procedure TForm1.CheckBox3Click(Sender: TObject);
begin
  Case TComponent(Sender).Tag Of
    0: VertFlip := Not VertFlip;
    1: HorzFlip := Not HorzFlip;
    2: Begin
         VertFlip := Not VertFlip;
         HorzFlip := Not HorzFlip;
       End;
  End;
  Invalidate;
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
  Label2.Caption := Format('Zoom: %d%%', [TrackBar1.Position]);
  Invalidate;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  Invalidate;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
Const OrgFlip : Array[Boolean] Of Integer = (0, 1);
      SizeFlip : Array[Boolean] Of Integer = (1, -1);
Var OrgX, OrgY,
    SizeX, SizeY : Integer;
    Factor : Extended;
    PntArray : T2DFace;
begin
  Factor := TrackBar1.Position * 1e-2;
  With BMP do Begin
    SizeX := Round(Width * SizeFlip[HorzFlip] * Factor);
    OrgX := Round(Width * OrgFlip[HorzFlip] * Factor);
    SizeY := Round(Height * SizeFlip[VertFlip] * Factor);
    OrgY := Round(Height * OrgFlip[VertFlip] * Factor);
  End;

  If CheckBox2.Checked Then Begin
    OrgX := OrgX + ((PaintBox1.ClientWidth - Abs(SizeX)) Div 2);
    OrgY := OrgY + ((PaintBox1.ClientHeight - Abs(SizeY)) Div 2);
  End;

  SetStretchBltMode(PaintBox1.Canvas.Handle, HALFTONE);

  If CheckBox1.Checked Then Begin
    PntArray[0] := Point(OrgX, OrgY);
    PntArray[1] := Point(OrgX+SizeX, OrgY);
    PntArray[2] := Point(OrgX, OrgY+SizeY);
    PlgBlt(PaintBox1.Canvas.Handle, PntArray, BMP.Canvas.Handle, 0, 0, BMP.Width, BMP.Height, 0, 0, 0);
  End
  Else
    StretchBlt(PaintBox1.Canvas.Handle, OrgX, OrgY, SizeX, SizeY, BMP.Canvas.Handle, 0, 0, BMP.Width, BMP.Height, srcCOPY);

  Label1.Caption := Format('Left: %d , Top: %d'#13'Width: %d , Height: %d', [OrgX, OrgY, SizeX, SizeY]);
end;

procedure TForm1.CheckBox2Click(Sender: TObject);
begin
  Invalidate;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  Invalidate;
end;

Bild Laden :

procedure TForm1.Button1Click(Sender: TObject);
begin
  If OpenPictureDialog1.Execute Then BMP.LoadFromFile(OpenPictureDialog1.FileName);
  Invalidate;
end;