The Example below is SSCCE code snippet.
The source code is below:
[codesyntax lang=”delphi”]
{*-----------------------------------------------------------------------------
Unit Name: TopFormU
@Author Mr. Arch Brooks, Software Engineer, Brooks Computing Systems LLC
@Version 1.0
Date: 04-Jan-2014
Purpose:
History:
-----------------------------------------------------------------------------}
unit TopFormU;
interface
uses
BCSXE3Utilsdp, System.Classes, System.SysUtils, System.Variants,
TopFormdmU, Vcl.ComCtrls, Vcl.Controls, Vcl.DBCtrls, Vcl.Dialogs,
Vcl.ExtCtrls, Vcl.Forms, Vcl.Graphics, Vcl.Grids, Vcl.Menus, Vcl.StdCtrls,
Vcl.TabNotBk, Winapi.Messages, Winapi.Windows, Vcl.DBGrids;
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;
/// TopForm Primary Class
TTopFormC = class(TForm)
/// BCS XE3 Utilities Component
BCSXE3UtilsCmp1: TBCSXE3UtilsCmp;
/// TopForm Color Dialog
TopFormColor: TColorDialog;
/// TopForm Colors Menu Item
TopFormColors1: TMenuItem;
/// TopForm DB Navigator
TopFormDBNavigator1: TDBNavigator;
/// TopForm DB Memo
TopFormDBMemo1: TDBMemo;
/// TopForm SB Grid
TopFormDBGrid1: TDBGrid;
/// BCSPageColor Main Menu
TopFormMainMenu1: TMainMenu;
/// Main Page Control
TopFormPageControl1: TPageControl;
/// Help Menu Item
TopFormHelp1: TMenuItem;
/// Status Panel For Dialog
TopFormStatusPanel1: TStatusBar;
/// Tab sheet 1 for page control
TopFormTabSheet1: TTabSheet;
/// Tab sheet 2 for page control
TopFormTabSheet2: TTabSheet;
/// Timer for Dialog
TopFormTimer1: TTimer;
procedure TopFormColors1Click(Sender: TObject);
procedure TopFormCreate(Sender: TObject);
procedure TopFormDrawTab(Control: TCustomTabControl; TabIndex: Integer;
const Rect: TRect; Active: Boolean);
procedure TopFormFormActivate(Sender: TObject);
procedure TopFormGridColor;
procedure TopFormHelp1Click(Sender: TObject);
procedure TopFormStatusBar1DrawPanel(StatusBar: TStatusBar;
Panel: TStatusPanel; const Rect: TRect);
procedure TopFormTimer1Timer(Sender: TObject);
public
{Public declarations}
end;
var
/// TopForm Dialog Pointer
TopFormC: TTopFormC;
implementation
{$R *.dfm}
var
/// TimeStamp Variable
ftime: String;
/// Item Index
i: Integer;
{*-----------------------------------------------------------------------------
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;
{*-----------------------------------------------------------------------------
Procedure: TopFormColors1Click
Date: 04-Jan-2014
@Param Sender: TObject
@Return None
-----------------------------------------------------------------------------}
procedure TTopFormC.TopFormColors1Click(Sender: TObject);
var
ti: Integer;
begin
if TopFormColor.Execute then
begin
Color := TopFormColor.Color;
TopFormTabSheet1.Color := Color;
TopFormTabSheet2.Color := Color;
TopFormDBGrid1.Color := Color;
TopFormStatusPanel1.Color := Color;
TopFormGridColor;
TopFormDBGrid1.Repaint;
end;
end;
{*-----------------------------------------------------------------------------
Procedure: TopFormCreate
Date: 04-Jan-2014
@Param Sender: TObject
@Return None
-----------------------------------------------------------------------------}
procedure TTopFormC.TopFormCreate(Sender: TObject);
begin
Color := $C9FCFA;
TopFormTabSheet1.Color := Color;
TopFormTabSheet2.Color := Color;
TopFormStatusPanel1.Color := Color;
end;
{*-----------------------------------------------------------------------------
Procedure: TopFormDrawTab
Date: 04-Jan-2014
@Param Control: TCustomTabControl; TabIndex: Integer; const Rect: TRect;
Active: Boolean
@Return None
-----------------------------------------------------------------------------}
procedure TTopFormC.TopFormDrawTab(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: FormActivate
Date: 05-Jan-2014
@Param Sender: TObject
@Return None
-----------------------------------------------------------------------------}
procedure TTopFormC.TopFormFormActivate(Sender: TObject);
begin
TopFormDBGrid1.Invalidate;
TopFormDBGrid1.Color := Color;
TopFormDBGrid1.Canvas.Brush.Color := Color;
TopFormDBGrid1.Canvas.Refresh;
TopFormGridColor;
end;
{*-----------------------------------------------------------------------------
Procedure: TopFormGridColor
Date: 05-Jan-2014
@Param None
@Return None
-----------------------------------------------------------------------------}
procedure TTopFormC.TopFormGridColor;
begin
i := 0;
repeat
TopFormDBGrid1.Columns[i].Color := Color;
Inc(i);
until i > TopFormDBGrid1.Columns.Count - 1;
TopFormDBGrid1.Repaint;
end;
{*-----------------------------------------------------------------------------
Procedure: TopFormHelp1Click
Date: 04-Jan-2014
@Param Sender: TObject
@Return None
-----------------------------------------------------------------------------}
procedure TTopFormC.TopFormHelp1Click(Sender: TObject);
begin
BCSXE3UtilsCmp1.ShellExec('http://bcswebs.us/bcs002/');
end;
{*-----------------------------------------------------------------------------
Procedure: TopFormStatusBar1DrawPanel
Date: 04-Jan-2014
@Param StatusBar: TStatusBar; Panel: TStatusPanel; const Rect: TRect
@Return None
-----------------------------------------------------------------------------}
procedure TTopFormC.TopFormStatusBar1DrawPanel(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: TopFormTimer1Timer
Date: 04-Jan-2014
@Param Sender: TObject
@Return None
-----------------------------------------------------------------------------}
procedure TTopFormC.TopFormTimer1Timer(Sender: TObject);
begin
DateTimeToString(ftime, 'dddd, mmmm dd, yyyy hh:mm:ss ', now);
TopFormStatusPanel1.Panels[2].Text := ftime;
end;
end.
[/codesyntax]
[codesyntax lang=”delphi”]
object TopFormC: TTopFormC
Left = 0
Top = 0
Caption = 'TopFormC'
ClientHeight = 274
ClientWidth = 447
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
Menu = TopFormMainMenu1
OldCreateOrder = False
Position = poDesktopCenter
OnActivate = TopFormFormActivate
OnCreate = TopFormCreate
PixelsPerInch = 96
TextHeight = 13
object TopFormStatusPanel1: TStatusBar
Left = 0
Top = 255
Width = 447
Height = 19
Panels = <
item
Style = psOwnerDraw
Width = 175
end
item
Style = psOwnerDraw
Width = 50
end
item
Alignment = taRightJustify
Style = psOwnerDraw
Width = 50
end>
OnDrawPanel = TopFormStatusBar1DrawPanel
end
object TopFormPageControl1: TPageControl
Left = 0
Top = 0
Width = 447
Height = 255
ActivePage = TopFormTabSheet1
Align = alClient
OwnerDraw = True
TabOrder = 1
TabPosition = tpBottom
OnDrawTab = TopFormDrawTab
object TopFormTabSheet1: TTabSheet
Caption = 'Options'
object TopFormDBNavigator1: TDBNavigator
Left = 0
Top = 0
Width = 439
Height = 25
DataSource = TopFormdm.adsDB01
Align = alTop
TabOrder = 0
end
object TopFormDBGrid1: TDBGrid
Left = 0
Top = 25
Width = 439
Height = 204
Align = alClient
DataSource = TopFormdm.adsDB01
ParentColor = True
TabOrder = 1
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'Tahoma'
TitleFont.Style = []
OnTitleClick = TopFormDBGrid1TitleClick
end
end
object TopFormTabSheet2: TTabSheet
Caption = 'Data'
ImageIndex = 1
object TopFormDBMemo1: TDBMemo
Left = 0
Top = 0
Width = 439
Height = 229
Align = alClient
DataSource = TopFormdm.adsDB01
ParentColor = True
ScrollBars = ssVertical
TabOrder = 0
end
end
end
object TopFormTimer1: TTimer
OnTimer = TopFormTimer1Timer
Left = 40
Top = 32
end
object BCSXE3UtilsCmp1: TBCSXE3UtilsCmp
FilLen = 0
Left = 184
Top = 40
end
object TopFormMainMenu1: TMainMenu
OwnerDraw = True
Left = 296
Top = 40
object TopFormColors1: TMenuItem
Caption = 'Colors'
OnClick = TopFormColors1Click
end
object TopFormHelp1: TMenuItem
Caption = 'Help'
OnClick = TopFormHelp1Click
end
end
object TopFormColor: TColorDialog
Options = [cdFullOpen]
Left = 72
Top = 96
end
end
[/codesyntax]
[codesyntax lang=”php”]
{*-----------------------------------------------------------------------------
Unit Name: TopFormdmU
@Author Mr. Arch Brooks, Software Engineer, Brooks Computing Systems LLC
@Version 1.0
Date: 09-May-2013
Purpose:
History:
-----------------------------------------------------------------------------}
unit TopFormdmU;
interface
uses
Data.DB, DBAccess, MemDS, MySQLUniProvider, System.Classes, Uni;
type
/// Main Class For The Data Module
TTopFormdm = class(TDataModule)
/// ADO Data Source
adsDB01: TDataSource;
ataCon1: TUniConnection;
ataDB01: TUniTable;
private
{ Private declarations }
public
{ Public declarations }
end;
var
/// Data Module Pointer
TopFormdm: TTopFormdm;
implementation
{%CLASSGROUP 'Vcl.Controls.TControl'}
{$R *.dfm}
end.
[/codesyntax]
[codesyntax lang=”delphi”]
object TopFormdm: TTopFormdm
OldCreateOrder = False
Height = 150
Width = 215
object adsDB01: TDataSource
DataSet = ataDB01
Left = 104
Top = 32
end
object ataCon1: TUniConnection
ProviderName = 'MySQL'
Port = 3306
Database = 'bk01'
Username = 'bcs'
Server = 'localhost'
Connected = True
LoginPrompt = False
Left = 48
Top = 80
EncryptedPassword = 'AFFF9AFF9EFF9CFF9AFFCFFFCFFFC8FF'
end
object ataDB01: TUniTable
TableName = '<#tab>'
Connection = ataCon1
Left = 112
Top = 80
end
end
[/codesyntax]
Please do not hesitate to contact me if I may be of further assistance in this endeavor.
Mr. Arch Brooks, Software Engineer, Brooks Computing Systems, LLC authored this article.