Form in neuem Thread laufen lassen

[Hobbycoder]

Hi,

ich möchte eine Information über vorhandene Updates einblenden lassen. Zu diesem Zweck habe ich eine Form ohne Rahmen, die ich oben rechts langsam in den Desktop ein- und ausscrollen lasse.
Leider hat das den Nachteil, dass der Scrollvorgang in's stocken gerät, wenn z.b. ein Hint in der Mainform angezeigt wird, oder andere Rechenintensive Prozesse im Mainthread auflaufen.

Also dachte ich mir, ich könnte ja gleich die Form in einem Thread laufen lassen.
So schaut's aus:

Delphi-Quellcode:

unit updatealert;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Buttons, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TFadeDirection=(dfIn, dfOut);
  TOnStep=procedure(Sender: TObject) of object;
  TOnFinished=procedure(Sender: TObject) of object;

  TThDisplayUpdateInformation=class(TThread)
  private
    FCaption: String;
    FTitle: string;
    FDuration: Integer;
    FWorkarea: TRect;
  public
    constructor Create(Suspended: Boolean; Caption, Title: string; Duration: Integer; WorkArea: TRect);
  protected
    procedure Execute; override;
  end;

  TThFadeIn=class(TThread)
  private
    FOnStep: TOnStep;
    FOnFinished: TOnFinished;
    FCancel: Boolean;
    FDirection: TFadeDirection;
    FForm: TForm;
    procedure DoStep;
    procedure DoFinished;
    procedure SetCancel(const Value: Boolean);
  published
    property OnStep: TOnStep read FOnStep write FOnStep;
    property OnFinished: TOnFinished read FOnFinished write FOnFinished;
    property Cancel: Boolean read FCancel write SetCancel;
  public
    constructor Create(Suspended: Boolean; Form: TForm; Direction: TFadeDirection = dfIn);
  protected
    procedure Execute; override;
  end;

  TOnStartUpdate=procedure(sender: TObject) of object;

  Tfrm_updatealert = class(TForm)
    pnl1: TPanel;
    lbl_title: TLabel;
    lbl_message: TLabel;
    btn1_close: TSpeedButton;
    btn_download: TSpeedButton;
    tmr1Duration: TTimer;
    procedure pnl1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure btn1_closeClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure tmr1DurationTimer(Sender: TObject);
    procedure DoStartUpdate;
    procedure btn_downloadClick(Sender: TObject);
  private
    thIn: TThFadeIn;
    thOut: TThFadeIn;
    FOnStartUpdate: TOnStartUpdate;
    procedure OnStepFadeIn(Sender: TObject);
    procedure OnFinishedFadeIn(Sender: TObject);
    procedure OnStepFadeOut(Sender: TObject);
    procedure OnFinishedFadeOut(Sender: TObject);
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  published
    property OnStartUpdate: TOnStartUpdate read FOnStartUpdate write FOnStartUpdate;
  end;

var
  frm_updatealert: Tfrm_updatealert;

implementation

{$R *.dfm}

procedure Tfrm_updatealert.btn1_closeClick(Sender: TObject);
begin
  thOut:=TThFadeIn.Create(True, self, dfOut);
  thOut.OnStep:=OnStepFadeOut;
  thOut.OnFinished:=OnFinishedFadeOut;
  thOut.Resume;
end;

procedure Tfrm_updatealert.btn_downloadClick(Sender: TObject);
begin
  DoStartUpdate;
end;

procedure Tfrm_updatealert.DoStartUpdate;
begin
  if Assigned(FOnStartUpdate) then
    FOnStartUpdate(Self);
end;

procedure Tfrm_updatealert.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action:=caFree;
end;

procedure Tfrm_updatealert.FormShow(Sender: TObject);
begin
  thIn:=TThFadeIn.Create(True, self, dfIn);
  thIn.OnStep:=OnStepFadeIn;
  thIn.OnFinished:=OnFinishedFadeIn;
  thIn.Resume;
end;

procedure Tfrm_updatealert.OnFinishedFadeIn(Sender: TObject);
begin
  thIn:=nil;
  tmr1Duration.Enabled:=True;
end;

procedure Tfrm_updatealert.OnFinishedFadeOut(Sender: TObject);
begin
  thOut:=nil;
  Self.Close;
end;

procedure Tfrm_updatealert.OnStepFadein(Sender: TObject);
begin
  if Self.Left>(Screen.WorkAreaRect.Right-Self.Width) then
  begin
    self.Left:=self.Left-1;
  end else begin
    Self.Left:=Screen.WorkAreaRect.Right-self.Width;
    if TThFadeIn(Sender)<>nil then TThFadeIn(Sender).Cancel:=True;
  end;
end;

procedure Tfrm_updatealert.OnStepFadeOut(Sender: TObject);
begin
  if Self.Left<Screen.WorkAreaRect.Right then
  begin
    self.Left:=self.Left+1;
  end else begin
    Self.Left:=Screen.WorkAreaRect.Right;
    if TThFadeIn(Sender)<>nil then TThFadeIn(Sender).Cancel:=True;
  end;
end;

procedure Tfrm_updatealert.pnl1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
    releasecapture;
    sendmessage(self.Handle, WM_NCLBUTTONDOWN, 2, 0);
end;

procedure Tfrm_updatealert.tmr1DurationTimer(Sender: TObject);
begin
  btn1_closeClick(self);
end;

{ TThFadeIn }

constructor TThFadeIn.Create(Suspended: Boolean; Form: TForm; Direction: TFadeDirection);
begin
  inherited Create(Suspended);
  self.NameThreadForDebugging('AlertFadeIn');
  self.FreeOnTerminate:=True;
  FCancel:=False;
  FDirection:=Direction;
  FForm:=Form;
end;

procedure TThFadeIn.DoFinished;
begin
  if Assigned(FOnFinished) then
    Synchronize(procedure
      begin
        FOnFinished(Self);
      end);
end;

procedure TThFadeIn.DoStep;
begin
  if FForm<>nil then
  begin
    case FDirection of
      dfIn:
        begin
          if FForm.Left>(Screen.WorkAreaRect.Right-FForm.Width) then
          begin
            FForm.Left:=FForm.Left-1;
          end else begin
            FForm.Left:=Screen.WorkAreaRect.Right-FForm.Width;
            FCancel:=True;
          end;
        end;
      dfOut:
        begin
          if FForm.Left<Screen.WorkAreaRect.Right then
          begin
            FForm.Left:=FForm.Left+1;
          end else begin
            FForm.Left:=Screen.WorkAreaRect.Right;
            FCancel:=True;
          end;
        end;
    end;
  end else
  begin
  if Assigned(FOnStep) then
    Synchronize(procedure
      begin
        FOnStep(Self);
      end);
  end;
end;

procedure TThFadeIn.Execute;
begin
  Try
    while (not FCancel) and (not Terminated) do
    begin
      DoStep;
      Sleep(2);
    end;
  Finally
    DoFinished;
  End;
end;

procedure TThFadeIn.SetCancel(const Value: Boolean);
begin
  FCancel := Value;
end;

{ TThDisplayUpdateInformation }

constructor TThDisplayUpdateInformation.Create(Suspended: Boolean; Caption, Title: string; Duration: Integer; WorkArea: TRect);
begin
  inherited Create(Suspended);
  self.FCaption:=Caption;
  self.FTitle:=Title;
  self.FDuration:=Duration;
  self.FWorkarea:=WorkArea;
end;

procedure TThDisplayUpdateInformation.Execute;
  function CalculateTextHeight(value: String; can: TCanvas): Integer;
  var
    lRect : TRect;
    lText : string;
  begin
    lRect.Left := 0;
    lRect.Right := 300;
    lRect.Top := 0;
    lRect.Bottom := 0;

    lText := value;

    Can.TextRect(
              {var} lRect, //will be modified to fit the text dimensions
              {var} lText, //not modified, unless you use the "tfModifyingString" flag
              [tfCalcRect, tfWordBreak] //flags to say "compute text dimensions with line breaks"
            );
    ASSERT( lRect.Top = 0 ); //this shouldn't have moved
    Result := lRect.Bottom;
  end;
var
  updateform: Tfrm_updatealert;
begin
  updateform:=Tfrm_updatealert.Create(nil);
  updateform.lbl_title.Caption:=FTitle;
  updateform.lbl_message.Caption:=FCaption;
  updateform.tmr1Duration.Interval:=FDuration;
  updateform.Height:=163+CalculateTextHeight(updateform.lbl_message.Caption, updateform.Canvas);
  updateform.Top:=FWorkarea.Top;
  updateform.Left:=FWorkarea.Right;
  //updateform.OnStartUpdate:=StartUpdate;
  updateform.Show;
  while updateform.Showing and (not Terminated) do
  begin
    Sleep(100);
  end;
end;

end.

So aufgerufen:

Delphi-Quellcode:

  UpdateCaption:='';
  for i:=0 to Update.UpdateFiles.Count-1 do
  begin
     UpdateCaption:=UpdateCaption+'- '+Update.UpdateFiles[i].Filename+' Version: '+Update.UpdateFiles[i].NewVersion+#10#13;
  end;
  thDisplayUpdate:=TThDisplayUpdateInformation.Create(False, UpdateCaption, 'Es liegen Updates zum Download bereit', 10000, Screen.WorkAreaRect, self);

führt das zu dem Effect, dass a) die Updateform nur zu 20% eingescrollt wird und dann stoppt und b) wenn ich die Updateform einmal mit der Maus anklicke das ganze Programm nicht mehr reagiert.

Rufe ich das so auf, dass es im MainThread läuft (einfach für .Show),
dann habe ich die oben aufgeführten Einschränkungen. (So läuft es zur Zeit).

Im Grunde bin ich mit dem wie es jetzt läuft ja auch ganz zufrieden, aber eben das stocken des scrollen stört das Look-And-Feel schon sehr, den der User soll ja während des Einblenden und Ausblenden ganz normal weiterarbeiten können.

Gruß Hobbycoder