Delphi 3. Библиотека программиста




Тернистый путь познания


Но мне показалось, что все слишком просто. Не знаю, в чем тут дело — то ли в каких-то личных качествах, то ли я просто «нерд» по натуре. Я решил пойти дальше и сделать так, чтобы строку из текстового поля можно было переслать в любую из сеток, просто сбрасывая ее на корешке соответствующей вкладки. Пожалуй, сейчас я уже раскаиваюсь в своем решении.

Сначала я узнал, что у компонента TabSet есть метод, который сообщает номер вкладки по координатам x, y. Компонент PageControl в основном выполняет функции оболочки для компонентов TabSheet, так что его собственные
возможности ограничены и он может разве что сообщить номер текущей выбранной вкладки.

Следовательно, я должен был узнать местонахождение каждого корешка, чтобы определить, на какой из них указывает мышь. Обладая этой информа цией, можно легко определить нужную вкладку. Но при этом возникает
другая проблема: компонент PageControl автоматически изменяет ширину каждого корешка в зависимости от длины его названия. Что делать?

Я решил организовать поддержку сбрасывания лишь для тех вкладок,
у которых значение свойств TabHeight и TabWidth было вручную заменено величиной, отличной от нуля. На этом следовало остановиться, но я решил предоставить возможность автоматического назначения корешкам вкладок одной и той же ширины, определяемой длиной самого длинного названия. В результате программа заметно разрослась, ее окончательная версия приведена в листинге 16.2.

Листинг 16.2. Полный исходный текст программы, демонстрирующей
применение общих обработчиков

{——————————————————————————————————————————————————————} { Применение общих обработчиков событий } { (демонстрационная программа) } { SHARMAIN.PAS : Главный модуль } { Автор: Эйс Брейкпойнт, N.T.P. } { При содействии Дона Тейлора } { } { Программа демонстрирует применение общих } { обработчиков событий в пределах одного приложения } { на примере операции перетаскивания. } { } { Написано для *High Performance Delphi 3 Programming* } { Copyright (c) 1997 The Coriolis Group, Inc. } { Дата последней редакции 30/4/97 } {——————————————————————————————————————————————————————} unit SharMain; interface uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, Grids, StdCtrls, ExtCtrls, ComCtrls; type TShareEventDemoForm = class(TForm) EditBox: TEdit; Label1: TLabel; QuitBtn: TButton; Panel1: TPanel; PageControl: TPageControl; MorningSheet: TTabSheet; AfternoonSheet: TTabSheet; EveningSheet: TTabSheet; MorningGrid: TStringGrid; AfternoonGrid: TStringGrid; EveningGrid: TStringGrid; procedure FormCreate(Sender: TObject); procedure QuitBtnClick(Sender: TObject); procedure EditBoxMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure GridMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure GridDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure GridDragDrop(Sender, Source : TObject; X, Y : Integer); procedure PageControlDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure PageControlDragDrop(Sender, Source: TObject; X, Y: Integer); private CopyDrag : Boolean; function ManualTabsSet : Boolean; function CurrentGrid : TStringGrid; function TabGrid(X : Integer) : TStringGrid; procedure SetTabSizes; procedure DropEditString(AGrid : TStringGrid); procedure DropGridString(TargetGrid : TStringGrid); public { Public declarations } end; var ShareEventDemoForm: TShareEventDemoForm; implementation {$R *.DFM} { Возвращает длину (в пикселях) отображаемой строки по логическому номеру окна, в котором она выводится, и логическому номеру шрифта. } function StringWidth(WinHnd : HWND; FntHnd : HWND; Text : String) : Integer; var DCHnd : HWND; StrSize : TSize; TextArr : array[0..127] of char; begin Result := -1; DCHnd := GetDC(WinHnd); if GetMapMode(DCHnd) = MM_TEXT then begin SelectObject(DCHnd, FntHnd); StrPCopy(TextArr, Text); if GetTextExtentPoint32(DCHnd, @TextArr, Length(Text), StrSize) then Result := StrSize.Cx end; ReleaseDC(WinHnd, DCHnd); end; { Возвращает высоту шрифта (в пикселях) по логическому номеру окна, в котором он выводится, и логическому номеру шрифта. Высота должна учитывать строчные и подстрочные элементы, а также внутренний интервал. } function FontHeight(WinHnd : HWND; FntHnd : HWND) : Integer; var DCHnd : HWND; TextMex : TTextMetric; begin Result := -1; DCHnd := GetDC(WinHnd); if GetMapMode(DCHnd) = MM_TEXT then begin SelectObject(DCHnd, FntHnd); GetTextMetrics(DCHnd, TextMex); Result := TextMex.tmHeight; end; ReleaseDC(WinHnd, DCHnd); end; procedure TShareEventDemoForm.FormCreate(Sender: TObject); begin PageControl.ActivePage := MorningSheet; SetTabSizes; CopyDrag := False; end; procedure TShareEventDemoForm.QuitBtnClick(Sender: TObject); begin Close; end; procedure TShareEventDemoForm.EditBoxMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin { Перед тем как начинать перетаскивание, необходимо убедиться в том, что нажата левая кнопка мыши, в текстовом поле присутствует текст и щелчок был не двойным. } if (Button = mbLeft) and (EditBox.Text <> '') and not (ssDouble in Shift) then TEdit(Sender).BeginDrag(False); end; { Общий обработчик для события OnMouseDown всех сеток. } procedure TShareEventDemoForm.GridMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var TheGrid : TStringGrid; begin { Инициируем перетаскивание из текущей выбранной сетки. Если нажата клавиша Ctrl, устанавливаем флаг CopyDrag. Перед тем как начинать перетаскивание, убедимся в том, что нажата левая кнопка мыши, в выделенной строке сетки присутствует текст щелчок был не двойным. } TheGrid := CurrentGrid; CopyDrag := ssCtrl in Shift; if (Button = mbLeft) and (TheGrid.Cells[0, TheGrid.Row] <> '') and not (ssDouble in Shift) then TStringGrid(Sender).BeginDrag(False); end; { Общий обработчик для события OnDragOver всех сеток. } procedure TShareEventDemoForm.GridDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin { Принимается все, что угодно, но только из текстового поля. } Accept := Source is TEdit; end; { Общий обработчик для события OnDragDrop всех сеток. } procedure TShareEventDemoForm.GridDragDrop (Sender, Source : TObject; X, Y : Integer); begin { Сбрасываем перетаскиваемый объект на текущую выбранную решетку. } DropEditString(CurrentGrid); end; procedure TShareEventDemoForm.PageControlDragOver (Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin { Сбрасывание на корешке вкладки принимается лишь в том случае, если перетаскиваемый объект происходит из текстового поля или сетки — при условии, что корешок относится не к той сетке, из которой начато перетаскивание. В любом случае размеры корешков должны быть установлены вручную. } Accept := ManualTabsSet and ( (Source is TEdit) or ((Source is TStringGrid) and (CurrentGrid <> TabGrid(X))) ); end; procedure TShareEventDemoForm.PageControlDragDrop (Sender, Source: TObject; X, Y: Integer); begin { Получаем строку из нужного источника и сбрасываем ее на сетку, связанную со вкладкой в позиции X. } if (Source is TEdit) then DropEditString (TabGrid(X)); if (Source is TStringGrid) then DropGridString (TabGrid(X)); end; { Возвращает True лишь в том случае, если и высота, и ширина вкладки были заданы вручную. } function TShareEventDemoForm.ManualTabsSet : Boolean; begin Result := (PageControl.TabHeight > 0) and (PageControl.TabWidth > 0); end; { Возвращает указатель на сетку, находящуюся на текущей вкладке. } function TShareEventDemoForm.CurrentGrid : TStringGrid; begin Result := nil; if PageControl.ActivePage = MorningSheet then Result := MorningGrid else if PageControl.ActivePage = AfternoonSheet then Result := AfternoonGrid else if PageControl.ActivePage = EveningSheet then Result := EveningGrid; end; { Возвращает указатель на сетку, связанную со вкладкой в позиции X. } function TShareEventDemoForm.TabGrid(X : Integer) : TStringGrid; var Idx : Integer; begin Result := nil; with PageControl do begin Idx := X div TabWidth; case Idx of 0 : Result := MorningGrid; 1 : Result := AfternoonGrid; 2 : Result := EveningGrid; end; { case } end; { with } end; { ?егулирует высоту и ширину корешков, следя за тем, чтобы все корешки имели одинаковые размеры. } procedure TShareEventDemoForm.SetTabSizes; var i : Integer; Len : Integer; MaxWidth : Integer; s : String; begin with PageControl do begin if TabWidth > 0 then begin MaxWidth := -1; for i := 0 to PageCount - 1 do begin s := Pages[i].Caption; Len := StringWidth(Handle, Font.Handle, s); if Len > MaxWidth then MaxWidth := Len; end; if MaxWidth > 0 then TabWidth := MaxWidth + 10; end; if TabHeight > 0 then PageControl.TabHeight := FontHeight (Handle, Font.Handle) + 5; end; { with } end; { Вспомогательная процедура для сброса строки из текстового поля на указанную сетку. Также очищает содержимое текстового поля. } procedure TShareEventDemoForm.DropEditString (AGrid : TStringGrid); begin if AGrid <> nil then with AGrid do begin Cells[0, RowCount - 1] := EditBox.Text; RowCount := RowCount + 1; EditBox.Text := ''; end; { with } end; { Вспомогательная процедура для сброса текста из выделенной строки текущей сетки на другую сетку. Если выполняется операция перемещения, строка удаляется из текущей сетки, которая затем "сжимается". } procedure TShareEventDemoForm.DropGridString (TargetGrid : TStringGrid); var i : Integer; begin if TargetGrid <> nil then begin with TargetGrid do begin Cells[0, RowCount - 1] := CurrentGrid.Cells[0, CurrentGrid.Row]; RowCount := RowCount + 1; end; { with } if not CopyDrag then with CurrentGrid do begin Cells[0, Row] := ''; if Row < RowCount - 1 then for i := Row to RowCount - 1 do Cells[0, i] := Cells[0, i + 1]; RowCount := RowCount - 1; end; { with } end; end; end.

Для правильного вычисления высоты и ширины строки, выводимой на корешке, мне пришлось прибегнуть к функциям Win95 API. Попутно я узнал пару интересных вещей. Во-первых, субсвойство Height свойства Font компонента включает высоту символа (вместе со строчными и подстрочными элемента ми), но не внутренний интервал (internal leading), используемый для специальных целей — например отображения диакритических знаков в некоторых символах национальных алфавитов.

Я захотел узнать настоящую высоту, возвращаемую при вызове GetText Metrics. Написанная мной функция FontHeight возвращает высоту по заданным логическим номерам компонента и шрифта. Внутри FontHeight я проверяю, что установлен координатный режим MM_TEXT — это означает, что полученное значение относится к выводу на экран и измеряется в пикселях.

Аналогичная методика используется и во вспомогательной функции String Width, передающей строку функции GetTextExtentPoint32. Возвращаемое значение равно приблизительной длине отображаемой строки (в пикселях). Значение считается приблизительным, поскольку в нем не учитывается возможный кернинг, выполняемый для символов шрифта.

Обработчик OnCreate формы вызывает процедуру SetTabSizes, чтобы узнать, нужно ли изменять размеры корешков. Если процедура определяет, что в режиме конструирования свойствам TabHeight и TabWidth компонента PageControl были присвоены ненулевые значения, она вмешивается в происходящее

и регулирует размеры корешков, учитывая метрики шрифта и длину самого длинного названия.

По свойству TabWidth и координате X, предоставляемой в ходе перетаскива ния, функция TabGrid определяет нужную вкладку и возвращает указатель на связанную с ней сетку. PageControlDragDrop также пользуется TabGrid, чтобы

определить, какая сетка должна получить сбрасываемую строку.




Содержание  Назад  Вперед