Delphi實現帶背景圖的標簽，讓一個Lable標簽顯示於背景圖片之上，看上去像是一個鏈接錨文字，本代碼包括兩個文件，代碼分別如下，先看運行圖吧。
GraphLabel.pas代碼：
01
unit GraphLabel;
02
interface
03
uses
04
Windows, Messages, SysUtils, Classes, Controls, StdCtrls,
05
Graphics;
06
type
07
TGraphLabel = class(TLabel)
08
private
09
{ Private declarations }
10
FImage:TBitmap;
11
procedure SetImage(Value:Tbitmap);
12
protected
13
{ Protected declarations }
14
procedure Paint; override;
15
public
16
{ Public declarations }
17
constructor Create(AOwner: TComponent); override;
18
destructor Destroy; override;
19
published
20
{ Published declarations }
21
property Image:TBitmap read FImage write SetImage;
22
end;
23
procedure Register;
24
implementation
25
procedure TGraphLabel.SetImage(Value: Tbitmap);
26
var
27
NewBitmap:Tbitmap;
28
begin
29
NewBitmap:=nil;
30
if Value <> nil then
31
begin
32
NewBitmap:=Tbitmap.Create;
33
NewBitmap.Assign(Value);
34
end;
35
try
36
FImage.Free;
37
FImage:=NewBitmap;
38
Refresh;
39
except
40
NewBitmap.Free;
41
raise;
42
end;
43
end;
44
procedure TGraphLabel.Paint;
45
const
46
Alignments: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
47
WordWraps: array[Boolean] of Word = (0, DT_WordBREAK);
48
var
49
Rect, CalcRect: TRect;
50
DrawStyle: Longint;
51
begin
52
with Canvas do
53
begin
54
if not Transparent then
55
begin
56
Brush.Color := Self.Color;
57
Brush.Style := bsSolid;
58
Brush.Bitmap:=FImage;
59
FillRect(ClIEntRect);
60
end;
61
Brush.Style := bsClear;
62
Rect := ClIEntRect;
63
{ DoDrawText takes care of BiDi alignments }
64
DrawStyle := DT_EXPANDTABS or WordWraps[WordWrap] or Alignments[Alignment];
65
{ Calculate vertical layout }
66
if Layout <> tlTop then
67
begin
68
CalcRect := Rect;
69
DoDrawText(CalcRect, DrawStyle or DT_CALCRECT);
70
if Layout = tlBottom then OffsetRect(Rect, 0, Height - CalcRect.Bottom)
71
else OffsetRect(Rect, 0, (Height - CalcRect.Bottom) div 2);
72
end;
73
DoDrawText(Rect, DrawStyle);
74
end;
75
end;
76
constructor TGraphLabel.Create(AOwner: TComponent);
77
begin
78
inherited Create(AOwner);
79
FImage:=TBitmap.Create;
80
end;
81
destructor TGraphLabel.Destroy;
82
begin
83
FImage.Free;
84
inherited Destroy;
85
end;
86
procedure Register;
87
begin
88
RegisterComponents('Samples', [TGraphLabel]);
89
end;
90
end.
Unit1.pas代碼：
vIEw source
