Eksempel på brugen af TEvent class\'en

http://www.alexdot.narod.ru/eng/Ch8.html#TEvent and TSimpleEvent
http://www.delphi32.com/url.asp?jsdfliwjlkmnLKJ4871ijO984l1ij9oiju598787n38098987ljhlksOIl3lU94lirouOLIoifw98pl!idoj=jsdfliwjlkmnLKJ4871ijO984l1ij9oiju598787n38098@987ljhlksOIl3lU94lirouOLIoifw98pl!idoj&backurl=/vcl/1288&url=http%3A%2F%2Fservice%2Ebfast%2Ecom%2Fbfast%2Fclick%3Fbfsiteid%3D18876564%26bfpage%3Dsibstc09%26bfmid%3D253985%26Keywords%3DTEvent%2BScrollBox%26Promo%3Dbefree%26Submit%2Ex%3D10%26Submit%2Ey%3D12

JEns B

Def:

TMyEvent = procedure Test( Sender : TObject; MyString : String ) of Object;

TMyObj = Class;
  FMyEvent : TMyEvent;
  procedure DoMyEvent;
end;

procedure DoMyEvent;
begin
  if Assigned(FMyEvent) then FMyEvent(Self,\'Slam\');
end;

TMyObj = Class;
  FMyEvent : TMyEvent;
  procedure DoMyEvent;
published
  property OnMyEvent : TMyEvent read FMyEvent write FMyEvent;
end;

Så kommer den frem i ObjectInpectoren

Mit problem er egentlig lidt anderledes.

Betragt følgende program:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
  procedure time_is_up (sender : tobject);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  test : tevent;
  tid : ttimer;
implementation

{$R *.DFM}

procedure tform1.time_is_up (sender : tobject);
begin;
test.SetEvent;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
si : tsecurityattributes;

begin

si.nLength := sizeof (tsecurityattributes);
si.lpSecurityDescriptor := nil;
si.bInheritHandle := true;

test := tevent.Create (@si, true, false, \'testevent\');

test.ResetEvent;

tid := ttimer.Create (nil);
tid.enabled := false;
tid.Interval := 5000;
tid.OnTimer := time_is_up;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
tid.enabled := true;

waitforsingleobject (test.handle, INFINITE);

showmessage (\'time is up!\');
end;

end.

Programmet virker ikke som det skal fordi at den ikke kommer videre fra \"waitforsingleobject\".

Hvad skal jeg gøre for at få det til at virke?

Her er en måde at løse det på:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
  procedure time_is_up (sender : tobject);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  test : tevent;
  tid : ttimer;
implementation

{$R *.DFM}

procedure tform1.time_is_up (sender : tobject);
begin;
test.SetEvent;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
si : tsecurityattributes;

begin

si.nLength := sizeof (tsecurityattributes);
si.lpSecurityDescriptor := nil;
si.bInheritHandle := true;

test := tevent.Create (@si, true, false, \'testevent\');

test.ResetEvent;

tid := ttimer.Create (nil);
tid.enabled := false;
tid.Interval := 5000;
tid.OnTimer := time_is_up;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
tid.enabled := true;

repeat
    Application.ProcessMessages;
  until WaitForSingleObject(test.handle, 0) <> WAIT_TIMEOUT;

showmessage (\'time is up!\');
end;

end.

og hvis man vil undgå at den ikke sluger *al* CPU kraften mens den kører:

</SNIP>

procedure TForm1.Button1Click(Sender: TObject);
begin
tid.enabled := true;

repeat
    Application.ProcessMessages;
    sleep (5);
  until WaitForSingleObject(test.handle, 0) <> WAIT_TIMEOUT;

showmessage (\'time is up!\');

tid.enabled:=false;
end;

end.

Det er nøjagtig samme problemstilling som det spørgsmål jeg stillede lige før. Her endte det så med en sleep midt i det hele igen. Det med at den hænger er fordi det er WaitForSingleObject du bruger. Hvis du bruger MsgWaitForMultibleObjects undgår du, at den hænger. Det er msg, der gør forskellen. Der er så vidt jeg ved også en MsgWaitForSingleObjects, men den understøttes ikke i Delphi. Det betyder imidlertid ikke noget, da det bare er at sætte NoObjects til 1.

Bare mine 25 cents :)