[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]

    {
     Author:    Craig Ward
     Copyright: none - public domain

     Date:      20/5/96

     Version:   1.0

     Overview:  Status bar

     Notes:     The captions for each panel (stored within the wrapper component),
                can be accessed via their index. The indices are:
                 [0] status panel
                 [1] caps-lock panel
                 [2] num-lock panel
                 [3] scroll-lock panel
                 [4] time panel

                The component will automatically check for the state of the caps-lock,
                num-lock, and scroll-lock keys, plus, it will also display the current
                time (all achieved through a private TTimer). Furthermore, the
                component will also automatically display any application hint, by
                setting the application's OnHint method to the custom method that
                is used by the TTimer.
    *******************************************************************************}
    unit Cwstatus;

    interface

    uses
      SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
      Forms, Dialogs, ExtCtrls;

    type

      {container object for panels}
      TStatusPanel = class(TPanel)
      private
        { Private declarations }
        FStatusPanel: TPanel;            {the comment panel}
        FCapsPanel: TPanel;              {the caps-lock panel}
        FNumPanel: TPanel;               {the num-lock panel}
        FScrollPanel: TPanel;            {the scroll-lock panel}
        FTimePanel: TPanel;              {the time panel}
      public
        { Public declarations }
        constructor Create(AOwner: TComponent); override;
      end;

      {wrapper for component}
      TcwStatusBar = Class(TWinControl)
        StatusPanel: TStatusPanel;
        FTimer: TTimer;
      private
        function GetCaption(Index: Integer): string;
        procedure SetCaption(Index: Integer; Cap: string);
        procedure mTimer(sender: TObject);
      public
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;
        property Captions[Index: Integer]: string read GetCaption write SetCaption;
      published
        property Font;
        property ParentFont;
        property Align;
      end;

    procedure Register;

    implementation

    {***VCL Preferences************************************************************}

    {constructor -
     note: panels created in reverse order}
    constructor TStatusPanel.Create(AOwner: TComponent);
    begin
      inherited Create(AOwner);
       Align := alBottom;            {default to bottom of form}

      {create time panel}
      FTimePanel := TPanel.Create(self);
      with FTimePanel do
      begin
        Parent := self;              {set parent to self}
        width := 65;
        Align := alRight;            {set alignment to right}
        BevelOuter := bvLowered;     {set bevel appearances}
        BevelInner := bvLowered;
        Caption := 'Time';           {set caption text}
        Alignment := taLeftJustify;  {left-justify caption}
        ParentFont := true;          {assume the parent's font}
      end;

      {create scroll-lock panel}
      FScrollPanel := TPanel.Create(self);
      with FScrollPanel do
      begin
        Parent := self;              {set parent to self}
        width := 40;
        Align := alRight;            {set alignment to right}
        BevelOuter := bvLowered;     {set bevel appearances}
        BevelInner := bvLowered;
        Caption := 'Scroll';         {set caption text}
        Alignment := taLeftJustify;  {left-justify caption}
        ParentFont := true;          {assume the parent's font}
      end;

      {create num-lock panel}
      FNumPanel := TPanel.Create(self);
      with FNumPanel do
      begin
        Parent := self;              {set parent to self}
        width := 40;
        Align := alRight;            {set alignment to right}
        BevelOuter := bvLowered;     {set bevel appearances}
        BevelInner := bvLowered;
        Caption := 'Num';            {set caption text}
        Alignment := taLeftJustify;  {left-justify caption}
        ParentFont := true;          {assume the parent's font}
      end;

      {create caps-lock panel}
      FCapsPanel := TPanel.Create(self);
      with FCapsPanel do
      begin
        Parent := self;              {set parent to self}
        width := 40;
        Align := alRight;            {set alignment to right}
        BevelOuter := bvLowered;     {set bevel appearances}
        BevelInner := bvLowered;
        Caption := 'Caps';           {set caption text}
        Alignment := taLeftJustify;  {left-justify caption}
        ParentFont := true;          {assume the parent's font}
      end;

      {create comment panel}
      FStatusPanel := TPanel.Create(self);
      with FStatusPanel do
      begin
        Parent := self;              {set parent to self}
        Align := alClient;           {set alignment to client}
        BevelOuter := bvLowered;     {set bevel appearances}
        BevelInner := bvLowered;
        Caption := 'Status Panel';   {set caption text}
        Alignment := taLeftJustify;  {left-justify caption}
        ParentFont := true;          {assume the parent's font}
      end;

    end;

    {constructor - for wrapper}
    constructor TcwStatusBar.Create(AOwner: TComponent);
    begin
      inherited Create(AOwner);

       {create status-panel}
       Align := alBottom;                        {default to alBottom}
       StatusPanel := TStatusPanel.Create(self); {create a TStatusPanel instance}
       with StatusPanel do
       begin
         Parent := self;                         {set parent to self}
         Align := alClient;                      {set alignment to client}
       end;
       Height := 25;

       {create TTimer}
       FTimer := TTimer.create(self);
       with FTimer do
        begin
         OnTimer := mTimer;
         interval := 250;                        {update panels quarter of a second}
         enabled := true;
        end;

       {set application's OnHint to the custom method, used by the TTimer. This will
        force the application, when a hint is encountered, to be displayed in the
        panel.}
       application.onHint := mTimer;

       {call timer method - this ensures that the application will open with a
        status-bar that is configured and running}
       mTimer(self);

    end;

    {destructor - for wrapper}
    destructor TcwStatusBar.Destroy;
    begin
      inherited Destroy;
    end;

    {return caption (of panel in index)}
    function TcwStatusBar.GetCaption(Index: Integer): string;
    begin
      case Index of
        0: result := StatusPanel.FStatusPanel.caption;
        1: result := StatusPanel.FCapsPanel.caption;
        2: result := StatusPanel.FNumPanel.caption;
        3: result := StatusPanel.FScrollPanel.caption;
        4: result := StatusPanel.FTimePanel.caption;
        { Show error if any other Index was entered }
        else MessageDlg('Invalid Index Value', mtWarning, [mbOk], 0);
      end;
    end;

    {set caption (of panel in index)}
    procedure TcwStatusBar.SetCaption(Index: Integer; Cap: string);
    begin
      case Index of
        0: StatusPanel.FStatusPanel.Caption := cap;
        1: StatusPanel.FCapsPanel.Caption := cap;
        2: StatusPanel.FNumPanel.caption := cap;
        3: StatusPanel.FScrollPanel.caption := cap;
        4: StatusPanel.FTimePanel.caption := cap;
        { Show an error if any other Index was entered }
        else MessageDlg('Invalid Index Value', mtWarning, [mbOk], 0);
      end;
    end;

    {register}
    procedure Register;
    begin
      RegisterComponents('cw_apps', [TcwStatusBar]);
    end;

    {***custom routines************************************************************}

    {on timer, update captions}
    procedure TcwStatusBar.mTimer(sender: TObject);
    begin

     {set hint}
     Captions[0] := ' '+application.hint;

     {set caps lock}
     if GetKeyState(VK_CAPITAL) <> 0 then
      Captions[1] := ' CAP'
     else
      Captions[1] := '';

     {set num lock}
     if GetKeyState(VK_NUMLOCK) <> 0 then
      Captions[2] := ' NUM'
     else
      Captions[2] := '';

     {set scroll lock}
     if GetKeyState(VK_SCROLL) <> 0 then
      Captions[3] := ' SCRL'
     else
      Captions[3] := '';

     {set time}
     Captions[4] := ' '+TimeToStr(now);

    end;

    {}
    end.

[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]