Dynamisches Form erscheint zu spät

Rund um die LCL und andere Komponenten
Antworten
Mathias
Beiträge: 6160
Registriert: Do 2. Jan 2014, 17:21
OS, Lazarus, FPC: Linux (die neusten Trunk)
CPU-Target: 64Bit
Wohnort: Schweiz

Dynamisches Form erscheint zu spät

Beitrag von Mathias »

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 grün
Mit Java und C/C++ sehe ich rot

Michl
Beiträge: 2505
Registriert: Di 19. Jun 2012, 12:54

Re: Dynamisches Form erscheint zu spät

Beitrag von Michl »

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; 

Mathias
Beiträge: 6160
Registriert: Do 2. Jan 2014, 17:21
OS, Lazarus, FPC: Linux (die neusten Trunk)
CPU-Target: 64Bit
Wohnort: Schweiz

Re: Dynamisches Form erscheint zu spät

Beitrag von Mathias »

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 grün
Mit Java und C/C++ sehe ich rot

Achtzig
Beiträge: 90
Registriert: Mo 15. Okt 2007, 13:09
OS, Lazarus, FPC: Debian
CPU-Target: xxBit

Re: Dynamisches Form erscheint zu spät

Beitrag von Achtzig »

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.

Michl
Beiträge: 2505
Registriert: Di 19. Jun 2012, 12:54

Re: Dynamisches Form erscheint zu spät

Beitrag von Michl »

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 Mo 23. Apr 2018, 20:58, insgesamt 1-mal geändert.

Code: Alles auswählen

type
  TLiveSelection = (lsMoney, lsChilds, lsTime);
  TLive = Array[0..1] of TLiveSelection; 

Mathias
Beiträge: 6160
Registriert: Do 2. Jan 2014, 17:21
OS, Lazarus, FPC: Linux (die neusten Trunk)
CPU-Target: 64Bit
Wohnort: Schweiz

Re: Dynamisches Form erscheint zu spät

Beitrag von Mathias »

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 grün
Mit Java und C/C++ sehe ich rot

Michl
Beiträge: 2505
Registriert: Di 19. Jun 2012, 12:54

Re: Dynamisches Form erscheint zu spät

Beitrag von Michl »

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; 

Mathias
Beiträge: 6160
Registriert: Do 2. Jan 2014, 17:21
OS, Lazarus, FPC: Linux (die neusten Trunk)
CPU-Target: 64Bit
Wohnort: Schweiz

Re: Dynamisches Form erscheint zu spät

Beitrag von Mathias »

Linux Mint cinamon.
Mit Lazarus sehe ich grün
Mit Java und C/C++ sehe ich rot

Michl
Beiträge: 2505
Registriert: Di 19. Jun 2012, 12:54

Re: Dynamisches Form erscheint zu spät

Beitrag von Michl »

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; 

Mathias
Beiträge: 6160
Registriert: Do 2. Jan 2014, 17:21
OS, Lazarus, FPC: Linux (die neusten Trunk)
CPU-Target: 64Bit
Wohnort: Schweiz

Re: Dynamisches Form erscheint zu spät

Beitrag von Mathias »

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 grün
Mit Java und C/C++ sehe ich rot

Benutzeravatar
kupferstecher
Beiträge: 418
Registriert: Do 17. Nov 2016, 11:52

Re: Dynamisches Form erscheint zu spät

Beitrag von kupferstecher »

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.

Antworten