belki işinize yarar diye paylaşmak istedim..
valuefloat özelliğinde parasal değeri tutuyor.
decimal kısmından kuruş kısmını ayarlıyoruz.
formatlı girişi destekliyor.
giriş sırasında değişik renk kullanabiliyor ..
vsv vs.
lazarus / windows
Kod: Tümünü seç
///**************************************************************************///
///************ ************///
///************ SrEditCur ver : 2.00 selim reis ************///
///************ ************///
///************ lazarus components ************///
///************ ************///
///************ reis_selim@hotmail.com 10/11/2005 ************///
///************ ************///
///**************************************************************************///
unit SrEditCur;
{$mode objfpc}{$H+}
interface
///**************************************************************************///
uses
Classes, SysUtils, LResources, Forms, Controls, windows,
Graphics, Dialogs, StdCtrls, lmessages;
///**************************************************************************///
type
{ TSrEditCur }
TSrEditCur = class(TEdit)
///**************************************************************************///
private
FColorActive : TColor;
FColorActiveText : TColor;
TColorActive : Tcolor;
TColorActiveText : Tcolor;
Fdecimal : integer;
Frm : string;
Fvaluefloat : real;
aktif : integer;
procedure gundecimal(const Value: integer);
procedure gunvaluefloat(const Value: real);
///**************************************************************************///
protected
procedure DoEnter; Override;
procedure DoExit ; Override;
procedure KeyPress (var Key: Char); Override;
procedure WMPaint (var Message: TLMPaint); message LM_PAINT;
///**************************************************************************///
public
Constructor Create (AOwner : TComponent); Override;
///**************************************************************************///
published
property Autosize;
property BorderStyle;
property Ctl3D;
property Cursor;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property maxlength;
property Name;
property ParentColor;
property parentCtl3D;
property ParentFont;
property ParentShowhint;
property PopupMenu;
property ReadOnly;
property ShowHint;
property TabOrder;
property Text;
property Visible;
property OnChange;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property Decimal :Integer read Fdecimal write gundecimal;
property ValueFloat :Real read Fvaluefloat write gunvaluefloat;
property ColorActive :TColor read FColorActive write FColorActive;
property ColorActiveText:TColor read FColorActiveText write FColorActiveText;
end;
///**************************************************************************///
procedure Register;
implementation
///**************************************************************************///
{ TSrEditCur }
///**************************************************************************///
procedure Register;
begin
RegisterComponents('fsh', [TSrEditCur]);
end;
///**************************************************************************///
constructor TSrEditCur.Create(AOwner: TComponent);
begin
inherited Create (AOwner);
FColorActive := ClWhite;
FColorActiveText := ClRed;
ParentCtl3D := False;
Ctl3D := False;
Height := 19;
Color := ClInfoBk;
Font.Color := ClBlue;
width := 120;
Text := '0,00';
decimal := 2;
Valuefloat := 0;
aktif := 1;
end;
///**************************************************************************///
procedure TSrEditCur.DoEnter;
begin
inherited;
aktif := 0;
TColorActive := color;
TColorActiveText := font.Color;
color := fcoloractive;
font.color := fcoloractivetext;
end;
///**************************************************************************///
procedure TSrEditCur.DoExit;
var
edt: string;
begin
inherited;
color := TColorActive;
font.color := TColorActiveText;
if text='' then edt:='0' else edt:= text;
while pos('.',edt)<>0 do delete(edt,pos('.',edt),1);
text := formatfloat(frm,strtofloat(edt));
valuefloat := strtofloat(edt);
aktif := 1;
end;
///**************************************************************************///
procedure TSrEditCur.gundecimal(const Value: integer);
begin
if Fdecimal = Value then exit;
Fdecimal := Value;
if decimal = 0 then frm := ',0' else frm := ',0.'+ stringofchar('0',decimal);
text := formatfloat(frm,valuefloat);
end;
///**************************************************************************///
procedure TSrEditCur.gunvaluefloat(const Value: real);
begin
if fvaluefloat = Value then exit;
Fvaluefloat := Value;
text := formatfloat(frm,valuefloat);
end;
///**************************************************************************///
procedure TSrEditCur.KeyPress(var Key: Char);
var
tus: char;
edt: string;
yer,nk1,nk2,i : integer;
begin
inherited;
tus := key;
key := #0;
yer := selstart;
case tus of {case başla}
#13 :
begin
PostMessage(Handle,WM_KEYDOWN,39,0);
PostMessage(Handle,WM_KEYDOWN,09,0);
end;
',','.' : if decimal<>0 then selstart:=pos(',',text);
'0'..'9' :
begin
if sellength=length(text) then text:='';
nk1:=0;
for i:=1 to length(Text) do if copy(Text,i,1)='.' then nk1:=nk1+1;
edt:=copy(text,1,yer)+tus+copy(text,yer+1,length(text));
while pos('.',edt)<>0 do delete(edt,pos('.',edt),1);
text:=formatfloat(frm,strtofloat(edt));
nk2:=0;
for i:=1 to length(Text) do if copy(Text,i,1)='.' then nk2:=nk2+1;
if nk2>nk1 then yer:=yer+2 else yer:=yer+1;
selstart:=yer;
end;
#8 :
begin
nk1:=0;
if ((yer+1>pos(',',text)) and (decimal>0)) then
begin
if yer>pos(',',text) then
begin
text:=copy(text,1,yer-1)+'0'+copy(text,yer,length(text)-1);
postmessage(handle,WM_KEYDOWN,46,0);
end;
postmessage(handle,WM_KEYDOWN,37,0);
selstart:=yer;
exit;
end;
for i:=1 to length(Text) do if copy(Text,i,1)='.' then nk1:=nk1+1;
edt:=copy(text,1,yer-1)+copy(text,yer+1,length(text));
while pos('.',edt)<>0 do delete(edt,pos('.',edt),1);
if edt='' then edt:='0';
text:=formatfloat(frm,strtofloat(edt));
nk2:=0;
for i:=1 to length(Text) do if copy(Text,i,1)='.' then nk2:=nk2+1;
if nk1>nk2 then yer:=yer-2 else yer:=yer-1;
if text='' then valuefloat:=0;
selstart:=yer;
exit;
end;
end; {case bitti}
end;
///**************************************************************************///
procedure TSrEditCur.WMPaint(var Message: TLMPaint);
var
xl,xh : integer;
xs : string;
xc : TControlCanvas;
begin
inherited;
if aktif=0 then exit;
xs := Text;
while pos('.',xs)<>0 do delete(xs,pos('.',xs),1);
xs := formatfloat(frm,strtofloat(xs));
xc := Tcontrolcanvas.Create;
xc.Control:=self;
xc.Lock;
xc.Color:=color;
xc.Font.Color:=font.Color;
xc.FillRect(self.ClientRect);
xh := xc.TextWidth(xs);
xl := self.ClientRect.Right - xh - 7;
xc.TextRect(self.ClientRect, xl, 1, xs);
xc.UnLock;
xc.Free;
end;
///**************************************************************************///
end.