source: trunk/Packages/bgracontrols/testbuttoneditor/umain.pas

Last change on this file was 2, checked in by chronos, 5 years ago
File size: 14.1 KB
Line 
1unit umain;
2
3{$mode objfpc}{$H+}
4
5interface
6
7uses
8 Forms, Graphics, Dialogs, Spin, StdCtrls, ExtCtrls,
9 BGRAVirtualScreen, BGRAGraphicControl, BGRABitmap, BGRASamples,
10 BGRABitmapTypes, BGRATextFX, FileUtil, IniFiles, SysUtils;
11
12type
13
14 { TfrmButtonEditor }
15
16 TfrmButtonEditor = class(TForm)
17 BorderGroup: TGroupBox;
18 borWidth: TFloatSpinEdit;
19 bs2: TComboBox;
20 bs3: TComboBox;
21 bs4: TComboBox;
22 btnColorAlpha: TSpinEdit;
23 btnFont: TButton;
24 btnHeight: TSpinEdit;
25 btnSave: TButton;
26 btnText: TEdit;
27 btnWidth: TSpinEdit;
28 btnSaveToINI: TButton;
29 btnLoadFromINI: TButton;
30 buttonGraphic: TBGRAGraphicControl;
31 btnColor: TColorButton;
32 GeneralGroup: TGroupBox;
33 LoadFromIni: TOpenDialog;
34 SaveToIni: TSaveDialog;
35 StyleGroup: TCheckGroup;
36 bs1: TComboBox;
37 gd1Horiz: TCheckBox;
38 gd2Horiz: TCheckBox;
39 gpHoriz: TCheckBox;
40 DirectionsGroup: TCheckGroup;
41 cl1: TColorButton;
42 cl1a: TSpinEdit;
43 cl2: TColorButton;
44 cl2a: TSpinEdit;
45 cl3: TColorButton;
46 cl3a: TSpinEdit;
47 cl4: TColorButton;
48 cl4a: TSpinEdit;
49 GradientsGroup: TGroupBox;
50 gradValue: TFloatSpinEdit;
51 innerAlpha: TSpinEdit;
52 innerColor: TColorButton;
53 outAlpha: TSpinEdit;
54 outColor: TColorButton;
55 roundHoriz: TFloatSpinEdit;
56 roundVert: TFloatSpinEdit;
57 SaveBitmap: TSaveDialog;
58 ScrollArea: TScrollBox;
59 ScrollBoxMain: TScrollBox;
60 ShadowGroup: TGroupBox;
61 shdColor: TColorButton;
62 shdColorAlpha: TSpinEdit;
63 shdHoriz: TSpinEdit;
64 shdRadius: TSpinEdit;
65 shdVert: TSpinEdit;
66 SplitterNice: TSplitter;
67 TextGroup: TGroupBox;
68 ButtonFont: TFontDialog;
69 tileBackgroundValue: TSpinEdit;
70 vsTileBackground: TBGRAVirtualScreen;
71 procedure btnFontClick(Sender: TObject);
72 procedure btnLoadFromINIClick(Sender: TObject);
73 procedure btnSaveClick(Sender: TObject);
74 procedure btnSaveToINIClick(Sender: TObject);
75 procedure buttonGraphicRedraw(Sender: TObject; Bitmap: TBGRABitmap);
76 procedure vsTileBackgroundRedraw(Sender: TObject; Bitmap: TBGRABitmap);
77 procedure tileBackgroundValueChange(Sender: TObject);
78 procedure UpdateButton(Sender: TObject);
79 private
80 { private declarations }
81 public
82 { public declarations }
83 end;
84
85var
86 frmButtonEditor: TfrmButtonEditor;
87
88function BGRAToStrRGBA(AColor: TBGRAPixel): string;
89
90implementation
91
92{$R *.lfm}
93
94function BGRAToStrRGBA(AColor: TBGRAPixel): string;
95begin
96 Result := 'rgba(' + IntToStr(AColor.red) + ',' + IntToStr(AColor.green) +
97 ',' + IntToStr(AColor.blue) + ',' + IntToStr(AColor.alpha) + ')';
98end;
99
100{ TfrmButtonEditor }
101
102procedure TfrmButtonEditor.buttonGraphicRedraw(Sender: TObject; Bitmap: TBGRABitmap);
103var
104 shadow: TBGRACustomBitmap;
105 gd1, gd2, gd3: TGradientDirection;
106 tl, tr, br, bl: TRoundRectangleOptions;
107 rh, rv: double;
108begin
109 tl := [];
110 tr := [];
111 br := [];
112 bl := [];
113
114 { Bevel Border }
115 if bs1.ItemIndex = 1 then
116 tl := [rrTopLeftBevel]
117 else if bs1.ItemIndex = 2 then
118 tl := [rrTopLeftSquare]
119 else
120 tl := [];
121
122 if bs2.ItemIndex = 1 then
123 tr := [rrTopRightBevel]
124 else if bs2.ItemIndex = 2 then
125 tr := [rrTopRightSquare]
126 else
127 tr := [];
128
129 if bs4.ItemIndex = 1 then
130 br := [rrBottomRightBevel]
131 else if bs4.ItemIndex = 2 then
132 br := [rrBottomRightSquare]
133 else
134 br := [];
135
136 if bs3.ItemIndex = 1 then
137 bl := [rrBottomLeftBevel]
138 else if bs3.ItemIndex = 2 then
139 bl := [rrBottomLeftSquare]
140 else
141 bl := [];
142
143 { Set Bevel square if round is zero }
144 if (roundHoriz.Value = 0) or (roundVert.Value = 0) then
145 begin
146 br := [rrTopLeftSquare, rrTopRightSquare, rrBottomLeftSquare, rrBottomRightSquare];
147 rh := 1;
148 rv := 1;
149 end
150 else
151 begin
152 rh := roundHoriz.Value;
153 rv := roundVert.Value;
154 end;
155
156 { Gradient Directions }
157 if gd1Horiz.Checked then
158 gd1 := gdHorizontal
159 else
160 gd1 := gdVertical;
161
162 if gd2Horiz.Checked then
163 gd2 := gdHorizontal
164 else
165 gd2 := gdVertical;
166
167 if gpHoriz.Checked then
168 gd3 := gdHorizontal
169 else
170 gd3 := gdVertical;
171
172 // clear
173 bitmap.FillTransparent;
174
175 { Button }
176 DrawButton(bitmap, ColorToBGRA(cl1.ButtonColor, cl1a.Value),
177 ColorToBGRA(cl2.ButtonColor, cl2a.Value),
178 ColorToBGRA(cl3.ButtonColor, cl3a.Value),
179 ColorToBGRA(cl4.ButtonColor, cl4a.Value),
180 ColorToBGRA(outColor.ButtonColor, outAlpha.Value),
181 ColorToBGRA(innerColor.ButtonColor, innerAlpha.Value),
182 rh, rv,
183 borWidth.Value, gradValue.Value,
184 gd1, gd2, gd3, tl + tr + br + bl);
185
186 { Text }
187 shadow := TextShadow(buttonGraphic.Width, buttonGraphic.Height,
188 btnText.Text, ButtonFont.Font.Height, ColorToBGRA(btnColor.ButtonColor,
189 btnColorAlpha.Value), ColorToBGRA(shdColor.ButtonColor, shdColorAlpha.Value),
190 shdHoriz.Value, shdVert.Value, shdRadius.Value, ButtonFont.Font.Style,
191 ButtonFont.Font.Name, True, fqFineAntialiasing);
192
193 // draw text and free
194 bitmap.PutImage(0, 0, shadow, dmDrawWithTransparency);
195 shadow.Free;
196end;
197
198procedure TfrmButtonEditor.btnSaveClick(Sender: TObject);
199begin
200 if SaveBitmap.Execute then
201 begin
202 buttonGraphic.Bitmap.SaveToFile(SaveBitmap.FileName);
203 if FileExistsUTF8(SaveBitmap.FileName) then
204 ShowMessage('Saved! ' + SaveBitmap.FileName)
205 else
206 ShowMessage('Error. File not found.');
207 end;
208end;
209
210procedure TfrmButtonEditor.btnLoadFromINIClick(Sender: TObject);
211
212 function BGRAToStrRGBA(AColor: TBGRAPixel): string;
213 begin
214 Result := 'rgba(' + IntToStr(AColor.red) + ',' + IntToStr(AColor.green) +
215 ',' + IntToStr(AColor.blue) + ',' + IntToStr(AColor.alpha) + ')';
216 end;
217
218var
219 temp: TMemIniFile;
220 tempColor: TBGRAPixel;
221begin
222 if LoadFromIni.Execute then
223 begin
224 { Create }
225 temp := TMemIniFile.Create(LoadFromIni.FileName);
226 { General }
227 btnWidth.Value := temp.ReadInteger('General', 'Width', btnWidth.Value);
228 btnHeight.Value := temp.ReadInteger('General', 'Heigh', btnHeight.Value);
229 { Gradients }
230 tempColor := StrToBGRA(temp.ReadString('Gradients', 'Color1',
231 BGRAToStrRGBA(ColorToBGRA(cl1.ButtonColor, cl1a.Value))));
232 cl1.ButtonColor := BGRAToColor(tempColor);
233 cl1a.Value := tempColor.alpha;
234 tempColor := StrToBGRA(temp.ReadString('Gradients', 'Color2',
235 BGRAToStrRGBA(ColorToBGRA(cl2.ButtonColor, cl2a.Value))));
236 cl2.ButtonColor := BGRAToColor(tempColor);
237 cl2a.Value := tempColor.alpha;
238 tempColor := StrToBGRA(temp.ReadString('Gradients', 'Color3',
239 BGRAToStrRGBA(ColorToBGRA(cl3.ButtonColor, cl3a.Value))));
240 cl3.ButtonColor := BGRAToColor(tempColor);
241 cl3a.Value := tempColor.alpha;
242 tempColor := StrToBGRA(temp.ReadString('Gradients', 'Color4',
243 BGRAToStrRGBA(ColorToBGRA(cl4.ButtonColor, cl4a.Value))));
244 cl4.ButtonColor := BGRAToColor(tempColor);
245 cl4a.Value := tempColor.alpha;
246 gradValue.Value := temp.ReadFloat('Gradients', 'Position', gradValue.Value);
247 { Text }
248 btnText.Text := temp.ReadString('Text', 'ButtonText', btnText.Text);
249 ButtonFont.Font.Name := temp.ReadString('Text', 'FontName', ButtonFont.Font.Name);
250 ButtonFont.Font.Height := temp.ReadInteger('Text', 'FontHeight',
251 ButtonFont.Font.Height);
252 tempColor := StrToBGRA(temp.ReadString('Text', 'FontColor',
253 BGRAToStrRGBA(ColorToBGRA(btnColor.ButtonColor, btnColorAlpha.Value))));
254 btnColor.ButtonColor := BGRAToColor(tempColor);
255 btnColorAlpha.Value := tempColor.alpha;
256 // bold
257 if temp.ReadBool('Text', 'FontBold', False) then
258 ButtonFont.Font.Style := ButtonFont.Font.Style + [fsBold]
259 else
260 ButtonFont.Font.Style := ButtonFont.Font.Style - [fsBold];
261 // italic
262 if temp.ReadBool('Text', 'FontItalic', False) then
263 ButtonFont.Font.Style := ButtonFont.Font.Style + [fsItalic]
264 else
265 ButtonFont.Font.Style := ButtonFont.Font.Style - [fsItalic];
266 // strikeout
267 if temp.ReadBool('Text', 'FontStrikeOut', False) then
268 ButtonFont.Font.Style := ButtonFont.Font.Style + [fsStrikeOut]
269 else
270 ButtonFont.Font.Style := ButtonFont.Font.Style - [fsStrikeOut];
271 // underline
272 if temp.ReadBool('Text', 'FontUnderline', False) then
273 ButtonFont.Font.Style := ButtonFont.Font.Style + [fsUnderline]
274 else
275 ButtonFont.Font.Style := ButtonFont.Font.Style - [fsUnderline];
276
277 { Shadow }
278 tempColor := StrToBGRA(temp.ReadString('Shadow', 'Color',
279 BGRAToStrRGBA(ColorToBGRA(shdColor.ButtonColor, shdColorAlpha.Value))));
280 shdColor.ButtonColor := BGRAToColor(tempColor);
281 shdColorAlpha.Value := tempColor.alpha;
282 shdHoriz.Value := temp.ReadInteger('Shadow', 'HorizontalOffset', shdHoriz.Value);
283 shdVert.Value := temp.ReadInteger('Shadow', 'VerticalOffset', shdVert.Value);
284 shdRadius.Value := temp.ReadInteger('Shadow', 'Radius', shdRadius.Value);
285 { Direction }
286 gd1Horiz.Checked := temp.ReadBool('Direction', '1Horizontal', gd1Horiz.Checked);
287 gd2Horiz.Checked := temp.ReadBool('Direction', '2Horizontal', gd2Horiz.Checked);
288 gpHoriz.Checked := temp.ReadBool('Direction', 'Horizontal', gpHoriz.Checked);
289 { Border }
290 tempColor := StrToBGRA(temp.ReadString('Border', 'OutColor',
291 BGRAToStrRGBA(ColorToBGRA(outColor.ButtonColor, outAlpha.Value))));
292 outColor.ButtonColor := BGRAToColor(tempColor);
293 outAlpha.Value := tempColor.alpha;
294 tempColor := StrToBGRA(temp.ReadString('Border', 'InnerColor',
295 BGRAToStrRGBA(ColorToBGRA(innerColor.ButtonColor, innerAlpha.Value))));
296 innerColor.ButtonColor := BGRAToColor(tempColor);
297 innerAlpha.Value := tempColor.alpha;
298 roundHoriz.Value := temp.ReadFloat('Border', 'RoundHorizontal', roundHoriz.Value);
299 roundVert.Value := temp.ReadFloat('Border', 'RoundVertical', roundVert.Value);
300 borWidth.Value := temp.ReadFloat('Border', 'BorderWidth', borWidth.Value);
301 { Border Style }
302 bs1.ItemIndex := temp.ReadInteger('BorderStyle', 'TopLeft', bs1.ItemIndex);
303 bs2.ItemIndex := temp.ReadInteger('BorderStyle', 'TopRight', bs2.ItemIndex);
304 bs3.ItemIndex := temp.ReadInteger('BorderStyle', 'BottomLeft', bs3.ItemIndex);
305 bs4.ItemIndex := temp.ReadInteger('BorderStyle', 'BottomRight', bs4.ItemIndex);
306 { Redraw }
307 buttonGraphic.RedrawBitmap;
308 { Free }
309 temp.Free;
310 end;
311end;
312
313procedure TfrmButtonEditor.btnFontClick(Sender: TObject);
314begin
315 ButtonFont.Font.Color := btnColor.ButtonColor;
316 if ButtonFont.Execute then
317 buttonGraphic.RedrawBitmap;
318end;
319
320procedure TfrmButtonEditor.btnSaveToINIClick(Sender: TObject);
321var
322 temp: TMemIniFile;
323begin
324 if SaveToIni.Execute then
325 begin
326 { Create }
327 temp := TMemIniFile.Create(SaveToIni.FileName);
328 { General }
329 temp.WriteInteger('General', 'Width', btnWidth.Value);
330 temp.WriteInteger('General', 'Heigh', btnHeight.Value);
331 { Gradients }
332 temp.WriteString('Gradients', 'Color1',
333 BGRAToStrRGBA(ColorToBGRA(cl1.ButtonColor, cl1a.Value)));
334 temp.WriteString('Gradients', 'Color2',
335 BGRAToStrRGBA(ColorToBGRA(cl2.ButtonColor, cl2a.Value)));
336 temp.WriteString('Gradients', 'Color3',
337 BGRAToStrRGBA(ColorToBGRA(cl3.ButtonColor, cl3a.Value)));
338 temp.WriteString('Gradients', 'Color4',
339 BGRAToStrRGBA(ColorToBGRA(cl4.ButtonColor, cl4a.Value)));
340 temp.WriteFloat('Gradients', 'Position', gradValue.Value);
341 { Text }
342 temp.WriteString('Text', 'ButtonText', btnText.Text);
343 temp.WriteString('Text', 'FontName', ButtonFont.Font.Name);
344 temp.WriteInteger('Text', 'FontHeight', ButtonFont.Font.Height);
345 temp.WriteString('Text', 'FontColor',
346 BGRAToStrRGBA(ColorToBGRA(btnColor.ButtonColor, btnColorAlpha.Value)));
347 // bold
348 if fsBold in ButtonFont.Font.Style then
349 temp.WriteBool('Text', 'FontBold', True)
350 else
351 temp.WriteBool('Text', 'FontBold', False);
352 // italic
353 if fsItalic in ButtonFont.Font.Style then
354 temp.WriteBool('Text', 'FontItalic', True)
355 else
356 temp.WriteBool('Text', 'FontItalic', False);
357 // strikeout
358 if fsStrikeOut in ButtonFont.Font.Style then
359 temp.WriteBool('Text', 'FontStrikeOut', True)
360 else
361 temp.WriteBool('Text', 'FontStrikeOut', False);
362 // underline
363 if fsUnderline in ButtonFont.Font.Style then
364 temp.WriteBool('Text', 'FontUnderline', True)
365 else
366 temp.WriteBool('Text', 'FontUnderline', False);
367 { Shadow }
368 temp.WriteString('Shadow', 'Color',
369 BGRAToStrRGBA(ColorToBGRA(shdColor.ButtonColor, shdColorAlpha.Value)));
370 temp.WriteInteger('Shadow', 'HorizontalOffset', shdHoriz.Value);
371 temp.WriteInteger('Shadow', 'VerticalOffset', shdVert.Value);
372 temp.WriteInteger('Shadow', 'Radius', shdRadius.Value);
373 { Direction }
374 temp.WriteBool('Direction', '1Horizontal', gd1Horiz.Checked);
375 temp.WriteBool('Direction', '2Horizontal', gd2Horiz.Checked);
376 temp.WriteBool('Direction', 'Horizontal', gpHoriz.Checked);
377 { Border }
378 temp.WriteString('Border', 'OutColor',
379 BGRAToStrRGBA(ColorToBGRA(outColor.ButtonColor, outAlpha.Value)));
380 temp.WriteString('Border', 'InnerColor',
381 BGRAToStrRGBA(ColorToBGRA(innerColor.ButtonColor, innerAlpha.Value)));
382 temp.WriteFloat('Border', 'RoundHorizontal', roundHoriz.Value);
383 temp.WriteFloat('Border', 'RoundVertical', roundVert.Value);
384 temp.WriteFloat('Border', 'BorderWidth', borWidth.Value);
385 { Border Style }
386 temp.WriteInteger('BorderStyle', 'TopLeft', bs1.ItemIndex);
387 temp.WriteInteger('BorderStyle', 'TopRight', bs2.ItemIndex);
388 temp.WriteInteger('BorderStyle', 'BottomLeft', bs3.ItemIndex);
389 temp.WriteInteger('BorderStyle', 'BottomRight', bs4.ItemIndex);
390 { Save and Free}
391 temp.UpdateFile;
392 temp.Free;
393 end;
394end;
395
396procedure TfrmButtonEditor.vsTileBackgroundRedraw(Sender: TObject; Bitmap: TBGRABitmap);
397
398 procedure DrawTileBackground(ABitmap: TBGRABitmap; Multiply: integer);
399 var
400 temp: TBGRABitmap;
401 begin
402 temp := TBGRABitmap.Create(2, 2, BGRAWhite);
403 temp.SetPixel(0, 0, clSilver);
404 temp.SetPixel(1, 1, clSilver);
405 BGRAReplace(temp, temp.Resample(2 * Multiply, 2 * Multiply, rmSimpleStretch));
406 ABitmap.Fill(temp, dmSet);
407 temp.Free;
408 end;
409
410begin
411 DrawTileBackground(bitmap, tileBackgroundValue.Value);
412end;
413
414procedure TfrmButtonEditor.tileBackgroundValueChange(Sender: TObject);
415begin
416 vsTileBackground.RedrawBitmap;
417end;
418
419procedure TfrmButtonEditor.UpdateButton(Sender: TObject);
420begin
421 buttonGraphic.Width := btnWidth.Value;
422 buttonGraphic.Height := btnHeight.Value;
423 buttonGraphic.RedrawBitmap;
424end;
425
426end.
427
Note: See TracBrowser for help on using the repository browser.