BCS Technology Blog Portal Quality, Reliability & Service

6Jan/140

BCS SSCCE Delphi Quuestions

Bookmark and Share

The Example below is SSCCE code snippet.

BCSSSCE1

The source code is below:

{*-----------------------------------------------------------------------------
 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.
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
{*-----------------------------------------------------------------------------
 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.
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

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.

Print This Post Print This Post
Comments (0) Trackbacks (0)

No comments yet.


Leave a comment

No trackbacks yet.