Пользователь
Сообщения: 75
Благодарности: 0
|
Профиль
|
Отправить PM
| Цитировать
Что я делаю не так?Я хочу когда включаешь поиск что бы можно было передвигать форму сворачивать итд.Но когда я скнирую Диск С на наличие файлов.Форма намертво виснет.
Вот исходник окна с кнопкой, Editом и Memo.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Memo1: TMemo;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses Unit2;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
NewThread: Thread;
begin
Memo1.Clear; // очистка списка файлов
Form1.Label1.Caption:='Сканирую!';
NewThread:=Thread.Create(True);
NewThread.Priority:=tpLower;
NewThread.FreeOnTerminate:=True;
NewThread.FindFile(Form1.Edit1.Text);
NewThread.Resume;
end;
end.
Вот исходник созданного файла потока:
unit Unit2;
interface
uses
Classes {$IFDEF MSWINDOWS} , Windows {$ENDIF},SysUtils;
type
Thread = class(TThread)
private
Dir : string;
fff : string;
procedure SetName;
protected
procedure Execute; override;
public
procedure FindFile(Dir : string);
procedure Plus;
end;
implementation
uses Unit1, Unit3;
{ Important: Methods and properties of objects in visual components can only be
used in a method called using Synchronize, for example,
Synchronize(UpdateCaption);
and UpdateCaption could look like,
procedure Thread.UpdateCaption;
begin
Form1.Caption := 'Updated in a thread';
end; }
{$IFDEF MSWINDOWS}
type
TThreadNameInfo = record
FType: LongWord; // must be 0x1000
FName: PChar; // pointer to name (in user address space)
FThreadID: LongWord; // thread ID (-1 indicates caller thread)
FFlags: LongWord; // reserved for future use, must be zero
end;
{$ENDIF}
{ Thread }
procedure Thread.SetName;
{$IFDEF MSWINDOWS}
var
ThreadNameInfo: TThreadNameInfo;
{$ENDIF}
begin
{$IFDEF MSWINDOWS}
ThreadNameInfo.FType := $1000;
ThreadNameInfo.FName := 'NewThread';
ThreadNameInfo.FThreadID := $FFFFFFFF;
ThreadNameInfo.FFlags := 0;
try
RaiseException( $406D1388, 0, sizeof(ThreadNameInfo) div sizeof(LongWord), @ThreadNameInfo );
except
end;
{$ENDIF}
end;
procedure Thread.Execute;
begin
SetName;
if terminated then exit;
end;
procedure Thread.FindFile(Dir : String);
var
SR:TSearchRec;
FindRes:Integer;
begin
FindRes:=FindFirst(Dir+'*.*',faAnyFile,SR);
While FindRes=0 do
begin
if ((SR.Attr and faDirectory)=faDirectory) and
((SR.Name='.')or(SR.Name='..')) then
begin
FindRes:=FindNext(SR);
Continue;
end;
// åñëè íàéäåí êàòàëîã, òî
if ((SR.Attr and faDirectory)=faDirectory) then
begin
// âõîäèì â ïðîöåäóðó ïîèñêà ñ ïàðàìåòðàìè òåêóùåãî êàòàëîãà +
// êàòàëîã, ÷òî ìû íàøëè
FindFile(Dir+SR.Name+'\');
FindRes:=FindNext(SR);
// ïîñëå îñìîòðà âëîæåííîãî êàòàëîãà ìû ïðîäîëæàåì ïîèñê
// â ýòîì êàòàëîãå
Continue; // ïðîäîëæèòü öèêë
end;
fff:=SR.Name;
Synchronize(Plus);
FindRes:=FindNext(SR);
end;
FindClose(SR);
end;
procedure Thread.Plus;
begin
Form1.Memo1.Lines.Add(fff);
end;
end.
Что я делаю не так как нужно написать что бы не висла форма?
|
