{$IFDEF FPC}
 {$mode delphi}
{$ENDIF}
unit mckQProgBar;
{

  ("`-''-/").___..--''"`-._
 `6_ 6  )   `-.  (     ).`-.__.`)
 (_Y_.)'  ._   )  `._ `. ``-..-'
  _..`--'_..-_/  /--'_.' ,'
(il).-''  (li).'  ((!.-'

 QnnO Progress Bar (MCK Classes)
 The component that provides a set of various progress bars.

 Ported to KOL © 2007-2008 Denis Fateyev (Danger)
 E-Mail: <denis@fateyev.com> <danger@artline.kz>

 Original TQProgressBar VCL component was developed by QnnO
 and was ported to KOL with his permission. Merci a Qnno!

}
interface

// ----------------------------------------------------------
uses
  Windows, Messages, KOL, SysUtils, Classes, Controls,
  KOLQProgBar, mirror, Graphics {$IFDEF FPC}, LResources {$ENDIF} ;
// ----------------------------------------------------------

type
  TKOLQProgressBar = class( TKOLControl )

  private
    fOrientation: TQBarOrientation;
    fBarKind: TQBarKind;
    fBarLook: TQBarLook;
    fRoundCorner: Boolean;
    fBackColor: TColor;
    fBarColor: TColor;
    fStartColor: TColor;
    fFinalColor: TColor;
    fShowInactPos: Boolean;
    fInvertInactPos: Boolean;
    fInactPosColor: TColor;
    fShaped: Boolean;
    fShapeColor: TColor;
    fBlockSize: Integer;
    fSpaceSize: Integer;
    fShowFullBlock: Boolean;
    fMaximum: Integer;
    fPosition: Integer;
    fGradShift: Integer;
    fHideOnTerm: Boolean;
    fCaptionAlign: TTextAlign;
    fAutoCaption: Boolean;
    fAutoHint: Boolean;
    fShowPosAsPct: Boolean;
    fShowIntPct: Boolean;
    fTransparent: Boolean;
    fOnProgressChange: TOnQProgressBar;
    fNotAvailable: Boolean;
    fColorNotAvailable: TColor;
    fOnPaintNotAvailable: TOnPaint;

    procedure SetOrientation( Value: TQBarOrientation );
    procedure SetBarKind( Value: TQBarKind );
    procedure SetBarLook( Value: TQBarLook);
    procedure SetRoundCorner( Value: Boolean );
    procedure SetBackColor( Value: TColor );
    procedure SetBarColor( Value: TColor );
    procedure SetStartColor( Value: TColor );
    procedure SetFinalColor(Value: TColor );
    procedure SetShowInactPos( Value: Boolean );
    procedure SetInvertInactPos( Value: Boolean );
    procedure SetInactPosColor( Value: TColor );
    procedure SetShaped( Value: Boolean );
    procedure SetShapeColor( Value: TColor );
    procedure SetBlockSize( Value: Integer );
    procedure SetSpaceSize( Value: Integer );
    procedure SetShowFullBlock( Value: Boolean );
    procedure SetMaximum( Value: Integer );
    procedure SetPosition( Value: Integer );
    procedure SetGradShift( Value: Integer );
    procedure SetHideOnTerm( Value: Boolean );
    procedure SetCaptionAlign( Value: TTextAlign );
    procedure SetAutoCaption( Value: Boolean );
    procedure SetAutoHint( Value: Boolean );
    procedure SetShowPosAsPct( Value: Boolean );
    procedure SetShowIntPct( Value: Boolean );
    procedure SetTransparent( Value: Boolean );

  protected
    function AdditionalUnits: string; override;
    procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: string ); override;
    function SetupParams( const AName, AParent: string ): string; override;
    procedure SetupConstruct( SL: TStringList; const AName, AParent, Prefix: string ); override;
    procedure AssignEvents( SL: TStringList; const AName: string ); override;
    procedure SetOnProgressChange( Value: TOnQProgressBar );

  public
    constructor Create( AOwner: TComponent ); override;

  published
    property Orientation: TQBarOrientation read fOrientation write SetOrientation;
    property BarKind: TQBarKind read fBarKind write SetBarKind;
    property BarLook: TQBarLook read fBarLook write SetBarLook;
    property RoundCorner: Boolean read fRoundCorner write SetRoundCorner;
    property BackgroundColor: TColor read fBackColor write SetBackColor;
    property BarColor: TColor read fBarColor write SetBarColor;
    property StartColor: TColor read fStartColor write SetStartColor;
    property FinalColor: TColor read fFinalColor write SetFinalColor;
    property GradientShift: Integer read fGradShift write SetGradShift;
    property ShowInactivePos: Boolean read fShowInactPos write SetShowInactPos;
    property InvertInactPos: Boolean read fInvertInactPos write SetInvertInactPos;
    property InactivePosColor: TColor read fInactPosColor write SetInactPosColor;
    property Shaped: Boolean read fShaped write SetShaped;
    property ShapeColor: TColor read fShapeColor write SetShapeColor;
    property BlockSize: Integer read fBlockSize write SetBlockSize;
    property SpaceSize: Integer read fSpaceSize write SetSpaceSize;
    property ShowFullBlock: Boolean read fShowFullBlock write SetShowFullBlock;
    property MaxProgress: Integer read fMaximum write SetMaximum;
    property Progress: Integer read fPosition write SetPosition;
    property HideOnTerminate: Boolean read fHideOnTerm write SetHideOnTerm;
    property CaptionAlign: TTextAlign read fCaptionAlign write SetCaptionAlign;
    property AutoCaption: Boolean read fAutoCaption write SetAutoCaption;
    property AutoHint: Boolean read fAutoHint write SetAutoHint;
    property ShowPosAsPct: Boolean read fShowPosAsPct write SetShowPosAsPct;
    property ShowIntPct: Boolean read fShowIntPct write SetShowIntPct;
    property Transparent: Boolean read fTransparent write SetTransparent;
    property OnProgressChange: TOnQProgressBar read fOnProgressChange write SetOnProgressChange;
    property DoubleBuffered: Boolean read fNotAvailable;
    property Ctl3D: Boolean read fNotAvailable;
    property Color: TColor read fColorNotAvailable;
    property EraseBackground: Boolean read fNotAvailable;
    property OnEraseBkgnd: TOnPaint read fOnPaintNotAvailable;
  end;

// ----------------------------------------------------------
procedure Register;

implementation

// ----------------------------------------------------------
procedure Register;
begin
  RegisterComponents( 'KOL Additional', [ TKOLQProgressBar ] );
end;

// ----------------------------------------------------------
{ TKOLQProgressBar }

function TKOLQProgressBar.AdditionalUnits: String;
begin
  Result := ', KOLQProgBar';
end;

// ----------------------------------------------------------
constructor TKOLQProgressBar.Create( AOwner: TComponent );
begin
  inherited Create(AOwner);
  Width:= 200;
  DefaultWidth:= Width;
  Height:= 20;
  DefaultHeight:= Height;
  ControlStyle := ControlStyle + [ csAcceptsControls ];

  fShowFullBlock:= false;
  fBlockSize:= 0;
  fSpaceSize:= 0;
  fOrientation:= boHorizontal;
  fBarKind:= bkFlat;
  fBarLook:= blMetal;
  fPosition:= 0;
  fShaped:= true;
  fShapeColor:= $00743C00;
  fBarColor:= clLime;
  fStartColor:= clLime;
  fFinalColor:= clLime;
  fGradShift:= 0;
  fBackColor:= clWhite;
  fShowInactPos:= false;
  fInactPosColor:= clGray;
  fInvertInactPos:= false;
  fMaximum:= 100;
  fAutoCaption:= false;
  fAutoHint:= false;
  fShowPosAsPct:= false;
  fShowIntPct:= false;
  fHideOnTerm:= false;
  fRoundCorner:= true;
  fTransparent:= false;
  fCaptionAlign:= taLeft;
end;

// ----------------------------------------------------------
procedure TKOLQProgressBar.SetupConstruct(SL: TStringList; const AName,
  AParent, Prefix: string);
var
 S: string;
begin
  S := GenerateTransparentInits;
  SL.Add( Prefix + AName + ' := PQProgressBar( New' + TypeName + '( '
          + SetupParams( AName, AParent ) + ' )' + S + ');' );
end;

// ----------------------------------------------------------
procedure TKOLQProgressBar.SetupFirst(SL: TStringList; const AName,
 AParent, Prefix: string);
begin
  inherited;
  if ( fShowFullBlock ) then
   SL.Add( Prefix + AName + '.ShowFullBlock:= true;' );
  if ( fBlockSize <> 0 ) then
   SL.Add( Prefix + AName + '.BlockSize:= ' + IntToStr( BlockSize ) + ';' );
  if ( fSpaceSize <> 0 ) then
   SL.Add( Prefix + AName + '.SpaceSize:= ' + IntToStr( SpaceSize ) + ';' );
  if ( fOrientation <> boHorizontal ) then
   SL.Add( Prefix + AName + '.Orientation:= boVertical;' );
  if ( fBarKind <> bkFlat ) then
   SL.Add( Prefix + AName + '.BarKind:= bkCylinder;' );
  if ( fBarLook <> blMetal ) then
   SL.Add( Prefix + AName + '.BarLook:= blGlass;' );
  if ( fPosition <> 0 ) then
   SL.Add( Prefix + AName + '.Progress:= ' + IntToStr( Progress ) + ';' );
  if ( fMaximum <> 100 ) then
   SL.Add( Prefix + AName + '.MaxProgress:= ' + IntToStr( MaxProgress ) + ';' );
  if ( not Shaped ) then
   SL.Add( Prefix + AName + '.Shaped:= false;' );
  if ( fShapeColor <> $00743C00 ) then
   SL.Add( Prefix + AName + '.ShapeColor:= ' + Color2Str( ShapeColor ) + ';');
  if ( fStartColor <> clLime ) then
   SL.Add( Prefix + AName + '.StartColor:= ' + Color2Str( StartColor ) + ';');
  if ( fFinalColor <> clLime ) then
   SL.Add( Prefix + AName + '.FinalColor:= ' + Color2Str( FinalColor ) + ';');
  if ( fGradShift <> 0 ) then
   SL.Add( Prefix + AName + '.GradientShift:= ' + IntToStr( GradientShift ) + ';');
  if ( fBackColor <> clWhite ) then
   SL.Add( Prefix + AName + '.BackgroundColor:= ' + Color2Str( BackgroundColor ) + ';');
  if ( fInactPosColor <> clGray ) then
   SL.Add( Prefix + AName + '.InactivePosColor:= ' + Color2Str( InactivePosColor ) + ';');
  if ( fShowInactPos ) then
   SL.Add( Prefix + AName + '.ShowInactivePos:= true;' );
  if ( fInvertInactPos ) then
   SL.Add( Prefix + AName + '.InvertInactPos:= true;' );
  if ( fAutoCaption ) then
   SL.Add( Prefix + AName + '.AutoCaption:= true;' )
  else
   if ( Caption <> '' ) then 
    SL.Add( Prefix + AName + '.Caption:= ''' + Caption + ''';');
  if ( fAutoHint ) then
   SL.Add( Prefix + AName + '.AutoHint:= true;' );
  if ( fShowPosAsPct ) then
  begin
   SL.Add( Prefix + AName + '.ShowPosAsPct:= true;' );
   if ( fShowIntPct ) then
    SL.Add( Prefix + AName + '.ShowIntPct:= true;' );
  end;
  if ( fHideOnTerm ) then
   SL.Add( Prefix + AName + '.HideOnTerminate:= true;' );
  if ( not fRoundCorner ) then
   SL.Add( Prefix + AName + '.RoundCorner:= false;' );
  if ( fCaptionAlign <> taLeft ) then
  begin
   if ( fCaptionAlign = taCenter ) then
    SL.Add( Prefix + AName + '.CaptionAlign:= taCenter;' );
   if ( fCaptionAlign = taRight ) then
    SL.Add( Prefix + AName + '.CaptionAlign:= taRight;' );
  end;
  if ( fTransparent ) then
   SL.Add( Prefix + AName + '.Transparent:= true;' );
end;

// ----------------------------------------------------------
function TKOLQProgressBar.SetupParams( const AName, AParent: string ): string;
begin
  Result:= AParent;
end;

// ----------------------------------------------------------
procedure TKOLQProgressBar.AssignEvents(SL: TStringList; const AName: string);
begin
  inherited;
  DoAssignEvents( SL, AName, [ 'OnProgressChange' ], [ @OnProgressChange ]);
end;

// ----------------------------------------------------------
procedure TKOLQProgressBar.SetOrientation( Value: TQBarOrientation );
var tmpClr: TColor;
    newH,
    newW: Integer;
begin
  if ( value <> fOrientation ) then
  begin
    if ( (value = boVertical)   and (Height < width)  )
    or ( (value = boHorizontal) and (width  < height) ) then
    begin
       newW := Height;
       newH := Width;
       Height := newH;
       Width  := newW;
    end;
    fOrientation := value;
    if  ( csDesigning in componentState ) then
     begin
      tmpClr    := fStartColor;
      fStartColor := fFinalColor;
      fFinalColor := tmpClr;
    end;
  end;
  Invalidate;
  Change;
end;

// ----------------------------------------------------------
procedure TKOLQProgressBar.SetBarKind( Value: TQBarKind );
begin
  fBarKind:= Value;
  Change;
end;

// ----------------------------------------------------------
procedure TKOLQProgressBar.SetBarLook( Value: TQBarLook);
begin
  fBarLook:= Value;
  Change;
end;

// ----------------------------------------------------------
procedure TKOLQProgressBar.SetRoundCorner( Value: Boolean );
begin
  fRoundCorner:= Value;
  Change;
end;

// ----------------------------------------------------------
procedure TKOLQProgressBar.SetBackColor( Value: TColor );
begin
  fBackColor:= Value;
  Change;
end;

// ----------------------------------------------------------
procedure TKOLQProgressBar.SetBarColor( Value: TColor );
begin
  fBarColor:= Value;
  fStartColor:= Value;
  fFinalColor:= Value;
end;

// ----------------------------------------------------------
procedure TKOLQProgressBar.SetStartColor( Value: TColor );
begin
  fStartColor:= Value;
  Change;
end;

// ----------------------------------------------------------
procedure TKOLQProgressBar.SetFinalColor(Value: TColor );
begin
  fFinalColor:= Value;
  Change;
end;

// ----------------------------------------------------------
procedure TKOLQProgressBar.SetGradShift(Value: Integer );
begin
  try
    if ( Value < 0 ) then Value:= 0;
    if ( Value > fMaximum ) then Value:= fMaximum;
    fGradShift:= Value;
  finally
    Change;
  end;
end;

// ----------------------------------------------------------
procedure TKOLQProgressBar.SetShowInactPos( Value: Boolean );
begin
  fShowInactPos:= Value;
  Change;
end;

// ----------------------------------------------------------
procedure TKOLQProgressBar.SetShowIntPct( Value: Boolean );
begin
  fShowIntPct:= Value;
  Change;
end;

// ----------------------------------------------------------
procedure TKOLQProgressBar.SetInvertInactPos( Value: Boolean );
begin
  fInvertInactPos:= Value;
  Change;
end;

// ----------------------------------------------------------
procedure TKOLQProgressBar.SetInactPosColor( Value: TColor );
begin
  fInactPosColor:= Value;
  Change;
end;

// ----------------------------------------------------------
procedure TKOLQProgressBar.SetShaped( Value: Boolean );
begin
  fShaped:= Value;
  Change;
end;

// ----------------------------------------------------------
procedure TKOLQProgressBar.SetShapeColor( Value: TColor );
begin
  fShapeColor:= Value;
  Change;
end;

// ----------------------------------------------------------
procedure TKOLQProgressBar.SetBlockSize( Value: Integer );
begin
  fBlockSize:= Value;
  Change;
end;

// ----------------------------------------------------------
procedure TKOLQProgressBar.SetSpaceSize( Value: Integer );
begin
  fSpaceSize:= Value;
  Change;
end;

// ----------------------------------------------------------
procedure TKOLQProgressBar.SetShowFullBlock( Value: Boolean );
begin
  fShowFullBlock:= Value;
  Change;
end;

// ----------------------------------------------------------
procedure TKOLQProgressBar.SetMaximum( Value: Integer );
begin
  fMaximum:= Value;
  Change;
end;

// ----------------------------------------------------------
procedure TKOLQProgressBar.SetPosition( Value: Integer );
begin
  if ( fMaximum = 0 ) then exit;
  try
    if (value <= 0) Then
    begin
      fPosition := 0;
      Exit;
    end
    else
    if ( value > fMaximum ) then value := fMaximum;

    fPosition := value;
  finally
   Change;
  end;
end;

// ----------------------------------------------------------
procedure TKOLQProgressBar.SetHideOnTerm( Value: Boolean );
begin
  fHideOnTerm:= Value;
  Change;
end;

// ----------------------------------------------------------
procedure TKOLQProgressBar.SetCaptionAlign( Value: TTextAlign );
begin
  fCaptionAlign:= Value;
  Change;
end;

// ----------------------------------------------------------
procedure TKOLQProgressBar.SetAutoCaption( Value: Boolean );
begin
  fAutoCaption:= Value;
  Change;
end;

// ----------------------------------------------------------
procedure TKOLQProgressBar.SetTransparent( Value: Boolean );
begin
  fTransparent:= Value;
  Change;
end;

// ----------------------------------------------------------
procedure TKOLQProgressBar.SetAutoHint( Value: Boolean );
begin
  fAutoHint:= Value;
  Change;
end;

// ----------------------------------------------------------
procedure TKOLQProgressBar.SetShowPosAsPct( Value: Boolean );
begin
  fShowPosAsPct:= Value;
  Change;
end;

// ----------------------------------------------------------
procedure TKOLQProgressBar.SetOnProgressChange( Value: TOnQProgressBar );
begin
  fOnProgressChange:= Value;
  Change;
end;

// ----------------------------------------------------------
{$IFDEF FPC}
initialization
 {$I mckQProgBar.lrs}
{$ENDIF}

// ----------------------------------------------------------


end.
