Skip to Content

Создание нового компонента на базе элементов управления из библиотеки ComCtl32

С каждой версией Internet Explorer Microsoft поставляет новую библиотеку ComQ132 с новыми элементами управления. Программисты Borland пытаются поспеть за ними, но получается это не всегда. Так что полезно было бы и самому научиться создавать оболочку для новых и необходимых элементов управления, тем более, что это несложно. Рассмотрим это на примере.

Подходящей кандидатурой может служить редактор IP-адресов, появившийся в версии библиотеки 4.71 (Internet Explorer 4.0). Это элемент, упрощающий редактирование адресов для многих Internet-компонентов и приложений.

Рис. 5.8. Мастер создания новых компонентов Delphi 7

Мастер создания новых компонентов (рис. 5.8) создаст для нас шаблон. Поскольку элементы из состава библиотеки ComCtl32 есть не что иное, как окна со специфическими свойствами, наш компонент мы породим от TWinControl. IP-редактор представляет собой окно класса WC_IPADDRESS.

Название нового компонента выбрано TCustomiPEdit. Такая схема принята разработчиками Delphi для большинства компонентов VCL. Непосредственным предком, допустим, TEdit является компонент TCustomEdit.

Первым делом при создании компонента — особо не раздумывая — следует опубликовать типовые свойства и события, которые есть у большинства визуальных компонентов. Чтобы не занимать место в книге, позаимствуем их список у любого другого компонента из модуля ComCtrls.pas.

Далее приступим к описанию свойств, которыми будет отличаться наш компонент от других. Возможности, предоставляемые IP-редактором, описаны в справочной системе MSDN. Визуально он состоит из четырех полей, разделенных точками (рис. 5.9).

Рис. 5.9. Тестовое приложение, содержащее IP-редактор (внизу)

Для каждого из полей можно задать отдельно верхнюю и нижнюю границы допустимых значений. Это удобно, если вы планируете работать с адресами какой-либо конкретной IP-сети. По умолчанию границы равны 0—255.

Элемент управления обрабатывает шесть сообщений (см. документацию MSDN), которые сведены в табл. 5.8.

Таблица 5.8. Сообщения, обрабатываемые элементом управления IP Address Control

Сообщение - Назначение

IPM CLEARADDRESS - Очистить поле адреса

IPM GETADDRESS - Считать адрес

IPM_ISBLANK - Проверить, не пустое ли поле адреса

IPM SETADDRESS - Установить адрес

IPM_SETFOCUS - Передать фокус заданному полю элемента управления

IPM_SETRANGE - Установить ограничения на значения в заданном поле

Кроме перечисленных, IP-редактор извещает приложение об изменениях, произведенных пользователем, путем посылки ему сообщения WM_NOTIFY.

Следует иметь в виду, что IP-редактор не является потомком обычного редактора (TCustomEdit) и не обрабатывает характерные для того сообщения ЕМ_ХХХХ, так что название TCustomipEdit отражает только внешнее сходство.

В создаваемом коде компонента первым делом нужно переписать конструктор Create и метод createParams. Последний метод вызывается перед созданием окна для установки его будущих параметров. Именно здесь нужно инициализировать библиотеку общих элементов управления ComCtl32 и породить новый класс окна.

  1. constructor TIPEditor.Create(AOwner: TComponent);
  2.  
  3. begin
  4.  
  5. inherited Create(AOwner);
  6.  
  7. ControlStyle := [csCaptureMouse, csClickEvents, csDoubleClicks, csOpaque];
  8.  
  9. Color := clBtnFace;
  10.  
  11. Width := 160;
  12.  
  13. Height := 25;
  14.  
  15. Align := alNone;
  16.  
  17. end;
  18.  
  19. procedure TIPEditor.CreateParams(var Params: TCreateParams);
  20.  
  21. begin
  22.  
  23. InitCommonControl(ICC_INTERNET_CLASSES);
  24.  
  25. inherited CreateParams(Params);
  26.  
  27. CreateSubClass(Params, WC_IPADDRESS);
  28.  
  29. end;

После создания свое значение получает дескриптор окна Handle (это свойство унаследовано от TwinControl). Все чтение/запись свойств элемента происходит путем обмена сообщениями с использованием этого дескриптора. Минимально необходимыми для работы являются свойства IP (задает IP-адрес в редакторе), ipstring (отображает его в виде текстовой строки) и процедура clear (очищает редактор).

Реализовано это следующим образом:

Листинг 5.2. Исходный код компонента TCustomlPEdit

  1. unit uIPEdit;
  2.  
  3. interface
  4.  
  5. uses
  6.  
  7. Windows, Messages, SysUtils, Classes, Controls;
  8.  
  9. type
  10.  
  11. TCustomlPEdit = class(TWinControl)
  12.  
  13. private
  14.  
  15. { Private declarations }
  16.  
  17. FIPAddress: DWORD;
  18.  
  19. FIPLimits: array [0..3] of word;
  20.  
  21. FCurrentField : Integer;
  22.  
  23. //procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey);
  24.  
  25. message CM_WANTSPECIALKEY;
  26.  
  27. procedure WMGetDlgCode(var Message: TWMGetDlgCode);
  28.  
  29. message WM_GETDLGCODE;
  30.  
  31. procedure CMDialogChar(var Message: TCMDialogChar);
  32.  
  33. message CM_DIALOGCHAR;
  34.  
  35. //procedure CMDialogKey(var Message: TCMDialogKey);
  36.  
  37. message CM_DIALOGKEY;
  38.  
  39. procedure CNNotify(var Message: TWMNotify);
  40.  
  41. message CN_NOTIFY;
  42.  
  43. protected
  44.  
  45. { Protected declarations }
  46.  
  47. function GetIP(Index: Integer): Byte;
  48.  
  49. procedure SetIP(Index: Integer; Value: Byte);
  50.  
  51. function GetMinIP(Index: Integer): Byte;
  52.  
  53. procedure SetMinIP(Index: Integer; Value: Byte);
  54.  
  55. function GetMaxIP(Index: Integer): Byte;
  56.  
  57. procedure SetMaxIP(Index: Integer; Value: Byte);
  58.  
  59. function GetlPString: string;
  60.  
  61. procedure SetlPString(Value: string);
  62.  
  63. function IsBlank: boolean;
  64.  
  65. procedure SetCurrentFieldfIndex: Integer);
  66.  
  67. //
  68.  
  69. procedure CreateParams(var Params: TCreateParams); override;
  70.  
  71. procedure CreateWnd; override;
  72.  
  73. //procedure KeyDown(var Key: Word; Shift: TShiftState);override;
  74.  
  75. function IPDwordToString(dw: DWORD): string;
  76.  
  77. function IPStringToDword(s: string): DWORD;
  78.  
  79. public
  80.  
  81. { Public declarations }
  82.  
  83. constructor Create(AOwner: TComponent);
  84.  
  85. override;
  86.  
  87. property IP[Index: Integer]: byte read GetIP write SetIP;
  88.  
  89. property MinIP[Index: Integer]: byte read GetMinIP write SetMinIP;
  90.  
  91. property MaxIP[Index: Integer]: byte read GetMaxIP write SetMaxIP;
  92.  
  93. property IPString : string read GetlPString write SetlPString;
  94.  
  95. property CurrentField : Integer read FCurrentField write SetCurrentField;
  96.  
  97. procedure Clear;
  98.  
  99. end;
  100.  
  101. TIPEdit = class(TCustomlPEdit)
  102.  
  103. published
  104.  
  105. property Align;
  106.  
  107. property Anchors;
  108.  
  109. property BorderWidth;
  110.  
  111. property DragCursor;
  112.  
  113. property DragKind;
  114.  
  115. property DragMode;
  116.  
  117. property Enabled;
  118.  
  119. property Font;
  120.  
  121. property Hint;
  122.  
  123. property Constraints;
  124.  
  125. property ParentShowHint;
  126.  
  127. property PopupMenu;
  128.  
  129. property ShowHint;
  130.  
  131. property TabOrder;
  132.  
  133. property TabStop;
  134.  
  135. property Visible;
  136.  
  137. property OnContextPopup;
  138.  
  139. property OnDragDrop;
  140.  
  141. property OnDragOver;
  142.  
  143. property OnEndDock;
  144.  
  145. property OnEndDrag;
  146.  
  147. property OnEnter;
  148.  
  149. property OnExit;
  150.  
  151. property OnMouseDown;
  152.  
  153. property OnMouseMove;
  154.  
  155. property OnMouseUp;
  156.  
  157. property OnStartDock;
  158.  
  159. property OnStartDrag;
  160.  
  161. { Published declarations }
  162.  
  163. property IPString;
  164.  
  165. end;
  166.  
  167. procedure Register;
  168.  
  169. implementation
  170.  
  171. uses Graphics, commctrl, comctrls;
  172.  
  173. constructor TCustomlPEdit.Create(AOwner: TComponent);
  174.  
  175. begin
  176.  
  177. inherited Create(AOwner);
  178.  
  179. FIPAddress := 0;
  180.  
  181. ControlStyle := [csCaptureMouse, csClickEvents, csDoubleClicks, csOpaque];
  182.  
  183. Color := clBtnFace;
  184.  
  185. Width := 160;
  186.  
  187. Height := 25;
  188.  
  189. Align := alNone;
  190.  
  191. TabStop := True; end;
  192.  
  193. procedure TCustomlPEdit.CreateParams(var Params: TCreateParams);
  194.  
  195. begin
  196.  
  197. InitCommonControl(ICC_INTERNET_CLASSES);
  198.  
  199. inherited CreateParams(Params); CreateSubClass(Params, WC_IPADDRESS);
  200.  
  201. with Params do
  202.  
  203. begin
  204.  
  205. Style := WS_VISIBLE or WS_BORDER or WS_CHILD;
  206.  
  207. if NewStyleControls and CtlSD then
  208.  
  209. begin
  210.  
  211. Style := Style and not WS_BORDER; ExStyle := ExStyle or WS_EX_CLIENTEDGE;
  212.  
  213. end;
  214.  
  215. end;
  216.  
  217. end;
  218.  
  219. procedure TCustomlPEdit.CreateWnd;
  220.  
  221. var i: Integer;
  222.  
  223. begin
  224.  
  225. inherited CreateWnd; Clear;
  226.  
  227. { for i := 0 to 3 do
  228.  
  229.  begin
  230.  
  231. MinIP[i] := 0; MaxIP[i] := $FF; end; }
  232.  
  233. CurrentField := 0;
  234.  
  235. end;
  236.  
  237. procedure TCustomlPEdit.WMGetDlgCode(var Message: TWMGetDlgCode);
  238.  
  239. begin
  240.  
  241. inherited;
  242.  
  243. Message.Result := {Message.Result or} DLGC_WANTTAB;
  244.  
  245. end;
  246.  
  247. procedure TCustomlPEdit.CNNotify(var Message: TWMNotify);
  248.  
  249. begin
  250.  
  251. with Message.NMHdr" do
  252.  
  253. begin case Code of
  254.  
  255. IPN_FIELDCHANGED : begin
  256.  
  257. FCurrentField := PNMIPAddress(Message.NMHdr)~.iField; {if Assigned(OnlpFieldChange) then
  258.  
  259. with PNMIPAdress(Message.NMHdr)^ do begin
  260.  
  261. OnIPFieldChange(Self, iField, iValue);}
  262.  
  263. end;
  264.  
  265. end;
  266.  
  267. end;
  268.  
  269. end;
  270.  
  271. (procedure TCustomlPEdit.KeyDown(var Key: Word; Shift: TShiftState);
  272.  
  273. begin
  274.  
  275. inherited KeyDown(Key, Shift);
  276.  
  277. if Key = VKJTAB then if ssShift in Shift then
  278.  
  279. CurrentField := (CurrentField -1+4) mod 4
  280.  
  281. else
  282.  
  283. CurrentField := (CurrentField + I) mod 4; end; }
  284.  
  285. {procedure TCustomlPEdit.CMWantSpecialKey(var Msg: TCMWantSpecialKey);
  286.  
  287. begin
  288.  
  289. inherited;
  290.  
  291. //Msg.Result := Ord(Char(Msg.CharCode) = #9) ; end;}
  292.  
  293. procedure TCustomlPEdit.CMDialogChar(var Message: TCMDialogChar);
  294.  
  295. begin with Message do
  296.  
  297. if CharCode = VKJTAB then
  298.  
  299. begin
  300.  
  301. Message.Result := 0; if GetKeyState(VK_SHIFT)<>0 then
  302.  
  303. begin
  304.  
  305. if (CurrentField=0) then Exit; CurrentField := CurrentField — 1;
  306.  
  307. end
  308.  
  309. else
  310.  
  311. begin
  312.  
  313. if (CurrentField=3) then Exit; CurrentField := CurrentField + 1;
  314.  
  315. end;
  316.  
  317. Message.Result := 1; end //VK_TAB
  318.  
  319. else
  320.  
  321. inherited; end;
  322.  
  323. {procedure TCustomlPEdit.CMDialogKey(var Message: TCMDialogKey);
  324.  
  325. begin
  326.  
  327. if (Focused or Windows.IsChild(Handle, Windows.GetFocus))
  328.  
  329. and
  330.  
  331. (Message.CharCode = VK_TAB) and (GetKeyState(VK_CONTROL) < 0) then
  332.  
  333. begin
  334.  
  335. if GetKeyState (VK_SHIFT) 00 then
  336.  
  337. CurrentField := (CurrentField -1+4) mod 4
  338.  
  339. else
  340.  
  341. CurrentField := (CurrentField + 1) ir.oci 4; Message.Result := 1;
  342.  
  343. end else
  344.  
  345. inherited; end; }
  346.  
  347. function TCustomlPEdit.GetIP(Index: Integer): Byte;
  348.  
  349. begin
  350.  
  351. SendMessage
  352.  
  353. (Handle,IPM_GETADDRESS,0,longint(@FipAddress));
  354.  
  355. case Index of
  356.  
  357. 1 : Result := FIRST_IPADDRESS(FipAddress);
  358.  
  359. 2 : Result := SECOND_IPADDRESS(FipAddress) ;
  360.  
  361. 3 : Result := THIRD_IPADDRESS(FipAddress);
  362.  
  363. 4 : Result := FOURTH_IPADDRESS(FipAddress); else Result := 0;
  364.  
  365. end;
  366.  
  367. end;
  368.  
  369. procedure TCustomlPEdit.SetIP(Index: Integer; Value: Byte);
  370.  
  371. begin
  372.  
  373. case Index of
  374.  
  375. 1: FIPAddress := FIPAddress AND $FFFFFF or DWORD(Value) shl 24;
  376.  
  377. 2: FIPAddress := FIPAddress AND $FFOOFFFF or DWORD(Value) shl 16;
  378.  
  379. 3: FIPAddress := FIPAddress AND $FFFFOOFF or DWORD(Value) shl 8;
  380.  
  381. 4: FIPAddress := FIPAddress AND $FFFFFFOO or DWORD(Value);
  382.  
  383. else Exit;
  384.  
  385. end;
  386.  
  387. SendMessage(Handle, IPM_SETADDRESS, 0, FIPAddress);
  388.  
  389. end;
  390.  
  391. function TCustomlPEdit.GetMinIP(Index: Integer): Byte; begin if (Index<0) or (Index>3) then
  392.  
  393. Result := 0
  394.  
  395. else
  396.  
  397. Result := LoByte(FIPLimits<ol>
  398. </ol>
  399. );
  400.  
  401. end;
  402.  
  403. procedure TCustomlPEdit.SetMinIP(Index: Integer; Value: Byte);
  404.  
  405. begin
  406.  
  407. if (Index<0) or (Index>3)
  408.  
  409. then Exit;
  410.  
  411. FIPLimits<ol>
  412. </ol>
  413. := MAKEIPRANGE(HiByte(FIPLimits<ol>
  414. </ol>
  415. ), Value);
  416.  
  417. SendMessage(Handle, IPM_SETRANGE, Index, FIPLimits<ol>
  418. </ol>
  419. );
  420.  
  421. end;
  422.  
  423. function TCustomlPEdit.GetMaxIP(Index: Integer): Byte; begin if (Index<0) or (Index>3)
  424.  
  425. then
  426.  
  427. Result := 0
  428.  
  429. else
  430.  
  431. Result := HiByte(FIPLimits<ol>
  432. </ol>
  433. );
  434.  
  435. end;
  436.  
  437. procedure TCustomlPEdit.SetMaxIP(Index: Integer; Value: Byte);
  438.  
  439. begin
  440.  
  441. if (Index<0) or (Index>3) then Exit;
  442.  
  443. FIPLimits<ol>
  444. </ol>
  445. := MAKEIPRANGE(Value, LoByte(FIPLimits<ol>
  446. </ol>
  447. ));
  448.  
  449. SendMessage(Handle, IPM_SETRANGE, Index, FIPLimits<ol>
  450. </ol>
  451. );
  452.  
  453. end;
  454.  
  455. procedure TCustomlPEdit.Clear,
  456.  
  457. begin
  458.  
  459. SendMessage(Handle, IPM_CLEARADDRESS, 0, 0);
  460.  
  461. end;
  462.  
  463. function TCustomlPEdit.IsBlank: boolean;
  464.  
  465. begin
  466.  
  467. Result:= SendMessage(Handle, IPM_ISBLANK, 0, 0) = 0;
  468.  
  469. end;
  470.  
  471. procedure TCustomlPEdit.SetCurrentField(Index: Integer);
  472.  
  473. begin
  474.  
  475. if (Index<0) or (Index>3)
  476.  
  477. then Exit;
  478.  
  479. FCurrentField := Index;
  480.  
  481. SendMessage(Handle, IPM_SETFOCUS, wParam(FCurrentField), 0) ;
  482.  
  483. end;
  484.  
  485. function TCustomlPEdit.IPDwordToString(dw: DWORD): string;
  486.  
  487. begin
  488.  
  489. Result := Format('%d.%d.%d.%d',
  490.  
  491. [FIRST_IPADDRESS(dw),
  492.  
  493. SECOND_IPADDRESS(dw),
  494.  
  495. THIRD_IPADDRESS(dw),
  496.  
  497. FOURTH_IPADDRESS(dw)]);
  498.  
  499. end;
  500.  
  501. function TCustomlPEdit.IPStringToDword(s: string): DWORD;
  502.  
  503. var i,j : Integer;
  504.  
  505. NewAddr, Part : DWORD;
  506.  
  507. begin
  508.  
  509. NewAddr := 0;
  510.  
  511. try
  512.  
  513. i := 0; repeat
  514.  
  515. j := Pos('.', s); if j<=l then if i<3 then
  516.  
  517. Abort else
  518.  
  519. Part := StrToInt(s) else
  520.  
  521. Part := StrToInt(Copy(s, I, j-1));
  522.  
  523. if Part>255 then Abort; Delete(s, 1, j);
  524.  
  525. NewAddr := (NewAddr shl 8) or Part;
  526.  
  527. Inc(i);
  528.  
  529. until i>3;
  530.  
  531. Result := NewAddr;
  532.  
  533. //Windows.MessageBox(0, pChar(IntToHex(FIPAddress, 8)), '', MB_Ok);
  534.  
  535. except end;
  536.  
  537. end;
  538.  
  539. function TCustomlPEdit.GetlPString: string;
  540.  
  541. begin
  542.  
  543. SendMessage(Handle,IPM_GETADDRESS, 0, longint(SFIPAddress));
  544.  
  545. Result := IpDwordToString(FIPAddress);
  546.  
  547. end;
  548.  
  549. procedure TCustomlPEdit.SetlPString(Value: string);
  550.  
  551. begin
  552.  
  553. FIPAddress := IPStringToDword(Value);
  554.  
  555. SendMessage(Handle, IPM_SETADDRESS, 0, FIPAddress);
  556.  
  557. end;
  558.  
  559. procedure Register;
  560.  
  561. begin
  562.  
  563. RegisterComponents('Samples', [TIPEdit]);
  564.  
  565. end;
  566.  
  567. end.

Для удобства пользования полезно было бы добавить к компоненту CustomiPEdit задание диапазона для каждого из четырех составляющих и средства преобразования текстовой строки в двоичный адрес. Но это уже совсем другая история, к библиотеке ComQ132 отношения не имеющая.



Delphi Для профессионалов &1   |    Delphi Для профессионалов &2   |    Delphi Для профессионалов &3   |    Иллюстрированный самоучитель &1   |    Иллюстрированный самоучитель &2