TApplicationevents.onmessage

[jaenicke]

Wofür brauchst du da eigentlich OnMessage? Ein Beispiel:

Delphi-Quellcode:

  TOnFinished = procedure(const ACancelled: Boolean; const AFolder: string; const AFolderSize: Int64) of object;

  TTest = class(TThread)
  private
    FFolder: string;
    FFolderSize: Int64;
    FOnFinished: TOnFinished;
    function GetFolderSize(const AFolder: string): Int64;
    procedure SetOnFinished(const Value: TOnFinished);
    procedure DoFinished;
  protected
    procedure Execute; override;
  public
    constructor Create(const AFolder: string);
    property OnFinished: TOnFinished read FOnFinished write SetOnFinished;
  end;

  TfrmTest = class(TForm)
    btnStart: TButton;
    btnStop: TButton;
    procedure btnStartClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
  private
    FThread: TTest;
    procedure CalculationFinished(const ACancelled: Boolean; const AFolder: string; const AFolderSize: Int64);
  public
    { Public-Deklarationen }
  end;

var
  frmTest: TfrmTest;

implementation

{$R *.dfm}

{ TTest }

constructor TTest.Create(const AFolder: string);
begin
  inherited Create(False);
  FFolder := AFolder;
end;

procedure TTest.DoFinished;
begin
  if Assigned(FOnFinished) then
    FOnFinished(FFolderSize = -1, FFolder, FFolderSize);
end;

procedure TTest.Execute;
begin
  inherited;
  FFolderSize := GetFolderSize(FFolder);
  Synchronize(DoFinished);
end;

function TTest.GetFolderSize(const AFolder: string): Int64;
var
  SearchResult: TSearchRec;
  SubFolderSize: Int64;
begin
  Result := 0;
  if FindFirst(IncludeTrailingPathDelimiter(AFolder) + '*.*', faAnyFile, SearchResult) = 0 then
  begin
    repeat
      if Copy(SearchResult.Name, 1, 1) <> '.' then
      begin
        if SearchResult.Attr and faDirectory > 0 then
          Inc(Result, GetFolderSize(IncludeTrailingPathDelimiter(AFolder) + SearchResult.Name))
        else
          Inc(Result, SearchResult.Size);
      end;
      if Terminated then
        Exit(-1);
    until FindNext(SearchResult) <> 0;
    FindClose(SearchResult);
  end;
end;

procedure TTest.SetOnFinished(const Value: TOnFinished);
begin
  FOnFinished := Value;
end;

{ TfrmTest }

procedure TfrmTest.btnStartClick(Sender: TObject);
begin
  FThread := TTest.Create('c:\');
  FThread.OnFinished := CalculationFinished;
  btnStart.Enabled := False;
  btnStop.Enabled := True;
end;

procedure TfrmTest.btnStopClick(Sender: TObject);
begin
  FThread.Free;
  btnStart.Enabled := True;
  btnStop.Enabled := False;
end;

procedure TfrmTest.CalculationFinished(const ACancelled: Boolean; const AFolder: string; const AFolderSize: Int64);
begin
  if not ACancelled then
    ShowMessage(AFolder + ': ' + IntToStr(AFolderSize));
end;