VTIStartUnit.pas 2.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596
  1. {
  2. TIGCC IDE
  3. Copyright (C) 2000-2004 Sebastian Reichelt
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2, or (at your option)
  7. any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software Foundation,
  14. Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  15. }
  16. unit VTIStartUnit;
  17. interface
  18. uses
  19. MasterUnit,
  20. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  21. StdCtrls, ExtCtrls;
  22. type
  23. TVTIStartForm = class(TForm)
  24. Label1: TLabel;
  25. CancelButton: TButton;
  26. FindTimer: TTimer;
  27. procedure FormShow(Sender: TObject);
  28. procedure FormClose(Sender: TObject; var Action: TCloseAction);
  29. procedure FindTimerTimer(Sender: TObject);
  30. private
  31. ProcessHandle: THandle;
  32. public
  33. VTIWindow: HWnd;
  34. VTIType: TCurVTIType;
  35. end;
  36. implementation
  37. {$R *.DFM}
  38. uses
  39. UtilsWin;
  40. procedure TVTIStartForm.FormShow(Sender: TObject);
  41. var
  42. StartupInfo: TStartupInfo;
  43. ProcessInfo: TProcessInformation;
  44. begin
  45. FillChar (StartupInfo, SizeOf (StartupInfo), 0);
  46. StartupInfo.cb := SizeOf (StartupInfo);
  47. if CreateProcess (nil, PChar (VTIPath), nil, nil, False, CREATE_NEW_PROCESS_GROUP or DETACHED_PROCESS, nil, PChar (ExtractFilePath (VTIPath)), StartupInfo, ProcessInfo) then begin
  48. ProcessHandle := ProcessInfo.hProcess;
  49. CloseHandle (ProcessInfo.hThread);
  50. end else begin
  51. ShowDefaultMessageBox ('An error occurred while trying to start Virtual TI.', 'Error', mtProgramError);
  52. ModalResult := mrAbort;
  53. end;
  54. end;
  55. procedure TVTIStartForm.FormClose(Sender: TObject;
  56. var Action: TCloseAction);
  57. begin
  58. if ProcessHandle <> 0 then
  59. CloseHandle (ProcessHandle);
  60. end;
  61. procedure TVTIStartForm.FindTimerTimer(Sender: TObject);
  62. var
  63. ExitCode: Cardinal;
  64. begin
  65. if GetExitCodeProcess (ProcessHandle, ExitCode) then begin
  66. if ExitCode <> STILL_ACTIVE then begin
  67. ModalResult := mrAbort;
  68. Exit;
  69. end;
  70. end;
  71. VTIWindow := FindWindow ('TEmuWnd', 'Virtual TI-89');
  72. if VTIWindow = 0 then begin
  73. VTIWindow := FindWindow ('TEmuWnd', 'Virtual TI-92+');
  74. if VTIWindow <> 0 then
  75. VTIType := cvTI92Plus;
  76. end else
  77. VTIType := cvTI89;
  78. if VTIWindow <> 0 then
  79. ModalResult := mrOK;
  80. end;
  81. end.