С каждой версией Internet Explorer Microsoft поставляет новую библиотеку ComQ132 с новыми элементами управления. Программисты Borland пытаются поспеть за ними, но получается это не всегда. Так что полезно было бы и самому научиться создавать оболочку для новых и необходимых элементов управления, тем более, что это несложно. Рассмотрим это на примере.
Подходящей кандидатурой может служить редактор IP-адресов, появившийся в версии библиотеки 4.71 (Internet Explorer 4.0). Это элемент, упрощающий редактирование адресов для многих Internet-компонентов и приложений.
Мастер создания новых компонентов (рис. 5.8)
создаст для нас шаблон. Поскольку элементы из состава библиотеки ComCtl32 есть
не что иное, как окна со специфическими свойствами, наш компонент мы породим
от TWinControl. IP-редактор представляет
собой окно класса WC_IPADDRESS.
Первым делом при создании компонента — особо
не раздумывая — следует опубликовать типовые свойства и события, которые есть
у большинства визуальных компонентов. Чтобы не занимать место в книге, позаимствуем
их список у любого другого компонента из модуля ComCtrls.pas.
Далее приступим к описанию свойств, которыми
будет отличаться наш компонент от других. Возможности, предоставляемые IP-редактором,
описаны в справочной системе MSDN. Визуально он состоит из четырех полей, разделенных
точками (рис. 5.9).
Для каждого из полей можно задать отдельно верхнюю
и нижнюю границы допустимых значений. Это удобно, если вы планируете работать
с адресами какой-либо конкретной IP-сети. По умолчанию границы равны 0—255.
Элемент управления обрабатывает шесть сообщений
(см. документацию MSDN), которые сведены в табл. 5.8.
Кроме перечисленных, IP-редактор извещает приложение
об изменениях, произведенных пользователем, путем посылки ему сообщения WM_NOTIFY.
Следует иметь в виду, что IP-редактор не является
потомком обычного редактора (TCustomEdit)
и не обрабатывает характерные для того сообщения
ЕМ_ХХХХ, так что название TCustomipEdit
отражает только внешнее сходство.
unit uIPEdit;
interface
uses
Windows, Messages,
SysUtils, Classes, Controls;
type
TCustomlPEdit
= class(TWinControl)
private
{ Private declarations
}
FIPAddress:
DWORD;
FIPLimits:
array [0..3] of word;
FCurrentField
: Integer;
//procedure
CMWantSpecialKey(var Msg: TCMWantSpecialKey);
message
CM_WANTSPECIALKEY;
procedure WMGetDlgCode(var
Message: TWMGetDlgCode);
message WM_GETDLGCODE;
procedure CMDialogChar(var
Message: TCMDialogChar);
message
CM_DIALOGCHAR;
//procedure
CMDialogKey(var Message: TCMDialogKey);
message
CM_DIALOGKEY;
procedure CNNotify(var
Message: TWMNotify);
message CN_NOTIFY;
protected
{ Protected
declarations }
function GetIP(Index:
Integer): Byte;
procedure SetIP(Index:
Integer; Value: Byte);
function GetMinIP(Index:
Integer): Byte;
procedure SetMinIP(Index:
Integer; Value: Byte);
function GetMaxIP(Index:
Integer): Byte;
procedure SetMaxIP(Index:
Integer; Value: Byte);
function GetlPString:
string;
procedure SetlPString(Value:
string);
function IsBlank:
boolean;
procedure SetCurrentFieldfIndex:
Integer);
//
procedure CreateParams(var
Params: TCreateParams); override;
procedure CreateWnd;
override;
//procedure
KeyDown(var Key: Word; Shift: TShiftState);override;
function IPDwordToString(dw:
DWORD): string;
function IPStringToDword(s:
string): DWORD;
public
{ Public declarations
}
constructor
Create(AOwner: TComponent);
override;
property IP[Index:
Integer]: byte read GetIP write SetIP;
property MinIP[Index:
Integer]: byte read GetMinIP write SetMinIP;
property MaxIP[Index:
Integer]: byte read GetMaxIP write SetMaxIP;
property IPString
: string read GetlPString write SetlPString;
property CurrentField
: Integer read FCurrentField write SetCurrentField;
procedure
Clear;
end;
TIPEdit = class(TCustomlPEdit)
published
property Align;
property Anchors;
property BorderWidth;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property Hint;
property Constraints;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnContextPopup;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
{ Published
declarations }
property IPString;
end;
procedure Register;
implementation
uses Graphics,
commctrl, comctrls;
constructor
TCustomlPEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FIPAddress
:= 0;
ControlStyle
:= [csCaptureMouse, csClickEvents, csDoubleClicks, csOpaque];
Color := clBtnFace;
Width := 160;
Height := 25;
Align := alNone;
TabStop :=
True; end;
procedure TCustomlPEdit.CreateParams(var
Params: TCreateParams);
begin
InitCommonControl(ICC_INTERNET_CLASSES);
inherited CreateParams(Params);
CreateSubClass(Params, WC_IPADDRESS);
with Params
do
begin
Style := WS_VISIBLE
or WS_BORDER or WS_CHILD;
if NewStyleControls
and CtlSD then
begin
Style := Style
and not WS_BORDER; ExStyle := ExStyle or WS_EX_CLIENTEDGE;
end;
end;
end;
procedure TCustomlPEdit.CreateWnd;
var i:
Integer;
begin
inherited CreateWnd;
Clear;
{ for i :=
0 to 3 do
begin
MinIP[i] :=
0; MaxIP[i] := $FF; end; }
CurrentField
:= 0;
end;
procedure TCustomlPEdit.WMGetDlgCode(var
Message: TWMGetDlgCode);
begin
inherited;
Message.Result
:= {Message.Result or} DLGC_WANTTAB;
end;
procedure TCustomlPEdit.CNNotify(var
Message: TWMNotify);
begin
with Message.NMHdr"
do
begin
case Code of
IPN_FIELDCHANGED
: begin
FCurrentField
:= PNMIPAddress(Message.NMHdr)~.iField; {if Assigned(OnlpFieldChange) then
with PNMIPAdress(Message.NMHdr)^
do begin
OnIPFieldChange(Self,
iField, iValue);}
end;
end;
end;
end;
(procedure
TCustomlPEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
inherited KeyDown(Key,
Shift);
if Key
= VKJTAB then if ssShift in Shift then
CurrentField
:= (CurrentField -1+4) mod 4
else
CurrentField
:= (CurrentField + I) mod 4; end; }
{procedure
TCustomlPEdit.CMWantSpecialKey(var Msg: TCMWantSpecialKey);
begin
inherited;
//Msg.Result
:= Ord(Char(Msg.CharCode) = #9) ; end;}
procedure TCustomlPEdit.CMDialogChar(var
Message: TCMDialogChar);
begin with
Message do
if CharCode
= VKJTAB then
begin
Message.Result
:= 0; if GetKeyState(VK_SHIFT)<>0 then
begin
if (CurrentField=0)
then Exit; CurrentField := CurrentField — 1;
end
else
begin
if (CurrentField=3)
then Exit; CurrentField := CurrentField + 1;
end;
Message.Result
:= 1; end //VK_TAB
else
inherited;
end;
{procedure
TCustomlPEdit.CMDialogKey(var Message: TCMDialogKey);
begin
if (Focused
or Windows.IsChild(Handle, Windows.GetFocus))
and
(Message.CharCode
= VK_TAB) and (GetKeyState(VK_CONTROL) < 0) then
begin
if GetKeyState
(VK_SHIFT) 00 then
CurrentField
:= (CurrentField -1+4) mod 4
else
CurrentField
:= (CurrentField + 1) ir.oci 4; Message.Result := 1;
end else
inherited;
end; }
function TCustomlPEdit.GetIP(Index:
Integer): Byte;
begin
SendMessage
(Handle,IPM_GETADDRESS,0,longint(@FipAddress));
case Index
of
1 : Result
:= FIRST_IPADDRESS(FipAddress);
2 : Result
:= SECOND_IPADDRESS(FipAddress) ;
3 : Result
:= THIRD_IPADDRESS(FipAddress);
4 : Result
:= FOURTH_IPADDRESS(FipAddress); else Result := 0;
end;
end;
procedure TCustomlPEdit.SetIP(Index:
Integer; Value: Byte);
begin
case Index
of
1: FIPAddress
:= FIPAddress AND $FFFFFF or DWORD(Value) shl 24;
2: FIPAddress
:= FIPAddress AND $FFOOFFFF or DWORD(Value) shl 16;
3: FIPAddress
:= FIPAddress AND $FFFFOOFF or DWORD(Value) shl 8;
4: FIPAddress
:= FIPAddress AND $FFFFFFOO or DWORD(Value);
else Exit;
end;
SendMessage(Handle,
IPM_SETADDRESS, 0, FIPAddress);
end;
function TCustomlPEdit.GetMinIP(Index:
Integer): Byte; begin if (Index<0) or (Index>3) then
Result := 0
else
Result := LoByte(FIPLimits[Index]);
end;
procedure TCustomlPEdit.SetMinIP(Index:
Integer; Value: Byte);
begin
if (Index<0)
or (Index>3)
then Exit;
FIPLimits[Index]
:= MAKEIPRANGE(HiByte(FIPLimits[Index]), Value);
SendMessage(Handle,
IPM_SETRANGE, Index, FIPLimits[Index]);
end;
function TCustomlPEdit.GetMaxIP(Index:
Integer): Byte; begin if (Index<0) or (Index>3)
then
Result := 0
else
Result := HiByte(FIPLimits[Index]);
end;
procedure TCustomlPEdit.SetMaxIP(Index:
Integer; Value: Byte);
begin
if (Index<0)
or (Index>3) then Exit;
FIPLimits[Index]
:= MAKEIPRANGE(Value, LoByte(FIPLimits[Index]));
SendMessage(Handle,
IPM_SETRANGE, Index, FIPLimits[Index]);
end;
procedure TCustomlPEdit.Clear,
begin
SendMessage(Handle,
IPM_CLEARADDRESS, 0, 0);
end;
function TCustomlPEdit.IsBlank:
boolean;
begin
Result:= SendMessage(Handle,
IPM_ISBLANK, 0, 0) = 0;
end;
procedure TCustomlPEdit.SetCurrentField(Index:
Integer);
begin
if (Index<0)
or (Index>3)
then Exit;
FCurrentField
:= Index;
SendMessage(Handle,
IPM_SETFOCUS, wParam(FCurrentField), 0) ;
end;
function TCustomlPEdit.IPDwordToString(dw:
DWORD): string;
begin
Result := Format('%d.%d.%d.%d',
[FIRST_IPADDRESS(dw),
SECOND_IPADDRESS(dw),
THIRD_IPADDRESS(dw),
FOURTH_IPADDRESS(dw)]);
end;
function TCustomlPEdit.IPStringToDword(s:
string): DWORD;
var i,j : Integer;
NewAddr, Part
: DWORD;
begin
NewAddr :=
0;
try
i := 0; repeat
j := PosC.
', s); if j<=l then if i<3 then
Abort else
Part := StrToInt(s)
else
Part := StrToInt(Copy(s,
I, j-1));
if Part>255
then Abort; Delete(s, 1, j);
NewAddr :=
(NewAddr shl 8) or Part;
Inc(i);
until i>3;
Result := NewAddr;
//Windows.MessageBox(0,
pChar(IntToHex(FIPAddress, 8)), '', MB_Ok);
except end;
end;
function TCustomlPEdit.GetlPString:
string;
begin
SendMessage(Handle,IPM_GETADDRESS,
0, longint(SFIPAddress));
Result := IpDwordToString(FIPAddress);
end;
procedure TCustomlPEdit.SetlPString(Value:
string);
begin
FIPAddress
:= IPStringToDword(Value);
SendMessage(Handle,
IPM_SETADDRESS, 0, FIPAddress);
end;
procedure Register;
begin
RegisterComponents('Samples',
[TIPEdit]);
end;
end.