WinAPI: SetWindowExtEx、SetViewportExtEx

相似函数: 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