Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Поле для ввода IP-адреса

unit uIPEdit;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls;

type
  TCustomIPEdit = 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 GetIPString: string;
    procedure SetIPString(Value: string);
    function IsBlank: boolean;
    procedure SetCurrentField(Index: 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 GetIPString write SetIPString;
    property CurrentField: Integer read FCurrentField write SetCurrentField;
    procedure Clear;

  end;

  TIPEdit = class(TCustomIPEdit)
  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 TCustomIPEdit.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 TCustomIPEdit.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 Ctl3D then
    begin
      Style := Style and not WS_BORDER;
      ExStyle := ExStyle or WS_EX_CLIENTEDGE;
    end;
  end;
end;

procedure TCustomIPEdit.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 TCustomIPEdit.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
  inherited;
  Message.Result := {Message.Result or} DLGC_WANTTAB;
end;


procedure TCustomIPEdit.CNNotify(var Message: TWMNotify);
begin
  with Message.NMHdr^ do begin
    case Code of
      IPN_FIELDCHANGED:
        begin
          FCurrentField := PNMIPAddress(Message.NMHdr)^.iField;
          {if Assigned(OnIpFieldChange) then
            with PNMIPAdress(Message.NMHdr)^ do begin
               OnIPFieldChange(Self, iField, iValue);}
        end;
    end;
  end;
end;

{procedure TCustomIPEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
 inherited KeyDown( Key, Shift );
 if Key = VK_TAB then
  if ssShift in Shift then
     CurrentField := (CurrentField - 1 + 4) mod 4
    else
     CurrentField := (CurrentField + 1) mod 4;
end;}

{procedure TCustomIPEdit.CMWantSpecialKey(var Msg: TCMWantSpecialKey);
begin
  inherited;
  //Msg.Result := Ord(Char(Msg.CharCode) = #9);
end;}

procedure TCustomIPEdit.CMDialogChar(var Message: TCMDialogChar);
begin
  with Message do
    if CharCode = VK_TAB 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 TCustomIPEdit.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)<>0 then
     CurrentField := (CurrentField - 1 + 4) mod 4
    else
     CurrentField := (CurrentField + 1) mod 4;
    Message.Result := 1;
   end
 else
  inherited;
end;}


function TCustomIPEdit.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 TCustomIPEdit.SetIP(Index: Integer; Value: Byte);
begin
  case Index of
    1: FIPAddress := FIPAddress and $FFFFFF or DWORD(Value) shl 24;
    2: FIPAddress := FIPAddress and $FF00FFFF or DWORD(Value) shl 16;
    3: FIPAddress := FIPAddress and $FFFF00FF or DWORD(Value) shl 8;
    4: FIPAddress := FIPAddress and $FFFFFF00 or DWORD(Value);
  else Exit;
  end;
  SendMessage(Handle, IPM_SETADDRESS, 0, FIPAddress);
end;

function TCustomIPEdit.GetMinIP(Index: Integer): Byte;
begin
  if (Index < 0) or (Index > 3) then
    Result := 0
  else
    Result := LoByte(FIPLimits[Index]);
end;

procedure TCustomIPEdit.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 TCustomIPEdit.GetMaxIP(Index: Integer): Byte;
begin
  if (Index < 0) or (Index > 3) then
    Result := 0
  else
    Result := HiByte(FIPLimits[Index]);
end;

procedure TCustomIPEdit.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 TCustomIPEdit.Clear;
begin
  SendMessage(Handle, IPM_CLEARADDRESS, 0, 0);
end;

function TCustomIPEdit.IsBlank: boolean;
begin
  Result := SendMessage(Handle, IPM_ISBLANK, 0, 0) = 0;
end;

procedure TCustomIPEdit.SetCurrentField(Index: Integer);
begin
  if (Index < 0) or (Index > 3) then Exit;
  FCurrentField := Index;
  SendMessage(Handle, IPM_SETFOCUS, wParam(FCurrentField), 0);
end;

function TCustomIPEdit.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 TCustomIPEdit.IPStringToDword(s: string): DWORD;
var i, j: Integer;
  NewAddr, Part: DWORD;
begin
  NewAddr := 0;
  try
    i := 0;
    repeat
      j := Pos('.', s);
      if j <= 1 then
        if i < 3 then
          Abort
        else
          Part := StrToInt(s)
      else
        Part := StrToInt(Copy(s, 1, 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 TCustomIPEdit.GetIPString: string;
begin
  SendMessage(Handle, IPM_GETADDRESS, 0, longint(@FIPAddress));
  Result := IpDwordToString(FIPAddress);
end;

procedure TCustomIPEdit.SetIPString(Value: string);
begin
  FIPAddress := IPStringToDword(Value);
  SendMessage(Handle, IPM_SETADDRESS, 0, FIPAddress);
end;

procedure Register;
begin
  RegisterComponents('Samples', [TIPEdit]);
end;

end.

Скачать весь проект

Проект Delphi World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.