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.
