ipaddresscontrol.pas

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

    CreationControl := Self;
    CreateWindowHandle(Params);
    if Handle = 0 then RaiseLastWin32Error;
  end;
  Text := '';
  if AutoSize then Adjust;
  SetIPAddress;
end;

procedure TCustomIPAddressControl.Enter;
begin
  if Assigned(FOnEnter) then FOnEnter(Self);
end;

procedure TCustomIPAddressControl.Leave;
begin
  if Assigned(FOnExit) then FOnExit(Self);
end;

function TCustomIPAddressControl.GetIsBlank: boolean;
begin
  Result:=True;
  if HandleAllocated then
    if SendMessage(Handle,IPM_ISBLANK,0,0)=0 then Result:=False;
end;

procedure TCustomIPAddressControl.RaiseRangeError(
   IPRange: TIPAddrRange;Value,Field:Integer);
begin
  if Assigned(FOnRangeError) then FOnRangeError(Self,IPRange,Value,Field)
  else
  begin
    case Field of
      1:FField0.Digit:=255;
      2:FField1.Digit:=255;
      3:FField2.Digit:=255;
      4:FField3.Digit:=255;
     end;
     raise ERangeError.CreateFmt(RangeError,[Value,IPRange.LowerLimit,IPRange.UpperLimit ]);
  end;
end;

procedure TCustomIPAddressControl.SetFirstIPAddress(const Value: Integer);
begin
  if (Value <> FField0.FDigit) or isBlank then
  begin
    if (Value < FField0.Range.LowerLimit) or (Value >FField0.Range.UpperLimit)then
    RaiseRangeError(FField0.Range,Value,1);
    FField0.FDigit := Value;
    SetIPAddress;
  end;
end;


procedure TCustomIPAddressControl.SetFourthIPAddress(const Value: Integer);
begin
  if (Value <> FField3.Digit) or isBlank then
  begin
    if (Value < FField3.Range.LowerLimit) or (Value >FField3.Range.UpperLimit)then
    RaiseRangeError(FField3.Range,Value,4);
    FField3.Digit := Value;
    SetIPAddress;
  end;
end;

procedure TCustomIPAddressControl.SetIPAddress;
begin
  if HandleAllocated then
  SendMessage(Handle,IPM_SETADDRESS,0,
  MakeIPAddress(FField0.Digit,FField1.Digit,FField2.Digit,FField3.Digit));
end;

procedure TCustomIPAddressControl.SetIsBlank(const Value: boolean);
begin
  if HandleAllocated then
  If (Value=True) then SendMessage(Handle,IPM_CLEARADDRESS,0,0);
end;

procedure TCustomIPAddressControl.SetSecondIPAddress(const Value: Integer);
begin
  if (Value <> FField1.Digit) or isBlank then
  begin
    if (Value < FField1.Range.LowerLimit) or (Value >FField1.Range.UpperLimit)then
    RaiseRangeError(FField1.Range,Value,2);
    FField1.Digit := Value;
    SetIPAddress;
  end;
end;

procedure TCustomIPAddressControl.SetThirdIPAddress(const Value: Integer);
begin
  if (Value <> FField2.Digit) or isBlank then
  begin
    if (Value < FField2.Range.LowerLimit) or (Value >FField2.Range.UpperLimit)then
    RaiseRangeError(FField2.Range,Value,3);
    FField2.Digit := Value;
    SetIPAddress;
  end;
end;

procedure TCustomIPAddressControl.SetAutoSize(const Value: Boolean);
begin
  if FAutoSize <> Value then
  begin
    FAutoSize := Value;
    UpdateHeight;
  end;
end;
procedure TCustomIPAddressControl.UpdateHeight;
begin
  if FAutoSize then
  begin
    ControlStyle := ControlStyle + [csFixedHeight];
    Adjust;
  end else
    ControlStyle := ControlStyle - [csFixedHeight];
end;

procedure TCustomIPAddressControl.WMCTLCOLOREDIT(
  var Message: TWMCTLCOLOREDIT);
var DC:HDC;
begin
  DC:=GetDC(Handle);
  Brush.Color:=ColorToRGB(Color);
  Brush.Style:=bsSolid;
  SetTextColor(DC,ColorToRGB(Font.Color));
  SetTextColor(Message.ChildDC,ColorToRGB(Font.Color));
  SetBkColor(DC,ColorToRGB(Brush.Color));
  SetBkColor(Message.ChildDC,ColorToRGB(Brush.Color));
  SetBkMode(Message.ChildDC,TRANSPARENT	);
  ReleaseDC(Handle,DC);
  Message.Result:=Brush.Handle;
end;

procedure TCustomIPAddressControl.WMParentNotify(
  var Message: TWMParentNotify);
begin
  DefaultHandler(Message);
end;

function TCustomIPAddressControl.GetIPAddr: String;
begin
  if isBlank then Result:=''
  else
  begin
    IF Modified then UpdateIPAddress;
    Result:=IntToStr(Field0)+'.'+IntToStr(Field1)+'.'+IntToStr(Field2)+'.'+IntToStr(Field3);
  end;
end;

procedure TCustomIPAddressControl.SetIPAddr(const Value: String);
var SubStr,NStr:String;
    L,L1,I,Count:Integer;
    S1:String;
begin
  try
    NStr:=Value+'.';
    i:=1;
    while NStr<>''do
    begin
      L:=Length(NStr);
      Count:=Pos('.',NStr);
      S1:=Copy(NStr,0,Count-1);
      L1:=Length(S1);
      SubStr:=Copy(NStr,L1+2,L-L1);
      NStr:=SubStr;
      case i of
        1:Field0:=StrToInt(S1);
        2:Field1:=StrToInt(S1);
        3:Field2:=StrToInt(S1);
        4:Field3:=StrToInt(S1);
      end;
      inc(i);
      if i=5 then break;
    end;
  except
    isBlank:=True
  end;
end;

function TCustomIPAddressControl.GetFirstIPAddress: Integer;
begin
  Result:=FField0.Digit;
end;

function TCustomIPAddressControl.GetSecondIPAddress: Integer;
begin
  Result:=FField1.Digit;
end;

function TCustomIPAddressControl.GetFourthIPAddress: Integer;
begin
  Result:=FField3.Digit;
end;

function TCustomIPAddressControl.GetThirdIPAddress: Integer;
begin
  Result:=FField2.Digit;
end;

function TCustomIPAddressControl.GetRanges0: TIPAddrRange;
begin
  Result:=FField0.Range;
end;

function TCustomIPAddressControl.GetRanges1: TIPAddrRange;
begin
  Result:=FField1.Range;
end;

function TCustomIPAddressControl.GetRanges2: TIPAddrRange;
begin
  Result:=FField2.Range;
end;

function TCustomIPAddressControl.GetRanges3: TIPAddrRange;
begin
  Result:=FField3.Range;
end;

procedure TCustomIPAddressControl.SetRanges0(const Value: TIPAddrRange);
begin
  if (Value <> FField0.Range)then
    FField0.Range:=Value;
end;

procedure TCustomIPAddressControl.SetRanges1(const Value: TIPAddrRange);
begin
  if (Value <> FField1.Range)then
    FField0.Range:=Value;
end;

procedure TCustomIPAddressControl.SetRanges2(const Value: TIPAddrRange);
begin
  if (Value <> FField2.Range)then
    FField0.Range:=Value;
end;

procedure TCustomIPAddressControl.SetRanges3(const Value: TIPAddrRange);
begin
  if (Value <> FField3.Range)then
    FField0.Range:=Value;
end;

function TCustomIPAddressControl.GetModified: Boolean;
var NewValues:DWORD;
begin
  NewValues:=0;
  if HandleAllocated then
  SendMessage(Handle,IPM_GETADDRESS,0,longint(@NewValues));
  IF ((FIRST_IPADDRESS(NewValues)=DWORD(FField0.Digit)) and
     (SECOND_IPADDRESS(NewValues)=DWORD(FField1.Digit)) and
        (THIRD_IPADDRESS(NewValues)= DWORD(FField2.Digit)) and
           (FOURTH_IPADDRESS(NewValues)= DWORD(FField3.Digit))) then Result:=False
  else
  Result:=True;
end;

procedure TCustomIPAddressControl.UpdateIPAddress;
var NewValues:DWord;
begin
  NewValues:=0;
  if HandleAllocated then
  SendMessage(Handle,IPM_GETADDRESS,0,longint(@NewValues));
  FField0.Digit:= FIRST_IPADDRESS(NewValues);
  FField1.Digit:= SECOND_IPADDRESS(NewValues);
  FField2.Digit:= THIRD_IPADDRESS(NewValues);
  FField3.Digit:= FOURTH_IPADDRESS(NewValues);
end;

procedure TCustomIPAddressControl.DefaultHandler(var Message);
begin
  if TMessage(Message).Msg = WM_SETFOCUS then
    if (Win32Platform = VER_PLATFORM_WIN32_WINDOWS) and
        not IsWindow(TWMSetFocus(Message).FocusedWnd) then
        TWMSetFocus(Message).FocusedWnd := 0;
   inherited;
end;


procedure TCustomIPAddressControl.WMGETDLGCODE(var Message: TWMGetDlgCode);
begin
  Message.Result:=DLGC_WANTARROWS;
end;


{ TIPAddrRange }

constructor TIPAddrRange.Create;
begin
  inherited Create;
  FLowerLimit:=0;
  FUpperLimit:=255;
end;

function TIPAddrRange.GetIPRange(Index: Integer): Byte;
begin
  Result:=255;
  case Index of
    1:Result:=FLowerLimit;
    2:Result:=FUpperLimit;
  end;
end;

procedure TIPAddrRange.SetIPRange(Index: Integer; Value: Byte);
begin
  case Index of
    1:FLowerLimit:=Value;
    2:FUpperLimit:=Value;
  end;
end;

{ TIPAddressField }

constructor TIPAddressField.Create(AOwner: TComponent; AAddrID: Integer);
begin
  inherited Create;
  FOwner:=AOwner;
  FRange:=TIPAddrRange.Create;
  Digit:=0;
  FAddrID:=AAddrID;
end;

destructor TIPAddressField.Destroy;
begin

  inherited Destroy;
end;

function TIPAddressField.GetDigit: Integer;
begin
  Result:=FDigit;
end;

procedure TIPAddressField.SetDigit(const Value: Integer);
begin
  FDigit:=Value;
end;

procedure TIPAddressField.SetRange(const Value: TIPAddrRange);
begin
  if FRange<> Value then
  begin
    FRange := Value;
    SendMessage(TIPAddressControl(FOwner).Handle,IPM_SETRANGE,FAddrID,MakeIPRange(FRange.LowerLimit,FRange.UpperLimit));
  end;
end;

procedure TIPAddressField.WMDestroy(var Message: TWMDestroy);
begin
  inherited;
end;

end.