4 \83{
\83g
\83\8b\83X
\83N
\83\8a\83v
\83g
\92è
\8c^
\8bå
\82ð
\95Û
\8e\9d\81E
\8f\88\97\9d\82·
\82é
\81B
9 uses Windows, Classes, SysUtils, Contnrs, Menus, Dialogs;
12 EScriptConstFileError = class(Exception);
14 TScriptConst = class(TPersistent) //
\8cÂ
\95Ê
\82Ì
\92è
\8c^
\8bå
20 procedure SetCaption(const Value: String);
21 procedure SetConstText(const Value: String);
22 procedure SetShortCut(const Value: TShortCut);
25 property Caption: String read FCaption write SetCaption;
26 property ShortCut: TShortCut read FShortCut write SetShortCut;
27 property ConstText: String read FConstText write SetConstText;
28 property ID: integer read FID;
29 function ToString: String; //
\95¶
\8e\9a\97ñ
\95\
\8c»
\82É
\95Ï
\8a·
30 procedure FromString(const Str: String); //
\93Ç
\82Ý
\8fo
\82µ
31 procedure Assign(Source: TPersistent); override;
34 TScriptConstMenu = class(TObject) //
\91·
\81BTScriptConst
\82Ì
\83\8a\83X
\83g
\81B
40 function GetCount: integer;
41 function GetConsts(Index: integer): TScriptConst;
42 procedure SetCaption(const Value: String);
43 procedure SetIfGhost(const Value: String);
46 destructor Destroy; override;
47 property ID: integer read FID;
48 property Count: integer read GetCount;
49 property Consts[Index: integer]: TScriptConst read GetConsts; default;
50 property List: TObjectList read FConsts;
51 property Caption: String read FCaption write SetCaption;
52 property IfGhost: String read FIfGhost write SetIfGhost;
53 procedure Load(Lines: TStrings);
54 procedure Save(Lines: TStrings);
55 procedure Delete(const ID: integer);
56 function GetConstByID(const ID: integer): TScriptConst;
57 function AddConst: TScriptConst;
60 TScriptConstFile = class(TObject) //
\8eq
\81BTScriptConstMenu
\82Ì
\83\8a\83X
\83g
\81B
64 function GetMenus(Index: integer): TScriptConstMenu;
65 function GetCount: integer;
66 procedure SetFileName(const Value: String);
69 destructor Destroy; override;
70 property FileName: String read FFileName write SetFileName;
71 property Count: integer read GetCount;
72 property Menus[Index: integer]: TScriptConstMenu read GetMenus; default;
73 property List: TObjectList read FMenus;
74 procedure LoadFromFile(LoadFileName: String);
76 procedure Delete(const ID: integer);
77 procedure MoveUp(const ID: integer);
78 procedure MoveDown(const ID: integer);
79 function GetConstByID(const ID: integer): TScriptConst;
80 function GetMenuByID(const ID: integer): TScriptConstMenu;
81 function AddMenu: TScriptConstMenu;
84 TScriptConstList = class(TObject) //
\90e
\81BScriptConstFile
\82Ì
\83\8a\83X
\83g
\81B
87 function GetCount: integer;
88 function GetFiles(Index: integer): TScriptConstFile;
91 destructor Destroy; override;
92 procedure LoadFromDir(const Dir: String);
94 property Files[Index: integer]: TScriptConstFile read GetFiles; default;
95 property Count: integer read GetCount;
96 property List: TObjectList read FFiles;
97 function GetConstByID(const ID: integer): TScriptConst;
98 function GetMenuByID(const ID: integer): TScriptConstMenu;
99 procedure Delete(const ID: integer);
103 ScriptConstList: TScriptConstList;
107 var OldID: integer; //
\92è
\8c^
\8bå
\82Ì
\93à
\95\94ID
\81BTag
\82É
\93ü
\82ê
\82é
\97p
110 //
\92P
\8f\83\82É
\83o
\83C
\83g
\92P
\88Ê
\82Å
\95¶
\8e\9a\97ñ
\82ð
\8c©
\82Ä
\82¢
\82«
\95ª
\89ð
\82·
\82é
\83\86\81[
\83e
\83B
\83\8a\83e
\83B
\8aÖ
\90\94
111 function Token(const Str: String; const Delimiter: char;
112 const Index: integer): String;
113 var i, c, len: integer;
119 while i <= len do begin
120 if (Str[i] = Delimiter) and (StrByteType(PChar(Str), i) <> mbTrailByte) then begin
122 if c > Index then Break;
123 end else if c = Index then Result := Result + Str[i];
130 constructor TScriptConstList.Create;
132 FFiles := TObjectList.Create(true);
135 procedure TScriptConstList.Delete(const ID: integer);
138 for i := Count-1 downto 0 do begin
143 destructor TScriptConstList.Destroy;
149 function TScriptConstList.GetConstByID(const ID: integer): TScriptConst;
153 for i := 0 to Count-1 do begin
154 Result := Files[i].GetConstByID(ID);
155 if Result <> nil then Exit;
159 function TScriptConstList.GetCount: integer;
161 Result := FFiles.Count;
164 function TScriptConstList.GetFiles(Index: integer): TScriptConstFile;
166 Result := FFiles[Index] as TScriptConstFile;
169 function TScriptConstList.GetMenuByID(const ID: integer): TScriptConstMenu;
173 for i := 0 to Count-1 do begin
174 Result := Files[i].GetMenuByID(ID);
175 if Result <> nil then Exit;
179 procedure TScriptConstList.LoadFromDir(const Dir: String);
182 AFile: TScriptConstFile;
185 i := FindFirst(Dir + '\*.txt', 0, F);
190 AFile := TScriptConstFile.Create;
191 AFile.LoadFromFile(Dir + '\' + F.Name);
202 procedure TScriptConstList.Save;
205 for i := 0 to FFiles.Count-1 do begin
212 procedure TScriptConst.Assign(Source: TPersistent);
215 if not (Source is TScriptConst) then Exit;
216 with (Source as TScriptConst) do begin
217 self.Caption := Caption;
218 self.ShortCut := ShortCut;
219 self.ConstText := ConstText;
223 constructor TScriptConst.Create;
225 //
\92è
\8c^
\8bå
\82ÌID
\82ð
\90¶
\90¬
\82·
\82é
226 // TMenuItem
\82ÌTag
\82É
\93ü
\82ê
\82é
\82±
\82Æ
\82Å
\83\81\83j
\83\85\81[
\8d\80\96Ú
\82ª
\8e©
\95ª
\82É
\91Î
\89\9e\82·
\82éTScriptConst
\82ð
227 //
\92m
\82é
\82±
\82Æ
\82ª
\82Å
\82«
\82é
232 procedure TScriptConst.FromString(const Str: String);
235 raise EScriptConstFileError.Create('
\92è
\8c^
\8bå
\83t
\83@
\83C
\83\8b\82ð
\89ð
\90Í
\82Å
\82«
\82Ü
\82¹
\82ñ: ' + Str);
236 ShortCut := TextToShortCut(Token(Str, #9, 1));
237 Caption := Token(Str, #9, 2);
238 ConstText := Token(Str, #9, 3);
239 if (Length(Caption) = 0) or (Length(ConstText) = 0) then
240 raise EScriptConstFileError.Create('
\92è
\8c^
\8bå
\83t
\83@
\83C
\83\8b\82ð
\89ð
\90Í
\82Å
\82«
\82Ü
\82¹
\82ñ: ' + Str);
243 procedure TScriptConst.SetCaption(const Value: String);
248 procedure TScriptConst.SetConstText(const Value: String);
253 procedure TScriptConst.SetShortCut(const Value: TShortCut);
258 function TScriptConst.ToString: String;
260 Result := #9 + ShortCutToText(ShortCut) + #9 + Caption + #9 + ConstText;
265 function TScriptConstFile.AddMenu: TScriptConstMenu;
267 Result := TScriptConstMenu.Create;
268 Result.Caption := '
\90V
\82µ
\82¢
\83O
\83\8b\81[
\83v';
269 Result.IfGhost := '';
273 constructor TScriptConstFile.Create;
275 FMenus := TObjectList.Create(true);
278 procedure TScriptConstFile.Delete(const ID: integer);
281 for i := FMenus.Count-1 downto 0 do begin
282 Menus[i].Delete(ID); // Item
\82ð
\8dí
\8f\9c(
\82µ
\82æ
\82¤
\82Æ
\82·
\82é)
283 if Menus[i].ID = ID then begin
284 FMenus.Delete(i); // Menu
\82ð
\8dí
\8f\9c
290 destructor TScriptConstFile.Destroy;
296 function TScriptConstFile.GetConstByID(const ID: integer): TScriptConst;
300 for i := 0 to Count-1 do begin
301 Result := Menus[i].GetConstByID(ID);
302 if Result <> nil then Exit;
306 function TScriptConstFile.GetCount: integer;
308 Result := FMenus.Count;
311 function TScriptConstFile.GetMenuByID(const ID: integer): TScriptConstMenu;
315 for i := 0 to Count-1 do
316 if Menus[i].ID = ID then begin
322 function TScriptConstFile.GetMenus(Index: integer): TScriptConstMenu;
324 Result := FMenus[Index] as TScriptConstMenu;
327 procedure TScriptConstFile.LoadFromFile(LoadFileName: String);
328 var Lines: TStringList;
329 Menu: TScriptConstMenu;
334 Lines := TStringList.Create;
335 Lines.LoadFromFile(LoadFileName);
336 while Lines.Count > 0 do begin
337 Menu := TScriptConstMenu.Create;
344 FileName := LoadFileName; //
\83t
\83@
\83C
\83\8b\96¼
\82Í
\95Û
\91¶
\82µ
\82Ä
\82¨
\82
347 procedure TScriptConstFile.MoveDown(const ID: integer);
351 for i := Count-1 downto 0 do begin
352 if Menus[i].ID = ID then begin
353 if i < Count-1 then FMenus.Move(i, i+1);
356 for j := Menus[i].Count-1 downto 0 do begin
357 if Menus[i][j].ID = ID then begin
358 if j < Menus[i].Count-1 then
359 Menus[i].List.Move(j, j+1) //
\95\81\92Ê
\82É
\83\81\83j
\83\85\81[
\93à
\82Å
\88Ú
\93®
360 else if i < Count-1 then begin //
\83\81\83j
\83\85\81[
\82ð
\92´
\82¦
\82Ä
\88Ú
\93®
361 ConstData := Menus[i][j];
362 Menus[i].List.Extract(ConstData);
363 Menus[i+1].List.Insert(0, ConstData);
371 procedure TScriptConstFile.MoveUp(const ID: integer);
375 for i := 0 to Count-1 do begin
376 if Menus[i].ID = ID then begin
377 if i > 0 then FMenus.Move(i, i-1);
380 for j := 0 to Menus[i].Count-1 do begin
381 if Menus[i][j].ID = ID then begin
383 Menus[i].List.Move(j, j-1) //
\95\81\92Ê
\82É
\83\81\83j
\83\85\81[
\93à
\82Å
\88Ú
\93®
384 else if i > 0 then begin //
\83\81\83j
\83\85\81[
\82ð
\92´
\82¦
\82Ä
\88Ú
\93®
385 ConstData := Menus[i][j];
386 Menus[i].List.Extract(ConstData);
387 Menus[i-1].List.Add(ConstData);
395 procedure TScriptConstFile.SaveToFile;
396 var Lines: TStringList;
401 Lines := TStringList.Create;
402 for i := 0 to FMenus.Count-1 do begin
403 Menus[i].Save(Lines);
405 Lines.SaveToFile(FileName);
411 procedure TScriptConstFile.SetFileName(const Value: String);
418 function TScriptConstMenu.AddConst: TScriptConst;
420 Result := TScriptConst.Create;
421 Result.Caption := '
\92è
\8c^
\8bå';
422 Result.ConstText := '
\83X
\83N
\83\8a\83v
\83g';
426 constructor TScriptConstMenu.Create;
430 FConsts := TObjectList.Create(true);
433 procedure TScriptConstMenu.Delete(const ID: integer);
436 for i := Count-1 downto 0 do begin
437 if Consts[i].ID = ID then FConsts.Delete(i);
441 destructor TScriptConstMenu.Destroy;
447 function TScriptConstMenu.GetConstByID(const ID: integer): TScriptConst;
451 for i := 0 to Count-1 do
452 if Consts[i].ID = ID then begin
458 function TScriptConstMenu.GetConsts(Index: integer): TScriptConst;
460 Result := FConsts[Index] as TScriptConst;
463 function TScriptConstMenu.GetCount: integer;
465 Result := FConsts.Count;
468 procedure TScriptConstMenu.Load(Lines: TStrings);
469 var ConstItem: TScriptConst;
471 if Lines.Count = 0 then Exit;
473 Caption := Token(Lines[0], #9, 0);
474 IfGhost := Token(Lines[0], #9, 1);
476 while Lines.Count > 0 do begin
477 if Lines[0][1] = #9 then begin
480 ConstItem := TScriptConst.Create;
481 ConstItem.FromString(Lines[0]);
482 FConsts.Add(ConstItem);
491 procedure TScriptConstMenu.Save(Lines: TStrings);
494 if IfGhost <> '' then
495 Lines.Add(Caption + #9 + IfGhost)
497 Lines.Add(Caption); //
\89ß
\8b\8e\8cÝ
\8a·
\82Ì
\82½
\82ß
\88ê
\89\9e\96\96\94ö
\82Ì#9
\82Í
\96³
\91Ê
\82É
\82Â
\82¯
\82È
\82¢
498 for i := 0 to FConsts.Count-1 do Lines.Add(Consts[i].ToString);
501 procedure TScriptConstMenu.SetCaption(const Value: String);
506 procedure TScriptConstMenu.SetIfGhost(const Value: String);
513 ScriptConstList := TScriptConstList.Create;
518 ScriptConstList.Free;