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