HusoEditCalc Componenti

Mesaj gönderen **husonet** » 08 Kas 2006 12:27

Arkadaşlar Seriye bir bileşen daha ekledik hayırlara vesile olsun derim.

Bu arada Bileşenin Hesaplama yapan fonksiyonunda buglar olabilir hazır bir fonk kullandım

Maksat yeşillik olsun. Buyrun geliştirmek isterseniz sadece Fonksiyonu replace etmeniz yeter

Yoğun bir iş temposuna girecem vakit ayırabilirsem ve talep olursa bende el atarım

Kod: Tümünü seç

unit HusoEditCalc;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, StdCtrls, Forms, Graphics, Dialogs,
  ExtCtrls;

type
  TCurrSymbolSet = (None,TL, YTL, EURO, DOLAR);
  THusoEditTypeSet = (TextType, CurrencyType);

  THusoEditCalc = 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;
    FCalcEditText:String;
    FCalcEdit        : TEdit;
    FCalcLabel       : TPanel;
    FCalcForm        : TPanel;
    FCalcButtonOk    : TButton;
    FCalcButtonCancel: TButton;
    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);
    procedure CalcEditOnChange(Sender:TObject);
    procedure CalcButtonOkOnClick(Sender:TObject);
    procedure CalcButtonCancelOnClick(Sender:TObject);
  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;
function domuls(cal : string) : extended;

implementation

procedure Register;
begin
  RegisterComponents('Huso Component Set', [THusoEditCalc]);
end;

function domuls(cal : string) : extended;
//Quate = http://garbo.uwasa.fi/ University of Vaasa, Finland
//Replace = Hüseyin Özdemir
  const
    digits : set of char = ['0'..'9', '.', ' '];

  function fval(s : string) : extended;
  var
    x : extended;
    code : integer;
  begin
    val(s, x, code);
    fval := x;
  end;
  function signs(cal : string; var i : integer) : integer;
  var
    sign : integer;
  begin
    sign := 1;
    repeat
      if cal[i] = '-' then
      begin
        sign := sign * -1;
        inc(i);
      end
      else
      if cal[i] = '+' then
        inc(i);
    until not(cal[i] in ['-', '+']);
    signs := sign;
  end;
  function fstr(x : extended) : string;
  var
    s : string;
  begin
    str(x:1:9, s);
    if s[1] = ' ' then
      delete(s, 1, 1);
    fstr := s;
  end;

  function prevnum(var temp : string; i : integer) : extended;
  var
    oldi : integer;
  begin
    oldi := i;
    while ((temp[i] in digits) or ((temp[i - 1] = 'E') and (temp[i] in ['+', '-']))) and (i >= 1) do
      dec(i);
    if (temp[i] in ['+', '-']) and ((i = 1) or (temp[i - 1] in ['+', '-', '*', '/'])) then
      dec(i);
    prevnum := fval(copy(temp, i + 1, oldi - i));
    delete(temp, i + 1, oldi - i);
  end;

  function nextnum(cal : string; var i : integer) : extended;
  var
    temp : string;
    sign : integer;
  begin
    temp := '';
    sign := signs(cal, i);
    while (cal[i] in digits) and (i <= length(cal)) do
    begin
      temp := temp + cal[i];
      inc(i);
      if (cal[i - 1] = 'E') and (cal[i] in ['+', '-']) then
      begin
        temp := temp + cal[i];
        inc(i);
      end;
    end;
    nextnum := sign * fval(temp);
  end;

  function doadd(temp : string) : extended;
  var
    i : integer;
    tot : extended;
  begin
    i := 1;
    tot := nextnum(temp, i);
    repeat
      inc(i);
      case temp[i - 1] of
        '+' : tot := tot + nextnum(temp, i);
        '-' : tot := tot - nextnum(temp, i);
      end;
    until i > length(temp);
    doadd := tot;
  end;
var
  i, sign : integer;
  temp, s : string;
begin
  i := 1;
  temp := '';
  repeat
     case cal[i] of
      '+', '-' : begin
                   temp := temp + cal[i];
                   inc(i);
                 end;

      '*' : begin
              inc(i);
              sign := signs(cal, i);
              if cal[i] in digits then
              begin
                s := fstr(sign * prevnum(temp, length(temp)) * nextnum(cal,i));
                temp := temp + s;
              end
              else
              if cal[i] = '(' then
              begin
                s := fstr(sign * prevnum(temp, length(temp)));
                temp := temp + s;
              end
              else
                inc(i);
            end;

      '/' : begin
              inc(i);
              sign := signs(cal, i);
              if cal[i] in digits then
              begin
                s := fstr(sign * prevnum(temp, length(temp)) / nextnum(cal, i));
                temp := temp + s;
              end;
              inc(i);
            end;

      '0'..'9', '.', ' ' : while (cal[i] in digits) and (i <= length(cal)) do
                      begin
                        temp := temp + cal[i];
                        inc(i);
                        if (cal[i] in ['+', '-']) then
                        begin
                          temp := temp + cal[i];
                          inc(i);
                        end;
                      end;
    end;
  until i > length(cal);
  domuls := doadd(temp);
end;

Function THusoEditCalc.Get_AboutStr:String;
var	msg: string;
const
  cr = chr(13);
begin
  msg := '                --==[ HusoEditCalc ]==--' + cr + cr;
  msg := msg + '     HUSOEDITCALC : ' + ' 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 THusoEditCalc.Get_About: string;
begin
  Result := Get_AboutStr;
end;

procedure THusoEditCalc.CMEnter(var Message: TCMGotFocus);
Begin
    SelStart := Length(Text) - FDecimals - 1;
    inherited;
end;

constructor THusoEditCalc.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;
    FCalcEdit:= TEdit.Create(nil);
    FCalcLabel:= TPanel.Create(nil);
    FCalcForm := TPanel.Create(nil);
    FCalcButtonOk := TButton.Create(nil);
    FCalcButtonCancel := TButton.Create(nil);
end;
procedure THusoEditCalc.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 THusoEditCalc.ArriveNextControl;
begin
    SendMessage(GetParentForm(Self).Handle, WM_NEXTDLGCTL, 0, 0);
end;

procedure THusoEditCalc.ArrivePreviousControl;
Begin
    SendMessage(GetParentForm(Self).Handle, WM_NEXTDLGCTL, 1, 0);
end;
procedure THusoEditCalc.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 THusoEditCalc.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 THusoEditCalc.GetTextAsFloat: Extended;
var
    Buffer:String;
begin
    Buffer := Text;
    Result := StrToFloat(StripCommas(Symboldelete(Buffer)));
end;

procedure THusoEditCalc.CalcEditOnChange(Sender: Tobject);
var
  StrText :String;
  Total:Double;
begin
  StrText := FCalcEdit.Text;
  if StrText <> '' then
  begin
    Total := domuls(StrText);
    FCalcLabel.Caption :=  FloatToStr(Total);
  end;
end;

procedure THusoEditCalc.CalcButtonOkOnClick(Sender: TObject);
begin
  if self.HusoEditType = CurrencyType then
  begin
    if FCalcLabel.Caption <> '' then
      Self.TextAsFloat   := StrToFloat(FCalcLabel.Caption);
  end
  else
    if FCalcLabel.Caption <> '' then
      Self.Text   := FCalcLabel.Caption;

  FCalcForm.Visible  := False;
  FCalcEdit.Visible  := False;
  FCalcLabel.Visible := False;
  FCalcButtonOk.Visible := False;
  FCalcButtonCancel.Visible := False;
end;

procedure THusoEditCalc.CalcButtonCancelOnClick(Sender: TObject);
begin
  FCalcLabel.Caption := '';

  FCalcForm.Visible  := False;
  FCalcEdit.Visible  := False;
  FCalcLabel.Visible := False;
  FCalcButtonOk.Visible := False;
  FCalcButtonCancel.Visible := False;
end;


procedure THusoEditCalc.KeyDown(var Key: Word; Shift: TShiftState);
var
  CursorPos, i: integer;
  Buffer      : string;
  Operant     : String;
begin
  Inherited KeyDown(Key,shift);
  case key of
      //Çarpma işlemi
      VK_MULTIPLY,
      VK_DIVIDE,
      VK_ADD,
      VK_SUBTRACT:begin
                    case key of
                      VK_MULTIPLY: Operant := '*';
                      VK_DIVIDE: Operant := '/';
                      VK_ADD: Operant := '+';
                      VK_SUBTRACT: Operant := '-';
                    end;

                    FCalcForm.Visible  := True;
                    FCalcForm.Top      := Self.Top + 10;
                    FCalcForm.Left     := Self.Left;
                    FCalcForm.Height   := 70;
                    FCalcForm.Width    := 200;
                    FCalcForm.Parent   := Self.Parent;

                    FCalcEdit.Visible  := True;
                    FCalcEdit.Top      := FCalcForm.Top + 10;
                    FCalcEdit.Left     := FCalcForm.Left + 10;
                    FCalcEdit.Parent   := FCalcForm.Parent;
                    FCalcEdit.OnChange := CalcEditOnChange;
                    FCalcEdit.Text     := FloatToStr(self.TextAsFloat) + Operant;
                    FCalcEdit.SetFocus;
                    FCalcEdit.SelStart := length(FCalcEdit.Text);

                    FCalcLabel.Visible    := True;
                    FCalcLabel.Top        := FCalcForm.Top + 40;
                    FCalcLabel.Left       := FCalcForm.Left + 10;
                    FCalcLabel.Height     := 20;
                    FCalcLabel.BevelInner := bvLowered;
                    FCalcLabel.Parent     := FCalcForm.Parent;
                    FCalcLabel.Caption    := FloatToStr(self.TextAsFloat);

                    FCalcButtonOk.Visible := True;
                    FCalcButtonOk.Top     := FCalcForm.Top + 10;
                    FCalcButtonOk.Left    := FCalcForm.Left + 140;
                    FCalcButtonOk.Parent  := FCalcForm.Parent;
                    FCalcButtonOk.Font.Size:= 6;
                    FCalcButtonOk.Width   := 20;
                    FCalcButtonOk.Caption := 'T';
                    FCalcButtonOk.OnClick := CalcButtonOkOnClick;
                    FCalcButtonOk.Default := True;

                    FCalcButtonCancel.Visible := True;
                    FCalcButtonCancel.Top     := FCalcForm.Top + 10;
                    FCalcButtonCancel.Left    := FCalcForm.Left + 170;
                    FCalcButtonCancel.Parent  := FCalcForm.Parent;
                    FCalcButtonCancel.Font.Size:= 6;
                    FCalcButtonCancel.Width   := 20;
                    FCalcButtonCancel.Caption := 'İ';
                    FCalcButtonCancel.OnClick := CalcButtonCancelOnClick;

                  end;
  end;

  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 THusoEditCalc.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 THusoEditCalc.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 THusoEditCalc.Reformat;
begin
    Text := FormatFloat(FormatString, StrToFloat(StripCommas(Text)));
end;

procedure THusoEditCalc.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 THusoEditCalc.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 THusoEditCalc.SetTextAsFloat(Value: Extended);
begin
    if FEditType <> TextType Then
    Begin
        Text := FormatFloat(FormatString, Value);
    End;
    RecreateWnd;
end;

function THusoEditCalc.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 THusoEditCalc.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 THusoEditCalc.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 THusoEditCalc.DoEnter;
var
    Buffer:String;
begin
  inherited;

  if self.HusoEditType = CurrencyType then
  begin
    if FCalcLabel.Caption <> '' then
      Self.TextAsFloat   := StrToFloat(FCalcLabel.Caption);
  end
  else
    if FCalcLabel.Caption <> '' then
      Self.Text   := FCalcLabel.Caption;

  FCalcForm.Visible  := False;
  FCalcEdit.Visible  := False;
  FCalcLabel.Visible := False;
  FCalcButtonOk.Visible := False;
  FCalcButtonCancel.Visible := False;  

  if FEditType <> TextType Then
  Begin
      Buffer := SymbolDelete(Text);
      Text := Buffer;
      SelectAll;
  End;
end;

function THusoEditCalc.SymbolDelete(AString: string): string;
var
  buffer: string;
  SymbolStr: string;
begin
  Buffer := AString;
  case CurrencySymbol of
    TL: SymbolStr := TLSymbol;
    YTL: SymbolStr := YTLSymbol;
    EURO: SymbolStr := EUROSymbol;
    DOLAR: SymbolStr := DOLARSymbol;
  else
    SymbolStr:='NONE';
  end;

  if Pos(SymbolStr, Buffer) <> 0 then
  begin
    case CurrencySymbol of
      TL: Delete(Buffer, Length(AString) - 2, 3);
      YTL: Delete(Buffer, Length(AString) - 3, 4);
      EURO: Delete(Buffer, Length(AString) - 1, 2);
      DOLAR: Delete(Buffer, Length(AString) - 1, 2);
    end;
  end;
  Result := Trim(Buffer);
end;
procedure THusoEditCalc.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 THusoEditCalc.Destroy;
begin
  inherited Destroy;
end;

end.

http://www.husonet.com/dfiles/HusoEditCalc.rar

Yorumlarınızı paylaşırsanız sevinirim.

Kolay Gelsin...

Mesaj gönderen **mege** » 08 Kas 2006 09:59

eline sağlık hüseyin

bunu kutlamamız lazım

Mesaj gönderen **rsimsek** » 08 Kas 2006 11:12

mege yazdı:eline sağlık hüseyin bunu kutlamamız lazım

Doğru söze ne denir

Mesaj gönderen **lazio** » 08 Kas 2006 08:32

rsimsek yazdı:
mege yazdı:eline sağlık hüseyin bunu kutlamamız lazım

Doğru söze ne denir

[/quote
+1
bu komponent ıslanmalı

Mesaj gönderen **husonet** » 08 Kas 2006 11:19

yaw şaka bir yanada ben hala Mege nin Adminliğini kutladığımızıda hatırlamıyorum ve Lazio nun mod luğunu sıra sizin

Tatlılar bizim

Mesaj gönderen **rsimsek** » 09 Kas 2006 12:15

husonet yazdı:yaw şaka bir yanada ben hala Mege nin Adminliğini kutladığımızıda hatırlamıyorum ve Lazio nun mod luğunu sıra sizin Tatlılar bizim

Haklısın hüso, güya seni sevdiklerinden sana torpil yapıyorlarmış

Aslında şu @mege nin uzaktan akrabası kebapçı iskender amcayı epeydir ziyaret etmedik ya

Mesaj gönderen **husonet** » 09 Kas 2006 12:23

evet evet

Mesaj gönderen **lazio** » 09 Kas 2006 11:49

oo hüseyin bizim mod luk timeout oldu

işi sıkı tutmadınız abi napalım

Mesaj gönderen **husonet** » 10 Kas 2006 08:40

hmm demek iskenderi neden bulamadın o gün ortaya çıktı

Artık elinden tutup biz götürürüz timestart olur hehe

Mesaj gönderen **lazio** » 10 Kas 2006 10:21

Mesaj gönderen **mege** » 10 Kas 2006 10:50

100000. mesaj kutlamasımı yapsak acaba

okadar mumda dikilmezki