Рис. 5.8. Мастер создания
новых компонентов Delphi 7
Мастер создания новых компонентов (рис. 5.8)
Рис. 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
|
Установить ограничения на значения в
заданном поле |
constructor TIPEditor.Create(AOwner: TComponent);После создания свое значение получает дескриптор окна Handle (это свойство унаследовано от TwinControl). Все чтение/запись свойств элемента происходит путем обмена сообщениями с использованием этого дескриптора. Минимально необходимыми для работы являются свойства IP (задает IP-адрес в редакторе), ipstring (отображает его в виде текстовой строки) и процедура clear (очищает редактор).
begin
inherited Create(AOwner);
ControlStyle := [csCaptureMouse, csClickEvents, csDoubleClicks, csOpaque];
Color := clBtnFace;
Width := 160;
Height := 25;
Align := alNone;
end;
procedure TIPEditor.CreateParams(var Params: TCreateParams);
begin
InitCommonControl(ICC_INTERNET_CLASSES);
inherited CreateParams(Params);
CreateSubClass(Params, WC_IPADDRESS);
end;
Листинг 5.2. Исходный
код компонента TCustomlPEdit
unit uIPEdit;Для удобства пользования полезно было бы добавить к компоненту CustomiPEdit задание диапазона для каждого из четырех составляющих и средства преобразования текстовой строки в двоичный адрес. Но это уже совсем другая история, к библиотеке ComQ132 отношения не имеющая.
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.
Назад | Начало | Вперед |