source: trunk/LocalPlayer/KeyBindings.pas

Last change on this file was 468, checked in by chronos, 5 months ago
  • Added: High DPI support integrated into trunk branch. It can be enabled by adding DPI define to compiler parameters for main project and packages.
File size: 12.8 KB
Line 
1unit KeyBindings;
2
3interface
4
5uses
6 Classes, SysUtils, Generics.Collections, Generics.Defaults, LCLProc, LCLType,
7 Registry,
8 {$IFDEF DPI}Dpi.Menus{$ELSE}Menus{$ENDIF};
9
10type
11
12 { TKeyBinding }
13
14 TKeyBinding = class
15 ShortName: string;
16 FullName: string;
17 ShortCut: TShortCut;
18 ShortCut2: TShortCut;
19 DefaultShortCut: TShortCut;
20 DefaultShortCut2: TShortCut;
21 function Test(AShortCut: TShortCut): Boolean;
22 procedure Assign(Source: TKeyBinding);
23 procedure SetDefault;
24 end;
25
26 { TKeyBindings }
27
28 TKeyBindings = class(TObjectList<TKeyBinding>)
29 private
30 public
31 function AddItem(const ShortName, FullName: string; ShortCut: TShortCut; ShortCut2: TShortCut = 0): TKeyBinding; overload;
32 function AddItem(const ShortName, FullName: string; ShortCutText: string; ShortCutText2: string = ''): TKeyBinding; overload;
33 function Search(ShortName: string): TKeyBinding;
34 procedure LoadFromRegistry(RootKey: HKEY; Key: string);
35 procedure SaveToRegistry(RootKey: HKEY; Key: string);
36 procedure LoadToStrings(Strings: TStrings);
37 procedure Assign(Source: TKeyBindings);
38 procedure ResetToDefault;
39 procedure RemoveShortCut(ShortCut: TShortCut);
40 procedure SortAlpha;
41 end;
42
43var
44 KeyBindings: TKeyBindings;
45 BEndTurn: TKeyBinding;
46 BHelp: TKeyBinding;
47 BUnitStat: TKeyBinding;
48 BCityStat: TKeyBinding;
49 BScienceStat: TKeyBinding;
50 BEUnitStat: TKeyBinding;
51 BDiagram: TKeyBinding;
52 BWonders: TKeyBinding;
53 BShips: TKeyBinding;
54 BNations: TKeyBinding;
55 BEmpire: TKeyBinding;
56 BFullScreen: TKeyBinding;
57 BResign: TKeyBinding;
58 BRandomMap: TKeyBinding;
59 BDisbandUnit: TKeyBinding;
60 BFortify: TKeyBinding;
61 BCenterUnit: TKeyBinding;
62 BStay: TKeyBinding;
63 BNoOrders: TKeyBinding;
64 BPrevUnit: TKeyBinding;
65 BNextUnit: TKeyBinding;
66 BCancel: TKeyBinding;
67 BPillage: TKeyBinding;
68 BSelectTransport: TKeyBinding;
69 BTechTree: TKeyBinding;
70 BWait: TKeyBinding;
71 BJump: TKeyBinding;
72 BMapBtn0: TKeyBinding;
73 BMapBtn1: TKeyBinding;
74 BMapBtn4: TKeyBinding;
75 BMapBtn5: TKeyBinding;
76 BMapBtn6: TKeyBinding;
77 BSetDebugMap0: TKeyBinding;
78 BSetDebugMap1: TKeyBinding;
79 BSetDebugMap2: TKeyBinding;
80 BSetDebugMap3: TKeyBinding;
81 BSetDebugMap4: TKeyBinding;
82 BSetDebugMap5: TKeyBinding;
83 BSetDebugMap6: TKeyBinding;
84 BSetDebugMap7: TKeyBinding;
85 BSetDebugMap8: TKeyBinding;
86 BSetDebugMap9: TKeyBinding;
87 BDebugMap: TKeyBinding;
88 BLocCodes: TKeyBinding;
89 BLogDlg: TKeyBinding;
90 BNames: TKeyBinding;
91 BRun: TKeyBinding;
92 BTestMapRepaint: TKeyBinding;
93 BSetViewpoint0: TKeyBinding;
94 BSetViewpoint1: TKeyBinding;
95 BSetViewpoint2: TKeyBinding;
96 BSetViewpoint3: TKeyBinding;
97 BSetViewpoint4: TKeyBinding;
98 BSetViewpoint5: TKeyBinding;
99 BSetViewpoint6: TKeyBinding;
100 BSetViewpoint7: TKeyBinding;
101 BSetViewpoint8: TKeyBinding;
102 BSetViewpoint9: TKeyBinding;
103 BAirBase: TKeyBinding;
104 BBuildCity: TKeyBinding;
105 BEnhance: TKeyBinding;
106 BGoOn: TKeyBinding;
107 BHome: TKeyBinding;
108 BFarmClearIrrigation: TKeyBinding;
109 BLoad: TKeyBinding;
110 BAfforestMine: TKeyBinding;
111 BCanal: TKeyBinding;
112 BTrans: TKeyBinding;
113 BPollution: TKeyBinding;
114 BRailRoad: TKeyBinding;
115 BUnload: TKeyBinding;
116 BRecover: TKeyBinding;
117 BUtilize: TKeyBinding;
118 BMoveLeftDown: TKeyBinding;
119 BMoveDown: TKeyBinding;
120 BMoveRightDown: TKeyBinding;
121 BMoveRight: TKeyBinding;
122 BMoveRightUp: TKeyBinding;
123 BMoveUp: TKeyBinding;
124 BMoveLeftUp: TKeyBinding;
125 BMoveLeft: TKeyBinding;
126
127
128implementation
129
130{ TKeyBinding }
131
132function TKeyBinding.Test(AShortCut: TShortCut): Boolean;
133begin
134 Result := (AShortCut = ShortCut) or (AShortCut = ShortCut2);
135end;
136
137procedure TKeyBinding.Assign(Source: TKeyBinding);
138begin
139 ShortName := Source.ShortName;
140 FullName := Source.FullName;
141 ShortCut := Source.ShortCut;
142 ShortCut2 := Source.ShortCut2;
143 DefaultShortCut := Source.DefaultShortCut;
144 DefaultShortCut2 := Source.DefaultShortCut2;
145end;
146
147procedure TKeyBinding.SetDefault;
148begin
149 ShortCut := DefaultShortCut;
150 ShortCut2 := DefaultShortCut2;
151end;
152
153{ TKeyBindings }
154
155function TKeyBindings.AddItem(const ShortName, FullName: string; ShortCut: TShortCut;
156 ShortCut2: TShortCut = 0): TKeyBinding;
157begin
158 Result := TKeyBinding.Create;
159 Result.ShortName := ShortName;
160 Result.FullName := FullName;
161 Result.ShortCut := ShortCut;
162 Result.ShortCut2 := ShortCut2;
163 Result.DefaultShortCut := ShortCut;
164 Result.DefaultShortCut2 := ShortCut2;
165 Add(Result);
166end;
167
168function TKeyBindings.AddItem(const ShortName, FullName: string;
169 ShortCutText: string; ShortCutText2: string = ''): TKeyBinding;
170begin
171 Result := AddItem(ShortName, FullName, TextToShortCut(ShortCutText),
172 TextToShortCut(ShortCutText2));
173end;
174
175function TKeyBindings.Search(ShortName: string): TKeyBinding;
176var
177 I: Integer;
178begin
179 I := 0;
180 while (I < Count) and (Items[I].ShortName <> ShortName) do Inc(I);
181 if I < Count then Result := Items[I]
182 else Result := nil;
183end;
184
185procedure TKeyBindings.LoadFromRegistry(RootKey: HKEY; Key: string);
186var
187 I: Integer;
188 Registry: TRegistry;
189 Text: string;
190begin
191 Registry := TRegistry.Create;
192 Registry.RootKey := RootKey;
193 with Registry do
194 try
195 OpenKey(Key, True);
196 for I := 0 to Count - 1 do begin
197 Text := '';
198 if ValueExists(Items[I].ShortName) then begin
199 Text := ReadString(Items[I].ShortName);
200 if Pos(',', Text) > 0 then begin
201 Items[I].ShortCut2 := TextToShortCut(Copy(Text, Pos(',', Text) + 1, MaxInt));
202 Items[I].ShortCut := TextToShortCut(Copy(Text, 1, Pos(',', Text) - 1));
203 end else begin
204 Items[I].ShortCut := TextToShortCut(Text);
205 Items[I].ShortCut2 := 0;
206 end;
207 end else begin
208 Text := ShortCutToText(Items[I].ShortCut);
209 if Items[I].ShortCut2 <> 0 then Text := Text + ',' + ShortCutToText(Items[I].ShortCut2);
210 WriteString(Items[I].ShortName, Text);
211 end;
212 end;
213 finally
214 Free;
215 end;
216end;
217
218procedure TKeyBindings.SaveToRegistry(RootKey: HKEY; Key: string);
219var
220 I: Integer;
221 Registry: TRegistry;
222 Text: string;
223begin
224 Registry := TRegistry.Create;
225 Registry.RootKey := RootKey;
226 with Registry do
227 try
228 OpenKey(Key, True);
229 for I := 0 to Count - 1 do begin
230 Text := ShortCutToText(Items[I].ShortCut);
231 if Items[I].ShortCut2 <> 0 then Text := Text + ',' + ShortCutToText(Items[I].ShortCut2);
232 WriteString(Items[I].ShortName, Text);
233 end;
234 finally
235 Free;
236 end;
237end;
238
239procedure TKeyBindings.LoadToStrings(Strings: TStrings);
240var
241 I: Integer;
242 Text: string;
243begin
244 Strings.BeginUpdate;
245 try
246 Strings.Clear;
247 for I := 0 to Count - 1 do begin
248 Text := '';
249 if Items[I].ShortCut <> 0 then
250 Text := Text + ShortCutToText(Items[I].ShortCut);
251 if Items[I].ShortCut2 <> 0 then begin
252 if Text <> '' then Text := Text + ', ';
253 Text := Text + ShortCutToText(Items[I].ShortCut2);
254 end;
255 if Text <> '' then Text := Items[I].FullName + ' (' + Text + ')'
256 else Text := Items[I].FullName;
257 Strings.Add(Text);
258 end;
259 finally
260 Strings.EndUpdate;
261 end;
262end;
263
264procedure TKeyBindings.Assign(Source: TKeyBindings);
265var
266 I: Integer;
267begin
268 while Count < Source.Count do
269 Add(TKeyBinding.Create);
270 while Count > Source.Count do
271 Delete(Count - 1);
272 for I := 0 to Count - 1 do
273 Items[I].Assign(Source.Items[I]);
274end;
275
276procedure TKeyBindings.ResetToDefault;
277var
278 I: Integer;
279begin
280 for I := 0 to Count - 1 do
281 Items[I].SetDefault;
282end;
283
284procedure TKeyBindings.RemoveShortCut(ShortCut: TShortCut);
285var
286 I: Integer;
287begin
288 for I := 0 to Count - 1 do begin
289 if Items[I].ShortCut = ShortCut then Items[I].ShortCut := 0;
290 if Items[I].ShortCut2 = ShortCut then Items[I].ShortCut2 := 0;
291 end;
292end;
293
294function CompareAlpha(constref Item1, Item2: TKeyBinding): Integer;
295begin
296 Result := CompareStr(Item1.FullName, Item2.FullName);
297end;
298
299procedure TKeyBindings.SortAlpha;
300begin
301 Sort(TComparer<TKeyBinding>.Construct(CompareAlpha));
302end;
303
304
305initialization
306
307KeyBindings := TKeyBindings.Create;
308with KeyBindings do begin
309 BEndTurn := AddItem('EndTurn', 'End turn', 'NumPlus');
310 BHelp := AddItem('Help', 'Help', 'F1');
311 BUnitStat := AddItem('UnitStat', 'Unit stat', 'F2');
312 BCityStat := AddItem('CityStat', 'City stat', 'F3');
313 BScienceStat := AddItem('ScienceStat', 'Science research', 'F4');
314 BEUnitStat := AddItem('EnemyUnitStat', 'Enemy unit stat', 'F5');
315 BDiagram := AddItem('Diagram', 'Charts', 'F6');
316 BWonders := AddItem('Wonders', 'World wonders', 'F7');
317 BShips := AddItem('Ships', 'Colonization ships', 'F8');
318 BNations := AddItem('Nations', 'Nations', 'F9');
319 BEmpire := AddItem('Empire', 'Empire', 'F10');
320 BFullScreen := AddItem('FullScreen', 'Full screen', 'F11');
321 BResign := AddItem('Resign', 'Resign', 'Ctrl+Q');
322 BRandomMap := AddItem('RandomMap', 'Random map', 'Ctrl+R');
323 BDisbandUnit := AddItem('DisbandUnit', 'Disband unit', 'Ctrl+D');
324 BFortify := AddItem('Fortify', 'Fortify', 'F');
325 BCenterUnit := AddItem('CenterUnit', 'Center', 'C');
326 BStay := AddItem('Stay', 'Stay', 'S');
327 BNoOrders := AddItem('NoOrders', 'No orders', 'Space');
328 BPrevUnit := AddItem('PrevUnit', 'Previous unit', 'Del');
329 BNextUnit := AddItem('NextUnit', 'Next unit', 'Ins');
330 BCancel := AddItem('Cancel', 'Cancel', 'Ctrl+C');
331 BPillage := AddItem('Pillage', 'Pillage', 'Ctrl+P');
332 BSelectTransport := AddItem('SelectTransport', 'Select transport', 'Ctrl+T');
333 BTechTree := AddItem('TechTree', 'Tech tree', 'T');
334 BWait := AddItem('Wait', 'Wait', 'W');
335 BJump := AddItem('Jump', 'Jump 20 turns', 'Ctrl+J');
336 BMapBtn0 := AddItem('MapButton1', 'Map button 1', '1');
337 BMapBtn1 := AddItem('MapButton2', 'Map button 2', '2');
338 BMapBtn4 := AddItem('MapButton3', 'Map button 3', '3');
339 BMapBtn5 := AddItem('MapButton4', 'Map button 4', '4');
340 BMapBtn6 := AddItem('MapButton5', 'Map button 5', '5');
341 BSetDebugMap0 := AddItem('SetDebugMap0', 'Set debug map 0', '0');
342 BSetDebugMap1 := AddItem('SetDebugMap1', 'Set debug map 1', '1');
343 BSetDebugMap2 := AddItem('SetDebugMap2', 'Set debug map 2', '2');
344 BSetDebugMap3 := AddItem('SetDebugMap3', 'Set debug map 3', '3');
345 BSetDebugMap4 := AddItem('SetDebugMap4', 'Set debug map 4', '4');
346 BSetDebugMap5 := AddItem('SetDebugMap5', 'Set debug map 5', '5');
347 BSetDebugMap6 := AddItem('SetDebugMap6', 'Set debug map 6', '6');
348 BSetDebugMap7 := AddItem('SetDebugMap7', 'Set debug map 7', '7');
349 BSetDebugMap8 := AddItem('SetDebugMap8', 'Set debug map 8', '8');
350 BSetDebugMap9 := AddItem('SetDebugMap9', 'Set debug map 9', '9');
351 BDebugMap := AddItem('DebugMap', 'Debug map', 'Ctrl+K');
352 BLocCodes := AddItem('LocCodes', 'Location codes', 'Ctrl+L');
353 BLogDlg := AddItem('LogDlg', 'Log dialog', 'Ctrl+M');
354 BNames := AddItem('ShowNames', 'Show names', 'Ctrl+N');
355 BRun := AddItem('Run', 'Run', 'Ctrl+R');
356 BTestMapRepaint := AddItem('TestMapRepaint', 'Test map reapaint', 'Ctrl+Space');
357 BSetViewpoint0 := AddItem('SetViewpoint0', 'Set viewpoint 0', 'Ctrl+0');
358 BSetViewpoint1 := AddItem('SetViewpoint1', 'Set viewpoint 1', 'Ctrl+1');
359 BSetViewpoint2 := AddItem('SetViewpoint2', 'Set viewpoint 2', 'Ctrl+2');
360 BSetViewpoint3 := AddItem('SetViewpoint3', 'Set viewpoint 3', 'Ctrl+3');
361 BSetViewpoint4 := AddItem('SetViewpoint4', 'Set viewpoint', 'Ctrl+4');
362 BSetViewpoint5 := AddItem('SetViewpoint0', 'Set viewpoint', 'Ctrl+5');
363 BSetViewpoint6 := AddItem('SetViewpoint1', 'Set viewpoint', 'Ctrl+6');
364 BSetViewpoint7 := AddItem('SetViewpoint2', 'Set viewpoint', 'Ctrl+7');
365 BSetViewpoint8 := AddItem('SetViewpoint3', 'Set viewpoint', 'Ctrl+8');
366 BSetViewpoint9 := AddItem('SetViewpoint4', 'Set viewpoint', 'Ctrl+9');
367 BAirBase := AddItem('AirBase', 'Air base', 'A');
368 BBuildCity := AddItem('BuildCity', 'Build city', 'B');
369 BEnhance := AddItem('Enhance', 'Enhance', 'E');
370 BGoOn := AddItem('GoOn', 'Go on', 'G');
371 BHome := AddItem('Home', 'Home', 'H');
372 BFarmClearIrrigation := AddItem('FarmClearIrrigation', 'Farm/Clear/Irrigation', 'I');
373 BLoad := AddItem('Load', 'Load', 'L');
374 BAfforestMine := AddItem('AfforestMine', 'Afforest/Mine', 'M');
375 BCanal := AddItem('Canal', 'Canal', 'N');
376 BTrans := AddItem('Trans', 'Trans', 'O');
377 BPollution := AddItem('Pollution', 'Pollution', 'P');
378 BRailRoad := AddItem('RailRoad', 'Rails/Road', 'R');
379 BUnload := AddItem('Unload', 'Unload', 'U');
380 BRecover := AddItem('Recover', 'Recover', 'V');
381 BUtilize := AddItem('Utilize', 'Utilize', 'Z');
382 BMoveLeftDown := AddItem('MoveLeftDown', 'Move unit left-down', 'Num1', 'End');
383 BMoveDown := AddItem('MoveDown', 'Move unit down', 'Num2', 'Down');
384 BMoveRightDown := AddItem('MoveRightDown', 'Move unit right-down', 'Num3', 'PgDn');
385 BMoveRight := AddItem('MoveRight', 'Move unit right', 'Num6', 'Right');
386 BMoveRightUp := AddItem('MoveRightUp', 'Move unit right-up', 'Num9', 'PgUp');
387 BMoveUp := AddItem('MoveUp', 'Move unit up', 'Num8', 'Up');
388 BMoveLeftUp := AddItem('MoveLeftUp', 'Move unit left-up', 'Num7', 'Home');
389 BMoveLeft := AddItem('MoveLeft', 'Move unit left', 'Num4', 'Left');
390 SortAlpha;
391end;
392
393
394finalization
395
396FreeAndNil(KeyBindings);
397
398end.
399
400
Note: See TracBrowser for help on using the repository browser.