Author: Tomas Rutkauskas
How to fill a text with a pattern or bitmap? I know that using fillpath(dc) will do
it but how can I assign the bitmap or a gradient color to the font?
Answer:
Solve 1:
Here's one method. To make this work, add a TImage and load it with a bmp of about
256 x 256. Make the TImage Visible - False. Drop a TButton on the form. Hook up the
OnClick for the button. Change the Form's Font to be something big enough, say
around 80 for the size. Also, specify a True Type Font (I used Times New Roman).
1 unit Unit1;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 StdCtrls, ExtCtrls;
8
9 type
10 TForm1 = class(TForm)
11 Image1: TImage;
12 Button1: TButton;
13 procedure Button1Click(Sender: TObject);
14 private
15 { Private declarations }
16 public
17 { Public declarations }
18 end;
19
20 var
21 Form1: TForm1;
22
23 implementation
24
25 {$R *.DFM}
26
27 procedure TForm1.Button1Click(Sender: TObject);
28 var
29 ClipRegion: HRGN;
30 Bmp: TBitmap;
31 begin
32 Bmp := TBitmap.Create;
33 Bmp.Width := Image1.Width;
34 Bmp.Height := Image1.Height;
35 Bmp.Canvas.Brush.Color := clSilver;
36 {You could use a different color, or another bitmap}
37 Bmp.Canvas.FillRect(RECT(0, 0, Bmp.Width, Bmp.Height));
38 BeginPath(Canvas.Handle);
39 SetBkMode(Canvas.Handle, TRANSPARENT);
40 TextOut(Canvas.Handle, 10, 30, 'Cool!', 5);
41 EndPath(Canvas.Handle);
42 ClipRegion := PathToRegion(Canvas.Handle);
43 SelectClipRgn(Bmp.Canvas.Handle, ClipRegion);
44 Bmp.Canvas.Draw(0, 0, Image1.Picture.Bitmap);
45 SelectClipRgn(Bmp.Canvas.Handle, 0);
46 Canvas.Draw(0, 0, Bmp);
47 DeleteObject(ClipRegion);
48 Bmp.Free;
49 end;
50
51 end.
Solve 2:
52 procedure TForm1.Button1Click(Sender: TObject);
53 var
54 dc: hdc;
55 SaveIndex: integer;
56 bm: TBitmap;
57 begin
58 bm := TBitmap.Create;
59 bm.LoadFromFile('c:\download\test.bmp');
60 Canvas.Font.Name := 'Arial';
61 Canvas.Font.Height := 100;
62 dc := Canvas.Handle;
63 SaveIndex := SaveDc(Dc);
64 SetBkMode(dc, TRANSPARENT);
65 BeginPath(dc);
66 Canvas.TextOut(0, 0, 'Many TeamB guys ignore me');
67 EndPath(dc);
68 SelectClipPath(dc, RGN_COPY);
69 Canvas.Draw(0, 0, bm);
70 RestoreDc(dc, SaveIndex);
71 bm.Free;
72 end;
|