// Der folgende Code realisiert ein Eingabefeld für IP-Adressen (IPv4).
// Es werden ein TPanel, 4 TLabel und 4 TEdit auf die Form gesetzt und
// die entsprechenden Events durch Doppelklick im Objektinspektor erzeugt.
// "Label4.caption" enthält immer die IP. Mittels der Variablen "dreistellig"
// wird geregelt, ob die vier einzelnen Elemente der IP jeweils auf drei
// Stellen aufgefüllt werden. Die Eingabefelder werden beim Verlassen
// immer auf drei Stellen ergänzt.



// Getestet mit D4 unter XP

uses 
  Windows, SysUtils, Classes, Controls, Forms, Graphics, Messages, 
  StdCtrls, ExtCtrls; 
 
type 
  TForm1 = class(TForm) 
    Edit1: TEdit; 
    Edit2: TEdit; 
    Edit3: TEdit; 
    Edit4: TEdit; 
    Panel1: TPanel; 
    Label1: TLabel; 
    Label2: TLabel; 
    Label3: TLabel; 
    Label4: TLabel; 
    procedure FormCreate(Sender: TObject); 
    procedure Edit1KeyPress(Sender: TObject; var Key: Char); 
    procedure Edit2KeyPress(Sender: TObject; var Key: Char); 
    procedure Edit3KeyPress(Sender: TObject; var Key: Char); 
    procedure Edit4KeyPress(Sender: TObject; var Key: Char); 
    procedure Edit1KeyDown(Sender: TObject; var Key: Word; 
      Shift: TShiftState); 
    procedure Edit2KeyDown(Sender: TObject; var Key: Word; 
      Shift: TShiftState); 
    procedure Edit3KeyDown(Sender: TObject; var Key: Word; 
      Shift: TShiftState); 
    procedure Edit4KeyDown(Sender: TObject; var Key: Word; 
      Shift: TShiftState); 
    procedure Edit1Change(Sender: TObject); 
    procedure Edit1Exit(Sender: TObject); 
  private 
    { Private-Deklarationen } 
  public 
    procedure komplett; 
    function formatieren(s: string): string; 
    procedure makeIP(s1, s2, s3, s4: string); 
    function umsetzen(key: char; this, prev, next: TEdit): char; 
    procedure positionieren(key: word; this, prev, next: TEdit); 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.DFM} 
 
var 
  dreistellig: boolean = false; 
 
procedure TForm1.FormCreate(Sender: TObject); 
var br, brp: integer; 
  procedure L_festlegen(lb: TLabel; lft: integer); 
  begin 
    lb.parentfont := false; 
    lb.color := clWindow; 
    lb.caption := '.'; 
    lb.top := Panel1.bevelwidth; 
    lb.left := lft; 
    lb.parent := Panel1; 
  end; 
  procedure E_festlegen(edt: TEdit; lft: integer); 
  begin 
    edt.parentfont := false; 
    edt.text := ''; 
    edt.borderstyle := bsNone; 
    edt.width := br; 
    edt.left := lft; 
    edt.top := Panel1.bevelwidth; 
    edt.height := Label1.height; 
    edt.Parent := Panel1; 
    edt.OnChange := Edit1Change; 
    edt.OnExit := Edit1Exit; 
  end; 
begin 
  Panel1.caption := ''; 
  Panel1.bevelwidth := 2; 
  Panel1.bevelouter := bvLowered; 
  br := canvas.textwidth('0') * 3; 
  brp := canvas.textwidth('.'); 
  L_festlegen(Label1, br + Panel1.bevelwidth); 
  L_festlegen(Label2, br * 2 + Panel1.bevelwidth + brp); 
  L_festlegen(Label3, br * 3 + Panel1.bevelwidth + brp * 2); 
  E_festlegen(Edit1, Panel1.bevelwidth); 
  E_festlegen(Edit2, Panel1.bevelwidth + brp + br); 
  E_festlegen(Edit3, Panel1.bevelwidth + (brp + br) * 2); 
  E_festlegen(Edit4, Panel1.bevelwidth + (brp + br) * 3); 
  Panel1.autosize := true; 
  Edit1Change(Sender); 
end; 
 
procedure TForm1.makeIP(s1, s2, s3, s4: string); 
begin 
  if dreistellig then 
    Label4.caption := s1 + '.' + s2 + '.' + 
      s3 + '.' + s4 else 
    Label4.caption := inttostr(strtoint(s1)) + '.' + 
      inttostr(strtoint(s2)) + '.' + inttostr(strtoint(s3)) + '.' + 
      inttostr(strtoint(s4)); 
end; 
 
procedure TForm1.komplett; 
begin 
  Edit1.text := formatieren(Edit1.text); 
  Edit2.text := formatieren(Edit2.text); 
  Edit3.text := formatieren(Edit3.text); 
  Edit4.text := formatieren(Edit4.text); 
  makeIP(Edit1.text, Edit2.text, Edit3.text, Edit4.text); 
end; 
 
function TForm1.formatieren(s: string): string; 
begin 
  result := Format('%.3d', [StrTointDef(s, 0)]); 
  if Result > '255' then result := '255'; 
end; 
 
function TForm1.umsetzen(key: char; this, prev, next: TEdit): char; 
begin 
  case key of 
    #3, #22, #24: result := key; 
    #8: begin 
        if (this.selstart > 0) or (this.sellength > 0) 
          then result := key 
        else begin 
          result := #0; 
          if this <> Edit1 then begin 
            prev.setfocus; 
            prev.sellength := 0; 
            prev.selstart := length(prev.text); 
          end; 
        end; 
      end; 
    #13: begin 
        result := #0; 
        komplett; 
        Edit4.setfocus; 
        Perform(WM_NEXTDLGCTL, 0, 0); 
      end; 
    '.': begin 
        result := #0; 
        next.setfocus 
      end; 
  else begin 
      result := #0; 
      if key in ['0'..'9'] then begin 
        if (this.sellength = 0) and (length(this.text) = 3) then begin 
          if this.selstart = 3 then this.selstart := 2; 
          this.sellength := 1; 
        end; 
        this.perform(EM_REPLACESEL, 1, integer(pchar(string(key)))); 
        if length(this.text) > 2 then next.setfocus; 
      end; 
    end; 
  end; 
end; 
 
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char); 
begin 
  key := umsetzen(key, Edit1, Edit4, Edit2); 
end; 
 
procedure TForm1.Edit2KeyPress(Sender: TObject; var Key: Char); 
begin 
  key := umsetzen(key, Edit2, Edit1, Edit3); 
end; 
 
procedure TForm1.Edit3KeyPress(Sender: TObject; var Key: Char); 
begin 
  key := umsetzen(key, Edit3, Edit2, Edit4); 
end; 
 
procedure TForm1.Edit4KeyPress(Sender: TObject; var Key: Char); 
begin 
  key := umsetzen(key, Edit4, Edit3, Edit1); 
end; 
 
procedure TForm1.positionieren(key: word; this, prev, next: TEdit); 
begin 
  if (this.selstart = 0) and (key = VK_Left) then begin 
    prev.setfocus; 
    prev.selstart := length(prev.text); 
  end else 
    if (this.selstart + this.sellength = length(this.text)) 
      and (key = VK_Right) then begin 
      next.setfocus; 
      next.selstart := 0; 
    end else 
      if key = VK_Home then begin 
        Edit1.setfocus; 
        Edit1.sellength := 0; 
        Edit1.selstart := 0; 
      end else 
        if key = VK_End then begin 
          Edit4.setfocus; 
          Edit4.sellength := 0; 
          Edit4.selstart := length(Edit4.text); 
        end; 
end; 
 
procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word; 
  Shift: TShiftState); 
begin 
  positionieren(key, Edit1, Edit4, Edit2); 
end; 
 
procedure TForm1.Edit2KeyDown(Sender: TObject; var Key: Word; 
  Shift: TShiftState); 
begin 
  positionieren(key, Edit2, Edit1, Edit3); 
end; 
 
procedure TForm1.Edit3KeyDown(Sender: TObject; var Key: Word; 
  Shift: TShiftState); 
begin 
  positionieren(key, Edit3, Edit2, Edit4); 
end; 
 
procedure TForm1.Edit4KeyDown(Sender: TObject; var Key: Word; 
  Shift: TShiftState); 
begin 
  positionieren(key, Edit4, Edit3, Edit1); 
end; 
 
procedure TForm1.Edit1Change(Sender: TObject); 
var 
  s1, s2, s3, s4: string; 
begin 
  s1 := formatieren(Edit1.text); 
  s2 := formatieren(Edit2.text); 
  s3 := formatieren(Edit3.text); 
  s4 := formatieren(Edit4.text); 
  makeIP(s1, s2, s3, s4); 
end; 
 
procedure TForm1.Edit1Exit(Sender: TObject); 
var 
  h: THandle; 
begin 
  h := GetFocus; 
  if (h <> Edit1.handle) and (h <> Edit2.handle) and (h <> Edit3.handle) 
    and (h <> Edit4.handle) then begin 
    if (Edit1.text <> '') or (Edit2.text <> '') or (Edit3.text <> '') or 
      (Edit4.text <> '') then komplett; 
  end else 
    if Tedit(Sender).text <> '' then 
      Tedit(Sender).text := formatieren(Tedit(Sender).text); 
end;



 

Zugriffe seit 6.9.2001 auf Delphi-Ecke