1 unit BGRADrawerFlashProgressBar;
2 
3 {$mode objfpc}{$H+}
4 
5 interface
6 
7 uses
8   Classes, {$IFDEF BGRABITMAP_USE_MSEGUI} mclasses, {$ENDIF} SysUtils, Types, BGRABitmap, BGRABitmapTypes, BGRAGraphics, BGRAGradients,
9   Math;
10 
11 type
12 
13   TBGRAProgressBarRedrawEvent = procedure(Sender: TObject; Bitmap: TBGRABitmap; xpos: integer) of object;
14 
15   { TBGRADrawerFlashProgressBar }
16 
17   TBGRADrawerFlashProgressBar = class(TPersistent)
18   private
19     FBackgroundColor: TColor;
20     FBackgroundRandomize: boolean;
21     FBackgroundRandomizeMaxIntensity: word;
22     FBackgroundRandomizeMinIntensity: word;
23     FBarColor: TColor;
24     FMaxValue: integer;
25     FMinValue: integer;
26     FOnChange: TNotifyEvent;
27     FRandSeed: integer;
28     FValue: integer;
29     xpos: integer;
30     procedure SetBackgroundRandomize(AValue: boolean);
31     procedure SetBackgroundRandomizeMaxIntensity(AValue: word);
32     procedure SetBackgroundRandomizeMinIntensity(AValue: word);
33     procedure SetBarColor(AValue: TColor);
34     procedure SetBackgroundColor(AValue: TColor);
35     procedure SetMaxValue(AValue: integer);
36     procedure SetMinValue(AValue: integer);
37     procedure SetRandSeed(AValue: integer);
38     procedure SetValue(AValue: integer);
39   public
40     procedure Draw(ABitmap: TBGRABitmap);
41   public
42     property OnChange: TNotifyEvent read FOnChange write FOnChange;
43     property RandSeed: integer read FRandSeed write SetRandSeed;
44     property BarColor: TColor read FBarColor write SetBarColor;
45     property BackgroundColor: TColor read FBackgroundColor write SetBackgroundColor;
46     property BackgroundRandomizeMinIntensity: word
47       read FBackgroundRandomizeMinIntensity write SetBackgroundRandomizeMinIntensity;
48     property BackgroundRandomizeMaxIntensity: word
49       read FBackgroundRandomizeMaxIntensity write SetBackgroundRandomizeMaxIntensity;
50     property BackgroundRandomize: boolean read FBackgroundRandomize
51       write SetBackgroundRandomize;
52     property XPosition: integer read xpos;
53   public
54     property MinValue: integer read FMinValue write SetMinValue;
55     property MaxValue: integer read FMaxValue write SetMaxValue;
56     property Value: integer read FValue write SetValue;
57   end;
58 
59 implementation
60 
61 { TBGRADrawerFlashProgressBar }
62 
63 procedure TBGRADrawerFlashProgressBar.SetBarColor(AValue: TColor);
64 begin
65   if FBarColor = AValue then
66     Exit;
67   FBarColor := AValue;
68   if Assigned(FOnChange) then
69     FOnChange(Self);
70   if Assigned(FOnChange) then
71     FOnChange(Self);
72 end;
73 
74 procedure TBGRADrawerFlashProgressBar.SetBackgroundRandomize(AValue: boolean);
75 begin
76   if FBackgroundRandomize = AValue then
77     Exit;
78   FBackgroundRandomize := AValue;
79   if Assigned(FOnChange) then
80     FOnChange(Self);
81 end;
82 
83 procedure TBGRADrawerFlashProgressBar.SetBackgroundRandomizeMaxIntensity(AValue: word);
84 begin
85   if FBackgroundRandomizeMaxIntensity = AValue then
86     Exit;
87   FBackgroundRandomizeMaxIntensity := AValue;
88   if Assigned(FOnChange) then
89     FOnChange(Self);
90 end;
91 
92 procedure TBGRADrawerFlashProgressBar.SetBackgroundRandomizeMinIntensity(AValue: word);
93 begin
94   if FBackgroundRandomizeMinIntensity = AValue then
95     Exit;
96   FBackgroundRandomizeMinIntensity := AValue;
97   if Assigned(FOnChange) then
98     FOnChange(Self);
99 end;
100 
101 procedure TBGRADrawerFlashProgressBar.SetBackgroundColor(AValue: TColor);
102 begin
103   if FBackgroundColor = AValue then
104     Exit;
105   FBackgroundColor := AValue;
106   if Assigned(FOnChange) then
107     FOnChange(Self);
108 end;
109 
110 procedure TBGRADrawerFlashProgressBar.SetMaxValue(AValue: integer);
111 begin
112   if FMaxValue = AValue then
113     exit;
114   FMaxValue := AValue;
115   if FValue > FMaxValue then
116     FValue := FMaxValue;
117   if FMinValue > FMaxValue then
118     FMinValue := FMaxValue;
119   if Assigned(FOnChange) then
120     FOnChange(Self);
121 end;
122 
123 procedure TBGRADrawerFlashProgressBar.SetMinValue(AValue: integer);
124 begin
125   if FMinValue = AValue then
126     exit;
127   FMinValue := AValue;
128   if FValue < FMinValue then
129     FValue := FMinValue;
130   if FMaxValue < FMinValue then
131     FMaxValue := FMinValue;
132   if Assigned(FOnChange) then
133     FOnChange(Self);
134 end;
135 
136 procedure TBGRADrawerFlashProgressBar.SetRandSeed(AValue: integer);
137 begin
138   if FRandSeed = AValue then
139     Exit;
140   FRandSeed := AValue;
141 end;
142 
143 procedure TBGRADrawerFlashProgressBar.SetValue(AValue: integer);
144 begin
145   if FValue = AValue then
146     exit;
147   FValue := AValue;
148   if FValue < FMinValue then
149     FValue := FMinValue;
150   if FValue > FMaxValue then
151     FValue := FMaxValue;
152   if Assigned(FOnChange) then
153     FOnChange(Self);
154 end;
155 
156 procedure TBGRADrawerFlashProgressBar.Draw(ABitmap: TBGRABitmap);
157 var
158   content: TRect;
159   y, tx, ty: integer;
160   bgColor: TBGRAPixel;
161 
ApplyLightnessnull162   function ApplyLightness(c: TBGRAPixel; lightness: word): TBGRAPixel;
163   begin
164     Result := GammaCompression(SetLightness(GammaExpansion(c), lightness));
165   end;
166 
167   procedure DrawBar(bounds: TRect);
168   var
169     lCol: TBGRAPixel;
170   begin
171     lCol := BarColor;
172 
173     DoubleGradientAlphaFill(ABitmap, bounds,
174       ApplyLightness(lCol, 37000), ApplyLightness(lCol, 29000),
175       ApplyLightness(lCol, 26000), ApplyLightness(lCol, 18000),
176       gdVertical, gdVertical, gdVertical, 0.53);
177 
178     InflateRect(bounds, -1, -1);
179 
180     DoubleGradientAlphaFill(ABitmap, bounds,
181       ApplyLightness(lCol, 28000), ApplyLightness(lCol, 22000),
182       ApplyLightness(lCol, 19000), ApplyLightness(lCol, 11000),
183       gdVertical, gdVertical, gdVertical, 0.53);
184   end;
185 
186 begin
187   ABitmap.FillTransparent;
188   tx := ABitmap.Width;
189   ty := ABitmap.Height;
190 
191   ABitmap.Rectangle(0, 0, tx, ty, BGRA(255, 255, 255, 6), BackgroundColor, dmSet);
192   if (tx > 2) and (ty > 2) then
193     ABitmap.Rectangle(1, 1, tx - 1, ty - 1, BGRA(29, 29, 29), dmSet);
194 
195   if (tx > 4) and (ty > 4) then
196   begin
197     content  := Rect(2, 2, tx - 2, ty - 2);
198     randseed := FRandSeed;
199     if BackgroundRandomize then
200     for y := content.Top to content.Bottom - 1 do
201     begin
202       bgColor := BackgroundColor;
203       bgColor.Intensity := RandomRange(BackgroundRandomizeMinIntensity, BackgroundRandomizeMaxIntensity);
204       ABitmap.HorizLine(content.Left, y, content.Right - 1, bgColor, dmSet);
205     end;
206     if tx >= 6 then
207       ABitmap.DrawVertLine(content.Right - 1, content.Top, content.Bottom - 1,
208         BGRA(0, 0, 0, 32));
209     if FMaxValue > FMinValue then
210     begin
211       xpos := round((FValue - FMinValue) / (FMaxValue - FMinValue) *
212         (content.right - content.left)) + content.left;
213       if xpos > content.left then
214       begin
215         DrawBar(rect(content.left, content.top, xpos, content.bottom));
216         if xpos < content.right then
217         begin
218           ABitmap.SetPixel(xpos, content.top, BGRA(62, 62, 62));
219           ABitmap.SetVertLine(xpos, content.top + 1, content.bottom - 1, BGRA(40, 40, 40));
220         end;
221       end;
222     end;
223   end;
224 end;
225 
226 end.
227