VPF::Не получается сделать свой ProgressBar

EKoshelev

Дата 19.4.2007, 19:48 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 509
Регистрация: 1.9.2004

Репутация: нет
Всего: нет

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

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

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

--------------------

Вежливым и адекватным предлагаю общаться на "ты".

Sunvas

Дата 19.4.2007, 20:00 (ссылка)

(голосов:1)

Загрузка ...

Соль и сахар

Профиль
Группа: Участник
Сообщений: 3388
Регистрация: 12.3.2006
Где: Тосно

Репутация: 2
Всего: 89

Ошибка в 17й строке.

--------------------

Воспитывая детей по своему образу и подобию, родители почему-то надеются, что они будут лучше их.

Alexeis

Дата 19.4.2007, 20:11 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 34
Всего: 459

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

--------------------

Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать

EKoshelev

Дата 19.4.2007, 21:36 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 509
Регистрация: 1.9.2004

Репутация: нет
Всего: нет

Sunvas, Смышно было, я плакаль.

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

СПАСИБО!!!

--------------------

Вежливым и адекватным предлагаю общаться на "ты".

EKoshelev

Дата 16.1.2008, 10:32 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 509
Регистрация: 1.9.2004

Репутация: нет
Всего: нет

Продолжаю писать свой прогресс.

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

Короче, люди мне рассказали что есть 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 (ссылка)

(нет голосов)

Загрузка ...

АСУТП-кодер

Профиль
Группа: Комодератор
Сообщений: 1460
Регистрация: 5.3.2007
Где: Москва

Репутация: 9
Всего: 95

Цитата(EKoshelev @ 16.1.2008, 10:32

)

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

имхо, простите, глупость...

Цитата(EKoshelev @ 16.1.2008, 10:32

)

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

Они в принципе всегда работают параллельно, но ты везде понатыкал вызовы Synchronize - что и приводит к печальным результатам. Имхо дело в том, что синхронизировать надо только необходимую отрисовку на форме, а ты судя по всему пытаешься синхронизировать всю работу - естественно, у тебя вся параллельность идет к черту... Могу сказать, что недавно писал программу, где около 10-15 самописных компонентов работали с потоками, которые параллельно отрисовывали что-то на одной и той же форме и все работает на ура, так что убирай лишние Synchronize, оптимизируй свой код и будет тебе щастье...

--------------------

самурай без меча подобен самураю с мечом, но только без меча

ivan219

Дата 16.1.2008, 12:10 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1121
Регистрация: 19.11.2005
Где: Планета земля

Репутация: 5
Всего: 12

Да и весь код желательно посмотреть а так присоединяюсь к Sunvas

--------------------

Мой первый сайт и моя первая программа!!!!!

MetalFan

Дата 16.1.2008, 12:52 (ссылка)

(голосов:1)

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 22
Всего: 128

Цитата(EKoshelev @ 16.1.2008, 10:32

)

Основная задача (Task) работает в одном процессе, прогресс (PB) - в другом. Оба наследники от TThread

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

--------------------

There are always someone smarter than you...

MetalFan

Дата 16.1.2008, 13:31 (ссылка)

(нет голосов)

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 22
Всего: 128

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

Код



...
  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;
...

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

Это сообщение отредактировал(а) MetalFan - 16.1.2008, 13:32

Присоединённый файл ( Кол-во скачиваний: 15 )

ThreadDrawProgress_out.rar 1,71 Kb

--------------------

There are always someone smarter than you...

EKoshelev

Дата 17.1.2008, 10:07 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 509
Регистрация: 1.9.2004

Репутация: нет
Всего: нет

Вот чё я понаписал на основе долбанины 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;

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

Это сообщение отредактировал(а) EKoshelev - 17.1.2008, 10:13

Присоединённый файл ( Кол-во скачиваний: 10 )

thread.rar 1,43 Kb

--------------------

Вежливым и адекватным предлагаю общаться на "ты".

ama_kid

Дата 17.1.2008, 11:11 (ссылка)

(нет голосов)

Загрузка ...

АСУТП-кодер

Профиль
Группа: Комодератор
Сообщений: 1460
Регистрация: 5.3.2007
Где: Москва

Репутация: 9
Всего: 95

Цитата(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.

Это сообщение отредактировал(а) ama_kid - 17.1.2008, 11:15

--------------------

самурай без меча подобен самураю с мечом, но только без меча

EKoshelev

Дата 17.1.2008, 15:51 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 509
Регистрация: 1.9.2004

Репутация: нет
Всего: нет

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

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

Вот.

--------------------

Вежливым и адекватным предлагаю общаться на "ты".

MetalFan

Дата 17.1.2008, 16:06 (ссылка)

(нет голосов)

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 22
Всего: 128

Цитата(EKoshelev @ 17.1.2008, 10:07

)

долбанины MetalFan'а.

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

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

Добавлено через 33 секунды

Цитата(EKoshelev @ 17.1.2008, 15:51

)

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

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

--------------------

There are always someone smarter than you...

ama_kid

Дата 17.1.2008, 16:21 (ссылка)

(нет голосов)

Загрузка ...

АСУТП-кодер

Профиль
Группа: Комодератор
Сообщений: 1460
Регистрация: 5.3.2007
Где: Москва

Репутация: 9
Всего: 95

EKoshelev, у тебя обработчик кнопки зацикливает приложение, тем самым не давая приложению получать сообщения об обновлении окон (да и вообще всех сообщений). Сам поток может не переставать крутиться, но его останавливает именно отрисовка окна Synchronize(UpdateProgress); - пока сообщения приложению не приходят - из этой процедуры не выйти (без этой команды поток продолжает работать в фоне нормально во время зацикливания)...

Цитата(MetalFan @ 17.1.2008, 16:06

)

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

Пример не мой, я только сделал "чтоб работало" smile

И кстати, ничего там не теряется, просто зацикливать обработчик событий - не совсем хорошая идея...

--------------------

самурай без меча подобен самураю с мечом, но только без меча

EKoshelev

Дата 17.1.2008, 16:47 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 509
Регистрация: 1.9.2004

Репутация: нет
Всего: нет

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

Цитата

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

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

Цитата

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

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

Это сообщение отредактировал(а) EKoshelev - 17.1.2008, 16:49

--------------------

Вежливым и адекватным предлагаю общаться на "ты".

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Для новичков \| Следующая тема »