Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: Общие вопросы > Показать popup menu в отдельном потоке

Автор: bazzzman 2.5.2007, 07:23

Пытаюсь показать popup menu в отдельном потоке

Код


var
  Form1: TForm1;
  Pop: TPopupMenu;

implementation

{$R *.dfm}

procedure TrayThreadProc; StdCall;
begin
 if TrackPopupMenu(Pop.Items.Handle, 0, 0, 0, 0 { reserved }, PopupList.Window, nil) = false then RaiseLastOSError;

 while true do
 begin
  Application.ProcessMessages;
 end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var Dummy: Cardinal;
begin
 Pop.Items.Add(NewItem('123', 0, false, true, nil, 0, 'na'));
 CreateThread(nil,0,@TrayThreadProc,nil,0,Dummy);
end;

initialization
 Pop := TPopupMenu.Create(nil);

finalization
 Pop.Free;

end.

Ничего не выходит. RaiseLastOSError = "A call to an OS function failed".
Может кто-нибудь знает в чем проблема?

Автор: aktuba 2.5.2007, 08:13

А для чего подобное извращение??? Если сильно надо - выложи какой-нибудь тестовый проект...

Автор: bazzzman 2.5.2007, 08:27

На генерацию меню уходит какое-то время (читаю файлы и папки с диска).

В главном потоке стоит callback для WH_LL_KEYBOARD, и при показе popup из главного потока есть лаги (подвисание программы и задержка в обработке callback'е). Даже задержка в 0.5 сек. при генерации меню видна.

Хочу вынести все в отдельный поток, чтобы не задерживать очередь.

Проект в атаче.

Автор: Snowy 2.5.2007, 12:29

1. Для работы в другом треде тебе нужно винапишное окно. Можно невидимое.
2. Никакого Application.ProcessMessages в треде!

Автор: Snowy 2.5.2007, 12:50

Вот собрал пример на коленке:

Код


type
  TForm1 = class(TForm)
    Button1: TButton;
    PopupMenu1: TPopupMenu;
    procedure Button1Click(Sender: TObject);
  private
    FtWnd: HWND;
    procedure FtWndProc(var Msg: TMessage);
  end;

var Form1: TForm1;

implementation

{$R *.dfm}

procedure TrayThreadProc; StdCall;
begin
  with Form1 do
  begin
    FtWnd := AllocateHWnd(FtWndProc);
    SetForegroundWindow(FtWnd);
    TrackPopupMenu(PopupMenu1.Handle, 0, Mouse.CursorPos.X, Mouse.CursorPos.Y, 0, FtWnd, nil);
    DeallocateHWnd(FtWnd);
  end;
end;

procedure TForm1.FtWndProc(var Msg: TMessage);
begin
  with Msg do
    Result := DefWindowProc(FtWnd, Msg, wParam, lParam);
end;

procedure TForm1.Button1Click(Sender: TObject);
var Dummy: Cardinal;
begin
 PopupMenu1.Items.Add(NewItem('123', 0, false, true, nil, 0, 'na'));
 CreateThread(nil,0,@TrayThreadProc,nil,0,Dummy);
end;

Автор: bazzzman 3.5.2007, 01:34

Snowy, спасибо. Проблема решена smile

Собственно вот этого не знал:

Цитата(Snowy @ 2.5.2007, 12:29

)

1. Для работы в другом треде тебе нужно винапишное окно. Можно невидимое.
2. Никакого Application.ProcessMessages в треде!

Буду искать информацию на эту тему.

Автор: Snowy 3.5.2007, 01:45

Просто VCL всегда работает только в основном треде.
Хочешь вторичные - нужны независимы функции. Если окно,то неVCL окно. VCL не может работать во вторичном треде - только в основном.
Ну а Application - это всега базовый тред. Нельзя его трогать во вторичном.
Вобщем VCL - это всега базовый тред. И при мультитреде всегда нужно трогать его очень осторожно, а лучше вообще не трогать.

Автор: bazzzman 3.5.2007, 05:17

Понял, спасибо большое. smile