Form ansprechen während einer Bearbeitung

[sirius]

Hier wäre mal ein Vorschlag

Form1 ist via Formdesigner einer normalen VCL-Anwendung erstellt
ProgressForm ist direkt gecodet (aber nur als Beispiel; kann man auch über den Designer erstellen und zu den "verfügbaren Formularen" in den Projektoptionen schieben).

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls;


const
  CM_Progress=WM_User+1;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;


  TProgressThread=class(TThread)
  protected
    procedure execute; override;
  private
    FParameter:String;
    FProgressWindowHandle:hwnd;
    FResult:String;
    FStatusReady: boolean;
    procedure SetParameter(const Value: String);
    procedure SetProgressWindowHandle(const Value: hwnd);
  public
    property ProgressWindowHandle:hwnd read FProgressWindowHandle write SetProgressWindowHandle;
    property Parameter:String read FParameter write SetParameter;
    property StatusReady:boolean read FStatusReady;
    property Result:String read FResult;
  end;

  TProgressform=class(TCustomForm)
    constructor CreateNew(AOwner: TComponent;dummy:Integer); override;
  private
    FProgressbar:TProgressbar;
    FAbbruchButton:TButton;
    FProgressThread:TProgressThread;
    FLabel:TLabel;
    FResult: String;
    FParameter: String;
    procedure AbbruchButtonClick(Sender:TObject);
    procedure CMProgress(var msg:TMessage);message CM_Progress;
    procedure SetParameter(const Value: String);
    procedure StarteThread(Parameter: String);
    procedure ProgressThreadTerminate(Sender:TObject);
  protected
    procedure DoShow; override;
  public
    property Parameter:String read FParameter write SetParameter;
    property Result:String read FResult;
  end;



var
  Form1: TForm1;

implementation

{$R *.dfm}




procedure TForm1.Button1Click(Sender: TObject);
var Progressform:TProgressform;
begin
  //Form dynamisch erstellen
  Progressform:=TProgressform.CreateNew(nil,0);
  try
    //Eingansgparameter setzen
    ProgressForm.Parameter:=Edit1.Text;

    //Fenster Modal öffnen und Rückgabewert prüfen
    case Progressform.ShowModal of
      mrOK: Memo1.Lines.Add('Fertsch: '+ProgressForm.Result);
      mrCancel: Memo1.Lines.Add('Abbruch: '+ ProgressForm.Result);
    end;
  finally
    //finito
    Progressform.Free;
  end;
end;



{ TProgressform }

procedure TProgressform.AbbruchButtonClick(Sender: TObject);
begin
  //einfach nur Abbruch des Threads erzwingen
  //um auch einen konsistenten Zustand aller Werte des Threads zu haben
  FProgressThread.Terminate;
end;

procedure TProgressform.CMProgress(var msg: TMessage);
begin
  //zum Aktualisieren der
  //Wenn Postmessage an dieses Fenster gesendet wird...  (siehe TProgressthread.execute)
  FProgressbar.StepBy(msg.LParam); //lparam ist der letzte Wert in Postmessage
  FLabel.Caption:=
    inttostr(FProgressbar.Position)+' von '+inttostr(FProgressbar.Max);

  //lparam und wParam dürfen frei verwendet werden
end;

constructor TProgressform.CreateNew(AOwner: TComponent;dummy:Integer);
begin
  //hier wird ein fesnter ohne formulardesigner erstellt
  //kann man aber auch mit designer machen (der Code aus Methode DoShow muss dan zum Ereignis onShow)
  inherited;

  //lustige Elemente zusammenbasteln
  Caption:='please hold the line...';
  Width:=400;
  Height:=150;
  FProgressbar:=TProgressbar.Create(self);
  FProgressbar.Parent:=self;
  FProgressbar.Height:=20;
  FProgressbar.Width:=300;
  FProgressbar.Left:=50;
  FProgressbar.Top:=20;
  FProgressbar.Visible:=true;
  FPRogressbar.Min:=0;
  FPRogressbar.Max:=100;
  FProgressbar.Position:=0;

  FAbbruchButton:=TButton.Create(self);
  FAbbruchButton.Caption:='A&bbruch';
  FAbbruchbutton.Parent:=self;
  FAbbruchbutton.Height:=40;
  FAbbruchButton.Width:=100;
  FAbbruchButton.Left:=150;
  FAbbruchButton.Top:=60;
  FAbbruchButton.Show;
  FAbbruchButton.OnClick:=AbbruchButtonClick;

  FLabel:=TLabel.Create(self);
  FLabel.Parent:=self;
  FLabel.Visible:=true;
  FLabel.Caption:='ich muss mal kurz rechnen';
  FLabel.Left:=50;
  FLabel.Top:=5; 
end;

procedure TProgressform.DoShow; //oder als Ereignis in onShow
begin
  inherited;
  BringToFront;
  if FParameter<>'' then
    StarteThread(FParameter) //wenn Fenster angezeigt wird, soll der Thread gestartet werden
  else
    raise Exception.Create('keine Parameter');  //aber nur bei gültigen Eingabewerten ;-)
end;

procedure TProgressform.ProgressThreadTerminate(Sender: TObject);
begin
  //wenn der Thread beendet wird, landen wir hier
  FResult:=(Sender as TProgressThread).Result;

  if (Sender as TProgressThread).StatusReady then
    modalResult:=mrOk
  else
    modalResult:=mrCancel;
  //das setzen von modalresult bewirkt, dass dieses Fenster automatisch geschlossen wird
  // wir landen hinter dem Aufruf von ShowModal
end;

procedure TProgressform.SetParameter(const Value: String);
begin
  FParameter := Value;
  FProgressbar.Max:= length(FParameter);
end;

procedure TProgressform.StarteThread(Parameter: String);
begin
  FProgressThread:=TProgressThread.Create(true);
  //Parameter übergeben
  FProgressThread.Parameter:=FParameter;
  //Windowhandle übergeben, damit wir Messages des Threads über den Fortschritt bekommen können
  FProgressThread.ProgressWindowHandle:=self.WindowHandle;
  FProgressThread.OnTerminate:=ProgressThreadTerminate;
  FProgressThread.FreeOnTerminate:=true;
  FProgressThread.Resume;
end;

{ TProgressThread }

procedure TProgressThread.execute;
var i,p:Integer;
begin
  FStatusready:=false;
  p:=1;

  //Hauptschleife
  while (not terminated)and(p<=length(FParameter)) do
  begin
    //erstmal Message senden, dass wir die nächste Aufgabe abarbeiten
    Postmessage(FProgressWindowHandle,CM_Progress,0,1);

    //Aufgabe erledigen
    FResult:=FResult+inttohex(ord(FParameter[p]),2)+' ';
    inc(p);

    //simulieren, dass die Aufgabe ca. 1sek braucht
    for i:=1 to 10 do
    begin
      sleep(100);
      if terminated then break;
    end;

  end;


  FStatusReady:= p>length(FParameter);
end;

procedure TProgressThread.SetParameter(const Value: String);
begin
  FParameter := Value;
end;

procedure TProgressThread.SetProgressWindowHandle(const Value: hwnd);
begin
  FProgressWindowHandle := Value;
end;

end.