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.

Comments (0) Trackbacks (0)

No comments yet.


Leave a comment

No trackbacks yet.