Суббота
31.10.2026
12:52

Форма входа

 Приветствую Вас Гость | RSS
Borland Delphi 7
Главная Регистрация Вход
Главная » 2009 » Февраль » 22 » Листинг - исходный код компонента TCustomlPEdit
Листинг - исходный код компонента TCustomlPEdit
10:44
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. 

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

Категория: Статьи участников клуба | Просмотров: 3107 | Добавил: delphi | Рейтинг: 0.0/0 |
Всего комментариев: 1
1 steetrora  
0
кофеварка delonghi запчасти
кофеварка екатеринбург
купить кофеварка morphy richards 47011
кофеварка delonghi bar 14f отзывы
кофеварка эспрессо delonghi
кофеварка krups 880
кружка кофеварка

Имя *:
Email *:
Код *:
Меню сайта

Разделы новостей
Программные обеспечения [6]
Учебники и справочники Delphi [15]
Лабораторные работы [2]
Статьи участников клуба [36]
Советы и трюки [1]

Календарь новостей
«  Февраль 2009  »
Пн Вт Ср Чт Пт Сб Вс
      1
2345678
9101112131415
16171819202122
232425262728

Поиск

Друзья сайта

Мини-чат

Наш опрос
Оцените мой сайт
Результаты | Архив опросов
Всего ответов: 72
Copyright MyCorp © 2026