Subversion Repositories spacemission

Rev

Rev 40 | Rev 51 | 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, ComLevelReader, 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. begin
  123.   if LevelListBox.ItemIndex = -1 then exit;
  124.  
  125.   if MessageDlg('Diesen Spielstand wirklich löschen?', mtConfirmation, mbYesNoCancel, 0) = mrYes then
  126.   begin
  127.     li1.visible := false;
  128.     li2a.visible := false;
  129.     li2b.visible := false;
  130.     li3a.visible := false;
  131.     li3b.visible := false;
  132.     li4a.visible := false;
  133.     li4b.visible := false;
  134.     liu.visible := false;
  135.     liw.visible := false;
  136.     li1.caption := 'n/a';
  137.     li2b.caption := 'n/a';
  138.     li3b.caption := 'n/a';
  139.     li4b.caption := 'n/a';
  140.     LadenBtn.enabled := false;
  141.     LoeschenBtn.enabled := false;
  142.     deletefile(IncludeTrailingPathDelimiter(GetSpielstandVerzeichnis)+LevelListBox.Items.strings[LevelListBox.itemindex]+'.sav');
  143.     searchsaves;
  144.   end;
  145. end;
  146.  
  147. procedure TSpeicherungForm.LadenBtnClick(Sender: TObject);
  148. var
  149.   SavGame: TSaveData;
  150. begin
  151.   if LevelListBox.ItemIndex = -1 then exit;
  152.  
  153.   if LevelListBox.items.count = 0 then
  154.   begin
  155.     li1.visible := false;
  156.     li2a.visible := false;
  157.     li2b.visible := false;
  158.     li3a.visible := false;
  159.     li3b.visible := false;
  160.     li4a.visible := false;
  161.     li4b.visible := false;
  162.     liu.visible := false;
  163.     liw.visible := false;
  164.     li1.caption := 'n/a';
  165.     li2b.caption := 'n/a';
  166.     li3b.caption := 'n/a';
  167.     li4b.caption := 'n/a';
  168.     LadenBtn.enabled := false;
  169.     LoeschenBtn.enabled := false;
  170.   end;
  171.   {if liu.visible or (LevelListBox.items.count=0) then
  172.     exit;}
  173.   SavGame := TSaveData.Create;
  174.   try
  175.     SavGame.LoadFromFile(IncludeTrailingPathDelimiter(GetSpielstandVerzeichnis)+LevelListBox.Items.strings[LevelListBox.itemindex]+'.sav');
  176.     mainform.FScore := SavGame.Score;
  177.     mainform.FLife := SavGame.Life;
  178.     mainform.FLevel := SavGame.Level;
  179.     mainform.FGameMode := SavGame.GameMode;
  180.     MainForm.FLevelDataAlreadyLoaded := true; // do not call NewLevel() in StartSceneMain
  181.     if Assigned(SavGame.LevelData) then
  182.     begin
  183.       MainForm.LevelData.Assign(SavGame.LevelData);
  184.     end;
  185.   finally
  186.     FreeAndNil(SavGame);
  187.   end;
  188.   mainform.playsound(smsSceneMov, false);
  189.   mainform.FNextScene := gsNewLevel;
  190.   mainform.FCheat := false;
  191.   close;
  192. end;
  193.  
  194. procedure TSpeicherungForm.SpeichernBtnClick(Sender: TObject);
  195. var
  196.   SavGame: TSaveData;
  197.   i: integer;
  198. begin
  199.   if Levelname.text = '' then
  200.   begin
  201.     MessageDlg('Dies ist kein gültiger Spielstandname!', mtError, [mbOK], 0);
  202.     LevelName.setfocus;
  203.     exit;
  204.   end;
  205.   for i := 0 to length(LevelName.text) do
  206.   begin
  207.     if (copy(LevelName.text, i, 1) = '\') or
  208.       (copy(LevelName.text, i, 1) = '/') or
  209.       (copy(LevelName.text, i, 1) = ':') or
  210.       (copy(LevelName.text, i, 1) = '*') or
  211.       (copy(LevelName.text, i, 1) = '?') or
  212.       (copy(LevelName.text, i, 1) = '"') or
  213.       (copy(LevelName.text, i, 1) = '<') or
  214.       (copy(LevelName.text, i, 1) = '>') or
  215.       (copy(LevelName.text, i, 1) = '|') then
  216.     begin
  217.       MessageDlg('Dies ist kein gültiger Spielstandname!', mtError, [mbOK], 0);
  218.       LevelName.setfocus;
  219.       exit;
  220.     end;
  221.   end;
  222.   if LevelListBox.items.IndexOf(LevelName.text) > -1 then
  223.   begin
  224.     if MessageDlg('Spielstand ist bereits vorhanden. Ersetzen?', mtConfirmation, mbYesNoCancel, 0) <> mrYes then
  225.       exit;
  226.   end;
  227.  
  228.   SavGame := TSaveData.Create;
  229.   try
  230.     SavGame.Score := mainform.FScoreAtLevelStart;//mainform.FScore;
  231.     SavGame.Life := mainform.FLifeAtLevelStart;//mainform.FLife;
  232.     SavGame.Level := mainform.FLevel;
  233.     SavGame.GameMode := mainform.FGameMode;
  234.     if not Assigned(SavGame.LevelData) then SavGame.LevelData := TLevelData.Create;
  235.     SavGame.LevelData.Assign(mainForm.LevelData);
  236.     SavGame.SaveToFile(IncludeTrailingPathDelimiter(GetSpielstandVerzeichnis)+LevelName.text+'.sav');
  237.   finally
  238.     FreeAndNil(SavGame);
  239.   end;
  240.  
  241.   SearchSaves;
  242. end;
  243.  
  244. procedure TSpeicherungForm.LevelListBoxClick(Sender: TObject);
  245. var
  246.   SavGame: TSaveData;
  247.   Punkte, Leben, Level: integer;
  248.   BeinhaltetLevelDaten: boolean;
  249.   Art: TGameMode;
  250. begin
  251.   ladenbtn.enabled := true;
  252.   loeschenbtn.enabled := true;
  253.   li1.visible := false;
  254.   li2a.visible := false;
  255.   li2b.visible := false;
  256.   li3a.visible := false;
  257.   li3b.visible := false;
  258.   li4a.visible := false;
  259.   li4b.visible := false;
  260.   liu.visible := false;
  261.   liw.visible := false;
  262.   li1.caption := 'n/a';
  263.   li2b.caption := 'n/a';
  264.   li3b.caption := 'n/a';
  265.   li4b.caption := 'n/a';
  266.   if (LevelListBox.items.count=0) or (LevelListBox.itemindex = -1) then
  267.   begin
  268.     ladenbtn.enabled := false;
  269.     loeschenbtn.enabled := false;
  270.     liw.visible := true;
  271.     exit;
  272.   end;
  273.   LevelName.Text := LevelListBox.Items.strings[LevelListBox.itemindex];
  274.  
  275.   SavGame := TSaveData.Create;
  276.   try
  277.     try
  278.       SavGame.LoadFromFile(IncludeTrailingPathDelimiter(GetSpielstandVerzeichnis)+LevelListBox.Items.strings[LevelListBox.itemindex]+'.sav');
  279.       Punkte := SavGame.Score;
  280.       Leben := SavGame.Life;
  281.       Level := SavGame.Level;
  282.       Art := SavGame.GameMode;
  283.       BeinhaltetLevelDaten := Assigned(SavGame.LevelData);
  284.     except
  285.       liu.visible := true;
  286.       ladenbtn.enabled := false;
  287.       exit;
  288.     end;
  289.   finally
  290.     FreeAndNil(SavGame);
  291.   end;
  292.   li1.visible := true;
  293.   li2a.visible := true;
  294.   li2b.visible := true;
  295.   li3a.visible := true;
  296.   li3b.visible := true;
  297.   li4a.visible := true;
  298.   li4b.visible := true;
  299.   if Art = gmLevels then
  300.     li1.caption := 'Das Level ist ein norm. Level'
  301.   else
  302.     li1.caption := 'Das Level ist ein Zufallslevel';
  303.   if BeinhaltetLevelDaten then
  304.     li1.Caption := li1.Caption + ' mit Karte';
  305.   li3b.caption := inttostr(Level);
  306.   li4b.caption := inttostr(Leben);
  307.   li2b.caption := inttostr(Punkte);
  308. end;
  309.  
  310. procedure TSpeicherungForm.LevelNameChange(Sender: TObject);
  311. begin
  312.   //listbox1.Items.indexof('Level '+spinedit1.text);
  313. end;
  314.  
  315. procedure TSpeicherungForm.Button4Click(Sender: TObject);
  316. begin
  317.   mainform.dxtimer.enabled := not mainform.gamepause.checked;
  318.   close;
  319. end;
  320.  
  321. procedure TSpeicherungForm.FormShow(Sender: TObject);
  322. begin
  323.   mainform.dxtimer.enabled := false;
  324.   SearchSaves;
  325.   if mainform.FNotSave then
  326.   begin
  327.     label1.enabled := false;
  328.     LevelName.enabled := false;
  329.     SpeichernBtn.enabled := false;
  330.   end
  331.   else
  332.   begin
  333.     label1.enabled := true;
  334.     LevelName.enabled := true;
  335.     SpeichernBtn.enabled := true;
  336.   end;
  337. end;
  338.  
  339. function TSpeicherungForm.GetSpielstandVerzeichnis: string;
  340. begin
  341.   try
  342.     result := GetKnownFolderPath(FOLDERID_SavedGames);
  343.   except
  344.     result := '';
  345.   end;
  346.   if result = '' then
  347.   begin
  348.     // Pre Vista
  349.     result := OwnDirectory + 'Spielstände';
  350.   end
  351.   else
  352.   begin
  353.     result := IncludeTrailingPathDelimiter(result);
  354.     result := result + 'SpaceMission';
  355.   end;
  356.   result := IncludeTrailingPathDelimiter(result);
  357.   ForceDirectories(result);
  358. end;
  359.  
  360. procedure TSpeicherungForm.DsFancyButton2Click(Sender: TObject);
  361. begin
  362.   SearchSaves;
  363. end;
  364.  
  365. procedure TSpeicherungForm.AbbrechenBtnClick(Sender: TObject);
  366. begin
  367.   close;
  368. end;
  369.  
  370. procedure TSpeicherungForm.FormHide(Sender: TObject);
  371. begin
  372.   if not mainform.gamepause.checked then mainform.dxtimer.enabled := true;
  373. end;
  374.  
  375. procedure TSpeicherungForm.LevelListBoxDblClick(Sender: TObject);
  376. begin
  377.   LadenBtn.click;
  378. end;
  379.  
  380. end.
  381.  
  382.