git-svn-id: https://svn.code.sf.net/p/kolmck/code@8 91bb2d04-0c0c-4d2d-88a5-bbb6f4c1fa07
This commit is contained in:
dkolmck
372
Addons/mckRarInfoBar.pas
Normal file
372
Addons/mckRarInfoBar.pas
Normal file
@@ -0,0 +1,372 @@
|
||||
unit mckRarInfoBar;
|
||||
|
||||
interface
|
||||
|
||||
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
|
||||
ComCtrls, ExtCtrls, Mirror;
|
||||
|
||||
const
|
||||
Boolean2Str: array [Boolean] of string = ('False','True');
|
||||
|
||||
type
|
||||
TRarInfoBar = class(TKOLControl)
|
||||
private
|
||||
{ Private declarations }
|
||||
FPosition: integer;
|
||||
FMin,FMax: integer;
|
||||
FShowPerc: boolean;
|
||||
|
||||
FLineColor,FTopColor,FSideColor1,FSideColor2,FEmptyColor1,FEmptyColor2,
|
||||
FEmptyFrameColor1,FEmptyFrameColor2,FBottomFrameColor,FBottomColor,
|
||||
FFilledFrameColor,FFilledColor,FFilledSideColor1,FFilledSideColor2: TColor;
|
||||
|
||||
TopX,TopY,Size: integer;
|
||||
|
||||
procedure SetPos(P: integer);
|
||||
procedure SetMin(M: integer);
|
||||
procedure SetMax(M: integer);
|
||||
procedure SetShowPerc(V: boolean);
|
||||
|
||||
procedure SetLineColor(C: TColor);
|
||||
procedure SetTopColor(C: TColor);
|
||||
procedure SetSideColor1(C: TColor);
|
||||
procedure SetSideColor2(C: TColor);
|
||||
procedure SetEmptyColor1(C: TColor);
|
||||
procedure SetEmptyColor2(C: TColor);
|
||||
procedure SetEmptyFrameColor1(C: TColor);
|
||||
procedure SetEmptyFrameColor2(C: TColor);
|
||||
procedure SetBottomFrameColor(C: TColor);
|
||||
procedure SetBottomColor(C: TColor);
|
||||
procedure SetFilledFrameColor(C: TColor);
|
||||
procedure SetFilledColor(C: TColor);
|
||||
procedure SetFilledSideColor1(C: TColor);
|
||||
procedure SetFilledSideColor2(C: TColor);
|
||||
protected
|
||||
{ Protected declarations }
|
||||
procedure Paint;
|
||||
procedure WMPaint(var Msg: TMessage); message WM_PAINT;
|
||||
procedure WMSize(var Msg: TMessage); message WM_SIZE;
|
||||
procedure WMActiv(var Msg: TMessage); message WM_SHOWWINDOW;
|
||||
function AdditionalUnits: string; override;
|
||||
procedure SetupFirst(SL: TStringList; const AName,AParent,Prefix: string); override;
|
||||
public
|
||||
{ Public declarations }
|
||||
constructor Create(Owner: TComponent); override;
|
||||
published
|
||||
{ Published declarations }
|
||||
property Position: integer read FPosition write SetPos;
|
||||
property Max: integer read FMax write SetMax;
|
||||
property Min: integer read FMin write SetMin;
|
||||
property ShowPercent: boolean read FShowPerc write SetShowPerc;
|
||||
|
||||
property LineColor: TColor read FLineColor write SetLineColor;
|
||||
property TopColor: TColor read FTopColor write SetTopColor;
|
||||
property SideColor1: TColor read FSideColor1 write SetSideColor1;
|
||||
property SideColor2: TColor read FSideColor2 write SetSideColor2;
|
||||
property EmptyColor1: TColor read FEmptyColor1 write SetEmptyColor1;
|
||||
property EmptyColor2: TColor read FEmptyColor2 write SetEmptyColor2;
|
||||
property EmptyFrameColor1: TColor read FEmptyFrameColor1 write SetEmptyFrameColor1;
|
||||
property EmptyFrameColor2: TColor read FEmptyFrameColor2 write SetEmptyFrameColor2;
|
||||
property BottomFrameColor: TColor read FBottomFrameColor write SetBottomFrameColor;
|
||||
property BottomColor: TColor read FBottomColor write SetBottomColor;
|
||||
property FilledFrameColor: TColor read FFilledFrameColor write SetFilledFrameColor;
|
||||
property FilledColor: TColor read FFilledColor write SetFilledColor;
|
||||
property FilledSideColor1: TColor read FFilledSideColor1 write SetFilledSideColor1;
|
||||
property FilledSideColor2: TColor read FFilledSideColor2 write SetFilledSideColor2;
|
||||
end;
|
||||
|
||||
procedure Register;
|
||||
|
||||
implementation
|
||||
|
||||
{$R mckRarInfoBar.dcr}
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterComponents('KOLAddons', [TRarInfoBar]);
|
||||
end;
|
||||
|
||||
constructor TRarInfoBar.Create;
|
||||
begin
|
||||
inherited;
|
||||
Width:=70;
|
||||
Height:=180;
|
||||
FMin:=0;
|
||||
FMax:=100;
|
||||
FPosition:=0;
|
||||
FLineColor:=$FFE0E0;
|
||||
FTopColor:=$FF8080;
|
||||
FSideColor1:=$E06868;
|
||||
FSideColor2:=$FF8080;
|
||||
FEmptyFrameColor1:=$A06868;
|
||||
FEmptyFrameColor2:=$BF8080;
|
||||
FEmptyColor1:=$C06868;
|
||||
FEmptyColor2:=$DF8080;
|
||||
FBottomFrameColor:=$64408C;
|
||||
FBottomColor:=$7A408C;
|
||||
FFilledFrameColor:=$8060A0;
|
||||
FFilledSideColor1:=$823C96;
|
||||
FFilledSideColor2:=$8848C0;
|
||||
FFilledColor:=$A060A0;
|
||||
FShowPerc:=True;
|
||||
Font.FontStyle:=[fsBold];
|
||||
Font.Color:=clPurple;
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.WMPaint;
|
||||
begin
|
||||
inherited;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.WMSize;
|
||||
begin
|
||||
inherited;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.WMActiv;
|
||||
begin
|
||||
inherited;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
function TRarInfoBar.AdditionalUnits;
|
||||
begin
|
||||
Result:=', KOLRarBar';
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.SetupFirst;
|
||||
begin
|
||||
inherited;
|
||||
SL.Add(Prefix+AName+'.Position := '+IntToStr(FPosition)+';');
|
||||
SL.Add(Prefix+AName+'.Min := '+IntToStr(FMin)+';');
|
||||
SL.Add(Prefix+AName+'.Max := '+IntToStr(FMax)+';');
|
||||
SL.Add(Prefix+AName+'.ShowPercent := '+Boolean2Str[FShowPerc]+';');
|
||||
SL.Add(Prefix+AName+'.LineColor := '+Color2Str(FLineColor)+';');
|
||||
SL.Add(Prefix+AName+'.TopColor := '+Color2Str(FTopColor)+';');
|
||||
SL.Add(Prefix+AName+'.SideColor1 := '+Color2Str(FSideColor1)+';');
|
||||
SL.Add(Prefix+AName+'.SideColor2 := '+Color2Str(FSideColor2)+';');
|
||||
SL.Add(Prefix+AName+'.EmptyFrameColor1 := '+Color2Str(FEmptyFrameColor1)+';');
|
||||
SL.Add(Prefix+AName+'.EmptyFrameColor2 := '+Color2Str(FEmptyFrameColor2)+';');
|
||||
SL.Add(Prefix+AName+'.EmptyColor1 := '+Color2Str(FEmptyColor1)+';');
|
||||
SL.Add(Prefix+AName+'.EmptyColor2 := '+Color2Str(FEmptyColor2)+';');
|
||||
SL.Add(Prefix+AName+'.BottomFrameColor := '+Color2Str(FBottomFrameColor)+';');
|
||||
SL.Add(Prefix+AName+'.BottomColor := '+Color2Str(FBottomColor)+';');
|
||||
SL.Add(Prefix+AName+'.FilledFrameColor := '+Color2Str(FFilledFrameColor)+';');
|
||||
SL.Add(Prefix+AName+'.FilledSideColor1 := '+Color2Str(FFilledSideColor1)+';');
|
||||
SL.Add(Prefix+AName+'.FilledSideColor2 := '+Color2Str(FFilledSideColor2)+';');
|
||||
SL.Add(Prefix+AName+'.FilledColor := '+Color2Str(FFilledColor)+';');
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.SetPos;
|
||||
begin
|
||||
if P>FMax then P:=FMax;
|
||||
FPosition:=P;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.SetMin;
|
||||
begin
|
||||
if M>FMax then M:=FMax;
|
||||
FMin:=M;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.SetMax;
|
||||
begin
|
||||
if M<FMin then M:=FMin;
|
||||
FMax:=M;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.SetLineColor;
|
||||
begin
|
||||
FLineColor:=C;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.SetTopColor;
|
||||
begin
|
||||
FTopColor:=C;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.SetSideColor1;
|
||||
begin
|
||||
FSideColor1:=C;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.SetSideColor2;
|
||||
begin
|
||||
FSideColor2:=C;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.SetEmptyColor1;
|
||||
begin
|
||||
FEmptyColor1:=C;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.SetEmptyColor2;
|
||||
begin
|
||||
FEmptyColor2:=C;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.SetEmptyFrameColor1;
|
||||
begin
|
||||
FEmptyFrameColor1:=C;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.SetEmptyFrameColor2;
|
||||
begin
|
||||
FEmptyFrameColor2:=C;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.SetBottomFrameColor;
|
||||
begin
|
||||
FBottomFrameColor:=C;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.SetBottomColor;
|
||||
begin
|
||||
FBottomColor:=C;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.SetFilledFrameColor;
|
||||
begin
|
||||
FFilledFrameColor:=C;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.SetFilledColor;
|
||||
begin
|
||||
FFilledColor:=C;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.SetFilledSideColor1;
|
||||
begin
|
||||
FFilledSideColor1:=C;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.SetFilledSideColor2;
|
||||
begin
|
||||
FFilledSideColor2:=C;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.SetShowPerc;
|
||||
begin
|
||||
FShowPerc:=V;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.Paint;
|
||||
procedure DrawFrame(C: TCanvas);
|
||||
begin
|
||||
C.Pen.Color:=FLineColor;
|
||||
C.Pen.Width:=1;
|
||||
C.Pen.Style:=psSolid;
|
||||
C.Pen.Mode:=pmCopy;
|
||||
C.MoveTo(TopX,TopY+5);
|
||||
C.LineTo(C.PenPos.X+15,C.PenPos.Y-5);
|
||||
C.LineTo(C.PenPos.X+15,C.PenPos.Y+5);
|
||||
C.LineTo(C.PenPos.X-15,C.PenPos.Y+5);
|
||||
C.LineTo(C.PenPos.X-15,C.PenPos.Y-5);
|
||||
C.LineTo(C.PenPos.X,C.PenPos.Y+(Size-10));
|
||||
C.LineTo(C.PenPos.X+15,C.PenPos.Y+5);
|
||||
C.LineTo(C.PenPos.X,C.PenPos.Y-(Size-10));
|
||||
C.MoveTo(C.PenPos.X,C.PenPos.Y+(Size-10));
|
||||
C.LineTo(C.PenPos.X+15,C.PenPos.Y-5);
|
||||
C.LineTo(C.PenPos.X,C.PenPos.Y-(Size-10));
|
||||
end;
|
||||
|
||||
var Points: array[1..4] of TPoint;
|
||||
Prog,Perc: integer;
|
||||
R: real;
|
||||
S: string;
|
||||
begin
|
||||
TopX:=0;
|
||||
TopY:=5;
|
||||
Size:=Height-TopY-5;
|
||||
if (Size=0) or ((FMax-FMin)=0) then
|
||||
begin
|
||||
Perc:=0;
|
||||
Prog:=0;
|
||||
end
|
||||
else
|
||||
begin
|
||||
R:=(FPosition-FMin)/((FMax-FMin)/(Size-10));
|
||||
Prog:=Round(R);
|
||||
Perc:=Round(R/((Size-10)/100));
|
||||
end;
|
||||
if Prog<0 then Prog:=0 else
|
||||
if Prog>Size-10 then Prog:=Size-10;
|
||||
Canvas.Brush.Color:=Color;
|
||||
Canvas.FillRect(Canvas.ClipRect);
|
||||
DrawFrame(Canvas);
|
||||
Canvas.Brush.Color:=FTopColor;
|
||||
Canvas.FloodFill(TopX+7,TopY+5,Canvas.Pixels[TopX+(15 div 2),TopY+5],fsSurface);
|
||||
Canvas.Brush.Color:=FSideColor1;
|
||||
Canvas.FloodFill(TopX+1,TopY+6,Canvas.Pixels[TopX+1,TopY+6],fsSurface);
|
||||
Canvas.Brush.Color:=FSideColor2;
|
||||
Canvas.FloodFill(TopX+29,TopY+6,Canvas.Pixels[TopX+29,TopY+6],fsSurface);
|
||||
if Prog>0 then
|
||||
begin
|
||||
Canvas.MoveTo(TopX,TopY+Size-5);
|
||||
Canvas.Pen.Color:=FBottomFrameColor;
|
||||
Canvas.LineTo(Canvas.PenPos.X+15,Canvas.PenPos.Y-5);
|
||||
Canvas.LineTo(Canvas.PenPos.X+15,Canvas.PenPos.Y+5);
|
||||
Canvas.Brush.Color:=FBottomColor;
|
||||
Canvas.FloodFill(TopX+7,TopY+Size-5,FSideColor1,fsSurface);
|
||||
Canvas.FloodFill(TopX+22,TopY+Size-5,FSideColor2,fsSurface);
|
||||
Canvas.Brush.Color:=FFilledColor;
|
||||
Canvas.Pen.Color:=FFilledFrameColor;
|
||||
Points[1]:=Point(TopX+15,TopY+Size-Prog);
|
||||
Points[2]:=Point(TopX,TopY+Size-Prog-5);
|
||||
Points[3]:=Point(TopX+15,TopY+Size-Prog-10);
|
||||
Points[4]:=Point(TopX+30,TopY+Size-Prog-5);
|
||||
Canvas.Polygon(Points);
|
||||
Canvas.Brush.Color:=FFilledSideColor1;
|
||||
Canvas.FloodFill(TopX+1,TopY+Size-5-(Prog div 2),FSideColor1,fsSurface);
|
||||
Canvas.Brush.Color:=FFilledSideColor2;
|
||||
Canvas.FloodFill(TopX+29,TopY+Size-5-(Prog div 2),FSideColor2,fsSurface);
|
||||
DrawFrame(Canvas);
|
||||
end
|
||||
else
|
||||
begin
|
||||
{EMPTY}
|
||||
Canvas.MoveTo(TopX,TopY+Size-5);
|
||||
Canvas.Pen.Color:=FEmptyFrameColor1;
|
||||
Canvas.LineTo(Canvas.PenPos.X+15,Canvas.PenPos.Y-5);
|
||||
Canvas.Pen.Color:=FEmptyFrameColor2;
|
||||
Canvas.LineTo(Canvas.PenPos.X+15,Canvas.PenPos.Y+5);
|
||||
DrawFrame(Canvas);
|
||||
Canvas.Brush.Color:=FEmptyColor1;
|
||||
Canvas.FloodFill(TopX+7,TopY+Size-5,FSideColor1,fsSurface);
|
||||
Canvas.Brush.Color:=FEmptyColor2;
|
||||
Canvas.FloodFill(TopX+22,TopY+Size-5,FSideColor2,fsSurface);
|
||||
end;
|
||||
if FShowPerc then
|
||||
begin
|
||||
Canvas.Font.Name:=Font.FontName;
|
||||
Canvas.Font.Height:=Font.FontHeight;
|
||||
Canvas.Font.Color:=Font.Color;
|
||||
Canvas.Font.Style:=Font.FontStyle;
|
||||
Canvas.Brush.Color:=Color;
|
||||
S:=IntToStr(Perc)+' %';
|
||||
Canvas.TextOut(TopX+33,TopY+Size-Prog-Canvas.TextHeight(S),S);
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user