Komunikaty w trakcie wykonywania innej operacji

0

Witam,
Chciał bym aby podczas wykonywania operacji wyświetlany był komunikat
proszę czekać trwa obliczanie i po skończonych obliczeniach komunikat
Obliczenia zakończone. Proszę o podpowiedz lub naprowadzenia jak to wykonać.

ShowMessage('Proszę czekać trwa obliczanie');

usunięcie pustej linii z kodu - fp

0

Dezaktywujesz okno glowne
2a. Tworzysz komunikat: Przygotowujesz tresc, moze jakis progressbar i dezaktywujesz przycisk ok
2b. Tworzysz komunikat bez przycisku i go wyswietlasz
Odpalasz drugi watek z operacja
Watek glowny sprawdza czy drugi watek sie zakonczyl i jesli sie zakonczyl
4a. Uaktywniasz przycisk
4b. Zamykasz komunikat

0

musisz te operacje przeprowadzać w osobnym wątku

0

Kolejne pytanie moje brzmi jak mam wywołać lub utworzyć drugi wątek w Lazarus ?, pod Delphi znalazłem informację jak tworzyć wątki , Rozdział 8

0

http://wiki.freepascal.org/Multithreaded_Application_Tutorial

0

Dodam jeszcze, że jeśli z jakichś powodów nie chcesz wykorzystać do tego osobnego wątku - możesz zablokować formularz główny, po czym wyświetlić niemodalnie formularz informacyjny (ze wspomnianą etykietą "proszę czekać - trwa obliczanie..."), a obliczenia wykonywać w wątku głównym; Po skończeniu obliczeń zamykasz formularz informacyjny i odblokowujesz okno główne; Żeby nie blokować programu można wykorzystać metodę Application.ProcessMessages;

Rozwiązanie prostsze, ale ma swoje minusy; Mimo wszystko warto jednak nauczyć się obsługi wątków.

0

n0name_l napisał(a):

Dezaktywujesz okno glowne
2a. Tworzysz komunikat: Przygotowujesz tresc, moze jakis progressbar i dezaktywujesz przycisk ok
2b. Tworzysz komunikat bez przycisku i go wyswietlasz

Odpalasz drugi watek z operacja

Watek glowny sprawdza czy drugi watek sie zakonczyl i jesli sie zakonczyl
4a. Uaktywniasz przycisk
4b. Zamykasz komunikat

Wykonałem coś takiego :

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ComCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    ProgressBar1: TProgressBar;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

type TWatek = class(TThread)
 private
   { Private declarations }
  protected

    procedure Execute; override;
end;



var
  Form1: TForm1;
  moj_watek:TWatek;
implementation

{$R *.lfm}

uses
   Unit2;

{ TForm1 }
procedure TWatek.Execute;
var
  i:integer;
begin
 FreeOnTerminate:=True;
//Program glowny wykonuje jakies obliczenia
for i:=1 to 100 do
    begin
      Form1.ProgressBar1.Position:=Form1.ProgressBar1.Position+1;
      Sleep(100);
    end;
Form2.Button1.Enabled:=True;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  Form2.Show;
  Form1.Enabled:=False;
  Form2.Button1.Enabled:=False;
  moj_watek.Resume;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  moj_watek:=TWatek.Create(true);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  moj_watek.Terminate;
end;

end.

oraz

unit Unit2;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;

type

  { TForm2 }

  TForm2 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form2: TForm2;

implementation
 {$R *.lfm}
 uses
   Unit1;

 { TForm2 }

 procedure TForm2.Button1Click(Sender: TObject);
 begin
   Form1.Enabled:=True;
   Form2.Close;
 end;

end.

Nadal nie mam pomysłu jak mam stworzyć drugi wątek ?
Czy lepszym rozwiązaniem było by zastosowanie ShowMessage zamiast formularza,
jeśli tak, Jak wtedy należ w nim zablokować przycisk OK ?

0

Biblioteka Jedy ma TThreadDialog

0

@pol2013: dlaczego najprościej nie zrobisz tego na CreateThread skoro się motasz z klasami. WinAPI rulez ;P Zawsze będę to powtarzał :) Na MSDNie masz opis co i jak. Natomiast jeżeli chcesz się bawić w okienko a'la dialogowe w stylu Delphiowatym. To nie wiem jak pod Lazarusem, ale powinno ze względu na wsteczną kompatybilnośc działać coś takiego jak poniżej. Oczywiście kod sobie możesz dostosować. Może oczywiście jeżeli ma się większe doświadczenia niż ja kombinować z sekcjami krytycznymi, ale skoro na StackOverFlow polecają metodę komunikatów dla wątku głownego to czemu by nie. Proste i skuteczne.

Zresztą jeżeli nie MessageDlg oparty o VCL, to zawsze możesz zapodać MessageBoxA/W i odpowiednio dobrać się do jego elementów, jak również w razie potrzeb cudować z funkcją obsługi komunikatów, ale już w kodzie WinAPI. Na Google znajdziesz na pewno przykład, bo sam patrzyłem jak na przykład podmdinić teksty na przyciskach MessageBoxa systemowego, który powinien być odporny na cudowanie w wątku. Jedno masz pokazane poniżej, to poszukaj sobie drugiego rozwiązania. I proszę w przyszłości pamiętaj. Najpierw googlujemy. Kombinujemy SAMI do BÓLU, a dopiero w ostateczności piszemy na forum.

Bo widzę, że Ty się chyba od razu poddałeś i jeb łubudu na forum do ludu ;) A przecież na pewno to co chcesz zrobić już nie jedna osoba kombinowała wcześniej i się z wiedzą podzieliła za pewne. Trzeba tylko po prostu chcieć pozyskiwać wiedzę metodami konwencjonalnymi czyli google i z zainstalowanym TBrain nawet pod Lazarusem idzie pracować ;) Tylko podkreślam, ja na szybko klepałem to w Delphi 7. I pewnie można jeszcze inaczej poza VCL, ale to może ktoś coś jeszcze tutaj doradzi. Ja zrobiłem tak, jak widzisz i działa ok.

//...
const
  Max_Secs = 5;
  WM_SHOWDLG = WM_USER + 666;
  WM_UPDATEDLG = WM_USER + 997;
  Dialog_Text = 'Czekamy - mineło: %d / %d sekund';

type
  TForm1 = class(TForm)
    Button1 : TButton;
    procedure Button1Click(Sender : TObject);
  private
    procedure OnShowDlg(var Msg : TMessage); message WM_SHOWDLG;
    procedure OnUpdateDlg(var Msg : TMessage); message WM_UPDATEDLG;
  public
  end;

var
  Form1 : TForm1;

implementation

{$R *.dfm}

var
  Dlg : TForm;

function ShowPolishMsgDlg(Msg : string; DlgType : TMSgDlgType; Buttons : TMsgDlgButtons) : TModalResult;
begin
  Dlg := CreateMessageDialog(Msg, DlgType, Buttons);
  Dlg.BorderIcons := [];
  Dlg.Caption := Application.Title;
  TButton(Dlg.FindComponent('Ok')).Caption := 'OK';
  TButton(Dlg.FindComponent('No')).Caption := '&Nie';
  TButton(Dlg.FindComponent('Yes')).Caption := '&Tak';
  TButton(Dlg.FindComponent('Help')).Caption := 'Pomoc';
  TButton(Dlg.FindComponent('Retry')).Caption := 'Ponów';
  TButton(Dlg.FindComponent('All')).Caption := 'Wszystko';
  TButton(Dlg.FindComponent('Cancel')).Caption := 'Anuluj';
  TButton(Dlg.FindComponent('Ignore')).Caption := 'Ignoruj';
  TButton(Dlg.FindComponent('NoToAll')).Caption := 'Nie na wszystko';
  TButton(Dlg.FindComponent('YesToAll')).Caption := 'Tak na wszystko';
  Dlg.ShowModal;
  Result := Dlg.ModalResult;
end;

procedure TForm1.OnUpdateDlg(var Msg : TMessage);
begin
  if Msg.WParam = 0 then
  begin
    TButton(Dlg.FindComponent('Ok')).Enabled := False;
  end;
  TLabel(Dlg.FindComponent('Message')).Caption := Format(Dialog_Text, [Msg.WParam, Msg.LParam])
end;

procedure TForm1.OnShowDlg(var Msg : TMessage);
begin
  ShowPolishMsgDlg(Format(Dialog_Text, [Msg.WParam, Msg.LParam]), mtInformation, [mbOk]);
end;

function ThreadFunc(Param : Pointer) : DWORD; stdcall;
var
  I, Maximum : integer;
begin
  Result := 0;
  Maximum := Integer(Param);
  PostMessage(Form1.Handle, WM_SHOWDLG, 0, Maximum);
  PostMessage(Form1.Handle, WM_UPDATEDLG, 0, Maximum);
  for I := 1 to Maximum do
  begin
    Sleep(1000);
    PostMessage(Form1.Handle, WM_UPDATEDLG, I, Maximum);
  end;
  TButton(Dlg.FindComponent('Ok')).Enabled := True;
end;

procedure TForm1.Button1Click(Sender : TObject);
var
  ThreadId : Cardinal;
begin
  CreateThread(nil, 0, @ThreadFunc, Pointer(Max_Secs), 0, ThreadId);
end;

0

do @pol2013

ja tylko napiszę, że to co próbowałeś wymodzić jest ŹLE. Nie możesz się odwoływać do elementów VCLa z innego wątku niż główny. To tak nie działa i nie tędy droga. Tu masz najprostszy przykład jak to może wyglądać.

W załączniku masz mój komponent, który działa w osobnym wątku niż główna forma. Ma to pewne ograniczenia - najpoważniejsze jak dla mnie to to, że nie może być modalny dla aplikacji. No ale coś za coś. Do działania potrzebuje jeszcze pakietu graphics32

Przykład użycia

procedure TForm1.btn1Click(Sender: TObject);
var
  i: Integer;
begin
  tws1.WindowLeft := (Screen.Width - tws1.Width) div 2;
  tws1.WindowTop := (Screen.Height - tws1.Height) div 2;
  tws1.Show;
  try
    for i := 0 to 100 do
    begin
      Sleep(100);
    end;
  finally
    tws1.Hide;
  end;
end;

Tu ThreadedWaitScreen_Demo.7z jest skompilowane demo. Jako animację można dodać animowanego gifa

0

@abrakadaber: pisałeś do mnie czy autora wątku? Czyli uważasz, że moje rozwiązanie też jest jednak złe? Sugerowałem się wygooglowaną podpowiedzią na StackOverFlow. Twój kod próbowałem analizowac, ale jeszcze mnie muli na tyle, że za dużo go i nie ogarniam niestety wszysykiego. Poza tym odpaliłem u siebie pobrany exek z demem i po chwili od kliknięcia robi się komunikat na pasku, że forma nie odpowiada. Zaś całoość nie da się przesunąć myszką. Po chwili całość po animacji się wywala i trzeba zamykać calość. System to Windows 7 64 bit.

0

A wystarczy tyle:

procedure TForm1.Button1Click(Sender: TObject);
begin
  CheckBox1.Checked:=true;
  JvThreadSimpleDialog1.DialogOptions.ShowDialog:=true;
  JvThread1.Execute(nil);
end;

procedure TForm1.JvThread1Execute(Sender: TObject; Params: Pointer);
begin
  while (not JvThread1.Terminated)and(CheckBox1.Checked) do
  begin
    Sleep(100);
  end;
end;

Komunikaty w trakcie wykonywania innej operacji

n0name_l napisał(a):

1 użytkowników online, w tym zalogowanych: 0, gości: 1

Praca dla programistów

Forum dyskusyjne

Sprawy administracyjne

O nas

Skontaktuj się z nami