378 lines
10 KiB
ObjectPascal
378 lines
10 KiB
ObjectPascal
//////////////////////////////////////////////////////////////////////
|
|
// //
|
|
// TRarProgressBar version 1.0 //
|
|
// Description: TRarProgressBar is a component which //
|
|
// displays dual progress bar like a WinRAR //
|
|
// Author: Dimaxx //
|
|
// //
|
|
//////////////////////////////////////////////////////////////////////
|
|
|
|
unit KOLRarProgBar;
|
|
|
|
interface
|
|
|
|
uses Windows, Messages, Kol, Objects;
|
|
|
|
type
|
|
PRarProgBar =^TRarProgBar;
|
|
TRarProgressBar = PRarProgBar;
|
|
TRarProgBar = object(TObj)
|
|
private
|
|
{ Private declarations }
|
|
FControl: PControl;
|
|
FPosition1: integer;
|
|
FPosition2: integer;
|
|
FPercent1,FPercent2: integer;
|
|
FDouble: boolean;
|
|
B: PBitmap;
|
|
|
|
FLightColor1,FDarkColor,FLightColor2,FFrameColor1,FFrameColor2,
|
|
FFillColor1,FFillColor2,FBackFrameColor1,FBackFrameColor2,
|
|
FBackFillColor,FShadowColor: TColor;
|
|
|
|
TopX,TopY,SizeX,SizeY: integer;
|
|
|
|
FMin,FMax: integer;
|
|
OldWind,NewWind: integer;
|
|
procedure SetPos1(P: integer);
|
|
procedure SetPos2(P: integer);
|
|
procedure SetMin(M: integer);
|
|
procedure SetMax(M: integer);
|
|
procedure SetDouble(D: boolean);
|
|
|
|
procedure SetLightColor1(C: TColor);
|
|
procedure SetLightColor2(C: TColor);
|
|
procedure SetDarkColor(C: TColor);
|
|
procedure SetFrameColor1(C: TColor);
|
|
procedure SetFrameColor2(C: TColor);
|
|
procedure SetFillColor1(C: TColor);
|
|
procedure SetFillColor2(C: TColor);
|
|
procedure SetBackFrameColor1(C: TColor);
|
|
procedure SetBackFrameColor2(C: TColor);
|
|
procedure SetBackFillColor(C: TColor);
|
|
procedure SetShadowColor(C: TColor);
|
|
protected
|
|
{ Protected declarations }
|
|
procedure NewWndProc(var Msg: TMessage);
|
|
procedure Paint;
|
|
public
|
|
destructor Destroy; virtual;
|
|
function SetPosition(X,Y: integer): PRarProgBar; overload;
|
|
function SetSize(X,Y: integer): PRarProgBar; overload;
|
|
function SetAlign(A: TControlAlign): PRarProgBar; overload;
|
|
{ Public declarations }
|
|
property Position1: integer read FPosition1 write SetPos1;
|
|
property Position2: integer read FPosition2 write SetPos2;
|
|
property Percent1: integer read FPercent1;
|
|
property Percent2: integer read FPercent2;
|
|
property Max: integer read FMax write SetMax;
|
|
property Min: integer read FMin write SetMin;
|
|
property Double: boolean read FDouble write SetDouble;
|
|
|
|
property LightColor1: TColor read FLightColor1 write SetLightColor1;
|
|
property LightColor2: TColor read FLightColor2 write SetLightColor2;
|
|
property DarkColor: TColor read FDarkColor write SetDarkColor;
|
|
property FrameColor1: TColor read FFrameColor1 write SetFrameColor1;
|
|
property FrameColor2: TColor read FFrameColor2 write SetFrameColor2;
|
|
property FillColor1: TColor read FFillColor1 write SetFillColor1;
|
|
property FillColor2: TColor read FFillColor2 write SetFillColor2;
|
|
property BackFrameColor1: TColor read FBackFrameColor1 write SetBackFrameColor1;
|
|
property BackFrameColor2: TColor read FBackFrameColor2 write SetBackFrameColor2;
|
|
property BackFillColor: TColor read FBackFillColor write SetBackFillColor;
|
|
property ShadowColor: TColor read FShadowColor write SetShadowColor;
|
|
|
|
procedure Add1(D: integer);
|
|
procedure Add2(D: integer);
|
|
end;
|
|
|
|
function NewTRarProgressBar(AOwner: PControl): PRarProgBar;
|
|
|
|
implementation
|
|
|
|
function Bounds(ALeft,ATop,AWidth,AHeight: integer): TRect;
|
|
begin
|
|
with Result do
|
|
begin
|
|
Left:=ALeft;
|
|
Top:=ATop;
|
|
Right:=ALeft+AWidth;
|
|
Bottom:=ATop+AHeight;
|
|
end;
|
|
end;
|
|
|
|
function NewTRarProgressBar;
|
|
var P: PRarProgBar;
|
|
C: PControl;
|
|
begin
|
|
C:=pointer(_NewControl(AOwner,'STATIC',WS_VISIBLE or WS_CHILD or SS_LEFTNOWORDWRAP or SS_NOPREFIX or SS_NOTIFY,False,nil));
|
|
C.CreateWindow;
|
|
New(P,Create);
|
|
AOwner.Add2AutoFree(P);
|
|
AOwner.Add2AutoFree(C);
|
|
P.FControl:=C;
|
|
P.FMin:=0;
|
|
P.FMax:=100;
|
|
P.FPosition1:=0;
|
|
P.FPosition2:=0;
|
|
P.FDouble:=False;
|
|
P.FPercent1:=0;
|
|
P.FPercent2:=0;
|
|
P.FLightColor1:=clWhite;
|
|
P.FDarkColor:=$606060;
|
|
P.FLightColor2:=$C0FFFF;
|
|
P.FFrameColor1:=$EEE8E8;
|
|
P.FFrameColor2:=$B4D4E4;
|
|
P.FFillColor1:=$DCD6D6;
|
|
P.FFillColor2:=$A0C0D0;
|
|
P.FBackFrameColor1:=$9494B4;
|
|
P.FBackFrameColor2:=$80809E;
|
|
P.FBackFillColor:=$6E6E94;
|
|
P.FShadowColor:=$464040;
|
|
C.SetSize(204,18);
|
|
P.B:=NewBitmap(C.Width,C.Height);
|
|
Result:=P;
|
|
P.OldWind:=GetWindowLong(C.Handle,GWL_WNDPROC);
|
|
P.NewWind:=integer(MakeObjectInstance(P.NewWndProc));
|
|
SetWindowLong(C.Handle,GWL_WNDPROC,P.NewWind);
|
|
end;
|
|
|
|
destructor TRarProgBar.Destroy;
|
|
begin
|
|
SetWindowLong(FControl.Handle,GWL_WNDPROC,OldWind);
|
|
FreeObjectInstance(Pointer(NewWind));
|
|
B.Free;
|
|
inherited;
|
|
end;
|
|
|
|
function TRarProgBar.SetPosition(X,Y: integer): PRarProgBar;
|
|
begin
|
|
FControl.Left:=X;
|
|
FControl.Top:=Y;
|
|
Result:=@Self;
|
|
end;
|
|
|
|
function TRarProgBar.SetSize(X,Y: integer): PRarProgBar;
|
|
begin
|
|
FControl.Width:=X;
|
|
FControl.Height:=Y;
|
|
B.Width:=X;
|
|
B.Height:=Y;
|
|
Result:=@Self;
|
|
end;
|
|
|
|
function TRarProgBar.SetAlign(A: TControlAlign): PRarProgBar;
|
|
begin
|
|
FControl.Align:=A;
|
|
Result:=@Self;
|
|
end;
|
|
|
|
procedure TRarProgBar.NewWndProc;
|
|
begin
|
|
Msg.Result:=CallWindowProc(Pointer(OldWind),FControl.Handle,Msg.Msg,Msg.wParam,Msg.lParam);
|
|
case Msg.Msg of
|
|
WM_PAINT : Paint;
|
|
WM_SIZE : Paint;
|
|
WM_ACTIVATE: Paint;
|
|
end;
|
|
end;
|
|
|
|
procedure TRarProgBar.SetMin;
|
|
begin
|
|
if M>FMax then M:=FMax;
|
|
FMin:=M;
|
|
Paint;
|
|
end;
|
|
|
|
procedure TRarProgBar.SetMax;
|
|
begin
|
|
if M<FMin then M:=FMin;
|
|
FMax:=M;
|
|
Paint;
|
|
end;
|
|
|
|
procedure TRarProgBar.SetPos1;
|
|
begin
|
|
if FDouble then if P<FPosition2 then P:=FPosition2;
|
|
if P>FMax then P:=FMax;
|
|
FPosition1:=P;
|
|
Paint;
|
|
end;
|
|
|
|
procedure TRarProgBar.SetPos2;
|
|
begin
|
|
if FDouble then if P>FPosition1 then P:=FPosition1;
|
|
FPosition2:=P;
|
|
Paint;
|
|
end;
|
|
|
|
procedure TRarProgBar.SetDouble;
|
|
begin
|
|
FDouble:=D;
|
|
Paint;
|
|
end;
|
|
|
|
procedure TRarProgBar.SetLightColor1;
|
|
begin
|
|
FLightColor1:=C;
|
|
Paint;
|
|
end;
|
|
|
|
procedure TRarProgBar.SetLightColor2;
|
|
begin
|
|
FLightColor2:=C;
|
|
Paint;
|
|
end;
|
|
|
|
procedure TRarProgBar.SetDarkColor;
|
|
begin
|
|
FDarkColor:=C;
|
|
Paint;
|
|
end;
|
|
|
|
procedure TRarProgBar.SetFrameColor1;
|
|
begin
|
|
FFrameColor1:=C;
|
|
Paint;
|
|
end;
|
|
|
|
procedure TRarProgBar.SetFrameColor2;
|
|
begin
|
|
FFrameColor2:=C;
|
|
Paint;
|
|
end;
|
|
|
|
procedure TRarProgBar.SetFillColor1;
|
|
begin
|
|
FFillColor1:=C;
|
|
Paint;
|
|
end;
|
|
|
|
procedure TRarProgBar.SetFillColor2;
|
|
begin
|
|
FFillColor2:=C;
|
|
Paint;
|
|
end;
|
|
|
|
procedure TRarProgBar.SetBackFrameColor1;
|
|
begin
|
|
FBackFrameColor1:=C;
|
|
Paint;
|
|
end;
|
|
|
|
procedure TRarProgBar.SetBackFrameColor2;
|
|
begin
|
|
FBackFrameColor2:=C;
|
|
Paint;
|
|
end;
|
|
|
|
procedure TRarProgBar.SetBackFillColor;
|
|
begin
|
|
FBackFillColor:=C;
|
|
Paint;
|
|
end;
|
|
|
|
procedure TRarProgBar.SetShadowColor;
|
|
begin
|
|
FShadowColor:=C;
|
|
Paint;
|
|
end;
|
|
|
|
procedure TRarProgBar.Paint;
|
|
var R: real;
|
|
Prog: cardinal;
|
|
begin
|
|
TopX:=2;
|
|
TopY:=2;
|
|
SizeX:=FControl.Width-TopX-2;
|
|
SizeY:=FControl.Height-TopY-4;
|
|
if (SizeX=0) or (SizeY=0) or (FMax-FMin=0) then Exit;
|
|
|
|
///////////////////////////////////////////////////////////////////////////////
|
|
// ������ ������
|
|
///////////////////////////////////////////////////////////////////////////////
|
|
|
|
B.Canvas.Brush.BrushStyle:=bsSolid;
|
|
B.Canvas.Brush.Color:=FControl.Color;
|
|
B.Canvas.FillRect(Bounds(0,0,B.Width,B.Height));
|
|
B.Canvas.Brush.Color:=FShadowColor;
|
|
B.Canvas.FillRect(Bounds(TopX+1,TopY+2,SizeX,SizeY));
|
|
B.Canvas.Brush.Color:=FBackFillColor;
|
|
B.Canvas.FillRect(Bounds(TopX,TopY,SizeX,SizeY+1));
|
|
B.Canvas.Brush.Color:=FDarkColor;
|
|
B.Canvas.FrameRect(Bounds(TopX,TopY,SizeX,SizeY+1));
|
|
B.Canvas.Brush.Color:=FBackFrameColor1;
|
|
B.Canvas.FrameRect(Bounds(TopX,TopY,SizeX,SizeY));
|
|
B.Canvas.Brush.Color:=FBackFrameColor2;
|
|
B.Canvas.FrameRect(Bounds(TopX+1,TopY+1,SizeX-2,SizeY-2));
|
|
|
|
///////////////////////////////////////////////////////////////////////////////
|
|
// ������ ������ ���������
|
|
///////////////////////////////////////////////////////////////////////////////
|
|
|
|
R:=(FPosition1-FMin)/((FMax-FMin)/SizeX);
|
|
Prog:=Round(R);
|
|
FPercent1:=Byte(Round(R/(SizeX/100)));
|
|
if Prog<>0 then
|
|
begin
|
|
B.Canvas.Brush.Color:=FLightColor1;
|
|
B.Canvas.FillRect(Bounds(TopX,TopY,TopX+Prog-2,TopY+SizeY-2));
|
|
if Prog>1 then
|
|
begin
|
|
B.Canvas.Brush.Color:=FFillColor1;
|
|
B.Canvas.FillRect(Bounds(TopX+1,TopY+1,TopX+Prog-3,TopY+SizeY-3));
|
|
B.Canvas.Brush.Color:=FFrameColor1;
|
|
B.Canvas.FrameRect(Bounds(TopX+1,TopY+1,TopX+Prog-3,TopY+SizeY-3));
|
|
end;
|
|
B.Canvas.Brush.Color:=FDarkColor;
|
|
B.Canvas.FillRect(Bounds(TopX+Prog,TopY,1,TopY+SizeY-1));
|
|
if Prog<SizeX-1 then
|
|
begin
|
|
B.Canvas.Brush.Color:=FBackFillColor;
|
|
B.Canvas.FillRect(Bounds(TopX+Prog+1,TopY,SizeX-Prog-1,SizeY));
|
|
B.Canvas.Brush.Color:=FBackFrameColor1;
|
|
B.Canvas.FrameRect(Bounds(TopX+Prog+1,TopY,SizeX-Prog-1,SizeY));
|
|
B.Canvas.Brush.Color:=FBackFrameColor2;
|
|
B.Canvas.FrameRect(Bounds(TopX+Prog+1,TopY+1,SizeX-Prog-2,SizeY-2));
|
|
end;
|
|
end;
|
|
|
|
///////////////////////////////////////////////////////////////////////////////
|
|
// ������ ������ ���������
|
|
///////////////////////////////////////////////////////////////////////////////
|
|
|
|
if FDouble then
|
|
begin
|
|
R:=(FPosition2-FMin)/((FMax-FMin)/SizeX);
|
|
Prog:=Round(R);
|
|
FPercent2:=Byte(Round(R/(SizeX/100)));
|
|
if Prog<>0 then
|
|
begin
|
|
B.Canvas.Brush.Color:=FLightColor2;
|
|
B.Canvas.FillRect(Bounds(TopX,TopY,TopX+Prog-2,TopY+SizeY-2));
|
|
if Prog>1 then
|
|
begin
|
|
B.Canvas.Brush.Color:=FFillColor2;
|
|
B.Canvas.FillRect(Bounds(TopX+1,TopY+1,TopX+Prog-3,TopY+SizeY-3));
|
|
B.Canvas.Brush.Color:=FFrameColor2;
|
|
B.Canvas.FrameRect(Bounds(TopX+1,TopY+1,TopX+Prog-3,TopY+SizeY-3));
|
|
end;
|
|
end;
|
|
end;
|
|
FControl.Canvas.CopyRect(Bounds(0,0,FControl.Width,FControl.Height),B.Canvas,Bounds(0,0,B.Width,B.Height));
|
|
end;
|
|
|
|
procedure TRarProgBar.Add1;
|
|
begin
|
|
Inc(FPosition1,D);
|
|
Paint;
|
|
end;
|
|
|
|
procedure TRarProgBar.Add2;
|
|
begin
|
|
Inc(FPosition2,D);
|
|
Paint;
|
|
end;
|
|
|
|
end.
|
|
|