ripedit.pas

两套ip输入的构件

//---------------------------------------------------------------------------
//
// TRIPEdit v1.0 (beta)
//
// FREEWARE COMPONENT.
//---------------------------------------------------------------------------
// The given component is intended for editing IP address.
// It will not use a component from Microsoft, as it
// is bad to be translated under Delphi. TRIPEdit completely
// is built on a standard components of Delphi. While that it
// is in stage of testing and the errors are expected. About
// all adaptations the request to send the messages on my electronic address.
//
//---------------------------------------------------------------------------
//
//  Copyright 1999 Ray Adams
//
//                     IMPORTANT NOTE:
// This software is provided 'as-is', without any express or
// implied warranty. In no event will the author be held
// liable for any damages arising from the use of this
// software.
// Permission is granted to anyone to use this software for
// any purpose, including commercial applications, and to
// alter it and redistribute it freely, subject to the
// following restrictions:
// 1. The origin of this software must not be misrepresented,
//    you must not claim that you wrote the original software.
//    If you use this software in a product, an acknowledgment
//    in the product documentation would be appreciated but is
//    not required.
// 2. Altered source versions must be plainly marked as such,
//    and must not be misrepresented as being the original
//    software.
// 3. This notice may not be removed or altered from any
//    source distribution.


unit RIPEdit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, stdctrls, mask,Clipbrd,winsock;

type
  TRIPEdit = class;
  TIPMaskEdit=class (TCustomMaskEdit)
  private
      FCanvas:TControlCanvas;
      procedure WMPaste(var Message: TWMPaste);   message WM_PASTE;
      procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
      procedure WMKillFocus(var Message: TWMSetFocus); message WM_KILLFOCUS;
      function GetTextMargins: TPoint;
  protected
      procedure KeyPress(var Key: Char); override;
      function IsValidChar(Key: Char): Boolean;
  public
      ParentPanel:TRIPEdit;
    constructor Create(AOwner: TComponent); override;
  end;

  TRIPEdit = class(TCustomPanel)
  private
    { Private declarations }
    FIP1:integer;
    FIP2:integer;
    FIP3:integer;
    FIP4:integer;
    FIPAddress: Longword;
    FIPString: string;
    procedure SetFIP1(const Value: integer);
    procedure SetFIP2(const Value: integer);
    procedure SetFIP3(const Value: integer);
    procedure SetFIP4(const Value: integer);
    procedure SetIPAddress(const Value: Longword);
    function ReadIPAddress: Longword;
    procedure SetIPString(const Value: string);
    function ReadIPString: string;
    function GetIP1: integer;
    function GetIP2: integer;
    function GetIP3: integer;
    function GetIP4: integer;
  protected
    { Protected declarations }
    IpEdit:Array [1..4] of TIPMaskEdit;
    PointLabels:Array[1..3] of TLabel;
    procedure InternOnChange(Sender: TObject);
    procedure InternOnExit(Sender: TObject);
    function MakeIPAdress(b1, b2, b3, b4 : Byte): Longint;
    function AllowNext(Value:string):boolean;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure RecalcIP;
  published
    { Published declarations }
    property IP1Sec:integer read GetIP1 write SetFIP1;
    property IP2Sec:integer read GetIP2 write SetFIP2;
    property IP3Sec:integer read GetIP3 write SetFIP3;
    property IP4Sec:integer read GetIP4 write SetFIP4;
    property Anchors;
    property BevelInner;
    property BevelOuter;
    property BevelWidth;
    property BorderWidth;
    property BorderStyle;
    property ShowHint;
    property ParentShowHint;
    property TabOrder;
    property TabStop;
    property OnEnter;
    property OnExit;
    property IPAddress:Longword	read ReadIPAddress write SetIPAddress;
    property IPString:string read ReadIPString write SetIPString;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('界面', [TRIPEdit]);
end;

{ TRIPEdit }

function TRIPEdit.AllowNext(Value: string): boolean;
begin
result:=StrToInt(Value)<=255;
end;

constructor TRIPEdit.Create(AOwner: TComponent);
var i:word;
begin
inherited Create(AOwner);
BevelInner:=bvLowered;
BevelOuter:=bvLowered;
Color:=clWhite;
Width:=120;
Height:=20;
Caption:='';
Cursor:=crIBeam;
//Create IP editors
for i:=1 to 4 do
    begin
    IPEdit[i]:=TIPMaskEdit.Create(Self);
    IPEdit[i].Top:=3;
    IPEdit[i].Left:=(30*(i-1))+3;
    IPEdit[i].Width:=(Width div 4)-5;
    IPEdit[i].Height:=Height-4;
    IPEdit[i].MaxLength:=3;
    IPEdit[i].Text:='0';
    IPEdit[i].BorderStyle:=bsNone;
    IPEdit[i].Name:='inRIP'+IntToStr(i);
if not (csDesigning  in ComponentState) then IPEdit[i].OnChange:=InternOnChange;
    IPEdit[i].OnExit:=InternOnExit;
    IPEdit[i].Font.Name:='FixedSys';
//    IPEdit[i].Color:=clBlue;
    IPEdit[i].Parent:=self;
    end;
for i:=1 to 3 do
    begin
    PointLabels[i]:=TLabel.Create(Self);
    PointLabels[i].Caption:='.';
//    PointLabels[i].AutoSize:=false;
    PointLabels[i].Height:=2;
    PointLabels[i].Top:=Height-17;
    PointLabels[i].Left:=25+((i-1)*30);
    PointLabels[i].Font.Name:='FixedSys';
    PointLabels[i].Parent:=Self;
    end;
end;

destructor TRIPEdit.Destroy;
var I:word;
begin
     for i:=1 to 4 do
         begin
         IPEdit[i].Free;
         end;
     for i:=1 to 3 do
         begin
         PointLabels[i].Free;
         end;
inherited Destroy;
end;

function TRIPEdit.GetIP1: integer;
begin
result:=StrToInt(IPEdit[1].Text);
end;

function TRIPEdit.GetIP2: integer;
begin
result:=StrToInt(IPEdit[2].Text);
end;

function TRIPEdit.GetIP3: integer;
begin
result:=StrToInt(IPEdit[3].Text);
end;

function TRIPEdit.GetIP4: integer;
begin
result:=StrToInt(IPEdit[4].Text);
end;

procedure TRIPEdit.InternOnChange(Sender: TObject);
begin
with Sender as TIPMaskEdit do
if Length(Text)=3 then
   if Name[Length(Name)]<>'4' then
                              if AllowNext(Text) then IPEdit[strtoint(Name[Length(Name)])+1].SetFocus
                              else IPEdit[strtoint(Name[Length(Name)])].SelectAll
      else if AllowNext(Text) then IPEdit[1].SetFocus
           else IPEdit[4].SelectAll;

RecalcIP;
end;

procedure TRIPEdit.InternOnExit(Sender: TObject);
begin
with Sender as TIPMaskEdit do
     begin
     if not AllowNext(Text) then
        begin
        case Name[Length(Name)] of
        '1':IP1Sec:=255;
        '2':IP2Sec:=255;
        '3':IP3Sec:=255;
        '4':IP4Sec:=255;
        end;

        end;
     end;
end;

function TRIPEdit.MakeIPAdress(b1, b2, b3, b4: Byte): Longint;
begin
  Result:= Longint((Longint(b1) Shl 24)+(Longint(b2) Shl 16)+(Longint(b3) Shl 8)+(Longint(b4)));
end;

function TRIPEdit.ReadIPAddress: Longword;
begin
result:=makeIPAdress(StrToInt(IPEdit[1].Text),StrToInt(IPEdit[2].Text),StrToInt(IPEdit[3].Text),StrToInt(IPEdit[4].Text));
end;

function TRIPEdit.ReadIPString: string;
begin
result:=IPEdit[1].Text+'.'+IPEdit[2].Text+'.'+IPEdit[3].Text+'.'+IPEdit[4].Text;
end;

procedure TRIPEdit.RecalcIP;
var S:String;
begin
s:=IPEdit[1].Text+'.'+IPEdit[2].Text+'.'+IPEdit[3].Text+'.'+IPEdit[4].Text;
FIPAddress:=makeIPAdress(StrToInt(IPEdit[1].Text),StrToInt(IPEdit[2].Text),StrToInt(IPEdit[3].Text),StrToInt(IPEdit[4].Text));;
FIPString:=s;
end;

procedure TRIPEdit.SetFIP1(const Value: integer);
begin
  if Value>355 then FIP1:=255 else FIP1 := Value;
  IPEdit[1].text:=IntToStr(FIP1);
end;

procedure TRIPEdit.SetFIP2(const Value: integer);
begin
  if Value>355 then FIP2:=255 else FIP2 := Value;
  IPEdit[2].text:=IntToStr(FIP2);
end;

procedure TRIPEdit.SetFIP3(const Value: integer);
begin
  if Value>355 then FIP3:=255 else FIP3 := Value;
  IPEdit[3].text:=IntToStr(FIP3);
end;

procedure TRIPEdit.SetFIP4(const Value: integer);
begin
  if Value>355 then FIP4:=255 else FIP4 := Value;
  IPEdit[4].text:=IntToStr(FIP4);
end;

procedure TRIPEdit.SetIPAddress(const Value: Longword);
var temp:in_addr;
begin
  if FIPAddress <> Value then
  begin
    FIPAddress := Value;
    temp.S_addr:=FIPAddress;
    IPEDit[4].text:=inttostr(ord(temp.S_un_b.s_b1));
    IPEDit[3].text:=inttostr(ord(temp.S_un_b.s_b2));
    IPEDit[2].text:=inttostr(ord(temp.S_un_b.s_b3));
    IPEDit[1].text:=inttostr(ord(temp.S_un_b.s_b4));
  end;
end;

procedure TRIPEdit.SetIPString(const Value: string);
begin
  FIPString := Value;
  IPAddress:=inet_addr(PChar(Value));
end;

{ TIPMaskEdit }

constructor TIPMaskEdit.Create(AOwner: TComponent);
begin
Inherited Create(AOwner);
end;

function TIPMaskEdit.GetTextMargins: TPoint;
var
  DC: HDC;
  SaveFont: HFont;
  I: Integer;
  SysMetrics, Metrics: TTextMetric;
begin
  if NewStyleControls then
  begin
    if BorderStyle = bsNone then I := 0 else
      if Ctl3D then I := 1 else I := 2;
    Result.X := SendMessage(Handle, EM_GETMARGINS, 0, 0) and $0000FFFF + I;
    Result.Y := I;
  end else
  begin
    if BorderStyle = bsNone then I := 0 else
    begin
      DC := GetDC(0);
      GetTextMetrics(DC, SysMetrics);
      SaveFont := SelectObject(DC, Font.Handle);
      GetTextMetrics(DC, Metrics);
      SelectObject(DC, SaveFont);
      ReleaseDC(0, DC);
      I := SysMetrics.tmHeight;
      if I > Metrics.tmHeight then I := Metrics.tmHeight;
      I := I div 4;
    end;
    Result.X := I;
    Result.Y := I;
  end;
end;

function TIPMaskEdit.IsValidChar(Key: Char): Boolean;
begin
  Result := (Key in ['0'..'9']) or (Key = Char(VK_BACK)) or (Key = Char(VK_DELETE));
end;


procedure TIPMaskEdit.KeyPress(var Key: Char);
begin
  if not IsValidChar(Key) then
  begin
    Key := #0;
    MessageBeep(0)
  end;
  if Key <> #0 then
     begin
     inherited KeyPress(Key);
//     invalidate;
     end;
end;

procedure TIPMaskEdit.WMKillFocus(var Message: TWMSetFocus);
begin
inherited;
invalidate;
end;

procedure TIPMaskEdit.WMPaint(var Message: TWMPaint);
var
  Left: Integer;
  Margins: TPoint;
  R: TRect;
  DC: HDC;
  PS: TPaintStruct;
  S: string;
begin
  if FCanvas = nil then
  begin
    FCanvas := TControlCanvas.Create;
    FCanvas.Control := Self;
  end;
  DC := Message.DC;
  if DC = 0 then DC := BeginPaint(Handle, PS);
  FCanvas.Handle := DC;
  try
    FCanvas.Font := Font;
    with FCanvas do
    begin
      R := ClientRect;
      if not (NewStyleControls and Ctl3D) and (BorderStyle = bsSingle) then
      begin
        Brush.Color := clWindowFrame;
        FrameRect(R);
        InflateRect(R, -1, -1);
      end;
      Brush.Color := Color;
      if not Enabled then
        Font.Color := clGrayText;
        S := Text;
        Margins := GetTextMargins;
        Left := (ClientWidth - TextWidth(S)) div 2;
      if SysLocale.MiddleEast then UpdateTextFlags;
      TextRect(R, Left, Margins.Y, S);
    end;
  finally
    FCanvas.Handle := 0;
    if Message.DC = 0 then EndPaint(Handle, PS);
  end;
end;

procedure TIPMaskEdit.WMPaste(var Message: TWMPaste);
var S:String;
begin
SetLength(S,4);
if Clipboard.HasFormat(CF_TEXT) then
   begin
   Clipboard.GetTextBuf(Pchar(S),4);
   try
     StrToInt(s);
   except
     exit;
   end;
     If (StrToInt(S)<=255) and (StrToInt(S)>=0) then inherited;
   end;
end;

end.