bottleclient/ScriptConsts.pas

   1 unit ScriptConsts;
   2
   3 {
   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
   5 }
   6
   7 interface
   8
   9 uses Windows, Classes, SysUtils, Contnrs, Menus, Dialogs;
  10
  11 type
  12   EScriptConstFileError = class(Exception);
  13
  14   TScriptConst = class(TPersistent) // \8cÂ\95Ê\82Ì\92è\8c^\8bå
  15   private
  16     FConstText: String;
  17     FShortCut: TShortCut;
  18     FCaption: String;
  19     FID: integer;
  20     procedure SetCaption(const Value: String);
  21     procedure SetConstText(const Value: String);
  22     procedure SetShortCut(const Value: TShortCut);
  23   public
  24     constructor Create;
  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;
  32   end;
  33
  34   TScriptConstMenu = class(TObject) // \91·\81BTScriptConst\82Ì\83\8a\83X\83g\81B
  35   private
  36     FConsts: TObjectList;
  37     FCaption: String;
  38     FIfGhost: String;
  39     FID: integer;
  40     function GetCount: integer;
  41     function GetConsts(Index: integer): TScriptConst;
  42     procedure SetCaption(const Value: String);
  43     procedure SetIfGhost(const Value: String);
  44   public
  45     constructor Create;
  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;
  58   end;
  59
  60   TScriptConstFile = class(TObject) // \8eq\81BTScriptConstMenu\82Ì\83\8a\83X\83g\81B
  61   private
  62     FMenus: TObjectList;
  63     FFileName: String;
  64     function GetMenus(Index: integer): TScriptConstMenu;
  65     function GetCount: integer;
  66     procedure SetFileName(const Value: String);
  67   public
  68     constructor Create;
  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);
  75     procedure SaveToFile;
  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;
  82   end;
  83
  84   TScriptConstList = class(TObject) // \90e\81BScriptConstFile\82Ì\83\8a\83X\83g\81B
  85   private
  86     FFiles: TObjectList;
  87     function GetCount: integer;
  88     function GetFiles(Index: integer): TScriptConstFile;
  89   public
  90     constructor Create;
  91     destructor Destroy; override;
  92     procedure LoadFromDir(const Dir: String);
  93     procedure Save;
  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);
 100   end;
 101
 102 var
 103   ScriptConstList: TScriptConstList;
 104
 105 implementation
 106
 107 var OldID: integer; // \92è\8c^\8bå\82Ì\93à\95\94ID\81BTag\82É\93ü\82ê\82é\97p
 108
 109
 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;
 114 begin
 115   i := 1;
 116   c := 0;
 117   len := length(Str);
 118   Result := '';
 119   while i <= len do begin
 120     if (Str[i] = Delimiter) and (StrByteType(PChar(Str), i) <> mbTrailByte) then begin
 121       Inc(c);
 122       if c > Index then Break;
 123     end else if c = Index then Result := Result + Str[i];
 124     Inc(i);
 125   end;
 126 end;
 127
 128 { TScriptConstList }
 129
 130 constructor TScriptConstList.Create;
 131 begin
 132   FFiles := TObjectList.Create(true);
 133 end;
 134
 135 procedure TScriptConstList.Delete(const ID: integer);
 136 var i: integer;
 137 begin
 138   for i := Count-1 downto 0 do begin
 139     Files[i].Delete(ID);
 140   end;
 141 end;
 142
 143 destructor TScriptConstList.Destroy;
 144 begin
 145   FreeAndNil(FFiles);
 146   inherited;
 147 end;
 148
 149 function TScriptConstList.GetConstByID(const ID: integer): TScriptConst;
 150 var i: integer;
 151 begin
 152   Result := nil;
 153   for i := 0 to Count-1 do begin
 154     Result := Files[i].GetConstByID(ID);
 155     if Result <> nil then Exit;
 156   end;
 157 end;
 158
 159 function TScriptConstList.GetCount: integer;
 160 begin
 161   Result := FFiles.Count;
 162 end;
 163
 164 function TScriptConstList.GetFiles(Index: integer): TScriptConstFile;
 165 begin
 166   Result := FFiles[Index] as TScriptConstFile;
 167 end;
 168
 169 function TScriptConstList.GetMenuByID(const ID: integer): TScriptConstMenu;
 170 var i: integer;
 171 begin
 172   Result := nil;
 173   for i := 0 to Count-1 do begin
 174     Result := Files[i].GetMenuByID(ID);
 175     if Result <> nil then Exit;
 176   end;
 177 end;
 178
 179 procedure TScriptConstList.LoadFromDir(const Dir: String);
 180 var F: TSearchRec;
 181     i: integer;
 182     AFile: TScriptConstFile;
 183 begin
 184   FFiles.Clear;
 185   i := FindFirst(Dir + '\*.txt', 0, F);
 186   if i = 0 then begin
 187     repeat
 188       AFile := nil;
 189       try
 190         AFile := TScriptConstFile.Create;
 191         AFile.LoadFromFile(Dir + '\' + F.Name);
 192       except
 193         AFile.Free;
 194       end;
 195       FFiles.Add(AFile);
 196       i := FindNext(F);
 197     until i <> 0;
 198   end;
 199   FindClose(F);
 200 end;
 201
 202 procedure TScriptConstList.Save;
 203 var i: integer;
 204 begin
 205   for i := 0 to FFiles.Count-1 do begin
 206     Files[i].SaveToFile;
 207   end;
 208 end;
 209
 210 { TScriptConst }
 211
 212 procedure TScriptConst.Assign(Source: TPersistent);
 213 begin
 214   inherited;
 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;
 220   end;
 221 end;
 222
 223 constructor TScriptConst.Create;
 224 begin
 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é
 228   FID := OldID+1;
 229   OldID := OldID+1;
 230 end;
 231
 232 procedure TScriptConst.FromString(const Str: String);
 233 begin
 234   if Str[1] <> #9 then
 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);
 241 end;
 242
 243 procedure TScriptConst.SetCaption(const Value: String);
 244 begin
 245   FCaption := Value;
 246 end;
 247
 248 procedure TScriptConst.SetConstText(const Value: String);
 249 begin
 250   FConstText := Value;
 251 end;
 252
 253 procedure TScriptConst.SetShortCut(const Value: TShortCut);
 254 begin
 255   FShortCut := Value;
 256 end;
 257
 258 function TScriptConst.ToString: String;
 259 begin
 260   Result := #9 + ShortCutToText(ShortCut) + #9 + Caption + #9 + ConstText;
 261 end;
 262
 263 { TScriptConstFile }
 264
 265 function TScriptConstFile.AddMenu: TScriptConstMenu;
 266 begin
 267   Result := TScriptConstMenu.Create;
 268   Result.Caption := '\90V\82µ\82¢\83O\83\8b\81[\83v';
 269   Result.IfGhost := '';
 270   FMenus.Add(Result);
 271 end;
 272
 273 constructor TScriptConstFile.Create;
 274 begin
 275   FMenus := TObjectList.Create(true);
 276 end;
 277
 278 procedure TScriptConstFile.Delete(const ID: integer);
 279 var i: integer;
 280 begin
 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
 285       Exit;
 286     end;
 287   end;
 288 end;
 289
 290 destructor TScriptConstFile.Destroy;
 291 begin
 292   FreeAndNil(FMenus);
 293   inherited;
 294 end;
 295
 296 function TScriptConstFile.GetConstByID(const ID: integer): TScriptConst;
 297 var i: integer;
 298 begin
 299   Result := nil;
 300   for i := 0 to Count-1 do begin
 301     Result := Menus[i].GetConstByID(ID);
 302     if Result <> nil then Exit;
 303   end;
 304 end;
 305
 306 function TScriptConstFile.GetCount: integer;
 307 begin
 308   Result := FMenus.Count;
 309 end;
 310
 311 function TScriptConstFile.GetMenuByID(const ID: integer): TScriptConstMenu;
 312 var i: integer;
 313 begin
 314   Result := nil;
 315   for i := 0 to Count-1 do
 316     if Menus[i].ID = ID then begin
 317       Result := Menus[i];
 318       Exit;
 319     end;
 320 end;
 321
 322 function TScriptConstFile.GetMenus(Index: integer): TScriptConstMenu;
 323 begin
 324   Result := FMenus[Index] as TScriptConstMenu;
 325 end;
 326
 327 procedure TScriptConstFile.LoadFromFile(LoadFileName: String);
 328 var Lines: TStringList;
 329     Menu: TScriptConstMenu;
 330 begin
 331   Lines := nil;
 332   FMenus.Clear;
 333   try
 334     Lines := TStringList.Create;
 335     Lines.LoadFromFile(LoadFileName);
 336     while Lines.Count > 0 do begin
 337       Menu := TScriptConstMenu.Create;
 338       Menu.Load(Lines);
 339       FMenus.Add(Menu);
 340     end;
 341   finally
 342     Lines.Free;
 343   end;
 344   FileName := LoadFileName; // \83t\83@\83C\83\8b\96¼\82Í\95Û\91¶\82µ\82Ä\82¨\82
 345 end;
 346
 347 procedure TScriptConstFile.MoveDown(const ID: integer);
 348 var i, j: integer;
 349     ConstData: TObject;
 350 begin
 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);
 354       Exit;
 355     end;
 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);
 364           Exit;
 365         end;
 366       end;
 367     end;
 368   end;
 369 end;
 370
 371 procedure TScriptConstFile.MoveUp(const ID: integer);
 372 var i, j: integer;
 373     ConstData: TObject;
 374 begin
 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);
 378       Exit;
 379     end;
 380     for j := 0 to Menus[i].Count-1 do begin
 381       if Menus[i][j].ID = ID then begin
 382         if j > 0 then
 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);
 388           Exit;
 389         end;
 390       end;
 391     end;
 392   end;
 393 end;
 394
 395 procedure TScriptConstFile.SaveToFile;
 396 var Lines: TStringList;
 397     i: integer;
 398 begin
 399   Lines := nil;
 400   try
 401     Lines := TStringList.Create;
 402     for i := 0 to FMenus.Count-1 do begin
 403       Menus[i].Save(Lines);
 404     end;
 405     Lines.SaveToFile(FileName);
 406   finally
 407     Lines.Free;
 408   end;
 409 end;
 410
 411 procedure TScriptConstFile.SetFileName(const Value: String);
 412 begin
 413   FFileName := Value;
 414 end;
 415
 416 { TScriptConstMenu }
 417
 418 function TScriptConstMenu.AddConst: TScriptConst;
 419 begin
 420   Result := TScriptConst.Create;
 421   Result.Caption := '\92è\8c^\8bå';
 422   Result.ConstText := '\83X\83N\83\8a\83v\83g';
 423   FConsts.Add(Result);
 424 end;
 425
 426 constructor TScriptConstMenu.Create;
 427 begin
 428   FID := OldID + 1;
 429   OldID := OldID + 1;
 430   FConsts := TObjectList.Create(true);
 431 end;
 432
 433 procedure TScriptConstMenu.Delete(const ID: integer);
 434 var i: integer;
 435 begin
 436   for i := Count-1 downto 0 do begin
 437     if Consts[i].ID = ID then FConsts.Delete(i);
 438   end;
 439 end;
 440
 441 destructor TScriptConstMenu.Destroy;
 442 begin
 443   FreeAndNil(FConsts);
 444   inherited;
 445 end;
 446
 447 function TScriptConstMenu.GetConstByID(const ID: integer): TScriptConst;
 448 var i: integer;
 449 begin
 450   Result := nil;
 451   for i := 0 to Count-1 do
 452     if Consts[i].ID = ID then begin
 453       Result := Consts[i];
 454       Exit;
 455     end;
 456 end;
 457
 458 function TScriptConstMenu.GetConsts(Index: integer): TScriptConst;
 459 begin
 460   Result := FConsts[Index] as TScriptConst;
 461 end;
 462
 463 function TScriptConstMenu.GetCount: integer;
 464 begin
 465   Result := FConsts.Count;
 466 end;
 467
 468 procedure TScriptConstMenu.Load(Lines: TStrings);
 469 var ConstItem: TScriptConst;
 470 begin
 471   if Lines.Count = 0 then Exit;
 472   FConsts.Clear;
 473   Caption := Token(Lines[0], #9, 0);
 474   IfGhost := Token(Lines[0], #9, 1);
 475   Lines.Delete(0);
 476   while Lines.Count > 0 do begin
 477     if Lines[0][1] = #9 then begin
 478       ConstItem := nil;
 479       try
 480         ConstItem := TScriptConst.Create;
 481         ConstItem.FromString(Lines[0]);
 482         FConsts.Add(ConstItem);
 483       except
 484         ConstItem.Free;
 485       end;
 486       Lines.Delete(0);
 487     end else Break;
 488   end;
 489 end;
 490
 491 procedure TScriptConstMenu.Save(Lines: TStrings);
 492 var i: integer;
 493 begin
 494   if IfGhost <> '' then
 495     Lines.Add(Caption + #9 + IfGhost)
 496   else
 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);
 499 end;
 500
 501 procedure TScriptConstMenu.SetCaption(const Value: String);
 502 begin
 503   FCaption := Value;
 504 end;
 505
 506 procedure TScriptConstMenu.SetIfGhost(const Value: String);
 507 begin
 508   FIfGhost := Value;
 509 end;
 510
 511 initialization
 512
 513 ScriptConstList := TScriptConstList.Create;
 514 OldID := 0;
 515
 516 finalization
 517
 518 ScriptConstList.Free;
 519
 520 end.