home *** CD-ROM | disk | FTP | other *** search
/ Prima Shareware 3 / DuCom_Prima-Shareware-3_cd1.bin / PROGRAMO / delphi / RTREGIST / DEMOS / VCL / UNIT1.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-01-14  |  3.6 KB  |  149 lines
  1. unit Unit1;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, ExtCtrls, Menus, RtRegc;
  8.  
  9. type
  10.   TRtRegException = class(Exception);
  11.  
  12.   TForm1 = class(TForm)
  13.     MainMenu1: TMainMenu;
  14.     System1: TMenuItem;
  15.     Exit1: TMenuItem;
  16.     Delete1: TMenuItem;
  17.     Lock1: TMenuItem;
  18.     Registration1: TMenuItem;
  19.     Registernow1: TMenuItem;
  20.     N1: TMenuItem;
  21.     Help1: TMenuItem;
  22.     About1: TMenuItem;
  23.     RtRegControl1: TRtRegControl;
  24.     procedure Exit1Click(Sender: TObject);
  25.     procedure Lock1Click(Sender: TObject);
  26.     procedure Registration1Click(Sender: TObject);
  27.     procedure Registernow1Click(Sender: TObject);
  28.     procedure FormCreate(Sender: TObject);
  29.     procedure About1Click(Sender: TObject);
  30.     procedure RtRegControl1Register(Sender: TObject);
  31.     procedure RtRegControl1StartCountLock(Sender: TObject);
  32.     procedure RtRegControl1EndCountLock(Sender: TObject);
  33.   private
  34.     { Private-Deklarationen }
  35.   public
  36.     { Public-Deklarationen }
  37.   end;
  38.  
  39. const
  40.   cRegVer    = 'DEMO Registered Version';
  41.   cDemoVer    = 'DEMO Unregistered Version. You have %d more %s to try it out!';
  42.   cPrg = 'DEMO';
  43.  
  44. var
  45.   Form1: TForm1;
  46.  
  47. implementation
  48.  
  49. {$R *.DFM}
  50.  
  51. uses
  52.     Unit2, Unit3, Unit4;
  53.  
  54. procedure TForm1.Exit1Click(Sender: TObject);
  55. begin
  56.     Close;
  57. end;
  58.  
  59. procedure TForm1.Lock1Click(Sender: TObject);
  60. begin
  61.     with RtRegControl1 do begin
  62.        if IsCountLock then
  63.            DelCountLock
  64.        else if IsDateLock then
  65.            DelDateLock;
  66.    end;
  67. end;
  68.  
  69. procedure TForm1.Registration1Click(Sender: TObject);
  70. begin
  71.      RtRegControl1.DelRegistration;
  72. end;
  73.  
  74. procedure TForm1.Registernow1Click(Sender: TObject);
  75. begin
  76.    if Register then
  77.    begin
  78.        Caption := cRegVer;
  79.       Registernow1.Enabled := False;
  80.    end;
  81. end;
  82.  
  83. procedure TForm1.FormCreate(Sender: TObject);
  84. begin
  85.     with RtRegControl1 do begin
  86.         if Registered then
  87.        begin
  88.           Caption := cRegVer;
  89.           Registernow1.Enabled := False;
  90.        end
  91.        else if IsCountLock then
  92.            Caption := Format(cDemoVer,[CallsLeft,'times'])
  93.        else if IsDateLock then
  94.           Caption := Format(cDemoVer,[DaysLeft,'days']);
  95.    end;
  96. end;
  97.  
  98. procedure TForm1.About1Click(Sender: TObject);
  99. var
  100.     NewForm: TNewForm2;
  101. begin
  102.    NewForm := TNewForm2.Create(Application);
  103.    try
  104.        NewForm.ShowModal;
  105.    finally
  106.        NewForm.Free;
  107.    end;
  108. end;
  109.  
  110. procedure TForm1.RtRegControl1Register(Sender: TObject);
  111. var
  112.     Msg: string;
  113. begin
  114.    Msg := 'This an unregister version of the DEMO program.'+#13#10;
  115.    with (Sender as TRtRegControl) do
  116.    begin
  117.         if CallsLeft>0 then
  118.           Msg := Msg+'You have '+IntToStr(CallsLeft)+' more calls to test it.'+#13#10
  119.         else if DaysLeft>0 then
  120.             Msg := Msg+'You have '+IntToStr(DaysLeft)+' more days to test it.'+#13#10;
  121.         Msg := Msg+'Do you want to register now?';
  122.            if MessageDlg(Msg,mtConfirmation,[mbYes,mbNo],0)=idYes then
  123.           Unit2.Register;
  124.    end;
  125. end;
  126.  
  127. procedure TForm1.RtRegControl1StartCountLock(Sender: TObject);
  128. begin
  129.    with (Sender as TRtRegControl) do
  130.         if not Registered then
  131.           SetLock;
  132. end;
  133.  
  134. procedure TForm1.RtRegControl1EndCountLock(Sender: TObject);
  135. var
  136.     Msg: string;
  137. begin
  138.    with (Sender as TRtRegControl) do
  139.    begin
  140.        Msg := 'This an unregister version of the DEMO program.'+#13#10+
  141.                'The evaluation period is over.'+#13#10+
  142.                  'Do you want to register now?';
  143.         if ((MessageDlg(Msg,mtConfirmation,[mbYes,mbNo],0)=idNo) or (not Unit2.Register)) then
  144.           raise TRtRegException.Create('The evaluation period is over.');
  145.    end;
  146. end;
  147.  
  148. end.
  149.