Ein Objekt um ein selbst definiertes Ereignis erweitern

[ustra]

Hallo,

ich habe mir ein kleines Objekt geschrieben, das überprüft, ob ein Programm mit dem Titel "CAD-Server" geöffnet ist (Stichwort Findwindow). Ich überprüfe mit einem Timer, ob das Programm geöffnet ist. Der Timer läuft solange, bis das Programm geöffnet ist. So weit auch alles kein Problem. Nun ich will dem Objekt ein eigenes Ereignis definieren(ich nenne es onOnline). Das soll ausgelöst werden, wenn das Programm geöffnet ist. Und nun stellt sich mir die Frage, wie ich das mache. ich habe schon auf Delphi-treff.de nachgesehen und schon gebastelt, bis jetzt funktioniert es noch nicht. Ich will es so haben, das der Aufruf des Objektes so aussieht:

Delphi-Quellcode:

  
Server:=TServer.create;
Server.onOnline:=TReadInBoxTimer;

So sieht der Quellcode der Unit aus (Ich weiss, der Destruktor fehlt noch):

Delphi-Quellcode:

unit UServer;

interface

uses classes, Dialogs, windows, extctrls, shellapi;
                                  
  type TFehlerEvent = procedure(Param1: String) of object;
  type TServer = class(Tcomponent)
    private
      FOnFehler: TFehlerEvent;
      TWarten : TTimer;
      function getBoServer : boolean;  
      procedure SetOnOnline(Value: TFehlerEvent);
      procedure TWartenOnTimer(Sender : TObject);

    published
      property OnOnline: TFehlerEvent read FOnFehler write SetonOnline;

    protected

    public
      constructor create;
  end;

implementation

  constructor TServer.create;
  begin
    if getBoServer
    then self.SetonOnline(FonFehler)
    else begin
      TWarten := TTimer.create(nil);
      TWarten.interval:=500;
      Twarten.OnTimer := TwartenOnTimer;
      TWarten.enabled:=true;  
      ShellExecute(0, 'open', 'Server.exe',  nil, 'C:\buco_bwp\Server', SW_SHOWNORMAL);
    end;
  end;

  function TServer.getBoServer : boolean;
  begin
    if FindWindow(nil, 'CAD-Server') = 0
    then
       result := false
    else
      result := true;
  end;

  procedure TServer.SetonOnline(Value: TFehlerEvent);
  begin
    ShowMessage('hallo');
  end;

  procedure TServer.TWartenOnTimer(Sender : TObject);
  begin
    if getBoServer
    then begin
      TWarten.enabled:=false;
      TWarten.free;
      self.SetonOnline(FOnFehler);
    end;
  end;

end.

Besten Grüße
Ulrich

[edit=Daniel B]Delphi-Tags korrigiert. Mfg, Daniel B[/edit]

[scp]

Delphi-Quellcode:

unit UServer; 

interface 

uses classes, Dialogs, windows, extctrls, shellapi; 
                                  
  type TFehlerEvent = procedure(Param1: String) of object; // "of object" evtl. weglassen, je nach dem, ob später eine normale procedure oder eine procedure, die in einem Form deklariert ist, werwendet wird.
  type TServer = class(Tcomponent) 
    private 
      FOnFehler: TFehlerEvent; 
      TWarten : TTimer; 
      function getBoServer : boolean;  
      procedure SetOnOnline(Value: TFehlerEvent); 
      procedure TWartenOnTimer(Sender : TObject); 

    published 
      property OnOnline: TFehlerEvent read FOnFehler write SetonOnline; 

    protected 

    public 
      constructor create; 
      procedure Execute;
  end; 

implementation 

  constructor TServer.create; 
  begin 
    inherited create(nil); // hier noch keine Aktionen
  end;

  procedure TServer.Execute; 
  begin 
    if getBoServer then
      begin
        If Assigned(FOnFehler) then   // Der Aufruf geht dann so von statten
          FOnFehler('text'); 
      end 
    else begin 
      TWarten := TTimer.create(nil); 
      TWarten.interval:=500; 
      Twarten.OnTimer := TwartenOnTimer; 
      TWarten.enabled:=true;  
      ShellExecute(0, 'open', 'Server.exe',  nil, 'C:\buco_bwp\Server', SW_SHOWNORMAL); 
    end; 
  end; 

  function TServer.getBoServer : boolean; 
  begin 
    if FindWindow(nil, 'CAD-Server') = 0 
    then 
       result := false 
    else 
      result := true; 
  end; 

  procedure TServer.SetonOnline(Value: TFehlerEvent); 
  begin 
    FOnFehler = Value;  // Hier wird nur die procedure zugeswiesen 
  end; 

  procedure TServer.TWartenOnTimer(Sender : TObject); 
  begin 
    if getBoServer 
    then begin 
      TWarten.enabled:=false; 
      TWarten.free; 
      If Assigned(FOnFehler) then  // Der Aufruf geht dann so von statten
        FOnFehler('text'); 
    end; 
  end; 

end.

Delphi-Quellcode:

var
  EinServer : TServer;

procedure EinServerOnFehler(param1 : string);
begin
  ShowMessage('hallo');
end;

procedure EinServerStarten;
begin
  EinServer := TServer.Create;
  EinServer.OnOnline := EinServerOnFehler;
  EinServer.Execute;
end;

[ustra]

Hallo,

danke für Deine Hilfe. Jetzt funktioniert ist. Ich schaue mir das noch mal genau an um es zu verstehen. Sollte jetzt aber kein Problem mehr für mich darstellen.

Besten Dank
Ulrich