Главная » Delphi » Пользовательский интерфейс

0

Главный модуль этого  приложения называется Main.pas, его  исходный код пред ставлен в листинге 5.8. Основная задача  данного модуля —  обеспечить функциониро вание  главной формы и ее пользовательского интерфейса. В частности, в модуле вы полняются действия, необходимые для заполнения окна списка,  вызова  соответст вующей  программы просмотра указанного пользователем файла, создания потока поиска, вывода  на печать содержимого списка,  а также  чтения и записи параметров пользовательского интерфейса в файл инициализации (.INI).

Листинг 5.8. Модуль Main.pas проекта DelSrch

unit Main; interface usesSysUtils, WinTypes, WinProcs, Messages, Classes, Graphics,Controls, Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, Menus, SrchIni, SrchU, ComCtrls, AppEvnts;

type

TMainForm = class(TForm)

lbFiles: TListBox;

StatusBar: TStatusBar;

pnlControls: TPanel;

PopupMenu: TPopupMenu;

FontDialog: TFontDialog;

pnlOptions: TPanel;

gbParams: TGroupBox;

LFileSpec: TLabel;

LToken: TLabel;

lPathName: TLabel;

edtFileSpec: TEdit;

edtToken: TEdit;

btnPath: TButton;

edtPathName: TEdit;

gbOptions: TGroupBox;

cbCaseSensitive: TCheckBox;

cbFileNamesOnly: TCheckBox;

cbRecurse: TCheckBox;

cbRunFromAss: TCheckBox;

pnlButtons: TPanel;

btnSearch: TBitBtn;

btnClose: TBitBtn;

btnPrint: TBitBtn;

btnPriority: TBitBtn;

Font1: TMenuItem;

Clear1: TMenuItem;

Print1: TMenuItem;

N1: TMenuItem;

Exit1: TMenuItem;

ApplicationEvents: TApplicationEvents;

procedure btnSearchClick(Sender: TObject);

procedure btnPathClick(Sender: TObject);

procedure lbFilesDrawItem(Control: TWinControl;

Index: Integer; Rect: TRect;

State: TOwnerDrawState);

procedure Font1Click(Sender: TObject);

procedure FormDestroy(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure btnPrintClick(Sender: TObject);

procedure btnCloseClick(Sender: TObject);

procedure lbFilesDblClick(Sender: TObject);

procedure FormResize(Sender: TObject);

procedure btnPriorityClick(Sender: TObject);

procedure edtTokenChange(Sender: TObject);

procedure Clear1Click(Sender: TObject);

procedure ApplicationEventsHint(Sender: TObject);

private

procedure ReadIni;procedure WriteIni;

public

Running: Boolean;

SearchPri: Integer;

SearchThread: TSearchThread;

procedure EnableSearchControls(Enable: Boolean);

end;

var

MainForm: TMainForm;

implementation

{$R *.DFM}

uses Printers, ShellAPI, StrUtils, FileCtrl, PriU;

procedure PrintStrings(Strings: TStrings);

{ Эта процедура выводит на печать все строки, переданные в

параметре Strings }

var

Prn: TextFile;

I: Integer;

begin

if Strings.Count = 0 then // Есть ли строки для печати?

raise Exception.Create(‘No text to print!’);

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

btnSearch.Enabled := Enable;             // разрешить (Enable)

cbRecurse.Enabled := Enable;             // запретить (Disable)

cbFileNamesOnly.Enabled := Enable;

cbCaseSensitive.Enabled := Enable;

btnPath.Enabled := Enable;

edtPathName.Enabled := Enable;

edtFileSpec.Enabled := Enable;

edtToken.Enabled := Enable;Running := not Enable;     // установить флаг Running edtTokenChange(nil);

with btnClose 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.btnSearchClick(Sender: TObject);

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

begin

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

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

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

SearchThread := TSearchThread.Create(cbCaseSensitive.Checked,

cbFileNamesOnly.Checked, cbRecurse.Checked, edtToken.Text,

edtPathName.Text, edtFileSpec.Text);

end;

procedure TMainForm.edtTokenChange(Sender: TObject);

begin

btnSearch.Enabled := not Running and (edtToken.Text <> ”);

end;

procedure TMainForm.btnPathClick(Sender: TObject);

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

путь }

var

ShowDir: string;

begin

ShowDir := edtPathName.Text;

if SelectDirectory(‘Choose a search path…’, ”, ShowDir) then

edtPathName.Text := ShowDir;

end;

procedure TMainForm.lbFilesDrawItem(Control: TWinControl;

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

{ Вызывается, если пользователь использует список. }

var

CurStr: string;

begin

with lbFiles do begin

CurStr := Items.Strings[Index];

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

if not cbFileNamesOnly.Checked then       // если не только имя

// файла…

{ Если текущая строка является именем файла… }if (Pos(‘File ‘, CurStr) = 1) and

(CurStr[Length(CurStr)] = ‘:’) then

with Canvas.Font do begin

Style := [fsUnderline]; // шрифт с подчеркиванием

Color := clRed;                     // цвет красный

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 FontDialog.Execute then

lbFiles.Font := FontDialog.Font;

end;

procedure TMainForm.FormDestroy(Sender: TObject);

{ Обработчик события OnDestroy для формы. }

begin

WriteIni;

end;

procedure TMainForm.FormCreate(Sender: TObject);

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

begin

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

end;

procedure TMainForm.btnPrintClick(Sender: TObject);

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

begin

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

[mbYes, mbNo], 0) = mrYes then

PrintStrings(lbFiles.Items);

end;

procedure TMainForm.btnCloseClick(Sender: TObject);

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

begin

// если поток выполняется, завершить его

if Running then SearchThread.Terminate

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

else Close;

end;

procedure TMainForm.lbFilesDblClick(Sender: TObject);

{ Вызывается при двойном щелчке в окне списка. Запускает программу

просмотра для выделенного файла. }var

ProgramStr, FileStr: string;

RetVal: THandle;

begin

{ Если пользователь щелкнул на файле.. }

if (Pos(‘File ‘, lbFiles.Items[lbFiles.ItemIndex]) = 1) then

begin // Загрузить текстовый редактор, указанный в INI-файле.

// По умолчанию загружается Notepad.

ProgramStr := SrchIniFile.ReadString(‘Defaults’, ‘Editor’,

‘notepad’);

// Получить выбранный файл

FileStr := lbFiles.Items[lbFiles.ItemIndex];

// Удалить префикс

FileStr := Copy(FileStr, 6, Length(FileStr) – 5);

// Удалить ":"

if FileStr[Length(FileStr)] = ‘:’ then DecStrLen(FileStr, 1);

if cbRunFromAss.Checked then

{ Загрузить файл в ассоциированное с ним приложение }

RetVal := ShellExecute(Handle, ‘open’, PChar(FileStr), nil,

nil, SW_SHOWNORMAL)

else { В противном случае – в текстовый редактор }

RetVal := ShellExecute(Handle, ‘open’, PChar(ProgramStr),

PChar(FileStr), nil, SW_SHOWNORMAL);

{ Проверка ошибок }

if RetVal < 32 then RaiseLastWin32Error;

end;

end;

procedure TMainForm.FormResize(Sender: TObject);

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

форме. }

begin

{ Делим строку состояния на две панели в отношении 1/3 – 2/3. }

with StatusBar do begin

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

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

end;

end;

procedure TMainForm.btnPriorityClick(Sender: TObject);

{ Отображает форму приоритета потока. }

begin

ThreadPriWin.Show;

end;

procedure TMainForm.ReadIni;

{ Читает из реестра значения по умолчанию. }

begin

with SrchIniFile do begin

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

edtFileSpec.Text := ReadString(‘Defaults’, ‘LastFileSpec’,

‘*.*’);

edtToken.Text := ReadString(‘Defaults’, ‘LastToken’, ”);cbFileNamesOnly.Checked := ReadBool(‘Defaults’, ‘FNamesOnly’, False);

cbCaseSensitive.Checked := ReadBool(‘Defaults’, ‘CaseSens’, False);

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

cbRunFromAss.Checked := ReadBool(‘Defaults’, ‘RunFromAss’,

False);

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

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

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

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

end;

end;

procedure TMainForm.WriteIni;

{ Записывает текущие параметры назад в реестр. }

begin

with SrchIniFile do begin

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

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

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

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

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

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

WriteBool(‘Defaults’, ‘RunFromAss’, cbRunFromAss.Checked);

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

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

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

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

end;

end;

procedure TMainForm.Clear1Click(Sender: TObject);

begin

lbFiles.Items.Clear;

end;

procedure TMainForm.ApplicationEventsHint(Sender: TObject);

{ Обработчик события OnHint объекта Application }

begin

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

StatusBar.Panels[0].Text := Application.Hint;

end;

end.Некоторые фрагменты этого  модуля заслуживают особого внимания. Прежде все го  стоит  остановиться на  маленькой процедуре PrintStrings(), применяющейся для отправки содержимого объекта TStrings на принтер. Для  этого  процедура ис пользует   преимущества  стандартной  процедуры  Delphi  AssignPrn(),  в  которой принтеру назначается переменная типа TextFile, благодаря чему любой текст, запи сываемый в эту переменную, автоматически выводится на принтер. Завершив вывод на печать, следует обязательно разорвать подключение к принтеру с помощью проце дуры CloseFile().

Интересно  также  использование  процедуры  API  Win32  ShellExecute() для  за

пуска программы просмотра файла, отображаемого в окне списка. Эта процедура по

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

CОВЕТ

Если процедура ShellExecute() возвращает значение, указывающее на  наличие ошибки, приложение вызывает функцию RaiseLastWin32Error(), которая располо- жена в модуле SysUtils. Данная функция возвращает более подробную информацию об ошибке. Она формирует эту информацию в строку и вызывает функцию API Get- LastError() и функцию Delphi SysErrorMessage(). Если необходимо, чтобы поль- зователи получали подробные сообщения об ошибках, связанных со сбоями в работе интерфейса API, используйте в своих приложениях функцию RaiseLast- Win32Error().

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

По теме:

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