Code :
Unit unit1; interfaceuses windows, messages, sysutils, variants, classes, graphics, controls, forms, dialogs, stdctrls, extctrls, comctrls, typinfo, direct2d; Type tform1 = Class (tform) metadata: tlistbox; Metadata: tpanel; groupbox1: tgroupbox; checkbox1: tcheckbox; edit1: tedit; Metadata: plaintext; colorbox1: tcolorbox; groupbox2: tgroupbox; checkbox2: tcheckbox; colorbox2: tcolorbox; paintbox1: tpaintbox; Procedure formcreate (Sender: tobject); Procedure paintbox1paint (Sender: tobject); Procedure alert (Sender: tobject; button: tmousebutton; shift: cursor; X, Y: integer); Procedure paintbox1mouseup (Sender: tobject; button: tmousebutton; shift: tshiftstate; X, Y: integer); Procedure paintbox1mousemove (Sender: tobject; shift: tshiftstate; x, y: integer); Procedure listbox1click (Sender: tobject); end; var form1: tform1; implementation {$ R *. DFM} type tenumdraw = (eellipse, Eline, erectangle, eroundrect, eframerect, Epie, earc, echord, epolyline, epolygon, epolybezr); tpointarr4 = array [0 .. 3] of tpoint; var PTSS: array [tenumdraw] of tpointarr4; // an array of point arrays ppts: ^ tpointarr4; // the pointer ppt of the point array required by a graph: Ppoint; // Enum: tenumdraw; // specifies the image type flag: Boolean to be drawn; // determine whether the mouse is directed to {initialization data} procedure tform1.formcreate (Sender: tobject); var E: tenumdraw; begin {initialization point array} PTSS [eellipse] [0]: = point (200,150); PTSS [eellipse] [1]: = point (); PTSS [eellipse] [2]: = point (maxint, maxint ); PTSS [eellipse] [3]: = point (maxint, maxint); PTSS [erectangle]: = PTSS [eellipse]; PTSS [Eline]: = PTSS [eellipse]; PTSS [eroundrect]: = PTSS [eellipse]; PTSS [eframerect]: = PTSS [eellipse]; PTSS [Epie] [0]: = point (100,50 ); PTSS [Epie] [1]: = point (200,150); PTSS [Epie] [2]: = point (); PTSS [Epie] [3]: = point (100,150); PTSS [earc]: = PTSS [Epie]; PTSS [echord]: = PTSS [Epie]; PTSS [epolyline] [0]: = point (200,150); PTSS [epolyline] [1]: = point (); PTSS [epolyline] [2]: = point ); PTSS [epolyline] [3]: = point (100,150); PTSS [epolygon]: = PTSS [epolyline]; PTSS [epolybeiser]: = PTSS [epolyline]; {fill listbox1} For E: = low (tenumdraw) to high (tenumdraw) Do begin listbox1.items. add (getenumname (typeinfo (tenumdraw), ord (E); end; listbox1.itemindex: = 0; {initialization control} panel1.caption: = ''; updown1.associate: = edit1; edit1.numbersonly: = true; consumed: = tacenter; updown1.associate: = edit1; updown1.min: = 1; checkbox1.checked: = true; checkbox2.checked: = true; colorbox1.selected: = clblue; colorbox2.selected: = cllime; {event sharing} checkbox1.onclick: = success; checkbox2.onclick: = listbox1.onclick; colorbox1.onchange: = success; colorbox2.onchange: = success; edit1.onchange: = success; end; Procedure publish (Sender: tobject ); begin Enum: = tenumdraw (listbox1.itemindex); ppts: = @ PTSS [Enum]; paintbox1.invalidate; end; Procedure submit (Sender: tobject; button: tmousebutton; shift: tshiftstate; X, y: integer); begin flag: = paintbox1.cursor = crcross; end; Procedure tform1.paintbox1mousemove (Sender: tobject; shift: tshiftstate; X, Y: integer); var I: integer; begin if flag then begin PPT ^: = point (x, y); paintbox1.invalidate; exit; end ;{determine whether the mouse is on the control point} For I: = 0 to length (ppts ^)-1 do begin if (ppts ^ [I]. X maxint) and ptinrect (rect (ppts ^ [I]. A X-4, ppts ^ [I]. A Y-4, ppts ^ [I]. X + 4, ppts ^ [I]. Y + 4), point (x, y) then begin paintbox1.cursor: = crcross; PPT: = @ ppts ^ [I]; // which control point exit; end else paintbox1.cursor: = crdefault; end; Procedure tform1.paintbox1mouseup (Sender: tobject; button: tmousebutton; shift: tshiftstate; X, Y: integer); begin flag: = false; end; {draw} procedure tform1.paintbox1paint (Sender: tobject); var PTS: tpointarr4; Pt: tpoint; begin with tdirect2dcanvas. create (paintbox1.canvas, paintbox1.clientrect) Do begin begindraw; pen. color: = colorbox1.selected; pen. width: = strtointdef (edit1.text, 1); brush. color: = colorbox2.selected; if not checkbox1.checked then pen. width: = 0; if not checkbox2.checked then brush. style: = bsclear; {Drawing Image} PTS: = ppts ^; Case Enum of eellipse: ellipse (rect (PTS [0], PTS [1]); Eline: begin moveTo (PTS [0]. x, PTS [0]. y); lineto (PTS [1]. x, PTS [1]. y); end; erectangle: rectangle (rect (PTS [0], PTS [1]); eroundrect: roundrect (rect (PTS [0], PTS [1]), 25, 25); eframerect: framerect (rect (PTS [0], PTS [1]); Epie: Pie (PTS [0]. x, PTS [0]. y, PTS [1]. x, PTS [1]. y, PTS [2]. x, PTS [2]. y, PTS [3]. x, PTS [3]. y); earc: arc (PTS [0]. x, PTS [0]. y, PTS [1]. x, PTS [1]. y, PTS [2]. x, PTS [2]. y, PTS [3]. x, PTS [3]. y); echord: chord (PTS [0]. x, PTS [0]. y, PTS [1]. x, PTS [1]. y, PTS [2]. x, PTS [2]. y, PTS [3]. x, PTS [3]. y); epolyline: polyline (PTS); epolygon: Polygon. style: = bssolid; brush. color: = clred; for PT in PTS do if pt. X maxint then fillrect (rect (pt. x-4, PT. y-4, PT. X + 4, PT. Y + 4); enddraw; free; end.
Form:
Object form1: tform1 left = 0 Top = 0 caption = 'form1' clientheight = 348 clientwidth = 476 color = clbtnface font. charset = default_charset font. color = clwindowtext font. height =-11 font. name = 'tahoma 'font. style = [] oldcreateorder = false oncreate = formcreate pixelsperinch = 96 textheight = 13 object listbox1: tlistbox left = 0 Top = 0 width = 129 Height = 348 align = alleft itemheight = 13 taborder = 0 onclick = listbox1click end object Panel1: tpanel left = 129 Top = 0 width = 347 Height = 348 align = alclient caption = 'panel1' padding. top = 10 taborder = 1 object paintbox1: tpaintbox left = 1 Top = 129 width = 345 Height = 218 align = alclient onmousedown = onmousemove = onmouseup = onpaint = paintbox1paint explicitleft = 208 explicittop = 136 explicitwidth = 105 explicitheight = 105 end object groupbox1: tgroupbox left = 1 Top = 11 width = 345 Height = 62 align = altop caption = 'pen 'taborder = 0 object edit1: tedit left = 256 Top = 24 width = 48 Height = 21 taborder = 0 text = 'edit1' end object updown1: tupdown left = 303 Top = 22 width = 17 Height = 23 taborder = 1 end object colorbox1: tcolorbox left = 112 Top = 24 width = 114 Height = 22 taborder = 2 end object checkbox1: tcheckbox left = 16 Top = 26 width = 97 Height = 17 caption = 'checkbox1' taborder = 3 end object groupbox2: tgroupbox left = 1 Top = 73 width = 345 Height = 56 align = altop caption = 'buffer' taborder = 1 object colorbox2: tcolorbox left = 112 Top = 22 width = 114 Height = 22 taborder = 0 end object checkbox2: tcheckbox left = 16 Top = 24 width = 97 Height = 17 caption = 'checkbox2 'taborder = 1 end endend
: