相似函数: ScaleWindowExtEx、ScaleViewportExtEx
本例效果图:
代码文件:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls;
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);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
var
cvs: TCanvas;
x1,y1: Real;
wx,wy,vx,vy: Integer;
f: Boolean;
procedure TForm1.FormCreate(Sender: TObject);
begin
cvs := TCanvas.Create;
cvs.Handle := GetDC(Handle);
wx := ClientWidth;
wy := ClientHeight;
vx := wx;
vy := wy;
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
f := True;
x1 := X;
y1 := Y;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if not f
then Exit;
x1 := X / x1;
y1 := Y / y1;
vx := Trunc(vx * x1);
vy := Trunc(vy * y1);
Repaint;
x1 := X;
y1 := Y;
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
f := False;
end;
procedure TForm1.FormPaint(Sender: TObject);
const
pts:
array[
0..
2]
of TPoint = ((X:
60; Y:
10), (X:
60; Y:
100), (X:
10; Y:
100));
begin
SetMapMode(cvs.Handle, MM_ANISOTROPIC);
{只能在 MM_ISOTROPIC 或 MM_ANISOTROPIC 模式下使用下面两个函数}
SetWindowExtEx(cvs.Handle, wx, wy,
nil);
SetViewportExtEx(cvs.Handle, vx, vy,
nil);
cvs.Pen.Width :=
3;
cvs.Pen.Color := clRed;
cvs.Brush.Style := bsCross;
cvs.Brush.Color := clSilver;
cvs.Polygon(pts);
cvs.Ellipse(
30,
70,
90,
130);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
cvs.Free;
end;
end.
窗体文件:
object Form1: TForm1
Left =
0
Top =
0
Caption =
‘Form1‘
ClientHeight =
241
ClientWidth =
302
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放大缩小，，只需要使用这2个函数：SetWindowExtEx、SetViewportExtEx
