Arkadaşlar HUSOEDIT 3.0 ı sadece Forum üyelerine ücretsiz olarak kaynak kodlu sunuyorum. Hayırlı Olsun.
Bu versiyon ile Bir çok özellik bir arada gelmiştir. Hem Text veri Hem de parasal veri girişi yapabileceksiniz.
Bileşen GENEL özelliklerine
http://www.husonet.com/husoedit.asp adres'ten ulaşabilirsiniz.
Bileşenin Kaynak Kodunu http://www.husonet.com/dfiles/HusoEditFullVersion.zip adresinden indirebilirsiniz.
Kullanan arkadaşlar bug bildirisini bu Başlık altında yaparsanız sevinirim.
Kod: Tümünü seç
unit HusoEdit;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, StdCtrls, Forms, Graphics, Dialogs;
type
TCurrSymbolSet = (None,TL, YTL, EURO, DOLAR);
THusoEditTypeSet = (TextType, CurrencyType);
THusoEdit = class(TCustomEdit)
private
{ Private declarations }
Falign: TAlignment;
FDecimals: integer;
FMaxLength: integer;
FormatString: String;
DecimalPos: integer;
FWantReturns: Boolean;
FAbout: String;
FCurr: TCurrSymbolSet;
FEditType: THusoEditTypeSet;
FPassingControl: Boolean;
FRealFontColor:TColor;
FRealSoilColor:TColor;
FAColor:TColor;
FBColor:TColor;
procedure ArriveNextControl;
procedure ArrivePreviousControl;
Procedure CurrWrite(Value: TCurrSymbolSet);
procedure SetDecimals(Value: integer);
procedure SetMaxLength(Value: integer);
function StripCommas(AString: string): string;
function SymbolDelete(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;
procedure EditTypeWrite(const Value: THusoEditTypeSet);
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;
procedure WndProc(var M:TMessage); override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
procedure CreateParams(var Params: TCreateParams); override;
procedure createwnd;override;
destructor Destroy; override;
function Value(Str: String): Double;
published
{ Published declarations }
property About: string read Get_About write FAbout stored False;
property CurrencySymbol: TCurrSymbolSet read FCurr write CurrWrite
default None;
property HusoEditType: THusoEditTypeSet read FEditType write EditTypeWrite
default TextType;
property MaxLength: integer read FMaxLength write SetMaxLength;
property Decimals: integer read FDecimals write SetDecimals;
property TextAsFloat: Extended read GetTextAsFloat write SetTextAsFloat;
property PassingControl: Boolean read FPassingControl write FPassingControl default True;
property ActiveFontColor:TColor read FAColor write FAColor;
property ActiveSoilColor:TColor read FBColor write FBColor;
property Text;
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
YTLSymbol:String =' YTL';
TLSymbol:String =' TL';
DOLARSymbol:String = ' $';
EUROSymbol: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 3.0 ]==--' + 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.HUSONET.com' + 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;
FEditType := TextType;
CurrencySymbol := FCurr;
FPassingControl := True;
FAcolor:=clWindowText;
FBcolor := clWindow;
FRealFontColor:= font.Color;
FRealSoilColor :=color;
end;
procedure THusoEdit.WndProc(var M:TMessage);
Begin
inherited wndproc(m);
if (m.msg=CM_EXIT) then
Begin
font.color := FRealFontColor;
Color := FRealSoilColor;
End
else
if (m.msg=CM_ENTER) then
Begin
font.color:=FAColor;
Color := FBColor;
End
End;
procedure THusoEdit.ArriveNextControl;
begin
SendMessage(GetParentForm(Self).Handle, WM_NEXTDLGCTL, 0, 0);
end;
procedure THusoEdit.ArrivePreviousControl;
Begin
SendMessage(GetParentForm(Self).Handle, WM_NEXTDLGCTL, 1, 0);
end;
procedure THusoEdit.CreateParams(var Params: TCreateParams);
const Alignments: array[TAlignment] of Word = (ES_LEFT, ES_RIGHT, ES_CENTER);
begin
inherited;
FAcolor:=ActiveFontColor;
FBcolor := ActiveSoilColor;
FRealFontColor := font.color;
FRealSoilColor := Color;
case FEditType of
TextType :Begin
FAlign:=taLeftJustify;
Params.Style := Params.Style or Alignments[FAlign];
End;
CurrencyType :Begin
FAlign:=taRightJustify;
Params.Style := Params.Style or Alignments[FAlign];
End;
end;
end;
procedure THusoEdit.createwnd;
begin
inherited;
if FEditType <> TextType Then
Begin
selStart := 1;
SetDecimals(FDecimals);
if CurrencySymbol = None Then
Text := Text
Else
if CurrencySymbol = TL Then
Text := Text + TLSymbol
Else
if CurrencySymbol = YTL Then
Text := Text + YTLSymbol
Else
if CurrencySymbol = DOLAR Then
Text := Text + DOLARSymbol
Else
if CurrencySymbol = EURO Then
Text := Text + EUROSymbol;
end;
end;
function THusoEdit.GetTextAsFloat: Extended;
var
Buffer:String;
begin
Buffer := Text;
Result := StrToFloat(StripCommas(Symboldelete(Buffer)));
end;
procedure THusoEdit.KeyDown(var Key: Word; Shift: TShiftState);
var
CursorPos, i: integer;
Buffer: string;
begin
Inherited KeyDown(Key,shift);
if FPassingControl then
case Key of
VK_UP: ArrivePreviousControl;
VK_DOWN: ArriveNextControl;
end;
if readonly <> True then
if FEditType <> TextType Then
Begin
if SelLength = length(Text) Then
if key = VK_DELETE Then
Begin
text:='';
while length(text)< FDecimals do
text:=text+'0';
if text<>'' then
text:='0,'+text;
SelStart := 0;
End
Else
if not (key in [vk_return, vk_left, vk_right, vk_up,
vk_down, vk_home, vk_end, vk_menu, vk_subtract,
vk_shift, vk_control, 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 SelLength > 0 Then
Begin
SelText := '';
Buffer := Text;
End
Else
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 (SelLength > 0) Then
Begin
if (SelText[Length(SelText) - FDecimals] = DECIMALSEPARATOR) Then
Begin
SelLength := SelLength - FDecimals;
SelText := '';
For i := 1 to FDecimals do
Begin
SelLength := FDecimals;
SelText := '0';
End;
CursorPos := FDecimals + 1;
Buffer := Text;
End
Else
if (CursorPos < FDecimals) Then
Begin
For i := 1 to SelLength do
Begin
SelText := '0';
End;
Buffer := Text;
End
Else
Begin
SelText := '';
Buffer := Text;
End;
End
Else
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;
end;
procedure THusoEdit.KeyPress(var Key: char);
var
Buffer: string;
CursorPos, i: integer;
begin
Inherited KeyPress(Key);
//SendMessage(Handle, EM_SETREADONLY, Ord(True), 0);
if (Key = #13) and FPassingControl then
begin
Key := #0;
PostMessage(GetParentForm(Self).Handle, WM_NEXTDLGCTL, 0, 0);
end;
if readonly = True then
Key := Char(VK_NONAME);
if FEditType <> TextType Then
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 SelLength > 0 Then
Begin
SelText := '';
Buffer := Text;
End
Else
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 (SelLength > 0) Then
Begin
if (SelText[Length(SelText) - FDecimals] = DECIMALSEPARATOR) Then
Begin
SelLength := SelLength - FDecimals;
SelText := '';
For i := 1 to FDecimals do
Begin
SelLength := FDecimals;
SelText := '0';
End;
CursorPos := FDecimals + 1;
Buffer := Text;
End
Else
if (CursorPos < FDecimals) Then
Begin
For i := 1 to SelLength do
Begin
SelText := '0';
End;
Buffer := Text;
End
Else
Begin
SelText := '';
Buffer := Text;
End;
End
Else
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;
end;
function THusoEdit.Value(Str: String): Double;
var
i:integer;
Buffer:String;
begin
Buffer := SymbolDelete(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 FEditType <> TextType Then
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;
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
if FEditType <> TextType Then
Begin
Text := FormatFloat(FormatString, Value);
End;
RecreateWnd;
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: TCurrSymbolSet);
begin
SetDecimals(FDecimals);
if Value = None then
Begin
FCurr := None;
Text := Text;
End
Else
if Value = TL then
Begin
FCurr := TL;
Text := Text + TLSymbol;
End
Else
if Value = YTL then
Begin
FCurr := YTL;
Text := Text + YTLSymbol;
End
Else
if Value = DOLAR then
Begin
FCurr := DOLAR;
Text := Text + DOLARSymbol;
End
Else
if Value = EURO then
Begin
FCurr := EURO;
Text := Text + EUROSymbol;
End;
if FEditType = TextType Then
Begin
Text := SymbolDelete(Text);
End;
end;
procedure THusoEdit.DoExit;
begin
inherited;
if FEditType <> TextType Then
Begin
if FCurr = None Then
Text := Text
Else
if FCurr = TL Then
Text := Text + TLSymbol
Else
if FCurr = YTL Then
Text := Text + YTLSymbol
Else
if FCurr = DOLAR Then
Text := Text + DOLARSymbol
Else
if FCurr = EURO Then
Text := Text + EUROSymbol;
End;
end;
procedure THusoEdit.DoEnter;
var
Buffer:String;
begin
inherited;
if FEditType <> TextType Then
Begin
Buffer := SymbolDelete(Text);
Text := Buffer;
SelectAll;
End;
end;
function THusoEdit.SymbolDelete(AString: string): string;
var
buffer:String;
begin
Buffer := AString;
if CurrencySymbol = TL Then
Delete(Buffer, Length(AString)-2, 3)
Else
if CurrencySymbol = YTL Then
Delete(Buffer, Length(AString)-3, 4)
Else
if CurrencySymbol = DOLAR Then
Delete(Buffer, Length(AString)-1, 2)
Else
if CurrencySymbol = EURO Then
Delete(Buffer, Length(AString)-1, 2);
Result := Buffer;
end;
procedure THusoEdit.EditTypeWrite(const Value: THusoEditTypeSet);
begin
if FEditType <> TextType Then
Begin
FEditType := Value;
Text := '';
CurrWrite(none);
RecreateWnd;
end
else
Begin
FEditType := Value;
SetDecimals(FDecimals);
RecreateWnd;
End;
end;
destructor THusoEdit.Destroy;
begin
inherited Destroy;
end;
end.
13/04/2004