unit kComp;
{
   Tässä tiedostossa on laskurikomponentit
     TCounter          - tavallinen laskuri
     TProgCounter      - "progress" counter, eli näyttää edistymisen Gaugella

   Author:  Vesa Lappalainen
   Date:    9.9.1996
   Changes: 5.10.1996
              + Laskurin alle vielä yksi paneeli, jotta Param-luokkaan
                saadaan Caption kohtuulisella vaivalla rinnalle
                  => paljon kopiointia TPanel -> TCounter
                     Likikään kaikki Eventit eivät vielä toimi
   Changes: 26.7.1998
              + laskureiden tarkkuus .ini -tiedostoon talletettaessa
                mahdollista lisätä IniDesim-verran tai sitten kuormittaa
                AsIniString -ominaisuus (GetAsIniString, SetAsIniString).
                Oletuksena talletys AsString-ominaisuuden mukaan
   Changes: 19.7.2000
              + SavePanel
   Changes: 18.8.2000
              + oletuksena .ini talletetaan AsIniString ja sen muoto
                on oletuksena desimaalipisteellä. 
   Changes: 29.9.2001/vl
              + VCL/CLX compiling (define CLX)
              - no Gauge for CLX
}

interface

uses
  SysUtils, Classes,
{$ifdef CLX}
  QGraphics, QControls, QForms, QDialogs, QExtCtrls,
{$else}
  Messages, Graphics, Controls, Forms, Dialogs,
  ExtCtrls,Gauges,
{$endif}
  kDouble,kinisave;

type
  TNotifyCounterEvent = procedure(Sender: TObject; var val:double) of object;


  TCounter = class(TPanel)
  private
    FDesim : integer;
    FIniDesim : integer;
    FIni : TIniSave;
    FPanelColor : TColor;
    FAfterChange : TNotifyCounterEvent;
    FDisabledColor: TColor;
  protected
    FValue : double;
    FLabel : TPanel;
    FLabelWidth : integer;
    FLabelHeight : integer;
    FPanel : TPanel;
    function GetAlignment:TAlignment;               virtual;
    procedure SetAlignment(p:TAlignment);           virtual;
    function GetColor:TColor;                       virtual;
    procedure SetColor(p:TColor);                   virtual;
    function GetBevelInner:TPanelBevel;             virtual;
    procedure SetBevelInner(p:TPanelBevel);         virtual;
    function GetBevelOuter:TPanelBevel;             virtual;
    procedure SetBevelOuter(p:TPanelBevel);         virtual;
    function GetBevelWidth:integer;                 virtual;
    procedure SetBevelWidth(p:integer);             virtual;
    function GetOnClick:TNotifyEvent;               virtual;
    procedure SetOnClick(p:TNotifyEvent);           virtual;
    function GetCursor:TCursor;                     virtual;
    procedure SetCursor(p:TCursor);                 virtual;
    function GetCaption : string;                   virtual;
    procedure SetCaption(s:string);                 virtual;
    procedure SetLAlign(a:TAlign);                  virtual;
    function GetLAlign:TAlign;                      virtual;
    procedure SetLAlignment(a:TAlignment);          virtual;
    function GetLAlignment:TAlignment;              virtual;
    procedure SetLabelWidth(p:integer);             virtual;
    procedure SetLabelHeight(p:integer);            virtual;
{$ifdef CLX}
    procedure SetEnabled(const Value: Boolean); override;
{$else}
    procedure SetEnabled(Value: Boolean); override;
{$endif}
    procedure SetDisabledColor(const Value: TColor); virtual;
    function GetAsIniString: string;                  virtual;
    procedure SetAsIniString(const Value: string);    virtual;
  public
    constructor Create(AOwner:TComponent); override;
    destructor Destroy;                    override;
    procedure Loaded;                      override;
    procedure SetValueNoSave(d:double);    virtual;
    procedure SetValue(d:double);          virtual;
    procedure SetDesim(i:integer);         virtual;
    procedure Inc(d:double);               virtual;
    procedure SetName(const NewName:TComponentName); override;
    procedure SetString(s:string);         virtual;
    function GetString:string;             virtual;
    function GetValue:double;              virtual;
    procedure SetInteger(i:Integer);       virtual;
    function GetInteger:Integer;           virtual;
    procedure PanelClick(Sender: TObject); virtual;
  published
    property Ini : TIniSave read FIni write FIni;
    property Value:double  read GetValue write SetValue;
    property Desim:integer read FDesim write SetDesim default 0;
    property IniDesim:integer read FIniDesim write FIniDesim default 0;
    property Alignment : TAlignment read GetAlignment write SetAlignment default taRightJustify;
    property Color : TColor read GetColor write SetColor default $0080ffff;
    property DisabledColor : TColor read FDisabledColor write SetDisabledColor default clSilver;
    property BevelInner :TPanelBevel read GetBevelInner write SetBevelInner default bvLowered;
    property BevelOuter :TPanelBevel read GetBevelOuter write SetBevelOuter default bvRaised;
    property BevelWidth : integer read GetBevelWidth write SetBevelWidth default 4;
    property OnClick : TNotifyEvent read GetOnClick write SetOnClick;
    property Cursor : TCursor read GetCursor write SetCursor;
    property Caption : string read GetCaption write SetCaption;
    property LAlign : TAlign read GetLAlign write SetLAlign default alLeft;
    property LAlignment : TAlignment read GetLAlignment write SetLAlignment default taLeftJustify;
    property LabelWidth : integer read FLabelWidth write SetLabelWidth default 0;
    property LabelHeight : integer read FLabelHeight write SetLabelHeight default 12;
    property AsString : string read GetString write SetString stored false;
    property AsIniString : string read GetAsIniString write SetAsIniString stored false;
    property AsInteger : integer read GetInteger write SetInteger stored false;
    property AfterChange : TNotifyCounterEvent read FAfterChange write FAfterChange;
  end; { TCounter }

  {----------------------------------------------------------------------------}
  TProgCounter = class(TCounter)
  private
{$ifdef CLX}

{$else}
    FGauge : TGauge;
{$endif}
    FMinValue : Double;
    FMaxValue : Double;
  protected
  public
    constructor Create(AOwner:TComponent); override;
    destructor Destroy;                    override;
    procedure SetValue(d:double);          override;
    procedure SetMaxValue(d:double);       virtual;
    procedure SetMinValue(d:double);       virtual;
{$ifdef CLX}
{$else}
    property Gauge:TGauge read FGauge;
{$endif}
  published
    property Value:double  read FValue write SetValue;
    property MinValue:double  read FMinValue write SetMinValue;
    property MaxValue:double  read FMaxValue write SetMaxValue;
  end; { TProgCounter }

  procedure Register;

implementation
uses KString,IniFiles;

procedure Register;
begin
  RegisterComponents('Kave2000', [TCounter,TProgCounter]);
end;

{------------------------------------------------------------------------------}
{ TCounter ====================================================================}
{------------------------------------------------------------------------------}


{------------------------------------------------------------------------------}
procedure TCounter.Loaded;
begin
  inherited;
  Ini.Load;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
constructor TCounter.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  FPanel := TPanel.Create(self);
  FPanel.Parent := self;
  Fpanel.Align := alClient;
  FPanel.Alignment  := taRightJustify;
  FPanelColor       := $0080ffff;
  FPanel.Color      := FPanelColor;
  FDisabledColor    := clSilver;
  FPanel.BevelInner := bvLowered;
  FPanel.BevelWidth := 4;

  inherited BevelOuter := bvNone;
  ParentColor := True;
  FValue     := 0;
  FDesim     := 0;
  FIniDesim  := 0;

  FLabel := TPanel.Create(self);
  FLabel.Parent := self;
  FLabel.Alignment  := taLeftJustify;
  FLabel.ParentColor := True;;
  FLabel.BevelInner := bvNone;
  FLabel.BevelOuter := bvNone;
  FLabel.Caption := '';
  FLabel.Align := alLeft;

  LabelWidth := 0;
  LabelHeight := 12;

  FIni          := TIniSave.Create(self);
  Ini.AutoSave  := false;
  Ini.PropName  := 'AsIniString';
end;

{------------------------------------------------------------------------------}
destructor TCounter.Destroy;
begin
  FIni.Save;
  FIni.Free;
  FPanel.Free;
  FPanel := NIL;
  FLabel.Free;
  FLabel := NIL;
  inherited Destroy;
end;

{------------------------------------------------------------------------------}
procedure TCounter.SetLAlign(a:TAlign);
begin
  if a in [alLeft,alRight,alTop,alBottom] then
     FLabel.Align := a;
  FLabel.Width := FLabelWidth;
  FLabel.Height := FLabelHeight;
end;

{------------------------------------------------------------------------------}
function TCounter.GetLAlign:TAlign;
begin
  Result := FLabel.Align;
end;

{------------------------------------------------------------------------------}
procedure TCounter.SetLAlignment(a:TAlignment);
begin
  FLabel.Alignment := a;
end;

{------------------------------------------------------------------------------}
function TCounter.GetLAlignment:TAlignment;
begin
  Result := FLabel.Alignment;
end;

{------------------------------------------------------------------------------}
procedure TCounter.SetValueNoSave(d:double);
begin
  FValue := d;
  FPanel.Caption := DoubleToStr(FValue,FDesim);
  if ( Assigned(FAfterChange) ) then FAfterChange(self,d);
end;

{------------------------------------------------------------------------------}
procedure TCounter.SetValue(d:double);
begin
  FValue := d;
  FPanel.Caption := DoubleToStr(FValue,FDesim);
  if ( Ini.AutoSave ) then Ini.SaveCond;
  if ( Assigned(FAfterChange) ) then FAfterChange(self,d);
end;

{------------------------------------------------------------------------------}
procedure TCounter.Inc(d:double);
begin
  Value := Value + d;
end;


{------------------------------------------------------------------------------}
procedure TCounter.SetDesim(i:integer);
begin
  FDesim := i;
  SetValue(FValue);
end;

{------------------------------------------------------------------------------}
function TCounter.GetAlignment:TAlignment;
begin
  Result := FPanel.Alignment;
end;

procedure TCounter.SetAlignment(p:TAlignment);
begin
  FPanel.Alignment := p;
end;

function TCounter.GetColor:TColor;
begin
  Result := FPanelColor;
end;

procedure TCounter.SetColor(p:TColor);
begin
  FPanelColor := p;
  if ( Enabled ) then FPanel.Color := p;
end;

function TCounter.GetBevelInner:TPanelBevel;
begin
  Result := FPanel.BevelInner;
end;

procedure TCounter.SetBevelInner(p:TPanelBevel);
begin
  FPanel.BevelInner := p;
end;

function TCounter.GetBevelOuter:TPanelBevel;
begin
  Result := FPanel.BevelOuter;
end;

procedure TCounter.SetBevelOuter(p:TPanelBevel);
begin
  FPanel.BevelOuter := p;
end;

function TCounter.GetBevelWidth:integer;
begin
  Result := FPanel.BevelWidth;
end;

procedure TCounter.SetBevelWidth(p:integer);
begin
  FPanel.BevelWidth := p;
end;

function TCounter.GetOnClick:TNotifyEvent;
begin
  Result := inherited OnClick;
end;

procedure TCounter.PanelClick(Sender: TObject);
begin
  if ( Assigned(OnClick) ) then Click;
end;

procedure TCounter.SetOnClick(p:TNotifyEvent);
begin
  inherited OnClick := p;
  FPanel.OnClick := PanelClick;
  FLabel.OnClick := PanelClick;
end;

function TCounter.GetCursor:TCursor;
begin
  Result := inherited Cursor;
end;

procedure TCounter.SetCursor(p:TCursor);
begin
  inherited Cursor := p;
  FPanel.Cursor := p;
end;

//-----------------------------------------------------------------------------
function TCounter.GetValue:double; //               virtual;
begin
  Result := FValue;
end;                            

{------------------------------------------------------------------------------}
function TCounter.GetCaption : string;
begin
  Result := FLabel.Caption;
end;

procedure TCounter.SetCaption(s:string);
begin
  FLabel.Caption := s;
end;

procedure TCounter.SetLabelWidth(p:integer);
begin
  FLabelWidth := p;
  FLabel.Width := p;
end;

procedure TCounter.SetLabelHeight(p:integer);
begin
  FLabelHeight := p;
  FLabel.Height := p;
end;


procedure TCounter.SetName(const NewName:TComponentName);
var i:integer;
    n,gen,oldname,oldcap:string;

    function SetCaption(start,n:string;Force:Boolean):boolean;
    begin
      Result := False;
      if Force or ( Pos(UpperCase(start),UpperCase(n)) = 1 )  then begin
        Delete(n,1,Length(start));
        Caption := n;
        Result := True;
       end;
    end;

begin
  gen := Copy(ClassName,2,50); n := NewName;
  oldname := Name; oldcap := Caption;
  inherited SetName(n);

  i := Pos(UpperCase(Caption),UpperCase(oldname));
  if ( Caption = '' ) then
    SetCaption(gen,n,True)
  else
  if not ( ( i-1 + Length(Caption) = Length(oldname) ) and
           ( SetCaption(Copy(oldname,1,i-1),n,False) ) ) then
    SetCaption(gen,Caption,False)
end;

procedure TCounter.SetString(s:string);
begin
  try
    Value := StrToDouble(s);
  except
    Value := 0;
  end;
end;

function TCounter.GetString:string;
begin
  Result := DoubleToStr(value,desim);
end;

procedure TCounter.SetInteger(i:Integer);
begin
  if ( csLoading in ComponentState ) then exit;
  value := i;
end;

function TCounter.GetInteger:Integer;
begin
  Result := trunc(value);
end;

function TCounter.GetAsIniString: string;
begin
  Result := DoubleToIniStr(value,desim+IniDesim);
end;

procedure TCounter.SetAsIniString(const Value: string);
begin
//  SetString(Value);
  self.Value := IniStrToDouble(Value);
end;

{$ifdef CLX}
procedure TCounter.SetEnabled(const Value: Boolean);
{$else}
procedure TCounter.SetEnabled(Value: Boolean);
{$endif}
begin
  inherited;
  if ( Value ) then
    FPanel.Color := FPanelColor
  else
    FPanel.Color := FDisabledColor;
end;

procedure TCounter.SetDisabledColor(const Value: TColor);
begin
  FDisabledColor := Value;
  if ( not Enabled ) then
    FPanel.Color := FDisabledColor;
end;

{------------------------------------------------------------------------------}
{ TProgCounter ================================================================}
{------------------------------------------------------------------------------}

{------------------------------------------------------------------------------}
constructor TProgCounter.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
{$ifdef CLX}

{$else}
  FGauge := TGauge.Create(FPanel);
  FGauge.Height      := 11;
  FGauge.Visible     := True;
  FGauge.Parent      := FPanel;
  FGauge.Align       := alBottom;
  FGauge.BackColor   := clYellow;
  FGauge.ForeColor   := clNavy;
  FGauge.Font.Color  := clBlack;
  FGauge.Font.Height := -11;
  FGauge.Font.Name   := 'MS Sans Serif';
  FGauge.BorderStyle := bsNone;
  FGauge.ParentFont  := False;
  MaxValue           := 100;
{$endif}
end;

{------------------------------------------------------------------------------}
destructor TProgCounter.Destroy;
begin
{$ifdef CLX}

{$else}
  FGauge.Free;
  FGauge := NIL;
{$endif}
  inherited Destroy;
end;

{------------------------------------------------------------------------------}
procedure TProgCounter.SetValue(d:double);
begin
  inherited SetValue(d);
{$ifdef CLX}
{$else}
  Gauge.Progress := trunc(d);
{$endif}
end;

{------------------------------------------------------------------------------}
procedure TProgCounter.SetMinValue(d:double);
begin
  FMinValue := d;
{$ifdef CLX}

{$else}
  Gauge.MinValue := trunc(d);
{$endif}
end;

{------------------------------------------------------------------------------}
procedure TProgCounter.SetMaxValue(d:double);
begin
  FMaxValue := d;
{$ifdef CLX}

{$else}
  Gauge.MaxValue := trunc(d);
{$endif}
end;


end.