Kod: Tümünü seç
unit HusoEdit;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, StdCtrls;
type
TCurrSimgeSet = (None,TL, YTL, EURO, DOLAR);
THusoEdit = class(TCustomEdit)
private
{ Private declarations }
Falign: TAlignment;
FDecimals: integer;
FMaxLength: integer;
FormatString: String;
DecimalPos: integer;
FWantReturns: Boolean;
FAbout: String;
FCurr: TCurrSimgeSet;
Procedure CurrWrite(Value: TCurrSimgeSet);
procedure SetDecimals(Value: integer);
procedure SetMaxLength(Value: integer);
function StripCommas(AString: string): string;
function SimgeDelete(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;
protected
{ Protected declarations }
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: char); override;
procedure DoExit; override;
procedure DoEnter; 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;
function Value(Str: String): Double;
published
{ Published declarations }
property About: string read Get_About write FAbout stored False;
property CurrencySimge: TCurrSimgeSet read FCurr write CurrWrite
default None;
property MaxLength: integer read FMaxLength write SetMaxLength;
property Decimals: integer read FDecimals write SetDecimals;
property TextAsFloat: Extended read GetTextAsFloat write SetTextAsFloat;
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;
Const
YTLSimge:String =' YTL';
TLSimge:String =' TL';
DOLARSimge:String = ' $';
EUROSimge:String = ' €';
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: Huseyin 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 + ' Tester Name: Abdullah YILMAZ' + 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;
CurrencySimge := FCurr;
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;
if CurrencySimge = None Then
Begin
Text := Text;
End
Else
if CurrencySimge = TL Then
Begin
Text := Text + TLSimge;
End
Else
if CurrencySimge = YTL Then
Begin
Text := Text + YTLSimge;
End
Else
if CurrencySimge = DOLAR Then
Begin
Text := Text + DOLARSimge;
End
Else
if CurrencySimge = EURO Then
Begin
Text := Text + EUROSimge;
End;
end;
function THusoEdit.GetTextAsFloat: Extended;
var
Buffer:String;
begin
Buffer := Text;
Result := StrToFloat(StripCommas(Simgedelete(Buffer)));
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, vk_menu, vk_subtract, vk_add]) 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 FDecimals = 0 Then
Begin
if CursorPos > FDecimals then
Begin
if (CursorPos-FDecimals) 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 );
end;
end;
End
Else
if FDecimals <> 0 Then
Begin
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;
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;
'-' : begin
if length(Buffer) > 0 Then
if (Buffer[1] <> '-') then
Buffer := '-' + buffer;
End;
'+' : begin
if Buffer[1] = '-' Then
Delete( Buffer, 1, 1 );
End;
#8: {BACKSPACE} begin
if FDecimals = 0 Then
Begin
if CursorPos > FDecimals then
begin
if (CursorPos-FDecimals+1) mod 4 = 0 then
inc(CursorPos);
Delete( Buffer, Length(Buffer)-CursorPos, 1 );
End
Else
begin
Delete( Buffer, Length(Buffer)-CursorPos, 1 );
end
End
Else
if FDecimals <> 0 Then
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;
Buffer:String;
begin
Buffer := SimgeDelete(Str);
Str := Buffer;
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);
{$Hints Off}
Val( AString, StringValue, ErrorPos );
if ErrorPos > 0 then
Result := '0'
else
begin
Insert(DecimalSeparator, AString, Length(AString)-FDecimals+1 );
Result := AString;
end;
end;
procedure THusoEdit.CurrWrite(Value: TCurrSimgeSet);
begin
SetDecimals(FDecimals);
if Value = None then
Begin
FCurr := None;
Text := Text;
End
Else
if Value = TL then
Begin
FCurr := TL;
Text := Text + TLSimge;
End
Else
if Value = YTL then
Begin
FCurr := YTL;
Text := Text + YTLSimge;
End
Else
if Value = DOLAR then
Begin
FCurr := DOLAR;
Text := Text + DOLARSimge;
End
Else
if Value = EURO then
Begin
FCurr := EURO;
Text := Text + EUROSimge;
End;
end;
procedure THusoEdit.DoExit;
begin
inherited;
if FCurr = TL Then
Text := Text + TLSimge
Else
if FCurr = YTL Then
Text := Text + YTLSimge
Else
if FCurr = DOLAR Then
Text := Text + DOLARSimge
Else
if FCurr = EURO Then
Text := Text + EUROSimge;
end;
procedure THusoEdit.DoEnter;
var
Buffer:String;
begin
inherited;
Buffer := SimgeDelete(Text);
Text := Buffer;
SelectAll;
end;
function THusoEdit.SimgeDelete(AString: string): string;
var
buffer:String;
begin
Buffer := AString;
if CurrencySimge = TL Then
Delete(Buffer, Length(AString)-2, 3)
Else
if CurrencySimge = YTL Then
Delete(Buffer, Length(AString)-3, 4)
Else
if CurrencySimge = DOLAR Then
Delete(Buffer, Length(AString)-1, 2)
Else
if CurrencySimge = EURO Then
Delete(Buffer, Length(AString)-1, 2);
Result := Buffer;
end;
end.
Hayırlı Olsun....
