powered by simpleCommunicator - 2.0.59     © 2025 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Как показать юзеру что прога работает и не повисла
8 сообщений из 8, страница 1 из 1
Как показать юзеру что прога работает и не повисла
    #32093719
falcon_k
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Приветствую многоуважаемый All!

Поделитесь опытом, как отобразить процесс выполнения проги во время обращения к базе и каких либо вычислений, если этот процесс занимает
некоторое время, а юзеру кажется что прога зависла.
Как вариант выводить ProgressBar по циклу в окне типа "Ждите ответа ...".
Но как это организовать, если главный поток программы занят работай
над процессом.
...
Рейтинг: 0 / 0
Как показать юзеру что прога работает и не повисла
    #32093730
alex_k
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
CreateThread и ctrl-f1 на него.
Там все понятно но вот маленький пример

var boolMustStopThread;

procedure yourproc(p:pointer);
begin
while not(boolMustStopThread) do
somthing();//here you do what you want
end;

var
ht,tid:integer;
begin
boolMustStopThread:=false;
ht:=CreateThread(nil,0,@yourproc,nil,0,tid);
DoYourWork;
//if youw work has done then stop do something()
boolMustStopThread:=true;
end;

есть меожество всяческих но, но сам разберешся.
...
Рейтинг: 0 / 0
Как показать юзеру что прога работает и не повисла
    #32093732
falcon_k
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
2alex_k\r
Вариант с пококом я уже пробовал сделать, но что-то не выходит:\r
\r
/topic/20335 \r
\r
или я чего-то недопонимаю.\r
\r
Возможно надо сам процесс работы в отдельный поток выделять, а в\r
основном производить прорисовку ProgressBarа.\r
Вот и хотел услышать совет, кто как делает.
...
Рейтинг: 0 / 0
Как показать юзеру что прога работает и не повисла
    #32093735
LexusR
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
попробуйте без потоков
типа
type
TForm1 = class(TForm)
ADOConnection1: TADOConnection;
ADOQuery1: TADOQuery;
BitBtn1: TBitBtn;
ProgressBar1: TProgressBar;
Timer1: TTimer;
procedure BitBtn1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{запуск запроса и Sleep(1) имитирует работу с базой - замените на ваш реальный запрос}
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
Caption := 'Start';
Timer1.Enabled := true;
ADOQuery1.Open;
while not ADOQuery1.Eof do
begin
Application.ProcessMessages;
sleep(1);
ADOQuery1.Next;
end;
Caption := 'Stop';
Timer1.Enabled := false;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
ProgressBar1.StepIt;
end;
...
Рейтинг: 0 / 0
Как показать юзеру что прога работает и не повисла
    #32093746
falcon_k
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
2LexusR
Идея понятна. Я примерно так и пробовал, но что делать если
ADOQuery1.Open работает долго. Тогда опс... и подвис как-бы.
и вставлять Application.ProcessMessages в каждое место
кода как бы не совсем правильно.
...
Рейтинг: 0 / 0
Как показать юзеру что прога работает и не повисла
    #32094029
LexusR
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
попробуй чтонибудь типа такого
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
UNIT1
...
   uses Unit2;
{$R *.dfm}
procedure TForm1.BitBtn1Click(Sender: TObject);
var
  WaitThread : TWait;
begin
  Caption := 'Start';
  WaitThread := TWait.Create(false,Self);
   try
     ADOQuery1.Open;
     while not ADOQuery1.Eof do
       begin
        sleep( 1 );
        ADOQuery1.Next;
       end;
   finally
     Caption := 'Stop';
     WaitThread.Terminate;
     WaitThread.WaitFor;
     WaitThread.Free;
   end;
end;

UNIT2
...
type
  TWaitForm = class(TForm)
    LbTime: TLabel;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    procedure CreateParams(var Params: TCreateParams); override;
  public
    { Public declarations }
  end;

  TWait = class(TThread)
  private
    fWaitForm  : TWaitForm;
    fStartTime : TDateTime;
  protected
    procedure Execute; override;
  public
    constructor Create(CreateSuspended: Boolean; Owner:TForm); virtual;
    destructor Destroy; override;
  end;
var
  WaitForm: TWaitForm;
implementation
{$R *.dfm}
procedure TWaitForm.CreateParams(var Params: TCreateParams);
begin
   inherited;
   with Params do begin
     Style := Style or WS_OVERLAPPED;
     if Self.Owner is TWinControl then
        WndParent := TWinControl(Self.Owner).Handle;
   end;
end;
procedure TWaitForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   Action := caFree;
end;
constructor TWait.Create(CreateSuspended: Boolean; Owner: TForm);
begin
   inherited Create(CreateSuspended);
   WaitForm := TWaitForm.Create(Owner);
   WaitForm.Caption := 'Îáðàáîòêà äàííûõ';
   WaitForm.Show;
   WaitForm.Update;
end;
destructor TWait.Destroy;
begin
   WaitForm.Free;
   inherited;
end;
procedure TWait.Execute;
begin
   fStartTime := Now;
   WaitForm.lbTime.Canvas.Lock;
   WaitForm.lbTime.Canvas.Brush.Color := WaitForm.lbTime.Color;
   WaitForm.lbTime.Canvas.TextOut( 1 , 1 ,FormatDateTime('[hh:nn:ss]', 0 ));
   WaitForm.lbTime.Canvas.UnLock;
   while (not Terminated) do
     begin
        Sleep( 10 );
        WaitForm.lbTime.Canvas.Lock;
        try
          WaitForm.lbTime.Canvas.Brush.Color := WaitForm.lbTime.Color;
          WaitForm.lbTime.Canvas.TextOut( 1 , 1 ,FormatDateTime('[hh:nn:ss]',Now-fStartTime));
        finally
          WaitForm.lbTime.Canvas.Unlock;
        end;
     end;
end;

...
Рейтинг: 0 / 0
Как показать юзеру что прога работает и не повисла
    #32094113
mpro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Проще курсор менять

screen.cursor:=hourglass;

..

screen.cursor:=default;
...
Рейтинг: 0 / 0
Как показать юзеру что прога работает и не повисла
    #32094988
falcon_k
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
2All

Пришел к выводу что для показа работы проги во время (долгого)
обращения к базе лучше показать анимационную картинку (Идет обрашение
к серверу) на форме а не обновлять ProgressBar.

Кто может подскажет где взять или кинет по мылу если есть такая.
Стандартными виндовскими (процесс поиска файлов) пользоваться не
очень охото.
...
Рейтинг: 0 / 0
8 сообщений из 8, страница 1 из 1
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Как показать юзеру что прога работает и не повисла
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]