1 | unit ButtonG;
|
---|
2 |
|
---|
3 | interface
|
---|
4 |
|
---|
5 | uses
|
---|
6 | Classes, SysUtils, LCLIntf, LCLType, ButtonBase, GraphicSet;
|
---|
7 |
|
---|
8 | type
|
---|
9 |
|
---|
10 | { TButtonG }
|
---|
11 |
|
---|
12 | TButtonG = class(TButtonBase)
|
---|
13 | private
|
---|
14 | FBackgroundDownName: string;
|
---|
15 | FBackgroundDownIndex: Integer;
|
---|
16 | FBackgroundUpName: string;
|
---|
17 | FBackgroundUpIndex: Integer;
|
---|
18 | FGlyphIndex: Integer;
|
---|
19 | FGlyphName: string;
|
---|
20 | FGraphicSet: TGraphicSet;
|
---|
21 | function GetGraphicSetItem(Index: Integer; Name: string): TGraphicSetItem;
|
---|
22 | procedure SetBackgroundDownIndex(AValue: Integer);
|
---|
23 | procedure SetBackgroundDownName(AValue: string);
|
---|
24 | procedure SetBackgroundUpIndex(AValue: Integer);
|
---|
25 | procedure SetBackgroundUpName(AValue: string);
|
---|
26 | procedure SetGlyphIndex(AValue: Integer);
|
---|
27 | procedure SetGlyphName(AValue: string);
|
---|
28 | procedure SetGraphicSet(AValue: TGraphicSet);
|
---|
29 | protected
|
---|
30 | procedure Paint; override;
|
---|
31 | procedure SetVisible(Value: Boolean); override;
|
---|
32 | public
|
---|
33 | constructor Create(AOwner: TComponent); override;
|
---|
34 | published
|
---|
35 | property GraphicSet: TGraphicSet read FGraphicSet write SetGraphicSet;
|
---|
36 | property BackgroundUpIndex: Integer read FBackgroundUpIndex write SetBackgroundUpIndex default -1;
|
---|
37 | property BackgroundUpName: string read FBackgroundUpName write SetBackgroundUpName;
|
---|
38 | property BackgroundDownIndex: Integer read FBackgroundDownIndex write SetBackgroundDownIndex default -1;
|
---|
39 | property BackgroundDownName: string read FBackgroundDownName write SetBackgroundDownName;
|
---|
40 | property GlyphIndex: Integer read FGlyphIndex write SetGlyphIndex default -1;
|
---|
41 | property GlyphName: string read FGlyphName write SetGlyphName;
|
---|
42 | property Visible;
|
---|
43 | property OnClick;
|
---|
44 | end;
|
---|
45 |
|
---|
46 | procedure Register;
|
---|
47 |
|
---|
48 |
|
---|
49 | implementation
|
---|
50 |
|
---|
51 | uses
|
---|
52 | ScreenTools;
|
---|
53 |
|
---|
54 | procedure Register;
|
---|
55 | begin
|
---|
56 | RegisterComponents('C-evo', [TButtonG]);
|
---|
57 | end;
|
---|
58 |
|
---|
59 | { TButtonG }
|
---|
60 |
|
---|
61 | procedure TButtonG.SetGraphicSet(AValue: TGraphicSet);
|
---|
62 | begin
|
---|
63 | if FGraphicSet = AValue then Exit;
|
---|
64 | FGraphicSet := AValue;
|
---|
65 | end;
|
---|
66 |
|
---|
67 | procedure TButtonG.Paint;
|
---|
68 | var
|
---|
69 | Back: TGraphicSetItem;
|
---|
70 | Glyph: TGraphicSetItem;
|
---|
71 | Drawn: Boolean;
|
---|
72 | begin
|
---|
73 | Drawn := False;
|
---|
74 | with Canvas do begin
|
---|
75 | if Assigned(FGraphicSet) then begin
|
---|
76 | if FDown then Back := GetGraphicSetItem(FBackgroundDownIndex, FBackgroundDownName)
|
---|
77 | else Back := GetGraphicSetItem(FBackgroundUpIndex, FBackgroundUpName);
|
---|
78 | if Assigned(Back) then begin
|
---|
79 | BitBltCanvas(Canvas, 0, 0, Back.Width, Back.Height, FGraphic.Canvas, Back.Left,
|
---|
80 | Back.Top);
|
---|
81 | Drawn := True;
|
---|
82 | end;
|
---|
83 | Glyph := GetGraphicSetItem(FGlyphIndex, FGlyphName);
|
---|
84 | if Assigned(Glyph) then begin
|
---|
85 | BitBltCanvas(Canvas, 0, 0, Glyph.Width, Glyph.Height, FGraphic.Canvas, Glyph.Left,
|
---|
86 | Glyph.Top, SRCAND);
|
---|
87 | BitBltCanvas(Canvas, 0, 0, Glyph.Width, Glyph.Height, FGraphic.Canvas, Glyph.Left,
|
---|
88 | Glyph.Top, SRCPAINT);
|
---|
89 | Drawn := True;
|
---|
90 | end;
|
---|
91 | end;
|
---|
92 | if not Drawn then begin
|
---|
93 | Brush.Color := $0000FF;
|
---|
94 | FrameRect(Rect(0, 0, Width - 1, Height - 1));
|
---|
95 | end;
|
---|
96 | end;
|
---|
97 | end;
|
---|
98 |
|
---|
99 | procedure TButtonG.SetVisible(Value: Boolean);
|
---|
100 | begin
|
---|
101 | inherited SetVisible(Value);
|
---|
102 | end;
|
---|
103 |
|
---|
104 | constructor TButtonG.Create(AOwner: TComponent);
|
---|
105 | begin
|
---|
106 | inherited;
|
---|
107 | FBackgroundUpIndex := -1;
|
---|
108 | FBackgroundDownIndex := -1;
|
---|
109 | FGlyphIndex := -1;
|
---|
110 | end;
|
---|
111 |
|
---|
112 | function TButtonG.GetGraphicSetItem(Index: Integer; Name: string): TGraphicSetItem;
|
---|
113 | begin
|
---|
114 | Result := nil;
|
---|
115 | if Assigned(FGraphicSet) then begin
|
---|
116 | if (Index <> -1) and (Index < FGraphicSet.Items.Count) then
|
---|
117 | Result := FGraphicSet.Items[Index]
|
---|
118 | else if (Name <> '') then
|
---|
119 | Result := FGraphicSet.Items.SearchByName(Name);
|
---|
120 | end;
|
---|
121 | end;
|
---|
122 |
|
---|
123 | procedure TButtonG.SetBackgroundDownIndex(AValue: Integer);
|
---|
124 | begin
|
---|
125 | if FBackgroundDownIndex = AValue then Exit;
|
---|
126 | FBackgroundDownIndex := AValue;
|
---|
127 | FBackgroundDownName := '';
|
---|
128 | end;
|
---|
129 |
|
---|
130 | procedure TButtonG.SetBackgroundDownName(AValue: string);
|
---|
131 | begin
|
---|
132 | if FBackgroundDownName = AValue then Exit;
|
---|
133 | FBackgroundDownName := AValue;
|
---|
134 | FBackgroundDownIndex := -1;
|
---|
135 | end;
|
---|
136 |
|
---|
137 | procedure TButtonG.SetBackgroundUpIndex(AValue: Integer);
|
---|
138 | begin
|
---|
139 | if FBackgroundUpIndex = AValue then Exit;
|
---|
140 | FBackgroundUpIndex := AValue;
|
---|
141 | FBackgroundUpName := '';
|
---|
142 | end;
|
---|
143 |
|
---|
144 | procedure TButtonG.SetBackgroundUpName(AValue: string);
|
---|
145 | begin
|
---|
146 | if FBackgroundUpName = AValue then Exit;
|
---|
147 | FBackgroundUpName := AValue;
|
---|
148 | FBackgroundUpIndex := -1;
|
---|
149 | end;
|
---|
150 |
|
---|
151 | procedure TButtonG.SetGlyphIndex(AValue: Integer);
|
---|
152 | begin
|
---|
153 | if FGlyphIndex = AValue then Exit;
|
---|
154 | FGlyphIndex := AValue;
|
---|
155 | FGlyphName := '';
|
---|
156 | end;
|
---|
157 |
|
---|
158 | procedure TButtonG.SetGlyphName(AValue: string);
|
---|
159 | begin
|
---|
160 | if FGlyphName = AValue then Exit;
|
---|
161 | FGlyphName := AValue;
|
---|
162 | FGlyphIndex := -1;
|
---|
163 | end;
|
---|
164 |
|
---|
165 | end.
|
---|
166 |
|
---|