What is wrong with my component? 1

[AP81]

Hi,

I have attempted to write a component, but get a stack overflow when it is run. I am not sure what I have done wrong, but maybe someone here can point out my errors.

I have included both my original code & component code.

To run my original code, just start a new project and replace all the code in unit1 with my code (it is all dynamic).

Any comments, help or input is appreciated.

Thanks heaps,
Adam

--- original code ---

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure panelTimerTimer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1         : TForm1;
  mainPanel     : TPanel;
  panelArray    : array[0..16] of TPanel;
  iCurrentPanel : smallInt;
  paneltimer    : TTimer;
  lblStatus     : TLabel;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  iPanelCount : smallInt;
begin
  //set form width
  Form1.Width   := 400;
  Form1.Height  := 200;

  //create main panel
  mainPanel               := TPanel.Create(self);
  mainPanel.Parent        := Self;
  mainPanel.Height        := 30;
  mainPanel.Ctl3D         := False;
  mainPanel.BevelInner    := bvNone;
  mainPanel.BevelOuter    := bvNone;
  mainPanel.BorderStyle   := bsSingle;
  mainPanel.Color         := clWhite;
  mainPanel.Width         := 278;
  mainPanel.Height        := 55;

  //create the status label
  lblStatus           := TLabel.Create(self);
  lblStatus.Parent    := mainPanel;           //place label in main panel
  lblStatus.Align     := alTop;               //place lable at top on mainPanel
  lblStatus.Alignment := taCenter;
  lblStatus.Font.Name := 'Arial';
  lblStatus.Font.Size := 10;
  //lblStatus.Font.Style:= [fsBold];
  lblStatus.Caption   := 'Processing...';

  //create panels
  for iPanelCount := 0 to 16 do
    begin
      //create panel
      panelArray[iPanelCount] := TPanel.Create(self);

      with panelArray[iPanelCount] do
        begin
          Parent      := mainPanel;  //belongs inside the mainPanel
          Caption     := '';
          Ctl3D       := False;
          BevelInner  := bvNone;
          BevelOuter  := bvNone;
          BorderStyle := bsSingle;
          Width       := 10;
          Height      := 10;
          Top         := 25;
          Left        := (iPanelCount*15) + 10;
          //Tag         := iPanelCount;
        end;
    end;

  //create timer
  panelTimer          := TTimer.Create(self);
  panelTimer.Interval := 150;
  panelTimer.OnTimer  := panelTimerTimer;
  panelTimer.Enabled  := true;
end;

procedure TForm1.panelTimerTimer(Sender: TObject);
begin
  if (iCurrentPanel > 16) then iCurrentPanel := 0;

  case iCurrentPanel of
    0:
      begin
        if (panelArray[iCurrentPanel].Color = clBtnFace) then
          begin
            panelArray[iCurrentPanel].Color := clSkyBlue;
          end
        else
          begin
            panelArray[iCurrentPanel].Color := clBtnFace;
          end;

        if (panelArray[16].Color  = clSkyBlue) then
           (panelArray[16].Color := clBtnFace);  
      end;

    else   //case else
      begin
        panelArray[iCurrentPanel].Color   := clSkyBlue;
        panelArray[iCurrentPanel-1].Color := clBtnFace;
      end;
  end; {case}

  //move to next panel
  Inc(iCurrentPanel);
end;

end.

--- component code ---

unit AnimatedGauge;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TAnimGauge = class(TComponent)
  private
    fAnimateSpeed : Integer;
    fCaption      : string;
    fEnabled      : boolean;
    procedure SetAnimateSpeed(iValue : integer);
    procedure SetCaption(sCaption : string);
    procedure SetEnabled(bValue : boolean);
    procedure panelTimerTimer(Sender: TObject);
  public
    Constructor Create(AnOwner:TComponent); Override;
    Destructor Destroy; Override;
  published
    property AnimateSpeed : integer read fAnimateSpeed  write SetAnimateSpeed;
    property Caption      : string  read fCaption       write SetCaption;
    property Enabled      : boolean read fEnabled       write SetEnabled;
  end;

var
  mainPanel     : TPanel;
  panelArray    : array[0..16] of TPanel;
  iCurrentPanel : smallInt;
  paneltimer    : TTimer;
  lblStatus     : TLabel;

Procedure Register;

implementation

Constructor TAnimGauge.Create(AnOwner:TComponent);
var
  iPanelCount : smallInt;
begin
  inherited Create(AnOwner);
  //create main panel
  mainPanel               := TPanel.Create(self);
  //mainPanel.Parent        := Self;
  mainPanel.Height        := 30;
  mainPanel.Ctl3D         := False;
  mainPanel.BevelInner    := bvNone;
  mainPanel.BevelOuter    := bvNone;
  mainPanel.BorderStyle   := bsSingle;
  mainPanel.Color         := clWhite;
  mainPanel.Width         := 278;
  mainPanel.Height        := 55;

  //create the status label
  lblStatus           := TLabel.Create(self);
  lblStatus.Parent    := mainPanel;           //place label in main panel
  lblStatus.Align     := alTop;               //place lable at top on mainPanel
  lblStatus.Alignment := taCenter;
  lblStatus.Font.Name := 'Arial';
  lblStatus.Font.Size := 10;
  //lblStatus.Font.Style:= [fsBold];
  lblStatus.Caption   := 'Processing...';

  //create panels
  for iPanelCount := 0 to 16 do
    begin
      //create panel
      panelArray[iPanelCount] := TPanel.Create(self);

      with panelArray[iPanelCount] do
        begin
          Parent      := mainPanel;  //belongs inside the mainPanel
          Caption     := '';
          Ctl3D       := False;
          BevelInner  := bvNone;
          BevelOuter  := bvNone;
          BorderStyle := bsSingle;
          Width       := 10;
          Height      := 10;
          Top         := 25;
          Left        := (iPanelCount*15) + 10;
          //Tag         := iPanelCount;
        end;
    end;

  //create timer
  panelTimer          := TTimer.Create(self);
  panelTimer.Interval := 150;
  panelTimer.OnTimer  := panelTimerTimer;
  panelTimer.Enabled  := true;

  SetAnimateSpeed(200);
  SetCaption('Processing ...');
  SetEnabled(False);
end;

Destructor TAnimGauge.Destroy;
begin
  inherited Destroy;
end;

procedure TAnimGauge.SetAnimateSpeed(iValue : integer);
begin
  AnimateSpeed := iValue;
end;

procedure TAnimGauge.SetCaption(sCaption : string);
begin
  Caption := sCaption;
end;

procedure TAnimGauge.SetEnabled(bValue : boolean);
begin
  Enabled := bValue;
end;


procedure TAnimGauge.panelTimerTimer(Sender: TObject);
begin
  if Enabled then
  begin
    if (iCurrentPanel > 16) then iCurrentPanel := 0;

    case iCurrentPanel of
      0:
        begin
          if (panelArray[iCurrentPanel].Color = clBtnFace) then
            begin
              panelArray[iCurrentPanel].Color := clSkyBlue;
            end
          else
            begin
              panelArray[iCurrentPanel].Color := clBtnFace;
            end;

          if (panelArray[16].Color  = clSkyBlue) then
             (panelArray[16].Color := clBtnFace);
        end;

      else   //case else
        begin
          panelArray[iCurrentPanel].Color   := clSkyBlue;
          panelArray[iCurrentPanel-1].Color := clBtnFace;
        end;
    end; {case}

    //move to next panel
    Inc(iCurrentPanel);
  end;
end;

procedure Register;
begin
  RegisterComponents('GAUGES', [TAnimGauge]);
end;

end.

------------------------------------
There's no place like 127.0.0.1
------------------------------------

 

[towerbase]

I would suggest that you disable each timer at the start of each timer handler and then enable it at the end of the timer handler.

So your code could look something like:

procedure T------.panelTimerTimer(Sender: TObject);
begin
  panelTimer.Enabled := false;
  if Enabled then
  ...
  end;
  panelTimer.Enabled := true; 
end;

This would avoid a timer event occuring whilst a previous timer event was being handled which is possibly the cause of your stack overflow.

Andrew
Hampshire, UK

 

[bledazemi]

your stack overflow comes from the following:

...
procedure TAnimGauge.SetAnimateSpeed(iValue : integer);
begin
  AnimateSpeed := iValue;
end;

procedure TAnimGauge.SetCaption(sCaption : string);
begin
  Caption := sCaption;
end;

procedure TAnimGauge.SetEnabled(bValue : boolean);
begin
  Enabled := bValue;
end;

you should change it to ...

...
procedure TAnimGauge.SetAnimateSpeed(iValue : integer);
begin
  fAnimateSpeed := iValue;
end;

procedure TAnimGauge.SetCaption(sCaption : string);
begin
  fCaption := sCaption;
end;

procedure TAnimGauge.SetEnabled(bValue : boolean);
begin
  fEnabled := bValue;
end;

...

You should be aware of when get and set routines for properties are called. Set routine is called each time the property appears on the left hand side of an assignment. Get is called each time the property in the right hand side of a statement:


for example if you define

property Enabled : boolean read GetEnabled write SetEnabled;

procedure TAnimGauge.SetEnabled(bValue : boolean);
begin
//The following will call SetEnabled again
//Enabled := bValue; //This is recursive its wrong

fEnabled:=bValue; //this is fine

end;

//You have not defined GetEnabled in your sample which
//is ok. But if you did then
function TAnimGauge.GetEnabled:Boolean;
begin
//This will call GetEnabled again
//result:=Enabled; //Recursive call and its wrong

result:=fEnabled; //This is right
end;


I hope it will help you





"It is in our collective behaviour that we are most mysterious" Lewis Thomas

 

[AP81]

Thanks, that fixed the problem, but the component is not visible on the form. Any ideas?




------------------------------------
There's no place like 127.0.0.1
------------------------------------

 

[bledazemi]

I run your original code that you posted (Unit1) in my machine and it worked beautifully. Beautiful and simple.

In relation to TAnimGauge component i have the following suggestions:

- TAnimGauge should inherit from TPanel
In your original code mainpanel contains all your controls except the timer. So why not make your new component inherit from TPanel and use the component itself you do with mainpanel. As a bonus of inheriting from TPanel your component will be visible at design time.


- panelArray, lblStatus, paneltimer should be properties TAnimGauge component
TAnimGauge contains and maintains the above therefore it is reasonable to have them as properties of TAnimGauge.


- private properties fAnimateSpeed, fCaption, fEnabled may not be necessary as they can be delegated directly to the underlying control property (see code below)


I installed your TAnimGauge with the slight changes that i mention above. And it runs beautifully. To my surprise TAnimGauge even animates at design time. It looks great . Once again thanks AP81 for sharing your idea about this control.

Good luck,

{*******************************************************
   Thanks AP81, very sweet idea to have such a component
********************************************************}
unit AnimatedGauge;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type

  //A type definition needed for Panels property (see below)
  TPanelArray=array[1..16] of TPanel;

  ///////////////////////////////////////////////
  //Let TAnimGauge components inherit from TPanel
  //  TAnimGauge itself will play the role of
  //  main panel in your original code.
  ///////////////////////////////////////////////
  TAnimGauge = class(TPanel)
  private
    //The label and panels in the array are contained
    //within TAnimGauge so it seems reasonable to
    //make them properties of TAnimGauge.
    panelArray    : TPanelArray;
    iCurrentPanel : smallInt;
    paneltimer    : TTimer;
    lblStatus     : TLabel;

    //the private members are not really needed
    //because we may delegate them directly:
    //AnimateSpeed  is panelTimer.Interval
    //Enabled       is panelTimer.Enabled
    //Caption       is lblStatus.Caption

    procedure SetAnimateSpeed(iValue : integer);
    procedure SetEnabled(bValue : boolean);
    procedure SetCaption(sVal:string);
    function  GetAnimateSpeed:integer;
    function  GetEnabled:Boolean;
    function  GetCaption:string;

  protected
    //Animation handler seems logical to put this
    //as internal routine of TAnimGauge
    procedure panelTimerTimer(Sender: TObject);

  public
    Constructor Create(AnOwner:TComponent); Override;
    Destructor Destroy; Override;

    //Make the controls contained within public so that
    //they may be used at runtime if necessary

    property Timer      : TTimer read panelTimer;
    property Panels     : TPanelArray read panelArray;
    property StatusLabel: TLabel read lblStatus write lblStatus;

  published
    property AnimateSpeed : integer read GetAnimateSpeed  write SetAnimateSpeed;
    property Enabled      : boolean read GetEnabled       write SetEnabled;
    property Caption      : string  read GetCaption write SetCaption;
    property CurrentPanel : smallint read iCurrentPanel;

  end;

Procedure Register;

implementation

////////////////////////////////////////////////////////////////////////////////
// Construction & Destruction
////////////////////////////////////////////////////////////////////////////////
constructor TAnimGauge.Create(AnOwner:TComponent);
var
  iPanelCount : smallInt;
begin
  inherited Create(AnOwner);

  //Initialise main panel (which is this component itself)
  ParentCtl3D   := false; //stop parents turning gauge into 3D
  Ctl3D         := False;
  BevelInner    := bvNone;
  BevelOuter    := bvNone;
  BorderStyle   := bsSingle;
  Color         := clWhite;
  Width         := 278;
  Height        := 55;
  Caption       := '';


  //create the status label
  lblStatus           := TLabel.Create(self);
  lblStatus.Parent    := self;
  lblStatus.Align     := alTop;
  lblStatus.Alignment := taCenter;
  lblStatus.Font.Name := 'Arial';
  lblStatus.Font.Size := 10;
  lblStatus.Caption   := 'Processing...';

  //create panels
  for iPanelCount := 0 to 16 do
    begin
      //create panel
      panelArray[iPanelCount] := TPanel.Create(self);

      with panelArray[iPanelCount] do
        begin
          Parent      := self;  //belongs inside the mainPanel
          Caption     := '';
          Ctl3D       := False;
          BevelInner  := bvNone;
          BevelOuter  := bvNone;
          BorderStyle := bsSingle;
          Width       := 10;
          Height      := 10;
          Top         := 25;
          Left        := (iPanelCount*15) + 10;
          //Tag         := iPanelCount;
        end;
    end;

  //create timer
  panelTimer          := TTimer.Create(self);
  panelTimer.OnTimer  := panelTimerTimer;

  AnimateSpeed:=200;
  Caption:='Processing ...';
  Enabled:=False;

end;

Destructor TAnimGauge.Destroy;
begin
  inherited Destroy;
end;

////////////////////////////////////////////////////
// Get & Set routines
////////////////////////////////////////////////////
procedure TAnimGauge.SetAnimateSpeed(iValue : integer);
begin
  paneltimer.Interval:=iValue;
end;

procedure TAnimGauge.SetEnabled(bValue : boolean);
begin
   paneltimer.Enabled:=bValue;
end;

procedure TAnimGauge.SetCaption(sVal:String);
begin
    lblStatus.Caption:=sVal;
end;

function TAnimGauge.GetAnimateSpeed:integer;
begin
    result:=paneltimer.Interval;
end;

function TAnimGauge.GetEnabled:Boolean;
begin
    result:=paneltimer.Enabled;
end;

function TAnimGauge.GetCaption:string;
begin
    result:=lblStatus.Caption;
end;

///////////////////////////////////////////////////////
// Handling animations (Timer event handler)
// Note: I love this routine, simple and beautiful
//       Thanks again AP81
///////////////////////////////////////////////////////
procedure TAnimGauge.panelTimerTimer(Sender: TObject);
begin
  if Enabled then
  begin
    if (iCurrentPanel > 16) then iCurrentPanel := 0;

    case iCurrentPanel of
      0:
        begin
          if (panelArray[iCurrentPanel].Color = clBtnFace) then
            begin
              panelArray[iCurrentPanel].Color := clSkyBlue;
            end
          else
            begin
              panelArray[iCurrentPanel].Color := clBtnFace;
            end;

          if (panelArray[16].Color  = clSkyBlue) then
             (panelArray[16].Color := clBtnFace);
        end;

      else   //case else
        begin
          panelArray[iCurrentPanel].Color   := clSkyBlue;
          panelArray[iCurrentPanel-1].Color := clBtnFace;
        end;
    end; {case}

    //move to next panel
    Inc(iCurrentPanel);
  end;
end;

procedure Register;
begin
  RegisterComponents('GAUGES', [TAnimGauge]);
end;

end.

"It is in our collective behaviour that we are most mysterious" Lewis Thomas

 

[AP81]

Thanks bledazemi,

I really appreciate that you took the time to help me fix this. I have never written a component before and it was causing me a lot of headaches.

I wrote this because I couldn't find any gauges on the net that I liked.

I'm really glad that you liked it. Feel free to use it as you wish.

Regards,
Adam




------------------------------------
There's no place like 127.0.0.1
------------------------------------