HusoEdit bileşeni Parasal basamaklama yapmak için tasarlanmıştır.
Kod: Tümünü seç
unit HusoEdit;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, StdCtrls;
type
THusoEdit = class(TCustomEdit)
private
{ Private declarations }
Falign: TAlignment;
FDecimals: integer;
FMaxLength: integer;
FormatString: string;
DecimalPos: integer;
FWantReturns: Boolean;
FAbout: string;
FAboutD: String;
procedure SetDecimals(Value: integer);
procedure SetMaxLength(Value: integer);
function StripCommas(AString: string): string;
procedure Reformat;
procedure CMEnter(var Message: TCMGotFocus); message CM_ENTER;
function GetTextAsFloat: Extended;
procedure SetTextAsFloat( Value: Extended );
function Get_About: string;
function Get_AboutStr: string; virtual;
protected
{ Protected declarations }
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: char); override;
property WantReturns: Boolean read FWantReturns write FWantReturns default True;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
procedure CreateParams(var Params: TCreateParams); override;
procedure createwnd;override;
published
{ Published declarations }
property About: string read Get_About write FAbout stored False;
property MaxLength: integer read FMaxLength write SetMaxLength;
property Decimals: integer read FDecimals write SetDecimals;
property TextAsFloat: Extended read GetTextAsFloat write SetTextAsFloat;
function Value(Str: String): Double;
property BorderStyle;
property Color;
property Ctl3D;
property DragCursor;
property DragMode;
property Enabled;
property Font;
property HideSelection;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ReadOnly;
property ShowHint;
property TabOrder;
property TabStop;
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;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Huso Component Set', [THusoEdit]);
end;
Function THusoEdit.Get_AboutStr:String;
var msg: string;
const
cr = chr(13);
begin
msg := ' --==[ HusoEdit 2.1 ]==--' + cr + cr;
msg := msg + ' HUSOEDIT : ' + ' a 16/32-Bit Component for Delphi' + cr;
{$IFDEF WIN32}
msg := msg + ' (This is the 32 bit version)' + cr;
{$ELSE}
msg := msg + ' (This is the 16 bit version)' + cr;
{$ENDIF}
{$IFDEF VER80} msg := msg + '(This is runing on Borland Delphi 1.0 or higher)';{$ENDIF}
{$IFDEF VER90} msg := msg + '(This is runing on Borland Delphi 2.0 or higher)';{$ENDIF}
{$IFDEF VER93} msg := msg + '(This is runing on Borland C++Builder 1.0)'; {$ENDIF}
{$IFDEF VER100}msg := msg + '(This is runing on Borland Delphi 3.0 or higher)';{$ENDIF}
{$IFDEF VER110}msg := msg + '(This is runing on Borland C++Builder 3.0)'; {$ENDIF}
{$IFDEF VER120}msg := msg + '(This is runing on Borland Delphi 4.0 or higher)';{$ENDIF}
{$IFDEF VER125}msg := msg + '(This is runing on Borland C++Builder 4.0)'; {$ENDIF}
{$IFDEF VER130}msg := msg + '(This is runing on Borland Delphi 5.0 or higher)';{$ENDIF}
{$IFDEF VER140}msg := msg + '(This is runing on Borland Delphi 6.0 or higher)';{$ENDIF}
{$IFDEF VER150}msg := msg + '(This is runing on Borland Delphi 7.0 or higher)';{$ENDIF}
msg := msg + cr + cr;
msg := msg + 'Copyright © 2003/2005 - All Rights Reserved' + cr;
msg := msg + 'www.husonet.com' + cr;
msg := msg + '-------------------------------------------------------------------------' + cr;
msg := msg + ' Author :' + cr;
msg := msg + ' Nick: husonet' + cr;
msg := msg + ' Author Name: Hüseyin OZDEMIR' + cr;
msg := msg + ' URL: www.HUSONET.com' + cr;
msg := msg + ' Mail: huseyin@husonet.com' + cr;
msg := msg + '-------------------------------------------------------------------------' + cr+ cr;
msg := msg + ' Tester :' + cr;
msg := msg + ' Nick: Aslangeri' + cr;
msg := msg + '-------------------------------------------------------------------------' + cr+ cr;
msg := msg + ' This Component is from www.DelphiTurkiye.com' + cr;
msg := msg + ' and This Component FreeWare' + cr;
Result := Msg;
end;
function THusoEdit.Get_About: string;
begin
Result := Get_AboutStr;
end;
procedure THusoEdit.CMEnter(var Message: TCMGotFocus);
Begin
SelStart := Length(Text) - FDecimals - 1;
inherited;
end;
constructor THusoEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
WantReturns := False;
Height := 24;
Width := 120;
FAlign:=taRightJustify;
DecimalPos := 0;
FMaxLength := 20;
Decimals := 0;
end;
procedure THusoEdit.CreateParams(var Params: TCreateParams);
const Alignments: array[TAlignment] of Word = (ES_LEFT, ES_RIGHT, ES_CENTER);
begin
inherited;
Params.Style:=Params.Style or ES_WANTRETURN or ES_LEFT or Alignments[FAlign];
end;
procedure THusoEdit.createwnd;
begin
inherited;
selStart := 1;
end;
function THusoEdit.GetTextAsFloat: Extended;
begin
Result := StrToFloat(StripCommas(Text));
end;
procedure THusoEdit.KeyDown(var Key: Word; Shift: TShiftState);
var
CursorPos: integer;
Buffer: string;
begin
if SelLength = length(Text) Then
if not (key in [vk_left, vk_right, vk_up, vk_down, vk_home, vk_end]) then
begin
text:='';
while length(text)<FDecimals do
text:=text+'0';
if text<>'' then text:='0,'+text;
SelStart := 1;
End;
if Key = VK_DELETE then
begin
Buffer := Text;
CursorPos := Length(Buffer)-SelStart-SelLength;
if CursorPos > FDecimals+1 then
begin
if (CursorPos-FDecimals-1) mod 4 = 0 then Dec(CursorPos);
Delete( Buffer, Length(Buffer)-CursorPos+1, 1 );
Dec(CursorPos);
end
else
begin
if CursorPos = FDecimals+1 then Dec(CursorPos);
if CursorPos > 0 then
begin
Delete( Buffer, Length(Buffer)-CursorPos+1, 1 );
Insert( '0', Buffer, Length(Buffer)-CursorPos+2 );
Dec(CursorPos);
end;
end;
Key := 0;
Text := Buffer;
Reformat;
SelStart := Length(Text)-CursorPos;
end;
end;
procedure THusoEdit.KeyPress(var Key: char);
var
Buffer: string;
CursorPos: integer;
begin
Buffer := Text;
CursorPos := Length(Buffer)-SelStart-SelLength;
case Key of
'0'..'9': begin
if FDecimals = 0 Then
Begin
if Length(Buffer) < FMaxLength then
Insert( Key, Buffer, Length(Buffer)-CursorPos+1 );
End
Else if CursorPos >= FDecimals+1 then
begin
if Length(Buffer) < FMaxLength then
Insert( Key, Buffer, Length(Buffer)-CursorPos+1 );
end
else if CursorPos >= 1 then
begin
Delete( Buffer, Length(Buffer)-CursorPos+1, 1 );
Insert( Key, Buffer, Length(Buffer)-CursorPos+2 );
if 1-CursorPos <= 0 then
Dec(CursorPos);
end;
end;
#8: {BACKSPACE} begin
if CursorPos > FDecimals then
begin
if (CursorPos-FDecimals) mod 4 = 0 then
Inc(CursorPos);
Delete( Buffer, Length(Buffer)-CursorPos, 1 );
end
else
begin
if CursorPos = FDecimals then
Inc(CursorPos);
Delete( Buffer, Length(Buffer)-CursorPos, 1 );
if CursorPos <= FDecimals then
begin
Insert( '0', Buffer, Length(Buffer)-CursorPos+1 );
Inc(CursorPos);
end;
end;
end;
'.',',': CursorPos := FDecimals;
end;
Key := #0;
Text := Buffer;
Reformat;
SelStart := Length(Text)-CursorPos;
end;
function THusoEdit.Value(Str: String): Double;
var
i:integer;
begin
for i:=1 to length(Str) do
Begin
if Str[i]= ThousandSeparator then
delete(Str,i,1);
End;
result:= StrToFloat(Str);
end;
procedure THusoEdit.Reformat;
begin
Text := FormatFloat(FormatString, StrToFloat(StripCommas(Text)));
end;
procedure THusoEdit.SetDecimals(Value: integer);
var
i: integer;
begin
if Value = 0 Then
Begin
FDecimals := Value;
FormatString := '#,##0';
End
Else
if ( Value > 0 ) and ( Value < FMaxLength-1 ) then
Begin
FDecimals := Value;
FormatString := '#,##0.';
End;
for i := 1 to FDecimals do FormatString := FormatString + '0';
MaxLength := MaxLength;
Reformat;
end;
procedure THusoEdit.SetMaxLength(Value: integer);
begin
if ( Value < 22 ) and ( Value > FDecimals+1 ) then
FMaxLength := Value;
if (FMaxLength-FDecimals-1) mod 4 = 0 then
Dec(FMaxLength);
end;
procedure THusoEdit.SetTextAsFloat(Value: Extended);
begin
Text := FormatFloat(FormatString, Value);
end;
function THusoEdit.StripCommas(AString: string): string;
var
StringValue: Extended;
ErrorPos: integer;
begin
while (Pos(ThousandSeparator, AString) > 0 ) do
delete(AString, Pos(ThousandSeparator, AString), 1);
while (Pos(DecimalSeparator, AString) > 0 ) do
delete(AString, Pos(DecimalSeparator, AString), 1);
Val( AString, StringValue, ErrorPos );
if ErrorPos > 0 then
Result := '0'
else
begin
Insert(DecimalSeparator, AString, Length(AString)-FDecimals+1 );
Result := AString;
end;
end;
end.
2.Edit bileşenin diğer özellikleri bölüm bölüm yapmak daha kolay oluyor (Halledildi)
3.Decimals olayı (Halledildi) Artık kuruşlu göstermedende kullanabilirsiniz.
Kolay Gelsin...
Son güncelleme 26/09/2004
:D bulana ödül verecem 
