сообщить всем формам моего приложения (в том числе и не видимым в данный момент) об изменении каких-то глобальных значений?
Ответ:
Один из способов — создать пользовательское сообщение и использовать метод preform чтобы разослать его всем формам из массива Screen.Forms.
Пример:
{Code for Unit1}
const UM_MyGlobalMessage = WM_USER + 1;
type TForm1 = class(TForm)
Label1: TLabel;
Button1: TButton;
procedure FormShow(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{Private declarations}
procedure UMMyGlobalMessage(var AMessage: TMessage); message UM_MyGlobalMessage;
public
{Public declarations}
end;
var Form1: TForm1;
implementation {$R *.DFM}
uses Unit2;
procedure TForm1.FormShow(Sender: TObject); begin Form2.Show; end;
procedure TForm1.UMMyGlobalMessage(var AMessage: TMessage); begin Label1.Left := AMessage.WParam; Label1.Top := AMessage.LParam; Form1.Caption := 'Got It!'; end;
procedure TForm1.Button1Click(Sender: TObject); var f: integer; begin for f := 0 to Screen.FormCount - 1 do Screen.Forms[f].Perform(UM_MyGlobalMessage, 42, 42); end;
{Code for Unit2} const UM_MyGlobalMessage = WM_USER + 1; type TForm2 = class(TForm) Label1: TLabel; private {Private declarations} procedure UMMyGlobalMessage(var AMessage: TMessage); message UM_MyGlobalMessage; public {Public declarations} end;
var Form2: TForm2;
implementation {$R *.DFM}
procedure TForm2.UMMyGlobalMessage(var AMessage: TMessage); begin Label1.Left := AMessage.WParam; Label1.Top := AMessage.LParam; Form2.Caption := 'Got It!'; end;
Вопрос: Как обновить список дисков компонента TDriveComboBox, учитывая, что могут быть подключены/отключены сетевые диски и произведена "горячая замена" plug&play дисков? Ответ: Следующий пример вызывает защищенный (protected) метод класса TDriveComboBox BuildList() для регенерации списка дисков. (использовая так наз. "class cracer") Пример: type TNewDriveComboBox = class(TDriveComboBox) //это наш "class cracer" end;
procedure TForm1.Button1Click(Sender: TObject); var Drive : char; begin Drive := DriveComboBox1.Drive; TNewDriveComboBox(DriveComboBox1).BuildList; //вызываем защищенный метод родительского класса DriveComboBox1.Drive := Drive; end;
Вопрос: Как программно заставить выпасть меню? Ответ: В примере показано как показать меню и выбрать в нем какой-то пункт, эмулируя нажатие "быстрой клавиши" пункта меню. Если у Вашего пункта меню нет "быстрой клавиши" Вы можете посылать комбинации VK_MENU, VK_LEFT, VK_DOWN, и VK_RETURN, чтобы программно "путешествовать" по меню. Пример: procedure TForm1.Button1Click(Sender: TObject); begin //Allow button to finish painting in response to the click Application.ProcessMessages; {Alt Key Down} keybd_Event(VK_MENU, 0, 0, 0); {F Key Down - Drops the menu down} keybd_Event(ord('F'), 0, 0, 0); {F Key Up} keybd_Event(ord('F'), 0, KEYEVENTF_KEYUP, 0); {Alt Key Up} keybd_Event(VK_MENU, 0, KEYEVENTF_KEYUP, 0); {F Key Down} keybd_Event(ord('S'), 0, 0, 0); {F Key Up} keybd_Event(ord('S'), 0, KEYEVENTF_KEYUP, 0); end;
Вопрос: Как сделать клавишу-акселератор (keyboard shortcut) компоненту, у которого нет заголовка? Ответ: Возможный вариант — присвоить ссылку на этот компонент свойству FocusControl TLabel'а. В примере используется невидимый Label для создания "быстрой" клавиши (Alt+M) компонента Memo. Чтобы использовать пример, разместите на форме компонет TMemo, Label и несколько других компонентов, которые могут принимать фокус ввода. Запустите программу, перевидите фокус ввода куда-нибудь вне Memo и нажмите Alt+M — фокус ввода вернется в Memo. Пример: procedure TForm1.FormCreate(Sender: TObject); begin Label1.Visible := false; Label1.Caption := '&M'; Label1.FocusControl := Memo1; end;
Вопрос: Можно ли как-то уменьшить мерцание при перерисовке компонента? Ответ: Если добавить флаг csOpaque (непрозрачный) к свойству ControlStyle компонента — то фон компонента перерисовываться не будет. Пример: constructor TMyControl.Create; begin inherited; ControlStyle := ControlStyle + [csOpaque]; end;
Вопрос: Как запретить изменение размера моего компонента в design-time? Ответ: Поместите в конструктор компонента код, устанавливающий размеры по умолчанию. Переопределите метод SetBounds и проверяйте в нем "componentstate". Если компонет находится режиме "design-time" (csDesigning in ComponentState) просто передавайте значения ширины и высоты (width и heights) компонента по умолчанию (в нашем примере 50) методу класса-предка. Пример: procedure TVu.SetBounds(ALeft : integer; ATop : integer; AWidth : integer; AHeight : integer); begin if csdesigning in componentstate then begin AWidth := 50; AHeight := 50; inherited; //вызываем унаследованный от предка метод end; end;
Вопрос: Можно ли уменьшить потребляемые компонентами TNotebook и TTabbedNotebook ресурсы? Ответ: Да. Можно уничтожать обьекты, расположенные не на текущей странице TNotebook или TTabbedNotebook. В примере вызывается защищенный (Protected) метод путем создания так называемый "class cracer'ов". type TMyTabbedNotebook = class(TTabbedNotebook); //это наш "class cracer" type TMyNotebook = class(TNotebook);
procedure TForm1.TabbedNotebook1Change(Sender: TObject; NewTab: Integer; var AllowChange: Boolean); begin with TabbedNotebook1 do //вызываем защищенный метод родительского класса TMyTabbedNotebook(TWinControl(Pages.Objects[PageIndex])).DestroyHandle; end;
procedure TForm1.TabSet1Change(Sender: TObject; NewTab: Integer; var AllowChange: Boolean); begin with Notebook1 do //вызываем защищенный метод родительского класса TMyNotebook(TWinControl(Pages.Objects[PageIndex])).DestroyHandle; NoteBook1.PageIndex := NewTab; AllowChange := true end;
Вопрос: Функция keybd_event() принимает значения до 244 — как мне отправить нажатие клавиши с кодом #255 в элемент управления Windows? Ответ: Это может понадобится для иностранных языков или для специальных символов. (например, в русских шрифтах символ с кодом #255 — я прописное). Приведенный в примере метод не стоит использовать в случае, если символ может быть передан обычным способом (функцией keybd_event()). procedure TForm1.Button1Click(Sender: TObject); var KeyData : packed record RepeatCount : word; ScanCode : byte; Bits : byte; end; begin {Let the button repaint} Application.ProcessMessages; {Set the focus to the window} Edit1.SetFocus; {Send a right so the char is added to the end of the line} // SimulateKeyStroke(VK_RIGHT, 0); keybd_event(VK_RIGHT, 0,0,0); {Let the app get the message} Application.ProcessMessages; FillChar(KeyData, sizeof(KeyData), #0); KeyData.ScanCode := 255; KeyData.RepeatCount := 1; SendMessage(Edit1.Handle, WM_KEYDOWN, 255,LongInt(KeyData)); KeyData.Bits := KeyData.Bits or (1 shl 30); KeyData.Bits := KeyData.Bits or (1 shl 31); SendMessage(Edit1.Handle, WM_KEYUP, 255, LongInt(KeyData)); KeyData.Bits := KeyData.Bits and not (1 shl 30); KeyData.Bits := KeyData.Bits and not (1 shl 31); SendMessage(Edit1.Handle, WM_CHAR, 255, LongInt(KeyData)); Application.ProcessMessages; end;
Вопрос: Некоторые компоненты не меняют курсор мыши до тех пор пока пользователь не сдвинет мышь. Как эмулировать движение мыши? Ответ: В примере мышка слегка "подталкивается" без участия пользователя. procedure TForm1.Button1Click(Sender: TObject); var pt : TPoint; begin Application.ProcessMessages; Screen.Cursor := CrHourglass; GetCursorPos(pt); SetCursorPos(pt.x + 1, pt.y + 1); Application.ProcessMessages; SetCursorPos(pt.x - 1, pt.y - 1); end;
Вопрос: Как зарегистрировать расширение файла за своим приложением и контекстное меню, связанное с этим типом? Ответ: Пример регистрирует расширение
var Form1: TForm1;
implementation {$R *.DFM}
uses Unit2;
procedure TForm1.FormShow(Sender: TObject); begin Form2.Show; end;
procedure TForm1.UMMyGlobalMessage(var AMessage: TMessage); begin Label1.Left := AMessage.WParam; Label1.Top := AMessage.LParam; Form1.Caption := 'Got It!'; end;
procedure TForm1.Button1Click(Sender: TObject); var f: integer; begin for f := 0 to Screen.FormCount - 1 do Screen.Forms[f].Perform(UM_MyGlobalMessage, 42, 42); end;
{Code for Unit2} const UM_MyGlobalMessage = WM_USER + 1; type TForm2 = class(TForm) Label1: TLabel; private {Private declarations} procedure UMMyGlobalMessage(var AMessage: TMessage); message UM_MyGlobalMessage; public {Public declarations} end;
var Form2: TForm2;
implementation {$R *.DFM}
procedure TForm2.UMMyGlobalMessage(var AMessage: TMessage); begin Label1.Left := AMessage.WParam; Label1.Top := AMessage.LParam; Form2.Caption := 'Got It!'; end;
Вопрос: Как обновить список дисков компонента TDriveComboBox, учитывая, что могут быть подключены/отключены сетевые диски и произведена "горячая замена" plug&play дисков? Ответ: Следующий пример вызывает защищенный (protected) метод класса TDriveComboBox BuildList() для регенерации списка дисков. (использовая так наз. "class cracer") Пример: type TNewDriveComboBox = class(TDriveComboBox) //это наш "class cracer" end;
procedure TForm1.Button1Click(Sender: TObject); var Drive : char; begin Drive := DriveComboBox1.Drive; TNewDriveComboBox(DriveComboBox1).BuildList; //вызываем защищенный метод родительского класса DriveComboBox1.Drive := Drive; end;
Вопрос: Как программно заставить выпасть меню? Ответ: В примере показано как показать меню и выбрать в нем какой-то пункт, эмулируя нажатие "быстрой клавиши" пункта меню. Если у Вашего пункта меню нет "быстрой клавиши" Вы можете посылать комбинации VK_MENU, VK_LEFT, VK_DOWN, и VK_RETURN, чтобы программно "путешествовать" по меню. Пример: procedure TForm1.Button1Click(Sender: TObject); begin //Allow button to finish painting in response to the click Application.ProcessMessages; {Alt Key Down} keybd_Event(VK_MENU, 0, 0, 0); {F Key Down - Drops the menu down} keybd_Event(ord('F'), 0, 0, 0); {F Key Up} keybd_Event(ord('F'), 0, KEYEVENTF_KEYUP, 0); {Alt Key Up} keybd_Event(VK_MENU, 0, KEYEVENTF_KEYUP, 0); {F Key Down} keybd_Event(ord('S'), 0, 0, 0); {F Key Up} keybd_Event(ord('S'), 0, KEYEVENTF_KEYUP, 0); end;
Вопрос: Как сделать клавишу-акселератор (keyboard shortcut) компоненту, у которого нет заголовка? Ответ: Возможный вариант — присвоить ссылку на этот компонент свойству FocusControl TLabel'а. В примере используется невидимый Label для создания "быстрой" клавиши (Alt+M) компонента Memo. Чтобы использовать пример, разместите на форме компонет TMemo, Label и несколько других компонентов, которые могут принимать фокус ввода. Запустите программу, перевидите фокус ввода куда-нибудь вне Memo и нажмите Alt+M — фокус ввода вернется в Memo. Пример: procedure TForm1.FormCreate(Sender: TObject); begin Label1.Visible := false; Label1.Caption := '&M'; Label1.FocusControl := Memo1; end;
Вопрос: Можно ли как-то уменьшить мерцание при перерисовке компонента? Ответ: Если добавить флаг csOpaque (непрозрачный) к свойству ControlStyle компонента — то фон компонента перерисовываться не будет. Пример: constructor TMyControl.Create; begin inherited; ControlStyle := ControlStyle + [csOpaque]; end;
Вопрос: Как запретить изменение размера моего компонента в design-time? Ответ: Поместите в конструктор компонента код, устанавливающий размеры по умолчанию. Переопределите метод SetBounds и проверяйте в нем "componentstate". Если компонет находится режиме "design-time" (csDesigning in ComponentState) просто передавайте значения ширины и высоты (width и heights) компонента по умолчанию (в нашем примере 50) методу класса-предка. Пример: procedure TVu.SetBounds(ALeft : integer; ATop : integer; AWidth : integer; AHeight : integer); begin if csdesigning in componentstate then begin AWidth := 50; AHeight := 50; inherited; //вызываем унаследованный от предка метод end; end;
Вопрос: Можно ли уменьшить потребляемые компонентами TNotebook и TTabbedNotebook ресурсы? Ответ: Да. Можно уничтожать обьекты, расположенные не на текущей странице TNotebook или TTabbedNotebook. В примере вызывается защищенный (Protected) метод путем создания так называемый "class cracer'ов". type TMyTabbedNotebook = class(TTabbedNotebook); //это наш "class cracer" type TMyNotebook = class(TNotebook);
procedure TForm1.TabbedNotebook1Change(Sender: TObject; NewTab: Integer; var AllowChange: Boolean); begin with TabbedNotebook1 do //вызываем защищенный метод родительского класса TMyTabbedNotebook(TWinControl(Pages.Objects[PageIndex])).DestroyHandle; end;
procedure TForm1.TabSet1Change(Sender: TObject; NewTab: Integer; var AllowChange: Boolean); begin with Notebook1 do //вызываем защищенный метод родительского класса TMyNotebook(TWinControl(Pages.Objects[PageIndex])).DestroyHandle; NoteBook1.PageIndex := NewTab; AllowChange := true end;
Вопрос: Функция keybd_event() принимает значения до 244 — как мне отправить нажатие клавиши с кодом #255 в элемент управления Windows? Ответ: Это может понадобится для иностранных языков или для специальных символов. (например, в русских шрифтах символ с кодом #255 — я прописное). Приведенный в примере метод не стоит использовать в случае, если символ может быть передан обычным способом (функцией keybd_event()). procedure TForm1.Button1Click(Sender: TObject); var KeyData : packed record RepeatCount : word; ScanCode : byte; Bits : byte; end; begin {Let the button repaint} Application.ProcessMessages; {Set the focus to the window} Edit1.SetFocus; {Send a right so the char is added to the end of the line} // SimulateKeyStroke(VK_RIGHT, 0); keybd_event(VK_RIGHT, 0,0,0); {Let the app get the message} Application.ProcessMessages; FillChar(KeyData, sizeof(KeyData), #0); KeyData.ScanCode := 255; KeyData.RepeatCount := 1; SendMessage(Edit1.Handle, WM_KEYDOWN, 255,LongInt(KeyData)); KeyData.Bits := KeyData.Bits or (1 shl 30); KeyData.Bits := KeyData.Bits or (1 shl 31); SendMessage(Edit1.Handle, WM_KEYUP, 255, LongInt(KeyData)); KeyData.Bits := KeyData.Bits and not (1 shl 30); KeyData.Bits := KeyData.Bits and not (1 shl 31); SendMessage(Edit1.Handle, WM_CHAR, 255, LongInt(KeyData)); Application.ProcessMessages; end;
Вопрос: Некоторые компоненты не меняют курсор мыши до тех пор пока пользователь не сдвинет мышь. Как эмулировать движение мыши? Ответ: В примере мышка слегка "подталкивается" без участия пользователя. procedure TForm1.Button1Click(Sender: TObject); var pt : TPoint; begin Application.ProcessMessages; Screen.Cursor := CrHourglass; GetCursorPos(pt); SetCursorPos(pt.x + 1, pt.y + 1); Application.ProcessMessages; SetCursorPos(pt.x - 1, pt.y - 1); end;
Вопрос: Как зарегистрировать расширение файла за своим приложением и контекстное меню, связанное с этим типом? Ответ: Пример регистрирует расширение