Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2006.10.01;
Скачать: CL | DM;

Вниз

Танцы PopupMenu. с Потоком.   Найти похожие ветки 

 
Задачник   (2006-09-07 17:04) [0]

Произвожу поиск в выбранной папке (урезанный вариант) :

type
 MyScanThreader = class(TThread)
 private
   FItem : TMenuItem;
   FDirectory : String;
 protected
   procedure Execute; override;
 public
   constructor Create(Item : TMenuItem; Directory : String);
 end;

constructor MyScanThreader.Create(Item: TMenuItem; Directory: String);
begin
 inherited Create(false); //После создания потока сразу запускаем метод Execute.
 FItem := Item;
 FDirectory := Directory;
end;

procedure MyScanThreader.Execute;
var
 it : TMenuItem ;
 res : Integer ;
 SearchRec : TSearchRec ;
begin
 inherited;
 FreeOnTerminate := True; //После выполнения метода Execute освобождаем поток.
 SetPriorityClass(Self.Handle, REALTIME_PRIORITY_CLASS);//Устанавливаем максимальный приоритет
 //////////////////////// Ну и собственно ищем.
 if (FDirectory <> "") and (FDirectory[Length(FDirectory)] <> "\") then
   FDirectory := FDirectory + "\";
 res := FindFirst(FDirectory + "*.*", faAnyFile, SearchRec);
 while res = 0 do begin
   if (SearchRec.Name <> ".") and (SearchRec.Name <> "..") then begin
     it := TMenuItem.Create(FItem);
     it.Caption := SearchRec.Name;
     it.Hint := FDirectory + SearchRec.Name;
     FItem.Add(it);
   end;
 res := FindNext(SearchRec);
 end;
 FindClose(SearchRec);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
 it: TMenuItem;
begin
 it := TMenuItem.Create(PopupMenu1);
 with it do
 begin
   Enabled := False;
   Caption := "Пусто";
 end;
 PopupMenu1.Items.Add(it);
end;

И вот после щелчка по кнопке собственно и начинается танец:

procedure TForm1.Button1Click(Sender: TObject);
var
 Scan : MyScanThreader  ;
begin
 Scan := MyScanThreader.Create(PopupMenu1.Items, "C:\Program Files");
 PopupMenu1.Popup(Mouse.CursorPos.X, Mouse.CursorPos.y)
end;

Возможно, нужно установить задержку, или иную конструкцию для того, чтобы дождется пока поток не отработает, а уже потом показывать меню?

P.S. Да еще компилятор ругается: Value assigned to "Scan" never used указывая на эту строку
Scan := MyScanThreader.Create(PopupMenu1.Items, "C:\Program Files");


 
Пусик ©   (2006-09-07 17:12) [1]

Перекрой OnTerminate и в нем выполняй PopupMenu1.Popup(Mouse.CursorPos.X, Mouse.CursorPos.y)


 
Fay ©   (2006-09-07 18:55) [2]

Здесь точно нужен поток?


 
Задачник   (2006-09-07 19:03) [3]


> Здесь точно нужен поток?

Думал, возможно, скорость поиска увеличится.


 
Задачник   (2006-09-07 19:03) [4]


> Пусик ©

Нет это не то.


 
Пусик ©   (2006-09-07 22:59) [5]


> Задачник   (07.09.06 19:03) [4]
> > Пусик ©Нет это не то.


Ну что ж.
Будем вопросы задавать.
Первый - почему не подходит OnTerminate?


 
Mike Petrichenko   (2006-09-07 23:16) [6]

1. Поток нафиг не нужен. Нет от него здесь толку.
2. Для работы с VCL пользуй метод Synchronize.
3. Вот это кусок:

> procedure TForm1.Button1Click(Sender: TObject);
> var
>  Scan : MyScanThreader  ;
> begin
>  Scan := MyScanThreader.Create(PopupMenu1.Items, "C:\Program
> Files");
>  PopupMenu1.Popup(Mouse.CursorPos.X, Mouse.CursorPos.y)
> end;

должен выглядеть вот так:
with MyScanThreader.Create(PopupMenu1.Items, "C:\Program Files") do
 WaitFor;
 Free;
end;
PopupMenu1.Popup(Mouse.CursorPos.X, Mouse.CursorPos.y);
4. В конструкторе потока FreeOnTerminate := False;


 
Fay ©   (2006-09-08 02:56) [7]

2 Задачник   (07.09.06 19:03) [3]
> Думал, возможно, скорость поиска увеличится.
Не вижу оснований для такого предположения


 
Задачник   (2006-09-09 10:27) [8]


> Пусик ©   (07.09.06 22:59) [5]

У меня представлен урезанный вариант, в полной версии в процедуре определяется, что найдено, если папка на OnClick указывается одна процедура, если файл другой. Программа представляет из себя проводник, только состоящий из меню. При выборе меню папки вызывается опять эта же самая процедура поиска только с другими параметрами.


> Mike Petrichenko   (07.09.06 23:16) [6]

Спасибо, попробую.


> Fay ©   (08.09.06 02:56) [7]

Ща проверю, вот только доделаю.



Страницы: 1 вся ветка

Текущий архив: 2006.10.01;
Скачать: CL | DM;

Наверх




Память: 0.46 MB
Время: 0.017 c
1-1155717646
webpauk
2006-08-16 12:40
2006.10.01
Обращение к классу объектов


1-1156342131
Sam Stone
2006-08-23 18:08
2006.10.01
CoUnInitialize()


2-1157709922
Urvin
2006-09-08 14:05
2006.10.01
Отправить запрос на сервер


1-1156148868
DelphiLexx
2006-08-21 12:27
2006.10.01
Продвинутый PaintTo


2-1157791558
oleg_v
2006-09-09 12:45
2006.10.01
DBGridEh и селект





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский