In this example:
Code File:
Unit unit1; interfaceuses windows, messages, sysutils, variants, classes, graphics, controls, forms, dialogs, stdctrls, comctrls; Type tform1 = Class (tform) trackbar1: ttrackbar; trackbar2: ttrackbar; trackbar3: ttrackbar; label1: tlabel; label2: tlabel; label3: tlabel; button1: tbutton; procedure invoke (Sender: tobject); Procedure formcreate (Sender: tobject ); procedure future (Sender: tobject); Procedure trackbar1change (Sender: tobject); Procedure future (Sender: tobject ); end; var form1: tform1; implementation {$ R *. DFM} uses gdipobj, gdipapi; var IMG: tgpimage; var colormatrix: tcolormatrix = (1.0, 0.0, 0.0, 0.0, 0.0), (0.0, 1.0, 0.0, 0.0, 0.0), (0.0, 0.0, 1.0, 0.0, 0.0), (0.0, 0.0, 0.0, 1.0, 0.0, 0.0), (0.0, 0.0, 0.0, 1.0 )); procedure tform1.formcreate (Sender: tobject); begin IMG: = tgpimage. create ('C: \ temp \ test.png '); trackbar1.height: = 23; trackbar1.showselrange: = false; trackbar1.min: =-100; trackbar1.max: = 100; trackbar1.position: = 0; trackbar2.height: = 23; trackbar2.showselrange: = false; trackbar2.min: =-100; trackbar2.max: = 100; trackbar2.position: = 0; trackbar3.height: = 23; trackbar3.showselrange: = false; trackbar3.min: =-100; trackbar3.max: = 100; trackbar3.position: = 0; doublebuffered: = true; end; Procedure tform1.formdestroy (Sender: tobject); begin IMG. free; end; Procedure tform1.formpaint (Sender: tobject); var G: tgpgraphics; imageattributes: tgpimageattributes; begin G: = tgpgraphics. create (canvas. handle); imageattributes: = tgpimageattributes. create; colormatrix [100]: = trackbar1.position/100; {red} colormatrix [100]: = trackbar2.position/; {green} colormatrix []: = trackbar3.position; {add or remove blue} imageattributes. setcolormatrix (colormatrix); G. drawimage (IMG, {image to be drawn} makerect (10, 10, IMG. getwidth, IMG. getheight), {the image will be scaled down to fit this rectangle} 0, 0, {drawing position} IMG. getwidth, IMG. getheight, {size} unitpixel, {unit} imageattributes {image attribute}); imageattributes. free; G. free; end; Procedure tform1.trackbar1change (Sender: tobject); begin repaint; end; Procedure prepare (Sender: tobject); begin repaint; end; Procedure tform1.trackbar3change (Sender: tobject ); begin repaint; end; Procedure tform1.button1click (Sender: tobject); begin trackbar1.position: = 0; trackbar2.position: = 0; trackbar3.position: = 0; repaint; end.
Form file:
Object form1: tform1 left = 0 Top = 0 caption = 'form1' clientheight = 291 clientwidth = 219 color = clbtnface font. charset = default_charset font. color = clwindowtext font. height =-11 font. name = 'tahoma 'font. style = [] oldcreateorder = false position = pow.topcenter oncreate = formcreate ondestroy = formdestroy onpaint = formpaint pixelsperinch = 96 textheight = 13 object label1: tlabel left = 12 Top = 188 width = 24 Height = 13 caption = #32418 #33394 end object label2: tlabel left = 12 Top = 212 width = 24 Height = 13 caption = #32511 #33394 end object label3: tlabel left = 12 Top = 234 width = 24 Height = 13 caption = #34013 #33394 end object trackbar1: ttrackbar left = 39 Top = 185 width = 172 Height = 45 taborder = 0 onchange = trackbar1change end object trackbar2: ttrackbar left = 39 Top = 207 width = 172 Height = 45 taborder = 1 onchange = trackbar2change end object trackbar3: ttrackbar left = 39 Top = 229 width = 172 Height = 45 taborder = 2 onchange = trackbar3change end object button1: tbutton left = 88 Top = 258 width = 75 Height = 25 caption = #24674 #22797 #40664 #35748 taborder = 3 onclick = button1click endend