Жизнь и смерть в режиме run-time

Лирическое вступление. Конец ноября в этом году выдался довольно забавный, и погода в Москве была неестественная для этого времени года и респондентов Круглого стола как прорвало. Если раньше можно было выделить десяток основных животрепещущих вопросов, например как выдвинуть CD-Rom, поместить иконку в Tray и обязательно добавить в Caption формы непрямоугольную кнопку, то теперь появился новый и явный лидер. И в личной почте и в вопросах на Круглый стол, и даже по Аське, несмотря на отсутствие авторизации, я получила за неделю десяток практически дословно повторяющихся вопросов от совершенно разных и незнакомых мне людей.

"Как создать кнопку во время работы? Как назначить ей обработчики событий? Почему нельзя написать (Edit + IntToStr(i)).Text:='' и как же тогда можно писать? Не перебирать же все Edit'ы у меня их на форме 100 штук! Ну Дельфя и дает!.."

Итак, зачетной сессии посвящается...

• Каким образом можно создавать и располагать на форме визуальные компоненты?
• Каким образом обрабатывать группы компонент, меняя их свойства "одним махом"?
• Как назначать обработчики для разных событий?
• Зачем нужно свойство Tag?
• Как можно двигать компоненты по форме?

Проект показывает сразу все перечисленные возможности работы с компонентами, он представляет собой форму , на которой есть панель (PanelTest : TPanel), управляющие компоненты и меню. Все наши компоненты, которые мы будем создавать, будут располагаться на панели PanelTest. Чтобы не путать тестовые компоненты с управляющими. Создавать будем TEdit , TButton , TCheckBox и TLabel по выбору. Управляющие элементы формы:

• rgComponents : TRadioGroup - выбор типа компонента
• ColorGrid : TColorGrid - выбор цвета фонта для меню "Изменить цвет"
• MainMenu : TMainMenu - действия с группами компонент
• pmComponent : TPopupMenu - изменения свойств конкретного компонента и его удаление.

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 );

property Controls[Index: Integer]: TControl;

property OnClick: TNotifyEvent;

type TMyProcedure = procedure ( I : Integer);

Var MyProcedure : TMyProcedure;

Procedure X( I : Integer);
Begin
   ...
End;

...
MyProcedure:=X;  

type TNotifyEvent = procedure (Sender: TObject) of object;

реально содержит две ссылки - непосредственно адрес метода(процедуры) и ссылку на сам объект, которому этот метод принадлежит.

Procedure TForm1.OnClickButton( Sender : TObject );
Var Value : String;
Begin    
    MessageDlg('Нажата кнопка '+TControl(Sender).Name ,mtInformation,[mbOk],0);
End;

New.OnClick:=OnClickButton;

Ссылка на класс.

. Посмотрите help по этой теме, там довольно подробно объясняется это понятие и приводятся примеры.

type TClass = class of TObject; 

type TControlClass = class of TControl;

Type
   TListClass = array [ 0..3 ] of TControlClass;

Const
   ListClass : TListClass  = (TEdit , TButton , TCheckBox , TLabel ) ;

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; 

Комментарий:

Point:=PanelTest.ScreenToClient(Mouse.CursorPos);

? Что это за свойство и в чем его смысл? Это целое число типа LongInt(длиной 4 байта), которое является полноценным свойством компонента и никак не учитывается средой. Delphi на него не обращает внимания. Можете там что-нибудь сохранить. На всякий случай. Итак, присвоим нашим новеньким Tag равный 1.

TEdit(New).PopupMenu:=pmComponent;

Tag = 1
Tag = 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;

For i:=0 To PanelTest.ControlCount-1 Do
Begin
	IF  (PanelTest.Controls[i] Is TEdit)
	Then TEdit(PanelTest.Controls[i]).Text:=''
End;

В удалении компонента нет никаких сложностей. В нашем примере только надо понять, что именно удаляется. Воспользуемся свойством TPopupMenu.PopupComponent : TComponent

, определяющим компонент, над которым в данный момент нажали правую кнопку мыши и вызвали это меню.

pmComponent.PopUpComponent.Free;

На рисунке показан момент работы проекта:

( any 32-bit value such as a component reference or a pointer ) !

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;

Item.Tag:=LongInt(PanelTest.Controls[i]);

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;

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;

...

Procedure TForm1.OnClickButton( Sender : TObject );
Var Value : String;
Begin
    Value:=PChar(Ptr(TButton(Sender).Tag));

    MessageDlg(Value ,mtInformation,[mbOk],0);

End;

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;

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;

, а совершенно обычное перемещение, как в режиме design-time. Для его реализации нам понадобится обработать самим два события для передвигаемого компонента:

OnMouseDown

-

если нажата левая кнопка мышки, запомним ее текущее положение в переменной DragPoint и и будем считать эти координаты точкой отсчета.

OnMouseMove

-

если нажата левая кнопка мышки, передвигаем компонент по новым координатам, сдвигая его так же, как сдвинулась мышка относительно нашей точки отсчета. Тем самым компонент будет плавно передвигаться вслед за мышкой.

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;
... 

Итого...

Другое по теме:

• Borland Delphi 7 - миграция в сторону .Net
• Delphi и 1C - экспорт и импорт
• Консольные приложения в Delphi