Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Delphi: Для новичков > Не получается сделать свой ProgressBar


Автор: EKoshelev 19.4.2007, 19:48
Короче, написал прогресс бар свой, там всякие градиенты переливаются, заполняются проценты, все дела. Когда начал юзать всё это в качестве примочки (а не основной проги) выяснилось, что ничего не отображается, рефреши не помогают, нефига не выводится, короче, серый прямоугольник.

То есть, я напрмер, вызывают прорисовку новых процентов (там круговой сектор на имаге и лабел с процентами) делаю рефреш всего подряд и имаги и формы и ничего не вижу в итоге.

Подскажите как заставить всё это рисоваться! Плииииииз!

Автор: Sunvas 19.4.2007, 20:00
Ошибка в 17й строке.

Автор: Alexeis 19.4.2007, 20:11
EKoshelev, значит нужно просто все правильно нарисовать. В обработчике OnPaint, например. Так сразу нельзя сказать в чем проблема нужно видеть код отрисовки.

Автор: EKoshelev 19.4.2007, 21:36
Sunvas, Смышно было, я плакаль.


Alexeis, спасибо, брат. На ОнПаинт повесил там кой-чё и всё заработало.

СПАСИБО!!!

Автор: EKoshelev 16.1.2008, 10:32
Продолжаю писать свой прогресс.

Предыдущий подход дал весьма куций рисалт. Для того, чтобы на баре было движение приходилось везде где ни попадя в основном коде вызывать метод бара двигающий по бару изображение (тем самым пользователь понимал, что процесс идёт). Хотя, если попадались какие-то долго играющие ф-ции бар на долго останавливался.

Короче, люди мне рассказали что есть TThread. Нашел пример (в DRKB). Запустить основную прогу параллельно с потоком у меня не получилось (один мой товарищ предположил, что в дельфе это вообще невозможно). Зато получилось запустить параллельно два процесса (наследников от thреада). И то лишь в рамках примера.

Когда начал применять всё это к своей задаче, снова упёрся. Вощем тема такая. Основная задача (Task) работает в одном процессе, прогресс (PB) - в другом. Оба наследники от TThread. Создаются так:

PB := TSimplePB.Create(false);
Task := TTask.Create(false);

Вот как у обоих построены экзекуты:

Код

procedure TSimplePB.Execute;
begin
  while FActive do
    if FForm.Visible then
    begin
      Synchronize(Time);    // Бегалка прогресс-бара
      Sleep(100);
    end;
end;


procedure TTask.Execute;
var
  i: integer;
begin
  FExitFlag := true;              // Не важно
  Synchronize(Go);                // Не важно
  Synchronize(ShowForm2);         // Не важно

  if not FExitFlag then
  begin
    Synchronize(ShowPB);  // Показать панель с прогресс-баром (с этого момента он, по делу, должен забегать)
    Sleep(10000);         // 10-секундная пауза
    Synchronize(MakeAct); // То, ради чего я всё это затеял
    Synchronize(HidePB);  // Скрыть панель с прогресс-баром
    Suspended := true;
    ShowMessage('Акт сформирован');
  end;
end;



ShowPB запускает прогресс-бар. Пока работает Слип(10000) прогресс бегает, как только начинает работать Syncronizy(MakeAct), бар встаёт. Короче, не знаю что делать, чтобы они собаки параллельно работали. Подскажите мне пожалуйста как надо!!!!!!!!!!!

Или дайте наколку на бесплатный рабочий бар (чтобы просто градиент гнал в одну строну и на статус баре можно было писать чё щас делается)!!!

И ещё, если не в лом, подскажите можно ли всё-таки в дельфи заставить параллельно работать основной код и поток?

Автор: ama_kid 16.1.2008, 10:52
Цитата(EKoshelev @  16.1.2008,  10:32 Найти цитируемый пост)
(один мой товарищ предположил, что в дельфе это вообще невозможно)
имхо, простите, глупость...
Цитата(EKoshelev @  16.1.2008,  10:32 Найти цитируемый пост)
можно ли всё-таки в дельфи заставить параллельно работать основной код и поток?
Они в принципе всегда работают параллельно, но ты везде понатыкал вызовы Synchronize - что и приводит к печальным результатам. Имхо дело в том, что синхронизировать надо только необходимую отрисовку на форме, а ты судя по всему пытаешься синхронизировать всю работу - естественно, у тебя вся параллельность идет к черту... Могу сказать, что недавно писал программу, где около 10-15 самописных компонентов работали с потоками, которые параллельно отрисовывали что-то на одной и той же форме и все работает на ура, так что убирай лишние Synchronize, оптимизируй свой код и будет тебе щастье...

Автор: ivan219 16.1.2008, 12:10
Да и весь код желательно посмотреть а так присоединяюсь к Sunvas 

Автор: MetalFan 16.1.2008, 12:52
Цитата(EKoshelev @  16.1.2008,  10:32 Найти цитируемый пост)
Основная задача (Task) работает в одном процессе, прогресс (PB) - в другом. Оба наследники от TThread

что то автор слегка путает понятие процесса и нити...

Автор: MetalFan 16.1.2008, 13:31
интересная задача.
в частности меня заинтересовала отрисовка прогресса из другого потока.
вот накидал пример кода потока, который рисует прогресс.
примитивно, но для примера сойдет:
Код


...
  TProgressBarColored = class( TProgressBar )
  public
    property Color;
  end;

  TThreadProgress = class( TThread )
  private
  const
    FC_WM_UPDATEPARENT = WM_APP + 1;
  var
    FParentWnd: Cardinal;
    FProgressBar: TProgressBarColored;
    procedure SetParentWnd(const Value: Cardinal);
    procedure DoUpdateParentWnd;

    procedure CreateProgress;
    procedure FreeProgress;
    procedure UpdateProgress;

    procedure MessageLoop;
  protected
    procedure Execute; override;
  public
    constructor Create( AParentWnd: Cardinal );

    property ParentWnd: Cardinal read FParentWnd write SetParentWnd;
  end;
...
implementation
...
{ TThreadProgress }

constructor TThreadProgress.Create( AParentWnd: Cardinal );
begin
  inherited Create( False );
  FParentWnd := AParentWnd;
end;

procedure TThreadProgress.CreateProgress;
begin
  FProgressBar := TProgressBarColored.Create(nil);
  FProgressBar.ParentWindow := FParentWnd;
  FProgressBar.Color := clBtnFace;
end;

procedure TThreadProgress.DoUpdateParentWnd;
begin
  PostThreadMessage( ThreadID, FC_WM_UPDATEPARENT, 0, 0 );
end;

procedure TThreadProgress.Execute;
begin
  CreateProgress;
  MessageLoop;
  FreeProgress;
end;

procedure TThreadProgress.FreeProgress;
begin
  FProgressBar.Free;
end;

procedure TThreadProgress.MessageLoop;
var
  lMsg: TMsg;
begin
  while not Terminated do
  begin
    while PeekMessage( lMsg, 0, 0, 0, PM_REMOVE  ) do
    begin
      case lMsg.message of
        WM_QUIT:
        begin
          Terminate;
          break;
        end;
        FC_WM_UPDATEPARENT: FProgressBar.ParentWindow := FParentWnd;
      end;
      DispatchMessage( lMsg );
    end;
    UpdateProgress;
  end;
end;

procedure TThreadProgress.SetParentWnd(const Value: Cardinal);
begin
  InterlockedExchange( Integer(FParentWnd), Integer(Value) );
  DoUpdateParentWnd;
end;

procedure TThreadProgress.UpdateProgress;
begin
  sleep(10);
  if FProgressBar.Position = FProgressBar.Max then
     FProgressBar.Position := FProgressBar.Min
  else
    FProgressBar.StepBy(1);
end;
...


проект с примером использования в аттаче

Автор: EKoshelev 17.1.2008, 10:07
Вот чё я понаписал на основе долбанины MetalFan'а.

На превый взгляд всё как надо, но после нажатия на Button1 нельзя двигать мышью. Если двинешь, движение на баре останавливается. Если в методе

Код

procedure TMyThread.UpdateProgress;
var
  v: integer;
begin
  while FForm.Visible do
  begin
    FImage.Canvas.Draw(FPosition, 0, FBitmap);
    FImage.Canvas.Draw(FPosition - 255, 0, FBitmap);
    FPosition := (FPosition + 15) mod 256;

    FForm.Refresh;

//    Sleep(100);
  end;
end;


раскоментировать слип, то работает стабильнее, но всё равно время от времени прогресс преостанавливается.
У меня вопрос: "Что нужно дописать, чтобы прогресс не пропадал?"

Автор: ama_kid 17.1.2008, 11:11
Цитата(EKoshelev @  17.1.2008,  10:07 Найти цитируемый пост)
Что нужно дописать, чтобы прогресс не пропадал?
Ну хотя бы так (навскидку)
Код
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls;


const
    FC_WM_UPDATEPARENT = WM_APP + 1;


type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Panel1: TPanel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;


  TMyThread = class(TThread)
  private
    FForm: TForm;
    FPosition: integer;
    FImage: TImage;
    FBitmap: TBitmap;
    FStatusBar: TStatusBar;
    FMainForm: TForm;

    procedure FFormClose(Sender: TObject; var Action: TCloseAction);
    procedure CreateProgress;
    procedure UpdateProgress;
    procedure MessageLoop;
  public
    constructor Create(MainForm: TForm);
    destructor Destroy; override;

  protected
    procedure Execute; override;
  end;


var
  Form1: TForm1;
  MyThread: TMyThread;

implementation

{$R *.dfm}


constructor TMyThread.Create(MainForm: TForm);
begin
  FMainForm := MainForm;
  inherited Create(false);
end;


destructor TMyThread.Destroy;
begin
  FForm.Hide;
  FForm.Free;
  FBitmap.Free;
end;


procedure TMyThread.CreateProgress;
var
  i: integer;
begin
  FPosition := 0;
  FForm := TForm.Create(nil);
  FForm.Position:=poMainFormCenter;
  FForm.OnClose:=FFormClose;       
  FImage := TImage.Create(FForm);
  FImage.Parent := FForm;
  FImage.Left := 1;
  FImage.Top := 2;
  FImage.Width := 256;
  FImage.Height := 16;
  FForm.ClientWidth := 256;
  FForm.ClientHeight := 10;

  FStatusBar := TStatusBar.Create(FForm);
  FStatusBar.Parent := FForm;
  FStatusBar.Panels.Add;

  FBitmap := TBitmap.Create;
  FBitmap.Width := 256;
  FBitmap.Height := 16;

  for i := 0 to 255 do
  begin
    FBitmap.Canvas.Pen.Color := 16711680 + (257) * i;
    FBitmap.Canvas.MoveTo(i, 0);
    FBitmap.Canvas.LineTo(i, 16);
    FBitmap.Canvas.MoveTo(255 - i, 0);
    FBitmap.Canvas.LineTo(255 - i, 16);
  end;

  FForm.Show;
  FForm.FormStyle := fsStayOnTop;
  FForm.BorderStyle := bsToolWindow;

  FMainForm.SetFocus;
end;


procedure TMyThread.UpdateProgress;
begin
 FImage.Canvas.Draw(FPosition, 0, FBitmap);
 FImage.Canvas.Draw(FPosition - 255, 0, FBitmap);
 FPosition := (FPosition + 15) mod 256;
 FForm.Refresh;
end;

procedure TMyThread.MessageLoop;
begin
  while not Terminated do
   begin
    Synchronize(UpdateProgress);
    Sleep(20);
   end;
end;

procedure TMyThread.Execute;
begin
  Synchronize(CreateProgress);
  MessageLoop;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  MyThread := TMyThread.Create(self);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  i: integer;
begin
  for i := 0 to 300 do
  begin
    Panel1.Caption := IntToStr(i);
    Panel1.Refresh;
    Sleep(10);
    Application.ProcessMessages;
  end;
end;

procedure TMyThread.FFormClose(Sender: TObject; var Action: TCloseAction);
begin
 Terminate; 
 Action:=caFree;
end;

end.

Автор: EKoshelev 17.1.2008, 15:51
ama_kid, Пример работает конечно, только если после каждой строчки писать Application.ProcessMessages; то нафига вообще все эти нити с потоками?..

Я изо всех сил надеялся, что можно запустить его и не думать... до тех пор пока не потребуется его закрыть...

Вот.

Автор: MetalFan 17.1.2008, 16:06
Цитата(EKoshelev @  17.1.2008,  10:07 Найти цитируемый пост)
долбанины MetalFan'а.

сам ты долбанина)
НЕЛЬЗЯ взаимодействовать с VCL в осн.нити из дополнительной без синхронизации!!!
если обратите внимание, то я написал не Parent := SomeForm, а ParentWnd := SomeFormHandle;
в ином случае это приведет к непредвиденным глюкам в работе программы.


ama_kid, а в твоем примере смысл использования доп.нити теряется

Добавлено через 33 секунды
Цитата(EKoshelev @  17.1.2008,  15:51 Найти цитируемый пост)
Я изо всех сил надеялся, что можно запустить его и не думать... 

а подумать иногда тоже неплохо бывает  smile 

Автор: ama_kid 17.1.2008, 16:21
EKoshelev, у тебя обработчик кнопки зацикливает приложение, тем самым не давая приложению получать сообщения об обновлении окон (да и вообще всех сообщений). Сам поток может не переставать крутиться, но его останавливает именно отрисовка окна Synchronize(UpdateProgress); - пока сообщения приложению не приходят - из этой процедуры не выйти (без этой команды поток продолжает работать в фоне нормально во время зацикливания)...
Цитата(MetalFan @  17.1.2008,  16:06 Найти цитируемый пост)
ama_kid, а в твоем примере смысл использования доп.нити теряется
Пример не мой, я только сделал "чтоб работало"  smile И кстати, ничего там не теряется, просто зацикливать обработчик событий - не совсем хорошая идея...

Автор: EKoshelev 17.1.2008, 16:47
MetalFan, На счёт подумать ты, безусловно, прав. Только у меня по этой теме иныф минимум. Я, собственно, за этим сюда и сунулся.


Цитата
EKoshelev, у тебя обработчик кнопки зацикливает приложение, тем самым не давая приложению получать сообщения об обновлении окон (да и вообще всех сообщений).


Ну и чё? Получается, что если у меня процедурь пашет... ну скажем... минуты три, то параллельно с ней без Application.ProcessMessages; ничего не запустить? Если так, то как раз получается

Цитата
(один мой товарищ предположил, что в дельфе это вообще невозможно)



И вообще, ребята, имхо, тему я понятно сформулировал, а ответы всё типа "не плохо бы подумать", "я сделал штоп работало". Такое ощущение, что вы не помочь хотите, а "чисто поржать".

Автор: ama_kid 17.1.2008, 17:01
Цитата(EKoshelev @  17.1.2008,  16:47 Найти цитируемый пост)
Ну и чё? Получается, что если у меня процедурь пашет... ну скажем... минуты три, то параллельно с ней без Application.ProcessMessages; ничего не запустить?
Запускай сколько твоей душе угодно, любые рассчетные задачи и они будут работать нормально, но не надо "вешать" саму VCL. И дельфи тут вообще не причем, на WinAPI с такими зацикливаниями в основном потоке ты получишь то же самое...

Автор: MetalFan 17.1.2008, 17:57
Цитата(EKoshelev @  17.1.2008,  16:47 Найти цитируемый пост)
имхо, тему я понятно сформулировал

вот именно, что нифига не понятно!

я ж тебе пример дал - что в нем тебя не устраивает?

Автор: EKoshelev 18.1.2008, 09:44
ama_kid, что значит "не надо "вешать" саму VCL"?


MetalFan
1.
Попробую ещё раз объяснить что мне надо. Я работаю с БД не запросами, а через длл, которая в себе эти запросы реализует. Одна ф-я (ну там какой-нить поиск) может выполняться несколько минут. Я хобтел бы чтобы эти несколько минут по отдельно созданному окошку бегал градиент. Ну и при выполнении того же цикла не охота постоянно вызывать Application.ProcessMessages.

Надеюсь, теперь немного понятнее.

2. 
Твоё решение хорошее. Но я бы хотел запустить его на отдельном окошке. При попытке сделать это нарвался на проблемы, описанные выше. Товарищ ama_kid по моей просьбе сдлал так чтобы моя прога заработала, но мне не понравился в ней Application.ProcessMessages, т. к. если я буду исполнять метод, который работает три минуты - бар остановится на те же три минуты...

Автор: ama_kid 18.1.2008, 10:13
Цитата(EKoshelev @  18.1.2008,  09:44 Найти цитируемый пост)
Попробую ещё раз объяснить что мне надо. Я работаю с БД не запросами, а через длл, которая в себе эти запросы реализует. Одна ф-я (ну там какой-нить поиск) может выполняться несколько минут. Я хобтел бы чтобы эти несколько минут по отдельно созданному окошку бегал градиент. Ну и при выполнении того же цикла не охота постоянно вызывать Application.ProcessMessages.
Если твоя функция работает несколько минут в контексте основного потока - то у тебя при её вызове зависнет не только окно прогресс-бара, но и основное приложение, вызвавшее эту функцию (не важно, в dll она находится или нет) ибо на время выполнения функции остановится основной цикл выборки сообщений приложения. Вывод - тебе надо запускать твою функцию в отдельном потоке, предварительно определив callback-функции для прогресса  и завершения твоей "долгой" процедуры и вызывая их её контексте...
Цитата(EKoshelev @  18.1.2008,  09:44 Найти цитируемый пост)
ama_kid, что значит "не надо "вешать" саму VCL"?
Это как раз и значит - останавливать основной цикл выборки сообщений приложения...

Автор: EKoshelev 18.1.2008, 13:38
ama_kid, понял всё кроме фразы
Цитата
предварительно определив callback-функции для прогресса  и завершения твоей "долгой" процедуры и вызывая их её контексте...

Щё такое колбак-функция?
Ну и, признаццо, с точки зрения русского языка эта часть мессаги не очень ясна...

Автор: ama_kid 18.1.2008, 13:56
EKoshelev
в данном случае под callback-функциями я подразумевал функции основного потока, которые будут вызываться из порождённого потока. Т.е. при создании потока "долгой" процедуры ты ему передаёшь адреса твоих функций, а во время работы вызываешь их в соответствующие моменты. Для простоты я имею ввиду только две функции - та, которая будет вызываться после завершения каждого шага (допустим, отображение процента завершения) и та, которая будет вызываться после завершения операции целиком (приём\передача финальных данных). Ну и, ессно, не забывать про синхронизацию при их вызове

Автор: MetalFan 18.1.2008, 14:09
Цитата(ama_kid @  18.1.2008,  13:56 Найти цитируемый пост)
та, которая будет вызываться после завершения каждого шага (допустим, отображение процента завершения) и та, которая будет вызываться после завершения операции целиком (приём\передача финальных данных)

что-то опять путаница получается!
если ты будешь отдавать в кач.колбэков функции, которые будут что-то менять в объектах VCL основной нити, то это не есть хорошо.

Цитата(ama_kid @  18.1.2008,  13:56 Найти цитируемый пост)
Ну и, ессно, не забывать про синхронизацию при их вызове 

если ты про метод TThread.Synchonize, то смысл доп.нити теряется полностью.

Автор: ama_kid 18.1.2008, 15:01
Цитата(MetalFan @  18.1.2008,  14:09 Найти цитируемый пост)
смысл доп.нити теряется полностью. 
на мой взгляд - смысл доп. нитей в программе в том, чтобы организовать параллельную работу задач имеющих собственные обособленные данные. Если есть точки соприкосновения потоков в виде общих данных - то тут хочешь-не хочешь  приходится терять в параллельности из-за синхронизации. VCL - это и есть громадная точка соприкосновения рассматриваемых нами потоков и мне кажется тут по-любому некая часть параллельности уйдет в небытие, поэтому задача сводится к тому, чтобы эти потери минимизировать. Ты в своем примере организовал дополнительный цикл выборки сообщений, позволяющий это сделать, но автор не захотел его перенимать (более того, назвал "долбаниной"  smile) - его право. А по другому без синхронизации я плохо представляю себе решение данной задачи...

Автор: MetalFan 18.1.2008, 15:27
Цитата(ama_kid @  18.1.2008,  15:01 Найти цитируемый пост)
автор не захотел его перенимать (более того, назвал "долбаниной"  smile) - его право

в общем решение есть, если автор не понимает ньюнсов работы нитей, то пусть учит.

решение есть, но если он считает предыдущий мой пример "долбаниной", то пусть сам до него доходит, либо делает через попу с синхронизацией с главной нитью приложения.

Автор: EKoshelev 18.1.2008, 16:21
Цитата(MetalFan @  18.1.2008,  15:27 Найти цитируемый пост)
решение есть, но если он считает предыдущий мой пример "долбаниной", то пусть сам до него доходит, либо делает через попу с синхронизацией с главной нитью приложения.


Вот я как чувствовал, что беседа дойдёт до подбных фраз.
Чё касается слова "долбанина", то я просто назвал им текст программы, желая разнообразить свою речь. И конечно же не пытался никого оскорбить или как-то негативно отозваться о предложенном решении...


Короче, ребята, на сколько я понял своим, по видимому, не очень производительным разумом, то, что предложил тов. ama_kid работать будет, но это не красиво (я даже кажется понял, что предложено). Но решение, предложенное тов. MetalFan обнаружило в себе кой-какие недостатки (суть которых я, кажется, изложил). Хотя, если пожертвовать некторыми своими пожеланиями, то может и заработает (я не все нюансы рассмотрел).

Цитата(MetalFan @  18.1.2008,  15:27 Найти цитируемый пост)
если автор не понимает ньюнсов работы нитей, то пусть учит

Автор не только этого не понимает этих ньюнсов, он, как выяснилось, даже не видит разницы между нитью и потоком. Поучить не прочь. Был бы рад, если кто-нибудь великодушно подкинул какую-нибудь наколочку на эту тему. В DRKB, кажись, сей материал изложен не вполне подробно (кучка примеров с коментами).

В общем, изо всех сил постараюсь творчески осмыслить/переосмыслить все предложенные вами решения.
Спасибо, друзья!

Автор: MetalFan 18.1.2008, 16:44
Цитата(EKoshelev @  18.1.2008,  16:21 Найти цитируемый пост)
Был бы рад, если кто-нибудь великодушно подкинул какую-нибудь наколочку на эту тему

есть очень хорошая тема на этом форуме: http://forum.vingrad.ru/forum/topic-60076.html

Автор: Prof_2000 18.1.2008, 18:45
Вот пример с двумя доп. нитями. Одна нить работает сама по себе, а вторая синхронизируется с VCL и с первой нитью.

Автор: MetalFan 18.1.2008, 19:27
дааа... маразм крепчал)

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)