1 | unit UFormMain;
|
---|
2 |
|
---|
3 | {$mode delphi}{$H+}
|
---|
4 |
|
---|
5 | interface
|
---|
6 |
|
---|
7 | uses
|
---|
8 | Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, FileUtil;
|
---|
9 |
|
---|
10 | type
|
---|
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 |
|
---|
39 | var
|
---|
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 |
|
---|
56 | implementation
|
---|
57 |
|
---|
58 | {$R *.lfm}
|
---|
59 |
|
---|
60 | type
|
---|
61 | TFilterMethod = function (FileName: string): Boolean of object;
|
---|
62 | TFileNameMethod = procedure (FileName: string) of object;
|
---|
63 |
|
---|
64 | procedure SearchFiles(List: TStrings; Dir: string;
|
---|
65 | FilterMethod: TFilterMethod = nil; FileNameMethod: TFileNameMethod = nil);
|
---|
66 | var
|
---|
67 | SR: TSearchRec;
|
---|
68 | FullName: string;
|
---|
69 | begin
|
---|
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;
|
---|
93 | end;
|
---|
94 |
|
---|
95 | { TFormMain }
|
---|
96 |
|
---|
97 | function TFormMain.IsAlpha(C: Char): Boolean;
|
---|
98 | begin
|
---|
99 | Result := (C in ['a'..'z']) or (C in ['A'..'Z']) or (C = '_');
|
---|
100 | end;
|
---|
101 |
|
---|
102 | function TFormMain.IsNumeric(C: Char): Boolean;
|
---|
103 | begin
|
---|
104 | Result := C in ['0'..'9'];
|
---|
105 | end;
|
---|
106 |
|
---|
107 | function TFormMain.IsAlphaNumeric(C: Char): Boolean;
|
---|
108 | begin
|
---|
109 | Result := IsAlpha(C) or IsNumeric(C);
|
---|
110 | end;
|
---|
111 |
|
---|
112 | procedure TFormMain.FormActivate(Sender: TObject);
|
---|
113 | begin
|
---|
114 | if not Initialized then begin
|
---|
115 | Initialized := True;
|
---|
116 | end;
|
---|
117 | end;
|
---|
118 |
|
---|
119 | procedure TFormMain.FormCreate(Sender: TObject);
|
---|
120 | begin
|
---|
121 | UseDpi := True;
|
---|
122 | FirstCapitalLetter := False;
|
---|
123 | end;
|
---|
124 |
|
---|
125 | procedure TFormMain.ButtonProcessClick(Sender: TObject);
|
---|
126 | var
|
---|
127 | Files: TStringList;
|
---|
128 | I: Integer;
|
---|
129 | FileNameSrc: string;
|
---|
130 | FileNameDst: string;
|
---|
131 | DirSrc: string;
|
---|
132 | DirDst: string;
|
---|
133 | begin
|
---|
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;
|
---|
158 | end;
|
---|
159 |
|
---|
160 | procedure TFormMain.FormatCodePas(FileName: string);
|
---|
161 | var
|
---|
162 | Lines: TStringList;
|
---|
163 | I, J: Integer;
|
---|
164 | C: Char;
|
---|
165 | Line: string;
|
---|
166 | Differences: Integer;
|
---|
167 | UsesSection: Boolean;
|
---|
168 | begin
|
---|
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;
|
---|
217 | end;
|
---|
218 |
|
---|
219 | procedure TFormMain.FormatCodeLfm(FileName: string);
|
---|
220 | var
|
---|
221 | Lines: TStringList;
|
---|
222 | I, J: Integer;
|
---|
223 | Line: string;
|
---|
224 | begin
|
---|
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;
|
---|
238 | end;
|
---|
239 |
|
---|
240 | function TFormMain.ReplaceText(Text: string; FromText, ToText: string): string;
|
---|
241 | begin
|
---|
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]);
|
---|
248 | end;
|
---|
249 |
|
---|
250 | function TFormMain.ReplaceIdent(Text: string; FromText, ToText: string): string;
|
---|
251 | type
|
---|
252 | TState = (stNone, stIdent, stCommentBlock, stLineComment, stString);
|
---|
253 | var
|
---|
254 | I: Integer;
|
---|
255 | State: TState;
|
---|
256 | Ident: string;
|
---|
257 | IdentStart: Integer;
|
---|
258 | begin
|
---|
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;
|
---|
309 | end;
|
---|
310 |
|
---|
311 | end.
|
---|
312 |
|
---|