Dynamisches Form erscheint zu spät

Rund um die LCL und andere Komponenten

Dynamisches Form erscheint zu spät

Beitragvon Mathias » 22. Apr 2018, 16:48 Dynamisches Form erscheint zu spät

Ich will mit folgendem Code, ein "Bitte warten..." Form erzeugen. Das sleep() simuliert Initialisierungen .
Nur dummerweise erscheint es erst, nach dem die 3s verstrichen sind. Auch wird das Form1 nich für 3s grün, es wird dann direkt blau.

Wie kann ich es erzwingen, das das "Bitte warten "- Form vorher erscheint ?
Geht dies überhaupt ?
Ich habe es mit Update, Invalidate, ProcessMessage probiert, aber ohne Erfolg. :cry:
Code: Alles auswählen
unit Unit1;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ExtCtrls;
 
type
 
  { TForm1 }
 
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
 
  public
 
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.lfm}
 
// "Bitte warten" Form
 
type
  TMyForm = class(TForm)
    constructor CreateNew(TheOwner: TComponent);
  end;
 
constructor TMyForm.CreateNew(TheOwner: TComponent);
var
  p: TPanel;
begin
  inherited CreateNew(TheOwner);
  p := TPanel.Create(Self);
  p.Caption:='Bitte warten...';
  p.Parent := Self;
end;
 
{ TForm1 }
 
procedure TForm1.Button1Click(Sender: TObject);
var
  f: TMyForm;
begin
  f := TMyForm.CreateNew(self);
  f.Update; // Bringt alles nichts
  f.Invalidate;
  Application.ProcessMessages;
  f.Show;
 
  Color := clGreen;
  sleep(3000); // Mache etwas
  Color := clBlue;
  //  f.free;
end;
 
end.
 
Mit Lazarus sehe ich gün
Mit Java und C/C++ sehe ich rot
Mathias
 
Beiträge: 4342
Registriert: 2. Jan 2014, 17:21
Wohnort: Schweiz
OS, Lazarus, FPC: Linux (die neusten Trunc) | 
CPU-Target: 64Bit
Nach oben

Beitragvon Michl » 22. Apr 2018, 19:58 Re: Dynamisches Form erscheint zu spät

So sollte es gehen:
Code: Alles auswählen
procedure TForm1.Button1Click(Sender: TObject);
var
  f: TMyForm;
begin
  f := TMyForm.CreateNew(self);
//  f.Update; // Bringt alles nichts
//  f.Invalidate;
//  Application.ProcessMessages;
  f.Show;
  Color := clGreen;
  Application.ProcessMessages// <-- hier die Abarbeitung der Queue
  sleep(3000); // Mache etwas
  Color := clBlue;
  //  f.free;
end;
Code: Alles auswählen
type
  TLiveSelection = (lsMoney, lsChilds, lsTime);
  TLive = Array[0..1] of TLiveSelection; 
Michl
 
Beiträge: 2260
Registriert: 19. Jun 2012, 11:54
OS, Lazarus, FPC: Win7 Laz 1.7 Trunk FPC 3.1.1 Trunk | 
CPU-Target: 32Bit/64bit
Nach oben

Beitragvon Mathias » 22. Apr 2018, 21:28 Re: Dynamisches Form erscheint zu spät

Ich habe nun den Code folgendermassen abgeändert.
Code: Alles auswählen
procedure TForm1.Button1Click(Sender: TObject);
var
  f: TMyForm;
begin
  f := TMyForm.CreateNew(Self);
  f.Show;
 
  Color := clGreen;
  Application.ProcessMessages;
  sleep(3000); // Mache etwas
  Color := clBlue;
 
  f.free;
end;

Das erste Fenster wird nun Grün und wird nach 3s Blau, wie erwartet. Auch erscheint das 2. Form für 3s.
Aber das Panel im 2. Form, wird mir nur gelegentlich angezeigt, so ca. bei jedem 4. Button-Klick.

Entferne ich die Zeile mit
Code: Alles auswählen
Color := clGreen;
Dann erscheint das Panel gar nie.

Wen ich
Code: Alles auswählen
f.free;
entferne, nach 3s erscheint das Panel dann immer.


Wen ich das sleep splitte, dann erscheint das Panel auch immer, aber dies ist eigentlich nicht, was ich will.
Code: Alles auswählen
procedure TForm1.Button1Click(Sender: TObject);
var
  f: TMyForm;
  i: integer;
begin
  f := TMyForm.CreateNew(Self);
  f.Show;
 
  for i := 0 to 99 do begin
    Application.ProcessMessages;
    sleep(30); // Mache etwas
  end;
  Color := clBlue;
 
  f.Free;
end;
 
Mit Lazarus sehe ich gün
Mit Java und C/C++ sehe ich rot
Mathias
 
Beiträge: 4342
Registriert: 2. Jan 2014, 17:21
Wohnort: Schweiz
OS, Lazarus, FPC: Linux (die neusten Trunc) | 
CPU-Target: 64Bit
Nach oben

Beitragvon Achtzig » 23. Apr 2018, 02:46 Re: Dynamisches Form erscheint zu spät

Wenn man Application.ProcessMessages hinter Color:=clGreen aufruft, wird bei mir alles richtig angezeigt. Ist schon ein wenig überraschend, daß sonst kein Panel angezeigt wird, Color:=clGreen hat ja soweit nichts mit dem dynamisch erstellten Dialog zu tun.

Code: Alles auswählen
procedure TForm1.Button1Click(Sender: TObject);
var
  f: TMyForm;
begin
  f := TMyForm.CreateNew(self);
  f.Show;
  Color := clGreen;
  Application.ProcessMessages;
  sleep(3000); // Mache etwas
  Color := clBlue;
  f.free;
end;
 


Nachtrag: Oh, Michl hatte ja das Gleiche :oops: Hatte mich da langsam hin gearbeitet und das nicht gemerkt.
Achtzig
 
Beiträge: 89
Registriert: 15. Okt 2007, 12:09
OS, Lazarus, FPC: Debian | 
CPU-Target: xxBit
Nach oben

Beitragvon Michl » 23. Apr 2018, 09:03 Re: Dynamisches Form erscheint zu spät

Die LCL arbeitet mit Messages. Dabei gibt es unterschiedliche Arten, wie eine Message abgesandt wird. Vergleiche (google) mal PostMessage mit SendMessage.

Um sicher zu gehen, daß das erste Formular fertig dargestellt wird, um zeitaufwendige Aufgaben zu erledigen, musst du warten, bis die Mainqueue keine Messages mehr in der Schleife abzuarbeiten hat. Da beim erstellen eines neuen Formulars durchaus je nach Widgetset Messages per PostMessage an das OS gesandt werden können, musst du auch abwarten, daß diese neu gesandten Messages abgearbeitet wurden, bevor du mit der zeitaufwendigen Arbeit beginnen kannst. Mit Application.QueueAsyncCall kannst du sowas bewerkstelligen.

z.B.:
Code: Alles auswählen
unit Unit1;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ExtCtrls;
 
type
 
  { TMyForm }
 
  TMyForm = class(TForm)
  private
    Panel: TPanel;
    FOnShowing: TNotifyEvent;
    procedure CallOnShowing(Data: PtrInt);
    procedure MyFormShow(Sender: TObject);
    procedure PanelPaint(Sender: TObject);
  public
    constructor CreateNew(AOwner: TComponent; Num: Integer = 0); override;
    property OnShowing: TNotifyEvent read FOnShowing write FOnShowing;
  end;
 
  { TForm1 }
 
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    FMyForm: TMyForm;
    procedure FMyFormShowing(Sender: TObject);
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.lfm}
 
procedure TMyForm.CallOnShowing(Data: PtrInt);
begin
  if Assigned(FOnShowing) then
    FOnShowing(Self);
end;
 
procedure TMyForm.MyFormShow(Sender: TObject);
begin
  Application.QueueAsyncCall(@CallOnShowing, 0);
end;
 
procedure TMyForm.PanelPaint(Sender: TObject);
begin
  Application.QueueAsyncCall(@CallOnShowing, 0);
  Panel.OnPaint := nil;
end;
 
constructor TMyForm.CreateNew(AOwner: TComponent; Num: Integer);
begin
  inherited CreateNew(AOwner, Num);
  Panel := TPanel.Create(Self);
  Panel.Caption := 'Bitte warten...';
  Panel.Parent := Self;
  OnShow := @MyFormShow;
//  Panel.OnPaint := @PanelPaint;  // <-- oder evtl. hier
end;
 
{ TForm1 }
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  FMyForm := TMyForm.CreateNew(Self);
  FMyForm.OnShowing := @FMyFormShowing;
  Color := clGreen;
  FMyForm.Show;
end;
 
procedure TForm1.FMyFormShowing(Sender: TObject);
begin
  sleep(3000); // Mache etwas
  Color := clBlue;
end;
 
end.
Zuletzt geändert von Michl am 23. Apr 2018, 19:58, insgesamt 1-mal geändert.
Code: Alles auswählen
type
  TLiveSelection = (lsMoney, lsChilds, lsTime);
  TLive = Array[0..1] of TLiveSelection; 
Michl
 
Beiträge: 2260
Registriert: 19. Jun 2012, 11:54
OS, Lazarus, FPC: Win7 Laz 1.7 Trunk FPC 3.1.1 Trunk | 
CPU-Target: 32Bit/64bit
Nach oben

Beitragvon Mathias » 23. Apr 2018, 17:08 Re: Dynamisches Form erscheint zu spät

Ich habe deinen Code ausprobiert, funktioniert leider auch nicht.
Das MyForm erscheint immer, aber das Panel wird nur zufällig gezeichnet.
Mit Lazarus sehe ich gün
Mit Java und C/C++ sehe ich rot
Mathias
 
Beiträge: 4342
Registriert: 2. Jan 2014, 17:21
Wohnort: Schweiz
OS, Lazarus, FPC: Linux (die neusten Trunc) | 
CPU-Target: 64Bit
Nach oben

Beitragvon Michl » 23. Apr 2018, 19:57 Re: Dynamisches Form erscheint zu spät

Unter welchem OS mit welchem Widgetset hast du das Problem?

Evtl. könnte man auch einen TIdleTimer starten und dort im OnTimer OnShowing feuern. Aber eigentlich sollte spätestens wenn das Panel gezeichnet (OnPaint) und die MainQueue abgearbeitet wurde, das Formular ordentlich sichtbar sein.
Code: Alles auswählen
type
  TLiveSelection = (lsMoney, lsChilds, lsTime);
  TLive = Array[0..1] of TLiveSelection; 
Michl
 
Beiträge: 2260
Registriert: 19. Jun 2012, 11:54
OS, Lazarus, FPC: Win7 Laz 1.7 Trunk FPC 3.1.1 Trunk | 
CPU-Target: 32Bit/64bit
Nach oben

Beitragvon Mathias » 24. Apr 2018, 08:20 Re: Dynamisches Form erscheint zu spät

Linux Mint cinamon.
Mit Lazarus sehe ich gün
Mit Java und C/C++ sehe ich rot
Mathias
 
Beiträge: 4342
Registriert: 2. Jan 2014, 17:21
Wohnort: Schweiz
OS, Lazarus, FPC: Linux (die neusten Trunc) | 
CPU-Target: 64Bit
Nach oben

Beitragvon Michl » 26. Apr 2018, 19:01 Re: Dynamisches Form erscheint zu spät

Ja, Cinnamon hat mit GTK2 diverse Probleme. Habe es jetzt mal probiert. Einzige zuverlässige Möglichkeit ob das Panel tatsächlich gezeichnet wurde, scheint der optische Test zu sein (ganz schöner Aufwand für so eine scheinbar simple Frage). Getestet Linux Mint Cinnamon (Projekt in Release Mode gebaut) und Windows:
Code: Alles auswählen
unit Unit1;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ExtCtrls, IntfGraphics, LCLType, LCLIntf, LCLProc;
 
type
 
  TColorArray = array of TColor;
 
  { TMyForm }
 
  TMyForm = class(TForm)
  private
    FPanelImage: TLazIntfImage;
    Panel: TPanel;
    IdleTimer: TIdleTimer;
    FOnShowing: TNotifyEvent;
    function GetPanelImage: TLazIntfImage;
    function GetPanelMiddleColors: TColorArray;
    function PanelPainted: Boolean;
    procedure TimerTimer(Sender: TObject);
  public
    constructor CreateNew(AOwner: TComponent; Num: Integer = 0); override;
    property OnShowing: TNotifyEvent read FOnShowing write FOnShowing;
  end;
 
  { TForm1 }
 
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    FMyForm: TMyForm;
    procedure FMyFormShowing(Sender: TObject);
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.lfm}
 
function TMyForm.GetPanelImage: TLazIntfImage;
var
  PanelDC: HDC;
begin
  if Assigned(FPanelImage) then Exit(FPanelImage);
 
  Result := nil;
  FPanelImage := TLazIntfImage.Create(Panel.Width, Panel.Height);
  PanelDC := GetDC(Panel.Handle);
  try
    FPanelImage.LoadFromDevice(PanelDC);
    Result := FPanelImage;
  except
    on e: Exception do
      DebugLn('TMyForm.GetPanelImage ' + e.Message);
  end;
  ReleaseDC(Panel.Handle, PanelDC);
end;
 
function TMyForm.GetPanelMiddleColors: TColorArray;
var
  ARect: TRect;
  x, y: Integer;
  AColor, OldColor: TColor;
begin
  SetLength(Result, 0);
  if not Assigned(GetPanelImage) then Exit;
  ARect := Panel.BoundsRect;
  y := ARect.Top + ARect.Height div 2;
  OldColor := -1;
  for x := 0 to ARect.Width - 1 do
  begin
    AColor := FPColorToTColor(GetPanelImage.Colors[x, ARect.Top + y]);
    if (AColor <> OldColor) then
    begin
      SetLength(Result, Length(Result) + 1);
      Result[High(Result)] := AColor;
      OldColor := AColor;
    end;
  end;
end;
 
function TMyForm.PanelPainted: Boolean;
begin
  FreeAndNil(FPanelImage);
  Result := Length(GetPanelMiddleColors) > 20;
  FreeAndNil(FPanelImage);
end;
 
procedure TMyForm.TimerTimer(Sender: TObject);
begin
  if not PanelPainted then Exit;
  IdleTimer.Enabled := False;
  if Assigned(FOnShowing) then
    FOnShowing(Self);
end;
 
constructor TMyForm.CreateNew(AOwner: TComponent; Num: Integer);
begin
  inherited CreateNew(AOwner, Num);
  Panel := TPanel.Create(Self);
  Panel.Caption := 'Bitte warten...';
  Panel.Parent := Self;
  IdleTimer := TIdleTimer.Create(Self);
  IdleTimer.Interval := 10;
  IdleTimer.OnTimer := @TimerTimer;
  IdleTimer.Enabled := True;
end;
 
{ TForm1 }
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  FMyForm := TMyForm.CreateNew(Self);
  FMyForm.OnShowing := @FMyFormShowing;
  Color := clGreen;
  FMyForm.Show;
end;
 
procedure TForm1.FMyFormShowing(Sender: TObject);
begin
  sleep(3000); // Mache etwas
  Color := clBlue;
  Application.ReleaseComponent(FMyForm);
end;
 
end.

Allerdings weiß ich nicht, ob es irgendwo bunte Themes gibt und wie es sich dann dort verhält.
Code: Alles auswählen
type
  TLiveSelection = (lsMoney, lsChilds, lsTime);
  TLive = Array[0..1] of TLiveSelection; 
Michl
 
Beiträge: 2260
Registriert: 19. Jun 2012, 11:54
OS, Lazarus, FPC: Win7 Laz 1.7 Trunk FPC 3.1.1 Trunk | 
CPU-Target: 32Bit/64bit
Nach oben

Beitragvon Mathias » 26. Apr 2018, 19:20 Re: Dynamisches Form erscheint zu spät

Ja, Cinnamon hat mit GTK2 diverse Probleme. Habe es jetzt mal probiert. Einzige zuverlässige Möglichkeit ob das Panel tatsächlich gezeichnet wurde, scheint der optische Test zu sein (ganz schöner Aufwand für so eine scheinbar simple Frage). Getestet Linux Mint Cinnamon (Projekt in Release Mode gebaut) und Windows:

Ups, der Aufwand ist ja gigantisch für so was scheinbar einfaches. TLazIntfImage, Timer, alles mögliche braucht es. :shock:
So wie es aussieht, wen noch mehr ausser des Panels auf das Form kommt, wird das ganze noch komplizierter. :roll:

Allerdings weiß ich nicht, ob es irgendwo bunte Themes gibt und wie es sich dann dort verhält.

Ob das Ganze Plattformübergreifend ist ?
Mit Lazarus sehe ich gün
Mit Java und C/C++ sehe ich rot
Mathias
 
Beiträge: 4342
Registriert: 2. Jan 2014, 17:21
Wohnort: Schweiz
OS, Lazarus, FPC: Linux (die neusten Trunc) | 
CPU-Target: 64Bit
Nach oben

Beitragvon kupferstecher » 26. Apr 2018, 19:49 Re: Dynamisches Form erscheint zu spät

Auf Linux (Mint) hatte und habe ich auch schon aehliche Probleme gehabt, allerdings unter QT, nicht GTK. Z.B kann ich bei einem Projekt das Trayicon nicht zur Laufzeit aendern, bei einem Minimalbeispiel (zur Fehlersuche) funktioniert es aber einwandfrei, genauso unter Windows. Ich vermute, es hat mit der Initialisierung zu tun. Dass das Form vielleicht intern noch nicht vollstaendig initialisiert ist, das Panel wird ja im Create erstellt. Hab aber selber noch keine Loesung gefunden.
kupferstecher
 
Beiträge: 166
Registriert: 17. Nov 2016, 11:52

• Themenende •

Zurück zu Komponenten und Packages



Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 1 Gast

porpoises-institution
accuracy-worried