source: tools/Prepare DPI/UFormMain.pas

Last change on this file was 448, checked in by chronos, 4 years ago
  • Modified: Extended source processing to replace identifiers with first capital letter.
File size: 9.0 KB
Line 
1unit UFormMain;
2
3{$mode delphi}{$H+}
4
5interface
6
7uses
8 Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, FileUtil;
9
10type
11
12 { TFormMain }
13
14 TFormMain = class(TForm)
15 ButtonProcess: TButton;
16 EditSrcDir: TEdit;
17 EditDstDir: TEdit;
18 Label1: TLabel;
19 Label2: TLabel;
20 MemoLog: TMemo;
21 procedure ButtonProcessClick(Sender: TObject);
22 procedure FormActivate(Sender: TObject);
23 procedure FormCreate(Sender: TObject);
24 private
25 Initialized: Boolean;
26 FirstCapitalLetter: Boolean;
27 UseDpi: Boolean;
28 procedure FormatCodePas(FileName: string);
29 procedure FormatCodeLfm(FileName: string);
30 function IsAlpha(C: Char): Boolean;
31 function IsNumeric(C: Char): Boolean;
32 function IsAlphaNumeric(C: Char): Boolean;
33 function ReplaceText(Text: string; FromText, ToText: string): string;
34 function ReplaceIdent(Text: string; FromText, ToText: string): string;
35 public
36
37 end;
38
39var
40 FormMain: TFormMain;
41 TypeNames: array[0..30] of string = ('Bitmap', 'Form', 'Font', 'WinControl', 'ListBox',
42 'GraphicControl', 'ScrollBar', 'Canvas', 'RasterImage', 'PortableNetworkGraphic',
43 'JpegImage', 'Control', 'MenuItem', 'PopupMenu', 'ControlBorderSpacing', 'Edit',
44 'ListView', 'StringGrid', 'Panel', 'ToolBar', 'CoolBar', 'CoolBand', 'CoolBands',
45 'ImageList', 'SpinEdit', 'PageControl', 'CheckBox', 'RadioButton',
46 'Memo', 'ComboBox', 'CustomDrawGrid');
47 Idents: array[0..44] of string = ('True', 'False', 'Boolean', 'Integer', 'Inc',
48 'Dec', 'Exit', 'Break', 'Result', 'Single', 'Assert', 'Move', 'Byte', 'Word',
49 'Extended', 'PChar', 'SizeOf', 'Last', 'Pointer', 'Code', 'Test', 'Line',
50 'Pos', 'Copy', 'Offscreen', 'Brush', 'FillChar', 'ShortInt', 'Cardinal',
51 'Green', 'Red', 'Blue', 'Include', 'Canvas', 'Double', 'FillRect',
52 'Length', 'Delete', 'IntToStr', 'Min', 'Max', 'Color', 'Me', 'Supervising',
53 'Idle');
54
55
56implementation
57
58{$R *.lfm}
59
60type
61 TFilterMethod = function (FileName: string): Boolean of object;
62 TFileNameMethod = procedure (FileName: string) of object;
63
64procedure SearchFiles(List: TStrings; Dir: string;
65 FilterMethod: TFilterMethod = nil; FileNameMethod: TFileNameMethod = nil);
66var
67 SR: TSearchRec;
68 FullName: string;
69begin
70 List.BeginUpdate;
71 try
72 Dir := IncludeTrailingPathDelimiter(Dir);
73 if FindFirst(Dir + '*', faAnyFile, SR) = 0 then begin
74 try
75 repeat
76 if (SR.Name = '.') or (SR.Name = '..') then Continue;
77 FullName := Dir + SR.Name;
78 if not Assigned(FilterMethod) or (Assigned(FilterMethod) and FilterMethod(FullName)) then begin;
79 if Assigned(FileNameMethod) then
80 FileNameMethod(Dir + SR.Name);
81 List.Add(FullName);
82 end;
83 if (SR.Attr and faDirectory) <> 0 then
84 SearchFiles(List, FullName, FilterMethod, FileNameMethod);
85 until FindNext(SR) <> 0;
86 finally
87 FindClose(SR);
88 end;
89 end;
90 finally
91 List.EndUpdate;
92 end;
93end;
94
95{ TFormMain }
96
97function TFormMain.IsAlpha(C: Char): Boolean;
98begin
99 Result := (C in ['a'..'z']) or (C in ['A'..'Z']) or (C = '_');
100end;
101
102function TFormMain.IsNumeric(C: Char): Boolean;
103begin
104 Result := C in ['0'..'9'];
105end;
106
107function TFormMain.IsAlphaNumeric(C: Char): Boolean;
108begin
109 Result := IsAlpha(C) or IsNumeric(C);
110end;
111
112procedure TFormMain.FormActivate(Sender: TObject);
113begin
114 if not Initialized then begin
115 Initialized := True;
116 end;
117end;
118
119procedure TFormMain.FormCreate(Sender: TObject);
120begin
121 UseDpi := True;
122 FirstCapitalLetter := False;
123end;
124
125procedure TFormMain.ButtonProcessClick(Sender: TObject);
126var
127 Files: TStringList;
128 I: Integer;
129 FileNameSrc: string;
130 FileNameDst: string;
131 DirSrc: string;
132 DirDst: string;
133begin
134 DirSrc := EditSrcDir.Text;
135 DirDst := EditDstDir.Text;
136
137 MemoLog.Lines.BeginUpdate;
138 MemoLog.Lines.Clear;
139 Files := TStringList.Create;
140 SearchFiles(Files, DirSrc, nil, nil);
141 for I := 0 to Files.Count - 1 do begin
142 MemoLog.Lines.Add(Files[I]);
143 FileNameSrc := Files[I];
144 if DirectoryExists(FileNameSrc) then continue;
145 if FileExists(FileNameSrc) then begin
146 FileNameDst := DirDst + Copy(FileNameSrc, Length(DirSrc) + 1, MaxInt);
147 ForceDirectories(ExtractFileDir(FileNameDst));
148 CopyFile(FileNameSrc, FileNameDst);
149
150 if (ExtractFileExt(FileNameSrc) = '.pas') or (ExtractFileExt(FileNameSrc) = '.lpr') then
151 FormatCodePas(FileNameDst);
152 if ExtractFileExt(FileNameSrc) = '.lfm' then
153 FormatCodeLfm(FileNameDst);
154 end;
155 end;
156 Files.Free;
157 MemoLog.Lines.EndUpdate;
158end;
159
160procedure TFormMain.FormatCodePas(FileName: string);
161var
162 Lines: TStringList;
163 I, J: Integer;
164 C: Char;
165 Line: string;
166 Differences: Integer;
167 UsesSection: Boolean;
168begin
169 Lines := TStringList.Create;
170 Lines.LineBreak := #13#10;
171 try
172 Lines.LoadFromFile(FileName);
173 Differences := 0;
174 for I := 0 to Lines.Count - 1 do begin
175 Line := Lines[I];
176
177 if FirstCapitalLetter then begin
178 for J := 0 to Length(Idents) - 1 do
179 Line := ReplaceIdent(Line, LowerCase(Idents[J]), Idents[J]);
180 for C := 'A' to 'Z' do
181 Line := ReplaceIdent(Line, LowerCase(C), C);
182 end;
183
184 if UseDpi then begin
185 for J := 0 to Length(TypeNames) - 1 do
186 Line := ReplaceIdent(Line, 'T' + TypeNames[J], 'TDpi' + TypeNames[J]);
187 Line := ReplaceIdent(Line, 'Screen', 'DpiScreen');
188 Line := ReplaceIdent(Line, 'Mouse', 'DpiMouse');
189 Line := ReplaceIdent(Line, 'Application', 'DpiApplication');
190 Line := StringReplace(Line, 'BitBlt(', 'DpiBitBlt(', [rfReplaceAll]);
191 Line := StringReplace(Line, 'BitBltCanvas(', 'DpiBitCanvas(', [rfReplaceAll]);
192 Line := StringReplace(Line, 'GetSystemMetrics(', 'DpiGetSystemMetrics(', [rfReplaceAll]);
193 Line := StringReplace(Line, 'CreateRectRgn(', 'DpiCreateRectRgn(', [rfReplaceAll]);
194 Line := StringReplace(Line, 'ScrollDC(', 'DpiScrollDC(', [rfReplaceAll]);
195 if Lines[I] <> Line then Inc(Differences);
196 end;
197 Lines[I] := Line;
198 end;
199
200 // Add UDpiControls to uses clause
201 if Differences > 0 then begin
202 if UseDpi then begin
203 UsesSection := False;
204 for I := 0 to Lines.Count - 1 do begin
205 if UsesSection then begin
206 Lines[I] := ' UDpiControls, ' + TrimLeft(Lines[I]);
207 Break;
208 end;
209 if Lines[I] = 'uses' then UsesSection := True;
210 end;
211 end;
212 end;
213 Lines.SaveToFile(FileName);
214 finally
215 Lines.Free;
216 end;
217end;
218
219procedure TFormMain.FormatCodeLfm(FileName: string);
220var
221 Lines: TStringList;
222 I, J: Integer;
223 Line: string;
224begin
225 Lines := TStringList.Create;
226 try
227 Lines.LoadFromFile(FileName);
228 for I := 0 to Lines.Count - 1 do begin
229 Line := Lines[I];
230 for J := 0 to Length(TypeNames) - 1 do
231 Line := StringReplace(Line, ': T' + TypeNames[J], ': TDpi' + TypeNames[J], [rfReplaceAll]);
232 Lines[I] := Line;
233 end;
234 Lines.SaveToFile(FileName);
235 finally
236 Lines.Free;
237 end;
238end;
239
240function TFormMain.ReplaceText(Text: string; FromText, ToText: string): string;
241begin
242 Result := StringReplace(Text, FromText + '.', ToText + '.', [rfReplaceAll]);
243 Result := StringReplace(Result, FromText + ';', ToText + ';', [rfReplaceAll]);
244 Result := StringReplace(Result, FromText + ')', ToText + ')', [rfReplaceAll]);
245 Result := StringReplace(Result, FromText + ',', ToText + ',', [rfReplaceAll]);
246 Result := StringReplace(Result, FromText + ' ', ToText + ' ', [rfReplaceAll]);
247 Result := StringReplace(Result, '(' + FromText + ')', '(' + ToText + ')', [rfReplaceAll]);
248end;
249
250function TFormMain.ReplaceIdent(Text: string; FromText, ToText: string): string;
251type
252 TState = (stNone, stIdent, stCommentBlock, stLineComment, stString);
253var
254 I: Integer;
255 State: TState;
256 Ident: string;
257 IdentStart: Integer;
258begin
259 I := 1;
260 State := stNone;
261 IdentStart := 0;
262 while I <= Length(Text) do begin
263 // Do not update line comment area
264 if (I < Length(Text)) and (Copy(Text, I, 2) = '//') then begin
265 State := stLineComment;
266 Break;
267 end;
268
269 if State = stNone then begin
270 if Text[I] = '{' then begin
271 State := stCommentBlock;
272 end else
273 if Text[I] = '''' then begin
274 State := stString;
275 end else
276 if IsAlpha(Text[I]) then begin
277 State := stIdent;
278 Ident := Text[I];
279 IdentStart := I;
280 end;
281 end else
282 if State = stIdent then begin
283 if IsAlphaNumeric(Text[I]) then begin
284 Ident := Ident + Text[I];
285 end else begin
286 if Ident = FromText then begin
287 Text := Copy(Text, 1, IdentStart - 1) + ToText + Copy(Text, I, MaxInt);
288 end;
289 State := stNone;
290 Continue;
291 end;
292 end else
293 if State = stString then begin
294 if Text[I] = '''' then begin
295 State := stNone;
296 end;
297 end else
298 if State = stCommentBlock then begin
299 if Text[I] = '}' then State := stNone;
300 end;
301 Inc(I);
302 end;
303
304 // Replace last ident terminated by line ending
305 if (State = stIdent) and (Ident = FromText) then begin
306 Text := Copy(Text, 1, IdentStart - 1) + ToText + Copy(Text, I, MaxInt);
307 end;
308 Result := Text;
309end;
310
311end.
312
Note: See TracBrowser for help on using the repository browser.