www.pudn.com > yrsCapture.zip > about.pas

{******************************************************************************} 
{*                                                                            *} 
{*                 Adirondack Software & Graphics About Unit                  *} 
{*           (C) Copyright Adirondack Software & Graphics 1997-1998           *} 
{*                                                                            *} 
{******************************************************************************} 
 
unit About; 
 
interface 
 
uses Windows, SysUtils, Classes, Dialogs, Graphics, Forms, Controls, StdCtrls, 
  Buttons, ExtCtrls, RXCtrls, ComCtrls, URL, mmlabel, NetGradient; 
 
type 
  TAboutBox1 = class( TForm ) 
    PageControl1: TPageControl; 
    TabSheet1: TTabSheet; 
    ProgramLabel2: TLabel; 
    ProgramLabel: TLabel; 
    Version: TLabel; 
    Copyright: TLabel; 
    Bevel1: TBevel; 
    Label3: TLabel; 
    FreeMemory: TLabel; 
    Label4: TLabel; 
    FreeRes: TLabel; 
    Comments: TLabel; 
    Label1: TLabel; 
    Label2: TLabel; 
    WinVersion: TLabel; 
    Processor: TLabel; 
    Label5: TLabel; 
    PhysicalMemory: TLabel; 
    Image2: TImage; 
    Label11: TLabel; 
    TabSheet2: TTabSheet; 
    OKButton: TButton; 
    SecretPanel1: TSecretPanel; 
    MMLabel2: TMMLabel; 
    SpeedButton1: TSpeedButton; 
    NetGradient1: TNetGradient; 
    MMLabel1: TMMLabel; 
    URL1: TURL; 
    SpeedButton2: TSpeedButton; 
    procedure FormCreate( Sender: TObject ); 
    procedure OKButtonClick( Sender: TObject ); 
    procedure FormActivate( Sender: TObject ); 
    procedure TrackBar1Change(Sender: TObject); 
    procedure MMLabel1Click(Sender: TObject); 
    procedure SpeedButton1Click(Sender: TObject); 
    procedure PageControl1Change(Sender: TObject); 
    procedure SpeedButton2Click(Sender: TObject); 
    procedure MMLabel2Click(Sender: TObject); 
  private 
    { Private declarations } 
  public 
    { Public declarations } 
  end; 
 
var 
  AboutBox1: TAboutBox1; 
 
implementation 
 
uses MAIN; 
 
{$R *.DFM} 
 
{==============================================================================} 
procedure TAboutBox1.FormCreate( Sender: TObject ); 
{==============================================================================} 
const 
PlatNames: array[0..2] of string = ( 'Win32s', 'Windows 95', 'Windows NT' ); 
var 
  OVI: TOsVersionInfo; 
  SI: TSystemInfo; 
begin 
  { Replace programicon with application's icon } 
  { Programicon.Picture.Graphic := Application.Icon; } 
  { Get windows version } 
  OVI.dwOSVersionInfoSize := Sizeof( OVI ); 
  GetVersionEx( OVI ); 
  WinVersion.Caption := Format( '%s, version %u.%.2u',[Platnames[OVI.dwPlatformID],OVI.dwMajorVersion,OVI.dwMinorVersion] ); 
  { Get system information } 
  GetSystemInfo( SI ); 
  case SI.dwProcessorType of 
       386: Processor.Caption := '80386'; 
       486: Processor.Caption := '80486'; 
       586: Processor.Caption := 'Pentium'; 
       else  Processor.Caption := 'Unknown processor' + InttoStr( SI.dwProcessorType ); 
  end; {case} 
  ProgramLabel.Caption := 'Apprehend98'; 
  ProgramLabel2.Caption := 'Apprehend98'; 
  Version.Caption :=  'Version 2 for Windows 95 and Delphi 3'; 
  Copyright.Caption :=  '© 1996-98 Adirondack Software && Graphics'; 
  Comments.Caption := ''; 
end; 
 
{==============================================================================} 
procedure TAboutBox1.OKButtonClick( Sender: TObject ); 
{==============================================================================} 
begin 
   Close; 
end; 
 
{==============================================================================} 
procedure TAboutBox1.FormActivate( Sender: TObject ); 
{==============================================================================} 
var 
TMS: TMemoryStatus; 
begin 
     { Get memory status info } 
     TMS.dwLength := Sizeof( TMS ); 
     GlobalMemoryStatus( TMS ); 
     PhysicalMemory.Caption := FormatFloat( '#," MB"', ( TMS.dwTotalPhys ) / 1048576 ); 
     FreeMemory.Caption := FormatFloat( '#," KB Free"', ( TMS.dwTotalPhys + TMS.dwAvailPageFile ) / 1024 ); 
     FreeRes.Caption := Format( '%d %%', [TMS.dwMemoryLoad] ); 
end; 
 
{==============================================================================} 
procedure TAboutBox1.TrackBar1Change(Sender: TObject); 
{==============================================================================} 
begin 
end; 
 
{==============================================================================} 
procedure TAboutBox1.MMLabel1Click(Sender: TObject); 
{==============================================================================} 
begin 
   ShowMessage('To order the shareware version of Apprehend98 with source code '+ 
  'please send $24.95 or $19.95 US(without source code, registration only) to '+ 
  'Adirondack Software && Graphics, 460 Rock Avenue, Chestertown New York 12817.  '+ 
  'Email your request for registration along with your email address.  '+ 
  'When the funds are received you will be sent a zipfile via internet mail.'+ 
  'The latest version is always available at the Apprehend98 Web Page.'); 
  Screen.Cursor := crHourglass; 
  URL1.URL := 'www.software.adirondack.ny.us'; 
  URL1.URLType := utHttp; 
  URL1.Execute; 
  Screen.Cursor := crDefault; 
end; 
 
{==============================================================================} 
procedure TAboutBox1.SpeedButton1Click(Sender: TObject); 
{==============================================================================} 
begin 
 if SpeedButton1.Down then 
   SecretPanel1.Interval := 0 
   else 
     SecretPanel1.Interval := 1; 
end; 
 
{==============================================================================} 
procedure TAboutBox1.PageControl1Change(Sender: TObject); 
{==============================================================================} 
begin 
if PageControl1.ActivePage = Tabsheet2 then begin 
   SpeedButton1.Visible := True; 
   SpeedButton2.Visible := True; 
 end 
 else 
 begin 
   SpeedButton1.Visible := False; 
   SpeedButton2.Visible := False; 
 end; 
end; 
 
{==============================================================================} 
procedure TAboutBox1.SpeedButton2Click(Sender: TObject); 
{==============================================================================} 
begin 
   SecretPanel1.Active := not SecretPanel1.Active; 
end; 
 
{==============================================================================} 
procedure TAboutBox1.MMLabel2Click(Sender: TObject); 
{==============================================================================} 
begin 
  URL1.URL := 'w2m@netheaven.com'; 
  URL1.URLType := utMailTo; 
  URL1.Execute; 
end; 
 
end.