Bileşen yazmak acaip zevkliselimr yazdı:çok teşekkürler husonet
çok teşekkürler mrmcop
verdiğiniz kodlar lazarusta mükemmel çalıştı..
şimdi bunları kullanarak lazarus için bir edit bileşeni oluşturmayı deniycem
bileşenin adi da EditHusoMrmcop olacak
Başlarsan bırakamazsın benden söylemesi 
Kod: Tümünü seç
unit SrEditFloat;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, windows,
Graphics, Dialogs, StdCtrls, messages;
type
TSrEditFloat = class(TEdit)
private
FColorPassive : TColor;
FColorActiveText : TColor;
FColorPassiveText : TColor;
FColorActive : TColor;
Fdecimal : integer;
Frm : string;
Fvaluefloat : real;
procedure gundecimal(const Value: integer);
procedure gunvaluefloat(const Value: real);
procedure ALColorPassive(const Value: TColor);
procedure ALColorPassiveText(const Value: TColor);
procedure rightjstifyedit(var xedit: TEdit);
protected
procedure DoEnter; Override;
procedure DoExit ; Override;
procedure KeyPress (var Key: Char); Override;
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 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;
Property ColorPassive : TColor read FColorPassive write ALColorPassive;
property ColorPassiveText : TColor read FColorPassiveText write ALColorPassiveText;
end;
procedure Register;
implementation
///**************************************************************************///
{ TSrEditFloat }
///**************************************************************************///
procedure Register;
begin
RegisterComponents('fsh', [TSrEditFloat]);
end;
///**************************************************************************///
constructor TSrEditFloat.Create(AOwner: TComponent);
begin
inherited Create (AOwner);
ParentCtl3D := False;
Ctl3D := False;
Height := 19;
ColorActive := ClInfoBk;
ColorPassive := ClInfoBk;
ColorActiveText := clblue;
ColorPassiveText := clblue;
Color := fColorPassive;
Font.Color := fColorPassiveText;
width := 120;
Text := '0,00';
decimal := 2;
Valuefloat := 0;
end;
///**************************************************************************///
procedure TSrEditFloat.DoEnter;
begin
inherited;
Color := ColorActive;
Font.Color := ColorActiveText;
end;
///**************************************************************************///
procedure TSrEditFloat.DoExit;
var
edt: string;
begin
inherited;
Color := ColorPassive;
Font.Color := ColorPassiveText;
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);
rightjstifyedit(self);
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);
text := formatfloat(frm,valuefloat);
end;
end;
///**************************************************************************///
procedure TSrEditFloat.gunvaluefloat(const Value: real);
begin
if fvaluefloat <> Value then
begin
Fvaluefloat := Value;
text := formatfloat(frm,valuefloat);
end;
end;
///**************************************************************************///
procedure TSrEditFloat.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:=''; //clear;
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 TSrEditFloat.ALColorPassive(const Value: TColor);
begin
if fcolorpassive<>value then
begin
FColorPassive := Value;
color:=fcolorpassive;
end;
end;
///**************************************************************************///
procedure TSrEditFloat.ALColorPassiveText(const Value: TColor);
begin
if fcolorpassivetext<>value then
begin
FColorPassiveText := Value;
font.Color:=fcolorpassivetext;
end;
end;
///**************************************************************************///
procedure TSrEditFloat.rightjstifyedit(var xedit: TEdit);
var
soldan, uzunluk : integer;
yazi : string;
xcanvas : TControlCanvas;
begin
yazi := xedit.Text;
while pos('.',yazi)<>0 do delete(yazi,pos('.',yazi),1);
yazi := formatfloat(frm,strtofloat(yazi));
xcanvas := Tcontrolcanvas.Create;
xcanvas.Control:=xedit;
xcanvas.Lock;
xcanvas.FillRect(xedit.ClientRect);
uzunluk:= xcanvas.TextWidth(yazi);
soldan := xedit.ClientRect.Right - uzunluk - 7;
xCanvas.TextRect(xEdit.ClientRect, Soldan, 1, Yazi);
xCanvas.UnLock;
xCanvas.Free;
end;
///**************************************************************************///
end.
Kod: Tümünü seç
procedure RightJustifyEdit(var xEdit : TEdit);
var
Soldan,
Uzunluk : Integer;
Yazi : String;
xCanvas : TControlCanvas;
begin
Yazi := xEdit.Text; // Yazıyı çektik
// TControlCanvas Create ediyor
// TEdit'i kontrolüne veriyoruz.
xCanvas := TControlCanvas.Create;
xCanvas.Control := xEdit;
// İşlerimizi yaparken başka thread vb.
// etkisine karşı kilitliyoruz.
xCanvas.Lock;
// TEdit'in görünür yüzeyini boşaltıyoruz...
// Veriye dokunmuyoruz :)
xCanvas.FillRect(xEdit.ClientRect);
Uzunluk := xCanvas.TextWidth(Yazi);
// Soldan başlangıç noktamızı belirliyoruz.
// İlerden başlatıp sağa yanaşıkmış hissi vermek için..
// İlüzyon burada :)
Soldan := xEdit.ClientRect.Right - Uzunluk - 1;
// Sonunda Yazımızı yazıyoruz.
xCanvas.TextRect(xEdit.ClientRect, Soldan, 0, Yazi);
xCanvas.UnLock; // Kilidi açtık.
xCanvas.Free; // Free ettik.
end;