Главная » Delphi » Мастер DDG Search

0

Помните небольшое изящное приложение для поиска  (Search),  разработка кото рого  была  описана в главе 5, “Создание многопоточных приложений”? В настоящем разделе изложено, как преобразовать эту утилиту в еще более полезный мастер  Delphi с минимальными изменениями кода. Этот мастер  называется DDG Search.

Сначала  рассмотрим модуль InitWiz.pas (листинг 17.6),  который обеспечивает взаимодействие мастера DDG Search  с интегрированной средой разработки. Нетруд но заметить, что  данный модуль очень  похож  на модуль из предыдущего примера  с тем же именем. И это неслучайно. Модуль InitWiz.pas является всего лишь копией модуля из предыдущего примера, в которую  внесены некоторые необходимые изме нения в имени мастера и методе  Execute(). Копирование и вставка — это именно то, что можно  назвать “старым  добрым”  наследованием. Зачем  набирать код вручную, ес ли он уже есть?

Листинг 17.6. InitWiz.pas — содержит логику мастера DDGSrch

unit InitWiz;

interface uses

Windows, ToolsAPI;

typeTSearchWizard = class(TNotifierObject, IOTAWizard, IOTAMenuWizard)

// Методы класса IOTAWizard function GetIDString: string; function GetName: string; function GetState: TWizardState; procedure Execute;

// Методы класса IOTAMenuWizard function GetMenuText: string;

end;

function InitWizard(const BorlandIDEServices: IBorlandIDEServices; RegisterProc: TWizardRegisterProc;

var Terminate: TWizardTerminateProc): Boolean stdcall;

var

ActionSvc: IOTAActionServices;

implementation

uses SysUtils, Dialogs, Forms, Controls, Main, PriU;

function TSearchWizard.GetName: string;

{ Возвращает имя мастера }

begin

Result := ‘DDG Search';

end;

function TSearchWizard.GetState: TWizardState;

{ Этот мастер всегда доступен в меню }

begin

Result := [wsEnabled];

end;

function TSearchWizard.GetIDString: String;

{ Возвращает уникальное имя мастера в формате Vendor.Product }

begin

Result := ‘DDG.DDGSearch';

end;

function TSearchWizard.GetMenuText: string;

{ Возвращает строку текста для помещения в меню Help }

begin

Result := ‘DDG Search Expert';

end;

procedure TSearchWizard.Execute;

{ Вызывается, если имя мастера выбрано в меню Help среды

разработки. В этой функции запускается мастер. }

begin

// Если форма не создана, то создать и отобразить ее

if MainForm = nil then begin

MainForm := TMainForm.Create(Application);ThreadPriWin := TThreadPriWin.Create(Application); MainForm.Show;

end else

// Если форма уже создана, то восстановить и отобразить ее

with MainForm do begin

if not Visible then Show;

if WindowState = wsMinimized then WindowState := wsNormal;

SetFocus;

end;

end;

function InitWizard(const BorlandIDEServices: IBorlandIDEServices; RegisterProc: TWizardRegisterProc;

var Terminate: TWizardTerminateProc): Boolean stdcall;

var

Svcs: IOTAServices;

begin

Result := BorlandIDEServices <> nil;

if Result then begin

Svcs := BorlandIDEServices as IOTAServices;

ActionSvc := BorlandIDEServices as IOTAActionServices;

ToolsAPI.BorlandIDEServices := BorlandIDEServices;

Application.Handle := Svcs.GetParentHandle;

RegisterProc(TSearchWizard.Create);

end;

end;

end.Функция  Execute() мастера немного отличается от  аналогичной функции, рас смотренной выше.  Главная  форма мастера MainForm отображается в немодальном режиме. Конечно, это  требует  написания дополнительного кода,  поскольку  заранее нельзя определить, когда форма действительно создана, а когда  переменная формы содержит некорректное значение. Для этого  необходимо, чтобы  переменная Main- Form имела  значение nil, когда мастер  неактивен. Более подробная информация по данной теме приведена далее в настоящей главе.

Еще  одним  существенным отличием этого  проекта от  примера,  приведенного в главе 5, “Создание многопоточных приложений”, является то,  что  файл  проекта те перь называется DDGSrch.dpr. Он приведен в листинге 17.7.

Листинг 17.7. DDGSrch.dpr — файл проекта DDGSrch

{$IFDEF BUILD_EXE}

program DDGSrch;

{$ELSE}

library DDGSrch;

{$ENDIF}

uses{$IFDEF BUILD_EXE} Forms,

{$ELSE} ShareMem, ToolsAPI,

InitWiz in ‘InitWiz.pas’,

{$ENDIF}

Main in ‘MAIN.PAS’ {MainForm},

SrchIni in ‘SrchIni.pas’,

SrchU in ‘SrchU.pas’,

PriU in ‘PriU.pas’ {ThreadPriWin},

MemMap in ‘..\..\Utils\MemMap.pas’,

DDGStrUtils in ‘..\..\Utils\DDGStrUtils.pas';

{$R *.RES}

{$IFNDEF BUILD_EXE}

exports

{ Точка входа, используемая средой разработки Delphi }

InitWizard name WizardEntryPoint;

{$ENDIF}

begin

{$IFDEF BUILD_EXE}

Application.Initialize;

Application.CreateForm(TMainForm, MainForm);

Application.Run;

{$ENDIF}

end.Как видно  из кода, данный файл  имеет  небольшой размер. Обратите внимание на два  важных  момента. Во первых, заголовок library показывает, что  будет  создан мастер  DLL. А, во вторых, для инициализации мастера интегрированной средой раз работки Delphi  экспортируется функция InitExpert().

В модуль Main этого  проекта также  было  внесено несколько изменений. Как уже

говорилось, если мастер неактивен, то переменная MainForm должна содержать зна

чение nil. Как уже упоминалось в главе  2, “Язык  программирования  Object Pascal”,

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

nil. Кроме  того,  в обработчике события OnClick экземпляр формы уничтожается, а

глобальная  переменная  MainForm принимает  значение  nil.  Этот  метод  имеет  сле

дующий вид:

procedure TMainForm.FormClose(Sender: TObject;

var Action: TCloseAction);

begin

Action := caFree;

Application.OnShowHint := FOldShowHint;

MainForm := nil;

end;И, наконец, с помощью рассматриваемого мастера можно, дважды щелкнув в спи ске главной формы, переносить файлы в редактор кода среды  разработки. Такая  воз можность реализована в методе FileLBDblClick() следующим образом:

procedure TMainForm.FileLBDblClick(Sender: TObject);

{ Вызывается, если пользователь дважды щелкнул в списке. Файл

загружается в интегрированную среду разработки. }

var

FileName: string;

Len: Integer;

begin

{ Удостовериться, что пользователь щелкнул на файле… }

if Integer(FileLB.Items.Objects[FileLB.ItemIndex]) > 0 then

begin

FileName := FileLB.Items[FileLB.ItemIndex];

{ Удалить из строк фрагменты "File " и ":". }

FileName := Copy(FileName, 6, Length(FileName));

Len := Length(FileName);

if FileName[Len] = ‘:’ then SetLength(FileName, Len – 1);

{ Открыть проект или файл }

{$IFNDEF BUILD_EXE}

if CompareText(ExtractFileExt(FileName), ‘.DPR’) = 0 then

ActionSvc.OpenProject(FileName, True)

else

ActionSvc.OpenFile(FileName);

{$ELSE}

ShellExecute(0, ‘open’, PChar(FileName), nil,

nil, SW_SHOWNORMAL);

{$ENDIF}

end;

end;

При   компиляции  в  качестве  мастера  эта  процедура  использует  методы   Open- File() и OpenProject() класса  IOTAActionServices, позволяющие открыть  со ответствующий файл.  При  компиляции в качестве автономного исполняемого файла EXE, данный метод  вызывает функцию API ShellExecute(), что  также  позволяет открыть файл, но используя для этого  приложение, ассоциированное с файлом дан ного расширения.

В листинге 17.8 приведен полный код модуля Main проекта DDGSrch, а на рис. 17.7 показан мастер  DDG Search, работающий в интегрированной среде.

Листинг 17.8. Main.pas — главный  модуль  проекта DDGSrch

unit Main;

interface

{$WARN UNIT_PLATFORM OFF}

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics,

Controls, Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, Menus,SrchIni, SrchU, ComCtrls;

type

TMainForm = class(TForm)

FileLB: TListBox;

PopupMenu1: TPopupMenu;

Font1: TMenuItem;

N1: TMenuItem;

Exit1: TMenuItem;

FontDialog1: TFontDialog;

StatusBar: TStatusBar;

AlignPanel: TPanel;

ControlPanel: TPanel;

ParamsGB: TGroupBox;

LFileSpec: TLabel;

LToken: TLabel;

lPathName: TLabel;

EFileSpec: TEdit;

EToken: TEdit;

PathButton: TButton;

OptionsGB: TGroupBox;

cbCaseSensitive: TCheckBox;

cbFileNamesOnly: TCheckBox;

cbRecurse: TCheckBox;

SearchButton: TBitBtn;

CloseButton: TBitBtn;

PrintButton: TBitBtn;

PriorityButton: TBitBtn;

View1: TMenuItem;

EPathName: TEdit;

procedure SearchButtonClick(Sender: TObject);

procedure PathButtonClick(Sender: TObject);

procedure FileLBDrawItem(Control: TWinControl; Index: Integer;

Rect: TRect; State: TOwnerDrawState);

procedure Font1Click(Sender: TObject);

procedure FormDestroy(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure PrintButtonClick(Sender: TObject);

procedure CloseButtonClick(Sender: TObject);

procedure FileLBDblClick(Sender: TObject);

procedure FormResize(Sender: TObject);

procedure PriorityButtonClick(Sender: TObject);

procedure ETokenChange(Sender: TObject);

procedure FormClose(Sender: TObject;

var Action: TCloseAction);

private

FOldShowHint: TShowHintEvent;

procedure ReadIni;

procedure WriteIni;

procedure DoShowHint(var HintStr: string;

var CanShow: Boolean; var HintInfo: THintInfo);

protected

procedure WndProc(var Message: TMessage); override;public

Running: Boolean;

SearchPri: integer;

SearchThread: TSearchThread;

procedure EnableSearchControls(Enable: Boolean);

end;

var

MainForm: TMainForm;

implementation

{$R *.DFM}

uses

{$IFNDEF BUILD_EXE}

InitWiz,

{$ENDIF}

Printers, ShellAPI, MemMap, FileCtrl, PriU;

procedure PrintStrings(Strings: TStrings);

{ Эта процедура печатает все строки из параметра Strings }

var

Prn: TextFile;

i: word;

begin

if Strings.Count = 0 then begin           // Строки есть?

MessageDlg(‘No text to print!’, mtInformation, [mbOk], 0);

Exit;

end;

AssignPrn(Prn);                           // Назначить принтеру Prn

try

Rewrite(Prn);                             // Открыть принтер

try

for i := 0 to Strings.Count – 1 do // Цикл по всем строкам

WriteLn(Prn, Strings.Strings[i]); // Запись на принтер

finally

CloseFile(Prn);                           // Закрыть принтер

end;

except

on EInOutError do

MessageDlg(‘Error Printing text.’, mtError, [mbOk], 0);

end;

end;

procedure TMainForm.EnableSearchControls(Enable: Boolean);

{ Разрешает или запрещает использование определенных элементов

управления, в зависимости от возможности модифицировать параметры

во время выполнения поиска. }

begin

// Разрешить/запретить соответствующие элементы управления

SearchButton.Enabled := Enable;

cbRecurse.Enabled := Enable;cbFileNamesOnly.Enabled := Enable; cbCaseSensitive.Enabled := Enable; PathButton.Enabled := Enable; EPathName.Enabled := Enable; EFileSpec.Enabled := Enable; EToken.Enabled := Enable;

Running := not Enable;      // Установить флаг Running

ETokenChange(nil);

with CloseButton do begin

if Enable then begin        // Установить свойства кнопки Close/Stop

Caption := ‘&Close';

Hint := ‘Close Application';

end

else begin

Caption := ‘&Stop';

Hint := ‘Stop Searching';

end;

end;

end;

procedure TMainForm.SearchButtonClick(Sender: TObject);

{ Вызывается по щелчку на кнопке Search. Создает поток поиска. }

begin

EnableSearchControls(False);        // Отключить элементы управления

FileLB.Clear;                       // Очистить список

{ запуск потока }

SearchThread := TSearchThread.Create(cbCaseSensitive.Checked,

cbFileNamesOnly.Checked, cbRecurse.Checked, EToken.Text,

EPathName.Text, EFileSpec.Text, Handle);

end;

procedure TMainForm.ETokenChange(Sender: TObject);

begin

SearchButton.Enabled := not Running and (EToken.Text <> ”);

end;

procedure TMainForm.PathButtonClick(Sender: TObject);

{ Вызывается по щелчку на кнопке Path. Позволяет выбрать новый

путь. }

var

ShowDir: string;

begin

ShowDir := EPathName.Text;

if SelectDirectory(ShowDir, [], 0) then

EPathName.Text := ShowDir;

end;

procedure TMainForm.FileLBDblClick(Sender: TObject);

{ Вызывается, если пользователь дважды щелкнул в списке. Файл

загружается в интегрированную среду разработки. }

var

FileName: string;

Len: Integer;begin

{ Удостовериться, что пользователь щелкнул на файле… }

if Integer(FileLB.Items.Objects[FileLB.ItemIndex]) > 0 then

begin

FileName := FileLB.Items[FileLB.ItemIndex];

{ Удалить из строк фрагменты "File " и ":". }

FileName := Copy(FileName, 6, Length(FileName));

Len := Length(FileName);

if FileName[Len] = ‘:’ then SetLength(FileName, Len – 1);

{ Открыть проект или файл }

{$IFNDEF BUILD_EXE}

if CompareText(ExtractFileExt(FileName), ‘.DPR’) = 0 then

ActionSvc.OpenProject(FileName, True)

else

ActionSvc.OpenFile(FileName);

{$ELSE}

ShellExecute(0, ‘open’, PChar(FileName), nil,

nil, SW_SHOWNORMAL);

{$ENDIF}

end;

end;

procedure TMainForm.FileLBDrawItem(Control: TWinControl;

Index: Integer; Rect: TRect; State: TOwnerDrawState);

{ Вызывается для перерисовки списка. }

var

CurStr: string;

begin

with FileLB do begin

CurStr := Items.Strings[Index];

Canvas.FillRect(Rect);                  // Очистка прямоугольника

// Если не только имя файла …

if not cbFileNamesOnly.Checked then begin

{ если текущая строка – имя файла … }

if Integer(Items.Objects[Index]) > 0 then

Canvas.Font.Style := [fsBold];               // Полужирный шрифт

end else

Rect.Left := Rect.Left + 15;           // в противном случае отступ

DrawText(Canvas.Handle, PChar(CurStr), Length(CurStr),

Rect, dt_SingleLine);

end;

end;

procedure TMainForm.Font1Click(Sender: TObject);

{ Выбор нового шрифта для списка }

begin

{ Выбор нового шрифта }

if FontDialog1.Execute then

FileLB.Font := FontDialog1.Font;

end;

procedure TMainForm.FormDestroy(Sender: TObject);{ Обработчик события формы OnDestroy }

begin

WriteIni;

end;

procedure TMainForm.FormCreate(Sender: TObject);

{ Обработчик события формы OnCreate }

begin

Application.HintPause := 0; // Отображать подсказки без задержки

FOldShowHint := Application.OnShowHint; // Установка подсказок

Application.OnShowHint := DoShowHint;

ReadIni;                                   // Чтение INI-файла

end;

procedure TMainForm.DoShowHint(var HintStr: string;

var CanShow: Boolean; var HintInfo: THintInfo);

{ Обработчик события приложения OnHint }

begin

{ Отображение подсказок в строке состояния }

StatusBar.Panels[0].Text := HintStr;

{ Не отображать всплывающие подсказки, если курсор расположен

над пользовательским элементом управления }

if (HintInfo.HintControl <> nil) and

(HintInfo.HintControl.Parent <> nil) and

((HintInfo.HintControl.Parent = ParamsGB) or

(HintInfo.HintControl.Parent = OptionsGB) or

(HintInfo.HintControl.Parent = ControlPanel)) then

CanShow := False;

if Assigned(FOldShowHint) then

FOldShowHint(HintStr, CanSHow, HintInfo);

end;

procedure TMainForm.PrintButtonClick(Sender: TObject);

{ Вызывается по щелчку на кнопке Print. }

begin

if MessageDlg(‘Send search results to printer?’, mtConfirmation,

[mbYes, mbNo], 0) = mrYes then

PrintStrings(FileLB.Items);

end;

procedure TMainForm.CloseButtonClick(Sender: TObject);

{ Вызывается для остановки потока или завершения приложения }

begin

// Если поток запущен, завершить его

if Running then SearchThread.Terminate

// В противном случае завершить приложение

else Close;

end;

procedure TMainForm.FormResize(Sender: TObject);

{ Обработчик события OnResize. Центрирование элементов управления в

форме. }

begin{ Разделить строку состояния на две панели в соотношении 2/3 }

with StatusBar do begin

Panels[0].Width := Width div 3;

Panels[1].Width := Width * 2 div 3;

end;

{ Центрирование элементов управления в середине формы }

ControlPanel.Left := (AlignPanel.Width div 2) -

(ControlPanel.Width div 2);

end;

procedure TMainForm.PriorityButtonClick(Sender: TObject);

{ Отображение формы приоритета потока }

begin

ThreadPriWin.Show;

end;

procedure TMainForm.ReadIni;

{ Считывание из системного реестра значений по умолчанию }

begin

with SrchIniFile do begin

EPathName.Text := ReadString(‘Defaults’, ‘LastPath’, ‘C:\’);

EFileSpec.Text := ReadString(‘Defaults’,

‘LastFileSpec’, ‘*.*’);

EToken.Text := ReadString(‘Defaults’, ‘LastToken’, ”);

cbFileNamesOnly.Checked := ReadBool(‘Defaults’,

‘FNamesOnly’, False);

cbCaseSensitive.Checked := ReadBool(‘Defaults’,

‘CaseSens’, False);

cbRecurse.Checked := ReadBool(‘Defaults’, ‘Recurse’, False);

Left := ReadInteger(‘Position’, ‘Left’, 100);

Top := ReadInteger(‘Position’, ‘Top’, 50);

Width := ReadInteger(‘Position’, ‘Width’, 510);

Height := ReadInteger(‘Position’, ‘Height’, 370);

end;

end;

procedure TMainForm.WriteIni;

{ Запись текущих значений обратно в системный реестр }

begin

with SrchIniFile do begin

WriteString(‘Defaults’, ‘LastPath’, EPathName.Text);

WriteString(‘Defaults’, ‘LastFileSpec’, EFileSpec.Text);

WriteString(‘Defaults’, ‘LastToken’, EToken.Text);

WriteBool(‘Defaults’, ‘CaseSens’, cbCaseSensitive.Checked);

WriteBool(‘Defaults’, ‘FNamesOnly’, cbFileNamesOnly.Checked);

WriteBool(‘Defaults’, ‘Recurse’, cbRecurse.Checked);

WriteInteger(‘Position’, ‘Left’, Left);

WriteInteger(‘Position’, ‘Top’, Top);

WriteInteger(‘Position’, ‘Width’, Width);

WriteInteger(‘Position’, ‘Height’, Height);

end;

end;procedure TMainForm.FormClose(Sender: TObject;

var Action: TCloseAction);

begin

Action := caFree;

Application.OnShowHint := FOldShowHint;

MainForm := nil;

end;

procedure TMainForm.WndProc(var Message: TMessage);

begin

if Message.Msg = DDGM_ADDSTR then begin

FileLB.Items.AddObject(PChar(Message.WParam),

TObject(Message.LParam));

StrDispose(PChar(Message.WParam));

end

else

inherited WndProc(Message);

end;

end.

CОВЕТ

Обратите внимание на следующую строку листинга 17.8:

{$WARN UNIT_PLATFORM OFF}

Эта директива компилятора используется для отключения предупреждений времени компиляции,  которые  возникают  в  связи  с  использованием  в  Main.pas модуля FileCtrl, который специфичен только для платформы Windows. Кроме того, приме- нение модуля FileCtrl отмечено директивами, зависимыми от платформы.

Рис. 17.7. в действии

 

Источник: Тейксейра, Стив, Пачеко, Ксавье.   Borland Delphi 6. Руководство разработчика. : Пер.  с англ. — М. : Издательский дом “Вильямс”, 2002. —  1120 с. : ил. — Парал. тит. англ.

По теме:

  • Комментарии