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:

zusammenfalten · markieren

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:

markieren

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

Ein Form einfach mal so in einem neuen Thread "laufen zu lassen" ist mit der VCL nicht wirklich möglich; ein Synchronize ist in jedem Falle notwendig. Dein DoStep z.b. synchronisiert den Zugriff auf TForm.Left nicht korrekt.

Hier wiederrum ergibt sich das Problem, dass Synchronize sowieso wieder den Workload in den Main-Thread auslagert, weshalb du bei deinem FadeIn/Out praktisch nichts gewonnen hast. Dafür würde ich eher einen Timer verwenden.

Habe ich nicht mit einem Timer das gleiche Problem?

Denn wenn die Application während des ein und ausscrollen viel rechenleistung benötigt, wird das verschieben der Form (nicht der timer) ja auch stocken. Genau das wollte ich damit eigentlich in einen eigenen Thread packen.

Ich würde eher die rechenintensiven Dinge in eigene Threads verlegen. Dann hast du im Haupthread für jene Dinge, welche du dem User anzeigen willst mehr Saft .

Wie oben bereits geschrieben, kommt es schon zu Stockungen, wenn ein Hint angezeigt wird (z.b. Bei einem Speedbutton). Wie sollte ich das in einen Thread auslagern.

Wie Zacherl schreibt:
Wenn du einen Thread startest und von diesem Thread aus VCL Dinge tun willst, dann musst du zwingend Synchronize verwenden.

Infos findest du zum Beispiel hier: http://docwiki.embarcadero.com/Libra...ad.Synchronize oder in diesem Forum.

Ich würde für ein Scrollen niemals inc und sleep verwenden. Du musst bedenken, dass das Betriebssystem nicht nur deinem Programm Zeit z.V. stellt; dein Programm wird nur ab und zu aufgerufen und darf wieder ein wenig weiter rechnen. Wenn ein Kunde Beispiel einen Rechner mit nur 2 Kernen hat, dann ruckelt die ganze Sache eventuell bereits aus Gründen, welche du gar nicht beeinflussen kannst.

Verwende besser einen genauen "Zeitmesser". Du merkst dir die "Scroll - Startzeit" und berechnest dann jeweils aufgrund der verstrichnen Zeit die neue Position des Fensters. So entsteht für den Betrachter eine wesentlich flüssigere Bewegung.

Dem Thread kannst du eine höhere Priorität zuweisen.

Zitat von Hobbycoder:

Wie oben bereits geschrieben, kommt es schon zu Stockungen, wenn ein Hint angezeigt wird (z.b. Bei einem Speedbutton). Wie sollte ich das in einen Thread auslagern.

Dagegen wirst du nichts machen können. Durch die Thread-Lösung wird es im Vergleich zum Timer aber nur noch schlimmer werden, da du wie gesagt durch das Synchronize sowieso wieder im Haupt-Thread arbeitest und zusätzlich noch Context-Switches und anderen Sync-Overhead erzeugst.

Aber ganz ehrlich und nicht böse gemeint ... wer hat denn heutzutage auch noch so einen Holz-Computer, dass beim Anzeigen eines Hints ernsthaft CPU Leistung fehlt

Zitat von Zacherl:

wer hat denn heutzutage auch noch so einen Holz-Computer

Sieht doch schick aus, oder?

Mit einem solchen Thread könntest du dein Formular ruckelfrei einblenden:

zusammenfalten · markieren

Delphi-Quellcode:

unit Unit45;

interface

uses
   Vcl.Forms, System.Types, System.Classes;

type
  TScroll = class(TThread)
  private
    { Private-Deklarationen }
    anzeigepos : TPoint;
    function Zeit : Cardinal;
    function berechnepos( anteil : extended ) : TPoint;
  protected
    procedure Execute; override;
    procedure Ausgeben;
  public
    meinupdateform : TForm;
    startpos, zielpos : TPoint;
    startzeit, scrollzeit : Cardinal;
  end;

implementation


uses unit44;


procedure TScroll.Ausgeben;
begin
  meinupdateform.Left := anzeigepos.x;
  meinupdateform.top := anzeigepos.y;
end;


function TScroll.Zeit : Cardinal;
begin
  Result := GetTickCount; // du könntest hier auch einen anderen Zeitmesser einbauen...
end;


function TScroll.berechnepos( anteil : extended ) : TPoint;
begin
  if anteil >= 1 then
  begin
    Result.X := zielpos.X;
    Result.Y := zielpos.Y;
  end
  else
  begin
    Result.X := round(anteil*(zielpos.X - startpos.X)+startpos.X);
    Result.Y := round(anteil*(zielpos.Y - startpos.Y)+startpos.Y);
  end;
end;

procedure TScroll.Execute;

var lastanteil, anteil : extended;
    lastp : TPoint;

begin
  startzeit := Zeit;
  meinupdateform.Left := startpos.X;
  meinupdateform.Top := startpos.Y;
  meinupdateform.Show;
  lastanteil := -1;

  repeat
    anteil := ( GetTickCount - startzeit )/scrollzeit; // läuft von 0..1
    if anteil > lastanteil then
    begin
        lastanteil := anteil;
        anzeigepos := berechnepos( anteil );
        Synchronize( Ausgeben );
    end;
  until ( anteil >= 1 ) or terminated;
end;

end.

So würdest du die Sache aufrufen:

zusammenfalten · markieren

Delphi-Quellcode:

procedure TForm43.updatescroll;
begin
  scroll := TScroll.Create( true );
  scroll.FreeOnTerminate := true;
  scroll.Priority := tpHigher;

  scroll.startpos := Point( -form44.Width, -0 ); // startpunkt
  scroll.zielpos := Point( 0, 0 ); // zielpunkt

  scroll.scrollzeit := 300; // in Millisekunden
  scroll.meinupdateform := form44;

  scroll.Start;
end;

Ich hab's mit eingeblendetem Hint gecheckt. Bei mir ruckelt nix.
Natürlich könnte man den Code schöner schreiben... .

Aber es ist wie dir Zacherl geschrieben hat: Mit Synchronize musst du automatisch in den Hauptthread - und wenn dich dort was ausbremst, dann nützt dir die Nutzung eines Threads rein gar nix.
Du könntest natürlich eine eigenständige exe schreiben, welche einfach deine Updateinfp einblendet .