Жизнь и смерть в режиме run-timeИсточник: delphikingdom Елена Филиппова
Автор: © Елена Филиппова Материал предназначен для начинающих программистов, умеющих работать с компонентами Delphi в режиме design-time но уже не считающих, что программировать это значит "накликать мышкой форму". Никаких интересных моментов для профи статья не содержит, это исключительно учебный материал. Цель статьи ответить на вопросы и показать :
И все это - во время работы программы (режим run-time). Пояснения к проекту: Скачать проект (откомпилировано в Delphi 5) :
Проект показывает сразу все перечисленные возможности работы с компонентами, он представляет собой форму , на которой есть панель (PanelTest : TPanel), управляющие компоненты и меню. Все наши компоненты, которые мы будем создавать, будут располагаться на панели PanelTest. Чтобы не путать тестовые компоненты с управляющими. Создавать будем TEdit , TButton , TCheckBox и TLabel по выбору. Управляющие элементы формы:
Некоторые элементы MainMenu и pmComponent будут достраиваться и изменять свои свойства в run-time.
Это очень просто, главное - знать какой именно это компонент и где он будет лежать. Например, создадим TButton на нашей панели PanelTest. Var New : TButton; Begin // Создаем НОВЫЙ экземпляр класса TButton // и кладем ссылку на него в переменную New New:=TButton.Create(PanelTest); // Координаты левого верхнего угла новой кнопки на панели New.Top:= ...; New.Left:=...; New.Name:='Button'; // А вот эта процедура будет вызываться // при нажатии на новенькую кнопку // то есть - обработка событи OnClick New.OnClick:=OnClickButton; // Оп! И делаем кнопку видимой на PanelTest New.Parent:=PanelTest; End; Комментарии к коду. Примечание:
New:=TButton.Create(PanelTest); Конструктор имеет входной параметр TButton.Create( AOwner : TObject ); где указан Owner , то есть "хозяин", создаваемого объекта. Хозяин компонента отвечает за его корректное удаление и освобождение памяти. В качестве хозяина мы передаем ему панель PanelTest, это означает, что при удалении PanelTest будет удалена и наша кнопка. Если в качестве параметра указать nil, то и заботиться об удалении кнопки придется самим. Какие комментарии можно добавить к прозрачным командам New.Top:= ... ? property Controls[Index: Integer]: TControl; Теперь кнопка будет не просто видна на панели, а будет принадлежать этой панели. То есть при возможном перемещении PanelTest или изменении ее размеров , наша кнопка будет оставаться внутри PanelTest. Но и это еще не все. Если кнопка нам нужна не для украшения формы, то хотелось бы, чтобы она адекватно реагировала на некоторые события, ну хотя бы на свое собственное нажатие. Читаем help : property OnClick: TNotifyEvent; Это свойство определяет реакцию на событие, которое возникает при клике мышки или нажатии Enter на контрол. Лирическое отступление: Смотрим help по теме "Procedural types" , то есть "процедурные типы". type TMyProcedure = procedure ( I : Integer); это процедурный тип, который является ссылкой(указателем) на адрес процедуры с определенным списком параметров. Var MyProcedure : TMyProcedure; Procedure X( I : Integer); Begin ... End; ... MyProcedure:=X; Переменная MyProcedure содержит адрес соответствущей процедуры. Таким образом процедуру можно передавать как параметр в другие процедуры и функции. type TNotifyEvent = procedure (Sender: TObject) of object; Тип TNotifyEvent это не просто указатель на процедуру, это ссылка на метод, об этом говорит директива "of object". Чем отличается ссылка на процедуру от ссылки на метод? Procedure TForm1.OnClickButton( Sender : TObject ); Var Value : String; Begin MessageDlg('Нажата кнопка '+TControl(Sender).Name ,mtInformation,[mbOk],0); End; И назначим эту процедуру в качестве обработчика события OnClick созданной кнопки: New.OnClick:=OnClickButton; Теперь наша кнопка прям как настоящая!
Итак, начнем. Ссылка на класс. Хорошо бы передать Delphi тип компонента, экземпляр которого мы хотим создать. Тогда бы задача упростилась. type TClass = class of TObject; Переменная типа TClass не может содержать экземпляр TObject, это только ссылка на определенный класс. Мы можем определить свой собственный тип, как ссылку на класс, который является родительским по отношению ко ВСЕМ нашим типам создаваемых компонент. Нам нужна ссылка на TControl. В Delphi есть уже "готовые" типы ссылок на классы. Кроме TClass есть еще несколько , в том числе и TControlClass. type TControlClass = class of TControl; Воспользуемся им. Нам понадобится список классов, с которыми будем работать : Type TListClass = array [ 0..3 ] of TControlClass; Const ListClass : TListClass = (TEdit , TButton , TCheckBox , TLabel ) ; На событие OnDblClick панели PanelTest разбираем, что именно мы должны создать и создаем это... procedure TForm1.PanelTestDblClick(Sender: TObject); Const No : integer = 0; Var TypeClass : TControlClass; New : TControl; Point : TPoint; begin IF (rgComponents.ItemIndex >= 0) AND (rgComponents.ItemIndex < rgComponents.Items.Count) Then Begin // Получаем ссылку на выбранный класс TypeClass:=TControlClass(ListClass[rgComponents.ItemIndex]); Inc(No); // увеличиваем счетчик компонент // Cоздаем компонент - вызываем конструктор выбранного класса New:=TypeClass.Create(PanelTest); Point:=PanelTest.ScreenToClient(Mouse.CursorPos); New.Top:=Point.y; New.Left:=Point.x; // Имя = название класса + номер нового компонента New.Name:=New.ClassName + IntToStr(No); New.Tag:=1; // Навешиваем меню по правой кнопке TEdit(New).PopupMenu:=pmComponent; // Если это кнопка - назначим обработчик IF TypeClass = TButton Then TButton(New).OnClick:=OnClickButton; // И помещаем новенького на панель New.Parent:=PanelTest; End; end; Все! И никаких CASE'ов :о) Комментарий: Point:=PanelTest.ScreenToClient(Mouse.CursorPos); Привязываем положение нового компонента к той точке, в которой кликнули мышкой. Процедра ScreenToClient пересчитывает абсолютные (экранные) координаты глобального объекта Mouse в координаты относительно левого верхнего угла панели.
Вы обратили внимание на строку New.Tag:=1 ? TEdit(New).PopupMenu:=pmComponent; связывает наши компоненты с popup-меню pmComponent, которое теперь будет вызываться при нажатии правой кнопки на компоненте. Не смущайтесь приведением к типу TEdit, дело в том, что свойство PopupMenu у класса TControl определено как protected и может быть использовано только его потомками. Чтобы не перебирать все наши типы, выбираем один и используем его для проникновения к нужному нам свойству. Так как PopupMenu есть у всех наших классов и оно то самое, которое наследовано от TControl.PopupMenu , то присвоение будет верным. Меню pmComponent содержит три опции : Tag = 1 Tag = 2 ------ Удалить компонент Первая устанавливает свойство Tag равным 1, вторая меняет его на 2. И последняя опция удаляет компонент по нашему желанию. Обратите внимание на основное меню окна, а именно на его пункт "Измененить цвет" Будем изменять цвет шрифта наших компонентов по выбранному условию. Все три пункта меню "Измененить цвет" используют один и тот же обработчик: procedure TForm1.AllColorClick(Sender: TObject); Var i : Integer; begin IF TControl(Sender).Tag = 0 Then For i:=0 To PanelTest.ControlCount-1 Do TEdit(PanelTest.Controls[i]).Font.Color:=ColorGrid.ForegroundColor Else For i:=0 To PanelTest.ControlCount-1 Do IF TWinControl(PanelTest.Controls[i]).Tag = TControl(Sender).Tag Then TEdit(PanelTest.Controls[i]).Font.Color:=ColorGrid.ForegroundColor end; Sender в этой процедуре - выбранный пункт меню. Обратите внимание в самом проекте, как расставлено свойство Tag у пунктов меню "Измененить цвет". For i:=0 To PanelTest.ControlCount-1 Do Begin IF (PanelTest.Controls[i] Is TEdit) Then TEdit(PanelTest.Controls[i]).Text:='' End; В удалении компонента нет никаких сложностей. В нашем примере только надо понять, что именно удаляется. pmComponent.PopUpComponent.Free; На рисунке показан момент работы проекта:
Было бы обидно, если Delphi разрешала бы программистам хранить для своих нужд только целочисленный признак. А мало ли какие у кого нужды? Если внимательно прочесть Help, то в самой последней строке нам откроется истина : в свойстве Tag можно хранить что угодно длинной 4 байта ( any 32-bit value such as a component reference or a pointer ) ! Это может быть целое число , а может быть ссылка (pointer). Например, ссылка на компонент. Чувствуете, какие открываются перспективы?! Пункт "Отметить CheckBox" основного меню в design-time имеет только один пункт (полоску считать не будем). По смыслу задачи в этот пункт должны добавляться подпункты со списком созданных к этому моменту TCheckBox'ов. При нажатии на нужный пункт, соответствующий TCheckBox на панели будет отмечаться (Checked:=True). Чудное(ударение на первый слог) свойство Tag поможет очень изящно решить эту задачу. Достраиваться меню будет в момент его вызова (событие OnClick), ибо зачем нам в другие моменты эта информация? procedure TForm1.miCheckBoxClick(Sender: TObject); Var Item : TMenuItem; i : Integer; begin // очищаем список For i:=TMenuItem(Sender).Count-1 DownTo 2 Do TMenuItem(Sender).Delete(i); // Формируем свежий вариант меню по текущему списку CheckBox'ов For i:=0 To PanelTest.ControlCount-1 Do IF (PanelTest.Controls[i] is TCheckBox) Then Begin Item:=NewItem( TCheckBox(PanelTest.Controls[i]).Caption, 0 , False, True , miCheckedClick , 0 , ''); TMenuItem(Sender).Add(Item); Item.Tag:=LongInt(PanelTest.Controls[i]); End; end; Не ищите функцию NewItem в проекте, ее там нет. Это функция из VCL модуля Menus. Посмотрите его, найдете еще много-много интересного. Item.Tag:=LongInt(PanelTest.Controls[i]); Приведение типов к LongInt необходимо для компилятора, иначе он не разрешит нам это присваивание. procedure TForm1.miCheckedClick(Sender: TObject); Var i : Integer; begin //Функция Ptr конвертирует 4 байта в тип Pointer. //function Ptr(Address: Integer): Pointer IF TMenuItem(Sender).Tag = 0 Then Begin For i:=0 To PanelTest.ControlCount-1 Do IF PanelTest.Controls[i] Is TCheckBox Then TCheckBox(PanelTest.Controls[i]).Checked:=True End Else TCheckBox(Ptr(TMenuItem(Sender).Tag)).Checked:=True; end; IF TMenuItem(Sender).Tag = 0 - проверка на пункт "Отметить все", здесь мы пользуемся старым способом перебора массива PanelTest.Controls. Var TagPtr : Ponter; ... TagPtr:=Ptr(TMenuItem(Sender).Tag); IF TagPtr <> nil Then IF TagPtr Is TCheckBox Then TCheckBox(TagPtr).Checked:=True; Это общий случай - защита от ошибочных ситуаций. Изменим немного код создания компонент: Var ... MessTag : PChar; ... IF TypeClass = TButton Then Begin TButton(New).OnClick:=OnClickButton; // выделяем память под строку GetMem(MessTag , Length('Нажата кнопка №' + IntToStr(No))+1); StrCopy(MessTag , PChar('Нажата кнопка №' + IntToStr(No))); TButton(New).Tag:=LongInt(MessTag); End Else New.Tag:=1; ... И процедура OnClickButton изменится соответствующим образом: Procedure TForm1.OnClickButton( Sender : TObject ); Var Value : String; Begin Value:=PChar(Ptr(TButton(Sender).Tag)); MessageDlg(Value ,mtInformation,[mbOk],0); End; Изменение строки привяжем к меню pmComponent, добавив туда еще один пункт. Обратите внимание, что пункт этот имеет смысл только для кнопок. Поэтому перед показом popup-меню, на событие OnPopup, делаем соответствующий пункт видимым или невидимым. procedure TForm1.pmComponentPopup(Sender: TObject); begin pmTag1.Checked:= TPopupMenu(Sender).PopupComponent.Tag = 1; pmTag2.Checked:= NOT pmTag1.Checked; pmLine.Visible:= TPopupMenu(Sender).PopupComponent Is TButton; pmNewMessage.Visible:=pmLine.Visible; end; Да! Перед тем, как записать адрес новой строки в Tag, освободим память от предыдущей, ведь она нам больше не нужна. procedure TForm1.pmNewMessageClick(Sender: TObject); Var Value : String; MessTag : PChar; begin MessTag:=PChar(TButton(pmComponent.PopupComponent).Tag); Value:=MessTag; IF InputQuery('Сменить сообщение', 'Для кнопки '+TButton(pmComponent.PopupComponent).Name, Value) Then Begin FreeMem(MessTag); GetMem(MessTag , Length(Value)+1); StrCopy(MessTag , PChar(Value)); TButton(pmComponent.PopupComponent).Tag:=LongInt(MessTag); End; end; При удалении компонента нам теперь надо учесть этот момент - если удаляется кнопка, надо удалить ее строку.
Напоследок, для полного оживления картины, сделаем наши компоненты подвижными. Разрешим им свободно перемещаться по панели, таская их мышкой. Это будет не drag & drop, а совершенно обычное перемещение, как в режиме design-time. Для его реализации нам понадобится обработать самим два события для передвигаемого компонента:
Пишем эти процедуры сами, список параметров должен соответствовать описаниям этих событий ( для этого снова к Help'у ). В принципе можно посмотреть, как создает обработчики этих событий сама Delphi и оттуда переписать параметры. procedure TForm1.ControlMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin DragPoint:=Point(X , Y ); end; procedure TForm1.ControlMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin IF (ssLeft IN Shift) Then Begin TControl(Sender).Left:=TControl(Sender).Left + x - DragPoint.X; TControl(Sender).Top :=TControl(Sender).Top + y - DragPoint.y; End; end; Естественно, что при создании компонент необходимо добавить назначение этих процедур в качестве обработчиков нужных нам событий. ... New.Top:=Point.y; New.Left:=Point.x; TLabel(New).OnMouseDown:=ControlMouseDown; TLabel(New).OnMouseMove:=ControlMouseMove; ... Ну, а теперь, мышку в руки и смело вперед! Итого... В статье я довольно подробно разобрала некоторые вопросы, некоторые затронула вскользь. |