Alphablend (DC: HDC; {target device environment handle} P2, P3, P4, P5: integer; {target location and width and height} dc6: HDC; {Source Device environment handle} P7, p8, P9, P10: integer; {source location and width and height} P11: tblendfunction {data structure of the synthesis method, see the table below}): bool; // The tblendfunction structure is _ blendfunction rename: _ blendfunction = packed record blendop: byte; {This example uses: ac_src_over = 0} blendflags: byte; {must be 0} sourceconstantalpha: byte; {transparency: 0 .. 255} alphaformat: byte; {usually 0. If the source bitmap is 32-bit true color, it can be ac_src_alpha} end;
In this example:
Code File:
Unit unit1; interfaceuses windows, messages, sysutils, variants, classes, graphics, controls, forms, dialogs, stdctrls, extctrls, comctrls; Type tform1 = Class (tform) trackbar1: ttrackbar; procedure alert (Sender: tobject); Procedure trackbar1change (Sender: tobject); Procedure formdestroy (Sender: tobject); end; var form1: tform1; implementation {$ R *. DFM} var bit, bitback: tbitmap; Transparency: byte = 255; {transparency} procedure tform1.formcreate (Sender: tobject); begin {set form background} bitback: = tbitmap. create; bitback. loadfromfile ('C: \ temp \ back.bmp '); brush. bitmap: = bitback; {transfer image} bit: = tbitmap. create; bit. loadfromfile ('C: \ temp \ test.bmp '); {initialize trackbar1} trackbar1.max: = 255; trackbar1.min: = 0; trackbar1.showselrange: = false; trackbar1.position: = trackbar1.max; end; procedure tform1.formpaint (Sender: tobject); var Blend: tblendfunction; {define the tblendfunction structure to be used by alphablend} begin {assign a value to the tblendfunction structure} blend. blendop: = ac_src_over; blend. blendflags: = 0; blend. alphaformat: = 0; blend. sourceconstantalpha: = transparency; windows. alphablend (canvas. handle, {because VCL has an attribute of the same name, it is specified to be from Windows units} 10, 10, bit. width + 10, bit. height + 10, bit. canvas. handle, 0, 0, bit. width, bit. height, blend); end; Procedure tform1.trackbar1change (Sender: tobject); begin transparency: = trackbar1.position; text: = inttostr (transparency); self. repaint; {command re-painting} end; Procedure tform1.formdestroy (Sender: tobject); begin bit. free; bitback. free; end.
Form Design:
Object form1: tform1 left = 352 Top = 238 caption = 'form1' clientheight = 209 clientwidth = 211 color = clbtnface font. charset = default_charset font. color = clwindowtext font. height =-11 font. name = 'tahoma 'font. style = [] oldcreateorder = false position = podesigned oncreate = formcreate ondestroy = formdestroy onpaint = formpaint pixelsperinch = 96 textheight = 13 object trackbar1: ttrackbar left = 0 Top = 186 width = 201 Height = 24 taborder = 0 onchange = trackbar1change endend