unit ColorProgressBar;

interface

uses
  SysUtils,Classes,Controls,
  ComCtrls,Graphics,Windows;

type
  TColorProgressBar = class(TGraphicControl)
  private
    { Private declarations }
    FColorBegin,FColorEnd :TColor;
    RedBegin,GreenBegin,BlueBegin :Byte;
    RedEnd,GreenEnd,BlueEnd :Byte;
    FMin,FMax,FPosition,FStep :Integer;
    FAutoStep :Boolean;
    FOrientation :TProgressBarOrientation;
    FSmooth :Boolean;

    //zdarzenie
    FOnPositionChanged :TNotifyEvent;
    procedure PositionChanged;

    function ObliczKolor(i: Integer) :TColor; inline;

    procedure SetRange(AMin,AMax,APosition,AStep :Integer);
    procedure SetPosition(APosition :Integer);
    procedure SetMin(AMin :Integer);
    procedure SetMax(AMax :Integer);
    procedure SetStep(AStep :Integer);
    procedure SetOrientation(AOrientation :TProgressBarOrientation);
    procedure SetColorBegin(AColorBegin :TColor);
    procedure SetColorEnd(AColorEnd :TColor);
    procedure SetSmooth(ASmooth :Boolean);
    procedure SetAutoStep(AAutoStep :Boolean);

  protected
    { Protected declarations }
    procedure Paint; override;

  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;

  published
    { Published declarations }
    property Position: Integer read FPosition write SetPosition default 0;
    property Min: Integer read FMin write SetMin default 0;
    property Max: Integer read FMax write SetMax default 100;
    property Step: Integer read FStep write SetStep default 10;
    property Orientation :TProgressBarOrientation read FOrientation write SetOrientation default pbHorizontal;
    property ColorBegin: TColor read FColorBegin write SetColorBegin default clBlack;
    property ColorEnd: TColor read FColorEnd write SetColorEnd default clBlue;
    property Smooth: Boolean read FSmooth write SetSmooth default False;
    property AutoStep: Boolean read FAutoStep write SetAutoStep default False;

    //udostepnianie zdefiniowanych w klasie bazowej wlasnosci
    property Align;
    property Anchors;
    property DockOrientation;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property ShowHint;
    property PopupMenu;
    property Visible;

    //udostepnianie zdefiniowanych w klasie bazowej zdarzen
    property OnContextPopup;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnMouseActivate;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheel;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    property OnStartDock;
    property OnStartDrag;

    //zdarzenie
    property OnPositionChanged :TNotifyEvent read FOnPositionChanged write FOnPositionChanged;
  end;

procedure Register;

implementation

constructor TColorProgressBar.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Width := 150;
Height := GetSystemMetrics(SM_CYVSCROLL);
FMin := 0;
FMax := 100;
FStep := 10;
FPosition:=0;
FAutoStep:=False;

//Orientation:=pbVertical;
FOrientation:=pbHorizontal;
FSmooth:=False;

//ustalanie koloru
SetColorBegin(clBlack);
SetColorEnd(clBlue);
end;

function TColorProgressBar.ObliczKolor(i: Integer) :TColor;
var W :Integer;
begin
W:=Width;
if FOrientation=pbVertical then W:=Height;

Result:=clNone;
if (i<0) or (i>W) then Exit;
Result:=RGB(
  RedBegin+i*(RedEnd-RedBegin) div W,
  GreenBegin+i*(GreenEnd-GreenBegin) div W,
  BlueBegin+i*(BlueEnd-BlueBegin) div W);
end;

procedure TColorProgressBar.Paint;
const
  Border=2;
var
  i :Integer;
  H,W :Integer;
  Percent :Double;
  StepWidth, BarWidth :Integer;
begin
  inherited Paint;

  //jezeli komponent nie jest widoczny, to sie nie trudzi
  if not Visible then Exit;

  //brzegi
  Canvas.MoveTo(0,Height-1);
  Canvas.Pen.Color:=clBtnShadow;
  Canvas.LineTo(0,0);
  Canvas.LineTo(Width-1,0);
  Canvas.Pen.Color:=clBtnHighlight;
  Canvas.LineTo(Width-1,Height-1);
  Canvas.LineTo(0,Height-1);

  //parametry
  W:=Width;
  H:=Height;
  if FOrientation=pbVertical then
    begin
    W:=Height;
    H:=Width;
    end;

  StepWidth:=FStep;
  if FAutoStep then StepWidth:=2*H div 3;
  Percent:=(FPosition-FMin)/(FMax-FMin);
  BarWidth:=Round(Percent*(W-2*Border-1));

  //pasek poziomy
  for i:=Border to Border+BarWidth do
    begin
    if not FSmooth and (i mod StepWidth > 0) and (i mod StepWidth < Border+1) then Continue;
    Canvas.Pen.Color:=ObliczKolor(i);
    if FOrientation=pbHorizontal then
      begin
      Canvas.MoveTo(i,Border);
      Canvas.LineTo(i,H-Border);
      end
      else
      begin
      Canvas.MoveTo(Border,i);
      Canvas.LineTo(H-Border,i);
      end;
    end;
end;

//metody zwiazane z wlasnosciami
procedure TColorProgressBar.SetRange(AMin,AMax,APosition,AStep :Integer);
begin
if (AStep<0) and (AStep>(AMax-AMin)) then raise Exception.Create('Step cannot be lower that zero and larger then Max-Min');
if AMin>AMax then raise Exception.Create('Min cannot be larger then Max');
if APosition<AMin then APosition:=AMin;
if APosition>AMax then APosition:=AMax;

FMin:=AMin;
FMax:=AMax;
FPosition:=APosition;
FStep:=AStep;

Refresh;
end;

{procedure TColorProgressBar.SetPosition(APosition :Integer);
begin
SetRange(FMin,FMax,APosition,FStep);
end;}

procedure TColorProgressBar.SetPosition(APosition :Integer);
var prevPosition :Integer;
begin
prevPosition:=Position;
SetRange(FMin,FMax,APosition,FStep);
if (prevPosition<>Position) then PositionChanged;
end;

procedure TColorProgressBar.SetMin(AMin :Integer);
begin
SetRange(AMin,FMax,FPosition,FStep);
end;

procedure TColorProgressBar.SetMax(AMax :Integer);
begin
SetRange(FMin,AMax,FPosition,FStep);
end;

procedure TColorProgressBar.SetStep(AStep :Integer);
begin
SetRange(FMin,FMax,FPosition,AStep);
end;

procedure TColorProgressBar.SetOrientation(AOrientation :TProgressBarOrientation);
begin
FOrientation:=AOrientation;
Refresh;
end;

procedure TColorProgressBar.SetColorBegin(AColorBegin :TColor);
begin
FColorBegin:=AColorBegin;
RedBegin:=GetRValue(FColorBegin);
GreenBegin:=GetGValue(FColorBegin);
BlueBegin:=GetBValue(FColorBegin);
Refresh;
end;

procedure TColorProgressBar.SetColorEnd(AColorEnd :TColor);
begin
FColorEnd:=AColorEnd;
RedEnd:=GetRValue(FColorEnd);
GreenEnd:=GetGValue(FColorEnd);
BlueEnd:=GetBValue(FColorEnd);
Refresh;
end;

procedure TColorProgressBar.SetSmooth(ASmooth :Boolean);
begin
FSmooth:=ASmooth;
Refresh;
end;

procedure TColorProgressBar.SetAutoStep(AAutoStep :Boolean);
begin
FAutoStep:=AAutoStep;
Refresh;
end;

procedure TColorProgressBar.PositionChanged;
begin
if Assigned(FOnPositionChanged) then FOnPositionChanged(Self);
end;

procedure Register;
begin
  RegisterComponents('JM', [TColorProgressBar]);
end;

end.
