HUSODBEDIT (Üyelerimize ücretsiz full sürüm)

Mesaj gönderen **husonet** » 07 Ara 2004 12:05

S.a.

HusoEdit Bileşeninin özelliklerini kapsayan DB için uyarlanmış bu sürüm umarım işinize yarar.

unit HusoDBEdit;

interface

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

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

  THusoDBEdit = class(TCustomEdit)
  private
    { Private declarations }
    Falign: TAlignment;
    FDecimals: integer;
    FMaxLength: integer;
    FormatString: String;
    DecimalPos: integer;
    FWantReturns: Boolean;
    FAbout: String;
    FCurr: TCurrSymbolSet;
    FEditType: THusoDBEditTypeSet;
    FPassingControl: Boolean;
    FFontColor:TColor;
    FRealFontColor:TColor;
    FRealSoilColor:TColor;
    FAColor:TColor;
    FSoilColor:TColor;
    FBColor:TColor;
    Fout:Boolean;
    FAllowChange: Boolean;
    FDataLink: TFieldDataLink;
    FBorderStyle: TBorderStyle;
    FControl : Boolean;
    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 );
    procedure SetTextAsFloat1( Value: Extended );
    function Get_About: string;
    Function Get_AboutStr:String;
    procedure EditTypeWrite(const Value: THusoDBEditTypeSet);
    function GetDataField: string;
    function GetDataSource: TDataSource;
    procedure SetDataField(const Value: string);
    procedure SetDataSource(Value: TDataSource);
    procedure DataLinkDataChange(Sender: TObject);
    procedure DataLinkUpdateData(Sender: TObject);
    procedure UnfibreDataLink;
    procedure fibreDataLink;
    procedure EditingChange(Sender: TObject);
    function GetReadOnly: Boolean;
    procedure SetReadOnly(const Value: Boolean);
  protected
    { Protected declarations }
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: char); override;
    procedure DoExit; override;
    procedure DoEnter; override;
    procedure Change; 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;
    property HusoDBEditType: THusoDBEditTypeSet read FEditType write EditTypeWrite
      default TextType;
    property TextAsFloat: Extended read GetTextAsFloat write SetTextAsFloat;
    Property Text;
  published
    { Published declarations }
    property About: string read Get_About write FAbout stored False;
    property CurrencySymbol: TCurrSymbolSet read FCurr write CurrWrite
      default None;
    property MaxLength: integer read FMaxLength write SetMaxLength;
    property Decimals: integer read FDecimals write SetDecimals;
    property PassingControl: Boolean read FPassingControl write FPassingControl default True;
    property ActiveFontColor:TColor read FAColor write FAColor;
    property ActiveSoilColor:TColor read FBColor write FBColor;
    property DataField: string read GetDataField write SetDataField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    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: Boolean read GetReadOnly write SetReadOnly default False;
    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', [THusoDBEdit]);
end;

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

procedure THusoDBEdit.CMEnter(var Message: TCMGotFocus);
Begin
    SelStart := Length(Text) - FDecimals - 1;
    inherited;
    if FDataLink.CanModify then
        inherited ReadOnly := False;
end;

constructor THusoDBEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
inherited ReadOnly := True;
    WantReturns := False;
    Height := 24;
    Width := 120;
    FAlign:=taRightJustify;
    DecimalPos := 0;
    FMaxLength := 20;
    FDecimals := 2;
    CurrWrite(FCurr);
    FPassingControl := True;
    FAcolor:=clWindowText;
    FBcolor := clWindow;
    FRealFontColor:= font.Color;
    FRealSoilColor :=color;
    FDataLink := TFieldDataLink.Create;
    FibreDataLink;
    FControl := False;
end;
procedure THusoDBEdit.WndProc(var M:TMessage);
Begin
 inherited wndproc(m);
{ if (m.msg=CM_MOUSELEAVE) and FOut then
 Begin
    font.color:=FFontColor;
    color:=FSoilColor;
 End
 Else
 if (m.msg=CM_MOUSEENTER) then
 Begin
    font.color:=FAColor;
    color:=FBColor;
 End;
}
 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 THusoDBEdit.ArriveNextControl;
begin
    SendMessage(GetParentForm(Self).Handle, WM_NEXTDLGCTL, 0, 0);
end;

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

procedure THusoDBEdit.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 (FDatalink.DataSet.State in [dsEdit, dsInsert]) Then
  Begin
    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
  else
    Key := VK_OEM_CLEAR;
end;

procedure THusoDBEdit.KeyPress(var Key: char);
var
  Buffer: string;
  CursorPos, i: integer;
begin
  Inherited KeyPress(Key);
  if (Key = #13) and FPassingControl then
  begin
    Key := #0;
    PostMessage(GetParentForm(Self).Handle, WM_NEXTDLGCTL, 0, 0);
  end;

  if (FDatalink.DataSet.State in [dsEdit, dsInsert]) Then
  Begin
      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
  else
    Key := #0;
end;

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

procedure THusoDBEdit.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;
    FDecimals := Value;
    Reformat;
end;

procedure THusoDBEdit.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 THusoDBEdit.SetTextAsFloat(Value: Extended);
begin
        Text := FormatFloat(FormatString, Value);
end;

function THusoDBEdit.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 THusoDBEdit.CurrWrite(Value: TCurrSymbolSet);
begin
    if FEditType <> TextType Then
    Begin
        SetDecimals(FDecimals);
        Text := FloatToStr(FDataLink.Field.AsFloat);
        TextAsFloat := StrToFloat(Text);
        if Value = None then
        Begin
            FCurr := None;
            Text := FormatFloat(FormatString, StrToFloat(StripCommas(Text)));
        End
        Else
        if Value = TL then
        Begin
            FCurr := TL;
            Text := FormatFloat(FormatString, StrToFloat(StripCommas(Text))) + TLSymbol;
        End
        Else
        if Value = YTL then
        Begin
            FCurr := YTL;
            Text := FormatFloat(FormatString, StrToFloat(StripCommas(Text))) + YTLSymbol;
        End
        Else
        if Value = DOLAR then
        Begin
            FCurr := DOLAR;
            Text := FormatFloat(FormatString, StrToFloat(StripCommas(Text))) + DOLARSymbol;
        End
        Else
        if Value = EURO then
        Begin
            FCurr := EURO;
            Text := FormatFloat(FormatString, StrToFloat(StripCommas(Text))) + EUROSymbol;
        End;
        if FEditType = TextType Then
        Begin
            Text := SymbolDelete(Text);
        End;
    End;
    FCurr := Value;
end;

procedure THusoDBEdit.DoExit;
begin
  inherited;
  if FEditType <> TextType Then
  Begin
      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 THusoDBEdit.DoEnter;
var
    Buffer:String;
begin
  inherited;
  if FEditType <> TextType Then
  Begin
      Buffer := SymbolDelete(Text);
      Text := Buffer;
      SelectAll;
  End;
end;
function THusoDBEdit.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 THusoDBEdit.EditTypeWrite(const Value: THusoDBEditTypeSet);
begin
      if FEditType <> TextType Then
      Begin
          FEditType := Value;
          Text := '';
          RecreateWnd;
      end
      else
      Begin
          FEditType := Value;
          SetDecimals(FDecimals);
          RecreateWnd;
      End;
end;
destructor THusoDBEdit.Destroy;
begin
  UnFibreDataLink;
  FDataLink.Free;
  inherited Destroy;
end;

function THusoDBEdit.GetDataField: string;
begin
   Result:=FDataLink.FieldName;
end;

function THusoDBEdit.GetDataSource: TDataSource;
begin
   Result:=FDataLink.DataSource;
end;

procedure THusoDBEdit.SetDataField(const Value: string);
begin
   FDataLink.FieldName:=Value;
end;

procedure THusoDBEdit.SetDataSource(Value: TDataSource);
begin
   FDataLink.DataSource:=Value;
end;

procedure THusoDBEdit.fibreDataLink;
begin
    FDataLink.OnDataChange := DataLinkDataChange;
    FDataLink.OnUpdateData := DataLinkUpdateData;
end;

procedure THusoDBEdit.UnfibreDataLink;
begin
    FDataLink.OnDataChange := nil;
    FDataLink.OnUpdateData := nil;
end;

procedure THusoDBEdit.SetTextAsFloat1(Value: Extended);
begin
    if FEditType <> TextType Then
    Begin
        FControl := True;
        Text := FormatFloat(FormatString, Value);
    End;
    RecreateWnd;
end;


procedure THusoDBEdit.DataLinkDataChange(Sender: TObject);
begin
   if not (FDataLink.Active = false) Then
   Begin
    try
        if FDataLink.Field.DataType = ftInteger Then
        Begin
            HusoDBEditType := CurrencyType;
            if FDataLink.Field = nil then
            Begin
                SetDecimals(FDecimals);
            End
            else
            if FControl = False Then
                SetTextAsFloat1(FDataLink.Field.AsInteger)
            Else
            Begin
                TextAsFloat := FDataLink.Field.AsInteger;
                CurrWrite(FCurr);
            End;
        End
        Else
        if (FDataLink.Field.DataType = ftFloat) or (FDataLink.Field.DataType = ftCurrency) Then
        Begin
            HusoDBEditType := CurrencyType;
            if FDataLink.Field = nil then
            Begin
                SetDecimals(FDecimals);
            End
            else
               if FControl = False Then
                begin
                    SetTextAsFloat1(FDataLink.Field.AsFloat);
                End
                Else
                Begin
                    TextAsFloat := FDataLink.Field.AsFloat;
                    CurrWrite(FCurr);
                End;
            End
            Else
            if (FDataLink.Field.DataType in [ftString, ftWideString, ftMemo]) Then
            Begin
                HusoDBEditType := TextType;
                if FDataLink.Field = nil then
                  Text := ''
                else
                  Text := FDataLink.Field.AsString;
            End
            Else
            Begin
                FDataLink.FieldName := '';
                Text := 'Error Field';
            End;
    Except
        Text := 'Lacking Quality Field';
       // ShowMessage('HUSONET' + Chr(13) + 'This is Component for AsString, AsFloat, AsCurrency and AsInteger value');
    End;
   End
   else
        Text :='';
end;

procedure THusoDBEdit.DataLinkUpdateData(Sender: TObject);
begin
  if (FDataLink.Field.DataType = ftString)  or (FDataLink.Field.DataType = ftMemo) Then
    FDataLink.Field.AsString := Text
  Else
  if (FDataLink.Field.DataType = ftInteger) Then
  Begin
    FDataLink.Field.AsInteger := StrToInt(FloatToStr(TextAsFloat));
  End
  Else
  if (FDataLink.Field.DataType = ftFloat) or  (FDataLink.Field.DataType = ftCurrency) Then
  Begin
    FDataLink.Field.AsFloat := TextAsFloat;
  End;
end;

procedure THusoDBEdit.Change;
begin
  FDataLink.Modified;
  inherited Change;
end;

function THusoDBEdit.GetReadOnly: Boolean;
begin
  Result := FDataLink.ReadOnly;
end;

procedure THusoDBEdit.SetReadOnly(const Value: Boolean);
begin
  FDataLink.ReadOnly := Value;
end;

procedure THusoDBEdit.EditingChange(Sender: TObject);
begin
  inherited ReadOnly := not FDataLink.Editing;
end;
end.

Bileşen dataset Edit ve Insert moddayken giriş yapmaya izin verecektir.
Burada yapılacak işlemleri Fieldları baz alarak yapmanızı tafsiye ederim.

Hayırlı olsun.

Görüş bildirenlere ve bug bildirimi yapan arkadaşlara teşekkür ederim.

Bileşeni indirmek için
http://www.husonet.com/dfiles/HusoDbEditFullVersion.zip linkini kullanabilirsiniz.

İyi Çalışmalar.
13/04/2005 son güncelleme

Mesaj gönderen **DotCom** » 07 Ara 2004 12:17

ya böyle güzel yapıyo yapıyo Husonet , korkuyom yakında paralıya dönecek diye.

Eline Sağlık.

y.kulac · Mesaj gönderen **y.kulac** » 06 Oca 2005 08:52

s.a.
sayın huso hocam.
forumda daha önceden sorduğum sizin yardımcı olduğunuz tabloyu kapatırken hata verme
konusunu hallettik. husodbedit companenti ytl için süper. bir iki halledilmesi gereken
küçük problemler var. onları aşağıya yazıyorum. umarım husodbedit en mükemmel olur.
Allah parmaklarınıza dert vermesin. böyle güzel çalışmalarınızı bekliyoruz.

1. tasarım esnasında tabloyu object inspector penceresinden active olayını falseden true
yapıyorum. true den false yapınca formdaki husodbeditlerin sayısınca hata mesajı veriyor.
bu çalışma esnasında olmuyor. gayet güzel çalışıyor.

2. object inspector penceresinden zemin ve font rengini değiştiriyorum. fare ile dbedit in
üzerine gelince font rengi siyah, zemim rengi beyaz oluyor. değişiklikler kalıcı olmuyor.

iyi çalışmalar diler saygılar sunarım.

Mesaj gönderen **husonet** » 06 Oca 2005 10:14

Teşekkür Ederim.

Mesaj gönderen **husonet** » 14 Nis 2005 12:05

1. tasarım esnasında tabloyu object inspector penceresinden active olayını falseden true
yapıyorum. true den false yapınca formdaki husodbeditlerin sayısınca hata mesajı veriyor.//Güncellendi

2. object inspector penceresinden zemin ve font rengini değiştiriyorum. fare ile dbedit in
üzerine gelince font rengi siyah, zemim rengi beyaz oluyor. değişiklikler kalıcı olmuyor. //Fare ile renk kontrolü iptal edildi

Kolay Gelsin...

ALUCARD · Mesaj gönderen **ALUCARD** » 22 Nis 2005 05:01

ya hüseyin hocam bugğn bir tane formuma husodbeditler koydum birkaç sıkıntım oldu

1. şu dosmove componenti vardı hani onunla çalışırken problem çıkıyor.

2. tariha alanları bağlayamıyorum tarih alanlar bağlanamaz hatası alıyorum
3. editten çıkınca veri editte kalıyor gridde göremiyorum. yani vt ye yazmamış oluyoru bende kontrolleri vt deki alanlara göre yapıyorum ama bu sefer editleri kontrol etmem gerekiyor.
4. ve bazende değerleri direkt sıfıra eşitliyor

niye yaptığını anlamadım

hüseryin abim bi ilgilenirsen sevinirim..

Mesaj gönderen **husonet** » 22 Nis 2005 06:11

ALUCARD yazdı:ya hüseyin hocam bugğn bir tane formuma husodbeditler koydum birkaç sıkıntım oldu

1. şu dosmove componenti vardı hani onunla çalışırken problem çıkıyor.

2. tariha alanları bağlayamıyorum tarih alanlar bağlanamaz hatası alıyorum
3. editten çıkınca veri editte kalıyor gridde göremiyorum. yani vt ye yazmamış oluyoru bende kontrolleri vt deki alanlara göre yapıyorum ama bu sefer editleri kontrol etmem gerekiyor.
4. ve bazende değerleri direkt sıfıra eşitliyor

niye yaptığını anlamadım

hüseryin abim bi ilgilenirsen sevinirim..

1.HusoDBEdit lerin PassingControl özelliğini false yaparsan çalışacaktır.

2.Alan sınırlamasını kaldırabilirsin bileşenden.

Kod: Tümünü seç

procedure THusoDBEdit.DataLinkDataChange(Sender: TObject);
begin
   if not (FDataLink.Active = false) Then
   Begin
    try
        if FDataLink.Field.DataType = ftInteger Then
        Begin
            HusoDBEditType := CurrencyType;
            if FDataLink.Field = nil then
            Begin
                SetDecimals(FDecimals);
            End
            else
            if FControl = False Then
                SetTextAsFloat1(FDataLink.Field.AsInteger)
            Else
            Begin
                TextAsFloat := FDataLink.Field.AsInteger;
                CurrWrite(FCurr);
            End;
        End
        Else
        if (FDataLink.Field.DataType = ftFloat) or (FDataLink.Field.DataType = ftCurrency) Then
        Begin
            HusoDBEditType := CurrencyType;
            if FDataLink.Field = nil then
            Begin
                SetDecimals(FDecimals);
            End
            else
               if FControl = False Then
                begin
                    SetTextAsFloat1(FDataLink.Field.AsFloat);
                End
                Else
                Begin
                    TextAsFloat := FDataLink.Field.AsFloat;
                    CurrWrite(FCurr);
                End;
            End
            Else
            if (FDataLink.Field.DataType in [ftString, ftWideString, ftMemo, ftDate, ftTime, ftDateTime]) Then
            Begin
                HusoDBEditType := TextType;
                if FDataLink.Field = nil then
                  Text := ''
                else
                  Text := FDataLink.Field.AsString;
            End
            Else
            Begin
                FDataLink.FieldName := '';
                Text := 'Error Field';
            End;
    Except
        Text := 'Lacking Quality Field';
       // ShowMessage('HUSONET' + Chr(13) + 'This is Component for AsString, AsFloat, AsCurrency and AsInteger value');
    End;
   End
   else
        Text :='';
end;

3.Veriyi post etmeden veritabanına yazmayacaktır.

4.Tablodaki alanın decimals özelliğini ile bileşendekini bir tutarsan sorunsuz yazması lazım.

ALUCARD · Mesaj gönderen **ALUCARD** » 24 Nis 2005 09:01

1.HusoDBEdit lerin PassingControl özelliğini false yaparsan çalışacaktır.

hüseyin abi ozaman husodbeditler arasında enter tuşuna basınca iki iki atlama ya başlıyor ama tab tuşuna basınca normal çalışıyor.

2.Alan sınırlamasını kaldırabilirsin bileşenden.

bunu kesinlikle yapacağım çünkü ben tarih alanlarıda kullanmak istiyorum.

3.Veriyi post etmeden veritabanına yazmayacaktır.

bununla ilgili şüphelerim var bezan çok iyi bazende çok kötü bi özellik olabilir.

ALUCARD yazdı:4. ve bazende değerleri direkt sıfıra eşitliyor

bunu sadece dosmowe componentini kullanırsam yapıyor. onun haricinde bi sorun yok
acaba ben birde alan formak vermiştim ondan yapıyo olabilirmi.

abi ilgilendiğin için teşekkür