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