Ta na mão um exemplo de componente, veja DoEnter e DoExit é so isso q vc
precisa.
unit NumTextoEdit;
interface
uses
Windows, SysUtils, Classes, Controls, StdCtrls, Graphics;
type
TTipo = ( ttTexto, ttNumero );
type
TNumTextoEdit = class(TEdit)
private
bTipo : Boolean;
FTipo : TTipo;
FCasaDecimal : Integer;
ACasaDecimal : Integer;
procedure GetFTipo(const Value: TTipo);
function SetFTipo: TTipo;
function AjustaTexto(pTexto: String; pTamanho: Integer; pFont:
TFont): String;
procedure GetFCasaDecimal(const Value: Integer);
function SetFCasaDecimal: Integer;
protected
procedure DoEnter; override;
procedure DoExit; override;
procedure KeyPress(var Key: Char); override;
public
function AjustaValor(pValor : String) : String;
constructor Create(AOwner: TComponent); override;
published
property Tipo : TTipo read SetFTipo write
GetFTipo default ttTexto;
property CasaDecimal : Integer read SetFCasaDecimal write
GetFCasaDecimal default 0;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Eduardo', [TNumTextoEdit]);
end;
{ TNumTextoEdit }
function TNumTextoEdit.AjustaValor(pValor : String) : String;
var
i : Integer;
begin
Result := '';
for i := 1 to Length(pValor) do
begin
if pValor[i] in ['0'..'9', DecimalSeparator] then
Result := Result + pValor[i];
end;
end;
function TNumTextoEdit.AjustaTexto(pTexto : String; pTamanho : Integer;
pFont : TFont) : String;
var
vInt : Integer;
vCanvas : TCanvas;
vHwnd : HWND;
begin
vCanvas := TCanvas.Create;
vCanvas.Handle := GetDeviceContext(vHwnd);
vCanvas.Font := pFont;
vInt := round((pTamanho - vCanvas.TextWidth(pTexto) - 8) /
vCanvas.TextWidth(' '));
Result := StringOfChar(' ', vInt) + pTexto;
end;
constructor TNumTextoEdit.Create(AOwner: TComponent);
begin
inherited;
Color := clInfoBk;
bTipo := True;
ACasaDecimal := -1;
end;
procedure TNumTextoEdit.DoEnter;
begin
inherited;
if Tipo = ttNumero then
Self.Text := AjustaValor(Self.Text);
Self.Text := Trim(Self.Text);
Self.SelectAll;
Color := clWindow;
end;
procedure TNumTextoEdit.DoExit;
var
s : String;
i : Integer;
begin
inherited;
if Tipo = ttNumero then
begin
if Trim(Self.Text) <> '' then
begin
s := '';
for i := 1 to CasaDecimal do
s := s + '0';
if Trim(s) <> '' then
Self.Text := FormatFloat('#,##0.' + s,
StrToFloat(Trim(Self.Text)))
else
Self.Text := FormatFloat('#,##0', StrToFloat(Trim(Self.Text)));
end
else
Self.Text := '0';
Self.Text := AjustaTexto(Self.Text, Self.Width, Self.Font);
end;
Color := clInfoBk;
end;
procedure TNumTextoEdit.GetFCasaDecimal(const Value: Integer);
begin
FCasaDecimal := Value;
end;
procedure TNumTextoEdit.GetFTipo(const Value: TTipo);
begin
FTipo := Value;
end;
procedure TNumTextoEdit.KeyPress(var Key: Char);
begin
inherited;
if (Tipo = ttNumero) then
begin
if (Trim(Self.Text) <> '') and (CasaDecimal <= 0) and (Key =
DecimalSeparator) then
Key := #0;
if (not (Key in ['0'..'9', DecimalSeparator, #8, #9, #13])) then
Key := #0;
if (Key = DecimalSeparator) and (Pos(DecimalSeparator, Self.Text) >
0) then
Key := #0;
if (not (Key in [#8, #9, #13])) and ((FCasaDecimal > 0) and
(Self.SelStart >= (Pos(DecimalSeparator, Self.Text) + 2)) ) then
Key := #0;
end;
end;
function TNumTextoEdit.SetFCasaDecimal: Integer;
var
i : Integer;
s : String;
begin
if FCasaDecimal > 0 then
begin
s := '';
for i := 1 to FCasaDecimal do
s := s + '0';
Result := FCasaDecimal;
if ACasaDecimal <> FCasaDecimal then
Self.Text := FormatFloat('#,##0.' + s,
StrToFloat(AjustaValor(Self.Text)));
end
else
begin
if ACasaDecimal <> FCasaDecimal then
Self.Text := FormatFloat('#,##0',
StrToFloat(AjustaValor(Self.Text)));
Result := 0;
end;
ACasaDecimal := FCasaDecimal;
if (bTipo) then
Self.Text := AjustaTexto(Self.Text, Self.Width, Self.Font);
end;
function TNumTextoEdit.SetFTipo: TTipo;
begin
Result := FTipo;
if (FTipo = ttNumero) then
begin
if not (bTipo) then
Exit;
Self.Text := '0';
bTipo := False;
Self.Text := AjustaTexto(Self.Text, Self.Width, Self.Font);
end
else
begin
bTipo := True;
Self.Text := Self.Name;
end;
end;
end.
Eduardo
Cleiton escreveu:
>
> Oi Erivando...
>
> A procedure que você me passou deu certinho. Era bem isso mesmo que eu
> queria.
>
> Valeu
> ----- Original Message -----
> From: [EMAIL PROTECTED] <mailto:erivando%40inforamos.com>
> To: delphi-br@yahoogrupos.com.br <mailto:delphi-br%40yahoogrupos.com.br>
> Sent: Thursday, March 29, 2007 4:00 PM
> Subject: Re: [delphi-br] cor do edit quando em foco
>
> faz assim: coloca em seu codigo:
> ....
> procedure entraCor(Sender: TObject);
> procedure saiCor(Sender: TObject);
> ....
>
> procedure TFrmCarnePag.entraCor(Sender: TObject);
> begin
> if (Sender is TEdit) then
> (Sender as TEdit).Color := RGB(255,255,230)
> else
> if (Sender is TComboBox) then
> (Sender as TComboBox).Color := RGB(255,255,230)
> else
> if (Sender is TMemo) then
> (Sender as TMemo).Color := RGB(255,255,230)
> else
> if (Sender is TMaskEdit) then
> (Sender as TMaskEdit).Color := RGB(255,255,230)
> end;
>
> procedure TFrmCarnePag.saiCor(Sender: TObject);
> begin
> if (Sender is TEdit) then
> (Sender as TEdit).Color := RGB(255,255,255)
> else
> if (Sender is TComboBox) then
> (Sender as TComboBox).Color := RGB(255,255,255)
> else
> if (Sender is TMemo) then
> (Sender as TMemo).Color := RGB(255,255,255)
> else
> if (Sender is TMaskEdit) then
> (Sender as TMaskEdit).Color := RGB(255,255,255)
> end;
>
> depois na propriedade Events em OnEnter = entraCor e OnExit = SaiCor
>
> Obs: vc pode usar a cor que lhe agradar trocando o RGB(255,255,230)
>
> Espero ter lhe ajudado
>
> Erivando Sena
> msn: [EMAIL PROTECTED] <mailto:inforamos%40inforamos.com>
>
> INFORAMOS - Soluções em Sistemas
> www.inforamos.com
> ----- Original Message -----
> From: Cleiton
> To: Delhpi
> Sent: Thursday, March 29, 2007 2:38 PM
> Subject: [delphi-br] cor do edit quando em foco
>
> Pessoal...
>
> Como faço para deixar o campo Edit ou DBedit quando o mesmo estiver em
> foco?
> --
> Esta mensagem foi verificada pelo sistema de antivírus e
> acredita-se estar livre de perigo.
>
> [As partes desta mensagem que não continham texto foram removidas]
>
> [As partes desta mensagem que não continham texto foram removidas]
>
> ----------------------------------------------------------
>
> No virus found in this incoming message.
> Checked by AVG Free Edition.
> Version: 7.5.446 / Virus Database: 268.18.22/739 - Release Date:
> 29/3/2007 13:36
>
> --
> Esta mensagem foi verificada pelo sistema de antivírus e
> acredita-se estar livre de perigo.
>
> [As partes desta mensagem que não continham texto foram removidas]
>
>
_______________________________________________________
Yahoo! Mail - Sempre a melhor opção para você!
Experimente já e veja as novidades.
http://br.yahoo.com/mailbeta/tudonovo/
