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.
[codesyntax lang=”delphi”]
{*-----------------------------------------------------------------------------
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.
[/codesyntax]
The source code reformatted by using BCS Tidy For Delphi is restructured so the same source now looks like this.
[codesyntax lang=”delphi”]
{*-----------------------------------------------------------------------------
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.
[/codesyntax]
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.