In this example:
Code File:
Unit unit1; interfaceuses windows, messages, sysutils, variants, classes, graphics, controls, forms, dialogs, stdctrls, tecanvas, comctrls; Type tform1 = Class (tform) combox1: tcombobox; combox2: custom; trackbar1: ttrackbar; buttoncolor1: tbuttoncolor; Procedure formcreate (Sender: tobject); Procedure formpaint (Sender: tobject); Procedure future (Sender: tobject ); procedure combobox2change (Sender: tobject); Procedure trackbar1change (Sender: tobject); Procedure buttoncolor1click (Sender: tobject); end; var form1: tform1; implementation {$ R *. DFM} uses gdipobj, gdipapi, typinfo; var startcap, endcap: integer; linewidth: single = 2; linecolor: tgpcolor = aclred; Procedure tform1.formcreate (Sender: tobject ); begin with combobox1.items do begin add ('linecapflat'); add ('linecapsquare '); add ('linecapround'); add ('linecaptriangle '); add ('linecapnoanchor '); add ('linecapsquareanchor '); add ('linecaproundanchor'); add ('linecapdiamondanchor '); add ('weight'); add ('linecapcustom'); end; combobox1.itemindex: = 0; combobox2.items: = combobox1.items; combobox2.itemindex: = 0; trackbar1.showselrange: = false; trackbar1.min: = 1; trackbar1.max: = 50; trackbar1.position: = 2; cursor: = clred; End; procedure tform1.formpaint (Sender: tobject); var G: tgpgraphics; P: tgppen; X1, Y1, X2, Y2: integer; begin G: = tgpgraphics. create (canvas. handle); P: = tgppen. create (0); G. clear (makecolor (255,255,255); X1: = 50; X2: = clientwidth-50; Y1: = clientheight Div 2; Y2: = Y1; p. setcolor (linecolor); p. setwidth (linewidth); p. setstartcap (startcap); p. setendcap (endcap); G. drawline (p, X1, Y1, X2, Y2); G. free; p. free; end; Procedure tform1.combobox1change (Sender: tobject); var I: integer; begin I: = 0; Case tcombobox (sender ). itemindex of 0: I: = linecapflat; 1: I: = linecapsquare; 2: I: = linecapround; 3: I: = linecaptriangle; 4: I: = linecapnoanchor; 5: i: = linecapsquareanchor; 6: I: = linecaproundanchor; 7: I: = linecapdiamondanchor; 8: I: = middle; 9: I: = linecapcustom; 10: I: = middle; end; If tcombobox (sender) = combox1 then startcap: = I; If tcombobox (sender) = combox2 then endcap: = I; repaint; end; Procedure destroy (Sender: tobject ); begin combobox1change (sender); end; Procedure tform1.trackbar1change (Sender: tobject); begin linewidth: = trackbar1.position; repaint; end; Procedure extract (Sender: tobject); begin linecolor: = colorreftoargb (buttoncolor1.symbolcolor); repaint; end.
Form file:
Object form1: tform1 left = 0 Top = 0 caption = 'form1' clientheight = 206 clientwidth = 315 color = clbtnface font. charset = default_charset font. color = clwindowtext font. height =-11 font. name = 'tahoma 'font. style = [] oldcreateorder = false position = pow.topcenter oncreate = formcreate onpaint = formpaint pixelsperinch = 96 textheight = 13 object combobox1: tcombobox left = 8 Top = 8 width = 145 Height = 21 itemheight = 13 taborder = 0 text = 'combox1' onchange = combobox1change end object combox2: tcombobox left = 162 Top = 8 width = 145 Height = 21 itemheight = 13 taborder = 1 text = 'combox2 'onchange = combobox2change end object trackbar1: ttrackbar left = 3 Top = 182 width = 223 Height = 20 taborder = 2 onchange = trackbar1change end object buttoncolor1: tbuttoncolor left = 232 Top = 177 caption = 'buttoncolor1' taborder = 3 onclick = buttoncolor1click endend
Attachment cap Style Constant:
Linecapflat = 0; {specify the flat cap} linecapsquare = 1; {specify the line cap} linecapround = 2; {specify the circle cap} linecaptriangle = 3; {specify triangle cap} linecapnoanchor = $10; {specify no anchor} linecapsquareanchor = $11; {specify the anchor cap} linecaproundanchor = $12; {specify round anchor cap} linecapdiamondanchor = $13; {specify diamond anchor} linecaparrowanchor = $14; {specify arrow-shaped anchor} linecapcustom = $ ff; {custom line caps} linecapanchormask = $ F0; {mask used to check whether the line caps are headers}