BCS Tidy For Delphi Source Code

It is much easier to manage Delphi source code when the source code is highly organized and properly formatted. Large volumes of source code are required for many of the more functional systems. BCS Tidy for Delphi sorts uses statements, objects, variables and procedures (functions) in ascending alphabetical sequence.

The following listing is not so tidy.

{*-----------------------------------------------------------------------------
 Unit Name: BCSUsesFMTcmpU
 @Author Mr. Arch Brooks, Software Engineer, Brooks Computing Systems LLC
 Date:      04-Jan-2014
 @Version 1.0
 Purpose:
 History:
-----------------------------------------------------------------------------}
 
unit BCSUsesFMTcmpU;
 
interface
 
uses
  BCSXE3Utilsdp, System.Classes, System.SysUtils, System.Variants, Vcl.ComCtrls,
  Vcl.Controls, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.Forms, Vcl.Graphics, Vcl.Menus,
  Vcl.TabNotBk, Winapi.Messages, Winapi.Windows, BCSUsesFMTdp;
 
type
 
  /// Tab Sheet Class
  TTabSheet = class(Vcl.ComCtrls.TTabSheet)
  private
    /// Tab Control Color
    FColor: TColor;
    procedure SetColor(Value: TColor);
    procedure WMEraseBkGnd(var Msg: TWMEraseBkGnd); message WM_ERASEBKGND;
  public
    constructor Create(aOwner: TComponent); override;
    property Color: TColor read FColor write SetColor;
  end;
 
  /// BCSUsesFMT Primary Class
  TBCSUsesFMTcmpC = class(TForm)
    /// Timer for Dialog
    BCSUsesFMTTimer1: TTimer;
    /// Status Panel For Dialog
    BCSUsesFMTStatusPanel1: TStatusBar;
    /// Main Page Control
    BCSUsesFMTPageControl1: TPageControl;
    /// Tab sheet 1 for page control
    BCSUsesFMTTabSheet1: TTabSheet;
    /// Tab sheet 2 for page control
    BCSUsesFMTTabSheet2: TTabSheet;
    /// BCS XE3 Utilities Component
    BCSXE3UtilsCmp1: TBCSXE3UtilsCmp;
    /// BCSPageColor Main Menu
    BCSUsesFMTMainMenu1: TMainMenu;
    /// Help Menu Item
    BCSUsesFMTHelp1: TMenuItem;
    /// BCSUsesFMT Color Dialog
    BCSUsesFMTColor: TColorDialog;
    /// BCSUsesFMT Colors Menu Item
    BCSUsesFMTColors1: TMenuItem;
    /// Component Tester Menu Item
    ExecuteComponentTester1: TMenuItem;
    /// BCSUsesFMT Component
    BCSUsesFMTCmp1: TBCSUsesFMTCmp;
    procedure BCSUsesFMTTimer1Timer(Sender: TObject);
    procedure BCSUsesFMTHelp1Click(Sender: TObject);
    procedure BCSUsesFMTDrawTab(Control: TCustomTabControl; TabIndex: Integer;
      const Rect: TRect; Active: Boolean);
    procedure BCSUsesFMTCreate(Sender: TObject);
    procedure BCSUsesFMTColors1Click(Sender: TObject);
    procedure BCSUsesFMTStatusBar1DrawPanel(StatusBar: TStatusBar;
      Panel: TStatusPanel; const Rect: TRect);
    procedure ExecuteComponentTester1Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    private
    {Privare Declarations}
    /// Dialog Default Color
    RFColor : TColor;
  public
    {Public declarations}
    property RDColor : TColor read RFColor write RFColor;
  end;
 
var
  /// BCSUsesFMT Dialog Pointer
  BCSUsesFMTcmpC: TBCSUsesFMTcmpC;
 
implementation
 
{$R *.dfm}
 
var
  /// TimeStamp Variable
  ftime: String;
 
{*-----------------------------------------------------------------------------
  Procedure: ExecuteComponentTester1Click
  Date:      04-Jan-2014
  @Param     Sender: TObject
  @Return    None
 
-----------------------------------------------------------------------------}
 
procedure TBCSUsesFMTcmpC.ExecuteComponentTester1Click(Sender: TObject);
begin
  BCSUsesFMTCmp1.RCaption := 'BCSUsesFMT Component Tester Dialog';
  BCSUsesFMTCmp1.RDColor := RDColor;
  BCSUsesFMTCmp1.Execute;
end;
 
{*-----------------------------------------------------------------------------
  Procedure: FormActivate
  Date:      04-Jan-2014
  @Param     Sender: TObject
  @Return    None
 
-----------------------------------------------------------------------------}
 
procedure TBCSUsesFMTcmpC.FormActivate(Sender: TObject);
begin
  Color := RDColor;
    BCSUsesFMTCmp1.RDColor := Color;
    BCSUsesFMTTabSheet1.Color := Color;
    BCSUsesFMTTabSheet2.Color := Color;
    BCSUsesFMTStatusPanel1.Color := Color;
end;
 
{*-----------------------------------------------------------------------------
 Procedure: BCSUsesFMTColors1Click
 Date:      04-Jan-2014
 @Param     Sender: TObject
 @Return    None
 
 -----------------------------------------------------------------------------}
 
procedure TBCSUsesFMTcmpC.BCSUsesFMTColors1Click(Sender: TObject);
var
  ti: Integer;
begin
  if BCSUsesFMTColor.Execute then
  begin
    Color := BCSUsesFMTColor.Color;
    BCSUsesFMTCmp1.RDColor := Color;
    BCSUsesFMTTabSheet1.Color := Color;
    BCSUsesFMTTabSheet2.Color := Color;
    BCSUsesFMTStatusPanel1.Color := Color;
  end;
end;
 
{*-----------------------------------------------------------------------------
 Procedure: BCSUsesFMTCreate
 Date:      04-Jan-2014
 @Param     Sender: TObject
 @Return    None
 
 -----------------------------------------------------------------------------}
 
procedure TBCSUsesFMTcmpC.BCSUsesFMTCreate(Sender: TObject);
begin
  BCSUsesFMTTabSheet1.Color := Color;
  BCSUsesFMTTabSheet2.Color := Color;
  BCSUsesFMTStatusPanel1.Color := Color;
end;
 
{*-----------------------------------------------------------------------------
 Procedure: BCSUsesFMTHelp1Click
 Date:      04-Jan-2014
 @Param     Sender: TObject
 @Return    None
 
 -----------------------------------------------------------------------------}
 
procedure TBCSUsesFMTcmpC.BCSUsesFMTHelp1Click(Sender: TObject);
begin
  BCSXE3UtilsCmp1.ShellExec('http://bcswebs.us/bcs002/');
end;
 
{*-----------------------------------------------------------------------------
 Procedure: BCSUsesFMTTimer1Timer
 Date:      04-Jan-2014
 @Param     Sender: TObject
 @Return    None
 
 -----------------------------------------------------------------------------}
 
procedure TBCSUsesFMTcmpC.BCSUsesFMTTimer1Timer(Sender: TObject);
begin
  DateTimeToString(ftime, 'dddd, mmmm dd, yyyy hh:mm:ss     ', now);
  BCSUsesFMTStatusPanel1.Panels[2].Text := ftime;
end;
 
{*-----------------------------------------------------------------------------
 Procedure: BCSUsesFMTDrawTab
 Date:      04-Jan-2014
 @Param     Control: TCustomTabControl; TabIndex: Integer; const Rect: TRect; Active: Boolean
 @Return    None
 
 -----------------------------------------------------------------------------}
 
procedure TBCSUsesFMTcmpC.BCSUsesFMTDrawTab(Control: TCustomTabControl;
  TabIndex: Integer; const Rect: TRect; Active: Boolean);
var
  AText: string;
  APoint: TPoint;
begin
  with (Control as TPageControl).Canvas do
  begin
    Brush.Color := Color;
    FillRect(Rect);
    AText := TPageControl(Control).Pages[TabIndex].Caption;
    with Control.Canvas do
    begin
      APoint.x := (Rect.Right - Rect.Left) div 2 - TextWidth(AText) div 2;
      APoint.y := (Rect.Bottom - Rect.Top) div 2 - TextHeight(AText) div 2;
      TextRect(Rect, Rect.Left + APoint.x, Rect.Top + APoint.y, AText);
    end;
  end;
end;
 
{*-----------------------------------------------------------------------------
 Procedure: WMEraseBkGnd
 Date:      04-Jan-2014
 @Param     var Msg: TWMEraseBkGnd
 @Return    None
 
 -----------------------------------------------------------------------------}
 
procedure TTabSheet.WMEraseBkGnd(var Msg: TWMEraseBkGnd);
begin
  if FColor = clBtnFace then
    inherited
  else
  begin
    Brush.Color := FColor;
    FillRect(Msg.dc, ClientRect, Brush.Handle);
    Msg.Result := 1;
  end;
end;
 
{*-----------------------------------------------------------------------------
 Procedure: SetColor
 Date:      04-Jan-2014
 @Param     Value: TColor
 @Return    None
 
 -----------------------------------------------------------------------------}
 
procedure TTabSheet.SetColor(Value: TColor);
begin
  if FColor <> Value then
  begin
    FColor := Value;
    Invalidate;
  end;
end;
 
{*-----------------------------------------------------------------------------
 Procedure: Create
 Date:      04-Jan-2014
 @Param     aOwner: TComponent
 @Return    None
 
 -----------------------------------------------------------------------------}
 
constructor TTabSheet.Create(aOwner: TComponent);
begin
  inherited;
  FColor := clWhite;
end;
 
{*-----------------------------------------------------------------------------
 Procedure: BCSUsesFMTStatusBar1DrawPanel
 Date:      04-Jan-2014
 @Param     StatusBar: TStatusBar; Panel: TStatusPanel; const Rect: TRect
 @Return    None
 
 -----------------------------------------------------------------------------}
 
procedure TBCSUsesFMTcmpC.BCSUsesFMTStatusBar1DrawPanel(StatusBar: TStatusBar;
  Panel: TStatusPanel; const Rect: TRect);
begin
  with StatusBar.Canvas do
  begin
    FillRect(Rect);
    case Panel.Index of
      0: // fist panel
        begin
          Brush.Color := Color;
          Font.Color := clBlack;
          // Font.Style := [fsBold];
          TextRect(Rect, 2 + Rect.Left, 2 + Rect.Top, Panel.Text);
        end;
      1: // second panel
        begin
          Brush.Color := Color;
          Font.Color := clBlack;
          // Font.Style := [fsItalic];
          TextRect(Rect, 2 + Rect.Left, 2 + Rect.Top, Panel.Text);
        end;
      2: // Third panel
        begin
          Brush.Color := Color;
          Font.Color := clBlack;
          // Font.Style := [fsItalic];
          Panel.Text := ftime;
          TextRect(Rect, 2 + Rect.Left, 2 + Rect.Top, Panel.Text);
          TextOut(0, 0, ftime);
        end;
    end;
  end;
end;
 
end.

The source code reformatted by using BCS Tidy For Delphi is restructured so the same source now looks like this.

{*-----------------------------------------------------------------------------
 Unit Name: BCSUsesFMTcmpU
 @Author Mr. Arch Brooks, Software Engineer, Brooks Computing Systems LLC
 Date:      04-Jan-2014
 @Version 1.0
 Purpose:
 History:
-----------------------------------------------------------------------------}
 
unit BCSUsesFMTcmpU;
 
interface
 
uses
  BCSUsesFMTdp, BCSXE3Utilsdp, System.Classes, System.SysUtils, System.Variants, 
  Vcl.ComCtrls, Vcl.Controls, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.Forms, 
  Vcl.Graphics, Vcl.Menus, Vcl.TabNotBk, Winapi.Messages, Winapi.Windows;
 
type
 
  /// Tab Sheet Class
  TTabSheet = class(Vcl.ComCtrls.TTabSheet)
  private
    /// Tab Control Color
    FColor: TColor;
    procedure SetColor(Value: TColor);
    procedure WMEraseBkGnd(var Msg: TWMEraseBkGnd); message WM_ERASEBKGND;
  public
    constructor Create(aOwner: TComponent); override;
    property Color: TColor read FColor write SetColor;
  end;
 
  /// BCSUsesFMT Primary Class
  TBCSUsesFMTcmpC = class(TForm)
    /// BCSUsesFMT Component
    BCSUsesFMTCmp1: TBCSUsesFMTCmp;
    /// BCSUsesFMT Color Dialog
    BCSUsesFMTColor: TColorDialog;
    /// BCSUsesFMT Colors Menu Item
    BCSUsesFMTColors1: TMenuItem;
    /// Help Menu Item
    BCSUsesFMTHelp1: TMenuItem;
    /// BCSPageColor Main Menu
    BCSUsesFMTMainMenu1: TMainMenu;
    /// Main Page Control
    BCSUsesFMTPageControl1: TPageControl;
    /// Status Panel For Dialog
    BCSUsesFMTStatusPanel1: TStatusBar;
    /// Tab sheet 1 for page control
    BCSUsesFMTTabSheet1: TTabSheet;
    /// Tab sheet 2 for page control
    BCSUsesFMTTabSheet2: TTabSheet;
    /// Timer for Dialog
    BCSUsesFMTTimer1: TTimer;
    /// BCS XE3 Utilities Component
    BCSXE3UtilsCmp1: TBCSXE3UtilsCmp;
    /// Component Tester Menu Item
    ExecuteComponentTester1: TMenuItem;
    procedure BCSUsesFMTColors1Click(Sender: TObject);
    procedure BCSUsesFMTCreate(Sender: TObject);
    procedure BCSUsesFMTDrawTab(Control: TCustomTabControl; TabIndex: Integer;
      const Rect: TRect; Active: Boolean);
    procedure BCSUsesFMTHelp1Click(Sender: TObject);
    procedure BCSUsesFMTStatusBar1DrawPanel(StatusBar: TStatusBar;
      Panel: TStatusPanel; const Rect: TRect);
    procedure BCSUsesFMTTimer1Timer(Sender: TObject);
    procedure ExecuteComponentTester1Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    private
    {Privare Declarations}
    /// Dialog Default Color
    RFColor : TColor;
  public
    {Public declarations}
    property RDColor : TColor read RFColor write RFColor;
  end;
 
var
  /// BCSUsesFMT Dialog Pointer
  BCSUsesFMTcmpC: TBCSUsesFMTcmpC;
 
implementation
 
{$R *.dfm}
 
var
  /// TimeStamp Variable
  ftime: String;
 
{*-----------------------------------------------------------------------------
 Procedure: BCSUsesFMTColors1Click
 Date:      04-Jan-2014
 @Param     Sender: TObject
 @Return    None
 
 -----------------------------------------------------------------------------}
 
procedure TBCSUsesFMTcmpC.BCSUsesFMTColors1Click(Sender: TObject);
var
  ti: Integer;
begin
  if BCSUsesFMTColor.Execute then
  begin
    Color := BCSUsesFMTColor.Color;
    BCSUsesFMTCmp1.RDColor := Color;
    BCSUsesFMTTabSheet1.Color := Color;
    BCSUsesFMTTabSheet2.Color := Color;
    BCSUsesFMTStatusPanel1.Color := Color;
  end;
end;
 
{*-----------------------------------------------------------------------------
 Procedure: BCSUsesFMTCreate
 Date:      04-Jan-2014
 @Param     Sender: TObject
 @Return    None
 
 -----------------------------------------------------------------------------}
 
procedure TBCSUsesFMTcmpC.BCSUsesFMTCreate(Sender: TObject);
begin
  BCSUsesFMTTabSheet1.Color := Color;
  BCSUsesFMTTabSheet2.Color := Color;
  BCSUsesFMTStatusPanel1.Color := Color;
end;
 
{*-----------------------------------------------------------------------------
 Procedure: BCSUsesFMTDrawTab
 Date:      04-Jan-2014
 @Param     Control: TCustomTabControl; TabIndex: Integer; const Rect: TRect; Active: Boolean
 @Return    None
 
 -----------------------------------------------------------------------------}
 
procedure TBCSUsesFMTcmpC.BCSUsesFMTDrawTab(Control: TCustomTabControl;
  TabIndex: Integer; const Rect: TRect; Active: Boolean);
var
  AText: string;
  APoint: TPoint;
begin
  with (Control as TPageControl).Canvas do
  begin
    Brush.Color := Color;
    FillRect(Rect);
    AText := TPageControl(Control).Pages[TabIndex].Caption;
    with Control.Canvas do
    begin
      APoint.x := (Rect.Right - Rect.Left) div 2 - TextWidth(AText) div 2;
      APoint.y := (Rect.Bottom - Rect.Top) div 2 - TextHeight(AText) div 2;
      TextRect(Rect, Rect.Left + APoint.x, Rect.Top + APoint.y, AText);
    end;
  end;
end;
 
{*-----------------------------------------------------------------------------
 Procedure: BCSUsesFMTHelp1Click
 Date:      04-Jan-2014
 @Param     Sender: TObject
 @Return    None
 
 -----------------------------------------------------------------------------}
 
procedure TBCSUsesFMTcmpC.BCSUsesFMTHelp1Click(Sender: TObject);
begin
  BCSXE3UtilsCmp1.ShellExec('http://bcswebs.us/bcs002/');
end;
 
{*-----------------------------------------------------------------------------
 Procedure: BCSUsesFMTStatusBar1DrawPanel
 Date:      04-Jan-2014
 @Param     StatusBar: TStatusBar; Panel: TStatusPanel; const Rect: TRect
 @Return    None
 
 -----------------------------------------------------------------------------}
 
procedure TBCSUsesFMTcmpC.BCSUsesFMTStatusBar1DrawPanel(StatusBar: TStatusBar;
  Panel: TStatusPanel; const Rect: TRect);
begin
  with StatusBar.Canvas do
  begin
    FillRect(Rect);
    case Panel.Index of
      0: // fist panel
        begin
          Brush.Color := Color;
          Font.Color := clBlack;
          // Font.Style := [fsBold];
          TextRect(Rect, 2 + Rect.Left, 2 + Rect.Top, Panel.Text);
        end;
      1: // second panel
        begin
          Brush.Color := Color;
          Font.Color := clBlack;
          // Font.Style := [fsItalic];
          TextRect(Rect, 2 + Rect.Left, 2 + Rect.Top, Panel.Text);
        end;
      2: // Third panel
        begin
          Brush.Color := Color;
          Font.Color := clBlack;
          // Font.Style := [fsItalic];
          Panel.Text := ftime;
          TextRect(Rect, 2 + Rect.Left, 2 + Rect.Top, Panel.Text);
          TextOut(0, 0, ftime);
        end;
    end;
  end;
end;
 
{*-----------------------------------------------------------------------------
 Procedure: BCSUsesFMTTimer1Timer
 Date:      04-Jan-2014
 @Param     Sender: TObject
 @Return    None
 
 -----------------------------------------------------------------------------}
 
procedure TBCSUsesFMTcmpC.BCSUsesFMTTimer1Timer(Sender: TObject);
begin
  DateTimeToString(ftime, 'dddd, mmmm dd, yyyy hh:mm:ss     ', now);
  BCSUsesFMTStatusPanel1.Panels[2].Text := ftime;
end;
 
{*-----------------------------------------------------------------------------
  Procedure: ExecuteComponentTester1Click
  Date:      04-Jan-2014
  @Param     Sender: TObject
  @Return    None
 
-----------------------------------------------------------------------------}
 
procedure TBCSUsesFMTcmpC.ExecuteComponentTester1Click(Sender: TObject);
begin
  BCSUsesFMTCmp1.RCaption := 'BCSUsesFMT Component Tester Dialog';
  BCSUsesFMTCmp1.RDColor := RDColor;
  BCSUsesFMTCmp1.Execute;
end;
 
{*-----------------------------------------------------------------------------
  Procedure: FormActivate
  Date:      04-Jan-2014
  @Param     Sender: TObject
  @Return    None
 
-----------------------------------------------------------------------------}
 
procedure TBCSUsesFMTcmpC.FormActivate(Sender: TObject);
begin
  Color := RDColor;
    BCSUsesFMTCmp1.RDColor := Color;
    BCSUsesFMTTabSheet1.Color := Color;
    BCSUsesFMTTabSheet2.Color := Color;
    BCSUsesFMTStatusPanel1.Color := Color;
end;
 
{*-----------------------------------------------------------------------------
 Procedure: Create
 Date:      04-Jan-2014
 @Param     aOwner: TComponent
 @Return    None
 
 -----------------------------------------------------------------------------}
 
constructor TTabSheet.Create(aOwner: TComponent);
begin
  inherited;
  FColor := clWhite;
end;
 
{*-----------------------------------------------------------------------------
 Procedure: SetColor
 Date:      04-Jan-2014
 @Param     Value: TColor
 @Return    None
 
 -----------------------------------------------------------------------------}
 
procedure TTabSheet.SetColor(Value: TColor);
begin
  if FColor <> Value then
  begin
    FColor := Value;
    Invalidate;
  end;
end;
 
{*-----------------------------------------------------------------------------
 Procedure: WMEraseBkGnd
 Date:      04-Jan-2014
 @Param     var Msg: TWMEraseBkGnd
 @Return    None
 
 -----------------------------------------------------------------------------}
 
procedure TTabSheet.WMEraseBkGnd(var Msg: TWMEraseBkGnd);
begin
  if FColor = clBtnFace then
    inherited
  else
  begin
    Brush.Color := FColor;
    FillRect(Msg.dc, ClientRect, Brush.Handle);
    Msg.Result := 1;
  end;
end;
 
end.

Please produce hard copy of both files so a side by side comparison is easily achievable.

Please feel free to contact me if you have further interest in BCS Tidy For Delphi Source Code at arch@archbrooks.com.

Mr. Arch Brooks, Software Engineer, Brooks Computing Systems, LLC authored this article.

Leave a Reply