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, 222Of 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.