realoneprogressbar.pas

来自「TRealOneProgressBar 类似RealOne播放器安装程序中的进度」· PAS 代码 · 共 268 行

unit RealOneProgressBar;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  TRealOneProgressBar = class(TGraphicControl)
  private
    { Private declarations }
    FBorderColor: TColor;
    FBackgroundColor: TColor;
    FFillColor: TColor;
    FBaseInnerHighColor: TColor;
    FBaseInnerLowColor: TColor;
    FInnerHighColor: TColor;
    FInnerLowColor: TColor;
    FMin, FMax, FStep: Integer;
    FPosition: Integer;

    procedure SetBorderColor(Value: TColor);
    procedure SetBackgroundColor(Value: TColor);
    procedure SetFillColor(Value: TColor);
    procedure SetBaseInnerHighColor(Value: TColor);
    procedure SetBaseInnerLowCOlor(Value: TColor);
    procedure SetInnerHighColor(Value: TColor);
    procedure SetInnerLowCOlor(Value: TColor);

    procedure SetMin(Value: Integer);
    procedure SetMax(Value: Integer);
    procedure SetPosition(Value: Integer);
    procedure SetStep(Value: Integer);

    function GetPercent: Byte;
  protected
    { Protected declarations }
    procedure Paint; override;
    procedure ZPaint;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    { Published declarations }
    property BorderColor: TColor read FBorderColor write SetBorderColor default $00636563;
    property BackgroundColor: TColor read FBackgroundColor write SetBackgroundColor default $00E7E7E7;
    property FillColor: TColor read FFillColor write SetFillColor default $00BD8A52;
    property BaseInnerHighColor: TColor read FBaseInnerHighColor write SetBaseInnerHighColor default $00BDBEBD;
    property BaseInnerLowColor: TColor read FBaseInnerLowColor write SetBaseInnerLowColor default clWhite;
    property InnerHighColor: TColor read FInnerHighColor write SetInnerHighColor default $00CEA684;
    property InnerLowCOlor: TColor read FInnerLowColor write SetInnerLowColor default $007B4910;
    property Min: Integer read FMin write SetMin default 0;
    property Max: Integer read FMax write SetMax default 100;
    property Position: Integer read FPosition write SetPosition;
    property Step: Integer read FStep write SetStep;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('ZeroZone', [TRealOneProgressBar]);
end;

{ TRealOneProgressBar }
constructor TRealOneProgressBar.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 ControlStyle := ControlStyle + [csOpaque];
 FBorderColor := $00636563;
 FBackgroundColor := $00E7E7E7;
 FFillColor := $00BD8A52;
 FBaseInnerHighColor := $00BDBEBD;
 FBaseInnerLowColor := clWhite;
 FInnerHighColor := $00CEA684;
 FInnerLowColor := $007B4910;
 FMin := 0;
 FMax := 100;
 FPosition := 50;
 FStep := 10;
 Width := 200;
 Height := 20;
end;

destructor TRealOneProgressBar.Destroy;
begin
 inherited Destroy;
end;

procedure TRealOneProgressBar.SetBorderColor(Value: TColor);
begin
 if FBorderColor <> Value then
  begin
    FBorderCOlor := Value;
    ZPaint;
  end;
end;

procedure TRealOneProgressBar.SetBackgroundColor(Value: TColor);
begin
 if FBackgroundColor <> Value then
  begin
    FBackgroundCOlor := Value;
    ZPaint;
  end;
end;

procedure TRealOneProgressBar.SetFillColor(Value: TColor);
begin
 if FFillColor <> Value then
  begin
    FFillCOlor := Value;
    ZPaint;
  end;
end;

procedure TRealOneProgressBar.SetBaseInnerHighColor(Value: TColor);
begin
 if FBaseInnerHighCOlor <> Value then
  begin
    FBaseInnerHighColor := Value;
    ZPaint;
  end;
end;

procedure TRealOneProgressBar.SetBaseInnerLowCOlor(Value: TColor);
begin
 if FBaseInnerLowCOlor <> Value then
  begin
    FBaseInnerLowCOlor := Value;
    ZPaint;
  end;
end;

procedure TRealOneProgressBar.SetInnerHighColor(Value: TColor);
begin
 if FInnerHighCOlor <> Value then
  begin
    FInnerHighColor := Value;
    ZPaint;
  end;
end;

procedure TRealOneProgressBar.SetInnerLowCOlor(Value: TColor);
begin
 if FInnerLowColor <> Value then
  begin
    FInnerLowColor := Value;
    ZPaint;
  end;
end;

procedure TRealOneProgressBar.SetMin(Value: Integer);
begin
 if FMin <> Value then
  begin
    FMin := Value;
    if FPosition < Value then FPosition := Value;
    ZPaint;
  end;
end;

procedure TRealOneProgressBar.SetMax(Value: Integer);
begin
 if FMax <> Value then
  begin
    FMax := Value;
    if FPosition > Value then FPosition := Value;
    ZPaint;
  end;
end;

procedure TRealOneProgressBar.SetPosition(Value: Integer);
begin
 if Value > FMax then Value := FMax;
 if Value < FMin then Value := FMin;
 if FPosition <> Value then
  begin
    FPosition := Value;
    ZPaint;
  end;
end;

procedure TRealOneProgressBar.SetStep(Value: Integer);
begin
 if FStep <> Value then
  begin
    FStep := Value;
    ZPaint;
  end;
end;

procedure TRealOneProgressBar.Paint;
var
  RealWidth: Integer;
  R: TRect;
  MBitmap: TBitmap;
begin
 MBitmap := TBitmap.Create;
 MBitmap.Width := Width;
 MBitmap.Height := Height;
 MBitmap.Canvas.Brush.Color := clBtnFace;
 MBitmap.Canvas.FillRect(Rect(0,0,Width,Height));
 MBitmap.Canvas.Pen.Color := FBorderColor;
 MBitmap.Canvas.Brush.Style := bsClear;
 //Draw Base Image
 with MBitmap.Canvas do
  begin
   RoundRect(0, 0, width, Height, 2, 2);
   Pen.Width := 1;
   Pen.Color := FBaseInnerHighColor;
   MoveTo(1, 1);
   LineTo(1, Height - 1);
   MoveTo(1, 1);
   LineTo(Width - 1, 1);
   Pen.Color := FBaseInnerLowColor;
   MoveTo(Width - 2, 2);
   LineTo(Width - 2, Height - 2);
   LineTo(1, Height - 2);
   Brush.Color := FBackgroundColor;
   FillRect(Rect(2,2,Width-2, Height-2));
  end;
  //Draw Bar
  if FPosition > 0 then
  with MBitmap.Canvas do
   begin
    RealWidth := Trunc((Width - 3)*GetPercent/100)+1;
    R := Rect(2,2,RealWidth+1, Height-2);
    Brush.Color := FFillColor;
    FillRect(R);
    Pen.Color := FInnerHighColor;
    MoveTo(1, 1);
    LineTo(1, Height - 1);
    MoveTo(1, 1);
    LineTo(RealWidth +1, 1);
    Pen.Color := FInnerLowCOlor;
    MoveTo(2, Height - 2);
    LineTo(RealWidth + 1, Height -2);
   end;
   Canvas.Draw(0,0,MBitmap);
   MBitmap.Free;
end;

procedure TRealOneProgressBar.ZPaint;
begin
 if csOpaque in ControlStyle then
  RePaint
 else
  begin
    ControlStyle := ControlStyle + [csOpaque];
    RePaint;
    ControlStyle := ControlStyle - [csOpaque];
  end;
end;

function TRealOneProgressBar.GetPercent: Byte;
begin
 if (FMax - FMin) = 0 then
  Result := 0
 else
  Result := Trunc(((FPosition - FMin)/(FMax - FMin)) * 100);
end;

end.