BCS Project Manager

Every computer technician is strapped with the task of reporting time spent on projects as billable hours.

The BCS Project Manager offers relief in that allows the technician to enter information into the repository and the database object calculates the elapsed time of the identified tasks.

This calculation is shown in elapsed days, hours, minutes and seconds. An associated report is also available that shows task completed by day and week. Consequently uncompleted task are also reported in a similar format by day or week.

BCSTasks01

The heart of the BCS Project Manager is the data repository.

The MySQL schema is listed below

-- phpMyAdmin SQL Dump
-- version 4.1.5
-- http://www.phpmyadmin.net
--
-- Host: localhost
-- Generation Time: Jan 31, 2014 at 05:46 PM
-- Server version: 5.5.24-log
-- PHP Version: 5.3.26
 
51&q=SET&lr=lang_en">SET SQL_MODE = "NO_AUTO_VALUE_ON_ZERO";
51&q=SET&lr=lang_en">SET time_zone = "+00:00";
 
/*!40101 SET @OLD_CHARACTER_SET_CLIENT=@@CHARACTER_SET_CLIENT */;
/*!40101 SET @OLD_CHARACTER_SET_RESULTS=@@CHARACTER_SET_RESULTS */;
/*!40101 SET @OLD_COLLATION_CONNECTION=@@COLLATION_CONNECTION */;
/*!40101 SET NAMES utf8 */;
 
--
-- Database: `bcswebtools`
--
 
-- --------------------------------------------------------
 
--
-- Table structure for table `pwb`
--
 
51&q=CREATE&lr=lang_en">CREATE 51&q=TABLE&lr=lang_en">TABLE 51&q=IF%20NOT%20EXISTS&lr=lang_en">IF 5.1/en/non-typed-operators.html">NOT EXISTS `pwb` (
  `id` 51&q=INT&lr=lang_en">int(11) 5.1/en/non-typed-operators.html">NOT 51&q=NULL&lr=lang_en">NULL 51&q=AUTO_INCREMENT&lr=lang_en">AUTO_INCREMENT,
  `sdes` 51&q=VARCHAR&lr=lang_en">varchar(255) 5.1/en/non-typed-operators.html">NOT 51&q=NULL&lr=lang_en">NULL,
  `xqt` 51&q=VARCHAR&lr=lang_en">varchar(255) 5.1/en/non-typed-operators.html">NOT 51&q=NULL&lr=lang_en">NULL,
  `sdir` 51&q=VARCHAR&lr=lang_en">varchar(125) 5.1/en/non-typed-operators.html">NOT 51&q=NULL&lr=lang_en">NULL,
  `det` 51&q=MEDIUMTEXT&lr=lang_en">mediumtext 5.1/en/non-typed-operators.html">NOT 51&q=NULL&lr=lang_en">NULL,
  51&q=PRIMARY%20KEY&lr=lang_en">PRIMARY KEY (`id`)
) 51&q=ENGINE&lr=lang_en">ENGINE=51&q=INNODB&lr=lang_en">InnoDB  51&q=DEFAULT&lr=lang_en">DEFAULT 51&q=CHARSET&lr=lang_en">CHARSET=utf8 51&q=AUTO_INCREMENT&lr=lang_en">AUTO_INCREMENT=378 ;
 
/*!40101 SET CHARACTER_SET_CLIENT=@OLD_CHARACTER_SET_CLIENT */;
/*!40101 SET CHARACTER_SET_RESULTS=@OLD_CHARACTER_SET_RESULTS */;
/*!40101 SET COLLATION_CONNECTION=@OLD_COLLATION_CONNECTION */;

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

BCS MVC 4 With Flash Content

To include flash on you MVC 4 applications create a new folder “swf” under the Contents folder of the MVC 4 project tree.

Next add an existing item to the folder “swf”. Select the “swf” flash file you would like to incorporate into your web site now.

Go to the Views Shared subfolder of the solution explorer and open the SiteMaster file.

Place the object in the desired location on the SiteMaster. Make sure the path includes /Content/swf/swfname.swf in the object.

When you run the MVC 4 application your flash content will appear.

I am including the source of the SiteMaster file below.

<%@ Master Language="C#" Inherits="System.Web.Mvc.ViewMasterPage" %>
<!DOCTYPE html>
<html lang="en">
    <head runat="server">
        <meta charset="utf-8" />
        <title><asp:ContentPlaceHolder ID="TitleContent" runat="server" /></title>
        <link href="<%: Url.Content("~/favicon.ico") %>" rel="shortcut icon" type="image/x-icon" />
        <meta name="viewport" content="width=device-width" />
        <%: Styles.Render("~/Content/css") %>
        <%: Scripts.Render("~/bundles/modernizr") %>
    </head>
<body>
    <header>
        <div class="content-wrapper">
            <div class="float-left">
                <object
                    classid="clsid:D27CDB6E-AE6D-11cf-96B8-444553540000"
                    codebase="http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=7,0,19,0"
                    id="BCSHead"
                    width="470" height="51">
                    <param name="movie" value="BCSHead.swf">
                    <param name="bgcolor" value="#FFFFFF">
                    <param name="quality" value="high">
                    <param name="allowscriptaccess" value="samedomain">
                    <embed
                        type="application/x-shockwave-flash"
                        pluginspage="http://www.adobe.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash"
                        name="BCSHead"
                        width="470" height="51"
                        src="/Content/swf/BCSHead.swf"
                        bgcolor="#FFFFFF"
                        quality="high"
                        allowscriptaccess="samedomain">
                        <noembed>
          </noembed>
                    </embed>
                </object>
 
                <p class="site-title"><%: Html.ActionLink("your logo here", "Index", "Home") %></p>
            </div>
            <div class="float-right">
                <section id="login">
                    <%: Html.Partial("_LoginPartial") %>
                </section>
                <nav>
                    <ul id="menu">
                        <li><%: Html.ActionLink("Home", "Index", "Home") %></li>
                        <li><%: Html.ActionLink("About", "About", "Home") %></li>
                        <li><%: Html.ActionLink("Contact", "Contact", "Home") %></li>
                    </ul>
                </nav>
            </div>
        </div>
    </header>
    <div id="body">
        <asp:ContentPlaceHolder ID="FeaturedContent" runat="server" />
        <section class="content-wrapper main-content clear-fix">
            <asp:ContentPlaceHolder ID="MainContent" runat="server" />
        </section>
    </div>
    <footer>
        <div class="content-wrapper">
            <div class="float-left">
                <p>&copy; <%: DateTime.Now.Year %> - My ASP.NET MVC Application</p>
            </div>
        </div>
    </footer>
 
    <%: Scripts.Render("~/bundles/jquery") %>
    <asp:ContentPlaceHolder ID="ScriptsSection" runat="server" />
</body>
</html>

Repeat this process for as many objects as you would like to incorporate into your site and enjoy.

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

BCS Delphi Sorted Cross Reference Utility

It would be nice to be able to cross reference unique keywords and occurrences in Delphi source code. The BCS Sorted Cross Reference Utility provides Delphi Programmers with such a capability.

In addition to the sorted cross reverence the Delphi source codes are numbered and precede the cross reference.

Please feel free to generate the hard copy to fully utilize its capabilities.

1 {*-----------------------------------------------------------------------------
2  Unit Name: BCSUsesFMTcmpU
3  @Author Mr. Arch Brooks, Software Engineer, Brooks Computing Systems LLC
4  Date:      04-Jan-2014
5  @Version 1.0
6  Purpose:
7  History:
8 -----------------------------------------------------------------------------}
9 
10 unit BCSUsesFMTcmpU;
11 
12 interface
13 
14 uses
15   BCSXE3Utilsdp, System.Classes, System.SysUtils, System.Variants, Vcl.ComCtrls,
16   Vcl.Controls, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.Forms, Vcl.Graphics, Vcl.Menus,
17   Vcl.TabNotBk, Winapi.Messages, Winapi.Windows, BCSUsesFMTdp;
18 
19 type
20 
21   /// Tab Sheet Class
22   TTabSheet = class(Vcl.ComCtrls.TTabSheet)
23   private
24     /// Tab Control Color
25     FColor: TColor;
26     procedure SetColor(Value: TColor);
27     procedure WMEraseBkGnd(var Msg: TWMEraseBkGnd); message WM_ERASEBKGND;
28   public
29     constructor Create(aOwner: TComponent); override;
30     property Color: TColor read FColor write SetColor;
31   end;
32 
33   /// BCSUsesFMT Primary Class
34   TBCSUsesFMTcmpC = class(TForm)
35     /// Timer for Dialog
36     BCSUsesFMTTimer1: TTimer;
37     /// Status Panel For Dialog
38     BCSUsesFMTStatusPanel1: TStatusBar;
39     /// Main Page Control
40     BCSUsesFMTPageControl1: TPageControl;
41     /// Tab sheet 1 for page control
42     BCSUsesFMTTabSheet1: TTabSheet;
43     /// Tab sheet 2 for page control
44     BCSUsesFMTTabSheet2: TTabSheet;
45     /// BCS XE3 Utilities Component
46     BCSXE3UtilsCmp1: TBCSXE3UtilsCmp;
47     /// BCSPageColor Main Menu
48     BCSUsesFMTMainMenu1: TMainMenu;
49     /// Help Menu Item
50     BCSUsesFMTHelp1: TMenuItem;
51     /// BCSUsesFMT Color Dialog
52     BCSUsesFMTColor: TColorDialog;
53     /// BCSUsesFMT Colors Menu Item
54     BCSUsesFMTColors1: TMenuItem;
55     /// Component Tester Menu Item
56     ExecuteComponentTester1: TMenuItem;
57     /// BCSUsesFMT Component
58     BCSUsesFMTCmp1: TBCSUsesFMTCmp;
59     procedure BCSUsesFMTTimer1Timer(Sender: TObject);
60     procedure BCSUsesFMTHelp1Click(Sender: TObject);
61     procedure BCSUsesFMTDrawTab(Control: TCustomTabControl; TabIndex: Integer;
62       const Rect: TRect; Active: Boolean);
63     procedure BCSUsesFMTCreate(Sender: TObject);
64     procedure BCSUsesFMTColors1Click(Sender: TObject);
65     procedure BCSUsesFMTStatusBar1DrawPanel(StatusBar: TStatusBar;
66       Panel: TStatusPanel; const Rect: TRect);
67     procedure ExecuteComponentTester1Click(Sender: TObject);
68     procedure FormActivate(Sender: TObject);
69     private
70     {Privare Declarations}
71     /// Dialog Default Color
72     RFColor : TColor;
73   public
74     {Public declarations}
75     property RDColor : TColor read RFColor write RFColor;
76   end;
77 
78 var
79   /// BCSUsesFMT Dialog Pointer
80   BCSUsesFMTcmpC: TBCSUsesFMTcmpC;
81 
82 implementation
83 
84 {$R *.dfm}
85 
86 var
87   /// TimeStamp Variable
88   ftime: String;
89 
90 {*-----------------------------------------------------------------------------
91   Procedure: ExecuteComponentTester1Click
92   Date:      04-Jan-2014
93   @Param     Sender: TObject
94   @Return    None
95 
96 -----------------------------------------------------------------------------}
97 
98 procedure TBCSUsesFMTcmpC.ExecuteComponentTester1Click(Sender: TObject);
99 begin
100   BCSUsesFMTCmp1.RCaption := 'BCSUsesFMT Component Tester Dialog';
101   BCSUsesFMTCmp1.RDColor := RDColor;
102   BCSUsesFMTCmp1.Execute;
103 end;
104 
105 {*-----------------------------------------------------------------------------
106   Procedure: FormActivate
107   Date:      04-Jan-2014
108   @Param     Sender: TObject
109   @Return    None
110 
111 -----------------------------------------------------------------------------}
112 
113 procedure TBCSUsesFMTcmpC.FormActivate(Sender: TObject);
114 begin
115   Color := RDColor;
116     BCSUsesFMTCmp1.RDColor := Color;
117     BCSUsesFMTTabSheet1.Color := Color;
118     BCSUsesFMTTabSheet2.Color := Color;
119     BCSUsesFMTStatusPanel1.Color := Color;
120 end;
121 
122 {*-----------------------------------------------------------------------------
123  Procedure: BCSUsesFMTColors1Click
124  Date:      04-Jan-2014
125  @Param     Sender: TObject
126  @Return    None
127 
128  -----------------------------------------------------------------------------}
129 
130 procedure TBCSUsesFMTcmpC.BCSUsesFMTColors1Click(Sender: TObject);
131 var
132   ti: Integer;
133 begin
134   if BCSUsesFMTColor.Execute then
135   begin
136     Color := BCSUsesFMTColor.Color;
137     BCSUsesFMTCmp1.RDColor := Color;
138     BCSUsesFMTTabSheet1.Color := Color;
139     BCSUsesFMTTabSheet2.Color := Color;
140     BCSUsesFMTStatusPanel1.Color := Color;
141   end;
142 end;
143 
144 {*-----------------------------------------------------------------------------
145  Procedure: BCSUsesFMTCreate
146  Date:      04-Jan-2014
147  @Param     Sender: TObject
148  @Return    None
149 
150  -----------------------------------------------------------------------------}
151 
152 procedure TBCSUsesFMTcmpC.BCSUsesFMTCreate(Sender: TObject);
153 begin
154   BCSUsesFMTTabSheet1.Color := Color;
155   BCSUsesFMTTabSheet2.Color := Color;
156   BCSUsesFMTStatusPanel1.Color := Color;
157 end;
158 
159 {*-----------------------------------------------------------------------------
160  Procedure: BCSUsesFMTHelp1Click
161  Date:      04-Jan-2014
162  @Param     Sender: TObject
163  @Return    None
164 
165  -----------------------------------------------------------------------------}
166 
167 procedure TBCSUsesFMTcmpC.BCSUsesFMTHelp1Click(Sender: TObject);
168 begin
169   BCSXE3UtilsCmp1.ShellExec('http://bcswebs.us/bcs002/');
170 end;
171 
172 {*-----------------------------------------------------------------------------
173  Procedure: BCSUsesFMTTimer1Timer
174  Date:      04-Jan-2014
175  @Param     Sender: TObject
176  @Return    None
177 
178  -----------------------------------------------------------------------------}
179 
180 procedure TBCSUsesFMTcmpC.BCSUsesFMTTimer1Timer(Sender: TObject);
181 begin
182   DateTimeToString(ftime, 'dddd, mmmm dd, yyyy hh:mm:ss     ', now);
183   BCSUsesFMTStatusPanel1.Panels[2].Text := ftime;
184 end;
185 
186 {*-----------------------------------------------------------------------------
187  Procedure: BCSUsesFMTDrawTab
188  Date:      04-Jan-2014
189  @Param     Control: TCustomTabControl; TabIndex: Integer; const Rect: TRect; Active: Boolean
190  @Return    None
191 
192  -----------------------------------------------------------------------------}
193 
194 procedure TBCSUsesFMTcmpC.BCSUsesFMTDrawTab(Control: TCustomTabControl;
195   TabIndex: Integer; const Rect: TRect; Active: Boolean);
196 var
197   AText: string;
198   APoint: TPoint;
199 begin
200   with (Control as TPageControl).Canvas do
201   begin
202     Brush.Color := Color;
203     FillRect(Rect);
204     AText := TPageControl(Control).Pages[TabIndex].Caption;
205     with Control.Canvas do
206     begin
207       APoint.x := (Rect.Right - Rect.Left) div 2 - TextWidth(AText) div 2;
208       APoint.y := (Rect.Bottom - Rect.Top) div 2 - TextHeight(AText) div 2;
209       TextRect(Rect, Rect.Left + APoint.x, Rect.Top + APoint.y, AText);
210     end;
211   end;
212 end;
213 
214 {*-----------------------------------------------------------------------------
215  Procedure: WMEraseBkGnd
216  Date:      04-Jan-2014
217  @Param     var Msg: TWMEraseBkGnd
218  @Return    None
219 
220  -----------------------------------------------------------------------------}
221 
222 procedure TTabSheet.WMEraseBkGnd(var Msg: TWMEraseBkGnd);
223 begin
224   if FColor = clBtnFace then
225     inherited
226   else
227   begin
228     Brush.Color := FColor;
229     FillRect(Msg.dc, ClientRect, Brush.Handle);
230     Msg.Result := 1;
231   end;
232 end;
233 
234 {*-----------------------------------------------------------------------------
235  Procedure: SetColor
236  Date:      04-Jan-2014
237  @Param     Value: TColor
238  @Return    None
239 
240  -----------------------------------------------------------------------------}
241 
242 procedure TTabSheet.SetColor(Value: TColor);
243 begin
244   if FColor <> Value then
245   begin
246     FColor := Value;
247     Invalidate;
248   end;
249 end;
250 
251 {*-----------------------------------------------------------------------------
252  Procedure: Create
253  Date:      04-Jan-2014
254  @Param     aOwner: TComponent
255  @Return    None
256 
257  -----------------------------------------------------------------------------}
258 
259 constructor TTabSheet.Create(aOwner: TComponent);
260 begin
261   inherited;
262   FColor := clWhite;
263 end;
264 
265 {*-----------------------------------------------------------------------------
266  Procedure: BCSUsesFMTStatusBar1DrawPanel
267  Date:      04-Jan-2014
268  @Param     StatusBar: TStatusBar; Panel: TStatusPanel; const Rect: TRect
269  @Return    None
270 
271  -----------------------------------------------------------------------------}
272 
273 procedure TBCSUsesFMTcmpC.BCSUsesFMTStatusBar1DrawPanel(StatusBar: TStatusBar;
274   Panel: TStatusPanel; const Rect: TRect);
275 begin
276   with StatusBar.Canvas do
277   begin
278     FillRect(Rect);
279     case Panel.Index of
280       0: // fist panel
281         begin
282           Brush.Color := Color;
283           Font.Color := clBlack;
284           // Font.Style := [fsBold];
285           TextRect(Rect, 2 + Rect.Left, 2 + Rect.Top, Panel.Text);
286         end;
287       1: // second panel
288         begin
289           Brush.Color := Color;
290           Font.Color := clBlack;
291           // Font.Style := [fsItalic];
292           TextRect(Rect, 2 + Rect.Left, 2 + Rect.Top, Panel.Text);
293         end;
294       2: // Third panel
295         begin
296           Brush.Color := Color;
297           Font.Color := clBlack;
298           // Font.Style := [fsItalic];
299           Panel.Text := ftime;
300           TextRect(Rect, 2 + Rect.Left, 2 + Rect.Top, Panel.Text);
301           TextOut(0, 0, ftime);
302         end;
303     end;
304   end;
305 end;
306 
307 end.
 
(Rect.Bottom - Rect.Top) div 2 - TextHeight(AText) div 2
    208
 
(Rect.Right - Rect.Left) div 2 - TextWidth(AText) div 2
    207
 
1
    4, 5, 36, 38, 40, 41, 42, 46, 48, 50, 54, 56, 58, 59, 60, 64, 
    65, 67, 91, 92, 98, 100, 101, 102, 107, 116, 117, 119, 123, 124, 
    130, 137, 138, 140, 146, 154, 156, 160, 161, 167, 169, 173, 174, 
    180, 183, 188, 216, 230, 236, 253, 266, 267, 273, 287
 
APoint
    198, 207, 208, 209
 
APoint.x
    207, 209
 
APoint.y
    208, 209
 
AText
    197, 204, 207, 208, 209
 
BCSUsesFMTCmp1
    58, 100, 101, 102, 116, 137
 
BCSUsesFMTCmp1.RCaption
    100
 
BCSUsesFMTCmp1.RDColor
    101, 116, 137
 
BCSUsesFMTcmpC
    34, 80, 98, 113, 130, 152, 167, 180, 194, 273
 
BCSUsesFMTColor
    52, 54, 64, 123, 130, 134, 136
 
BCSUsesFMTColor.Color
    136
 
BCSUsesFMTColors1
    54, 64, 123, 130
 
BCSUsesFMTColors1Click
    64, 123, 130
 
BCSUsesFMTCreate
    63, 145, 152
 
BCSUsesFMTDrawTab
    61, 187, 194
 
BCSUsesFMTHelp1
    50, 60, 160, 167
 
BCSUsesFMTHelp1Click
    60, 160, 167
 
BCSUsesFMTMainMenu1
    48
 
BCSUsesFMTPageControl1
    40
 
BCSUsesFMTStatusBar1DrawPanel
    65, 266, 273
 
BCSUsesFMTStatusPanel1
    38, 119, 140, 156, 183
 
BCSUsesFMTStatusPanel1.Color
    119, 140, 156
 
BCSUsesFMTStatusPanel1.Panels[2].Text
    183
 
BCSUsesFMTTabSheet1
    42, 117, 138, 154
 
BCSUsesFMTTabSheet1.Color
    117, 138, 154
 
BCSUsesFMTTabSheet2
    44, 118, 139, 155
 
BCSUsesFMTTabSheet2.Color
    118, 139, 155
 
BCSUsesFMTTimer1
    36, 59, 173, 180
 
BCSUsesFMTTimer1Timer
    59, 173, 180
 
BCSXE3UtilsCmp1
    46, 169
 
begin
    99, 114, 133, 135, 153, 168, 181, 199, 201, 206, 223, 227, 243, 
    245, 260, 275, 277, 281, 288, 295
 
Brush.Color
    202, 228, 282, 289, 296
 
case
    279
 
clBlack
    283, 290, 297
 
clWhite
    262
 
Color
    24, 25, 26, 30, 47, 51, 52, 53, 54, 64, 71, 72, 75, 101, 115, 
    116, 117, 118, 119, 123, 130, 134, 136, 137, 138, 139, 140, 154, 
    155, 156, 202, 224, 228, 235, 237, 242, 244, 246, 262, 282, 283, 
    289, 290, 296, 297
 
const Rect
    62, 66, 189, 195, 268, 274
 
constructor Create
    29
 
constructor TTabSheet.Create
    259
 
end
    31, 59, 60, 63, 64, 67, 68, 76, 93, 98, 103, 108, 113, 120, 125, 
    130, 141, 142, 147, 152, 157, 162, 167, 170, 175, 180, 184, 210, 
    211, 212, 231, 232, 248, 249, 263, 286, 293, 302, 303, 304, 305, 
    307
 
ExecuteComponentTester1
    56, 67, 91, 98
 
ExecuteComponentTester1Click
    67, 91, 98
 
FColor
    25, 30, 72, 75, 224, 228, 244, 246, 262
 
Font.Color
    283, 290, 297
 
FormActivate
    68, 106, 113
 
ftime
    88, 182, 183, 299, 301
 
if
    134, 224, 244
 
inc
 
Msg.Result
    230
 
Panel
    37, 38, 65, 66, 119, 140, 156, 183, 266, 268, 273, 274, 279, 
    285, 292, 299, 300
 
Panel.Text
    285, 292, 299, 300
 
RDColor
    75, 101, 115, 116, 137
 
repeat
 
RFColor
    72, 75
 
SetColor
    26, 30, 235, 242
 
TabIndex
    61, 189, 195, 204
 
TBCSUsesFMTcmpC.BCSUsesFMTColors1Click
    130
 
TBCSUsesFMTcmpC.BCSUsesFMTCreate
    152
 
TBCSUsesFMTcmpC.BCSUsesFMTDrawTab
    194
 
TBCSUsesFMTcmpC.BCSUsesFMTHelp1Click
    167
 
TBCSUsesFMTcmpC.BCSUsesFMTStatusBar1DrawPanel
    273
 
TBCSUsesFMTcmpC.BCSUsesFMTTimer1Timer
    180
 
TBCSUsesFMTcmpC.ExecuteComponentTester1Click
    98
 
TBCSUsesFMTcmpC.FormActivate
    113
 
ti
    3, 15, 45, 46, 62, 68, 70, 74, 82, 88, 100, 106, 113, 132, 169, 
    182, 183, 189, 195, 204, 299, 301
 
TPageControl(Control).Pages[TabIndex].Caption
    204
 
TTabSheet.SetColor
    242
 
TTabSheet.WMEraseBkGnd
    222
 
until
 
Value
    26, 237, 242, 244, 246
 
WMEraseBkGnd
    27, 215, 217, 222

Of course there is a Multi Document Interface (MDI) that is used in conjunction with this tool and when you click on the number in the cross reference you are immediately positioned to the line number in the source code.  The MDI allows the cross reference and the source to be viewed simultaneously.

Please feel free to contact us further on either of these tools at arch@archbrooks.com.

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

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.

BCS Database Browser

This component allows the user to browse any database by using a grid and a specialized memo editor BCS Memo Pro.

BCSDBBro01

In the screenshot below you will see the BCS Memo Pro component in action.

BCSBro02

The BCS DB Browser is a handy tool.

The component documentation can be located http://archbrooks.com/compdoc/BCSDBBrowse/html/BCS%20Database%20Browser.htm.

The code for this component is located at Code Central http://bcsjava.com/blg/wordpress/?p=933.

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

BCS Memo Professional

There are those time when textural information must be utilized.  BCS Memo Pro provides such functions.

BCSMemo01

The normal data entry functions are available as well as the capability to change colors, fonts and maximize screen to the full size.

This tool is great when using the BCS Database Browser when memo type data is encountered.  I maintain multiple WordPress blogs and it is neat to be able to view article contents without WordPress overhead.

The component documentation is located http://archbrooks.com/compdoc/BCSMemoP/html/BCS%20Memo%20Pro.htm.

The source code for this component may be found at Code Central http://cc.embarcadero.com/item/29691

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

BCS Master Detail Infomation Collector

To collect information to be subsequently used in a master detail scenario the BCSMDInfo component fulfills that requirement.

BCSMD01

Once the component has executed successfully the following information is returned.

BCSMD02

As you can see all the information to establish the master detail scenario is collected.

Component documentation can be located http://archbrooks.com/compdoc/BCSMDInfo/html/BCS%20Collect%20Master%20Detail%20Information.htm.

The source code for this tool is located at http://cc.embarcadero.com/item/29690.

A modification was added to collect database user login credentials.  The Universal User Login component was used for this feature.  The article for the utility can be found at http://bcsjava.com/blg/wordpress/post.php?post=903.

A new table was created to support this level of user verification.  It schema is listed below.

-- phpMyAdmin SQL Dump
-- version 4.0.4
-- http://www.phpmyadmin.net
--
-- Host: localhost
-- Generation Time: Jan 17, 2014 at 01:17 PM
-- Server version: 5.5.24-log
-- PHP Version: 5.3.26
 
51&q=SET&lr=lang_en">SET SQL_MODE = "NO_AUTO_VALUE_ON_ZERO";
51&q=SET&lr=lang_en">SET time_zone = "+00:00";
 
/*!40101 SET @OLD_CHARACTER_SET_CLIENT=@@CHARACTER_SET_CLIENT */;
/*!40101 SET @OLD_CHARACTER_SET_RESULTS=@@CHARACTER_SET_RESULTS */;
/*!40101 SET @OLD_COLLATION_CONNECTION=@@COLLATION_CONNECTION */;
/*!40101 SET NAMES utf8 */;
 
--
-- Database: `bcswebtools`
--
 
-- --------------------------------------------------------
 
--
-- Table structure for table `dbct`
--
 
51&q=CREATE&lr=lang_en">CREATE 51&q=TABLE&lr=lang_en">TABLE 51&q=IF%20NOT%20EXISTS&lr=lang_en">IF 5.1/en/non-typed-operators.html">NOT EXISTS `dbct` (
  `id` 51&q=INT&lr=lang_en">int(11) 5.1/en/non-typed-operators.html">NOT 51&q=NULL&lr=lang_en">NULL 51&q=AUTO_INCREMENT&lr=lang_en">AUTO_INCREMENT,
  `uid` 51&q=VARCHAR&lr=lang_en">varchar(25) 5.1/en/non-typed-operators.html">NOT 51&q=NULL&lr=lang_en">NULL,
  `pwd` 51&q=VARCHAR&lr=lang_en">varchar(25) 5.1/en/non-typed-operators.html">NOT 51&q=NULL&lr=lang_en">NULL,
  51&q=PRIMARY%20KEY&lr=lang_en">PRIMARY KEY (`id`)
) 51&q=ENGINE&lr=lang_en">ENGINE=51&q=INNODB&lr=lang_en">InnoDB 51&q=DEFAULT&lr=lang_en">DEFAULT 51&q=CHARSET&lr=lang_en">CHARSET=utf8 51&q=AUTO_INCREMENT&lr=lang_en">AUTO_INCREMENT=1 ;
 
/*!40101 SET CHARACTER_SET_CLIENT=@OLD_CHARACTER_SET_CLIENT */;
/*!40101 SET CHARACTER_SET_RESULTS=@OLD_CHARACTER_SET_RESULTS */;
/*!40101 SET COLLATION_CONNECTION=@OLD_COLLATION_CONNECTION */;

This table contains a user name and a password value for verification purposes.

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

BCS Data Entry Panel Code Generator

There are those time when users would like to use data entry dialogs as opposed to the spreadsheet or grid approach of data entry. Memo data entry is normally handed in a separate tab on the tabbed panel.

BCSDE01

I have automated the process of generating data entry panels by traversing the MySQL database and extracting metadata. The metadata is then used to create data entry code which are available in a scroll box in case more datum than will fit in the default form size exists.  This application was written in Delphi XE3.

I then select the .dfm of the targeted application’s form and the data source and table name are detected and extracted.

The extracted table name is then opened and all the fields in the table are used as input to generate the data entry panel codes. The results are then stored in the forms directory as FormName_dfm.txt for the code that needs to be in the form designer and FormName_pas.txt for the data definitions for the form that reside in the Pascal code portion of the form.

Create a new tab on the form and add a scroll box aligned to the client. Open the two files (FormName_dfm.txt and FormName_pas.txt) in the Delphi IDE.

Copy the contents of the _pas file to the clipboard. Position in the form’s class so the data definitions are inserted before any properties, function and methods section of the form and paste from clipboard.

DBEdit01: TDBEdit;
    DBEdit02: TDBEdit;
    DBEdit03: TDBEdit;
    DBEdit04: TDBEdit;
    DBEdit05: TDBEdit;
    DBEdit06: TDBEdit;
    DBEdit07: TDBEdit;
    DBEdit08: TDBEdit;
    DBEdit09: TDBEdit;
    DBEdit10: TDBEdit;
    DBEdit11: TDBEdit;
    DBEdit12: TDBEdit;
    DBEdit13: TDBEdit;
    DBMemo14: TDBMemo;
    Label01: TLabel;
    Label02: TLabel;
    Label03: TLabel;
    Label04: TLabel;
    Label05: TLabel;
    Label06: TLabel;
    Label07: TLabel;
    Label08: TLabel;
    Label09: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;

Now copy the contents of the _dfm to the clipboard. Navigate to the designer and view for as text. Move to the “end” statement of the scroll box. Paste the contents of the clipboard at that location.

object DBEdit01: TDBEdit
          Left = 135
          Top = 0
          Width = 241
          Height = 21
          DataField = 'cid'
          DataSource = BCSCompdm.adsei_comp
          ParentColor = True
          TabOrder = 01
        end
        object DBEdit02: TDBEdit
          Left = 135
          Top = 26
          Width = 241
          Height = 21
          DataField = 'name'
          DataSource = BCSCompdm.adsei_comp
          ParentColor = True
          TabOrder = 02
        end
        object DBEdit03: TDBEdit
          Left = 135
          Top = 52
          Width = 241
          Height = 21
          DataField = 'adr1'
          DataSource = BCSCompdm.adsei_comp
          ParentColor = True
          TabOrder = 03
        end
        object DBEdit04: TDBEdit
          Left = 135
          Top = 78
          Width = 241
          Height = 21
          DataField = 'adr2'
          DataSource = BCSCompdm.adsei_comp
          ParentColor = True
          TabOrder = 04
        end
        object DBEdit05: TDBEdit
          Left = 135
          Top = 104
          Width = 241
          Height = 21
          DataField = 'city'
          DataSource = BCSCompdm.adsei_comp
          ParentColor = True
          TabOrder = 05
        end
        object DBEdit06: TDBEdit
          Left = 135
          Top = 130
          Width = 241
          Height = 21
          DataField = 'state'
          DataSource = BCSCompdm.adsei_comp
          ParentColor = True
          TabOrder = 06
        end
        object DBEdit07: TDBEdit
          Left = 135
          Top = 156
          Width = 241
          Height = 21
          DataField = 'zip'
          DataSource = BCSCompdm.adsei_comp
          ParentColor = True
          TabOrder = 07
        end
        object DBEdit08: TDBEdit
          Left = 135
          Top = 182
          Width = 241
          Height = 21
          DataField = 'poc'
          DataSource = BCSCompdm.adsei_comp
          ParentColor = True
          TabOrder = 08
        end
        object DBEdit09: TDBEdit
          Left = 135
          Top = 208
          Width = 241
          Height = 21
          DataField = 'phone'
          DataSource = BCSCompdm.adsei_comp
          ParentColor = True
          TabOrder = 09
        end
        object DBEdit10: TDBEdit
          Left = 135
          Top = 234
          Width = 241
          Height = 21
          DataField = 'email'
          DataSource = BCSCompdm.adsei_comp
          ParentColor = True
          TabOrder = 10
        end
        object DBEdit11: TDBEdit
          Left = 135
          Top = 260
          Width = 241
          Height = 21
          DataField = 'web'
          DataSource = BCSCompdm.adsei_comp
          ParentColor = True
          TabOrder = 11
        end
        object DBEdit12: TDBEdit
          Left = 135
          Top = 286
          Width = 241
          Height = 21
          DataField = 'uid'
          DataSource = BCSCompdm.adsei_comp
          ParentColor = True
          TabOrder = 12
        end
        object DBEdit13: TDBEdit
          Left = 135
          Top = 312
          Width = 241
          Height = 21
          DataField = 'pwd'
          DataSource = BCSCompdm.adsei_comp
          ParentColor = True
          TabOrder = 13
        end
        object DBMemo14: TDBMemo
          Left = 135
          Top = 338
          Width = 241
          Height = 89
          DataField = 'addr'
          DataSource = BCSCompdm.adsei_comp
          ParentColor = True
          TabOrder = 14
        end
        object BitBtn1: TBitBtn
          Left = 152
          Top = 528
          Width = 75
          Height = 25
          Kind = bkOK
          NumGlyphs = 2
          TabOrder = 17
        end
        object BitBtn2: TBitBtn
          Left = 256
          Top = 528
          Width = 75
          Height = 25
          Kind = bkCancel
          NumGlyphs = 2
          TabOrder = 18
        end
        object Label01: TLabel
          Left = 22
          Top = 0
          Width = 107
          Height = 13
          Alignment = taRightJustify
          AutoSize = False
          Caption = 'cid :  '
        end
        object Label02: TLabel
          Left = 22
          Top = 26
          Width = 107
          Height = 13
          Alignment = taRightJustify
          AutoSize = False
          Caption = 'name :  '
        end
        object Label03: TLabel
          Left = 22
          Top = 52
          Width = 107
          Height = 13
          Alignment = taRightJustify
          AutoSize = False
          Caption = 'adr1 :  '
        end
        object Label04: TLabel
          Left = 22
          Top = 78
          Width = 107
          Height = 13
          Alignment = taRightJustify
          AutoSize = False
          Caption = 'adr2 :  '
        end
        object Label05: TLabel
          Left = 22
          Top = 104
          Width = 107
          Height = 13
          Alignment = taRightJustify
          AutoSize = False
          Caption = 'city :  '
        end
        object Label06: TLabel
          Left = 22
          Top = 130
          Width = 107
          Height = 13
          Alignment = taRightJustify
          AutoSize = False
          Caption = 'state :  '
        end
        object Label07: TLabel
          Left = 22
          Top = 156
          Width = 107
          Height = 13
          Alignment = taRightJustify
          AutoSize = False
          Caption = 'zip :  '
        end
        object Label08: TLabel
          Left = 22
          Top = 182
          Width = 107
          Height = 13
          Alignment = taRightJustify
          AutoSize = False
          Caption = 'poc :  '
        end
        object Label09: TLabel
          Left = 22
          Top = 208
          Width = 107
          Height = 13
          Alignment = taRightJustify
          AutoSize = False
          Caption = 'phone :  '
        end
        object Label10: TLabel
          Left = 22
          Top = 234
          Width = 107
          Height = 13
          Alignment = taRightJustify
          AutoSize = False
          Caption = 'email :  '
        end
        object Label11: TLabel
          Left = 22
          Top = 260
          Width = 107
          Height = 13
          Alignment = taRightJustify
          AutoSize = False
          Caption = 'web :  '
        end
        object Label12: TLabel
          Left = 22
          Top = 286
          Width = 107
          Height = 13
          Alignment = taRightJustify
          AutoSize = False
          Caption = 'uid :  '
        end
        object Label13: TLabel
          Left = 22
          Top = 312
          Width = 107
          Height = 13
          Alignment = taRightJustify
          AutoSize = False
          Caption = 'pwd :  '
        end
        object Label14: TLabel
          Left = 22
          Top = 338
          Width = 107
          Height = 13
          Alignment = taRightJustify
          AutoSize = False
          Caption = 'addr :  '
        end

View the form as a form and you will see the scroll box populated with data elements.

{*-----------------------------------------------------------------------------
 Unit Name: BCSCompU
 @Author Mr. Arch Brooks, Software Engineer, Brooks Computing Systems LLC
 @Version 1.0
 Date:      04-Jan-2014
 Purpose:
 History:
 -----------------------------------------------------------------------------}
 
unit BCSCompU;
 
interface
 
uses
  BCSXE3Utilsdp, System.Classes, System.SysUtils, System.Variants,
  BCSCompdmU, 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, Vcl.Buttons,
  Vcl.Mask;
 
type
  /// DB Grid Class Overide
  TDBGrid = class(Vcl.DBGrids.TDBGrid)
  protected
    procedure Paint; override;
  end;
 
  /// 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;
 
  /// BCSComp Primary Class
  TBCSCompC = class(TForm)
    /// BCS XE3 Utilities Component
    BCSXE3UtilsCmp1: TBCSXE3UtilsCmp;
    /// BCSComp Color Dialog
    BCSCompColor: TColorDialog;
    /// BCSComp Colors Menu Item
    BCSCompColors1: TMenuItem;
    /// BCSComp DB Navigator
    BCSCompDBNavigator1: TDBNavigator;
    /// BCSComp DB Memo
    BCSCompDBMemo1: TDBMemo;
    /// BCSComp SB Grid
    BCSCompDBGrid1: TDBGrid;
    /// BCSPageColor Main Menu
    BCSCompMainMenu1: TMainMenu;
    /// Main Page Control
    BCSCompPageControl1: TPageControl;
    /// Help Menu Item
    BCSCompHelp1: TMenuItem;
    /// Status Panel For Dialog
    BCSCompStatusPanel1: TStatusBar;
    /// Tab sheet 1 for page control
    BCSCompTabSheet1: TTabSheet;
    /// Tab sheet 2 for page control
    BCSCompTabSheet2: TTabSheet;
    /// Timer for Dialog
    BCSCompTimer1: TTimer;
    tasDataEntryForm: TTabSheet;
    ScrollBox1: TScrollBox;
    DBEdit01: TDBEdit;
    DBEdit02: TDBEdit;
    DBEdit03: TDBEdit;
    DBEdit04: TDBEdit;
    DBEdit05: TDBEdit;
    DBEdit06: TDBEdit;
    DBEdit07: TDBEdit;
    DBEdit08: TDBEdit;
    DBEdit09: TDBEdit;
    DBEdit10: TDBEdit;
    DBEdit11: TDBEdit;
    DBEdit12: TDBEdit;
    DBEdit13: TDBEdit;
    DBMemo14: TDBMemo;
    Label01: TLabel;
    Label02: TLabel;
    Label03: TLabel;
    label04: TLabel;
    Label05: TLabel;
    Label06: TLabel;
    Label07: TLabel;
    Label08: TLabel;
    Label09: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    Panel1: TPanel;
    Panel2: TPanel;
 
    procedure BCSCompColors1Click(Sender: TObject);
    procedure BCSCompCreate(Sender: TObject);
    procedure BCSCompDBGrid1TitleClick(Column: TColumn);
    procedure BCSCompDrawTab(Control: TCustomTabControl; TabIndex: Integer;
      const Rect: TRect; Active: Boolean);
    procedure BCSCompFormActivate(Sender: TObject);
    procedure BCSCompGridColor;
    procedure BCSCompHelp1Click(Sender: TObject);
    procedure BCSCompStatusBar1DrawPanel(StatusBar: TStatusBar;
      Panel: TStatusPanel; const Rect: TRect);
    procedure BCSCompTimer1Timer(Sender: TObject);
  private
    {Private declarations}
    FDColor: TColor;
  public
    {Public declarations}
    property RDColor: TColor read FDColor write FDColor;
  end;
 
var
  /// BCSComp Dialog Pointer
  BCSCompC: TBCSCompC;
 
implementation
 
{$R *.dfm}
 
var
  /// TimeStamp Variable
  ftime: String;
  /// Item Index
  i: Integer;
 
{*-----------------------------------------------------------------------------
  Procedure: Paint
  Date:      06-Jan-2014
  @Param     None
  @Return    None
 
-----------------------------------------------------------------------------}
 
procedure TDBGrid.Paint;
var
  LDrawInfo: TGridDrawInfo;
begin
  inherited Paint;
  CalcDrawInfo(LDrawInfo);
  if LDrawInfo.Horz.GridBoundary < LDrawInfo.Horz.GridExtent then
  begin
    Canvas.Brush.Color := Color;
    // use the Color property to paint the background
    Canvas.FillRect(Rect(LDrawInfo.Horz.GridBoundary, 0,
      LDrawInfo.Horz.GridExtent, LDrawInfo.Vert.GridBoundary));
  end;
  if LDrawInfo.Vert.GridBoundary < LDrawInfo.Vert.GridExtent then
  begin
    Canvas.Brush.Color := Color;
    // use the Color property to paint the background
    Canvas.FillRect(Rect(0, LDrawInfo.Vert.GridBoundary,
      LDrawInfo.Horz.GridExtent, LDrawInfo.Vert.GridExtent));
  end;
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;
 
{*-----------------------------------------------------------------------------
 Procedure: BCSCompColors1Click
 Date:      04-Jan-2014
 @Param     Sender: TObject
 @Return    None
 
 -----------------------------------------------------------------------------}
 
procedure TBCSCompC.BCSCompColors1Click(Sender: TObject);
var
  ti: Integer;
begin
  if BCSCompColor.Execute then
  begin
    Color := BCSCompColor.Color;
    RDColor := Color;
    BCSCompTabSheet1.Color := Color;
    BCSCompTabSheet2.Color := Color;
    BCSCompDBGrid1.Color := Color;
    BCSCompStatusPanel1.Color := Color;
    BCSCompGridColor;
    BCSCompDBGrid1.Repaint;
  end;
end;
 
{*-----------------------------------------------------------------------------
 Procedure: BCSCompCreate
 Date:      04-Jan-2014
 @Param     Sender: TObject
 @Return    None
 
 -----------------------------------------------------------------------------}
 
procedure TBCSCompC.BCSCompCreate(Sender: TObject);
begin
  Color := RDColor;
  BCSCompTabSheet1.Color := Color;
  BCSCompTabSheet2.Color := Color;
  BCSCompDBGrid1.Color := Color;
  BCSCompStatusPanel1.Color := Color;
  BCSCompGridColor;
  BCSCompDBGrid1.Repaint;
 
  {BCSCompTabSheet1.Color := Color;
   BCSCompTabSheet2.Color := Color;
   BCSCompStatusPanel1.Color := Color;
   BCSCompGridColor;}
end;
 
{*-----------------------------------------------------------------------------
 Procedure: BCSCompDBGrid1TitleClick
 Date:      04-Jan-2014
 @Param     Column: TColumn
 @Return    None
 
 -----------------------------------------------------------------------------}
 
procedure TBCSCompC.BCSCompDBGrid1TitleClick(Column: TColumn);
begin
  BCSCompdm.ataei_comp.IndexFieldNames := Column.FieldName;
end;
 
{*-----------------------------------------------------------------------------
 Procedure: BCSCompDrawTab
 Date:      04-Jan-2014
 @Param     Control: TCustomTabControl; TabIndex: Integer; const Rect: TRect;
 Active: Boolean
 @Return    None
 
 -----------------------------------------------------------------------------}
 
procedure TBCSCompC.BCSCompDrawTab(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:      04-Jan-2014
 @Param     Sender: TObject
 @Return    None
 
 -----------------------------------------------------------------------------}
 
procedure TBCSCompC.BCSCompFormActivate(Sender: TObject);
begin
  Color := RDColor;
  BCSCompDBGrid1.Invalidate;
  BCSCompDBGrid1.Color := Color;
  BCSCompDBGrid1.Canvas.Brush.Color := Color;
  BCSCompDBGrid1.Canvas.Refresh;
  BCSCompGridColor;
 
  BCSCompTabSheet1.Color := Color;
  BCSCompTabSheet2.Color := Color;
  BCSCompStatusPanel1.Color := Color;
  BCSCompStatusPanel1.Color := Color;
  i := 0;
  repeat
    if Self.BCSCompDBGrid1.Columns[i].Width > 150 then
    begin
      Self.BCSCompDBGrid1.Columns[i].Width := 150;
    end;
    Inc(i);
  until (i > (Self.BCSCompDBGrid1.Columns.Count - 1));
  BCSCompdm.ataei_comp.Open;
  BCSCompStatusPanel1.Panels[0].Text := 'Record Count is : ' +
    FormatFloat('#,##0', BCSCompdm.ataei_comp.RecordCount);
end;
 
{*-----------------------------------------------------------------------------
 Procedure: BCSCompGridColor
 Date:      04-Jan-2014
 @Param     None
 @Return    None
 
 -----------------------------------------------------------------------------}
 
procedure TBCSCompC.BCSCompGridColor;
begin
  // Color := RDColor;
  i := 0;
  repeat
    BCSCompDBGrid1.Columns[i].Color := Color;
    Inc(i);
  until i > BCSCompDBGrid1.Columns.Count - 1;
  // BCSCompDBGrid1.Repaint;
end;
 
{*-----------------------------------------------------------------------------
 Procedure: BCSCompHelp1Click
 Date:      04-Jan-2014
 @Param     Sender: TObject
 @Return    None
 
 -----------------------------------------------------------------------------}
 
procedure TBCSCompC.BCSCompHelp1Click(Sender: TObject);
begin
  BCSXE3UtilsCmp1.ShellExec('http://bcswebs.us/bcs002/');
end;
 
{*-----------------------------------------------------------------------------
 Procedure: BCSCompStatusBar1DrawPanel
 Date:      04-Jan-2014
 @Param     StatusBar: TStatusBar; Panel: TStatusPanel; const Rect: TRect
 @Return    None
 
 -----------------------------------------------------------------------------}
 
procedure TBCSCompC.BCSCompStatusBar1DrawPanel(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: BCSCompTimer1Timer
 Date:      04-Jan-2014
 @Param     Sender: TObject
 @Return    None
 
 -----------------------------------------------------------------------------}
 
procedure TBCSCompC.BCSCompTimer1Timer(Sender: TObject);
begin
  DateTimeToString(ftime, 'dddd, mmmm dd, yyyy hh:mm:ss     ', now);
  BCSCompStatusPanel1.Panels[2].Text := ftime;
end;
 
end.

The BCS XE3 code generator provides the basic form functionality with a data module, database navigator, database grid and memo editor. That generated code is input to this tool. Code generators are quite useful and saves countless hours of perfunctory coding tedium.

Depending in user interest I will make the source code available for this tool.

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

BCS Universal User Login

There are those time when users need to log into a particular application to gain access to it functions and corporate repositories. Each application is unique and has requirements which must be fulfilled before access can be granted.

BCSULogin

On solution is to write a login procedure for every application you write. With this approach you will spend countless hours counter productively.

A universal user login is the answer to the problem. The following lists the requirements for the data model followed by the requirements for the user interface.

BCSUniLoginCmp1.RDBName := 'jei';
  BCSUniLoginCmp1.RDBPwd := '********';
  BCSUniLoginCmp1.RDBPort := '3306';
  BCSUniLoginCmp1.RDBProvider := 'MySQL';
  BCSUniLoginCmp1.RDBServer := 'localhost';
  BCSUniLoginCmp1.RDBUserName := 'bcs';
  BCSUniLoginCmp1.RDBTableName := 'ei_comp';
BCSUniLoginCmp1.RPassword := 'pwd';
  BCSUniLoginCmp1.Rbcs := 'uid';

The data module elements are self explanatory.  The user interface properties names the fields used to locate the user in the database.

This approach makes our component flexible enough to accommodate almost any user login requirement without coding another user login procedure.

The source code for this project is at Code Central http://cc.embarcadero.com/Item/29686.

Component documentation can be viewed by clicking the following link http://archbrooks.com//compdoc/BCSUniLogin/html/BCS%20Universal%20User%20Login.htm.

From the design of the component through the documentation and fielding of the component was three hours and thirty seconds.

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

BCS SSCCE Delphi Quuestions

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.