Uses direct2d, d2d1; {function for creating a bitmap painter} function getbitmapbrush (canvas: tdirect2dcanvas; filepath: string): id2d1bitmapbrush; var rbbp: td2d1bitmapbrushproperties; bit: tbitmap; begin bit: = tbitmap. create; bit. loadfromfile (filepath); rbbp. extendmodex: = d2d1_extend_mode_wrap; rbbp. extendmodey: = d2d1_extend_mode_wrap; rbbp. interpolationmode: = d2d1_bitmap_interpolation_mode_nearest_neighbor; canvas. rendertar Get. createbitmapbrush (canvas. createbitmap (BIT), @ rbbp, nil, result); bit. free; end; {function for linear gradient painter} function getlineargradientbrush (rendertarget: id2d1rendertarget; colors: array of tcolor): gradient; var rlinear: gradient; rgradientstops: array of td2d1gradientstop; igradientstops: id2d1gradientstopcollection; rsizef: td2dsizef; count, I: integer; begin rendertar Get. getsize (rsizef); rlinear. startpoint: = d2d1pointf (0, rsizef. height/2); rlinear. endpoint: = d2d1pointf (rsizef. width, rsizef. height/2); count: = length (colors); setlength (rgradientstops, count); for I: = 0 to count-1 do begin rgradientstops [I]. position: = I * (1/(count-1); rgradientstops [I]. color: = d2d1colgrading (colors [I]); end; rendertarget. creategradientstopcollection (@ rgradientstops [0], c Ount, d2d1_gamma_2_2, d2d1_extend_mode_clamp, igradientstops); rendertarget. aggregate (rlinear, nil, igradientstops, result); end; procedure merge (Sender: tobject); var CVS: tdirect2dcanvas; STR: string; itextformat: idwritetextformat; ibrush: id2d1brush; begin STR: = 'Hello world using directwrite! '; Dwritefactory. createtextformat ('Gabriel A', nil, dwrite_font_weight_ultra_black, dwrite_font_style_normal, dwrite_font_stretch_normal, 72.0, 'en-use', itextformat); itextformat. settextalignment (dwrite_text_alignment_center); itextformat. setparagraphalignment (dwrite_paragraph_alignment_center); CVS: = tdirect2dcanvas. create (canvas, clientrect); CVs. rendertarget. begindraw; CVs. rendertarget. clear (d 2d1colgrading (clwhite); If tag = 0 then ibrush: = getlineargradientbrush (CVS. rendertarget, [clred, clyellow]) else ibrush: = getbitmapbrush (CVS, 'c: \ temp \ test.bmp ');//! CVS. rendertarget. drawtext (pwidechar (STR), length (STR), itextformat, clientrect, ibrush); CVs. rendertarget. enddraw (); CVs. free; end; {mouse click conversion painter} procedure tform1.formclick (Sender: tobject); begin Tag: = not tag; repaint; end; Procedure tform1.formresize (Sender: tobject); begin repaint; end;
: