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.

Leave a Reply