频道分类

Delphi IP编辑控件

作者:admin 来源: 日期:2019/12/1 22:50:11 人气: 标签:

 

最近需要用一个IP输入控件,网上找了几个,都不符合效果,有些还有一些奇怪的Bug。后来发现原来系统已经提供了IP地址编辑控件,只是系统提供的控件不能设置只读效果。网上找了下资料,封装了一下,自己迂回一下实现了只读效果。

unit ueIPEdit;

 

interface

 

uses

  System.SysUtils, System.Classes, Vcl.Controls, Winapi.Windows, Winapi.Messages,

  Vcl.ComCtrls, Winapi.CommCtrl;

 

type

  TFieldChangeEvent = procedure(Sender: TObject; OldField, OldValue: Byte) of object;

 

  TUeIPEdit = class(TWinControl)

  private

    FState: Integer; //Internal use

    FBakIP: Longint; //Internal use

    FMinIP: Longint;

    FMaxIP: Longint;

    FOnChange: TNotifyEvent;

    FOnFieldChange: TFieldChangeEvent;

    procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;

    procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;

  protected

    procedure CreateParams(var Params: TCreateParams); override;

    function  GetMinIP: String;

    function  GetMaxIP: String;

    procedure SetMinIP(const Value: String);

    procedure SetMaxIP(const Value: String);

    procedure UpdateRange;

    function  GetIP: String;

    procedure SetIP(const Value: String);

    function  GetEmpty: Boolean;

    function GetReadOnly: Boolean;

    procedure SetReadOnly(Value: Boolean);

    function IPToString(const AIp: Longint): String;

    function StringToIP(const Value: String): Longint;

  public

    constructor Create(AOwner: TComponent); override;

    procedure Clear;

    procedure SetActiveField(const Value: Integer);

    property Empty: Boolean read GetEmpty;

    property ReadOnly: Boolean read GetReadOnly write SetReadOnly;

    property IP: String read GetIP write SetIP;

    property MinIP: String read GetMinIP write SetMinIP;

    property MaxIP: String read GetMaxIP write SetMaxIP;

    property OnChange: TNotifyEvent read FOnChange write FOnChange;

    property OnIPFieldChange: TFieldChangeEvent read FOnFieldChange write FOnFieldChange;

 

    property Font;

    property ParentColor;

    property ParentFont;

    property ParentShowHint;

    property PopupMenu;

    property ShowHint;

    property TabOrder;

    property TabStop;

    property Tag;

    property DragCursor;

    property DragMode;

    property HelpContext;

  end;

 

implementation

 

uses Vcl.Graphics;

 

constructor TUeIPEdit.Create(AOwner: TComponent);

const

  EditStyle = [csClickEvents, csSetCaption, csDoubleClicks, csFixedHeight, csPannable];

begin

  inherited Create(AOwner);

  if NewStyleControls then

    ControlStyle := EditStyle else

    ControlStyle := EditStyle + [csFramed];

  ParentColor := False;

  Color := clWindow;

  Width:= 130;

  Height:= 20;

  TabStop:= True;

  FState := 0;

  FBakIP := -1;

  FMinIP:= 0;

  FMaxIP:= $0FFFFFFFF;

  FOnChange:= nil;

  FOnFieldChange:= nil;

end;

 

procedure TUeIPEdit.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 TUeIPEdit.CNNotify(var Message: TWMNotify);

begin

  if (FState=0) and Assigned(FOnFieldChange) and

    (Message.NMHdr^.code=IPN_FIELDCHANGED) then

    FOnFieldChange(Self, PNMIPAddress(Message.NMHdr)^.iField,

        PNMIPAddress(Message.NMHdr)^.iValue);

end;

 

procedure TUeIPEdit.CNCommand(var Message: TWMCommand);

begin

  if (Message.NotifyCode = EN_CHANGE) then

  begin

    case FState of

      0: if Assigned(FOnChange) then FOnChange(Self);

      1: begin

           FState := 2;

           PostMessage(Handle, IPM_SETADDRESS, 0, FBakIP);

         end;

      2: FState := 1;

    end;

  end;

end;

 

function TUeIPEdit.IPToString(const AIp: Longint): String;

begin

  Result:= Format('%d.%d.%d.%d',[FIRST_IPADDRESS(AIp),SECOND_IPADDRESS(AIp),

    THIRD_IPADDRESS(AIp),FOURTH_IPADDRESS(AIp)]);

end;

 

function TUeIPEdit.StringToIp(const Value: String): Longint;

var

  B: array[0..3] of Byte;

  Strs: TArray<string>;

  i, Cnt : Integer;

begin

  B[0]:= 0;

  B[1]:= 0;

  B[2]:= 0;

  B[3]:= 0;

  if Value<>'' then

  begin

    Strs := Value.Split(['.'],TStringSplitOptions.ExcludeEmpty);

    try

      Cnt := Length(Strs);

      if Cnt>4 then Cnt := 4;

      for i := 0 to Cnt-1 do

        B[i] := StrToInt(Strs[i]);

    finally

      Strs := nil;

    end;

  end;

  Result:= MakeIPAddress(b[0], b[1], b[2], b[3]);

end;

 

function TUeIPEdit.GetIP: String;

var

  AIp: Longint;

begin

  SendMessage(Handle, IPM_GETADDRESS, 0, Longint(@AIp));

  Result:= IPToString(AIp);

end;

 

procedure TUeIPEdit.SetIP(const Value: String);

begin

  SendMessage(Handle, IPM_SETADDRESS, 0, StringToIp(Value));

end;

 

function TUeIPEdit.GetMinIP: String;

begin

  Result:= IPToString(FMinIP);

end;

 

procedure TUeIPEdit.SetMinIP(const Value: String);

var

  AMin: LongInt;

begin

  AMin := StringToIp(Value);

  if FMinIP<>AMin then

  begin

    FMinIP := AMin;

    UpdateRange;

  end;

end;

 

procedure TUeIPEdit.UpdateRange;

begin

  SendMessage(Handle, IPM_SETRANGE, 0, MAKEIPRANGE(FIRST_IPADDRESS(FMinIP), FIRST_IPADDRESS(FMaxIP)));

  SendMessage(Handle, IPM_SETRANGE, 1, MAKEIPRANGE(SECOND_IPADDRESS(FMinIP), SECOND_IPADDRESS(FMaxIP)));

  SendMessage(Handle, IPM_SETRANGE, 2, MAKEIPRANGE(THIRD_IPADDRESS(FMinIP), THIRD_IPADDRESS(FMaxIP)));

  SendMessage(Handle, IPM_SETRANGE, 3, MAKEIPRANGE(FOURTH_IPADDRESS(FMinIP), FOURTH_IPADDRESS(FMaxIP)));

end;

 

procedure TUeIPEdit.SetMaxIP(const Value: String);

var

  AMax: LongInt;

begin

  AMax := StringToIp(Value);

  if FMaxIP<>AMax then

  begin

    FMaxIP := AMax;

    UpdateRange;

  end;

end;

 

function TUeIPEdit.GetMaxIP: String;

begin

  Result:= IPToString(FMaxIP);

end;

 

function TUeIPEdit.GetReadOnly: Boolean;

begin

  Result := FState<>0;

end;

 

procedure TUeIPEdit.SetReadOnly(Value: Boolean);

begin

  if Value <> GetReadOnly then

  begin

    if Value then

    begin

      SendMessage(Handle, IPM_GETADDRESS, 0, Longint(@FBakIP));

      FState := 1;

    end else begin

      FState := 0;

    end;

  end;

end;

 

function TUeIPEdit.GetEmpty: Boolean;

begin

  Result:= Boolean(SendMessage(Handle, IPM_ISBLANK, 0, 0));

end;

 

procedure TUeIPEdit.Clear;

begin

  SendMessage(Handle, IPM_CLEARADDRESS, 0, 0);

end;

 

procedure TUeIPEdit.SetActiveField(const Value: Integer);

begin

  if (Value < 4) then

  begin

    SendMessage(Handle, IPM_SETFOCUS, wParam(Value), 0);

  end;

end;

 

end.



上一篇:Delphi货币类型转中文大写金额下一篇:没有资料