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