WebSVN – spacemission – Diff – /GamMain.pas

 interface
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   StdCtrls, ExtCtrls, Menus, DIB, DXClass, DXSprite, DXDraws, DXInput, DXSounds,
-  ShellAPI, wininet, DirectX{$IF CompilerVersion >= 23.0},
+  ShellAPI, DirectX{$IF CompilerVersion >= 23.0},
   System.UITypes{$IFEND}, ComLevelReader, DirectMusic, Global;
 type
   TGameScene = (
     gsNone,
     Leer6: TMenuItem;
     Leer1: TMenuItem;
     Cheat: TMenuItem;
     CheckUpdates: TMenuItem;
     Master: TMenuItem;
+    Hilfe1: TMenuItem;
     procedure DXDrawFinalize(Sender: TObject);
     procedure DXDrawInitialize(Sender: TObject);
     procedure FormCreate(Sender: TObject);
     procedure DXTimerTimer(Sender: TObject; LagCount: Integer);
     procedure DXTimerActivate(Sender: TObject);
     procedure FormClose(Sender: TObject; var Action: TCloseAction);
     procedure FormDestroy(Sender: TObject);
     procedure CheckUpdatesClick(Sender: TObject);
     procedure MasterClick(Sender: TObject);
     procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+    procedure Hilfe1Click(Sender: TObject);
   private
     ProgrammGestartet: boolean;
     FInterval: TGameInterval;
     FScene: TGameScene;
     FMusic: TSpaceMissionMusicTrack;
   MainForm: TMainForm;
 implementation
 uses
-  GamSplash, GamSpeicherung, ComInfo, GamCheat, MMSystem, Registry;
+  GamSplash, GamSpeicherung, ComInfo, GamCheat, MMSystem, Registry,
+  ComHilfe;
 {$R *.DFM}
 const
   DXInputButton = [isButton1, isButton2, isButton3,
     isButton4, isButton5, isButton6, isButton7, isButton8, isButton9, isButton10, isButton11,
     isButton12, isButton13, isButton14, isButton15, isButton16, isButton17, isButton18,
     isButton19, isButton20, isButton21, isButton22, isButton23, isButton24, isButton25,
     isButton26, isButton27, isButton28, isButton29, isButton30, isButton31, isButton32];
-// https://www.delphipraxis.net/post43515.html
-function GetHTML(AUrl: string): string;
-var
-  databuffer : array[0..4095] of char;
-  ResStr : string;
-  hSession, hfile: hInternet;
-  dwindex,dwcodelen,dwread,dwNumber: cardinal;
-  dwcode : array[1..20] of char;
-  res    : pchar;
-  Str    : pchar;
-begin
-  ResStr:='';
-  if (system.pos('http://',lowercase(AUrl))=0) and
-     (system.pos('https://',lowercase(AUrl))=0) then
-     AUrl:='http://'+AUrl;
-  // Hinzugefügt
-  application.ProcessMessages;
-  hSession:=InternetOpen('InetURL:/1.0',
-                         INTERNET_OPEN_TYPE_PRECONFIG,
-                         nil,
-                         nil,
-);
-  if assigned(hsession) then
-  begin
-    // Hinzugefügt
-    application.ProcessMessages;
-    hfile:=InternetOpenUrl(
-           hsession,
-           pchar(AUrl),
-           nil,
-,
-           INTERNET_FLAG_RELOAD,
-);
-    dwIndex  := 0;
-    dwCodeLen := 10;
-    // Hinzugefügt
-    application.ProcessMessages;
-    HttpQueryInfo(hfile,
-                  HTTP_QUERY_STATUS_CODE,
-                  @dwcode,
-                  dwcodeLen,
-                  dwIndex);
-    res := pchar(@dwcode);
-    dwNumber := sizeof(databuffer)-1;
-    if (res ='200') or (res ='302') then
-    begin
-      while (InternetReadfile(hfile,
-                              @databuffer,
-                              dwNumber,
-                              DwRead)) do
-      begin
-        // Hinzugefügt
-        application.ProcessMessages;
-        if dwRead =0 then
-          break;
-        databuffer[dwread]:=#0;
-        Str := pchar(@databuffer);
-        resStr := resStr + Str;
-      end;
-    end
-    else
-      ResStr := 'Status:'+res;
-    if assigned(hfile) then
-      InternetCloseHandle(hfile);
-  end;
-  // Hinzugefügt
-  application.ProcessMessages;
-  InternetCloseHandle(hsession);
-  Result := resStr;
-end;
 { TBackground }
 procedure TBackground.DoMove(MoveCount: Integer);
 var
   ran: integer;
     result := imagelist.Items.Items[Ord(Sprite)-1]
   else
     result := nil;
 end;
+procedure TMainForm.Hilfe1Click(Sender: TObject);
+begin
+  HilfeForm.Caption := TMenuItem(Sender).Caption;
+  HilfeForm.Caption := StringReplace(HilfeForm.Caption, '&&', #1, [rfReplaceAll]);
+  HilfeForm.Caption := StringReplace(HilfeForm.Caption, '&', '', [rfReplaceAll]);
+  HilfeForm.Caption := StringReplace(HilfeForm.Caption, #1, '&', [rfReplaceAll]);
+  HilfeForm.ShowMarkDownHelp(OwnDirectory+'Doku.md');
+  HilfeForm.ShowModal;
+end;
 procedure TMainForm.GamePauseClick(Sender: TObject);
 begin
   GamePause.Checked := not GamePause.Checked;
   DXTimer.Enabled := not GamePause.Checked;
   if GamePause.Checked then
     //application.terminate;
   end;
 end;
 procedure TMainForm.CheckUpdatesClick(Sender: TObject);
-var
-  cont: string;
-begin
-  cont := GetHTML('https://www.viathinksoft.de/update/?id=spacemission');
-  if copy(cont, 0, 7) = 'Status:' then
-  begin
-    Application.MessageBox('Ein Fehler ist aufgetreten. Wahrscheinlich ist keine Internetverbindung aufgebaut, oder der der ViaThinkSoft-Server vorübergehend offline.', 'Fehler', MB_OK + MB_ICONERROR)
-  end
-  else
-  begin
+begin
-    if cont <> ProgramVersion then
+  CheckForUpdates('spacemission');
-    begin
-      if Application.MessageBox('Eine neue Programmversion ist vorhanden. Möchten Sie diese jetzt herunterladen?', 'Information', MB_YESNO + MB_ICONASTERISK) = ID_YES then
-        shellexecute(application.handle, 'open', pchar('https://www.viathinksoft.de/update/?id=@spacemission'), '', '', sw_normal);
-    end
-    else
-    begin
-      Application.MessageBox('Es ist keine neue Programmversion vorhanden.', 'Information', MB_OK + MB_ICONASTERISK);
-    end;
-  end;
 end;
 procedure TMainForm.BeendenClick(Sender: TObject);
 begin
   close;

Subversion Repositories spacemission

spacemission/GamMain.pas – Rev 61 → 63