ipaddresscontrol.pas

一个用于IP地址编辑的控件

{******************************************************************************}
{*        Copyright 2001 by J.Friebel all rights reserved.                    *}
{*        Autor           :  J鰎g Friebel                                     *}
{*        Compiler        :  Delphi 4 / 5                                     *}
{*        System          :  Windows NT / 2000 (9x not tested !)              *}
{*        Projekt         :  IP Address Control                               *}
{*        Last Update     :  11-06-2001                                       *}
{*        Version         :  2.00                                            *}
{*        EMail           :  [e-mail]                         *}
{******************************************************************************}
{*        Warning you need Comctl32.dll Version 4.71 or later                 *}
{******************************************************************************}
{*                                                                            *}
{*    This File is free software; You can redistribute it and/or modify it    *}
{*    under the term of GNU Library General Public License as published by    *}
{*    the Free Software Foundation. This File is distribute in the hope       *}
{*    it will be useful "as is", but WITHOUT ANY WARRANTY OF ANY KIND;        *}
{*    See the GNU Library Public Licence for more details.                    *}
{*                                                                            *}
{******************************************************************************}
{*                                                                            *}
{*    Diese Datei ist Freie-Software. Sie k鰊nen sie weitervertreiben         *}
{*    und/oder ver鋘dern im Sinne der Bestimmungen der "GNU Library GPL"      *}
{*    der Free Software Foundation. Diese Datei wird,"wie sie ist",           *}
{*    zur Verf黦ung gestellt, ohne irgendeine GEW腍RLEISTUNG.                 *}
{*                                                                            *}
{******************************************************************************}
{*                          www.delphiclub.de                                 *}
{******************************************************************************}

unit IPAddressControl;

{$R-,T-,H+,X+,Q-}

interface

{$IFDEF Ver125} {$DEFINE C++Build3} {$ENDIF}

uses
  Windows, Messages, SysUtils, CommCtrl, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls,stdctrls;

resourcestring RangeError =
                 '$%x 的值必需在$%x..$%x之间';


type
  TIPAddrRange = class(TPersistent)
  private
    FLowerLimit:byte;
    FUpperLimit:byte;
    function GetIPRange(Index:Integer): Byte;
    procedure SetIPRange(Index: Integer; Value: Byte);
  public
    constructor Create;
  published
    property LowerLimit:Byte index 1 read GetIPRange write SetIPRange default 0;
    property UpperLimit:Byte index 2 read GetIPRange write SetIPRange default 255;
  end;

type
  TIPAddressField = class(TPersistent)
  private
    FOwner:TComponent;
    FRange:TIPAddrRange;
    FDigit:Integer;
    FAddrID:Integer;
    procedure SetDigit(const Value: Integer);
    procedure SetRange(const Value: TIPAddrRange);
    procedure WMDestroy(var Message: TWMDestroy); message WM_DESTROY;
    function GetDigit: Integer;
  public
    constructor Create(AOwner:TComponent;AAddrID:Integer);
    destructor Destroy;override;
  published
    property Range:TIPAddrRange read FRange write SetRange;
    property Digit:Integer read GetDigit write SetDigit default 0;
  end;



type
 TRangeErrorEvent=procedure(Sender:TObject;var IPRange:TIPAddrRange;Value,Field:Integer)of Object;


type
  TCustomIPAddressControl = class(TWinControl)
  private
    FHandle: HWnd;
    FFirstChildID:Integer;
    FField0:TIPAddressField;
    FField1:TIPAddressField;
    FField2:TIPAddressField;
    FField3:TIPAddressField;
    FOnChange: TNotifyEvent;
    FOnEnter: TNotifyEvent;
    FOnExit: TNotifyEvent;
    FOnRangeError:TRangeErrorEvent;
    FAutoSize: Boolean;
    procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
    procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure WMCTLCOLOREDIT(var Message: TWMCTLCOLOREDIT);message WM_CTLCOLOREDIT;
    procedure WMSize(var Message: TMessage);message WM_Size;
    procedure WMParentNotify(var Message: TWMParentNotify); message WM_PARENTNOTIFY;
    procedure WMGETDLGCODE(var Message :TWMGetDlgCode);message WM_GETDLGCODE;
    procedure SetFirstIPAddress(const Value: Integer);
    procedure SetIPAddress;
    procedure SetFourthIPAddress(const Value: Integer);
    procedure SetSecondIPAddress(const Value: Integer);
    procedure SetThirdIPAddress(const Value: Integer);
    function GetIsBlank: boolean;
    procedure SetIsBlank(const Value: boolean);
    procedure Adjust;
    procedure SetAutoSize(const Value: Boolean);
    procedure UpdateHeight;
    function GetIPAddr: String;
    procedure SetIPAddr(const Value: String);
    function GetFirstIPAddress: Integer;
    function GetSecondIPAddress: Integer;
    function GetFourthIPAddress: Integer;
    function GetThirdIPAddress: Integer;
    function GetRanges0: TIPAddrRange;
    function GetRanges1: TIPAddrRange;
    function GetRanges2: TIPAddrRange;
    function GetRanges3: TIPAddrRange;
    procedure SetRanges0(const Value: TIPAddrRange);
    procedure SetRanges1(const Value: TIPAddrRange);
    procedure SetRanges2(const Value: TIPAddrRange);
    procedure SetRanges3(const Value: TIPAddrRange);
    function GetModified: Boolean;
    procedure UpdateIPAddress;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWindowHandle(const Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure Change;
    procedure Enter;
    procedure Leave;
    procedure RaiseRangeError(IPRange:TIPAddrRange;Value,Field:Integer);
    property AutoSize:Boolean read FAutoSize write SetAutoSize default False;
    property ParentColor default False;
    property ParentFont default False;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure DefaultHandler(var Message);override;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnEnter: TNotifyEvent read FOnEnter write FOnEnter;
    property OnExit: TNotifyEvent read FOnExit write FOnExit;
    property IsBlank:boolean read GetIsBlank write SetIsBlank default True;
    property OnRangeError:TRangeErrorEvent read FOnRangeError write FOnRangeError;
    property Color default clWindow;
    property Font;
    property IPAddress:String read GetIPAddr write SetIPAddr;
    property Modified:Boolean read GetModified ;
  published
    property Field0 :Integer read GetFirstIPAddress write SetFirstIPAddress default 0;
    property Field1 :Integer read GetSecondIPAddress write SetSecondIPAddress default 0;
    property Field2 :Integer read GetThirdIPAddress write SetThirdIPAddress default 0;
    property Field3 :Integer read GetFourthIPAddress write SetFourthIPAddress default 0;
    property RangeField0:TIPAddrRange read GetRanges0 write SetRanges0;
    property RangeFiled1:TIPAddrRange read GetRanges1 write SetRanges1;
    property RangeField2:TIPAddrRange read GetRanges2 write SetRanges2;
    property RangeFiled3:TIPAddrRange read GetRanges3 write SetRanges3;
    property TabStop default True;
    property TabOrder;
  end;

type
  TIPAddressControl = class(TCustomIPAddressControl)
  published
    property OnChange;
    property OnEnter;
    property OnExit;
    property OnRangeError;
    {$IFNDEF C++Build3}
    property OnResize;
    {$ENDIF}
    property ShowHint;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property AutoSize;
    {$IFNDEF C++Build3}
    property Anchors;
    {$ENDIF}
    property Visible;
    property Color;
    {$IFNDEF C++Build3}
    property BiDiMode;
    {$ENDIF}
    property Font;
    property IPAddress;
    property Modified;

  end;

procedure Register;

implementation

uses Consts;


procedure Register;
begin
  RegisterComponents('Internet', [TIPAddressControl]);
end;

{ TCustomIPAddressControl }

constructor TCustomIPAddressControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FFirstChildID:=0;
  ControlStyle :=ControlStyle+[csCaptureMouse, csClickEvents, csDoubleClicks, csOpaque];
  TabStop := True;
  Width := 121;
  Height := 25;
  FField0:=TIPAddressField.Create(self,0);
  FField1:=TIPAddressField.Create(self,1);
  FField2:=TIPAddressField.Create(self,2);
  FField3:=TIPAddressField.Create(self,3);
  FAutoSize:=False;
  ParentColor:=False;
  ParentFont:=False;
  Color:=clWindow;
  IsBlank:=true;
end;

destructor TCustomIPAddressControl.Destroy;
begin
  if HandleAllocated then DestroyWindowHandle;
  FField0.Free;
  FField1.Free;
  FField2.Free;
  FField3.Free;
  inherited Destroy;
end;

procedure TCustomIPAddressControl.Change;
begin
  inherited Changed;
  if Assigned(FOnChange) then FOnChange(Self);
end;

procedure TCustomIPAddressControl.CMFontChanged(var Message: TMessage);
begin
  Adjust;
  inherited;
  if HandleAllocated then Perform(WM_SIZE, 0, 0);
end;

procedure TCustomIPAddressControl.WMSize(var Message: TMessage);
begin
  if not (csLoading in ComponentState) then Resize;
  Repaint;
end;

procedure TCustomIPAddressControl.Adjust;
var
  DC: HDC;
  SaveFont: HFont;
  SysMetrics, Metrics: TTextMetric;
begin
  DC := GetDC(0);
  GetTextMetrics(DC, SysMetrics);
  SaveFont := SelectObject(DC, Font.Handle);
  GetTextMetrics(DC, Metrics);
  SelectObject(DC, SaveFont);
  ReleaseDC(0, DC);
  Height := Metrics.tmHeight + 8;
  Width :=(Metrics.tmMaxCharWidth+8)*8;
end;

procedure TCustomIPAddressControl.CNCommand(var Message: TWMCommand);
begin
  case Message.NotifyCode of
    EN_SETFOCUS :Enter;
    EN_KILLFOCUS:Leave;
    EN_CHANGE :Change;
    1:;
    else inherited;
  end;
end;

procedure TCustomIPAddressControl.CNNotify(var Message: TWMNotify);
var IP_a:TNMIPAddress ;
begin
  inherited;
  with Message do
  begin
    case NMHdr^.Code of
      IPN_FIELDCHANGED:
      begin
        IP_a:=PNMIPADDRESS(Message.NMHdr)^;
        with IP_a do
        case iField of
          0:FField0.Digit:=iValue;
          1:FField1.Digit:=iValue;
          2:FField2.Digit:=iValue;
          3:FField3.Digit:=iValue;
        end;
      end;
    end;
  end;
end;

procedure TCustomIPAddressControl.CreateParams(var Params: TCreateParams);
begin
  InitCommonControl(ICC_INTERNET_CLASSES);
  inherited CreateParams(Params);
  CreateSubClass(Params, WC_IPADDRESS);
  with Params  do
  begin
    Style :=WS_Child;
    ExStyle:=WS_EX_CONTROLPARENT;
    WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW );
  end;
end;

procedure TCustomIPAddressControl.CreateWindowHandle(
  const Params: TCreateParams);
begin
  with Params do
    FHandle := CreateWindowEx(ExStyle, WinClassName, Caption, Style,
      X, Y, Width, Height, WndParent, 0, WindowClass.hInstance, Param);
end;

procedure TCustomIPAddressControl.CreateWnd;
var
  Params: TCreateParams;
  TempClass: TWndClass;
  ClassRegistered: Boolean;
begin
  CreateParams(Params);
  with Params do
  begin
    if (WndParent = 0) and (Style and WS_CHILD <> 0) then
      if (Owner <> nil) and (csReading in Owner.ComponentState) and
        (Owner is TWinControl) then
        WndParent := TWinControl(Owner).Handle
      else
        raise EInvalidOperation.CreateFmt(SParentRequired, [Name]);
    DefWndProc := WindowClass.lpfnWndProc;
    ClassRegistered := GetClassInfo(WindowClass.hInstance, WinClassName, TempClass);
    if not ClassRegistered or (TempClass.lpfnWndProc <> @InitWndProc) then
    begin
      if ClassRegistered then Windows.UnregisterClass(WinClassName,
        WindowClass.hInstance);
      WindowClass.lpfnWndProc := @InitWndProc;
      WindowClass.lpszClassName := WinClassName;
      if Windows.RegisterClass(WindowClass) = 0 then RaiseLastWin32Error;
    end;