1 // SPDX-License-Identifier: LGPL-3.0-only (modified to allow linking)
2 {
3 Created by BGRA Controls Team
4 Dibo, Circular, lainz (007) and contributors.
5 For detailed information see readme.txt
6
7 Site: https://sourceforge.net/p/bgra-controls/
8 Wiki: http://wiki.lazarus.freepascal.org/BGRAControls
9 Forum: http://forum.lazarus.freepascal.org/index.php/board,46.0.html
10 }
11 {******************************* CONTRIBUTOR(S) ******************************
12 - Edivando S. Santos Brasil | mailedivando@gmail.com
13 (Compatibility with delphi VCL 11/2018)
14
15 ***************************** END CONTRIBUTOR(S) *****************************}
16 unit BGRAFlashProgressBar;
17
18 {$I bgracontrols.inc}
19
20 interface
21
22 uses
23 Classes, SysUtils, {$IFDEF FPC}LResources, LMessages,{$ENDIF} Forms, Controls, Graphics,
24 {$IFNDEF FPC}Messages, Windows, BGRAGraphics, GraphType, FPImage, {$ENDIF}
25 BCBaseCtrls, Dialogs, BGRABitmap, BGRADrawerFlashProgressBar;
26
27 type
28 { TBGRAFlashProgressBar }
29
30 TBGRAFlashProgressBar = class(TBGRAGraphicCtrl)
31 private
32 FBGRA: TBGRABitmap;
33 FDrawer: TBGRADrawerFlashProgressBar;
34 FOnRedraw: TBGRAProgressBarRedrawEvent;
GetBackgroundColornull35 function GetBackgroundColor: TColor;
GetBackgroundRandomizenull36 function GetBackgroundRandomize: boolean;
GetBackgroundRandomizeMaxIntensitynull37 function GetBackgroundRandomizeMaxIntensity: word;
GetBackgroundRandomizeMinIntensitynull38 function GetBackgroundRandomizeMinIntensity: word;
GetBarColornull39 function GetBarColor: TColor;
GetMaxValuenull40 function GetMaxValue: integer;
GetMinValuenull41 function GetMinValue: integer;
GetValuenull42 function GetValue: integer;
43 procedure OnChangeDrawer(Sender: TObject);
44 procedure SetBackgroundColor(AValue: TColor);
45 procedure SetBackgroundRandomize(AValue: boolean);
46 procedure SetBackgroundRandomizeMaxIntensity(AValue: word);
47 procedure SetBackgroundRandomizeMinIntensity(AValue: word);
48 procedure SetBarColor(AValue: TColor);
49 procedure SetMaxValue(const AValue: integer);
50 procedure SetMinValue(const AValue: integer);
51 procedure SetValue(const AValue: integer);
52 protected
53 procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer;
54 WithThemeSpace: boolean); override;
55 procedure WMEraseBkgnd(var Message: {$IFDEF FPC}TLMEraseBkgnd{$ELSE}TWMEraseBkgnd{$ENDIF}); message {$IFDEF FPC}LM_ERASEBKGND{$ELSE}WM_ERASEBKGND{$ENDIF};
56 procedure Paint; override;
57 public
58 constructor Create(AOwner: TComponent); override;
59 destructor Destroy; override;
60 public
61 { Streaming }
62 {$IFDEF FPC}
63 procedure SaveToFile(AFileName: string);
64 procedure LoadFromFile(AFileName: string);
65 procedure OnFindClass({%H-}Reader: TReader; const AClassName: string;
66 var ComponentClass: TComponentClass);
67 {$ENDIF}
68 published
69 property Align;
70 property Anchors;
71 property OnClick;
72 property OnMouseDown;
73 property OnMouseEnter;
74 property OnMouseLeave;
75 property OnMouseMove;
76 property OnMouseUp;
77 property OnMouseWheel;
78 property OnMouseWheelUp;
79 property OnMouseWheelDown;
80 property MinValue: integer Read GetMinValue Write SetMinValue;
81 property MaxValue: integer Read GetMaxValue Write SetMaxValue;
82 property Value: integer Read GetValue Write SetValue;
83 property Color; deprecated 'User BarColor instead';
84 property BarColor: TColor read GetBarColor write SetBarColor;
85 property BackgroundColor: TColor read GetBackgroundColor write SetBackgroundColor;
86 property BackgroundRandomizeMinIntensity: word read GetBackgroundRandomizeMinIntensity write SetBackgroundRandomizeMinIntensity;
87 property BackgroundRandomizeMaxIntensity: word read GetBackgroundRandomizeMaxIntensity write SetBackgroundRandomizeMaxIntensity;
88 property BackgroundRandomize: boolean read GetBackgroundRandomize write SetBackgroundRandomize;
89 property OnRedraw: TBGRAProgressBarRedrawEvent read FOnredraw write FOnRedraw;
90 end;
91
92 {$IFDEF FPC}procedure Register;{$ENDIF}
93
94 implementation
95
96 uses BGRABitmapTypes;
97
98 {$IFDEF FPC}
99 procedure Register;
100 begin
101 //{$I icons\bgraflashprogressbar_icon.lrs}
102 RegisterComponents('BGRA Controls', [TBGRAFlashProgressBar]);
103 end;
104 {$ENDIF}
105
106 procedure TBGRAFlashProgressBar.SetMinValue(const AValue: integer);
107 begin
108 FDrawer.MinValue := AValue;
109 end;
110
111 procedure TBGRAFlashProgressBar.SetValue(const AValue: integer);
112 begin
113 FDrawer.Value := AValue;
114 end;
115
116 {$hints off}
117 procedure TBGRAFlashProgressBar.CalculatePreferredSize(
118 var PreferredWidth, PreferredHeight: integer; WithThemeSpace: boolean);
119 begin
120 PreferredWidth := 379;
121 PreferredHeight := 33;
122 end;
123
124 {$hints on}
125
126 procedure TBGRAFlashProgressBar.Paint;
127 begin
128 if (ClientWidth <> FBGRA.Width) or (ClientHeight <> FBGRA.Height) then
129 FBGRA.SetSize(ClientWidth, ClientHeight);
130 FDrawer.Draw(FBGRA);
131 if Assigned(OnRedraw) then
132 OnRedraw(Self, FBGRA, {%H-}FDrawer.XPosition);
133 FBGRA.Draw(Canvas, 0, 0, False);
134 end;
135
136 {$hints off}
137 procedure TBGRAFlashProgressBar.WMEraseBkgnd(var Message: {$IFDEF FPC}TLMEraseBkgnd{$ELSE}TWMEraseBkgnd{$ENDIF});
138 begin
139 //do nothing
140 end;
141 {$hints on}
142
143 constructor TBGRAFlashProgressBar.Create(AOwner: TComponent);
144 begin
145 inherited Create(AOwner);
146
147 with GetControlClassDefaultSize do
148 SetInitialBounds(0, 0, CX, 33);
149
150 // Bitmap and Drawer
151 FBGRA := TBGRABitmap.Create(Width, Height);
152 FDrawer := TBGRADrawerFlashProgressBar.Create;
153 FDrawer.OnChange := OnChangeDrawer;
154 // Functionality
155 MinValue := 0;
156 MaxValue := 100;
157 Value := 30;
158 // Functionality and Style
159 Randomize;
160 FDrawer.RandSeed := RandSeed;
161 // Style
162 BarColor := BGRA(102, 163, 226);
163 BackgroundColor := BGRA(47,47,47);
164 BackgroundRandomize := True;
165 BackgroundRandomizeMinIntensity := 4000;
166 BackgroundRandomizeMaxIntensity := 5000;
167 end;
168
169 destructor TBGRAFlashProgressBar.Destroy;
170 begin
171 FreeAndNil(FBGRA);
172 FDrawer.Free;
173 inherited Destroy;
174 end;
175 {$IFDEF FPC}
176 procedure TBGRAFlashProgressBar.SaveToFile(AFileName: string);
177 var
178 AStream: TMemoryStream;
179 begin
180 AStream := TMemoryStream.Create;
181 try
182 WriteComponentAsTextToStream(AStream, Self);
183 AStream.SaveToFile(AFileName);
184 finally
185 AStream.Free;
186 end;
187 end;
188
189 procedure TBGRAFlashProgressBar.LoadFromFile(AFileName: string);
190 var
191 AStream: TMemoryStream;
192 begin
193 AStream := TMemoryStream.Create;
194 try
195 AStream.LoadFromFile(AFileName);
196 ReadComponentFromTextStream(AStream, TComponent(Self), OnFindClass);
197 finally
198 AStream.Free;
199 end;
200 end;
201
202 procedure TBGRAFlashProgressBar.OnFindClass(Reader: TReader;
203 const AClassName: string; var ComponentClass: TComponentClass);
204 begin
205 if CompareText(AClassName, 'TBGRAFlashProgressBar') = 0 then
206 ComponentClass := TBGRAFlashProgressBar;
207 end;
208 {$ENDIF}
209
210 procedure TBGRAFlashProgressBar.SetMaxValue(const AValue: integer);
211 begin
212 FDrawer.MaxValue := AValue;
213 end;
214
215 procedure TBGRAFlashProgressBar.OnChangeDrawer(Sender: TObject);
216 begin
217 Invalidate;
218 end;
219
GetBackgroundColornull220 function TBGRAFlashProgressBar.GetBackgroundColor: TColor;
221 begin
222 Result := FDrawer.BackgroundColor;
223 end;
224
GetBackgroundRandomizenull225 function TBGRAFlashProgressBar.GetBackgroundRandomize: boolean;
226 begin
227 Result := FDrawer.BackgroundRandomize;
228 end;
229
TBGRAFlashProgressBar.GetBackgroundRandomizeMaxIntensitynull230 function TBGRAFlashProgressBar.GetBackgroundRandomizeMaxIntensity: word;
231 begin
232 Result := FDrawer.BackgroundRandomizeMaxIntensity;
233 end;
234
GetBackgroundRandomizeMinIntensitynull235 function TBGRAFlashProgressBar.GetBackgroundRandomizeMinIntensity: word;
236 begin
237 Result := FDrawer.BackgroundRandomizeMinIntensity;
238 end;
239
GetBarColornull240 function TBGRAFlashProgressBar.GetBarColor: TColor;
241 begin
242 Result := FDrawer.BarColor;
243 end;
244
TBGRAFlashProgressBar.GetMaxValuenull245 function TBGRAFlashProgressBar.GetMaxValue: integer;
246 begin
247 Result := FDrawer.MaxValue;
248 end;
249
GetMinValuenull250 function TBGRAFlashProgressBar.GetMinValue: integer;
251 begin
252 Result := FDrawer.MinValue;
253 end;
254
TBGRAFlashProgressBar.GetValuenull255 function TBGRAFlashProgressBar.GetValue: integer;
256 begin
257 Result := FDrawer.Value;
258 end;
259
260 procedure TBGRAFlashProgressBar.SetBackgroundColor(AValue: TColor);
261 begin
262 FDrawer.BackgroundColor := AValue;
263 end;
264
265 procedure TBGRAFlashProgressBar.SetBackgroundRandomize(AValue: boolean);
266 begin
267 FDrawer.BackgroundRandomize := AValue;
268 end;
269
270 procedure TBGRAFlashProgressBar.SetBackgroundRandomizeMaxIntensity(AValue: word
271 );
272 begin
273 FDrawer.BackgroundRandomizeMaxIntensity := AValue;
274 end;
275
276 procedure TBGRAFlashProgressBar.SetBackgroundRandomizeMinIntensity(AValue: word
277 );
278 begin
279 FDrawer.BackgroundRandomizeMinIntensity := AValue;
280 end;
281
282 procedure TBGRAFlashProgressBar.SetBarColor(AValue: TColor);
283 begin
284 FDrawer.BarColor := AValue;
285 end;
286
287 end.
288