再学 GDI+[87]: TGPImage(7) - 调整图像大小

本例效果图:

---

代码文件:

---

unit Unit1;



interface



uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs;



type

  TForm1 = class(TForm)

    procedure FormCreate(Sender: TObject);

    procedure FormDestroy(Sender: TObject);

    procedure FormPaint(Sender: TObject);

    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;

      Shift: TShiftState; X, Y: Integer);

    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;

      Shift: TShiftState; X, Y: Integer);

  private

    procedure RectToPoints;

  end;



var

  Form1: TForm1;



implementation



{$R *.dfm}



uses GDIPOBJ, GDIPAPI;



var

  img: TGPImage;

  flag: Integer = -1;

  ClickImg: Boolean;

  rt: TRect;

  pts: array[0..7] of TPoint;

  x1,y1: Integer;



{从矩形中获取八个点, 因要反复使用, 故提取为一个独立的过程}

procedure TForm1.RectToPoints;

begin

  pts[0] := rt.TopLeft;

  pts[1] := Point(rt.Left, rt.Top + (rt.Bottom - rt.Top) div 2);

  pts[2] := Point(rt.Left, rt.Bottom);

  pts[3] := Point(rt.Left + (rt.Right - rt.Left) div 2, rt.Bottom);;

  pts[4] := rt.BottomRight;

  pts[5] := Point(rt.Right, rt.Top + (rt.Bottom - rt.Top) div 2);;

  pts[6] := Point(rt.Right, rt.Top);;

  pts[7] := Point(rt.Left + (rt.Right - rt.Left) div 2, rt.Top);

end;



procedure TForm1.FormCreate(Sender: TObject);

const

  ImgPath = 'c:\temp\test.png';

var

  w,h: Integer;

begin

  if not FileExists(ImgPath) then Exit;



  img := TGPImage.Create(ImgPath);

  w := img.GetWidth;

  h := img.GetHeight;



  rt.Left := (ClientWidth - w) div 2;

  rt.Top := (ClientHeight - h) div 2;

  rt.Right := rt.Left + w;

  rt.Bottom := rt.Top + h;



  RectToPoints;



  DoubleBuffered := True;

end;



procedure TForm1.FormDestroy(Sender: TObject);

begin

  img.Free;

end;



procedure TForm1.FormPaint(Sender: TObject);

var

  g: TGPGraphics;

  p: TGPPen;

  i: Integer;

begin

  g := TGPGraphics.Create(Canvas.Handle);

  p := TGPPen.Create(aclRed);

  g.DrawImage(img, MakeRect(rt));



  if ClickImg then

    for i := 0 to Length(pts) - 1 do

      g.DrawRectangle(p, MakeRect(pts[i].X - 3, pts[i].Y - 3, 6, 6));

  p.Free;

  g.Free;

end;



procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

var

  i: Integer;

begin

  flag := -1;

  for i := 0 to Length(pts) - 1 do

    if PtInRect(Bounds(pts[i].X - 3, pts[i].Y - 3, 6, 6), Point(X, Y)) then

    begin

      flag := i;

      Break;

    end;

  if flag = -1 then

  begin

    ClickImg := PtInRect(rt, Point(X,Y));

    Repaint;

  end else begin

    x1 := X;

    y1 := Y;

  end;

end;



procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,

  Y: Integer);

begin

  if flag = -1 then Exit;

  case flag of

    0: begin Inc(rt.Left, X-x1); Inc(rt.Top, Y-y1) end;

    1: begin Inc(rt.Left, X-x1) end;

    2: begin Inc(rt.Left, X-x1); Inc(rt.Bottom, Y-y1) end;

    3: begin Inc(rt.Bottom, Y-y1) end;

    4: begin Inc(rt.Right, X-x1); Inc(rt.Bottom, Y-y1) end;

    5: begin Inc(rt.Right, X-x1) end;

    6: begin Inc(rt.Right, X-x1); Inc(rt.Top, Y-y1) end;

    7: begin Inc(rt.Top, Y-y1) end;

  end;

  x1 := X;

  y1 := Y;



  RectToPoints;

  Repaint;

end;



procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

begin

  flag := -1;

end;



end.


 
   

窗体文件:

---

object Form1: TForm1

  Left = 0

  Top = 0

  Caption = 'Form1'

  ClientHeight = 246

  ClientWidth = 346

  Color = clBtnFace

  Font.Charset = DEFAULT_CHARSET

  Font.Color = clWindowText

  Font.Height = -11

  Font.Name = 'Tahoma'

  Font.Style = []

  OldCreateOrder = False

  Position = poDesktopCenter

  OnCreate = FormCreate

  OnDestroy = FormDestroy

  OnMouseDown = FormMouseDown

  OnMouseMove = FormMouseMove

  OnMouseUp = FormMouseUp

  OnPaint = FormPaint

  PixelsPerInch = 96

  TextHeight = 13

end