IRCForumları - IRC ve mIRC Kullanıcılarının Buluşma Noktası
  kral sohbet




Yeni Konu aç Cevapla
 
LinkBack Seçenekler Stil
Alt 18 Mart 2015, 14:02   #1
Çevrimiçi
Sadece rakam kullanabileceğiniz şık bir edit component


sohbet


Kod:   Kodu kopyalamak için üzerine çift tıklayın!
unit PBNumEdit; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; const PB_SETTINGCHANGE = WM_USER + 147; type TNumberFormat = (Standard, Thousands, Scientific, Engineering); TPBNumEdit = class(TCustomEdit) private FAlignment: TAlignment; FDecimals: ShortInt; FEnter, FParentColor : Boolean; FInvalidEntry: TNotifyEvent; FMaxValue: Extended; FMinValue: Extended; FNumberFormat : TNumberFormat; FVersion: String; FDisabledColor, FEnabledColor : TColor; OldDecimalSep, OldThousandSep : Char; FOnClear : TNotifyEvent; function FormatText(Value: Extended): string; function GetAsCurrency: Currency; function GetAsFloat: Extended; function GetAsInteger: Integer; function GetValue: Extended; function HookMainProc(var Message: TMessage) : Boolean; function Remove1000(Num : string): string; function ReplaceSeparators(Num : string) : string; procedure DeleteKey(Key: Word); procedure DeleteSelection; procedure SetAlignment(Value: TAlignment); procedure SetAsCurrency(Value: Currency); procedure SetAsFloat(Value: Extended); procedure SetAsInteger(Value: Integer); procedure SetColor(Value : TColor); procedure SetDisabledColor(Value : TColor); procedure SetDecimals(Value: ShortInt); procedure SetMaxValue(Value: Extended); procedure SetMinValue(Value: Extended); procedure SetNumberFormat(Value: TNumberFormat); procedure SetParentColor(Value : Boolean); procedure SetValue(Value: Extended); procedure SetVersion(Value: String); procedure WMClear(var Msg : TMessage); message WM_CLEAR; procedure WMCut(var Message: TMessage); message WM_CUT; procedure WMCopy(var Message: TMessage); message WM_COPY; procedure WMGetDlgCode(var Msg : TWMGetDlgCode); message WM_GETDLGCODE; procedure WMPaste(var Message: TMessage); message WM_PASTE; procedure WMSettingchange(var Message: TMessage); message PB_SETTINGCHANGE; procedure CMPARENTCOLORCHANGED(var M:TMessage); message CM_PARENTCOLORCHANGED; protected procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure DoEnter; override; procedure DoExit; override; procedure InvalidEntry; procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure KeyPress(var Key: Char); override; procedure Keyup(var Key: Word; Shift: TShiftState); override; procedure SetEnabled(Value : Boolean); override; procedure Loaded; override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure CreateParams(var Params: TCreateParams); override; property AsCurrency: Currency read GetAsCurrency write SetAsCurrency; property AsFloat: Extended read GetAsFloat write SetAsFloat; property AsInteger: Integer read GetAsInteger write SetAsInteger; published property Alignment: TAlignment read FAlignment write SetAlignment; {$IFNDEF VER100} property Anchors; {$ENDIF} property AutoSelect; property AutoSize; property BorderStyle; property Color : TColor read FEnabledColor write SetColor default clWindow; property DisabledColor : TColor read FDisabledColor write SetDisabledColor default clBtnFace; property Enabled : Boolean read GetEnabled write SetEnabled default True; property Ctl3D; property Decimals: ShortInt read FDecimals write SetDecimals; property DragCursor; property DragMode; property Font; property HideSelection; property MaxLength; property MaxValue: Extended read FMaxValue write SetMaxValue; property MinValue: Extended read FMinValue write SetMinValue; property NumberFormat: TNumberFormat read FNumberFormat write SetNumberFormat; property OnChange; property OnClear : TNotifyEvent read FOnClear write FOnClear; property OnClick; property OnDblClick; property OnDragDrop; property OnDragOver; property OnEndDrag; property OnEnter; property OnExit; property OnInvalidEntry: TNotifyEvent read FInvalidEntry write FInvalidEntry; property OnKeyDown; property OnKeyPress; property OnKeyUp; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnStartDrag; property ParentColor : Boolean read FParentColor write SetParentColor default False; property ParentCtl3D; property ParentFont; property ParentShowHint; property PopupMenu; property ReadOnly; property ShowHint; property TabOrder; property TabStop; property Value: Extended read GetValue write SetValue; property Version: String read FVersion write SetVersion stored False; property Visible; property Align; end; procedure Register; implementation uses Clipbrd; constructor TPBNumEdit.Create(AOwner: TComponent); begin inherited Create(AOwner); Width := 100; FAlignment := taRightJustify; FDecimals := -1; FEnter := False; FMaxValue := 0; FMinValue := 0; FNumberFormat := Standard; FVersion := '8.50.00.00'; OldDecimalSep := DecimalSeparator; OldThousandSep := ThousandSeparator; Value := 0; Text := FormatText(Value); inherited Enabled := True; inherited Color := clWindow; FEnabledColor := clWindow; FDisabledColor := clBtnFace; Application.HookMainWindow(HookMainProc); end; procedure TPBNumEdit.Loaded; begin inherited; if Enabled then inherited Color := FEnabledColor else inherited Color := FDisabledColor; end; procedure TPBNumEdit.CreateParams(var Params: TCreateParams); const Alignments: array[TAlignment] of Word = (ES_LEFT, ES_RIGHT, ES_CENTER); begin inherited CreateParams(Params); Params.Style := Params.Style or ES_MULTILINE or Alignments[FAlignment]; end; destructor TPBNumEdit.Destroy; begin Application.UnHookMainWindow(HookMainProc); inherited; end; procedure TPBNumEdit.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if (Button = mbLeft) or (ssLeft in Shift) then begin if FEnter = True then begin FEnter := False; if AutoSelect then SelectAll; end; end; inherited MouseDown(Button, Shift, X, Y); end; procedure TPBNumEdit.DoEnter; begin inherited DoEnter; if csLButtonDown in ControlState then FEnter := True; if AutoSelect then SelectAll; end; procedure TPBNumEdit.DoExit; begin Text := FormatText(Value); if ((FMinValue <> 0) or (FMaxValue <> 0)) and ((Value < FMinValue) or (Value > FMaxValue)) then InvalidEntry else inherited DoExit; end; procedure TPBNumEdit.KeyDown(var Key: Word; Shift: TShiftState); begin inherited KeyDown(Key, Shift); FEnter := False; if not ReadOnly then begin if Key in [VK_DELETE, VK_BACK] then begin if SelLength > 0 then DeleteSelection else DeleteKey(Key); Key := 0; end; end; end; procedure TPBNumEdit.KeyPress(var Key: Char); var P, D, E : Integer; N, NE : Boolean; begin inherited KeyPress(Key); if ReadOnly or (Key in [#3, #22, #24]) then exit; if not (Key in ['0'..'9', DecimalSeparator, '-', 'e', 'E']) or ((Key = DecimalSeparator) and (FDecimals = 0)) then begin MessageBeep(0); Key := #0; Exit; end; P := SelStart; D := pos(DecimalSeparator, Text); E := pos('E', Text); if Key = 'e' then Key := 'E'; if Key in [DecimalSeparator, 'E'] then SelLength := 0 else DeleteSelection; N := (Text[1] = '-'); NE := (pos('-', copy(Text, E + 1, length(Text) - E)) <> 0) and (E <> 0); if N and (SelStart = 0) then SelStart := 1; if NE and (Selstart = E + 1) then SelStart := SelStart + 1; if Key = '-' then begin if (P < E) or (E = 0) then begin if not N then begin Text := '-' + Text; SelStart := P + 1; end else begin Text := Copy(Text, 2, Length(Text) - 1); SelStart := P - 1; end; end else begin if not NE then begin Text := copy(Text, 1, E) + '-' + copy(Text, E + 1, Length(Text) - E); SelStart := P + 1; end else begin Text := copy(Text, 1, E) + copy(Text, E + 2, Length(Text) - E - 1); SelStart := P - 1; end; end; Key := #0; exit; end; if Key = DecimalSeparator then begin if D <> 0 then begin Selstart := D; Key := #0; end else if FDecimals < 0 then begin if E <> 0 then Selstart := E - 1 else Selstart := Length(Text); end; exit; end else if Key = 'E' then begin if E = 0 then SelStart := Length(Text) else begin SelStart := E; Key := #0; end; Exit; end; if (SelStart <= 2) and (Copy(Text, 2, 1) = '0') and N then begin SelStart := 1; SelLength := 1; end else if (SelStart <= 1) and (Copy(Text, 1, 1) = '0') then begin SelStart := 0; SelLength := 1; end else if (SelStart = E) and (E <> 0) and (copy(Text,E + 1, 1) = '0') then SelLength := 1 else if (SelStart >= E) and (E <> 0) then begin if Abs(StrToInt(Copy(Text, E + 1, SelStart - E) + Key + Copy(Text, SelStart + 1, 99))) > 4932 then begin MessageBeep(0); Key := #0; end; end else if FDecimals > 0 then begin if (SelStart = D + FDecimals) then begin MessageBeep(0); Key := #0; end else if SelStart >= D then SelLength := 1 else if SelStart < D - 1 then SelLength := 0; end; end; procedure TPBNumEdit.Keyup(var Key: Word; Shift: TShiftState); var Numsep, NumSep0, SelStart0, X, D, N, N0 : integer; Text0 : string; begin inherited KeyUp(Key, Shift); if (SelLength > 0) then exit; if NumberFormat <> Thousands then exit; D := pos(DecimalSeparator, Text); SelStart0 := SelStart; NumSep := 0; NumSep0 := 0; Text0 := FormatText(AsFloat); for X := 1 to length(Text0) do if Text0[X] = ThousandSeparator then inc(NumSep0); for X := 1 to length(Text) do if Text[X] = ThousandSeparator then inc(NumSep); N := pos(ThousandSeparator, Text); N0 := pos(ThousandSeparator, Text0); if (NumSep <> NumSep0) or (N <> N0) or (Key in [32, 13]) then begin Text := Text0; Selstart := SelStart0 + NumSep0 - NumSep; if (pos(DecimalSeparator, Text) <> 0) and (D = 0) then Selstart := Selstart + 1 else if (D <> 0) and (pos(DecimalSeparator, Text) = 0) then Selstart := Selstart - 1; if Copy(Text, Selstart + 1, 1) = ThousandSeparator then Selstart := Selstart + 1; end; end; function TPBNumEdit.GetAsCurrency: Currency; begin Result := StrToCurr(Remove1000(Text)); end; function TPBNumEdit.GetAsFloat: Extended; begin Result := StrToFloat(Remove1000(Text)); end; function TPBNumEdit.GetAsInteger: Integer; begin Result := Trunc(StrToFloat(Remove1000(Text))); end; function TPBNumEdit.GetValue: Extended; begin Result := StrToFloat(Remove1000(Text)); end; procedure TPBNumEdit.SetAsCurrency(Value: Currency); begin if Text <> FormatText(Value) then Text := FormatText(Value); end; procedure TPBNumEdit.SetAsFloat(Value: Extended); begin if Text <> FormatText(Value) then Text := FormatText(Value); end; procedure TPBNumEdit.SetAsInteger(Value: Integer); begin if Text <> FormatText(Value) then Text := FormatText(Value); end; procedure TPBNumEdit.SetAlignment(Value: TAlignment); var SelSt, SelLe : integer; begin if FAlignment <> Value then begin SelSt := SelStart; SelLe := SelLength; FAlignment := Value; RecreateWnd; SelStart := SelSt; SelLength := SelLe; end; end; procedure TPBNumEdit.SetColor(Value : TColor); begin if FEnabledColor <> Value then begin FEnabledColor := Value; if Enabled then inherited Color := Value; if (Parent <> nil) and (FEnabledColor <> Parent.Brush.Color) then FParentColor := False; end; end; procedure TPBNumEdit.SetDisabledColor(Value : TColor); begin if FDisabledColor <> Value then begin FDisabledColor := Value; if (not Enabled) then inherited Color := Value; end; end; procedure TPBNumEdit.SetEnabled(Value : Boolean); begin inherited; if Enabled then inherited Color := FEnabledColor else inherited Color := FDisabledColor; end; procedure TPBNumEdit.SetDecimals(Value: ShortInt); var Value0 : ShortInt; begin Value0 := Value; if FDecimals <> Value0 then begin if Value0 < 0 then Value0 := -1 else if Value0 > 14 then Value0 := 14; if (Value0 > MaxLength - 2) and (MaxLength > 0) then Value0 := maxlength - 2; FDecimals := Value0; Text := FormatText(AsFloat); end; end; procedure TPBNumEdit.SetMaxValue(Value: Extended); begin if (FMaxValue <> Value) and (Value >= FminValue) then begin FMaxValue := Value; end; end; procedure TPBNumEdit.SetMinValue(Value: Extended); begin if (FMinValue <> Value) and (Value <= FmaxValue) then begin FMinValue := Value; end; end; procedure TPBNumEdit.SetParentColor(Value : Boolean); begin if FParentColor <> Value then begin FParentColor := Value; if FParentColor and (Parent <> nil) then FEnabledColor := Parent.Brush.Color; SetEnabled(Enabled); end; end; procedure TPBNumEdit.SetValue(Value: Extended); begin if csDesigning in ComponentState then begin if (Value > FMaxValue) and ((FMaxValue <> 0) or (FMinValue <> 0)) then InvalidEntry; if (Value < FMinValue) and ((FMaxValue <> 0) or (FMinValue <> 0)) then InvalidEntry; end; if Text <> FormatText(Value) then Text := FormatText(Value); end; procedure TPBNumEdit.DeleteKey(Key: Word); var P, D, E: Integer; N: Boolean; str0 : string; begin D := pos(DecimalSeparator, Text); E := pos('E', Text); if E = 0 then E := length(Text) + 1; if Key = VK_DELETE then begin P := SelStart + 1; if P > Length(Text) then Exit; if Text[P] in [ThousandSeparator, DecimalSeparator, 'E'] then inc(P); end else begin P := SelStart; if P = 0 then Exit; if Text[P] in [ThousandSeparator, DecimalSeparator, 'E'] then dec(P); end; N := (Pos('-', Text) > 0); if (P = 0) or (P > Length(Text)) then exit; str0 := ''; if (P > D) and (D <> 0) and ((P < E) or (E = 0)) then begin if FDecimals > 0 then str0 := '0'; Text := Copy(Text, 1, P - 1) + Copy(Text, P + 1,E - P - 1) + str0 + Copy(Text, E, length(Text) - E + 1); SelStart := P - 1; end else if (P = 1) and N then begin Text := Copy(Text, 2, Length(Text) - 1); if Text = '' then Text := '0'; end else if (P = 1) and ((P = D - 1) or (P = E - 1) or (P = length(Text))) then begin Text := '0' + Copy(Text, 2, Length(Text) - 1); SelStart := 1; if N then Text := '-' + Text; end else if P > 0 then begin Text := Copy(Text, 1, P - 1) + Copy(Text, P + 1, Length(Text) - P); SelStart := P - 1; if ((FNumberFormat = Scientific) or (FNumberFormat = Engineering)) and (Text[length(Text)] = 'E') then Text := Text + '0'; end; end; procedure TPBNumEdit.DeleteSelection; var X, Y, Z: Integer; begin if SelLength = 0 then exit; if SelText = Text then begin Text := FormatText(0); exit; end; Y := Length(Remove1000(SelText)); if pos(DecimalSeparator, SelText) <> 0 then dec(Y); Z := Length(SelText); SelStart := SelStart + Z; for X:= 1 to Y do begin DeleteKey(VK_BACK); end; end; procedure TPBNumEdit.InvalidEntry; begin if not (csLoading in ComponentState) then begin if Assigned(FInvalidEntry) then FInvalidEntry(Self) else begin if Value < FMinValue then Value := FMinValue else if Value > FMaxValue then Value := FMaxValue; MessageBeep(0); if CanFocus and (not (csDesigning in ComponentState)) then SetFocus; end; end; end; procedure TPBNumEdit.SetVersion(Value: String); begin { Read only! } end; procedure TPBNumEdit.WMCopy(var Message: TMessage); begin ClipBoard.AsText := Remove1000(Seltext); end; procedure TPBNumEdit.WMCut(var Message: TMessage); begin ClipBoard.AsText := Remove1000(Seltext); DeleteSelection; end; procedure TPBNumEdit.WMPaste(var Message: TMessage); var X: integer; S: String; W: Word; begin DeleteSelection; S := Clipboard.AsText; for X := 1 to Length(S) do begin W := Ord(S[X]); Perform(WM_CHAR, W, 0); end; end; procedure TPBNumEdit.SetNumberFormat(Value: TNumberFormat); begin if FNumberFormat <> Value then FNumberFormat := Value; Text := FormatText(AsFloat); end; function TPBNumEdit.ReplaceSeparators(Num : string) : string; var t : integer; begin Result := Num; for t := 1 to Length(Result) do begin if Result[t] = OldDecimalSep then Result[t] := DecimalSeparator else if Result[t] = OldThousandSep then Result[t] := ThousandSeparator; end; OldDecimalSep := DecimalSeparator; OldThousandSep := ThousandSeparator; end; function TPBNumEdit.Remove1000(Num : string): string; var t : integer; begin if (OldDecimalSep <> DecimalSeparator) or (OldThousandSep <> ThousandSeparator) then Num := ReplaceSeparators(Num); Result := ''; for t :=1 to length(Num) do begin if Num[t] <> ThousandSeparator then Result := Result + Num[t]; end; if Result = '' then Result := '0'; if Result = '-' then Result := '-0'; end; function TPBNumEdit.FormatText(Value: Extended) : string; var e0, E, D, NN, t, FD : integer; a : extended; Formatmask : string; begin if (FNumberFormat = Engineering) and (Value <> 0) then begin e0 := trunc(ln(abs(Value)) / ln(10) / 3) * 3; Result := 'E' + inttostr(e0); a := Value / StrToFloat('1' + Result); FD := 14; if a > 9 then dec(FD); if a > 99 then dec(FD); if (FD > FDecimals) and (FDecimals <> -1) then FD := FDecimals; if FDecimals < 0 then Result := formatfloat('0.' + StringOfChar('#',FD), a) + Result else if FDecimals = 0 then Result := formatfloat('0', a) + Result else Result := formatfloat('0.' + StringOfChar('0',FD), a) + Result; end else begin FormatMask := '0'; if FNumberFormat = Thousands then FormatMask := ',' + FormatMask; if FDecimals > 0 then FormatMask := FormatMask + '.' + StringOfChar('0', FDecimals) else if FDecimals < 0 then FormatMask := FormatMask + '.' + StringOfChar('#', 14); if FNumberFormat > Thousands then FormatMask := FormatMask + 'E-'; Result := FormatFloat(FormatMask, Value); E := pos('E',Result); if E = 0 then begin D := pos(DecimalSeparator, Result); if (D <> 0) then begin NN := 0; for t := 1 to D do if (Result[t] in ['0'..'9'] = True) then inc(NN); if (FDecimals = -1) then begin if FNumberFormat = Thousands then Result := FormatFloat(',0.' + StringOfChar('#',15 - NN),Value) else if FDecimals <> -1 then Result := FormatFloat('0.' + StringOfChar('#',15 - NN),Value); end else if (FDecimals > 15 - NN) then begin if FNumberFormat = Thousands then Result := FormatFloat(',0.' + StringOfChar('0',15 - NN),Value) else if FDecimals <> -1 then Result := FormatFloat('0.' + StringOfChar('0',15 - NN),Value); Result := Result + StringOfChar('0', Fdecimals -15 + NN); end; end; end; end; end; // Trap when decimalseparator or thousandseparator has changed. function TPBNumEdit.HookMainProc(var Message: TMessage) : Boolean; begin Result := False; if Message.Msg = WM_SETTINGCHANGE then PostMessage(Self.Handle, PB_SETTINGCHANGE, 0, 0); end; procedure TPBNumEdit.WMSettingchange(var Message: TMessage); begin Text := ReplaceSeparators(Text); end; procedure TPBNumEdit.CMPARENTCOLORCHANGED(var M:TMessage); begin if FParentColor and (Parent <> nil) then FEnabledColor := Parent.Brush.Color; if Parent <> nil then Invalidate; SetEnabled(Enabled); end; procedure TPBNumEdit.WMClear(var Msg : TMessage); begin if Assigned(FOnClear) then FOnClear(Self) else DeleteSelection; end; procedure TPBNumEdit.WMGetDlgCode(var Msg: TWMGetDlgCode); begin Msg.Result := DLGC_WANTCHARS or DLGC_WANTARROWS; end; procedure Register; begin RegisterComponents('Ramazan', [TPBNumEdit]); end; end.

Kod:   Kodu kopyalamak için üzerine çift tıklayın!
unit PBNumEdit; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; const PB_SETTINGCHANGE = WM_USER + 147; type TNumberFormat = (Standard, Thousands, Scientific, Engineering); TPBNumEdit = class(TCustomEdit) private FAlignment: TAlignment; FDecimals: ShortInt; FEnter, FParentColor : Boolean; FInvalidEntry: TNotifyEvent; FMaxValue: Extended; FMinValue: Extended; FNumberFormat : TNumberFormat; FVersion: String; FDisabledColor, FEnabledColor : TColor; OldDecimalSep, OldThousandSep : Char; FOnClear : TNotifyEvent; function FormatText(Value: Extended): string; function GetAsCurrency: Currency; function GetAsFloat: Extended; function GetAsInteger: Integer; function GetValue: Extended; function HookMainProc(var Message: TMessage) : Boolean; function Remove1000(Num : string): string; function ReplaceSeparators(Num : string) : string; procedure DeleteKey(Key: Word); procedure DeleteSelection; procedure SetAlignment(Value: TAlignment); procedure SetAsCurrency(Value: Currency); procedure SetAsFloat(Value: Extended); procedure SetAsInteger(Value: Integer); procedure SetColor(Value : TColor); procedure SetDisabledColor(Value : TColor); procedure SetDecimals(Value: ShortInt); procedure SetMaxValue(Value: Extended); procedure SetMinValue(Value: Extended); procedure SetNumberFormat(Value: TNumberFormat); procedure SetParentColor(Value : Boolean); procedure SetValue(Value: Extended); procedure SetVersion(Value: String); procedure WMClear(var Msg : TMessage); message WM_CLEAR; procedure WMCut(var Message: TMessage); message WM_CUT; procedure WMCopy(var Message: TMessage); message WM_COPY; procedure WMGetDlgCode(var Msg : TWMGetDlgCode); message WM_GETDLGCODE; procedure WMPaste(var Message: TMessage); message WM_PASTE; procedure WMSettingchange(var Message: TMessage); message PB_SETTINGCHANGE; procedure CMPARENTCOLORCHANGED(var M:TMessage); message CM_PARENTCOLORCHANGED; protected procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure DoEnter; override; procedure DoExit; override; procedure InvalidEntry; procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure KeyPress(var Key: Char); override; procedure Keyup(var Key: Word; Shift: TShiftState); override; procedure SetEnabled(Value : Boolean); override; procedure Loaded; override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure CreateParams(var Params: TCreateParams); override; property AsCurrency: Currency read GetAsCurrency write SetAsCurrency; property AsFloat: Extended read GetAsFloat write SetAsFloat; property AsInteger: Integer read GetAsInteger write SetAsInteger; published property Alignment: TAlignment read FAlignment write SetAlignment; {$IFNDEF VER100} property Anchors; {$ENDIF} property AutoSelect; property AutoSize; property BorderStyle; property Color : TColor read FEnabledColor write SetColor default clWindow; property DisabledColor : TColor read FDisabledColor write SetDisabledColor default clBtnFace; property Enabled : Boolean read GetEnabled write SetEnabled default True; property Ctl3D; property Decimals: ShortInt read FDecimals write SetDecimals; property DragCursor; property DragMode; property Font; property HideSelection; property MaxLength; property MaxValue: Extended read FMaxValue write SetMaxValue; property MinValue: Extended read FMinValue write SetMinValue; property NumberFormat: TNumberFormat read FNumberFormat write SetNumberFormat; property OnChange; property OnClear : TNotifyEvent read FOnClear write FOnClear; property OnClick; property OnDblClick; property OnDragDrop; property OnDragOver; property OnEndDrag; property OnEnter; property OnExit; property OnInvalidEntry: TNotifyEvent read FInvalidEntry write FInvalidEntry; property OnKeyDown; property OnKeyPress; property OnKeyUp; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnStartDrag; property ParentColor : Boolean read FParentColor write SetParentColor default False; property ParentCtl3D; property ParentFont; property ParentShowHint; property PopupMenu; property ReadOnly; property ShowHint; property TabOrder; property TabStop; property Value: Extended read GetValue write SetValue; property Version: String read FVersion write SetVersion stored False; property Visible; property Align; end; procedure Register; implementation uses Clipbrd; constructor TPBNumEdit.Create(AOwner: TComponent); begin inherited Create(AOwner); Width := 100; FAlignment := taRightJustify; FDecimals := -1; FEnter := False; FMaxValue := 0; FMinValue := 0; FNumberFormat := Standard; FVersion := '8.50.00.00'; OldDecimalSep := DecimalSeparator; OldThousandSep := ThousandSeparator; Value := 0; Text := FormatText(Value); inherited Enabled := True; inherited Color := clWindow; FEnabledColor := clWindow; FDisabledColor := clBtnFace; Application.HookMainWindow(HookMainProc); end; procedure TPBNumEdit.Loaded; begin inherited; if Enabled then inherited Color := FEnabledColor else inherited Color := FDisabledColor; end; procedure TPBNumEdit.CreateParams(var Params: TCreateParams); const Alignments: array[TAlignment] of Word = (ES_LEFT, ES_RIGHT, ES_CENTER); begin inherited CreateParams(Params); Params.Style := Params.Style or ES_MULTILINE or Alignments[FAlignment]; end; destructor TPBNumEdit.Destroy; begin Application.UnHookMainWindow(HookMainProc); inherited; end; procedure TPBNumEdit.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if (Button = mbLeft) or (ssLeft in Shift) then begin if FEnter = True then begin FEnter := False; if AutoSelect then SelectAll; end; end; inherited MouseDown(Button, Shift, X, Y); end; procedure TPBNumEdit.DoEnter; begin inherited DoEnter; if csLButtonDown in ControlState then FEnter := True; if AutoSelect then SelectAll; end; procedure TPBNumEdit.DoExit; begin Text := FormatText(Value); if ((FMinValue <> 0) or (FMaxValue <> 0)) and ((Value < FMinValue) or (Value > FMaxValue)) then InvalidEntry else inherited DoExit; end; procedure TPBNumEdit.KeyDown(var Key: Word; Shift: TShiftState); begin inherited KeyDown(Key, Shift); FEnter := False; if not ReadOnly then begin if Key in [VK_DELETE, VK_BACK] then begin if SelLength > 0 then DeleteSelection else DeleteKey(Key); Key := 0; end; end; end; procedure TPBNumEdit.KeyPress(var Key: Char); var P, D, E : Integer; N, NE : Boolean; begin inherited KeyPress(Key); if ReadOnly or (Key in [#3, #22, #24]) then exit; if not (Key in ['0'..'9', DecimalSeparator, '-', 'e', 'E']) or ((Key = DecimalSeparator) and (FDecimals = 0)) then begin MessageBeep(0); Key := #0; Exit; end; P := SelStart; D := pos(DecimalSeparator, Text); E := pos('E', Text); if Key = 'e' then Key := 'E'; if Key in [DecimalSeparator, 'E'] then SelLength := 0 else DeleteSelection; N := (Text[1] = '-'); NE := (pos('-', copy(Text, E + 1, length(Text) - E)) <> 0) and (E <> 0); if N and (SelStart = 0) then SelStart := 1; if NE and (Selstart = E + 1) then SelStart := SelStart + 1; if Key = '-' then begin if (P < E) or (E = 0) then begin if not N then begin Text := '-' + Text; SelStart := P + 1; end else begin Text := Copy(Text, 2, Length(Text) - 1); SelStart := P - 1; end; end else begin if not NE then begin Text := copy(Text, 1, E) + '-' + copy(Text, E + 1, Length(Text) - E); SelStart := P + 1; end else begin Text := copy(Text, 1, E) + copy(Text, E + 2, Length(Text) - E - 1); SelStart := P - 1; end; end; Key := #0; exit; end; if Key = DecimalSeparator then begin if D <> 0 then begin Selstart := D; Key := #0; end else if FDecimals < 0 then begin if E <> 0 then Selstart := E - 1 else Selstart := Length(Text); end; exit; end else if Key = 'E' then begin if E = 0 then SelStart := Length(Text) else begin SelStart := E; Key := #0; end; Exit; end; if (SelStart <= 2) and (Copy(Text, 2, 1) = '0') and N then begin SelStart := 1; SelLength := 1; end else if (SelStart <= 1) and (Copy(Text, 1, 1) = '0') then begin SelStart := 0; SelLength := 1; end else if (SelStart = E) and (E <> 0) and (copy(Text,E + 1, 1) = '0') then SelLength := 1 else if (SelStart >= E) and (E <> 0) then begin if Abs(StrToInt(Copy(Text, E + 1, SelStart - E) + Key + Copy(Text, SelStart + 1, 99))) > 4932 then begin MessageBeep(0); Key := #0; end; end else if FDecimals > 0 then begin if (SelStart = D + FDecimals) then begin MessageBeep(0); Key := #0; end else if SelStart >= D then SelLength := 1 else if SelStart < D - 1 then SelLength := 0; end; end; procedure TPBNumEdit.Keyup(var Key: Word; Shift: TShiftState); var Numsep, NumSep0, SelStart0, X, D, N, N0 : integer; Text0 : string; begin inherited KeyUp(Key, Shift); if (SelLength > 0) then exit; if NumberFormat <> Thousands then exit; D := pos(DecimalSeparator, Text); SelStart0 := SelStart; NumSep := 0; NumSep0 := 0; Text0 := FormatText(AsFloat); for X := 1 to length(Text0) do if Text0[X] = ThousandSeparator then inc(NumSep0); for X := 1 to length(Text) do if Text[X] = ThousandSeparator then inc(NumSep); N := pos(ThousandSeparator, Text); N0 := pos(ThousandSeparator, Text0); if (NumSep <> NumSep0) or (N <> N0) or (Key in [32, 13]) then begin Text := Text0; Selstart := SelStart0 + NumSep0 - NumSep; if (pos(DecimalSeparator, Text) <> 0) and (D = 0) then Selstart := Selstart + 1 else if (D <> 0) and (pos(DecimalSeparator, Text) = 0) then Selstart := Selstart - 1; if Copy(Text, Selstart + 1, 1) = ThousandSeparator then Selstart := Selstart + 1; end; end; function TPBNumEdit.GetAsCurrency: Currency; begin Result := StrToCurr(Remove1000(Text)); end; function TPBNumEdit.GetAsFloat: Extended; begin Result := StrToFloat(Remove1000(Text)); end; function TPBNumEdit.GetAsInteger: Integer; begin Result := Trunc(StrToFloat(Remove1000(Text))); end; function TPBNumEdit.GetValue: Extended; begin Result := StrToFloat(Remove1000(Text)); end; procedure TPBNumEdit.SetAsCurrency(Value: Currency); begin if Text <> FormatText(Value) then Text := FormatText(Value); end; procedure TPBNumEdit.SetAsFloat(Value: Extended); begin if Text <> FormatText(Value) then Text := FormatText(Value); end; procedure TPBNumEdit.SetAsInteger(Value: Integer); begin if Text <> FormatText(Value) then Text := FormatText(Value); end; procedure TPBNumEdit.SetAlignment(Value: TAlignment); var SelSt, SelLe : integer; begin if FAlignment <> Value then begin SelSt := SelStart; SelLe := SelLength; FAlignment := Value; RecreateWnd; SelStart := SelSt; SelLength := SelLe; end; end; procedure TPBNumEdit.SetColor(Value : TColor); begin if FEnabledColor <> Value then begin FEnabledColor := Value; if Enabled then inherited Color := Value; if (Parent <> nil) and (FEnabledColor <> Parent.Brush.Color) then FParentColor := False; end; end; procedure TPBNumEdit.SetDisabledColor(Value : TColor); begin if FDisabledColor <> Value then begin FDisabledColor := Value; if (not Enabled) then inherited Color := Value; end; end; procedure TPBNumEdit.SetEnabled(Value : Boolean); begin inherited; if Enabled then inherited Color := FEnabledColor else inherited Color := FDisabledColor; end; procedure TPBNumEdit.SetDecimals(Value: ShortInt); var Value0 : ShortInt; begin Value0 := Value; if FDecimals <> Value0 then begin if Value0 < 0 then Value0 := -1 else if Value0 > 14 then Value0 := 14; if (Value0 > MaxLength - 2) and (MaxLength > 0) then Value0 := maxlength - 2; FDecimals := Value0; Text := FormatText(AsFloat); end; end; procedure TPBNumEdit.SetMaxValue(Value: Extended); begin if (FMaxValue <> Value) and (Value >= FminValue) then begin FMaxValue := Value; end; end; procedure TPBNumEdit.SetMinValue(Value: Extended); begin if (FMinValue <> Value) and (Value <= FmaxValue) then begin FMinValue := Value; end; end; procedure TPBNumEdit.SetParentColor(Value : Boolean); begin if FParentColor <> Value then begin FParentColor := Value; if FParentColor and (Parent <> nil) then FEnabledColor := Parent.Brush.Color; SetEnabled(Enabled); end; end; procedure TPBNumEdit.SetValue(Value: Extended); begin if csDesigning in ComponentState then begin if (Value > FMaxValue) and ((FMaxValue <> 0) or (FMinValue <> 0)) then InvalidEntry; if (Value < FMinValue) and ((FMaxValue <> 0) or (FMinValue <> 0)) then InvalidEntry; end; if Text <> FormatText(Value) then Text := FormatText(Value); end; procedure TPBNumEdit.DeleteKey(Key: Word); var P, D, E: Integer; N: Boolean; str0 : string; begin D := pos(DecimalSeparator, Text); E := pos('E', Text); if E = 0 then E := length(Text) + 1; if Key = VK_DELETE then begin P := SelStart + 1; if P > Length(Text) then Exit; if Text[P] in [ThousandSeparator, DecimalSeparator, 'E'] then inc(P); end else begin P := SelStart; if P = 0 then Exit; if Text[P] in [ThousandSeparator, DecimalSeparator, 'E'] then dec(P); end; N := (Pos('-', Text) > 0); if (P = 0) or (P > Length(Text)) then exit; str0 := ''; if (P > D) and (D <> 0) and ((P < E) or (E = 0)) then begin if FDecimals > 0 then str0 := '0'; Text := Copy(Text, 1, P - 1) + Copy(Text, P + 1,E - P - 1) + str0 + Copy(Text, E, length(Text) - E + 1); SelStart := P - 1; end else if (P = 1) and N then begin Text := Copy(Text, 2, Length(Text) - 1); if Text = '' then Text := '0'; end else if (P = 1) and ((P = D - 1) or (P = E - 1) or (P = length(Text))) then begin Text := '0' + Copy(Text, 2, Length(Text) - 1); SelStart := 1; if N then Text := '-' + Text; end else if P > 0 then begin Text := Copy(Text, 1, P - 1) + Copy(Text, P + 1, Length(Text) - P); SelStart := P - 1; if ((FNumberFormat = Scientific) or (FNumberFormat = Engineering)) and (Text[length(Text)] = 'E') then Text := Text + '0'; end; end; procedure TPBNumEdit.DeleteSelection; var X, Y, Z: Integer; begin if SelLength = 0 then exit; if SelText = Text then begin Text := FormatText(0); exit; end; Y := Length(Remove1000(SelText)); if pos(DecimalSeparator, SelText) <> 0 then dec(Y); Z := Length(SelText); SelStart := SelStart + Z; for X:= 1 to Y do begin DeleteKey(VK_BACK); end; end; procedure TPBNumEdit.InvalidEntry; begin if not (csLoading in ComponentState) then begin if Assigned(FInvalidEntry) then FInvalidEntry(Self) else begin if Value < FMinValue then Value := FMinValue else if Value > FMaxValue then Value := FMaxValue; MessageBeep(0); if CanFocus and (not (csDesigning in ComponentState)) then SetFocus; end; end; end; procedure TPBNumEdit.SetVersion(Value: String); begin { Read only! } end; procedure TPBNumEdit.WMCopy(var Message: TMessage); begin ClipBoard.AsText := Remove1000(Seltext); end; procedure TPBNumEdit.WMCut(var Message: TMessage); begin ClipBoard.AsText := Remove1000(Seltext); DeleteSelection; end; procedure TPBNumEdit.WMPaste(var Message: TMessage); var X: integer; S: String; W: Word; begin DeleteSelection; S := Clipboard.AsText; for X := 1 to Length(S) do begin W := Ord(S[X]); Perform(WM_CHAR, W, 0); end; end; procedure TPBNumEdit.SetNumberFormat(Value: TNumberFormat); begin if FNumberFormat <> Value then FNumberFormat := Value; Text := FormatText(AsFloat); end; function TPBNumEdit.ReplaceSeparators(Num : string) : string; var t : integer; begin Result := Num; for t := 1 to Length(Result) do begin if Result[t] = OldDecimalSep then Result[t] := DecimalSeparator else if Result[t] = OldThousandSep then Result[t] := ThousandSeparator; end; OldDecimalSep := DecimalSeparator; OldThousandSep := ThousandSeparator; end; function TPBNumEdit.Remove1000(Num : string): string; var t : integer; begin if (OldDecimalSep <> DecimalSeparator) or (OldThousandSep <> ThousandSeparator) then Num := ReplaceSeparators(Num); Result := ''; for t :=1 to length(Num) do begin if Num[t] <> ThousandSeparator then Result := Result + Num[t]; end; if Result = '' then Result := '0'; if Result = '-' then Result := '-0'; end; function TPBNumEdit.FormatText(Value: Extended) : string; var e0, E, D, NN, t, FD : integer; a : extended; Formatmask : string; begin if (FNumberFormat = Engineering) and (Value <> 0) then begin e0 := trunc(ln(abs(Value)) / ln(10) / 3) * 3; Result := 'E' + inttostr(e0); a := Value / StrToFloat('1' + Result); FD := 14; if a > 9 then dec(FD); if a > 99 then dec(FD); if (FD > FDecimals) and (FDecimals <> -1) then FD := FDecimals; if FDecimals < 0 then Result := formatfloat('0.' + StringOfChar('#',FD), a) + Result else if FDecimals = 0 then Result := formatfloat('0', a) + Result else Result := formatfloat('0.' + StringOfChar('0',FD), a) + Result; end else begin FormatMask := '0'; if FNumberFormat = Thousands then FormatMask := ',' + FormatMask; if FDecimals > 0 then FormatMask := FormatMask + '.' + StringOfChar('0', FDecimals) else if FDecimals < 0 then FormatMask := FormatMask + '.' + StringOfChar('#', 14); if FNumberFormat > Thousands then FormatMask := FormatMask + 'E-'; Result := FormatFloat(FormatMask, Value); E := pos('E',Result); if E = 0 then begin D := pos(DecimalSeparator, Result); if (D <> 0) then begin NN := 0; for t := 1 to D do if (Result[t] in ['0'..'9'] = True) then inc(NN); if (FDecimals = -1) then begin if FNumberFormat = Thousands then Result := FormatFloat(',0.' + StringOfChar('#',15 - NN),Value) else if FDecimals <> -1 then Result := FormatFloat('0.' + StringOfChar('#',15 - NN),Value); end else if (FDecimals > 15 - NN) then begin if FNumberFormat = Thousands then Result := FormatFloat(',0.' + StringOfChar('0',15 - NN),Value) else if FDecimals <> -1 then Result := FormatFloat('0.' + StringOfChar('0',15 - NN),Value); Result := Result + StringOfChar('0', Fdecimals -15 + NN); end; end; end; end; end; // Trap when decimalseparator or thousandseparator has changed. function TPBNumEdit.HookMainProc(var Message: TMessage) : Boolean; begin Result := False; if Message.Msg = WM_SETTINGCHANGE then PostMessage(Self.Handle, PB_SETTINGCHANGE, 0, 0); end; procedure TPBNumEdit.WMSettingchange(var Message: TMessage); begin Text := ReplaceSeparators(Text); end; procedure TPBNumEdit.CMPARENTCOLORCHANGED(var M:TMessage); begin if FParentColor and (Parent <> nil) then FEnabledColor := Parent.Brush.Color; if Parent <> nil then Invalidate; SetEnabled(Enabled); end; procedure TPBNumEdit.WMClear(var Msg : TMessage); begin if Assigned(FOnClear) then FOnClear(Self) else DeleteSelection; end; procedure TPBNumEdit.WMGetDlgCode(var Msg: TWMGetDlgCode); begin Msg.Result := DLGC_WANTCHARS or DLGC_WANTARROWS; end; procedure Register; begin RegisterComponents('Ramazan', [TPBNumEdit]); end; end.

__________________
SusKun ve Sessiz Mürekkep...


Kullanıcı imzalarındaki bağlantı ve resimleri görebilmek için en az 20 mesaja sahip olmanız gerekir ya da üye girişi yapmanız gerekir.

  Alıntı ile Cevapla

IRCForumlari.NET Reklamlar
radyo44.com.tr
Cevapla

Etiketler
bîr, component, edit, kullanabileceğiniz, rakam, sadece, şık

Seçenekler
Stil

Yetkileriniz
Konu Acma Yetkiniz Yok
Cevap Yazma Yetkiniz Yok
Eklenti Yükleme Yetkiniz Yok
Mesajınızı Değiştirme Yetkiniz Yok

BB code is Açık
Smileler Açık
[IMG] Kodları Açık
HTML-Kodu Kapalı
Trackbacks are Kapalı
Pingbacks are Açık
Refbacks are Açık


Benzer Konular
Konu Konuyu Başlatan Forum Cevaplar Son Mesaj
Unreal CR Edit (CR JAVA Edit) toXic Unreal IRCd 0 15 Şubat 2009 19:19
Flash Component Panelleri ve Kodları Onur Flash 0 17 Ağustos 2006 01:42