Subversion Repositories spacemission

Rev

Rev 24 | Rev 28 | Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | RSS feed

  1. unit GamSpeicherung;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, ExtCtrls, Spin{$IF CompilerVersion >= 23.0}, System.UITypes{$IFEND};
  8.  
  9. type
  10.   TSpeicherungForm = class(TForm)
  11.     Bevel1: TBevel;
  12.     LadenBtn: TButton;
  13.     LoeschenBtn: TButton;
  14.     AktualisierenBtn: TButton;
  15.     SpeichernBtn: TButton;
  16.     AbbrechenBtn: TButton;
  17.     LevelListBox: TListBox;
  18.     Label2: TLabel;
  19.     Label3: TLabel;
  20.     Label1: TLabel;
  21.     LevelName: TEdit;
  22.     ElPanel1: TPanel;
  23.     li4a: TLabel;
  24.     li1: TLabel;
  25.     li3b: TLabel;
  26.     li3a: TLabel;
  27.     li4b: TLabel;
  28.     liu: TLabel;
  29.     liw: TLabel;
  30.     li2a: TLabel;
  31.     li2b: TLabel;
  32.     procedure LoeschenBtnClick(Sender: TObject);
  33.     procedure LadenBtnClick(Sender: TObject);
  34.     procedure SpeichernBtnClick(Sender: TObject);
  35.     procedure LevelListBoxClick(Sender: TObject);
  36.     procedure LevelNameChange(Sender: TObject);
  37.     procedure Button4Click(Sender: TObject);
  38.     procedure FormShow(Sender: TObject);
  39.     procedure DsFancyButton2Click(Sender: TObject);
  40.     procedure AbbrechenBtnClick(Sender: TObject);
  41.     procedure FormHide(Sender: TObject);
  42.     procedure LevelListBoxDblClick(Sender: TObject);
  43.   private
  44.     function GetSpielstandVerzeichnis: string;
  45.   public
  46.     procedure SearchSaves;
  47.   end;
  48.  
  49. var
  50.   SpeicherungForm: TSpeicherungForm;
  51.  
  52. implementation
  53.  
  54. uses
  55.   Global, GamMain, ComSaveGameReader, ActiveX, ShlObj;
  56.  
  57. {$R *.DFM}
  58.  
  59. const
  60.   FOLDERID_SavedGames: TGuid = '{4C5C32FF-BB9D-43b0-B5B4-2D72E54EAAA4}';
  61.  
  62. function GetKnownFolderPath(const rfid: TGUID): string;
  63. var
  64.   OutPath: PWideChar;
  65. begin
  66.   // https://www.delphipraxis.net/135471-unit-zur-verwendung-von-shgetknownfolderpath.html
  67.   if ShGetKnownFolderPath(rfid, 0, 0, OutPath) {>= 0} = S_OK then
  68.   begin
  69.     Result := OutPath;
  70.     // From MSDN
  71.     // ppszPath [out]
  72.     // Type: PWSTR*
  73.     // When this method returns, contains the address of a pointer to a null-terminated Unicode string that specifies the path of the known folder
  74.     // The calling process is responsible for freeing this resource once it is no longer needed by calling CoTaskMemFree.
  75.     // The returned path does not include a trailing backslash. For example, "C:\Users" is returned rather than "C:\Users\".
  76.     CoTaskMemFree(OutPath);
  77.   end
  78.   else
  79.   begin
  80.     Result := '';
  81.   end;
  82. end;
  83.  
  84. { TSpeicherungForm }
  85.  
  86. procedure TSpeicherungForm.SearchSaves;
  87. var
  88.   sr: TSearchRec;
  89.   res: integer;
  90. begin
  91.   LevelName.text := '';
  92.   LevelListBox.items.clear;
  93.   li1.visible := false;
  94.   li2a.visible := false;
  95.   li2b.visible := false;
  96.   li3a.visible := false;
  97.   li3b.visible := false;
  98.   li4a.visible := false;
  99.   li4b.visible := false;
  100.   liu.visible := false;
  101.   liw.visible := true;
  102.   li1.caption := 'n/a';
  103.   li2b.caption := 'n/a';
  104.   li3b.caption := 'n/a';
  105.   li4b.caption := 'n/a';
  106.   LadenBtn.enabled := false;
  107.   LoeschenBtn.enabled := false;
  108.   res := FindFirst(IncludeTrailingPathDelimiter(GetSpielstandVerzeichnis)+'*.sav', 0, sr);
  109.   try
  110.     while (res = 0) do
  111.     begin
  112.       if (sr.name <> '.') and (sr.name <> '..') then
  113.         LevelListBox.items.Add(ChangeFileExt(sr.Name, ''));
  114.       res := FindNext(sr);
  115.     end;
  116.   finally
  117.     FindClose(sr);
  118.   end;
  119. end;
  120.  
  121. procedure TSpeicherungForm.LoeschenBtnClick(Sender: TObject);
  122. var
  123.   Markiert: boolean;
  124.   i: integer;
  125. begin
  126.   Markiert := false;
  127.   for i := 0 to LevelListBox.items.Count-1 do
  128.   begin
  129.     if LevelListBox.Selected[i] then Markiert := true;
  130.   end;
  131.   if not Markiert then exit;
  132.   if MessageDlg('Diesen Spielstand wirklich löschen?',
  133.     mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  134.   begin
  135.     li1.visible := false;
  136.     li2a.visible := false;
  137.     li2b.visible := false;
  138.     li3a.visible := false;
  139.     li3b.visible := false;
  140.     li4a.visible := false;
  141.     li4b.visible := false;
  142.     liu.visible := false;
  143.     liw.visible := false;
  144.     li1.caption := 'n/a';
  145.     li2b.caption := 'n/a';
  146.     li3b.caption := 'n/a';
  147.     li4b.caption := 'n/a';
  148.     LadenBtn.enabled := false;
  149.     LoeschenBtn.enabled := false;
  150.     deletefile(IncludeTrailingPathDelimiter(GetSpielstandVerzeichnis)+LevelListBox.Items.strings[LevelListBox.itemindex]+'.sav');
  151.     searchsaves;
  152.   end;
  153. end;
  154.  
  155. procedure TSpeicherungForm.LadenBtnClick(Sender: TObject);
  156. var
  157.   Markiert: boolean;
  158.   i: integer;
  159.   SavGame: TSaveData;
  160. begin
  161.   Markiert := false;
  162.   for i := 0 to LevelListBox.items.Count-1 do
  163.   begin
  164.     if LevelListBox.Selected[i] then Markiert := true;
  165.   end;
  166.   if not Markiert then exit;
  167.   if LevelListBox.items.count = 0 then
  168.   begin
  169.     li1.visible := false;
  170.     li2a.visible := false;
  171.     li2b.visible := false;
  172.     li3a.visible := false;
  173.     li3b.visible := false;
  174.     li4a.visible := false;
  175.     li4b.visible := false;
  176.     liu.visible := false;
  177.     liw.visible := false;
  178.     li1.caption := 'n/a';
  179.     li2b.caption := 'n/a';
  180.     li3b.caption := 'n/a';
  181.     li4b.caption := 'n/a';
  182.     LadenBtn.enabled := false;
  183.     LoeschenBtn.enabled := false;
  184.   end;
  185.   {if liu.visible or (LevelListBox.items.count=0) then
  186.     exit;}
  187.   SavGame := TSaveData.Create;
  188.   try
  189.     SavGame.Load(IncludeTrailingPathDelimiter(GetSpielstandVerzeichnis)+LevelListBox.Items.strings[LevelListBox.itemindex]+'.sav');
  190.     mainform.FScore := SavGame.FScore;
  191.     mainform.FLife := SavGame.FLife;
  192.     mainform.FLevel := SavGame.FLevel;
  193.     mainform.FGameMode := SavGame.FGameMode;
  194.   finally
  195.     FreeAndNil(SavGame);
  196.   end;
  197.   mainform.playsound('SceneMov', false);
  198.   mainform.FNextScene := gsNewLevel;
  199.   mainform.FCheat := false;
  200.   close;
  201. end;
  202.  
  203. procedure TSpeicherungForm.SpeichernBtnClick(Sender: TObject);
  204. var
  205.   SavGame: TSaveData;
  206.   i: integer;
  207. begin
  208.   if Levelname.text = '' then
  209.   begin
  210.     MessageDlg('Dies ist kein gültiger Spielstandname!', mtError, [mbOK], 0);
  211.     LevelName.setfocus;
  212.     exit;
  213.   end;
  214.   for i := 0 to length(LevelName.text) do
  215.   begin
  216.     if (copy(LevelName.text, i, 1) = '\') or
  217.       (copy(LevelName.text, i, 1) = '/') or
  218.       (copy(LevelName.text, i, 1) = ':') or
  219.       (copy(LevelName.text, i, 1) = '*') or
  220.       (copy(LevelName.text, i, 1) = '?') or
  221.       (copy(LevelName.text, i, 1) = '"') or
  222.       (copy(LevelName.text, i, 1) = '<') or
  223.       (copy(LevelName.text, i, 1) = '>') or
  224.       (copy(LevelName.text, i, 1) = '|') then
  225.     begin
  226.       MessageDlg('Dies ist kein gültiger Spielstandname!', mtError, [mbOK], 0);
  227.       LevelName.setfocus;
  228.       exit;
  229.     end;
  230.   end;
  231.   if LevelListBox.items.IndexOf(LevelName.text) > -1 then
  232.   begin
  233.     if MessageDlg('Spielstand ist bereits vorhanden. Ersetzen?', mtConfirmation, [mbYes, mbNo], 0) = mrNo then
  234.       exit;
  235.   end;
  236.  
  237.   SavGame := TSaveData.Create;
  238.   try
  239.     SavGame.FScore := mainform.FScore;
  240.     SavGame.FLife := mainform.FLife;
  241.     SavGame.FLevel := mainform.FLevel;
  242.     SavGame.FGameMode := mainform.FGameMode;
  243.     SavGame.Save(IncludeTrailingPathDelimiter(GetSpielstandVerzeichnis)+LevelName.text+'.sav');
  244.   finally
  245.     FreeAndNil(SavGame);
  246.   end;
  247.  
  248.   SearchSaves;
  249. end;
  250.  
  251. procedure TSpeicherungForm.LevelListBoxClick(Sender: TObject);
  252. var
  253.   SavGame: TSaveData;
  254.   Punkte, Leben, Level: integer;
  255.   Art: TGameMode;
  256. begin
  257.   ladenbtn.enabled := true;
  258.   loeschenbtn.enabled := true;
  259.   li1.visible := false;
  260.   li2a.visible := false;
  261.   li2b.visible := false;
  262.   li3a.visible := false;
  263.   li3b.visible := false;
  264.   li4a.visible := false;
  265.   li4b.visible := false;
  266.   liu.visible := false;
  267.   liw.visible := false;
  268.   li1.caption := 'n/a';
  269.   li2b.caption := 'n/a';
  270.   li3b.caption := 'n/a';
  271.   li4b.caption := 'n/a';
  272.   if (LevelListBox.items.count=0) or (LevelListBox.itemindex = -1) then
  273.   begin
  274.     ladenbtn.enabled := false;
  275.     loeschenbtn.enabled := false;
  276.     liw.visible := true;
  277.     exit;
  278.   end;
  279.   LevelName.Text := LevelListBox.Items.strings[LevelListBox.itemindex];
  280.  
  281.   SavGame := TSaveData.Create;
  282.   try
  283.     try
  284.       SavGame.Load(IncludeTrailingPathDelimiter(GetSpielstandVerzeichnis)+LevelListBox.Items.strings[LevelListBox.itemindex]+'.sav');
  285.       Punkte := SavGame.FScore;
  286.       Leben := SavGame.FLife;
  287.       Level := SavGame.FLevel;
  288.       Art := SavGame.FGameMode;
  289.     except
  290.       liu.visible := true;
  291.       ladenbtn.enabled := false;
  292.       exit;
  293.     end;
  294.   finally
  295.     FreeAndNil(SavGame);
  296.   end;
  297.   li1.visible := true;
  298.   li2a.visible := true;
  299.   li2b.visible := true;
  300.   li3a.visible := true;
  301.   li3b.visible := true;
  302.   li4a.visible := true;
  303.   li4b.visible := true;
  304.   if Art = gmLevels then
  305.     li1.caption := 'Das Level ist ein normales Level.'
  306.   else
  307.     li1.caption := 'Das Level ist ein Zufallslevel.';
  308.   li3b.caption := inttostr(Level);
  309.   li4b.caption := inttostr(Leben);
  310.   li2b.caption := inttostr(Punkte);
  311. end;
  312.  
  313. procedure TSpeicherungForm.LevelNameChange(Sender: TObject);
  314. begin
  315.   //listbox1.Items.indexof('Level '+spinedit1.text);
  316. end;
  317.  
  318. procedure TSpeicherungForm.Button4Click(Sender: TObject);
  319. begin
  320.   mainform.dxtimer.enabled := not mainform.gamepause.checked;
  321.   close;
  322. end;
  323.  
  324. procedure TSpeicherungForm.FormShow(Sender: TObject);
  325. begin
  326.   mainform.dxtimer.enabled := false;
  327.   SearchSaves;
  328.   if mainform.FNotSave then
  329.   begin
  330.     label1.enabled := false;
  331.     LevelName.enabled := false;
  332.     SpeichernBtn.enabled := false;
  333.   end
  334.   else
  335.   begin
  336.     label1.enabled := true;
  337.     LevelName.enabled := true;
  338.     SpeichernBtn.enabled := true;
  339.   end;
  340. end;
  341.  
  342. function TSpeicherungForm.GetSpielstandVerzeichnis: string;
  343. begin
  344.   try
  345.     result := GetKnownFolderPath(FOLDERID_SavedGames);
  346.   except
  347.     result := '';
  348.   end;
  349.   if result = '' then
  350.   begin
  351.     // Pre Vista
  352.     result := FDirectory + 'Spielstände';
  353.   end
  354.   else
  355.   begin
  356.     result := IncludeTrailingPathDelimiter(result);
  357.     result := result + 'SpaceMission';
  358.   end;
  359.   result := IncludeTrailingPathDelimiter(result);
  360.   ForceDirectories(result);
  361. end;
  362.  
  363. procedure TSpeicherungForm.DsFancyButton2Click(Sender: TObject);
  364. begin
  365.   SearchSaves;
  366. end;
  367.  
  368. procedure TSpeicherungForm.AbbrechenBtnClick(Sender: TObject);
  369. begin
  370.   close;
  371. end;
  372.  
  373. procedure TSpeicherungForm.FormHide(Sender: TObject);
  374. begin
  375.   if not mainform.gamepause.checked then mainform.dxtimer.enabled := true;
  376. end;
  377.  
  378. procedure TSpeicherungForm.LevelListBoxDblClick(Sender: TObject);
  379. begin
  380.   LadenBtn.click;
  381. end;
  382.  
  383. end.
  384.  
  385.