Chip 2001 September/Chip_2001-09_cd1.bin/zkuste/delphi/kolekce/d12345/MISC.ZIP/Splash.pas

Pascal/Delphi Source File | 2001-05-02 | 6.1 KB | 219 lines

unit Splash;

{-----------------------------------------------------------------------------
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

http://www.mozilla.org/MPL/MPL-1.1.html

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.

The Original Code is: Splash.pas, released 12 September 2000.

The Initial Developer of the Original Code is Mat Ballard.
Portions created by Mat Ballard are Copyright (C) 1999 Mat Ballard.
Portions created by Microsoft are Copyright (C) 1998, 1999 Microsoft Corp.
All Rights Reserved.

Contributor(s): Mat Ballard                 e-mail: [e-mail].

Last Modified: 05/25/2000
Current Version: 2.00

You may retrieve the latest version of this file from:

        http://Chemware.hypermart.net/

This work was created with the Project JEDI VCL guidelines:

        http://www.delphi-jedi.org/Jedi:VCLVCL

in mind.


Purpose:
This file contains the SplashBox form.
This form is used to display a standard "Splash" dialog box with a few extra wrinkles.

Known Issues:
-----------------------------------------------------------------------------}

interface

uses
  FileInfo,
  Classes, SysUtils, IniFiles,
{$IFDEF WINDOWS}
  WinTypes, WinProcs, ShellAPI,
  Buttons, Controls, ExtCtrls, Forms, Graphics, StdCtrls
{$ENDIF}
{$IFDEF WIN32}
  Windows, ShellAPI,
  Buttons, Controls, ExtCtrls, Forms, Graphics, StdCtrls
{$ENDIF}
{$IFDEF LINUX}
  QTypes,
  QButtons, QControls, QExtCtrls, QForms, QGraphics, QStdCtrls
{$ENDIF}
  ;

type
  TSplashBox = class(TForm)
    Panel1: TPanel;
    ProgramIcon: TImage;
    ProductLabel: TLabel;
    VersionLabel: TLabel;
    CopyrightLabel: TLabel;
    URLLabel: TLabel;
    CommentsLabel: TLabel;
    LeftImage: TImage;
    RightImage: TImage;
    PriceLabel: TLabel;
    AgreeBitBtn: TBitBtn;
    DisagreeBitBtn: TBitBtn;
    ViewLicenseBitBtn: TBitBtn;
    CompanyLabel: TLabel;
    Timer1: TTimer;
    procedure FormShow(Sender: TObject);
    procedure URLLabelClick(Sender: TObject);
    procedure OpenObject(sObjectPath : PChar);
    procedure ProgramIconClick(Sender: TObject);
    procedure ViewLicenseBitBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    Registered: Boolean;
    CompanyName: String;
    procedure GetRegistration;
  public
    { Public declarations }
  end;

var
  SplashBox: TSplashBox;
  {This is the "Splash" dialog box that TSplashDlg displays
   when its Execute function is called.}
  {}
  {As well as the properties mentioned elsewhere, it also shows the
   free resources and operating system.}

implementation

{$R *.dfm}

{------------------------------------------------------------------------------
    Procedure: TSplashBox.FormShow
  Description: standard FormShow event handler
       Author: Mat Ballard
 Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
      Purpose: sets the Position on screen
 Known Issues:
 ------------------------------------------------------------------------------}
procedure TSplashBox.FormShow(Sender: TObject);
begin
  Left := (Screen.Width - Width) div 2;
  Top := (Screen.Height - Height) div 2;
end;

procedure TSplashBox.URLLabelClick(Sender: TObject);
var
  TempString : array[0..255] of char;
begin
  StrPCopy(TempString,URLLabel.Caption);
  OpenObject(TempString);
end;

procedure TSplashBox.OpenObject(sObjectPath : PChar);
begin
{$IFDEF WINDOWS}
  ShellExecute(0, Nil, sObjectPath, Nil, Nil, 3);  {?SW_SHOW ?}
{$ENDIF}
{$IFDEF WIN32}
  ShellExecute(0, Nil, sObjectPath, Nil, Nil, SW_NORMAL);
{$ENDIF}
{$IFDEF LINUX}
  //
{$ENDIF}
end;

procedure TSplashBox.ProgramIconClick(Sender: TObject);
begin
  OpenObject('http://www.borland.com/delphi/');
end;

procedure TSplashBox.ViewLicenseBitBtnClick(Sender: TObject);
begin
{$IFDEF MSWINDOWS}
  Application.HelpContext(HelpContext);
  //Application.HelpJump(HelpContext);
{$ENDIF}
end;

procedure TSplashBox.FormCreate(Sender: TObject);
var
  Info: TFileVersionInfo;
begin
{$IFDEF MSWINDOWS}
  //Self.PixelsPerInch := 96;
  Self.BorderStyle := bsDialog;
{$ENDIF}
{$IFDEF LINUX}
  //Self.PixelsPerInch := 75;
  Self.BorderStyle := fbsDialog;
{$ENDIF}

  Left := Screen.Width - Self.Width div 2;
  Top := Screen.Height - Self.Height div 2;
  ClientHeight := AgreeBitBtn.Top + 3 * AgreeBitBtn.Height div 2;
  ClientWidth := Panel1.Left + Panel1.Width + Panel1.Left;
  AgreeBitBtn.Left := (Self.ClientWidth - AgreeBitBtn.Width) div 2;

{get version information:}
  Info := TFileVersionInfo.Create(self);
  Info.ExecutableFile := Application.ExeName;
  ProductLabel.Caption := Info.ProductName;
  CompanyName := Info.CompanyName;
  CompanyLabel.Caption := 'by ' + Info.CompanyName;
  VersionLabel.Caption := 'Version ' + Info.FileVersion;
  CopyrightLabel.Caption := Info.LegalCopyright;
  CommentsLabel.Caption := Info.Comments;
  Info.Free;
  GetRegistration;
end;

procedure TSplashBox.Timer1Timer(Sender: TObject);
begin
  ModalResult := mrOk;
end;

procedure TSplashBox.GetRegistration;
var
  Reg: TIniFile;
  FileName: String;
  Value: String;
begin
  FileName := Copy(Application.ExeName, 1, Length(Application.ExeName)-4) +
    'ini';
  Reg := TIniFile.Create(FileName);
  Try
    Value := Reg.ReadString(CompanyName, 'Registered', '0');
    if (Value = '1') then
    begin
      Registered := TRUE;
      PriceLabel.Caption := 'Registered to ' + #13+#10 +
        Reg.ReadString(CompanyName, 'Username', 'UnRegistered');
      LeftImage.Visible := FALSE;
      RightImage.Visible := FALSE;
      PriceLabel.Left := LeftImage.Left;
      PriceLabel.Width := RightImage.Left + RightImage.Width - LeftImage.Left;
    end;
  finally
    Reg.Free;
  end;
end;


end.