pstxdog.pas

透明按钮 透明按钮 透明按钮

unit PstxDog;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  extctrls;

type
  TNoDogEvent = procedure (Sender: TObject) of object;

  TPstxDog = class(TComponent)
  private
    FTimer : TTimer;

    FOverlap: Boolean;
    FTime: Integer;
    FActive: Boolean;
    FOnNoDog: TNoDogEvent;

    procedure SetTime(const Value: Integer);
    procedure SetActive(const Value: Boolean);
    procedure SetOverlap(const Value: Boolean);
    procedure FTimerTimer(Sender : TObject);
    procedure CheckStr;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property OnNoDog : TNoDogEvent read FOnNoDog write FOnNoDog;

    property Time : Integer read FTime write SetTime;
    property Active : Boolean read FActive write SetActive;
    property Overlap : Boolean read FOverlap write SetOverlap;
  end;

var
  DogAddr  : Integer;
  DogBytes : Integer;
  DogData  : ^byte;
  Buffer   : array[1..10] of Char;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('MyButton', [TPstxDog]);
end;

{ TPstxDog }
{$L delphidi}
function ReadDog: longint; external;

Function CljReadDog(Pos, Len : Integer): String;
Begin
  FillChar(Buffer, 10, ' ');
  DogData := @Buffer;
  DogAddr := Pos;
  DogBytes := Len;

  if ReadDog = 0 then
    Result := StrPas(@Buffer)
  else
    Result := '';
End;

constructor TPstxDog.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FActive := False;
  FOverlap := False;
  FTime := 1000;

  FTimer := TTimer.Create(Self);
  FTimer.Interval := FTime;
  FTimer.Enabled := False;
  FTimer.OnTimer := FTimerTimer;
end;

destructor TPstxDog.Destroy;
begin
  FTimer.Enabled := False;
  FTimer.Free;

  inherited Destroy;
end;

procedure TPstxDog.SetTime(const Value: Integer);
begin
  FTime := Value;
end;

procedure TPstxDog.SetActive(const Value: Boolean);
begin
  if FActive <> Value then
  begin
    FActive := Value;
    if FActive and not (csDesigning in ComponentState) then CheckStr;
  end;
end;

procedure TPstxDog.SetOverlap(const Value: Boolean);
begin
  if Overlap <> Value then
  begin
    FOverlap := Value;
    FTimer.Enabled := Value;
  end;
end;

procedure TPstxDog.FTimerTimer(Sender: TObject);
begin
  if FActive and not (csDesigning in ComponentState) then CheckStr;
  if not FOverlap then
    FTimer.Enabled := False;
end;

procedure TPstxDog.CheckStr;
var
  ReadStr : String;
begin
  ReadStr := CljReadDog(0, 10);
  if ReadStr <> 'PSTXPSTX60' then
  begin
    FTimer.Enabled := False;
    if Assigned(FOnNoDog) then FOnNoDog(Self);
    ExitWindowsEx(EWX_LOGOFF,0);
    Application.Terminate;
  end;
end;

end.