controls/rarprogress/mckRarProgBar.pas

   1 //////////////////////////////////////////////////////////////////////
   2 //                                                                  //
   3 //      TRarProgressBar version 1.0                                 //
   4 //      Description: TRarProgressBar is a component which           //
   5 //                   displays dual progress bar like a WinRAR       //
   6 //      Author: Dimaxx                                              //
   7 //                                                                  //
   8 //////////////////////////////////////////////////////////////////////
   9
  10 unit mckRarProgBar;
  11
  12 interface
  13
  14 uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  15      ComCtrls, ExtCtrls, Mirror;
  16
  17 const
  18   Boolean2Str: array [Boolean] of string = ('False','True');
  19
  20 type
  21   TRarProgressBar = class(TKOLControl)
  22   private
  23     { Private declarations }
  24     FPosition1: integer;
  25     FPosition2: integer;
  26     FMin,FMax: integer;
  27
  28     FPercent1,FPercent2: integer;
  29     FDouble: boolean;
  30
  31     FLightColor1,FDarkColor,FLightColor2,FFrameColor1,FFrameColor2,
  32     FFillColor1,FFillColor2,FBackFrameColor1,FBackFrameColor2,
  33     FBackFillColor,FShadowColor: TColor;
  34
  35     TopX,TopY,SizeX,SizeY: integer;
  36
  37     function  AdditionalUnits: string; override;
  38     procedure SetupFirst(SL: TStringList; const AName,AParent,Prefix: string); override;
  39     procedure SetPos1(P: integer);
  40     procedure SetPos2(P: integer);
  41     procedure SetMin(M: integer);
  42     procedure SetMax(M: integer);
  43     procedure SetDouble(D: boolean);
  44
  45     procedure SetLightColor1(C: TColor);
  46     procedure SetLightColor2(C: TColor);
  47     procedure SetDarkColor(C: TColor);
  48     procedure SetFrameColor1(C: TColor);
  49     procedure SetFrameColor2(C: TColor);
  50     procedure SetFillColor1(C: TColor);
  51     procedure SetFillColor2(C: TColor);
  52     procedure SetBackFrameColor1(C: TColor);
  53     procedure SetBackFrameColor2(C: TColor);
  54     procedure SetBackFillColor(C: TColor);
  55     procedure SetShadowColor(C: TColor);
  56   protected
  57     { Protected declarations }
  58     procedure Paint;
  59     procedure WMPaint(var Msg: TMessage); message WM_PAINT;
  60     procedure WMSize(var Msg: TMessage); message WM_SIZE;
  61     procedure WMActiv(var Msg: TMessage); message WM_SHOWWINDOW;
  62   public
  63     { Public declarations }
  64     constructor Create(Owner: TComponent); override;
  65   published
  66     { Published declarations }
  67     property Position1: integer read FPosition1 write SetPos1;
  68     property Position2: integer read FPosition2 write SetPos2;
  69     property Percent1: integer read FPercent1;
  70     property Percent2: integer read FPercent2;
  71     property Max: integer read FMax write SetMax;
  72     property Min: integer read FMin write SetMin;
  73     property Double: boolean read FDouble write SetDouble;
  74
  75     property LightColor1: TColor read FLightColor1 write SetLightColor1;
  76     property LightColor2: TColor read FLightColor2 write SetLightColor2;
  77     property DarkColor: TColor read FDarkColor write SetDarkColor;
  78     property FrameColor1: TColor read FFrameColor1 write SetFrameColor1;
  79     property FrameColor2: TColor read FFrameColor2 write SetFrameColor2;
  80     property FillColor1: TColor read FFillColor1 write SetFillColor1;
  81     property FillColor2: TColor read FFillColor2 write SetFillColor2;
  82     property BackFrameColor1: TColor read FBackFrameColor1 write SetBackFrameColor1;
  83     property BackFrameColor2: TColor read FBackFrameColor2 write SetBackFrameColor2;
  84     property BackFillColor: TColor read FBackFillColor write SetBackFillColor;
  85     property ShadowColor: TColor read FShadowColor write SetShadowColor;
  86
  87     procedure Add1(D: integer);
  88     procedure Add2(D: integer);
  89   end;
  90
  91 procedure Register;
  92
  93 implementation
  94
  95 {$R mckRarProgBar.dcr}
  96
  97 procedure Register;
  98 begin
  99   RegisterComponents('KOL', [TRarProgressBar]);
 100 end;
 101
 102 constructor TRarProgressBar.Create;
 103 begin
 104   inherited;
 105   Width:=204;
 106   Height:=18;
 107   FMin:=0;
 108   FMax:=100;
 109   FPosition1:=0;
 110   FPosition2:=0;
 111   FDouble:=False;
 112   FPercent1:=0;
 113   FPercent2:=0;
 114   FLightColor1:=clWhite;
 115   FDarkColor:=$606060;
 116   FLightColor2:=$C0FFFF;
 117   FFrameColor1:=$EEE8E8;
 118   FFrameColor2:=$B4D4E4;
 119   FFillColor1:=$DCD6D6;
 120   FFillColor2:=$A0C0D0;
 121   FBackFrameColor1:=$9494B4;
 122   FBackFrameColor2:=$80809E;
 123   FBackFillColor:=$6E6E94;
 124   FShadowColor:=$464040;
 125 end;
 126
 127 procedure TRarProgressBar.WMPaint;
 128 begin
 129   inherited;
 130   Paint;
 131 end;
 132
 133 procedure TRarProgressBar.WMSize;
 134 begin
 135   inherited;
 136   Paint;
 137 end;
 138
 139 procedure TRarProgressBar.WMActiv;
 140 begin
 141   inherited;
 142   Paint;
 143 end;
 144
 145 function TRarProgressBar.AdditionalUnits;
 146 begin
 147   Result:=', KOLRarProgBar';
 148 end;
 149
 150 procedure TRarProgressBar.SetupFirst;
 151 begin
 152   inherited;
 153   SL.Add(Prefix+AName+'.Position1 := '+IntToStr(FPosition1)+';');
 154   SL.Add(Prefix+AName+'.Position2 := '+IntToStr(FPosition2)+';');
 155   SL.Add(Prefix+AName+'.Min := '+IntToStr(FMin)+';');
 156   SL.Add(Prefix+AName+'.Max := '+IntToStr(FMax)+';');
 157   SL.Add(Prefix+AName+'.Double := '+Boolean2Str[FDouble]+';');
 158   SL.Add(Prefix+AName+'.LightColor1 := '+Color2Str(FLightColor1)+';');
 159   SL.Add(Prefix+AName+'.LightColor2 := '+Color2Str(FLightColor2)+';');
 160   SL.Add(Prefix+AName+'.DarkColor := '+Color2Str(FDarkColor)+';');
 161   SL.Add(Prefix+AName+'.FrameColor1 := '+Color2Str(FFrameColor1)+';');
 162   SL.Add(Prefix+AName+'.FrameColor2 := '+Color2Str(FFrameColor2)+';');
 163   SL.Add(Prefix+AName+'.FillColor1 := '+Color2Str(FFillColor1)+';');
 164   SL.Add(Prefix+AName+'.FillColor2 := '+Color2Str(FFillColor2)+';');
 165   SL.Add(Prefix+AName+'.BackFrameColor1 := '+Color2Str(FBackFrameColor1)+';');
 166   SL.Add(Prefix+AName+'.BackFrameColor2 := '+Color2Str(FBackFrameColor2)+';');
 167   SL.Add(Prefix+AName+'.BackFillColor := '+Color2Str(FBackFillColor)+';');
 168   SL.Add(Prefix+AName+'.ShadowColor := '+Color2Str(FShadowColor)+';');
 169 end;
 170
 171 procedure TRarProgressBar.SetPos1;
 172 begin
 173   if FDouble then if P<FPosition2 then P:=FPosition2;
 174   if P>FMax then P:=FMax;
 175   FPosition1:=P;
 176   Paint;
 177 end;
 178
 179 procedure TRarProgressBar.SetPos2;
 180 begin
 181   if FDouble then if P>FPosition1 then P:=FPosition1;
 182   FPosition2:=P;
 183   Paint;
 184 end;
 185
 186 procedure TRarProgressBar.SetMin;
 187 begin
 188   if M>FMax then M:=FMax;
 189   FMin:=M;
 190   Paint;
 191 end;
 192
 193 procedure TRarProgressBar.SetMax;
 194 begin
 195   if M<FMin then M:=FMin;
 196   FMax:=M;
 197   Paint;
 198 end;
 199
 200 procedure TRarProgressBar.SetDouble;
 201 begin
 202   FDouble:=D;
 203   Paint;
 204 end;
 205
 206 procedure TRarProgressBar.SetLightColor1;
 207 begin
 208   FLightColor1:=C;
 209   Paint;
 210 end;
 211
 212 procedure TRarProgressBar.SetLightColor2;
 213 begin
 214   FLightColor2:=C;
 215   Paint;
 216 end;
 217
 218 procedure TRarProgressBar.SetDarkColor;
 219 begin
 220   FDarkColor:=C;
 221   Paint;
 222 end;
 223
 224 procedure TRarProgressBar.SetFrameColor1;
 225 begin
 226   FFrameColor1:=C;
 227   Paint;
 228 end;
 229
 230 procedure TRarProgressBar.SetFrameColor2;
 231 begin
 232   FFrameColor2:=C;
 233   Paint;
 234 end;
 235
 236 procedure TRarProgressBar.SetFillColor1;
 237 begin
 238   FFillColor1:=C;
 239   Paint;
 240 end;
 241
 242 procedure TRarProgressBar.SetFillColor2;
 243 begin
 244   FFillColor2:=C;
 245   Paint;
 246 end;
 247
 248 procedure TRarProgressBar.SetBackFrameColor1;
 249 begin
 250   FBackFrameColor1:=C;
 251   Paint;
 252 end;
 253
 254 procedure TRarProgressBar.SetBackFrameColor2;
 255 begin
 256   FBackFrameColor2:=C;
 257   Paint;
 258 end;
 259
 260 procedure TRarProgressBar.SetBackFillColor;
 261 begin
 262   FBackFillColor:=C;
 263   Paint;
 264 end;
 265
 266 procedure TRarProgressBar.SetShadowColor;
 267 begin
 268   FShadowColor:=C;
 269   Paint;
 270 end;
 271
 272 procedure TRarProgressBar.Paint;
 273 var R: real;
 274     Prog: cardinal;
 275 begin
 276   TopX:=2;
 277   TopY:=2;
 278   SizeX:=Width-TopX-2;
 279   SizeY:=Height-TopY-4;
 280   if (SizeX=0) or (SizeY=0) or (FMax-FMin=0) then Exit;
 281
 282 ///////////////////////////////////////////////////////////////////////////////
 283 //              Drawing base
 284 ///////////////////////////////////////////////////////////////////////////////
 285
 286   Canvas.Brush.Style:=bsSolid;
 287   Canvas.Brush.Color:=Color;
 288   Canvas.FillRect(Bounds(0,0,Width,Height));
 289   Canvas.Brush.Color:=FShadowColor;
 290   Canvas.FillRect(Bounds(TopX+1,TopY+2,SizeX,SizeY));
 291   Canvas.Brush.Color:=FBackFillColor;
 292   Canvas.FillRect(Bounds(TopX,TopY,SizeX,SizeY+1));
 293   Canvas.Brush.Color:=FDarkColor;
 294   Canvas.FrameRect(Bounds(TopX,TopY,SizeX,SizeY+1));
 295   Canvas.Brush.Color:=FBackFrameColor1;
 296   Canvas.FrameRect(Bounds(TopX,TopY,SizeX,SizeY));
 297   Canvas.Brush.Color:=FBackFrameColor2;
 298   Canvas.FrameRect(Bounds(TopX+1,TopY+1,SizeX-2,SizeY-2));
 299
 300 ///////////////////////////////////////////////////////////////////////////////
 301 //              Drawing first bar
 302 ///////////////////////////////////////////////////////////////////////////////
 303
 304   R:=(FPosition1-FMin)/((FMax-FMin)/SizeX);
 305   Prog:=Round(R);
 306   FPercent1:=Byte(Round(R/(SizeX/100)));
 307   if Prog<>0 then
 308     begin
 309       Canvas.Brush.Color:=FLightColor1;
 310       Canvas.FillRect(Bounds(TopX,TopY,TopX+Prog-2,TopY+SizeY-2));
 311       if Prog>1 then
 312         begin
 313           Canvas.Brush.Color:=FFillColor1;
 314           Canvas.FillRect(Bounds(TopX+1,TopY+1,TopX+Prog-3,TopY+SizeY-3));
 315           Canvas.Brush.Color:=FFrameColor1;
 316           Canvas.FrameRect(Bounds(TopX+1,TopY+1,TopX+Prog-3,TopY+SizeY-3));
 317         end;
 318       Canvas.Brush.Color:=FDarkColor;
 319       Canvas.FillRect(Bounds(TopX+Prog,TopY,1,TopY+SizeY-1));
 320       if Prog<SizeX-1 then
 321         begin
 322           Canvas.Brush.Color:=FBackFillColor;
 323           Canvas.FillRect(Bounds(TopX+Prog+1,TopY,SizeX-Prog-1,SizeY));
 324           Canvas.Brush.Color:=FBackFrameColor1;
 325           Canvas.FrameRect(Bounds(TopX+Prog+1,TopY,SizeX-Prog-1,SizeY));
 326           Canvas.Brush.Color:=FBackFrameColor2;
 327           Canvas.FrameRect(Bounds(TopX+Prog+1,TopY+1,SizeX-Prog-2,SizeY-2));
 328         end;
 329     end;
 330
 331 ///////////////////////////////////////////////////////////////////////////////
 332 //              Drawing second bar
 333 ///////////////////////////////////////////////////////////////////////////////
 334
 335   if FDouble then
 336     begin
 337       R:=(FPosition2-FMin)/((FMax-FMin)/SizeX);
 338       Prog:=Round(R);
 339       FPercent2:=Byte(Round(R/(SizeX/100)));
 340       if Prog<>0 then
 341         begin
 342           Canvas.Brush.Color:=FLightColor2;
 343           Canvas.FillRect(Bounds(TopX,TopY,TopX+Prog-2,TopY+SizeY-2));
 344           if Prog>1 then
 345             begin
 346               Canvas.Brush.Color:=FFillColor2;
 347               Canvas.FillRect(Bounds(TopX+1,TopY+1,TopX+Prog-3,TopY+SizeY-3));
 348               Canvas.Brush.Color:=FFrameColor2;
 349               Canvas.FrameRect(Bounds(TopX+1,TopY+1,TopX+Prog-3,TopY+SizeY-3));
 350             end;
 351         end;
 352     end;
 353 end;
 354
 355 procedure TRarProgressBar.Add1;
 356 begin
 357   Inc(FPosition1,D);
 358   Paint;
 359 end;
 360
 361 procedure TRarProgressBar.Add2;
 362 begin
 363   Inc(FPosition2,D);
 364   Paint;
 365 end;
 366
 367 end.
 368