Similar functions: scaleappswextex and scaleviewportextex
In this example:
Code File:
Unit unit1; interfaceuses 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); {you can only use the following two functions in mm_isotropic or mm_anisotropic mode} setjavaswextex (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.
Form file:
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 placement = 96 textheight