1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:

unit AppleProgressBar;

interface

uses
  SysUtils, Classes, Controls, ExtCtrls, Graphics;

type
  TAppleProgressBar = class(TPaintBox)
  private
    FEnabled: Boolean;
    FAnim: Integer;
    FPosition: Integer;
    FAnimated: Boolean;
    FTimer: TTimer;
    FBar: TBitmap;
    FInactiveBar: TBitmap;
    FBarBGLeft: TBitmap;
    FBarBGRight: TBitmap;
    FBarBG: TBitmap;
  protected
    procedure SetEnabled(Value: Boolean);
    procedure SetPosition(Value: Integer);
    procedure SetAnimated(Value: Boolean);
    procedure DoTimer(Sender: TObject);
    procedure SetBar(Value: TBitmap);
    procedure SetInactiveBar(Value: TBitmap);
    procedure SetBarBGLeft(Value: TBitmap);
    procedure SetBarBgRight(Value: TBitmap);
    procedure SetBarBG(Value: TBitmap);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Repaint; override;
  published
    property Enabled: Boolean read FEnabled write SetEnabled;
    property Position: Integer read FPosition write SetPosition;
    property Animated: Boolean read FAnimated write SetAnimated;
    property Bar: TBitmap read FBar write SetBar;
    property InactiveBar: TBitmap read FInactiveBar write SetInactiveBar;
    property BarBGLeft: TBitmap read FBarBGLeft write SetBarBGLeft;
    property BarBGRight: TBitmap read FBarBGRight write SetBarBGRight;
    property BarBG: TBitmap read FBarBG write SetBarBG;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('CapSystems', [TAppleProgressBar]);
end;

{ TAppleProgressBar }
constructor TAppleProgressBar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FEnabled := True;
  FPosition := 0;
  FAnimated := False;
  FTimer := TTimer.Create(Self);
  with FTimer do
  begin
    OnTimer := DoTimer;
    Enabled := False;
    Interval := 50;
  end;
  FAnim := 0;
  FBar := TBitmap.Create;
  FInactiveBar := TBitmap.Create;
  FBarBGLeft := TBitmap.Create;
  FBarBGRight := TBitmap.Create;
  FBarBG := TBitmap.Create;
end;

destructor TAppleProgressBar.Destroy;
begin
  FTimer.Free;
  FBar.Free;
  FBarBGLeft.Free;
  FBarBGRight.Free;
  FBarBG.Free;
  FInactiveBar.Free;
  inherited Destroy;
end;

procedure TAppleProgressBar.Repaint;
var
  i, p: Integer;
  tmpImage: TBitmap;
begin
  p := 0;
  Canvas.Draw(0, 0, FBarBGLeft);
  Canvas.Draw(Width - 3, 0, FBarBGRight);
  tmpImage := TBitmap.Create;
  if FEnabled then
    tmpImage.Assign(FBar)
  else
    tmpImage.Assign(FInactiveBar);

  for i := Width downto 1 do
  begin
    if (i - 8 - p * 7 - FAnim) > -16 then
      Canvas.Draw(i - 8 - p * 7 - FAnim, 0, tmpImage)
    else
      FAnim := FAnim - 8;
    Inc(p);
    if p = 8 then
      p := 0;
  end;
  tmpImage.Free;
  Canvas.StretchDraw(Rect(Round(Width div 100 * FPosition), 0, Width, 12), FBarBG);
end;

procedure TAppleProgressBar.SetEnabled(Value: Boolean);
begin
  FEnabled := Value;
  Repaint;
end;

procedure TAppleProgressBar.SetPosition(Value: Integer);
begin
  FPosition := Value;
  Repaint;
end;

procedure TAppleProgressBar.SetAnimated(Value: Boolean);
begin
  FAnimated := Value;
  FTimer.Enabled := Value;
  Repaint;
end;

procedure TAppleProgressbar.DoTimer(Sender: TObject);
begin
  if FAnimated then
  begin
    Inc(FAnim);
    Refresh;
  end;
end;

procedure TAppleProgressbar.SetBar(Value: TBitmap);
begin
  FBar.Assign(Value);
end;

procedure TAppleProgressbar.SetInactiveBar(Value: TBitmap);
begin
  FInactiveBar.Assign(Value);
end;

procedure TAppleProgressbar.SetBarBGLeft(Value: TBitmap);
begin
  FBarBGLeft.Assign(Value);
end;

procedure TAppleProgressbar.SetBarBgRight(Value: TBitmap);
begin
  FBarBGRight.Assign(Value);
end;

procedure TAppleProgressbar.SetBarBG(Value: TBitmap);
begin
  FBarBG.Assign(Value);
end;

end.                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:

procedure TAppleProgressBar.paint;
var i,p:integer;
    tmpImage:TBitmap;
begin
  p:=0;
  tmpcanvas.width := width;
  tmpcanvas.height := FbarBG.Height;
  //Draw the left bar Background graphic:
  tmpcanvas.canvas.Draw(0,0,FbarBGleft);
  //Draw the right bar Baclground graphic:
  tmpcanvas.canvas.Draw(Width-3,0,FbarBGRight);
  //Load and draw the Progressbar graphic:
  tmpImage := TBitmap.Create;
  if FColorMode=Blue then
    tmpImage.Assign(FBar)
  else
    tmpImage.Assign(FInactiveBar);

  for i:=Width downto 1 do  BEGIN
    if (i-bar.Width-p*(bar.Width-1)-FAnim)>-bar.Width*2 then tmpcanvas.canvas.Draw(i-bar.Width-p*(bar.Width-1)-FAnim,0,tmpimage) else FAnim:=FAnim-bar.Width;
    inc(p);
    if p=bar.Width then p:=0;
 end;

 tmpImage.Free;
  //Ddraw the middle bar graphic stretched:
  tmpcanvas.Canvas.StretchDraw(rect(round(Width/100*FPosition),0,Width,12),FbarBG);
  Canvas.Draw(0,0,tmpcanvas);
end;                    

1:
2:
3:
4:

procedure TSBControl.WMEraseBkgnd(var Msg: TWMEraseBkgnd);
begin
  Msg.Result:=1;
end;