Changeset 448
- Timestamp:
- May 19, 2022, 10:48:39 PM (3 years ago)
- Location:
- tools/Prepare DPI
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
tools/Prepare DPI/UFormMain.lfm
r302 r448 9 9 DesignTimePPI = 144 10 10 OnActivate = FormActivate 11 LCLVersion = '2.0.12.0' 11 OnCreate = FormCreate 12 LCLVersion = '2.2.0.4' 12 13 object EditSrcDir: TEdit 13 14 Left = 159 14 Height = 4 215 Height = 43 15 16 Top = 17 16 17 Width = 497 17 18 TabOrder = 0 18 Text = ' /home/chronos/Projekty/C-evo/trunk'19 Text = '../../trunk' 19 20 end 20 21 object Label1: TLabel 21 22 Left = 17 22 Height = 2 423 Height = 26 23 24 Top = 25 24 25 Width = 91 25 26 Caption = 'Source dir:' 26 ParentColor = False27 27 end 28 28 object Label2: TLabel 29 29 Left = 16 30 Height = 2 430 Height = 26 31 31 Top = 72 32 32 Width = 130 33 33 Caption = 'Destination dir:' 34 ParentColor = False35 34 end 36 35 object EditDstDir: TEdit 37 36 Left = 159 38 Height = 4 237 Height = 43 39 38 Top = 64 40 39 Width = 496 41 40 TabOrder = 1 42 Text = ' /home/chronos/Projekty/C-evo/branches/highdpi_new'41 Text = '../../branches/highdpi_new' 43 42 end 44 43 object ButtonProcess: TButton -
tools/Prepare DPI/UFormMain.pas
r407 r448 21 21 procedure ButtonProcessClick(Sender: TObject); 22 22 procedure FormActivate(Sender: TObject); 23 procedure FormCreate(Sender: TObject); 23 24 private 24 25 Initialized: Boolean; 26 FirstCapitalLetter: Boolean; 27 UseDpi: Boolean; 25 28 procedure FormatCodePas(FileName: string); 26 29 procedure FormatCodeLfm(FileName: string); 27 30 function IsAlpha(C: Char): Boolean; 31 function IsNumeric(C: Char): Boolean; 32 function IsAlphaNumeric(C: Char): Boolean; 28 33 function ReplaceText(Text: string; FromText, ToText: string): string; 29 34 function ReplaceIdent(Text: string; FromText, ToText: string): string; … … 40 45 'ImageList', 'SpinEdit', 'PageControl', 'CheckBox', 'RadioButton', 41 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 42 55 43 56 implementation … … 87 100 end; 88 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 89 112 procedure TFormMain.FormActivate(Sender: TObject); 90 113 begin … … 92 115 Initialized := True; 93 116 end; 117 end; 118 119 procedure TFormMain.FormCreate(Sender: TObject); 120 begin 121 UseDpi := True; 122 FirstCapitalLetter := False; 94 123 end; 95 124 … … 133 162 Lines: TStringList; 134 163 I, J: Integer; 164 C: Char; 135 165 Line: string; 136 166 Differences: Integer; … … 138 168 begin 139 169 Lines := TStringList.Create; 170 Lines.LineBreak := #13#10; 140 171 try 141 172 Lines.LoadFromFile(FileName); … … 143 174 for I := 0 to Lines.Count - 1 do begin 144 175 Line := Lines[I]; 145 for J := 0 to Length(TypeNames) - 1 do 146 Line := ReplaceIdent(Line, 'T' + TypeNames[J], 'TDpi' + TypeNames[J]); 147 Line := ReplaceIdent(Line, 'Screen', 'DpiScreen'); 148 Line := ReplaceIdent(Line, 'Mouse', 'DpiMouse'); 149 Line := ReplaceIdent(Line, 'Application', 'DpiApplication'); 150 Line := StringReplace(Line, 'BitBlt(', 'DpiBitBlt(', [rfReplaceAll]); 151 Line := StringReplace(Line, 'BitBltCanvas(', 'DpiBitCanvas(', [rfReplaceAll]); 152 Line := StringReplace(Line, 'GetSystemMetrics(', 'DpiGetSystemMetrics(', [rfReplaceAll]); 153 Line := StringReplace(Line, 'CreateRectRgn(', 'DpiCreateRectRgn(', [rfReplaceAll]); 154 Line := StringReplace(Line, 'ScrollDC(', 'DpiScrollDC(', [rfReplaceAll]); 155 if Lines[I] <> Line then Inc(Differences); 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; 156 197 Lines[I] := Line; 157 198 end; … … 159 200 // Add UDpiControls to uses clause 160 201 if Differences > 0 then begin 161 UsesSection := False; 162 for I := 0 to Lines.Count - 1 do begin 163 if UsesSection then begin 164 Lines[I] := ' UDpiControls, ' + TrimLeft(Lines[I]); 165 Break; 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; 166 210 end; 167 if Lines[I] = 'uses' then UsesSection := True;168 211 end; 169 212 end; … … 207 250 function TFormMain.ReplaceIdent(Text: string; FromText, ToText: string): string; 208 251 type 209 TState = (stNone, stIdent );252 TState = (stNone, stIdent, stCommentBlock, stLineComment, stString); 210 253 var 211 254 I: Integer; … … 218 261 IdentStart := 0; 219 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 220 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 221 276 if IsAlpha(Text[I]) then begin 222 277 State := stIdent; … … 226 281 end else 227 282 if State = stIdent then begin 228 if IsAlpha (Text[I]) then begin283 if IsAlphaNumeric(Text[I]) then begin 229 284 Ident := Ident + Text[I]; 230 285 end else begin … … 233 288 end; 234 289 State := stNone; 235 end; 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; 236 300 end; 237 301 Inc(I); 238 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; 239 308 Result := Text; 240 309 end; 241 310 242 243 311 end. 244 312 -
tools/Prepare DPI/project1.lpi
r302 r448 2 2 <CONFIG> 3 3 <ProjectOptions> 4 <Version Value="1 1"/>4 <Version Value="12"/> 5 5 <General> 6 <Flags> 7 <CompatibilityMode Value="True"/> 8 </Flags> 6 9 <SessionStorage Value="InProjectDir"/> 7 <MainUnit Value="0"/>8 10 <Title Value="project1"/> 9 11 <Scaled Value="True"/> … … 24 26 <RunParams> 25 27 <FormatVersion Value="2"/> 26 <Modes Count="0"/>27 28 </RunParams> 28 29 <RequiredPackages Count="1">
Note:
See TracChangeset
for help on using the changeset viewer.