home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d12345 / MISC.ZIP / About.pas < prev    next >
Pascal/Delphi Source File  |  2001-05-02  |  12KB  |  372 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: 05/25/2000
  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.   Fileinfo,
  45.   Classes, SysUtils,
  46. {$IFDEF WINDOWS}
  47.   WinTypes, WinProcs,
  48.   Buttons, ExtCtrls, Forms, StdCtrls,
  49.   ShellAPI, Graphics, Controls, 
  50. {$ENDIF}
  51. {$IFDEF WIN32}
  52.   Windows,
  53.   Buttons, Controls, ExtCtrls, Forms, Graphics, StdCtrls,
  54.   ShellAPI,
  55. {$ENDIF}
  56. {$IFDEF LINUX}
  57.   Libc,
  58.   QButtons, QControls, QExtCtrls, QForms, QGraphics, QStdCtrls,
  59. {$ENDIF}
  60.   Misc;
  61.  
  62. type
  63.   TAboutBox = class(TForm)
  64.     Panel1: TPanel;
  65.     ProgramIcon: TImage;
  66.     ProductLabel: TLabel;
  67.     VersionLabel: TLabel;
  68.     CopyrightLabel: TLabel;
  69.     ResourcesLabel: TLabel;
  70.     OSLabel: TLabel;
  71.     URLLabel: TLabel;
  72.     CommentsLabel: TLabel;
  73.     CompanyLabel: TLabel;
  74.     EmailLabel: TLabel;
  75.     MailImage: TImage;
  76.     OSBuildLabel: TLabel;
  77.     OKBitBtn: TBitBtn;
  78.     procedure FormCreate(Sender: TObject);
  79.     procedure FormShow(Sender: TObject);
  80.     procedure URLLabelClick(Sender: TObject);
  81.     procedure ProgramIconClick(Sender: TObject);
  82.     procedure EmailLabelClick(Sender: TObject);
  83.   private
  84.     
  85.   public
  86.     procedure DoGeometry;
  87.   end;
  88.  
  89. var
  90.   AboutBox: TAboutBox;
  91.   {This is the "About" dialog box that TAboutDlg displays
  92.    when its Execute function is called.}
  93.   {}
  94.   {As well as the properties mentioned elsewhere, it also shows the
  95.    free resources and operating system.}
  96.  
  97. {$IFDEF WINDOWS} {Delphi 1}
  98. {procedure Register;}
  99. {$ENDIF}
  100.  
  101. implementation
  102.  
  103. {$R *.dfm}
  104.  
  105. {------------------------------------------------------------------------------
  106.     Procedure: TAboutBox.FormCreate
  107.   Description: standard FormCreate event handler
  108.        Author: Mat Ballard
  109.  Date created: 04/25/2000
  110. Date modified: 04/25/2000 by Mat Ballard
  111.       Purpose: sets various Properties by querying the OS
  112.  Known Issues:
  113.  ------------------------------------------------------------------------------}
  114. procedure TAboutBox.FormCreate(Sender: TObject);
  115. var
  116. {$IFDEF WINDOWS} {Delphi 1}
  117.   OS_Version: Longint;
  118.   DOS, WIN: Integer;
  119.   DOS_Minor, DOS_Major, WIN_Minor, WIN_Major: Integer;
  120. {$ENDIF}
  121. {$IFDEF WIN32}
  122.   Memory_Info: TMEMORYSTATUS;
  123.   Version_Info: TOSVERSIONINFO;
  124.   Info: TFileVersionInfo;
  125. {$ENDIF}
  126. {$IFDEF LINUX}
  127.   MySysInfo: TSysInfo;
  128.   MachineInfo: TUTSName;
  129.   {ResString;
  130.   ResourceStream: TResourceStream;}
  131. {$ENDIF}
  132. begin
  133.   CommentsLabel.Width := Panel1.Width - CommentsLabel.Left;
  134. {$IFDEF WINDOWS} {Delphi 1}
  135.   ResourcesLabel.Caption :=
  136.     'Free Resources: ' + IntToStr(GetFreeSpace(0) div (1024 * 1024)) + ' M - ' +
  137.     IntToStr(GetFreeSystemResources(0)) + '/' +
  138.     IntToStr(GetFreeSystemResources(1)) + '/' +
  139.     IntToStr(GetFreeSystemResources(2)) + ' %';
  140.  
  141.   OS_Version := GetVersion;
  142.   DOS := OS_Version div 65536;
  143.   WIN := OS_Version - 65536 * DOS;
  144.   DOS_Major := DOS div 256;
  145.   DOS_Minor := DOS - 256 * DOS_Major;
  146.   WIN_Minor := WIN div 256;
  147.   WIN_Major := WIN - 256 * WIN_Minor;
  148.  
  149.   OSLabel.Caption :=
  150.     'DOS Version: ' + IntToStr(DOS_Major) + '.' + IntToStr(DOS_Minor) +
  151.     ' / Windows Version: ' + IntToStr(WIN_Major) + '.' + IntToStr(WIN_Minor);
  152. {$ENDIF}
  153. {$IFDEF WIN32}
  154.   Memory_Info.dwLength := 32;
  155.   GlobalMemoryStatus(Memory_Info);
  156.  
  157.   {MemoryLabel.Caption := 'Used Memory: ' +
  158.    IntToStr(Memory_Info.dwMemoryLoad) + ' %'; - always zero}
  159.   ResourcesLabel.Caption := 'Total Free RAM: ' +
  160.    FloatToStrF(Memory_Info.dwAvailPhys / 1048576.0, ffFixed, 7, 3) + ' / ' +
  161.    FloatToStrF(Memory_Info.dwTotalPhys / 1048576.0, ffFixed, 7, 3) + ' M';
  162.  
  163.   Version_Info.dwOSVersionInfoSize := 148;
  164.   GetVersionEx(Version_Info);
  165.   with Version_Info do
  166.   begin
  167.     Case Version_Info.dwPlatformId of
  168.       VER_PLATFORM_WIN32_WINDOWS:
  169.         begin
  170.           dwBuildNumber := dwBuildNumber and 65535;
  171.           case dwMajorVersion of
  172.             3: OSLabel.Caption := Format(
  173.               'Windows 95 (%d.%d), build %d, ' + String(szCSDVersion),
  174.               [dwMajorVersion, dwMinorVersion, dwBuildNumber]);
  175.             4:
  176.               begin
  177.                 case dwMinorVersion of
  178.                   0:
  179.                     begin
  180.                       OSLabel.Caption := Format(
  181.                         'Windows 95' + String(szCSDVersion) + '(%d.%d)',
  182.                         [dwMajorVersion, dwMinorVersion]);
  183.                       OSBuildLabel.Caption :=
  184.                         Format('build %d' + String(szCSDVersion),
  185.                         [dwBuildNumber]);
  186.                     end;
  187.                   10:
  188.                     begin
  189.                       OSLabel.Caption := 'Windows 98';
  190.                       if (dwBuildNumber = 2222) then
  191.                         OSLabel.Caption := OSLabel.Caption + 'SE';
  192.                       OSLabel.Caption := OSLabel.Caption +
  193.                         Format(' (%d.%d)',
  194.                         [dwMajorVersion, dwMinorVersion]);
  195.                       OSBuildLabel.Caption :=
  196.                         Format('build %d' + String(szCSDVersion),
  197.                         [dwBuildNumber]);
  198.                     end;
  199.                 else
  200.                   begin
  201.                     OSLabel.Caption := Format(
  202.                       'Windows ME (%d.%d)',
  203.                       [dwMajorVersion, dwMinorVersion]);
  204.                     OSBuildLabel.Caption :=
  205.                       Format('build %d' + String(szCSDVersion),
  206.                       [dwBuildNumber]);
  207.                   end;
  208.                 end; {case}
  209.               end; {4}
  210.           end; {case}
  211.         end; {WIN32}
  212.       VER_PLATFORM_WIN32_NT:
  213.         begin
  214.           OSLabel.Caption :=
  215.             Format('Windows NT %d.%d',
  216.             [dwMajorVersion, dwMinorVersion]);
  217.           OSBuildLabel.Caption :=
  218.             Format('build %d' + String(szCSDVersion),
  219.             [dwBuildNumber]);
  220.         end
  221.         else
  222.           OSLabel.Caption := 'OS: Damnned if I know !';
  223.     end;
  224.   end;
  225. {get version information:}
  226.   Info := TFileVersionInfo.Create(self);
  227.   Info.ExecutableFile := Application.ExeName;
  228.   ProductLabel.Caption := Info.ProductName;
  229.   CompanyLabel.Caption := 'by ' + Info.CompanyName;
  230.   VersionLabel.Caption := 'Version ' + Info.FileVersion;
  231.   CopyrightLabel.Caption := Info.LegalCopyright;
  232.   CommentsLabel.Caption := Info.Comments;
  233.   Info.Free;
  234. {$ENDIF}
  235.  
  236.  
  237. {$IFDEF LINUX}
  238.   {ResourceStream := TResourceStream.Create(Application.Handle, 'Company', RT_VERSION);
  239.   ResourceStream.Read(Pointer(ResString)^, ResourceStream.Size);
  240.   CompanyLabel.Caption := 'by ' + ResString;
  241.   ResourceStream.Free;}
  242.  
  243.   sysinfo(MySysInfo);
  244.   ResourcesLabel.Caption :=
  245.     Format('Free/Total RAM: %d/%d M, %d cpus',
  246.       [MySysInfo.freeram div 1048576,
  247.        MySysInfo.totalram div 1048576,
  248.        get_nprocs]);
  249.   uname(MachineInfo);
  250.   with MachineInfo do
  251.   begin
  252.     OSLabel.Caption := sysname + ' ' + release + ' on ' + machine;
  253.     OSBuildLabel.Caption := version;
  254.   end;
  255. {$ENDIF}
  256. end;
  257.  
  258. {------------------------------------------------------------------------------
  259.     Procedure: TAboutBox.DoGeometry
  260.   Description: standard FormShow event handler
  261.        Author: Mat Ballard
  262.  Date created: 04/25/2000
  263. Date modified: 04/25/2000 by Mat Ballard
  264.       Purpose: sets the position on screen
  265.  Known Issues:
  266.  ------------------------------------------------------------------------------}
  267. procedure TAboutBox.DoGeometry;
  268. begin
  269.   URLLabel.Top := ProgramIcon.Top +
  270.     CommentsLabel.Top + CommentsLabel.Height;
  271.   MailImage.Top := URLLabel.Top + URLLabel.Height;
  272.   EmailLabel.Top := ProgramIcon.Top + MailImage.Top;
  273.   ResourcesLabel.Top := ProgramIcon.Top +
  274.     MailImage.Top + MailImage.Height;
  275.   OSLabel.Top := ProgramIcon.Top +
  276.     ResourcesLabel.Top + ResourcesLabel.Height;
  277.   OSBuildLabel.Top := ProgramIcon.Top +
  278.     OSLabel.Top + OSLabel.Height;
  279.   Panel1.Height := ProgramIcon.Top +
  280.     OSBuildLabel.Top + OSBuildLabel.Height;
  281.   OKBitBtn.Top :=
  282.     2*Panel1.Top + Panel1.Height;
  283.  
  284. {$IFDEF MSWINDOWS}
  285.   Self.BorderStyle := bsDialog;
  286. {$ENDIF}
  287. {$IFDEF LINUX}
  288.   Self.BorderStyle := fbsDialog;
  289. {$ENDIF}
  290.  
  291.   Left := Screen.Width - Self.Width div 2;
  292.   Top := Screen.Height - Self.Height div 2;
  293.   ClientHeight := OKBitBtn.Top + 3 * OKBitBtn.Height div 2;
  294.   ClientWidth := Panel1.Left + Panel1.Width + Panel1.Left;
  295.   OKBitBtn.Left := (Self.ClientWidth - OKBitBtn.Width) div 2;
  296. end;
  297.  
  298. {------------------------------------------------------------------------------
  299.     Procedure: TAboutBox.FormShow
  300.   Description: standard FormShow event handler
  301.        Author: Mat Ballard
  302.  Date created: 04/25/2000
  303. Date modified: 04/25/2000 by Mat Ballard
  304.       Purpose: sets the position on screen
  305.  Known Issues:
  306.  ------------------------------------------------------------------------------}
  307. procedure TAboutBox.FormShow(Sender: TObject);
  308. begin
  309.   Left := (Screen.Width - Width) div 2;
  310.   Top := (Screen.Height - Height) div 2;
  311. end;
  312.  
  313. {------------------------------------------------------------------------------
  314.     Procedure: TAboutBox.URLLabelClick
  315.   Description: standard Click handler
  316.        Author: Mat Ballard
  317.  Date created: 04/25/2000
  318. Date modified: 04/25/2000 by Mat Ballard
  319.       Purpose: Fires up the web browser and goes to the specified URL
  320.  Known Issues:
  321.  ------------------------------------------------------------------------------}
  322. procedure TAboutBox.URLLabelClick(Sender: TObject);
  323. var
  324.   TheString : String;
  325. begin
  326.   TheString := URLLabel.Caption;
  327. {$IFDEF LINUX}
  328.   TheString := 'konqueror ' + TheString;
  329. {$ENDIF}
  330.   ShellExec(TheString);
  331. end;
  332.  
  333. {------------------------------------------------------------------------------
  334.     Procedure: TAboutBox.ProgramIconClick
  335.   Description: standard Click handler
  336.        Author: Mat Ballard
  337.  Date created: 04/25/2000
  338. Date modified: 04/25/2000 by Mat Ballard
  339.       Purpose: Fires up the web browser and goes to Borland Delphi
  340.  Known Issues:
  341.  ------------------------------------------------------------------------------}
  342. procedure TAboutBox.ProgramIconClick(Sender: TObject);
  343. begin
  344. {$IFDEF MSWINDOWS}
  345.   ShellExec('http://www.borland.com/delphi/');
  346. {$ENDIF}
  347. {$IFDEF LINUX}
  348.   ShellExec('konqueror http://www.borland.com/kylix/');
  349. {$ENDIF}
  350. end;
  351.  
  352. {------------------------------------------------------------------------------
  353.     Procedure: TAboutBox.EmailLabelClick
  354.   Description: standard Click handler
  355.        Author: Mat Ballard
  356.  Date created: 04/25/2000
  357. Date modified: 04/25/2000 by Mat Ballard
  358.       Purpose: Fires up the web browser and goes to Borland Delphi
  359.  Known Issues:
  360.  ------------------------------------------------------------------------------}
  361. procedure TAboutBox.EmailLabelClick(Sender: TObject);
  362. var
  363.   TheString : String;
  364. begin
  365.   TheString := 'mailto: ' + EmailLabel.Caption;
  366.   ShellExec(TheString);
  367. end;
  368.  
  369.  
  370. end.
  371.  
  372.