MyEdit Delphi

unit UnitMyNewEdit;

interface

uses
  SysUtils, Classes, Windows, Controls, MaskUtils, Forms, StdCtrls, ExtCtrls, Graphics,
  Dialogs, Messages;

type
  TMyNewEdit = class(TPanel)
  private
    { Private declarations }
    MyEdit : TEdit;
    Shape_Base: TShape;
    Shape_Lateral: TShape;
    Label_Texto: TLabel;
    FTextLabel: string;
    FTextLabelColor: TColor;
    FTextEdit : string;
    FMostraShapeLateral : boolean;
    FPassWord : boolean;
    FZeros : integer;
    FZeroEsquerda : boolean;
    FCurrency : boolean;
    FMask : string;
    Texto1, Texto2 : string;
    procedure SetTextMyEdit(const Value: string);
    procedure SetTextLabel(const Value: string);
    procedure SetTextLabelColor(const Value: TColor);
    procedure SetMostraShapeLateral(const Value: boolean);
    procedure SetFPassWord(const Value: boolean);
    procedure SetFMask(const Value: String);
    procedure SetFCurrency(const Value: boolean);
    procedure SetFZeroEsquerda(const Value: boolean);
    procedure SetFZeros(const Value: integer);
    function GetTextMyEdit : string;
    procedure KeyPressMyEdit (Sender: TObject; var Key: Char);
    procedure ChangeMyEdit (Sender: TObject);
    procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
    procedure CMExit(var Message: TCMExit); message CM_EXIT;
    function Mascara(edt: String; mask: string) : string;
    function PreencheZero(const aNumber, Length : integer) : string;
    function TiraPontos(texto : String) : string;
  protected
    procedure CreateWnd; override;
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
  published
    { Published declarations }
    property  TextEdit : string read GetTextMyEdit write SetTextMyEdit;
    property  TextLabel : string read FTextLabel write SetTextLabel;
    property  TextLabelColor : TColor read FTextLabelColor write SetTextLabelColor;
    property  LinhaVertical : boolean read FMostraShapeLateral write SetMostraShapeLateral;
    property  Password : boolean read FPassWord write SetFPassWord;
    property  TextMask : string read FMask write SetFMask;
    property  Currency : boolean read FCurrency write SetFCurrency;
    property  Zeros : integer read FZeros write SetFZeros;
    property  ZeroEsquerda : boolean read FZeroEsquerda write SetFZeroEsquerda;

  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('My Componentes', [TMyNewEdit]);
end;

{ TMyNewEdit }

constructor TMyNewEdit.Create(AOwner: Tcomponent);
begin
  inherited Create(AOwner);

  Label_Texto := TLabel.Create(Self);
  Label_Texto.Parent:= self;
  Label_Texto.Left:=0;
  Label_Texto.Top:=1;
  Label_Texto.Caption:='Texto Teste';
  Label_Texto.Font.Name:='Segoe UI';
  Label_Texto.Font.Color:=clBlue;

  MyEdit := TEdit.Create(Self);
  MyEdit.Parent:= self;
  MyEdit.Left:=2;
  MyEdit.Top:=15;
  MyEdit.Width:=176; //-4 da linha de base
  MyEdit.Height:=26;
  MyEdit.BorderStyle:=bsnone;
  MyEdit.ParentColor:=True;
  MyEdit.Font.Size:=12;
  MyEdit.Font.Name:='Segoe UI';
  MyEdit.Anchors:=[akleft, akright, aktop];
  MyEdit.OnChange:=ChangeMyEdit;
  MyEdit.OnKeyPress:=KeyPressMyEdit;

  Shape_Lateral := TShape.Create(Self);
  Shape_Lateral.Parent:= self;
  Shape_Lateral.Left:=0;
  Shape_Lateral.Top:=MyEdit.Top;
  Shape_Lateral.Width:=2;
  Shape_Lateral.Height:=MyEdit.Height+2;
  Shape_Lateral.Brush.Color:=clBlue;
  Shape_Lateral.Pen.Style:=psClear;

  Shape_Base := TShape.Create(Self);
  Shape_Base.Parent:= self;
  Shape_Base.Left:=1;
  Shape_Base.Top:=(Label_Texto.Height+MyEdit.Height)+2;
  Shape_Base.Width:=180;
  Shape_Base.Height:=2;
  Shape_Base.Brush.Color:=clBlue;
  Shape_Base.Pen.Style:= psclear;
  Shape_Base.Anchors:=[akleft, akright, aktop];

end;


procedure TMyNewEdit.CreateWnd;
begin
  inherited;
   self.Caption:='';
   self.BevelOuter:=bvNone;
   self.ParentColor:=True;
   self.Height:=(Label_Texto.Height+MyEdit.Height)+3;
end;


procedure TMyNewEdit.CMEnter(var Message: TCMEnter);
begin

end;

procedure TMyNewEdit.CMExit(var Message: TCMExit);
begin

    if FZeroEsquerda then
    begin

      if not (FTextEdit = '') then
      begin
        MyEdit.Text:=PreencheZero(strtoint(FTextEdit), 10) ;
      end;

    end;

end;


function TMyNewEdit.GetTextMyEdit : string;
begin
  Result := FTextEdit;
end;

procedure TMyNewEdit.ChangeMyEdit(Sender: TObject);
begin
  FTextLabel := inttostr(MyEdit.SelStart);
  Label_Texto.Caption:= FTextLabel;
end;

procedure TMyNewEdit.KeyPressMyEdit(Sender: TObject; var Key: Char);
var
posicao : integer;
begin


  if not (Length(MyEdit.Text)>0) then
  begin
    Texto1:='';
    Texto2:='';
    MyEdit.Text:='';
  end;


  if FCurrency then
  begin
    if not (Key in [#8, #13, '0'..'9', '-', DecimalSeparator]) then
    begin
    //ShowMessage('Invalid key: ' + Key);
    Key := #0;
    end
    else if ((Key = DecimalSeparator) or (Key = '-')) and
    (Pos(Key, (Sender as TEdit).Text) > 0)
    then begin
    //ShowMessage('Invalid Key: twice ' + Key);
    Key := #0;
    end
    else if (Key = '-') and
    ((Sender as TEdit).SelStart <> 0) then
    begin
    //ShowMessage('Only allowed at beginning of number: ' + Key);
    Key := #0;
    end;
  end;

if FMask <> ''  then
begin

  if (key = chr(VK_BACK)) then
  begin
    posicao := MyEdit.SelStart;
    texto2:=texto1;
    delete(Texto2, Posicao,1);
    texto1:=texto2;
  end;

  if (key = chr(VK_DELETE)) then
  begin
    posicao := MyEdit.SelStart;
    texto2:=texto1;
    delete(Texto2, Posicao,1);
    texto1:=texto2;
  end;

  if not ( (key = chr(VK_BACK))  or (key = chr(VK_DELETE)) ) then
  begin

    if   (MyEdit.SelLength < MyEdit.MaxLength) then
    begin

      posicao := MyEdit.SelStart;
      texto2:=texto1;
      insert(key, texto2, posicao);
      texto1:=texto2;

      MyEdit.Text := Mascara(texto1, FMask);

        if (posicao=MyEdit.SelLength) then
        begin
          MyEdit.SelStart :=  posicao+1;
        end
        else
        begin
          MyEdit.SelStart :=  MyEdit.SelLength;
        end;

    end
    else
    begin
      Key := #0;
      //fazer ir para proximo controle
    end;

  end;

end;

end;


function TMyNewEdit.Mascara(edt : string; mask: string): string;
var
ipos : integer;
begin

  if (FMask <> '')  then
  begin
    MyEdit.MaxLength:=Length(FMask);
  end;


  for ipos := 1 to Length(edt) do
  begin

    if (mask[ipos] = '9') and  not (edt[ipos] in ['0'..'9'])  and
     (Length(edt)=Length(mask)+1)  then
     delete(edt,ipos,1);

    if (mask[ipos] <> '9') and (edt[ipos] in ['0'..'9']) then
     insert(mask[ipos],edt, ipos);

  end;

  result := edt;

end;

function TMyNewEdit.PreencheZero(const aNumber, Length : integer) : string;
begin
 result := Format('%.*d', [Length, aNumber]) ;
end;

procedure TMyNewEdit.SetTextMyEdit(const Value: string);
begin
  FTextEdit:=Value;
end;


function TMyNewEdit.TiraPontos(texto: String): String;
const
  InvalidChars : set of char = ['-','.','/',',','(',')',' '];
var
  i : integer;
begin
  Result:='';
    for i:=1 to Length(Texto) do
      if not (Texto[i] in InvalidChars) then
      Result:=Result+Texto[i]
end;


procedure TMyNewEdit.SetFCurrency(const Value: boolean);
begin
  FCurrency := Value;
  if FCurrency then
  begin
    FMask :='';
    MyEdit.Alignment:=taRightJustify;
  end;
end;

procedure TMyNewEdit.SetFMask(const Value: String);
begin
  FMask := Value;
  if (FMask <> '')  then
  begin
    MyEdit.MaxLength:=Length(FMask);
  end;
end;

procedure TMyNewEdit.SetFPassWord(const Value: boolean);
begin
  FPassWord := Value;
  if FPassWord then
  begin
    MyEdit.PasswordChar:='*';
  end
  else
  begin
    MyEdit.PasswordChar:=#0;
 end;
end;

procedure TMyNewEdit.SetFZeroEsquerda(const Value: boolean);
begin
  FZeroEsquerda := Value;
end;

procedure TMyNewEdit.SetFZeros(const Value: integer);
begin
  FZeros := Value;
end;

procedure TMyNewEdit.SetMostraShapeLateral(const Value: boolean);
begin
  FMostraShapeLateral := Value;
  Shape_Lateral.Visible:=FMostraShapeLateral;
end;

procedure TMyNewEdit.SetTextLabel(const Value: string);
begin
  FTextLabel := Value;
  Label_Texto.Caption:= FTextLabel;
end;

procedure TMyNewEdit.SetTextLabelColor(const Value: TColor);
begin
  FTextLabelColor := Value;
  Label_Texto.Font.Color := FTextLabelColor;
end;

end.