home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kompon / d123456 / CHEMPLOT.ZIP / Misc / About.pas < prev    next >
Pascal/Delphi Source File  |  2001-07-26  |  14KB  |  423 lines
  1. unit About;
  2.  
  3. {$I Misc.inc}
  4.  
  5. {-----------------------------------------------------------------------------
  6. The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at
  7.  
  8. http://www.mozilla.org/MPL/MPL-1.1.html
  9.  
  10. Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for the specific language governing rights and limitations under the License.
  11.  
  12. The Original Code is: About.pas, released 12 September 2000.
  13.  
  14. The Initial Developer of the Original Code is Mat Ballard.
  15. Portions created by Mat Ballard are Copyright (C) 1999 Mat Ballard.
  16. Portions created by Microsoft are Copyright (C) 1998, 1999 Microsoft Corp.
  17. All Rights Reserved.
  18.  
  19. Contributor(s): Mat Ballard                 e-mail: mat.ballard@chemware.hypermart.net.
  20.  
  21. Last Modified: 07/25/2001
  22. Current Version: 2.00
  23.  
  24. You may retrieve the latest version of this file from:
  25.  
  26.         http://Chemware.hypermart.net/
  27.  
  28. This work was created with the Project JEDI VCL guidelines:
  29.  
  30.         http://www.delphi-jedi.org/Jedi:VCLVCL
  31.  
  32. in mind.
  33.  
  34.  
  35. Purpose:
  36. This form is used to display a standard "About" dialog box with a few extra wrinkles.
  37.  
  38. Known Issues:
  39. -----------------------------------------------------------------------------}
  40.  
  41. interface
  42.  
  43. uses
  44.   Classes, SysUtils,
  45. {$IFDEF WINDOWS}
  46.   WinTypes, WinProcs,
  47.   Buttons, ExtCtrls, Forms, StdCtrls,
  48.   ShellAPI, Graphics, Controls,
  49. {$ENDIF}
  50. {$IFDEF WIN32}
  51.   Windows,
  52.   Buttons, Controls, ExtCtrls, Forms, Graphics, StdCtrls,
  53.   ShellAPI,
  54. {$ENDIF}
  55. {$IFDEF LINUX}
  56.   Libc,
  57.   QButtons, QControls, QExtCtrls, QForms, QGraphics, QStdCtrls,
  58.   QDialogs,
  59. {$ENDIF}
  60.   Fileinfo, Misc;
  61.  
  62. type
  63.   TAboutBox = class(TForm)
  64.     Panel1: TPanel;
  65.     ResourcesLabel: TLabel;
  66.     OSLabel: TLabel;
  67.     URLLabel: TLabel;
  68.     CommentsLabel: TLabel;
  69.     CompanyLabel: TLabel;
  70.     EmailLabel: TLabel;
  71.     MailImage: TImage;
  72.     OSBuildLabel: TLabel;
  73.     OKBitBtn: TBitBtn;
  74.     ProductLabel: TLabel;
  75.     VersionLabel: TLabel;
  76.     CopyrightLabel: TLabel;
  77.     procedure FormCreate(Sender: TObject);
  78.     procedure FormShow(Sender: TObject);
  79.     procedure URLLabelClick(Sender: TObject);
  80.     procedure ProgramIconClick(Sender: TObject);
  81.     procedure EmailLabelClick(Sender: TObject);
  82.   private
  83.     ProgramIcon: TImage;
  84.   public
  85.     procedure DoGeometry;
  86. {$IFNDEF LANG_ENGLISH}
  87.     procedure DoCaptionsFromResource;
  88. {$ENDIF}
  89.     procedure DoHintsFromResource;
  90.   end;
  91.  
  92. var
  93.   AboutBox: TAboutBox;
  94.   {This is the "About" dialog box that TAboutDlg displays
  95.    when its Execute function is called.}
  96.   {}
  97.   {As well as the properties mentioned elsewhere, it also shows the
  98.    free resources and operating system.}
  99.  
  100. {$IFDEF WINDOWS} {Delphi 1}
  101. {procedure Register;}
  102. {$ENDIF}
  103.  
  104. implementation
  105.  
  106. {$R *.dfm}
  107.  
  108. {------------------------------------------------------------------------------
  109.     Procedure: TAboutBox.FormCreate
  110.   Description: standard FormCreate event handler
  111.        Author: Mat Ballard
  112.  Date created: 04/25/2000
  113. Date modified: 04/25/2000 by Mat Ballard
  114.       Purpose: sets various Properties by querying the OS
  115.  Known Issues:
  116.  ------------------------------------------------------------------------------}
  117. procedure TAboutBox.FormCreate(Sender: TObject);
  118. var
  119. {$IFDEF WINDOWS} {Delphi 1}
  120.   OS_Version: Longint;
  121.   DOS, WIN: Integer;
  122.   DOS_Minor, DOS_Major, WIN_Minor, WIN_Major: Integer;
  123. {$ENDIF}
  124. {$IFDEF WIN32}
  125.   Memory_Info: TMEMORYSTATUS;
  126.   Version_Info: TOSVERSIONINFO;
  127.   Info: TFileVersionInfo;
  128. {$ENDIF}
  129. {$IFDEF LINUX}
  130.   MySysInfo: TSysInfo;
  131.   MachineInfo: TUTSName;
  132.   {ResStrings: TStringList;
  133.   ResourceStream: TResourceStream;}
  134. {$ENDIF}
  135. begin
  136.   ProgramIcon := TImage.Create(Self);
  137.   ProgramIcon.Parent := Panel1;
  138.   ProgramIcon.Left := 8;
  139.   ProgramIcon.Top := 8;
  140.   ProgramIcon.Picture.Bitmap.LoadFromResourceID(hInstance, 100);
  141.   ProgramIcon.AutoSize := TRUE;
  142.  
  143. {$IFNDEF LANG_ENGLISH}
  144.   DoCaptionsFromResource;
  145. {$ENDIF}
  146.   DoHintsFromResource;
  147.  
  148.   CommentsLabel.Width := Panel1.Width - CommentsLabel.Left;
  149. {$IFDEF WINDOWS} {Delphi 1}
  150.   ResourcesLabel.Caption :=
  151.     'Free Resources: ' + IntToStr(GetFreeSpace(0) div (1024 * 1024)) + ' M - ' +
  152.     IntToStr(GetFreeSystemResources(0)) + '/' +
  153.     IntToStr(GetFreeSystemResources(1)) + '/' +
  154.     IntToStr(GetFreeSystemResources(2)) + ' %';
  155.  
  156.   OS_Version := GetVersion;
  157.   DOS := OS_Version div 65536;
  158.   WIN := OS_Version - 65536 * DOS;
  159.   DOS_Major := DOS div 256;
  160.   DOS_Minor := DOS - 256 * DOS_Major;
  161.   WIN_Minor := WIN div 256;
  162.   WIN_Major := WIN - 256 * WIN_Minor;
  163.  
  164.   OSLabel.Caption :=
  165.     'DOS ' + sVersion + ': ' + IntToStr(DOS_Major) + '.' + IntToStr(DOS_Minor) +
  166.     ' / Windows' + sVersion + ': ' + IntToStr(WIN_Major) + '.' + IntToStr(WIN_Minor);
  167. {$ENDIF}
  168. {$IFDEF WIN32}
  169.   Memory_Info.dwLength := 32;
  170.   GlobalMemoryStatus(Memory_Info);
  171.  
  172.   {MemoryLabel.Caption := 'Used Memory: ' +
  173.    IntToStr(Memory_Info.dwMemoryLoad) + ' %'; - always zero}
  174.   ResourcesLabel.Caption := sTotal + ' ' + sFree  + ' ' + sMemory + ' ' +
  175.     FloatToStrF(Memory_Info.dwAvailPhys / 1048576.0, ffFixed, 7, 3) + ' / ' +
  176.     FloatToStrF(Memory_Info.dwTotalPhys / 1048576.0, ffFixed, 7, 3) + ' M';
  177.  
  178.   Version_Info.dwOSVersionInfoSize := 148;
  179.   GetVersionEx(Version_Info);
  180.   with Version_Info do
  181.   begin
  182.     Case Version_Info.dwPlatformId of
  183.       VER_PLATFORM_WIN32_WINDOWS:
  184.         begin
  185.           dwBuildNumber := dwBuildNumber and 65535;
  186.           case dwMajorVersion of
  187.             3: OSLabel.Caption := Format(
  188.               'Windows 95 (%d.%d), build %d, ' + String(szCSDVersion),
  189.               [dwMajorVersion, dwMinorVersion, dwBuildNumber]);
  190.             4:
  191.               begin
  192.                 case dwMinorVersion of
  193.                   0:
  194.                     begin
  195.                       OSLabel.Caption := Format(
  196.                         'Windows 95' + String(szCSDVersion) + '(%d.%d)',
  197.                         [dwMajorVersion, dwMinorVersion]);
  198.                       OSBuildLabel.Caption :=
  199.                         Format('build %d' + String(szCSDVersion),
  200.                         [dwBuildNumber]);
  201.                     end;
  202.                   10:
  203.                     begin
  204.                       OSLabel.Caption := 'Windows 98';
  205.                       if (dwBuildNumber = 2222) then
  206.                         OSLabel.Caption := OSLabel.Caption + 'SE';
  207.                       OSLabel.Caption := OSLabel.Caption +
  208.                         Format(' (%d.%d)',
  209.                         [dwMajorVersion, dwMinorVersion]);
  210.                       OSBuildLabel.Caption :=
  211.                         Format('build %d' + String(szCSDVersion),
  212.                         [dwBuildNumber]);
  213.                     end;
  214.                 else
  215.                   begin
  216.                     OSLabel.Caption := Format(
  217.                       'Windows ME (%d.%d)',
  218.                       [dwMajorVersion, dwMinorVersion]);
  219.                     OSBuildLabel.Caption :=
  220.                       Format('build %d' + String(szCSDVersion),
  221.                       [dwBuildNumber]);
  222.                   end;
  223.                 end; {case}
  224.               end; {4}
  225.           end; {case}
  226.         end; {WIN32}
  227.       VER_PLATFORM_WIN32_NT:
  228.         begin
  229.           OSLabel.Caption :=
  230.             Format('Windows NT %d.%d',
  231.             [dwMajorVersion, dwMinorVersion]);
  232.           OSBuildLabel.Caption :=
  233.             Format('build %d' + String(szCSDVersion),
  234.             [dwBuildNumber]);
  235.         end
  236.         else
  237.           OSLabel.Caption := sOSDamnned;
  238.     end;
  239.   end;
  240. {get version information:}
  241.   Info := TFileVersionInfo.Create(self);
  242.   Info.ExecutableFile := Application.ExeName;
  243.   ProductLabel.Caption := Info.ProductName;
  244.   CompanyLabel.Caption := sBy + ' ' + Info.CompanyName;
  245.   VersionLabel.Caption := sVersion + ' ' + Info.FileVersion;
  246.   CopyrightLabel.Caption := Info.LegalCopyright;
  247.   CommentsLabel.Caption := Info.Comments;
  248.   Info.Free;
  249. {$ENDIF}
  250.  
  251.  
  252. {$IFDEF LINUX}
  253.   {ResourceStream := TResourceStream.Create(hInstance, 'fileversion', 'RT_VERSION');
  254.   ResStrings := TStringList.Create;
  255.   //ResourceStream.Read(Pointer(ResString)^, ResourceStream.Size);
  256.   ResStrings.LoadFromStream(ResourceStream);
  257.   ShowMessage(ResStrings.Text);
  258.   //ResStrings.SaveToFile('/home/matb/ResStrings.txt');
  259.   //CompanyLabel.Caption := 'by ' + ResString;
  260.   ResourceStream.Free;
  261.   ResStrings.Free;}
  262.  
  263.   sysinfo(MySysInfo);
  264.   ResourcesLabel.Caption :=
  265.     Format(sFree + '/' + sTotal + '/' + sMemory + ': %d/%d M, %d cpus',
  266.       [MySysInfo.freeram div 1048576,
  267.        MySysInfo.totalram div 1048576,
  268.        get_nprocs]);
  269.   uname(MachineInfo);
  270.   OSLabel.Caption := MachineInfo.sysname + ' ' +
  271.     MachineInfo.release + sOn +
  272.     MachineInfo.machine;
  273.   OSBuildLabel.Caption := MachineInfo.version;
  274. {$ENDIF}
  275. end;
  276.  
  277. {------------------------------------------------------------------------------
  278.     Procedure: TAboutBox.DoCaptionsFromResource
  279.   Description: standard loading of labels from resources
  280.        Author: Mat Ballard
  281.  Date created: 06/25/2001
  282. Date modified: 06/25/2001 by Mat Ballard
  283.       Purpose: display in different languages
  284.  Known Issues:
  285.  ------------------------------------------------------------------------------}
  286. {$IFNDEF LANG_ENGLISH}
  287. procedure TAboutBox.DoCaptionsFromResource;
  288. begin
  289.   OKBitBtn.Caption := sOK;
  290. end;
  291. {$ENDIF}
  292.  
  293. {------------------------------------------------------------------------------
  294.     Procedure: TAboutBox.DoHintsFromResource
  295.   Description: standard loading of hints from resources
  296.        Author: Mat Ballard
  297.  Date created: 06/25/2001
  298. Date modified: 06/25/2001 by Mat Ballard
  299.       Purpose: display hints in different languages
  300.  Known Issues:
  301.  ------------------------------------------------------------------------------}
  302. procedure TAboutBox.DoHintsFromResource;
  303. begin
  304.   URLLabel.Hint := sURLLabelHint;
  305.   EmailLabel.Hint := sEmailLabelHint;
  306.   ProgramIcon.Hint := sProgramIconHint;
  307. end;
  308.  
  309. {------------------------------------------------------------------------------
  310.     Procedure: TAboutBox.DoGeometry
  311.   Description: standard FormShow event handler
  312.        Author: Mat Ballard
  313.  Date created: 04/25/2000
  314. Date modified: 04/25/2000 by Mat Ballard
  315.       Purpose: sets the position on screen
  316.  Known Issues:
  317.  ------------------------------------------------------------------------------}
  318. procedure TAboutBox.DoGeometry;
  319. begin
  320.   URLLabel.Top := ProgramIcon.Top +
  321.     CommentsLabel.Top + CommentsLabel.Height;
  322.   MailImage.Top := URLLabel.Top + URLLabel.Height;
  323.   EmailLabel.Top := ProgramIcon.Top + MailImage.Top;
  324.   ResourcesLabel.Top := ProgramIcon.Top +
  325.     MailImage.Top + MailImage.Height;
  326.   OSLabel.Top := ProgramIcon.Top +
  327.     ResourcesLabel.Top + ResourcesLabel.Height;
  328.   OSBuildLabel.Top := ProgramIcon.Top +
  329.     OSLabel.Top + OSLabel.Height;
  330.   Panel1.Height := ProgramIcon.Top +
  331.     OSBuildLabel.Top + OSBuildLabel.Height;
  332.   OKBitBtn.Top :=
  333.     2*Panel1.Top + Panel1.Height;
  334.  
  335. {$IFDEF MSWINDOWS}
  336.   Self.BorderStyle := bsDialog;
  337. {$ENDIF}
  338. {$IFDEF LINUX}
  339.   Self.BorderStyle := fbsDialog;
  340. {$ENDIF}
  341.  
  342.   Left := Screen.Width - Self.Width div 2;
  343.   Top := Screen.Height - Self.Height div 2;
  344.   ClientHeight := OKBitBtn.Top + 3 * OKBitBtn.Height div 2;
  345.   ClientWidth := Panel1.Left + Panel1.Width + Panel1.Left;
  346.   OKBitBtn.Left := (Self.ClientWidth - OKBitBtn.Width) div 2;
  347. end;
  348.  
  349. {------------------------------------------------------------------------------
  350.     Procedure: TAboutBox.FormShow
  351.   Description: standard FormShow event handler
  352.        Author: Mat Ballard
  353.  Date created: 04/25/2000
  354. Date modified: 04/25/2000 by Mat Ballard
  355.       Purpose: sets the position on screen
  356.  Known Issues:
  357.  ------------------------------------------------------------------------------}
  358. procedure TAboutBox.FormShow(Sender: TObject);
  359. begin
  360.   Left := (Screen.Width - Width) div 2;
  361.   Top := (Screen.Height - Height) div 2;
  362. end;
  363.  
  364. {------------------------------------------------------------------------------
  365.     Procedure: TAboutBox.URLLabelClick
  366.   Description: standard Click handler
  367.        Author: Mat Ballard
  368.  Date created: 04/25/2000
  369. Date modified: 04/25/2000 by Mat Ballard
  370.       Purpose: Fires up the web browser and goes to the specified URL
  371.  Known Issues:
  372.  ------------------------------------------------------------------------------}
  373. procedure TAboutBox.URLLabelClick(Sender: TObject);
  374. var
  375.   TheString : String;
  376. begin
  377.   TheString := URLLabel.Caption;
  378. {$IFDEF LINUX}
  379.   TheString := 'konqueror ' + TheString;
  380. {$ENDIF}
  381.   ShellExec(TheString);
  382. end;
  383.  
  384. {------------------------------------------------------------------------------
  385.     Procedure: TAboutBox.ProgramIconClick
  386.   Description: standard Click handler
  387.        Author: Mat Ballard
  388.  Date created: 04/25/2000
  389. Date modified: 04/25/2000 by Mat Ballard
  390.       Purpose: Fires up the web browser and goes to Borland Delphi
  391.  Known Issues:
  392.  ------------------------------------------------------------------------------}
  393. procedure TAboutBox.ProgramIconClick(Sender: TObject);
  394. begin
  395. {$IFDEF MSWINDOWS}
  396.   ShellExec('http://www.borland.com/delphi/');
  397. {$ENDIF}
  398. {$IFDEF LINUX}
  399.   ShellExec('konqueror http://www.borland.com/kylix/');
  400. {$ENDIF}
  401. end;
  402.  
  403. {------------------------------------------------------------------------------
  404.     Procedure: TAboutBox.EmailLabelClick
  405.   Description: standard Click handler
  406.        Author: Mat Ballard
  407.  Date created: 04/25/2000
  408. Date modified: 04/25/2000 by Mat Ballard
  409.       Purpose: Fires up the web browser and goes to Borland Delphi
  410.  Known Issues:
  411.  ------------------------------------------------------------------------------}
  412. procedure TAboutBox.EmailLabelClick(Sender: TObject);
  413. var
  414.   TheString : String;
  415. begin
  416.   TheString := 'mailto: ' + EmailLabel.Caption;
  417.   ShellExec(TheString);
  418. end;
  419.  
  420.  
  421. end.
  422.  
  423.