Delphi控件源码

开发平台：
Delphi

UTimStop.pas：源码内容
							unit UTimStop;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  DsgnIntf;
const
  DEF_MAX = 50;
  DEF_AUTOSAVE = True;
  DEF_AUTOLOAD = True;
  DEF_ALERTMESSAGE = True;
  DEF_MESSAGETEXT = 'You have reached the limit of times you can run this application. You cannot use it anymore until you register.';
  DEF_KEY = 'SoftwareMy Program';
  DEF_SECTION = 'Used Times Stop';
  DEF_STOPEXECUTE = True;
type
  TAboutUsedTimesStop = class(TPropertyEditor)
  public
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
    function GetValue: string; override;
  end;
  TUsedTimesStop = class(TComponent)
  private
    FMax: integer;
    FAlert: Boolean;
    FAutoSave: boolean;
    FOnUsedAll: TNotifyEvent;
    FUsed: integer;
    FAbout: TAboutUsedTimesStop;
    FKey: string;
    FSection: string;
    FMessageText: string;
    FStopExecute: boolean;
    procedure SetMax(Value: integer);
    procedure SetAlert(Value: Boolean);
  protected
    procedure Loaded; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ResetCounter;
    procedure LockCounter;
    function Load: boolean;
    function Save: boolean;
    property TimesUsed: integer read FUsed;
  published
    property About: TAboutUsedTimesStop read FAbout write FAbout;
    property AlertMessage: Boolean read FAlert write SetAlert;
    property AutoSave: boolean read FAutoSave write FAutoSave;
    property MessageText: string read FMessageText write FMessageText;
    property Max: integer read FMax write SetMax;
    property OnUsedAll: TNotifyEvent read FOnUsedAll write FOnUsedAll;
    property SaveKey: string read FKey write FKey;
    property SaveSection: string read FSection write FSection;
    property StopExecute: boolean read FStopExecute write FStopExecute;
  end;
procedure Register;
implementation
uses Registry;
procedure TAboutUsedTimesStop.Edit;
begin
  Application.MessageBox('TUsedTimesStop component v1.00 for Delphi 2.0. Copyright (C) 1997 Ivan Azic. This component is freeware. For more details, see readme.doc file.',
                         'About TUsedTimesStop Component', MB_OK + MB_ICONINFORMATION);
end;
function TAboutUsedTimesStop.GetAttributes: TPropertyAttributes;
begin
  Result:= [paMultiSelect, paDialog, paReadOnly];
end;
function TAboutUsedTimesStop.GetValue: string;
begin
  Result:= '(about)';
end;
procedure TUsedTimesStop.SetMax(Value: Integer);
begin
  FMax:= Value;
end;
procedure TUsedTimesStop.SetAlert(Value: boolean);
begin
  FAlert:= Value;
end;
constructor TUsedTimesStop.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FMax:= DEF_MAX;
  FAlert:= DEF_ALERTMESSAGE;
  FMessageText:= DEF_MESSAGETEXT;
  FKey:= DEF_KEY;
  FSection:= DEF_SECTION;
  FAutoSave:= DEF_AUTOSAVE;
  FStopExecute:= DEF_STOPEXECUTE;
end;
destructor TUsedTimesStop.Destroy;
begin
  if not(csDesigning in ComponentState) then
    if FAutoSave then
      Save;
  inherited Destroy;
end;
procedure TUsedTimesStop.Loaded;
begin
  inherited Loaded;
  if not(csDesigning in ComponentState) then
    if not(Load) then exit;
  if (FUsed = -1) or (FUsed = 0) then exit;
  if FUsed > FMax then begin
    if FAlert then begin
      Beep;
      ShowMessage(FMessageText);
    end;
    if Assigned(FOnUsedAll) then
      FOnUsedAll(Self);
    if FStopExecute then
      Halt;
  end;
  FUsed:= FUsed + 1;
  if FAutoSave then
    Save;
end;
function TUsedTimesStop.Load: boolean;
var
  p: TRegIniFile;
begin
  Result:= False;
  if (FKey = '') or (FSection = '') then exit;
  p:= TRegIniFile.Create(FKey);
  try
    FUsed:= p.ReadInteger(FSection, 'TimesUsed', 1);
    Result:= True;
  finally
    p.Free;
  end;
end;
function TUsedTimesStop.Save: boolean;
var
  p: TRegIniFile;
begin
  Result:= False;
  if (FKey = '') or (FSection = '') then exit;
  p:= TRegIniFile.Create(FKey);
  try
    p.EraseSection(FSection);
    p.WriteInteger(FSection, 'TimesUsed', FUsed);
    Result:= True;
  finally
    p.Free;
  end;
end;
procedure TUsedTimesStop.ResetCounter;
begin
  FUsed:= 1;
  if FAutoSave then
    Save;
end;
procedure TUsedTimesStop.LockCounter;
begin
  FUsed:= -1;
  if FAutoSave then
    Save;
end;
procedure Register;
begin
  RegisterComponents('Samples', [TUsedTimesStop]);
  RegisterPropertyEditor(TypeInfo(TAboutUsedTimesStop), TUsedTimesStop, 'ABOUT', TAboutUsedTimesStop);
end;
end.

						