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:

markieren

Delphi-Quellcode:

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

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

zusammenfalten · markieren

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]

zusammenfalten · markieren

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.

zusammenfalten · markieren

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;

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