bgraflashprogressbar.pas 49 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506
  1. {
  2. Created by BGRA Controls Team
  3. Dibo, Circular, lainz (007) and contributors.
  4. For detailed information see readme.txt
  5. Site: https://sourceforge.net/p/bgra-controls/
  6. Wiki: http://wiki.lazarus.freepascal.org/BGRAControls
  7. Forum: http://forum.lazarus.freepascal.org/index.php/board,46.0.html
  8. }
  9. {******************************* CONTRIBUTOR(S) ******************************
  10. - Edivando S. Santos Brasil | [email protected]
  11. (Compatibility with delphi VCL 11/2018)
  12. - Massimo Magnano
  13. 2024-12 Added Marquee and MultiProgress Style
  14. Added Caption, CaptionShowPercent, CaptionShowPercentAlign, CaptionShowPercentDigits;
  15. Changed Values to Double Type;
  16. Deleted Unit BGRADrawerFlashProgressBar;
  17. New Test with all Features
  18. Added Timer Style
  19. 2025-01 Added Marquee Bounce and Stepit Method,
  20. TimerPlayPause works also for Marquee (useful for debugging)
  21. Added Graph Style and ShowDividers, Renamed MultiProgress properties
  22. Added ShowBarAnimation
  23. 2025-02 Added use of Font.Color
  24. 2025-03 Added MarqueeWidthType
  25. - Sandy Ganz ([email protected])
  26. 2025-07 Added Missing OnDblClick event property
  27. ***************************** END CONTRIBUTOR(S) *****************************}
  28. unit BGRAFlashProgressBar;
  29. {$I bgracontrols.inc}
  30. interface
  31. uses
  32. Classes, {$IFDEF BGRABITMAP_USE_MSEGUI} mclasses, {$ENDIF}
  33. SysUtils, Types, Forms, Controls, Graphics,
  34. {$IFDEF FPC} LResources, LMessages,
  35. {$ELSE} Messages, Windows, BGRAGraphics, GraphType, FPImage, {$ENDIF}
  36. BCBaseCtrls, BGRABitmap, BGRABitmapTypes, BGRAGraphics, BGRAGradients,
  37. Math, fptimer;
  38. type
  39. TBGRAPBarStyle = (pbstNormal, pbstMultiProgress, pbstMarquee, pbstTimer, pbstGraph);
  40. TBGRAPBarMarqueeWidthType = (pbmwAuto, pbmwFixed, pbmwValue, pbmwValueSub); //, pbmwInc MaxM: maybe tomorrow when I have free time
  41. TBGRAPBarMarqueeDirection = (pbmdToRight, pbmdToLeft);
  42. TBGRAPBarMarqueeSpeed = (pbmsSlow, pbmsMedium, pbmsFast);
  43. TBGRAProgressBarRedrawEvent = procedure(Sender: TObject; Bitmap: TBGRABitmap; xpos: integer) of object;
  44. { TBGRAFlashProgressBar }
  45. TGraphValue = record
  46. XValue, YValue: Double;
  47. end;
  48. TGraphValues = array of TGraphValue;
  49. TBGRAFlashProgressBar = class(TBGRAGraphicCtrl)
  50. private
  51. function GetMax: Integer;
  52. function GetMin: Integer;
  53. function GetPosition: Integer;
  54. procedure SetBackgroundRandomize(AValue: boolean);
  55. procedure SetBackgroundRandomizeMaxIntensity(AValue: word);
  56. procedure SetBackgroundRandomizeMinIntensity(AValue: word);
  57. procedure SetBarColor(AValue: TColor);
  58. procedure SetBackgroundColor(AValue: TColor);
  59. procedure SetBarColorSub(AValue: TColor);
  60. procedure SetCaptionPercentDigits(AValue: Integer);
  61. procedure SetCaptionPercentTimerFormat(AValue: String);
  62. procedure SetCaptionShowPercent(AValue: Boolean);
  63. procedure SetCaptionPercentAlign(AValue: TAlignment);
  64. procedure SetCaptionPercentSubAlign(AValue: TAlignment);
  65. procedure SetCaptionShowPercentSub(AValue: Boolean);
  66. procedure SetGraphShowYLine(AValue: Boolean);
  67. procedure SetGraphYLineAfter(AValue: String);
  68. procedure SetGraphYLineCaption(AValue: String);
  69. procedure SetGraphYLineDigits(AValue: Integer);
  70. procedure SetMarqueeWidthType(AValue: TBGRAPBarMarqueeWidthType);
  71. procedure SetMax(AValue: Integer);
  72. procedure SetMin(AValue: Integer);
  73. procedure SetPosition(AValue: Integer);
  74. procedure SetShowBarAnimation(AValue: Boolean);
  75. procedure SetShowDividers(AValue: Boolean);
  76. procedure SetMarqueeBounce(AValue: Word);
  77. procedure SetMarqueeDirection(AValue: TBGRAPBarMarqueeDirection);
  78. procedure SetMarqueeSpeed(AValue: TBGRAPBarMarqueeSpeed);
  79. procedure SetMarqueeWidth(AValue: Word);
  80. procedure SetMaxValue(AValue: Double);
  81. procedure SetMaxYValue(AValue: Double);
  82. procedure SetMinValue(AValue: Double);
  83. procedure SetMinYValue(AValue: Double);
  84. procedure SetRandSeed(AValue: integer);
  85. procedure SetGraphShowYDividers(AValue: Boolean);
  86. procedure SetStyle(AValue: TBGRAPBarStyle);
  87. procedure SetTimerInterval(AValue: Cardinal);
  88. procedure SetValueSub(AValue: Double);
  89. protected
  90. FBGRA: TBGRABitmap;
  91. FCaptionPercentDigits: Integer;
  92. FCaptionPercentTimerFormat: String;
  93. FCaptionShowPercent: Boolean;
  94. FCaptionPercentAlign: TAlignment;
  95. FCaptionPercentSubAlign: TAlignment;
  96. FCaptionShowPercentSub: Boolean;
  97. FMarqueeBounce: Word;
  98. FOnRedraw: TBGRAProgressBarRedrawEvent;
  99. FBackgroundColor: TColor;
  100. FBackgroundRandomize: boolean;
  101. FBackgroundRandomizeMaxIntensity: word;
  102. FBackgroundRandomizeMinIntensity: word;
  103. FShowDividers,
  104. FGraphShowYDividers: Boolean;
  105. FBarColor,
  106. FBarColorSub: TColor;
  107. FMarqueeWidthType: TBGRAPBarMarqueeWidthType;
  108. FMarqueeDirection: TBGRAPBarMarqueeDirection;
  109. FMarqueeSpeed: TBGRAPBarMarqueeSpeed;
  110. FMarqueeWidth,
  111. rMarqueeWidth: Word;
  112. FOnTimerTimer: TNotifyEvent;
  113. FTimerAutoRestart: Boolean;
  114. FOnTimerEnd: TNotifyEvent;
  115. FOnTimerStart: TNotifyEvent;
  116. FTimerInterval: Cardinal;
  117. FMaxValue,
  118. FMinValue,
  119. FMinYValue,
  120. FMaxYValue,
  121. FValue,
  122. FValueSub: Double;
  123. FOnChange: TNotifyEvent;
  124. FRandSeed: integer;
  125. FStyle: TBGRAPBarStyle;
  126. FGraphShowYLine: Boolean;
  127. FGraphYLineAfter: String;
  128. FGraphYLineCaption: String;
  129. FGraphYLineDigits: Integer;
  130. FShowBarAnimation: Boolean;
  131. xpos,
  132. xposSub,
  133. marqueeLeft,
  134. marqueeRight,
  135. marqueeCount,
  136. marqueeBCount,
  137. barAnimLeft: Integer;
  138. marqueeWall,
  139. marqueeBouncing: Boolean;
  140. marqueeCurMode: TBGRAPBarMarqueeDirection;
  141. internalTimer: TFPTimer;
  142. closing: Boolean;
  143. GraphValues: TGraphValues; //array of Real Graph Values
  144. GraphPoints: array of TPointF; //array of Calculated xpos and ypos
  145. class function GetControlClassDefaultSize: TSize; override;
  146. procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer; WithThemeSpace: boolean); override;
  147. procedure DoOnResize; override;
  148. procedure WMEraseBkgnd(var Message: {$IFDEF FPC}TLMEraseBkgnd{$ELSE}TWMEraseBkgnd{$ENDIF}); message {$IFDEF FPC}LM_ERASEBKGND{$ELSE}WM_ERASEBKGND{$ENDIF};
  149. procedure Paint; override;
  150. procedure Loaded; override;
  151. procedure TextChanged; override;
  152. procedure TimerOnTimer(Sender: TObject);
  153. procedure CalcMarqueeWidth;
  154. public
  155. constructor Create(AOwner: TComponent); override;
  156. destructor Destroy; override;
  157. { Streaming }
  158. {$IFDEF FPC}
  159. procedure SaveToFile(AFileName: string);
  160. procedure LoadFromFile(AFileName: string);
  161. procedure OnFindClass({%H-}Reader: TReader; const AClassName: string;
  162. var ComponentClass: TComponentClass);
  163. {$ENDIF}
  164. procedure Draw(ABitmap: TBGRABitmap);
  165. procedure SetValue(AValue: Double); overload;
  166. //Set Current Value and it's Y Value in Graph Style
  167. procedure SetValue(AValue, AYValue: Double); overload;
  168. //Step It, if Style is pbstNormal then Inc/Dec Value,
  169. // if pbstMarquee then do next Animation Step (AIncrement is ignored)
  170. // if pbstTimer then Value is decremented of 100ms (AIncrement is ignored)
  171. procedure StepIt(AIncrement: Double);
  172. //Timer Restart applies only if Style is pbstTimer
  173. procedure TimerReStart;
  174. //Timer Play/Pause applies only if Style is pbstMarquee or pbstTimer
  175. procedure TimerPlayPause;
  176. //For Compatibility with TProgressBar code
  177. property Position: Integer read GetPosition write SetPosition;
  178. property Min: Integer read GetMin write SetMin;
  179. property Max: Integer read GetMax write SetMax;
  180. property XPosition: integer read xpos;
  181. property XPositionSub: integer read xposSub;
  182. published
  183. property Align;
  184. property BorderSpacing;
  185. property Anchors;
  186. property Caption;
  187. property CaptionShowPercent: Boolean read FCaptionShowPercent write SetCaptionShowPercent default False;
  188. property CaptionPercentAlign: TAlignment read FCaptionPercentAlign write SetCaptionPercentAlign default taCenter;
  189. property CaptionShowPercentSub: Boolean read FCaptionShowPercentSub write SetCaptionShowPercentSub default False;
  190. property CaptionPercentSubAlign: TAlignment read FCaptionPercentSubAlign write SetCaptionPercentSubAlign default taLeftJustify;
  191. property CaptionPercentDigits: Integer read FCaptionPercentDigits write SetCaptionPercentDigits default 0;
  192. property CaptionPercentTimerFormat: String read FCaptionPercentTimerFormat write SetCaptionPercentTimerFormat;
  193. property Font;
  194. property ParentFont;
  195. property MinValue: Double read FMinValue write SetMinValue;
  196. property MaxValue: Double read FMaxValue write SetMaxValue;
  197. property MinYValue: Double read FMinYValue write SetMinYValue;
  198. property MaxYValue: Double read FMaxYValue write SetMaxYValue;
  199. property Value: Double read FValue write SetValue;
  200. property ValueSub: Double read FValueSub write SetValueSub;
  201. property Color; deprecated 'User BarColor instead';
  202. property RandSeed: integer read FRandSeed write SetRandSeed;
  203. property BarColor: TColor read FBarColor write SetBarColor;
  204. property BarColorSub: TColor read FBarColorSub write SetBarColorSub;
  205. property BackgroundColor: TColor read FBackgroundColor write SetBackgroundColor;
  206. property BackgroundRandomizeMinIntensity: Word read FBackgroundRandomizeMinIntensity write SetBackgroundRandomizeMinIntensity;
  207. property BackgroundRandomizeMaxIntensity: Word read FBackgroundRandomizeMaxIntensity write SetBackgroundRandomizeMaxIntensity;
  208. property BackgroundRandomize: Boolean read FBackgroundRandomize write SetBackgroundRandomize;
  209. property ShowDividers: Boolean read FShowDividers write SetShowDividers default False;
  210. property ShowBarAnimation: Boolean read FShowBarAnimation write SetShowBarAnimation default False;
  211. property Style: TBGRAPBarStyle read FStyle write SetStyle default pbstNormal;
  212. property MarqueeWidthType: TBGRAPBarMarqueeWidthType read FMarqueeWidthType write SetMarqueeWidthType default pbmwAuto;
  213. property MarqueeWidth: Word read FMarqueeWidth write SetMarqueeWidth default 95;
  214. property MarqueeSpeed: TBGRAPBarMarqueeSpeed read FMarqueeSpeed write SetMarqueeSpeed default pbmsMedium;
  215. property MarqueeDirection: TBGRAPBarMarqueeDirection read FMarqueeDirection write SetMarqueeDirection default pbmdToRight;
  216. property MarqueeBounce: Word read FMarqueeBounce write SetMarqueeBounce default 0;
  217. property TimerInterval: Cardinal read FTimerInterval write SetTimerInterval default 100;
  218. property TimerAutoRestart: Boolean read FTimerAutoRestart write FTimerAutoRestart default True;
  219. property GraphShowYDividers: Boolean read FGraphShowYDividers write SetGraphShowYDividers default False;
  220. property GraphShowYLine: Boolean read FGraphShowYLine write SetGraphShowYLine default False;
  221. property GraphYLineCaption: String read FGraphYLineCaption write SetGraphYLineCaption;
  222. property GraphYLineAfter: String read FGraphYLineAfter write SetGraphYLineAfter;
  223. property GraphYLineDigits: Integer read FGraphYLineDigits write SetGraphYLineDigits default 0;
  224. property OnClick;
  225. property OnDblClick;
  226. property OnMouseDown;
  227. property OnMouseEnter;
  228. property OnMouseLeave;
  229. property OnMouseMove;
  230. property OnMouseUp;
  231. property OnMouseWheel;
  232. property OnMouseWheelUp;
  233. property OnMouseWheelDown;
  234. property OnChange: TNotifyEvent read FOnChange write FOnChange;
  235. property OnRedraw: TBGRAProgressBarRedrawEvent read FOnRedraw write FOnRedraw;
  236. property OnTimerStart: TNotifyEvent read FOnTimerStart write FOnTimerStart;
  237. property OnTimerEnd: TNotifyEvent read FOnTimerEnd write FOnTimerEnd;
  238. property OnTimerTimer: TNotifyEvent read FOnTimerTimer write FOnTimerTimer;
  239. end;
  240. {$IFDEF FPC}procedure Register;{$ENDIF}
  241. implementation
  242. uses DateUtils, BGRATextFX;
  243. const
  244. BAR_ANIM_TIMER = 20;
  245. BAR_ANIM_INC = 4;
  246. MARQUEE_TIMER_SLOW = 50;
  247. MARQUEE_TIMER_MED = 20;
  248. MARQUEE_TIMER_FAST = 10;
  249. MARQUEE_INC = 2;
  250. MARQUEE_WIDTH_MIN = 10;
  251. {$IFDEF FPC}
  252. procedure Register;
  253. begin
  254. RegisterComponents('BGRA Controls', [TBGRAFlashProgressBar]);
  255. end;
  256. {$ENDIF}
  257. { TBGRAFlashProgressBar }
  258. procedure TBGRAFlashProgressBar.SetBarColor(AValue: TColor);
  259. begin
  260. if FBarColor = AValue then exit;
  261. FBarColor := AValue;
  262. if Assigned(FOnChange) then FOnChange(Self);
  263. Invalidate;
  264. end;
  265. function TBGRAFlashProgressBar.GetMax: Integer;
  266. begin
  267. Result:= Trunc(FMaxValue);
  268. end;
  269. function TBGRAFlashProgressBar.GetMin: Integer;
  270. begin
  271. Result:= Trunc(FMinValue);
  272. end;
  273. function TBGRAFlashProgressBar.GetPosition: Integer;
  274. begin
  275. Result:= Trunc(FValue);
  276. end;
  277. procedure TBGRAFlashProgressBar.SetBackgroundRandomize(AValue: boolean);
  278. begin
  279. if FBackgroundRandomize = AValue then exit;
  280. FBackgroundRandomize := AValue;
  281. if Assigned(FOnChange) then FOnChange(Self);
  282. Invalidate;
  283. end;
  284. procedure TBGRAFlashProgressBar.SetBackgroundRandomizeMaxIntensity(AValue: word);
  285. begin
  286. if FBackgroundRandomizeMaxIntensity = AValue then exit;
  287. FBackgroundRandomizeMaxIntensity := AValue;
  288. if Assigned(FOnChange) then FOnChange(Self);
  289. Invalidate;
  290. end;
  291. procedure TBGRAFlashProgressBar.SetBackgroundRandomizeMinIntensity(AValue: word);
  292. begin
  293. if FBackgroundRandomizeMinIntensity = AValue then exit;
  294. FBackgroundRandomizeMinIntensity := AValue;
  295. if Assigned(FOnChange) then FOnChange(Self);
  296. Invalidate;
  297. end;
  298. procedure TBGRAFlashProgressBar.SetBackgroundColor(AValue: TColor);
  299. begin
  300. if FBackgroundColor = AValue then exit;
  301. FBackgroundColor := AValue;
  302. if Assigned(FOnChange) then FOnChange(Self);
  303. Invalidate;
  304. end;
  305. procedure TBGRAFlashProgressBar.SetBarColorSub(AValue: TColor);
  306. begin
  307. if FBarColorSub = AValue then exit;
  308. FBarColorSub := AValue;
  309. if Assigned(FOnChange) then FOnChange(Self);
  310. Invalidate;
  311. end;
  312. procedure TBGRAFlashProgressBar.SetCaptionPercentDigits(AValue: Integer);
  313. begin
  314. if FCaptionPercentDigits=AValue then Exit;
  315. FCaptionPercentDigits:=AValue;
  316. if Assigned(FOnChange) then FOnChange(Self);
  317. Invalidate;
  318. end;
  319. procedure TBGRAFlashProgressBar.SetCaptionPercentTimerFormat(AValue: String);
  320. begin
  321. if FCaptionPercentTimerFormat=AValue then Exit;
  322. FCaptionPercentTimerFormat:=AValue;
  323. if Assigned(FOnChange) then FOnChange(Self);
  324. Invalidate;
  325. end;
  326. procedure TBGRAFlashProgressBar.SetCaptionShowPercent(AValue: Boolean);
  327. begin
  328. if FCaptionShowPercent=AValue then Exit;
  329. FCaptionShowPercent:=AValue;
  330. if Assigned(FOnChange) then FOnChange(Self);
  331. Invalidate;
  332. end;
  333. procedure TBGRAFlashProgressBar.SetCaptionPercentAlign(AValue: TAlignment);
  334. begin
  335. if FCaptionPercentAlign=AValue then Exit;
  336. FCaptionPercentAlign:=AValue;
  337. if Assigned(FOnChange) then FOnChange(Self);
  338. Invalidate;
  339. end;
  340. procedure TBGRAFlashProgressBar.SetCaptionPercentSubAlign(AValue: TAlignment);
  341. begin
  342. if FCaptionPercentSubAlign=AValue then Exit;
  343. FCaptionPercentSubAlign:=AValue;
  344. if Assigned(FOnChange) then FOnChange(Self);
  345. Invalidate;
  346. end;
  347. procedure TBGRAFlashProgressBar.SetCaptionShowPercentSub(AValue: Boolean);
  348. begin
  349. if FCaptionShowPercentSub=AValue then Exit;
  350. FCaptionShowPercentSub:=AValue;
  351. if Assigned(FOnChange) then FOnChange(Self);
  352. Invalidate;
  353. end;
  354. procedure TBGRAFlashProgressBar.SetGraphShowYLine(AValue: Boolean);
  355. begin
  356. if FGraphShowYLine=AValue then Exit;
  357. FGraphShowYLine:=AValue;
  358. if Assigned(FOnChange) then FOnChange(Self);
  359. Invalidate;
  360. end;
  361. procedure TBGRAFlashProgressBar.SetGraphYLineAfter(AValue: String);
  362. begin
  363. if FGraphYLineAfter=AValue then Exit;
  364. FGraphYLineAfter:=AValue;
  365. if Assigned(FOnChange) then FOnChange(Self);
  366. Invalidate;
  367. end;
  368. procedure TBGRAFlashProgressBar.SetGraphYLineCaption(AValue: String);
  369. begin
  370. if FGraphYLineCaption=AValue then Exit;
  371. FGraphYLineCaption:=AValue;
  372. if Assigned(FOnChange) then FOnChange(Self);
  373. Invalidate;
  374. end;
  375. procedure TBGRAFlashProgressBar.SetGraphYLineDigits(AValue: Integer);
  376. begin
  377. if FGraphYLineDigits=AValue then Exit;
  378. FGraphYLineDigits:=AValue;
  379. if Assigned(FOnChange) then FOnChange(Self);
  380. Invalidate;
  381. end;
  382. procedure TBGRAFlashProgressBar.SetMarqueeWidthType(AValue: TBGRAPBarMarqueeWidthType);
  383. begin
  384. if FMarqueeWidthType=AValue then Exit;
  385. FMarqueeWidthType:=AValue;
  386. CalcMarqueeWidth;
  387. if Assigned(FOnChange) then FOnChange(Self);
  388. Invalidate;
  389. end;
  390. procedure TBGRAFlashProgressBar.SetMax(AValue: Integer);
  391. begin
  392. SetMaxValue(AValue);
  393. end;
  394. procedure TBGRAFlashProgressBar.SetMin(AValue: Integer);
  395. begin
  396. SetMinValue(AValue);
  397. end;
  398. procedure TBGRAFlashProgressBar.SetPosition(AValue: Integer);
  399. begin
  400. SetValue(AValue);
  401. end;
  402. procedure TBGRAFlashProgressBar.SetShowBarAnimation(AValue: Boolean);
  403. begin
  404. if FShowBarAnimation=AValue then Exit;
  405. FShowBarAnimation:=AValue;
  406. if (FStyle in [pbstNormal, pbstMultiProgress, pbstGraph]) and
  407. not(csLoading in ComponentState) and
  408. not(csDesigning in ComponentState) then
  409. begin
  410. barAnimLeft:= 0;
  411. if FShowBarAnimation then internalTimer.Interval:= BAR_ANIM_TIMER;
  412. internalTimer.Enabled:= FShowBarAnimation;
  413. end;
  414. if Assigned(FOnChange) then FOnChange(Self);
  415. Invalidate;
  416. end;
  417. procedure TBGRAFlashProgressBar.SetShowDividers(AValue: Boolean);
  418. begin
  419. if FShowDividers=AValue then Exit;
  420. FShowDividers:=AValue;
  421. if Assigned(FOnChange) then FOnChange(Self);
  422. Invalidate;
  423. end;
  424. procedure TBGRAFlashProgressBar.SetMarqueeBounce(AValue: Word);
  425. begin
  426. marqueeBCount:= AValue;
  427. if FMarqueeBounce=AValue then Exit;
  428. FMarqueeBounce:=AValue;
  429. if Assigned(FOnChange) then FOnChange(Self);
  430. Invalidate;
  431. end;
  432. procedure TBGRAFlashProgressBar.SetMarqueeDirection(AValue: TBGRAPBarMarqueeDirection);
  433. begin
  434. if (FMarqueeDirection <> AValue) then
  435. begin
  436. FMarqueeDirection:= AValue;
  437. marqueeCurMode:= AValue;
  438. if Assigned(FOnChange) then FOnChange(Self);
  439. Invalidate;
  440. end;
  441. end;
  442. procedure TBGRAFlashProgressBar.SetMarqueeSpeed(AValue: TBGRAPBarMarqueeSpeed);
  443. begin
  444. FMarqueeSpeed:=AValue;
  445. case FMarqueeSpeed of
  446. pbmsSlow: internalTimer.Interval:= MARQUEE_TIMER_SLOW;
  447. pbmsMedium: internalTimer.Interval:= MARQUEE_TIMER_MED;
  448. pbmsFast: internalTimer.Interval:= MARQUEE_TIMER_FAST;
  449. end;
  450. end;
  451. procedure TBGRAFlashProgressBar.SetMarqueeWidth(AValue: Word);
  452. begin
  453. if FMarqueeWidth=AValue then Exit;
  454. if (AValue > Width) then AValue:= Width;
  455. if (AValue < MARQUEE_WIDTH_MIN) then AValue:= MARQUEE_WIDTH_MIN;
  456. FMarqueeWidth:= AValue;
  457. if (FMarqueeWidthType = pbmwFixed) then
  458. begin
  459. rMarqueeWidth:= FMarqueeWidth;
  460. if Assigned(FOnChange) then FOnChange(Self);
  461. Invalidate;
  462. end;
  463. end;
  464. procedure TBGRAFlashProgressBar.SetMaxValue(AValue: Double);
  465. begin
  466. if FMaxValue = AValue then exit;
  467. FMaxValue := AValue;
  468. if (FValue > FMaxValue) then FValue := FMaxValue;
  469. if (FMinValue > FMaxValue) then FMinValue := FMaxValue;
  470. if Assigned(FOnChange) then FOnChange(Self);
  471. Invalidate;
  472. end;
  473. procedure TBGRAFlashProgressBar.SetMaxYValue(AValue: Double);
  474. begin
  475. if FMaxYValue=AValue then Exit;
  476. FMaxYValue:=AValue;
  477. end;
  478. procedure TBGRAFlashProgressBar.SetMinValue(AValue: Double);
  479. begin
  480. if FMinValue = AValue then exit;
  481. FMinValue := AValue;
  482. if (FValue < FMinValue) then FValue := FMinValue;
  483. if (FMaxValue < FMinValue) then FMaxValue := FMinValue;
  484. if Assigned(FOnChange) then FOnChange(Self);
  485. Invalidate;
  486. end;
  487. procedure TBGRAFlashProgressBar.SetMinYValue(AValue: Double);
  488. begin
  489. if FMinYValue=AValue then Exit;
  490. FMinYValue:=AValue;
  491. end;
  492. procedure TBGRAFlashProgressBar.SetRandSeed(AValue: integer);
  493. begin
  494. if FRandSeed = AValue then exit;
  495. FRandSeed := AValue;
  496. if Assigned(FOnChange) then FOnChange(Self);
  497. Invalidate;
  498. end;
  499. procedure TBGRAFlashProgressBar.SetGraphShowYDividers(AValue: Boolean);
  500. begin
  501. if FGraphShowYDividers=AValue then Exit;
  502. FGraphShowYDividers:=AValue;
  503. if Assigned(FOnChange) then FOnChange(Self);
  504. Invalidate;
  505. end;
  506. procedure TBGRAFlashProgressBar.SetStyle(AValue: TBGRAPBarStyle);
  507. begin
  508. if (FStyle <> AValue) then
  509. begin
  510. FStyle:= AValue;
  511. Case FStyle of
  512. pbstNormal,
  513. pbstMultiProgress: begin
  514. if FShowBarAnimation and
  515. not(csLoading in ComponentState) and
  516. not(csDesigning in ComponentState)
  517. then begin
  518. barAnimLeft:= 0;
  519. internalTimer.Interval:= BAR_ANIM_TIMER;
  520. internalTimer.Enabled:= True;
  521. end
  522. else internalTimer.Enabled:= False;
  523. end;
  524. pbstMarquee: begin
  525. SetMarqueeSpeed(FMarqueeSpeed);
  526. if (FMarqueeDirection = pbmdToRight)
  527. then marqueeLeft:= 2
  528. else marqueeLeft:= -rMarqueeWidth;
  529. if FTimerAutoRestart and
  530. not(csLoading in ComponentState) and
  531. not(csDesigning in ComponentState) then internalTimer.Enabled:= True;
  532. end;
  533. pbstTimer: begin
  534. FValue:= FMaxValue;
  535. internalTimer.Interval:= FTimerInterval;
  536. if FTimerAutoRestart and
  537. not(csLoading in ComponentState) and
  538. not(csDesigning in ComponentState) then internalTimer.Enabled:= True;
  539. end;
  540. pbstGraph: begin
  541. //Save space for the 2 points to close the polygon
  542. if (Length(GraphPoints) < 2) then SetLength(GraphPoints, 2);
  543. if FShowBarAnimation and
  544. not(csLoading in ComponentState) and
  545. not(csDesigning in ComponentState)
  546. then begin
  547. internalTimer.Interval:= BAR_ANIM_TIMER;
  548. internalTimer.Enabled:= True;
  549. end
  550. else internalTimer.Enabled:= False;
  551. end;
  552. end;
  553. if Assigned(FOnChange) then FOnChange(Self);
  554. Invalidate;
  555. end;
  556. end;
  557. procedure TBGRAFlashProgressBar.SetTimerInterval(AValue: Cardinal);
  558. begin
  559. if FTimerInterval=AValue then Exit;
  560. FTimerInterval:=AValue;
  561. if (FStyle = pbstTimer) then internalTimer.Interval:= AValue;
  562. if Assigned(FOnChange) then FOnChange(Self);
  563. Invalidate;
  564. end;
  565. procedure TBGRAFlashProgressBar.SetValueSub(AValue: Double);
  566. begin
  567. if FValueSub = AValue then exit;
  568. FValueSub := AValue;
  569. if (FValueSub < FMinValue) then FValueSub := FMinValue;
  570. if (FValueSub > FValue) then FValueSub := FValue;
  571. if Assigned(FOnChange) then FOnChange(Self);
  572. Invalidate;
  573. end;
  574. procedure TBGRAFlashProgressBar.TimerOnTimer(Sender: TObject);
  575. begin
  576. try
  577. if closing then exit;
  578. Case FStyle of
  579. pbstNormal,
  580. pbstMultiProgress,
  581. pbstGraph: if FShowBarAnimation then begin
  582. inc(barAnimLeft, BAR_ANIM_INC);
  583. //Wait 16 times after reached the end
  584. if (barAnimLeft+18 > xpos) then barAnimLeft:= -16*BAR_ANIM_INC;
  585. end;
  586. pbstMarquee: begin
  587. if (FMarqueeBounce > 0) then
  588. begin
  589. if marqueeBouncing then
  590. begin
  591. if (marqueeCount = 0) //we've reached the rebound wall
  592. then begin
  593. marqueeCount:= 3; //Set the bounce length (3*2pixels)
  594. if (marqueeCurMode = pbmdToRight)
  595. then marqueeCurMode:= pbmdToLeft
  596. else marqueeCurMode:= pbmdToRight;
  597. //decreases the rebound counter only if we are in the real wall
  598. if marqueeWall then dec(marqueeBCount);
  599. if (marqueeBCount > 0)
  600. then marqueeBouncing:= True
  601. else begin
  602. //Stop Bouncing
  603. if marqueeWall then marqueeBCount:= FMarqueeBounce;
  604. marqueeBouncing:= False;
  605. end;
  606. end
  607. else dec(marqueeCount);
  608. end;
  609. end;
  610. //Move the bar 2 pixels
  611. if (marqueeCurMode = pbmdToRight)
  612. then inc(marqueeLeft, MARQUEE_INC)
  613. else dec(marqueeLeft, MARQUEE_INC);
  614. end;
  615. pbstTimer: begin
  616. { #note -oMaxM : If we had to be more precise we should keep the Start time and subtract the current time }
  617. FValue:= IncMilliSecond(FValue, -internalTimer.Interval);
  618. if (FValue <= 0)
  619. then begin
  620. if Assigned(FOnTimerEnd) then FOnTimerEnd(Self);
  621. if FTimerAutoRestart then FValue:= FMaxValue;
  622. internalTimer.Enabled:= FTimerAutoRestart;
  623. end
  624. else if Assigned(FOnTimerTimer) then FOnTimerTimer(Self);
  625. end;
  626. end;
  627. Invalidate;
  628. except
  629. //MaxM: Ignore Exception sometimes it happens when we are closing
  630. end;
  631. end;
  632. procedure TBGRAFlashProgressBar.CalcMarqueeWidth;
  633. begin
  634. Case FMarqueeWidthType of
  635. pbmwAuto: rMarqueeWidth:= Width div 4;
  636. pbmwFixed: rMarqueeWidth:= FMarqueeWidth;
  637. pbmwValue: begin
  638. rMarqueeWidth:= round((FValue - FMinValue) / (FMaxValue - FMinValue) * (Width-2));
  639. if (rMarqueeWidth < MARQUEE_WIDTH_MIN) then rMarqueeWidth:= MARQUEE_WIDTH_MIN;
  640. end;
  641. pbmwValueSub: begin
  642. rMarqueeWidth:= round((FValueSub - FMinValue) / (FMaxValue - FMinValue) * (Width-2));
  643. if (rMarqueeWidth < MARQUEE_WIDTH_MIN) then rMarqueeWidth:= MARQUEE_WIDTH_MIN;
  644. end;
  645. end;
  646. end;
  647. {$hints off}
  648. class function TBGRAFlashProgressBar.GetControlClassDefaultSize: TSize;
  649. begin
  650. Result.CX := 380;
  651. Result.CY := 34;
  652. end;
  653. procedure TBGRAFlashProgressBar.CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer; WithThemeSpace: boolean);
  654. begin
  655. PreferredWidth := 380;
  656. PreferredHeight := 34;
  657. end;
  658. procedure TBGRAFlashProgressBar.DoOnResize;
  659. begin
  660. inherited DoOnResize;
  661. if (FMarqueeWidthType = pbmwAuto) then rMarqueeWidth:= Width div 4;
  662. end;
  663. {$hints on}
  664. procedure TBGRAFlashProgressBar.Paint;
  665. begin
  666. if (ClientWidth <> FBGRA.Width) or (ClientHeight <> FBGRA.Height)
  667. then FBGRA.SetSize(ClientWidth, ClientHeight);
  668. Draw(FBGRA);
  669. if Assigned(OnRedraw) then OnRedraw(Self, FBGRA, {%H-}XPosition);
  670. FBGRA.Draw(Canvas, 0, 0, False);
  671. end;
  672. procedure TBGRAFlashProgressBar.Loaded;
  673. begin
  674. inherited Loaded;
  675. Case FStyle of
  676. pbstNormal,
  677. pbstMultiProgress,
  678. pbstGraph: begin
  679. if FShowBarAnimation then internalTimer.Interval:= BAR_ANIM_TIMER;
  680. internalTimer.Enabled:= FShowBarAnimation;
  681. end;
  682. pbstMarquee: begin
  683. CalcMarqueeWidth;
  684. if (FMarqueeDirection = pbmdToRight)
  685. then marqueeLeft:= 2
  686. else marqueeLeft:= -rMarqueeWidth;
  687. if FTimerAutoRestart and not(csDesigning in ComponentState) then internalTimer.Enabled:= True;
  688. end;
  689. pbstTimer: begin
  690. FValue:= FMaxValue;
  691. internalTimer.Interval:= FTimerInterval;
  692. if FTimerAutoRestart and not(csDesigning in ComponentState) then internalTimer.Enabled:= True;
  693. end;
  694. end;
  695. end;
  696. procedure TBGRAFlashProgressBar.TextChanged;
  697. begin
  698. Invalidate;
  699. end;
  700. {$hints off}
  701. procedure TBGRAFlashProgressBar.WMEraseBkgnd(var Message: {$IFDEF FPC}TLMEraseBkgnd{$ELSE}TWMEraseBkgnd{$ENDIF});
  702. begin
  703. //do nothing
  704. end;
  705. {$hints on}
  706. constructor TBGRAFlashProgressBar.Create(AOwner: TComponent);
  707. begin
  708. inherited Create(AOwner);
  709. with GetControlClassDefaultSize do
  710. SetInitialBounds(0, 0, CX, CY);
  711. // Bitmap
  712. FBGRA := TBGRABitmap.Create(Width, Height);
  713. // Functionality
  714. FMinValue := 0;
  715. FMaxValue := 100;
  716. FValue := 30;
  717. FValueSub := 10;
  718. xpos:= 0;
  719. xposSub:= 0;
  720. // Functionality and Style
  721. Randomize;
  722. FRandSeed := RandSeed;
  723. FCaptionShowPercent:= False;
  724. FCaptionPercentAlign:= taCenter;
  725. FCaptionPercentSubAlign:= taLeftJustify;
  726. FCaptionPercentDigits:= 0;
  727. Caption:= '';
  728. // Style
  729. FStyle:=pbstNormal;
  730. FBarColor := BGRA(102, 163, 226);
  731. FBarColorSub := BGRA(240, 240, 15);
  732. FBackgroundColor := BGRA(47,47,47);
  733. FBackgroundRandomize := True;
  734. FBackgroundRandomizeMinIntensity := 4000;
  735. FBackgroundRandomizeMaxIntensity := 5000;
  736. FShowDividers:= False;
  737. FGraphShowYDividers:= False;
  738. FShowBarAnimation:= False;
  739. barAnimLeft:= 0;
  740. //Marquee
  741. FMarqueeWidthType:= pbmwAuto; //AutoWidth
  742. rMarqueeWidth:= 95; //PreferredWidth div 4
  743. FMarqueeWidth:= 95;
  744. FMarqueeSpeed:= pbmsMedium;
  745. FMarqueeDirection:= pbmdToRight;
  746. marqueeCurMode:= pbmdToRight;
  747. marqueeLeft:= 0;
  748. marqueeRight:= 0;
  749. FMarqueeBounce:= 0;
  750. marqueeBouncing:= False;
  751. //Timer
  752. FTimerInterval:= 100;
  753. FTimerAutoRestart:= True;
  754. FCaptionPercentTimerFormat:= 'nn:ss.zzz';
  755. //Graph
  756. FMinYValue := 0;
  757. FMaxYValue := 100;
  758. GraphValues:= nil;
  759. GraphPoints:= nil;
  760. FGraphShowYDividers:= False;
  761. FGraphShowYLine:= False;
  762. FGraphYLineCaption:= '';
  763. FGraphYLineAfter:= '';
  764. FGraphYLineDigits:= 0;
  765. internalTimer:= TFPTimer.Create(Self);
  766. internalTimer.UseTimerThread:= True;
  767. internalTimer.Enabled:= False;
  768. internalTimer.Interval:= MARQUEE_TIMER_MED;
  769. internalTimer.OnTimer:= TimerOnTimer;
  770. closing:= False;
  771. end;
  772. destructor TBGRAFlashProgressBar.Destroy;
  773. begin
  774. //Avoid Exception when internalTimer is Enabled
  775. closing:= True;
  776. internalTimer.Enabled:=False;
  777. CheckSynchronize(40);
  778. internalTimer.Free;
  779. GraphValues:= nil;
  780. GraphPoints:= nil;
  781. FBGRA.Free;
  782. inherited Destroy;
  783. end;
  784. {$IFDEF FPC}
  785. procedure TBGRAFlashProgressBar.SaveToFile(AFileName: string);
  786. var
  787. AStream: TMemoryStream;
  788. begin
  789. AStream := TMemoryStream.Create;
  790. try
  791. WriteComponentAsTextToStream(AStream, Self);
  792. AStream.SaveToFile(AFileName);
  793. finally
  794. AStream.Free;
  795. end;
  796. end;
  797. procedure TBGRAFlashProgressBar.LoadFromFile(AFileName: string);
  798. var
  799. AStream: TMemoryStream;
  800. begin
  801. AStream := TMemoryStream.Create;
  802. try
  803. AStream.LoadFromFile(AFileName);
  804. ReadComponentFromTextStream(AStream, TComponent(Self), OnFindClass);
  805. finally
  806. AStream.Free;
  807. end;
  808. end;
  809. procedure TBGRAFlashProgressBar.OnFindClass(Reader: TReader;
  810. const AClassName: string; var ComponentClass: TComponentClass);
  811. begin
  812. if CompareText(AClassName, 'TBGRAFlashProgressBar') = 0 then
  813. ComponentClass := TBGRAFlashProgressBar;
  814. end;
  815. {$ENDIF}
  816. procedure TBGRAFlashProgressBar.Draw(ABitmap: TBGRABitmap);
  817. var
  818. content: TRect;
  819. y, tx, ty,
  820. marqueeOver: integer;
  821. bgColor: TBGRAPixel;
  822. pStr: String;
  823. pValue: Double;
  824. function ApplyLightness(c: TBGRAPixel; lightness: word): TBGRAPixel;
  825. begin
  826. Result := GammaCompression(SetLightness(GammaExpansion(c), lightness));
  827. end;
  828. procedure DrawBar(bounds: TRect; AColor: TColor);
  829. var
  830. lCol: TBGRAPixel;
  831. begin
  832. lCol := AColor;
  833. DoubleGradientAlphaFill(ABitmap, bounds,
  834. ApplyLightness(lCol, 37000), ApplyLightness(lCol, 29000),
  835. ApplyLightness(lCol, 26000), ApplyLightness(lCol, 18000),
  836. gdVertical, gdVertical, gdVertical, 0.53);
  837. InflateRect(bounds, -1, -1);
  838. DoubleGradientAlphaFill(ABitmap, bounds,
  839. ApplyLightness(lCol, 28000), ApplyLightness(lCol, 22000),
  840. ApplyLightness(lCol, 19000), ApplyLightness(lCol, 11000),
  841. gdVertical, gdVertical, gdVertical, 0.53);
  842. end;
  843. procedure DrawBarAnimation;
  844. begin
  845. if FShowBarAnimation and (barAnimLeft >= 0)
  846. then ABitmap.GradientFill(barAnimLeft, content.Top, barAnimLeft+36, content.Bottom,
  847. BGRA(255, 255, 255, 64), BGRA(255, 255, 255, 2), gtReflected,
  848. PointF(barAnimLeft+18, content.Bottom-content.Top/2), PointF(barAnimLeft+36, content.Bottom-content.Top/2),
  849. dmLinearBlend);
  850. end;
  851. procedure DrawText(ACaption: String; AAlign: TAlignment);
  852. var
  853. fx: TBGRATextEffect;
  854. lColB: TBGRAPixel;
  855. begin
  856. try
  857. if (Font.Size=0)
  858. then fx:= TBGRATextEffect.Create(ACaption, Font.Name, ABitmap.Height div 2, True)
  859. else fx:= TBGRATextEffect.Create(ACaption, Font, True);
  860. if (Font.Color = clDefault) or (Font.Color = clNone)
  861. then lColB:= ApplyLightness(FBarColor, 59000)
  862. else lColB:= ColorToBGRA(Font.Color);
  863. y:= (ABitmap.Height-fx.TextHeight) div 2;
  864. Case AAlign of
  865. taLeftJustify: begin
  866. fx.DrawOutline(ABitmap, 4, y, BGRABlack, taLeftJustify);
  867. fx.Draw(ABitmap, 4, y, lColB, taLeftJustify);
  868. end;
  869. taRightJustify: begin
  870. fx.DrawOutline(ABitmap, tx-4, y, BGRABlack, taRightJustify);
  871. fx.Draw(ABitmap, tx-4, y, lColB, taRightJustify);
  872. end;
  873. taCenter: begin
  874. fx.DrawOutline(ABitmap, ABitmap.Width div 2, y, BGRABlack, taCenter);
  875. fx.Draw(ABitmap, ABitmap.Width div 2, y, lColB, taCenter);
  876. end;
  877. end;
  878. finally
  879. fx.Free;
  880. end;
  881. end;
  882. procedure DrawDividers(DrawYDiv: Boolean);
  883. var
  884. lColD: TBGRAPixel;
  885. posS: Single;
  886. i: Integer;
  887. begin
  888. lColD:= BGRA(128, 128, 128, 128);
  889. for i:= 1 to 9 do
  890. begin
  891. posS:= content.left+(i*10*(content.right-content.left)/100);
  892. ABitmap.DrawLineAntialias(posS, 2, posS, content.Bottom-1, lColD, 1, True);
  893. end;
  894. if DrawYDiv then
  895. for i:= 1 to 9 do
  896. begin
  897. posS:= content.Bottom-1-(i*10*(content.Bottom-content.Top)/100);
  898. ABitmap.DrawLineAntialias(2, posS, content.Right-1, posS, lColD, 1, True);
  899. end;
  900. end;
  901. procedure DrawG;
  902. var
  903. lCol,
  904. lColB: TBGRAPixel;
  905. posS: Single;
  906. curIndex: Integer;
  907. fx: TBGRATextEffect;
  908. begin
  909. lCol := FBarColor;
  910. if (Font.Color = clDefault) or (Font.Color = clNone)
  911. then lColB:= ApplyLightness(FBarColor, 37000)
  912. else lColB:= ColorToBGRA(Font.Color);
  913. posS:= content.left+((FValue-FMinValue)/(FMaxValue-FMinValue)*(content.right-content.left));
  914. if (posS > content.Right-1) then posS:= content.Right-1;
  915. //Fixed Points to Close the Path
  916. GraphPoints[0].x:= posS;
  917. GraphPoints[0].y:= content.Bottom-1;
  918. GraphPoints[1].x:= content.Left;
  919. GraphPoints[1].y:= content.Bottom-1;
  920. //Draw Value Position
  921. xpos:= Round(posS);
  922. ABitmap.RectangleAntialias(content.left, content.Top, xpos, content.Bottom-1, lColB, 1, lColB);
  923. if FShowDividers then DrawDividers(FGraphShowYDividers);
  924. //Draw the Graph
  925. if (Length(GraphPoints) > 2) then
  926. begin
  927. ABitmap.DrawPolygonAntialias(GraphPoints, lCol, 1, lCol);
  928. if FGraphShowYLine then
  929. begin
  930. curIndex:= Length(GraphValues)-1;
  931. //Check if we have at least one Value
  932. if (curIndex >= 0) then
  933. begin
  934. lColB:= BGRA(0, 0, 0, 192);
  935. pStr:= FGraphYLineCaption+FloatToStrF(GraphValues[curIndex].YValue, ffFixed, 15, FGraphYLineDigits)+FGraphYLineAfter;
  936. //Get last Value Y Point and draw a horizontal line
  937. curIndex:= Length(GraphPoints)-1;
  938. posS:= GraphPoints[curIndex].y;
  939. ABitmap.DrawLineAntialias(2, posS, tx-4, posS, lColB, 1, True);
  940. try
  941. fx:= TBGRATextEffect.Create(pStr, Font.Name, 12, True);
  942. //Write the text above the line if possible else write below
  943. if (Round(posS-fx.TextHeight) >= 2) then posS:= posS-fx.TextHeight;
  944. fx.Draw(ABitmap, tx-6, Round(posS), lColB, taRightJustify);
  945. finally
  946. fx.Free;
  947. end;
  948. end;
  949. end;
  950. end;
  951. DrawBarAnimation; { #note -oMaxM : Evaluate how it seems }
  952. //Draw Value Text
  953. pStr:= '';
  954. if FCaptionShowPercent then
  955. begin
  956. pValue:= 100*(FValue - FMinValue)/FMaxValue;
  957. if (pValue <> 0) then pStr:= FloatToStrF(pValue, ffFixed, 15, FCaptionPercentDigits)+'%'
  958. end;
  959. DrawText(Caption+pStr, FCaptionPercentAlign);
  960. end;
  961. begin
  962. try
  963. ABitmap.FillTransparent;
  964. tx := ABitmap.Width;
  965. ty := ABitmap.Height;
  966. ABitmap.Rectangle(0, 0, tx, ty, BGRA(255, 255, 255, 6), FBackgroundColor, dmSet);
  967. if (tx > 2) and (ty > 2) then
  968. ABitmap.Rectangle(1, 1, tx - 1, ty - 1, BGRA(29, 29, 29), dmSet);
  969. if (tx > 4) and (ty > 4) then
  970. begin
  971. content := Rect(2, 2, tx - 2, ty - 2);
  972. randseed := FRandSeed;
  973. if FBackgroundRandomize then
  974. for y := content.Top to content.Bottom - 1 do
  975. begin
  976. bgColor := FBackgroundColor;
  977. bgColor.Intensity := RandomRange(FBackgroundRandomizeMinIntensity, FBackgroundRandomizeMaxIntensity);
  978. ABitmap.HorizLine(content.Left, y, content.Right - 1, bgColor, dmSet);
  979. end;
  980. if tx >= 6 then
  981. ABitmap.DrawVertLine(content.Right - 1, content.Top, content.Bottom - 1,
  982. BGRA(0, 0, 0, 32));
  983. Case FStyle of
  984. pbstNormal: begin
  985. if FMaxValue > FMinValue then
  986. begin
  987. //Draw Value Bar
  988. xpos := round((FValue - FMinValue) / (FMaxValue - FMinValue) *
  989. (content.right - content.left)) + content.left;
  990. if xpos > content.left then
  991. begin
  992. DrawBar(rect(content.left, content.top, xpos, content.bottom), FBarColor);
  993. if xpos < content.right then
  994. begin
  995. ABitmap.SetPixel(xpos, content.top, BGRA(62, 62, 62));
  996. ABitmap.SetVertLine(xpos, content.top + 1, content.bottom - 1, BGRA(40, 40, 40));
  997. end;
  998. if FShowDividers then DrawDividers(False);
  999. DrawBarAnimation;
  1000. //Draw Value Text
  1001. pStr:= '';
  1002. if FCaptionShowPercent then
  1003. begin
  1004. pValue:= 100*(FValue - FMinValue)/FMaxValue;
  1005. if (pValue <> 0) then pStr:= FloatToStrF(pValue, ffFixed, 15, FCaptionPercentDigits)+'%'
  1006. end;
  1007. DrawText(Caption+pStr, FCaptionPercentAlign);
  1008. end;
  1009. end
  1010. else if FShowDividers then DrawDividers(False);
  1011. end;
  1012. pbstMultiProgress: begin
  1013. if FMaxValue > FMinValue then
  1014. begin
  1015. //Draw Value Bar
  1016. xpos := round((FValue - FMinValue) / (FMaxValue - FMinValue) *
  1017. (content.right - content.left)) + content.left;
  1018. if xpos > content.left then
  1019. begin
  1020. DrawBar(rect(content.left, content.top, xpos, content.bottom), FBarColor);
  1021. if xpos < content.right then
  1022. begin
  1023. ABitmap.SetPixel(xpos, content.top, BGRA(62, 62, 62));
  1024. ABitmap.SetVertLine(xpos, content.top + 1, content.bottom - 1, BGRA(40, 40, 40));
  1025. end;
  1026. end;
  1027. //Draw ValueSub Bar
  1028. xposSub := round((FValueSub - FMinValue) / (FMaxValue - FMinValue) *
  1029. (content.right - content.left)) + content.left;
  1030. if xposSub > content.left then
  1031. begin
  1032. DrawBar(rect(content.left, content.top, xposSub, content.bottom), FBarColorSub);
  1033. if xposSub < content.right then
  1034. begin
  1035. ABitmap.SetPixel(xposSub, content.top, BGRA(62, 62, 62));
  1036. ABitmap.SetVertLine(xposSub, content.top + 1, content.bottom - 1, BGRA(40, 40, 40));
  1037. end;
  1038. end;
  1039. if FShowDividers then DrawDividers(False);
  1040. DrawBarAnimation;
  1041. //Draw Value Text
  1042. pStr:= '';
  1043. if FCaptionShowPercent then
  1044. begin
  1045. pValue:= 100*(FValue - FMinValue)/FMaxValue;
  1046. if (pValue <> 0) then pStr:= FloatToStrF(pValue, ffFixed, 15, FCaptionPercentDigits)+'%'
  1047. end;
  1048. DrawText(Caption+pStr, FCaptionPercentAlign);
  1049. //Draw ValueSub Text
  1050. pStr:= '';
  1051. if FCaptionShowPercentSub then
  1052. begin
  1053. pValue:= 100*(FValueSub - FMinValue)/FMaxValue;
  1054. if (pValue <> 0) then pStr:= FloatToStrF(pValue, ffFixed, 15, FCaptionPercentDigits)+'%'
  1055. end;
  1056. DrawText(pStr, FCaptionPercentSubAlign);
  1057. end
  1058. else if FShowDividers then DrawDividers(False);
  1059. end;
  1060. pbstMarquee: begin
  1061. //Calculate new MarqueeWidth based on Values (only if type is Value related)
  1062. Case FMarqueeWidthType of
  1063. pbmwValue: begin
  1064. rMarqueeWidth:= round((FValue - FMinValue) / (FMaxValue - FMinValue) * (content.right - content.left));
  1065. if (rMarqueeWidth < MARQUEE_WIDTH_MIN) then rMarqueeWidth:= MARQUEE_WIDTH_MIN;
  1066. end;
  1067. pbmwValueSub: begin
  1068. rMarqueeWidth:= round((FValueSub - FMinValue) / (FMaxValue - FMinValue) * (content.right - content.left));
  1069. if (rMarqueeWidth < MARQUEE_WIDTH_MIN) then rMarqueeWidth:= MARQUEE_WIDTH_MIN;
  1070. end;
  1071. end;
  1072. if (marqueeCurMode = pbmdToRight)
  1073. then begin
  1074. //check if the whole bar is out put it back to the beginning
  1075. if (marqueeLeft >= content.Right)
  1076. then marqueeLeft:= content.Left;
  1077. //Calculate the Right
  1078. marqueeRight:= marqueeLeft+(rMarqueeWidth-1);
  1079. //Check if part of the bar is out calculate the visible piece on the left
  1080. marqueeOver:= 0;
  1081. marqueeWall:= (marqueeRight >= content.Right-1);
  1082. if marqueeWall then
  1083. begin
  1084. if (FMarqueeBounce > 0)
  1085. then begin
  1086. //Put perfectly on the Right edge
  1087. marqueeRight:= content.Right-1;
  1088. marqueeLeft:= marqueeRight-(rMarqueeWidth-1);
  1089. marqueeBouncing:= True;
  1090. end
  1091. else marqueeOver:= marqueeRight-(content.Right-1);
  1092. end;
  1093. end
  1094. else begin
  1095. //check if the whole bar is out put it back to the end
  1096. if (marqueeLeft <= -rMarqueeWidth)
  1097. then marqueeLeft:= content.Right-rMarqueeWidth;
  1098. //Calculate the Right
  1099. marqueeRight:= marqueeLeft+(rMarqueeWidth-1);
  1100. //check if part of the bar is out then the visible piece on the left is equal to marqueeRight
  1101. marqueeOver:= 0;
  1102. marqueeWall:= (marqueeRight-1 <= rMarqueeWidth);
  1103. if marqueeWall then
  1104. begin
  1105. if (FMarqueeBounce > 0)
  1106. then begin
  1107. //Put perfectly on the Left edge
  1108. marqueeLeft:= content.Left;
  1109. marqueeRight:= marqueeLeft+(rMarqueeWidth-1);
  1110. marqueeBouncing:= True;
  1111. end
  1112. else marqueeOver:= marqueeRight;
  1113. end;
  1114. end;
  1115. if (marqueeOver = 0)
  1116. then begin
  1117. //Draw Normal Bar Left-Right
  1118. DrawBar(rect(marqueeLeft, content.top, marqueeRight, content.bottom), FBarColor);
  1119. ABitmap.SetPixel(marqueeLeft, content.top, BGRA(62, 62, 62));
  1120. ABitmap.SetVertLine(marqueeLeft, content.top + 1, content.bottom - 1, BGRA(40, 40, 40));
  1121. ABitmap.SetPixel(marqueeRight, content.top, BGRA(62, 62, 62));
  1122. ABitmap.SetVertLine(marqueeRight, content.top + 1, content.bottom - 1, BGRA(40, 40, 40));
  1123. end
  1124. else begin
  1125. //Draw visible piece on the Left
  1126. DrawBar(rect(content.Left, content.top, marqueeOver, content.bottom), FBarColor);
  1127. ABitmap.SetPixel(marqueeOver, content.top, BGRA(62, 62, 62));
  1128. ABitmap.SetVertLine(marqueeOver, content.top + 1, content.bottom - 1, BGRA(40, 40, 40));
  1129. //Draw visible piece on the Right
  1130. DrawBar(rect(content.Right-(rMarqueeWidth+1-marqueeOver), content.top, tx-2, content.bottom), FBarColor);
  1131. ABitmap.SetPixel(content.Right-(rMarqueeWidth+1-marqueeOver), content.top, BGRA(62, 62, 62));
  1132. ABitmap.SetVertLine(content.Right-(rMarqueeWidth+1-marqueeOver), content.top + 1, content.bottom - 1, BGRA(40, 40, 40));
  1133. end;
  1134. //Draw Value Text
  1135. pStr:= '';
  1136. if FCaptionShowPercent then
  1137. begin
  1138. pValue:= 100*(FValue - FMinValue)/FMaxValue;
  1139. if (pValue <> 0) then pStr:= FloatToStrF(pValue, ffFixed, 15, FCaptionPercentDigits)+'%'
  1140. end;
  1141. DrawText(Caption+pStr, FCaptionPercentAlign);
  1142. end;
  1143. pbstTimer: begin
  1144. if FMaxValue > FMinValue then
  1145. begin
  1146. //Draw Timer Bar
  1147. xpos := round((FValue - FMinValue) / (FMaxValue - FMinValue) *
  1148. (content.right - content.left)) + content.left;
  1149. if xpos > content.left then
  1150. begin
  1151. DrawBar(rect(content.left, content.top, xpos, content.bottom), FBarColor);
  1152. if xpos < content.right then
  1153. begin
  1154. ABitmap.SetPixel(xpos, content.top, BGRA(62, 62, 62));
  1155. ABitmap.SetVertLine(xpos, content.top + 1, content.bottom - 1, BGRA(40, 40, 40));
  1156. end;
  1157. if FShowDividers then DrawDividers(False);
  1158. //Draw Timer Text
  1159. pStr:= '';
  1160. if FCaptionShowPercent then
  1161. begin
  1162. if (FValue <> 0) then pStr:= FormatDateTime(FCaptionPercentTimerFormat, FValue)
  1163. end;
  1164. DrawText(Caption+pStr, FCaptionPercentAlign);
  1165. end;
  1166. end
  1167. else if FShowDividers then DrawDividers(False);
  1168. end;
  1169. pbstGraph: DrawG;
  1170. end;
  1171. end;
  1172. except
  1173. //MaxM: Ignore Exception sometimes it happens when the timer is active and we are closing
  1174. end;
  1175. end;
  1176. procedure TBGRAFlashProgressBar.SetValue(AValue: Double);
  1177. begin
  1178. SetValue(AValue, 0);
  1179. end;
  1180. procedure TBGRAFlashProgressBar.SetValue(AValue, AYValue: Double);
  1181. var
  1182. curIndex: Integer;
  1183. begin
  1184. if (FStyle = pbstGraph)
  1185. then begin
  1186. if (AValue >= FMinValue) and (AValue <= FMaxValue) then
  1187. begin
  1188. //Check if Y Value is on the Range
  1189. FValue := AValue;
  1190. if (AYValue < FMinYValue) then AYValue := FMinYValue;
  1191. if (AYValue > FMaxYValue) then AYValue := FMaxYValue;
  1192. if (AValue > FValue)
  1193. then begin
  1194. //Add a new Value in the array
  1195. curIndex:= Length(GraphValues);
  1196. SetLength(GraphValues, curIndex+1);
  1197. GraphValues[curIndex].XValue:= AValue;
  1198. GraphValues[curIndex].YValue:= AYValue;
  1199. //Calculate new Value x/y Position and add in the array
  1200. curIndex:= Length(GraphPoints);
  1201. SetLength(GraphPoints, curIndex+1);
  1202. GraphPoints[curIndex].x:= 2+((AValue-FMinValue) / (FMaxValue-FMinValue))*(Width-4);
  1203. GraphPoints[curIndex].y:= Height-3-((AYValue-FMinYValue) / (FMaxYValue-FMinYValue))*(Height-4);
  1204. if (GraphPoints[curIndex].x > Width-4) then GraphPoints[curIndex].x:= Width-4;
  1205. if (GraphPoints[curIndex].y < 2) then GraphPoints[curIndex].y:= 2;
  1206. end
  1207. else begin
  1208. //Deletes all values from the array that are no longer visible
  1209. curIndex:= Length(GraphValues)-1;
  1210. while (curIndex>=0) and (GraphValues[curIndex].XValue > AValue) do
  1211. begin
  1212. SetLength(GraphValues, curIndex);
  1213. SetLength(GraphPoints, curIndex+2); //there are 2 fixed points at the beginning
  1214. dec(curIndex);
  1215. end;
  1216. //If the last XValue is the same then assign the YValue else add a new Value
  1217. if (curIndex>=0) and (GraphValues[curIndex].XValue = AValue)
  1218. then GraphValues[curIndex].YValue:= AYValue
  1219. else begin
  1220. curIndex:= Length(GraphValues);
  1221. SetLength(GraphValues, curIndex+1);
  1222. GraphValues[curIndex].XValue:= AValue;
  1223. GraphValues[curIndex].YValue:= AYValue;
  1224. SetLength(GraphPoints, Length(GraphPoints)+1);
  1225. end;
  1226. curIndex:= Length(GraphPoints)-1;
  1227. GraphPoints[curIndex].x:= 2+((AValue-FMinValue) / (FMaxValue-FMinValue))*(Width-4);
  1228. GraphPoints[curIndex].y:= Height-3-((AYValue-FMinYValue) / (FMaxYValue-FMinYValue))*(Height-4);
  1229. if (GraphPoints[curIndex].x > Width-4) then GraphPoints[curIndex].x:= Width-4;
  1230. if (GraphPoints[curIndex].y < 2) then GraphPoints[curIndex].y:= 2;
  1231. end;
  1232. FValue:= AValue;
  1233. if Assigned(FOnChange) then FOnChange(Self);
  1234. Invalidate;
  1235. end;
  1236. end
  1237. else if (FValue <> AValue) then
  1238. begin
  1239. FValue := AValue;
  1240. if (FValue < FMinValue) then FValue := FMinValue;
  1241. if (FValue > FMaxValue) then FValue := FMaxValue;
  1242. if Assigned(FOnChange) then FOnChange(Self);
  1243. Invalidate;
  1244. end;
  1245. end;
  1246. procedure TBGRAFlashProgressBar.StepIt(AIncrement: Double);
  1247. begin
  1248. Case FStyle of
  1249. pbstMarquee,
  1250. pbstTimer: begin
  1251. internalTimer.Enabled:= False;
  1252. TimerOnTimer(nil);
  1253. end
  1254. else Value:= Value+AIncrement;
  1255. end;
  1256. end;
  1257. procedure TBGRAFlashProgressBar.TimerReStart;
  1258. begin
  1259. if (FStyle = pbstTimer) then
  1260. begin
  1261. FValue:= FMaxValue;
  1262. internalTimer.Interval:= FTimerInterval;
  1263. internalTimer.Enabled:= True;
  1264. Invalidate;
  1265. if Assigned(FOnTimerStart) then FOnTimerStart(Self);
  1266. end;
  1267. end;
  1268. procedure TBGRAFlashProgressBar.TimerPlayPause;
  1269. begin
  1270. if (FStyle in [pbstMarquee, pbstTimer]) then
  1271. begin
  1272. internalTimer.Enabled:= not(internalTimer.Enabled);
  1273. Invalidate;
  1274. end;
  1275. end;
  1276. end.