istedim.. inşallah birilerinin işine yarar..
veya aksaklıklar varsa bildirirseniz sevinirim.
izelliklei:
---------------------
dicimal : virgülden sonraki hane sayısı
coloractive : kutu aktifken zemin rengi
coloractivetext: kutu aktifken karakter rengi
color passive : kutu pasifken renk
colorpassivetext: kutu pasifken karakter rengi
valuefloat : parasal değer ( real tipinde)
valuestring: sayısal değerin yazıya kuruş dahil çevrilmiş şekli
valstrEH : parasal değerin yazıya çevirip çevrilmeyeceğinin belirlenmesi
varsayılan değeri true dir.
Kod: Tümünü seç
unit SrEditFloat;
interface
uses
Windows, SysUtils, Classes, Controls, StdCtrls, graphics, Messages;
type
TKonum = (aLeft,aCenter,aRight);
TSrEditFloat = class(TCustomEdit)
private
Fkonum : TKonum;
FColorPassive : TColor;
FColorActiveText : TColor;
FColorPassiveText : TColor;
FColorActive : TColor;
Fdecimal : integer;
Frm : string;
Frg : string;
Fvaluefloat : real;
Fvaluestring : string;
FValStrEH : boolean;
procedure Konumsec(const Value: TKonum);
procedure gundecimal(const Value: integer);
procedure gunvaluefloat(const Value: real);
function rakyazf(tutar:real; tur:integer):string;
protected
procedure CreateParams(var params : TCreateParams); Override;
procedure DoEnter; Override;
procedure DoExit ; Override;
procedure KeyPress (var Key: Char); Override;
public
Constructor Create (AOwner : TComponent); Override;
property ValueString: string read Fvaluestring write fvaluestring;
published
property AutoSelect;
property Autosize;
property BevelEdges;
property BevelInner;
property BevelKind;
property BevelOuter;
property BorderStyle;
property Ctl3D;
property Cursor;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property HideSelection;
property ImeMode;
property ImeName;
property maxlength;
property Name;
property ParentColor;
property parentCtl3D;
property ParentFont;
property ParentShowhint;
property PopupMenu;
property ReadOnly;
property ShowHint;
property TabOrder;
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 Alignment : TKonum read FKonum write Konumsec;
property ColorActive : TColor read FColorActive write FColorActive;
property ColorActiveText : TColor read FColorActiveText write FColorACtiveText;
Property ColorPassive : TColor read FColorPassive write FColorPassive;
property ColorPassiveText : TColor read FColorPassiveText write FColorPassiveText;
property Decimal : integer read Fdecimal write gundecimal;
property ValueFloat : real read Fvaluefloat write gunvaluefloat;
property ValStrEH : boolean read FValStrEH write FValStrEH ;
end;
procedure Register;
implementation
///**************************************************************************///
{ TSrEditFloat }
///**************************************************************************///
constructor TSrEditFloat.Create(AOwner: TComponent);
begin
inherited Create (AOwner);
FKonum := aRight;
ParentCtl3D := False;
Ctl3D := False;
Height := 19;
ColorActive := ClInfoBk;
ColorPassive := ClInfoBk;
ColorActiveText := ClBlue;
ColorPassiveText := ClBlue;
Color := ColorPassive;
Font.Color := ColorPassiveText;
Text := '0,00';
decimal := 2;
Valuefloat := 0;
Autoselect := true;
FValStrEH := true;
end;
///**************************************************************************///
procedure TSrEditFloat.CreateParams(var params: TCreateParams);
begin
inherited;
Case FKonum of
aLeft : Params.Style := Params.Style or ES_LEFT;
aRight : Params.Style := Params.Style or ES_RIGHT;
aCenter : Params.Style := Params.Style or ES_CENTER;
end;
end;
///**************************************************************************///
procedure TSrEditFloat.DoEnter;
begin
inherited;
Color := ColorActive;
Font.Color := ColorActiveText;
if autoselect=true then selectall else selstart:=pos(',',text)-1;
end;
///**************************************************************************///
procedure TSrEditFloat.DoExit;
var edt: string;
begin
inherited;
Color := ColorPassive;
Font.Color := ColorPassiveText;
if text='' then
begin
valuefloat :=0;
text := formatfloat(frm,valuefloat);
end;
edt := text;
while pos('.',edt)<>0 do delete(edt,pos('.',edt),1);
text := formatfloat(frm,strtofloat(edt));
valuefloat := strtofloat(edt);
end;
///**************************************************************************///
procedure TSrEditFloat.gundecimal(const Value: integer);
begin
if Fdecimal <> Value then
begin
Fdecimal := Value;
if decimal=0 then frm:=',0' else frm:=',0.'+stringofchar('0',decimal);
if decimal=0 then frg:=',#' else frg:=',#.'+stringofchar('0',decimal);
text := formatfloat(frm,valuefloat);
end;
end;
///**************************************************************************///
procedure TSrEditFloat.gunvaluefloat(const Value: real);
begin
if fvaluefloat <> Value then
begin
Fvaluefloat := Value;
text := formatfloat(frm,valuefloat);
if FValStrEH = true then fvaluestring:= rakyazf(fvaluefloat,0);
end;
end;
///**************************************************************************///
procedure TSrEditFloat.KeyPress(var Key: Char);
var
yer: integer;
tus: string;
edt: string;
nk1: integer;
nk2: integer;
i : integer;
begin
inherited;
yer:=selstart;
if key=#8 then
begin
tus:=key;
key:=#0;
nk1:=0;
if yer+1>pos(',',text) then
begin
postmessage(handle,WM_KEYDOWN,37,0);
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);
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;
if key=#13 then
begin
if text='' then valuefloat:=0;
Key:=#0;
PostMessage(Handle,WM_KEYDOWN,09,0);
exit;
end;
if key=',' then
begin
key:=#0;
if decimal<>0 then selstart:=pos(',',text);
end;
if sellength=length(text) then clear;
if ((decimal=0) and (key=',')) or (not (key in ['0'..'9',#44,#8])) then
begin
key:=#0;
exit;
end;
tus:=key;
key:=#0;
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;
///**************************************************************************///
procedure TSrEditFloat.Konumsec(const Value: TKonum);
begin
if FKonum <> Value then
begin
FKonum := Value;
RecreateWnd;
end;
end;
///**************************************************************************///
procedure Register;
begin
RegisterComponents('fsh', [TSrEditFloat]);
end;
///**************************************************************************///
function TSrEditFloat.rakyazf(tutar: real; tur: integer): string;
const
b1:ARRAY [1..9] of string =
('BİR','İKİ','ÜÇ','DÖRT','BEŞ','ALTI','YEDİ','SEKİZ','DOKUZ');
b2:ARRAY [1..9] of string =
('ON','YİRMİ','OTUZ','KIRK','ELLİ','ALTMIŞ','YETMİŞ','SEKSEN','DOKSAN');
b3:ARRAY [1..6] of string =
('KATRİLYON','TRİLYON','MİLYAR','MİLYON','BİN','');
var
gr:ARRAY [1..6] of string[3];
sn:ARRAY [1..6] of string;
bs:ARRAY [1..3] of integer;
tutars, tutart, tutark , sonuct, sonuck: string;
i,l: integer;
begin
tutars:=floattostr(tutar);
if pos(',',tutars)=0 then tutars:=tutars+',00';
tutart:=copy(tutars,1,(pos(',',tutars)-1));
tutark:=copy(tutars,(pos(',',tutars)+1),2);
tutart:=stringofchar('0',(18-(length(trim(tutart))))) + tutart;
tutark:=tutark + stringofchar('0',( 2-(length(trim(tutark)))));
for i:=1 to 6 do gr[i]:=copy(tutart,1+(3*(i-1)),3);
for l:=1 to 6 do
begin
bs[1]:=strtoint(copy(gr[l],1,1));
if bs[1]<>0 then(if bs[1]<>1 then sn[l]:=sn[l]+b1[bs[1]]+'YÜZ' else sn[l]:=sn[l]+'YÜZ');
bs[2]:=strtoint(copy(gr[l],2,1));
if bs[2]<>0 then sn[l]:=sn[l]+b2[bs[2]];
bs[3]:=strtoint(copy(gr[l],3,1));
if bs[3]<>0 then sn[l]:=sn[l]+b1[bs[3]];
if length(trim(sn[l]))<>0 then sn[l]:=sn[l]+b3[l];
end;
if sn[5]='BİRBİN' then sn[5]:='BİN';
for i:=1 to 6 do sonuct:=sonuct+sn[i];
if strtoint(copy(tutark,1,1))<> 0 then sonuck:=sonuck + b2[strtoint(copy(tutark,1,1))];
if strtoint(copy(tutark,2,1))<> 0 then sonuck:=sonuck + b1[strtoint(copy(tutark,2,1))];
if tur=0 then result:=sonuct + '.TL / ' + sonuck + '.KR ';
if tur=1 then result:=sonuct + '.TL ';
if tur=2 then result:=sonuck + '.KR ';
end;
///**************************************************************************///
end.