AGB  ·  Impressum  







Anmelden
Nützliche Links
Registrieren

Form in neuem Thread laufen lassen

Ein Thema von Hobbycoder · begonnen am 17. Apr 2017 · letzter Beitrag vom 3. Mai 2017
Antwort Antwort
Seite 1 von 6  1 23     Letzte » 
Hobbycoder

Registriert seit: 22. Feb 2017
230 Beiträge
 
#1

Form in neuem Thread laufen lassen

  Alt 17. Apr 2017, 12:55
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
  Mit Zitat antworten Zitat
Benutzerbild von Zacherl
Zacherl

Registriert seit: 3. Sep 2004
4.059 Beiträge
 
Delphi 10.1 Berlin Starter
 
#2

AW: Form in neuem Thread laufen lassen

  Alt 17. Apr 2017, 13:05
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.
"Do not argue with an idiot. He will drag you down to his level and beat you with experience."
  Mit Zitat antworten Zitat
Hobbycoder

Registriert seit: 22. Feb 2017
230 Beiträge
 
#3

AW: Form in neuem Thread laufen lassen

  Alt 17. Apr 2017, 13:27
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.
  Mit Zitat antworten Zitat
Michael II

Registriert seit: 1. Dez 2012
Ort: Region Bern CH
143 Beiträge
 
Delphi 10.2 Tokyo Professional
 
#4

AW: Form in neuem Thread laufen lassen

  Alt 17. Apr 2017, 13:30
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 .
  Mit Zitat antworten Zitat
Hobbycoder

Registriert seit: 22. Feb 2017
230 Beiträge
 
#5

AW: Form in neuem Thread laufen lassen

  Alt 17. Apr 2017, 13:51
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.
  Mit Zitat antworten Zitat
Michael II

Registriert seit: 1. Dez 2012
Ort: Region Bern CH
143 Beiträge
 
Delphi 10.2 Tokyo Professional
 
#6

AW: Form in neuem Thread laufen lassen

  Alt 17. Apr 2017, 14:24
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.
  Mit Zitat antworten Zitat
Benutzerbild von Zacherl
Zacherl

Registriert seit: 3. Sep 2004
4.059 Beiträge
 
Delphi 10.1 Berlin Starter
 
#7

AW: Form in neuem Thread laufen lassen

  Alt 17. Apr 2017, 15:46
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
"Do not argue with an idiot. He will drag you down to his level and beat you with experience."
  Mit Zitat antworten Zitat
Benutzerbild von Uwe Raabe
Uwe Raabe
Online

Registriert seit: 20. Jan 2006
Ort: Lübbecke
4.733 Beiträge
 
Delphi 10.2 Tokyo Architect
 
#8

AW: Form in neuem Thread laufen lassen

  Alt 17. Apr 2017, 16:04
wer hat denn heutzutage auch noch so einen Holz-Computer
Sieht doch schick aus, oder?
Miniaturansicht angehängter Grafiken
incase_gehc3a4use3_web1.jpg   incase_tastatur_web.jpg  
Uwe Raabe
Certified Delphi Master Developer
Embarcadero MVP
Blog: The Art of Delphi Programming
  Mit Zitat antworten Zitat
Michael II

Registriert seit: 1. Dez 2012
Ort: Region Bern CH
143 Beiträge
 
Delphi 10.2 Tokyo Professional
 
#9

AW: Form in neuem Thread laufen lassen

  Alt 17. Apr 2017, 16:18
Mit einem solchen Thread könntest du dein Formular ruckelfrei einblenden:

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:

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... .
  Mit Zitat antworten Zitat
Michael II

Registriert seit: 1. Dez 2012
Ort: Region Bern CH
143 Beiträge
 
Delphi 10.2 Tokyo Professional
 
#10

AW: Form in neuem Thread laufen lassen

  Alt 17. Apr 2017, 16:40
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 .
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 08:17 Uhr.
Powered by vBulletin® Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2017 by Daniel R. Wolf