Delphi控件源码

开发平台：
Delphi

mmabout.pas：源码内容
							{========================================================================}
{=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
{========================================================================}
{=                          All Rights Reserved                         =}
{========================================================================}
{=  D 01099 Dresden             = Fax.: +49 (0)351-8037944              =}
{=  Loewenstr.7a                = info@swiftsoft.de                     =}
{========================================================================}
{=  Actual versions on http://www.swiftsoft.de/mmtools.html             =}
{========================================================================}
{=  This code is for reference purposes only and may not be copied or   =}
{=  distributed in any format electronic or otherwise except one copy   =}
{=  for backup purposes.                                                =}
{=                                                                      =}
{=  No Delphi Component Kit or Component individually or in a collection=}
{=  subclassed or otherwise from the code in this unit, or associated   =}
{=  .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed     =}
{=  without express permission from SwiftSoft.                          =}
{=                                                                      =}
{=  For more licence informations please refer to the associated        =}
{=  HelpFile.                                                           =}
{========================================================================}
{=  $Date: 12.08.98 - 14:59:47 $                                        =}
{========================================================================}
unit MMAbout;
{$I COMPILER.INC}
{$C PRELOAD}
interface
uses
    {$IFDEF WIN32}
    Windows,
    ShellApi,
    {$ELSE}
    WinTypes,
    WinProcs,
    ToolHelp,
    {$ENDIF}
    SysUtils,
    Classes,
    Graphics,
    Forms,
    Controls,
    StdCtrls,
    Buttons,
    ExtCtrls,
    CRightC;
type
  {-- TMMAboutBox -------------------------------------------------------}
  TMMAboutBox = class(TForm)
    Panel1: TPanel;
    OKButton: TButton;
    Panel2: TPanel;
    Image1: TImage;
    Copyright1: TLabel;
    Address4: TLabel;
    Copyright2: TLabel;
    Label2: TLabel;
    Address5: TLabel;
    Timer1: TTimer;
    Label4: TLabel;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormShow(Sender: TObject);
    procedure Address4Click(Sender: TObject);
    procedure Address5Click(Sender: TObject);
  private
    AboutCount: integer;
  end;
var
  MMAboutBox: TMMAboutBox;
procedure Show_AboutBox(Time: integer);
procedure Show_AboutBoxEx(Time: integer);
procedure Show_EvalAboutBox(Time: integer);
implementation
uses MMObj,MMUtils;
{$R *.DFM}
const
  AboutCounter: integer = 5;
  AboutCalls  : integer = 0;
{-------------------------------------------------------------------------}
procedure TMMAboutBox.FormCreate(Sender: TObject);
begin
   AboutCount := AboutCounter;
   {$IFDEF WIN32}
   Address4.Font.Color := clNavy;
   Address4.Font.Style := Address4.Font.Style + [fsUnderline];
   Address4.Cursor     := crsHand1;
   Address5.Font.Color := clNavy;
   Address5.Font.Style := Address5.Font.Style + [fsUnderline];
   Address5.Cursor     := crsHand1;
   {$ENDIF}
end;
{-------------------------------------------------------------------------}
procedure TMMAboutBox.FormShow(Sender: TObject);
begin
   if (AboutCount = 0) then
   begin
      OKButton.Enabled := True;
   end
   else Timer1.Enabled := True;
end;
{-------------------------------------------------------------------------}
procedure TMMAboutBox.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
   if AboutCount > 0 then CanClose := False
   else CanClose := True;
end;
{-------------------------------------------------------------------------}
procedure TMMAboutBox.Timer1Timer(Sender: TObject);
begin
   if (AboutCount > 0) then dec(AboutCount);
   if (AboutCount = 0) then
   begin
      OKButton.Enabled := True;
      Timer1.Enabled := False;
   end;
end;
{-------------------------------------------------------------------------}
procedure TMMAboutBox.Address4Click(Sender: TObject);
var
   S: string;
begin
   {$IFDEF WIN32}
   S := 'mailto:'+Address4.Caption;
   ShellExecute(0, nil, PChar(S), nil, nil, SW_SHOWDEFAULT);
   {$ENDIF}
end;
{-------------------------------------------------------------------------}
procedure TMMAboutBox.Address5Click(Sender: TObject);
var
   S: string;
begin
   {$IFDEF WIN32}
   S := Address5.Caption;
   ShellExecute(0, nil, PChar(S), nil, nil, SW_SHOWDEFAULT);
   {$ENDIF}
end;
{$IFDEF TRIAL}
{-------------------------------------------------------------------------}
procedure Show_NoIDEMessage;
var
   aBuf: array[0..255] of Char;
begin
     with TMMAboutBox.Create(NIL) do
     try
//        Copyright1.Caption := CRightC.Copyright2;
        ShowModal;
     finally
        Free;
     end;
     Application.MessageBox(StrPCopy(aBuf,'IDE not found. Please register !'),
                                          'Multimedia Tools', MB_OK);
     Halt;
end;
{-------------------------------------------------------------------------}
procedure Show_TimeExpired;
var
   aBuf: array[0..255] of Char;
begin
     with TMMAboutBox.Create(NIL) do
     try
//        Copyright1.Caption := CRightC.Copyright2;
        ShowModal;
     finally
        Free;
     end;
     Application.MessageBox(StrPCopy(aBuf,'Your evalution period has expired. Please register !'),
                                          'Multimedia Tools', MB_OK);
     Halt;
end;
{$ENDIF}
{-------------------------------------------------------------------------}
procedure Show_AboutBox(Time: integer);
begin
     with TMMAboutBox.Create(nil) do
     try
        { Copyright1.Caption := CRightC.Copyright2; }
        AboutCount := Time;
        ShowModal;
     finally
        Free;
     end;
end;
{-------------------------------------------------------------------------}
procedure Show_AboutBoxEx(Time: integer);
begin
   inc(AboutCalls);
   if (AboutCalls = 1) then Show_AboutBox(Time);
end;
{-------------------------------------------------------------------------}
procedure Show_EvalAboutBox(Time: integer);
begin
     with TMMAboutBox.Create(nil) do
     try
        { Copyright1.Caption := CRightC.Copyright2; }
        Caption := 'Evalution Version - not for distribution';
        AboutCount := Time;
        ShowModal;
     finally
        Free;
     end;
end;
initialization
     { copyright string OK ? }
     if Modifiziert then Halt;
{$IFDEF TRIAL}
     { is IDE running ?}
     if not IDERunning then Show_NoIDEMessage;
     if not CheckTime then Show_TimeExpired;
{$ENDIF}
end.

						