Ver Mensaje Individual
  #122  
Antiguo 10-07-2013
Avatar de José Luis Garcí
[José Luis Garcí] José Luis Garcí is offline
Miembro Premium
 
Registrado: may 2003
Ubicación: Las Palmas de G.C.
Posts: 1.372
Reputación: 22
José Luis Garcí Va camino a la fama
Después de unas cuantas horas buenas os pongo el código de dos componentes que se usaran en el módulo que estamos, son iguales, uno para integer y otro para double, son Spinedit para tablas

Código Delphi [-]
//Este componente deriva de los componentes NewDbedit,´JanbuttonEdit y DbSpinEdit  y nuevas propiedades añadidas

unit NewDBSpinEdit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, DBneweditjl , mask,  DbTables, DB, DBCtrls;

type
  TNewDBSpinEdit = class(TDBNewEditJL)
  private
    FButtonUp      : TBitBtn;
    FButtonDown    : TBitBtn;
    FWidthButton  : Integer;
    FCaptionUp    : String;
    FCaptionDown  : String;
    FProportional : Boolean;
    FMinValue      : LongInt;
    FMaxValue      : LongInt;
    FIncrement    : LongInt;
    FEditorEnabled: Boolean;
    FFontButtons  : TFont;
    procedure SetGlyph(const Value: TBitmap);
    function  GetGlyph:TBitmap;
    procedure SetGlyphDown(const Value: TBitmap);
    function  GetGlyphDown:TBitmap;
    procedure autofit;
    procedure TextChanged(sender: TObject);
    procedure setCaptionUp(const Value:String);
    procedure setCaptionDown(const Value:String);
    procedure setWidthButton(const Value:Integer);
    procedure setProportional(const Value:Boolean);
    function  GetValue: LongInt;
    procedure SetValue (NewValue: LongInt);
    function  CheckValue (NewValue: LongInt): LongInt;
    procedure CMEnter(var Message: TCMGotFocus); message CM_ENTER;
    procedure CMExit(var Message: TCMExit);   message CM_EXIT;
    procedure WMPaste(var Message: TWMPaste);   message WM_PASTE;
    procedure WMCut(var Message: TWMCut);   message WM_CUT;
  protected
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure CreateWnd;override;
    function GetOnButtonUpClick: TNotifyEvent;
    function GetOnButtonDownClick: TNotifyEvent;
    procedure SetOnButtonUpClick(Value: TNotifyEvent);
    procedure SetOnButtonDownClick(Value: TNotifyEvent);
    procedure KeyPress(var Key: Char); override;
    function IsValidChar(Key: Char): Boolean; virtual;
    procedure UpClick (Sender: TObject); virtual;
    procedure DownClick (Sender: TObject); virtual;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
  published
    property OnButtonUpClick: TNotifyEvent    read GetOnButtonUpClick    write SetOnButtonUpClick;
    property OnButtonDownClick: TNotifyEvent read GetOnButtonDownClick write SetOnButtonDownClick;
    property GlyphUP      :TBitmap read GetGlyph       write SetGlyph;
    property GlyphDown    :TBitmap read GetGlyphDown   write SetGlyphDown;
    property CaptionUp     :String  read FCaptionUp     write SetCaptionUp;
    property CaptionDown   :String   read FCaptionDown  write SetCaptionDown;
    property WidthButton   :Integer read FWidthButton  write SetWidthButton   default 15;
    property Proportional :Boolean read FProportional  write SetProportional default True;
    property MaxValue      :LongInt read FMaxValue      write FMaxValue;
    property MinValue      :LongInt read FMinValue      write FMinValue;
    property Value        :LongInt read GetValue        write SetValue;
    property Increment    :LongInt read FIncrement     write FIncrement       default 1;
    property FontButtons  :TFont   read FFontButtons   write FFontButtons;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Data Controls', [TNewDBSpinEdit]);
end;

procedure TNewDBSpinEdit.WMCut(var Message: TWMCut);
begin
  if not FEditorEnabled or ReadOnly then Exit;
  inherited;
end;

procedure TNewDBSpinEdit.WMPaste(var Message: TWMPaste);
begin
  if not FEditorEnabled or ReadOnly then Exit;
  inherited;
end;

procedure TNewDBSpinEdit.WMSize(var Message: TWMSize);
begin
  inherited;
  autofit;
end;

function TNewDBSpinEdit.CheckValue(NewValue: Integer): LongInt;
begin
  Result := NewValue;
  if (FMaxValue <> FMinValue) then
  begin
    if NewValue < FMinValue then Result := FMinValue
                            else if NewValue > FMaxValue then Result := FMaxValue;
  end;
end;

procedure TNewDBSpinEdit.CMEnter(var Message: TCMGotFocus);
begin
  if AutoSelect and not (csLButtonDown in ControlState) then
    SelectAll;
  inherited;
end;

procedure TNewDBSpinEdit.CMExit(var Message: TCMExit);
begin
   inherited;
  if CheckValue (Value) <> Value then
    SetValue (Value);
end;

constructor TNewDBSpinEdit.Create(AOwner: TComponent);
begin
  inherited;
  width           :=121;
  height         :=24;
  FCaptionDown   :='q';
  FCaptionUp     :='p';
  FWidthButton   :=15;
  FontButtons     :=TFont.Create;
  with FFontButtons do
  begin
     Name         :='wingdings 3';
     Size         :=7;
  end;
  FButtonUP       :=TBitbtn.Create (self);
  with FButtonUP do
  begin
    width         :=FWidthButton;
    height       :=15;
    Font         :=FFontButtons;
    top           :=1;
    parent       :=Self;
    Caption      :=FCaptionUp;
    OnClick       :=UpClick;
  end;
  FButtonDown     :=TBitbtn.Create (self);
  with FButtonDown do
  begin
    width         :=FWidthButton;
    height       :=15;
    Font         :=FFontButtons;
    top           :=1;
    parent       :=Self;
    Caption      :=FCaptionDown;
    OnClick       :=DownClick;
  end;
  FProportional   :=True;
  ControlStyle    := ControlStyle - [csSetCaption];
  FIncrement      := 1;
  Text           :='0';
end;

destructor  TNewDBSpinEdit.Destroy;
begin
  FButtonUP.Free;
  FbuttonDown.Free;
  inherited Destroy;
end;

procedure TNewDBSpinEdit.DownClick(Sender: TObject);
begin
  if ReadOnly then MessageBeep(0) else Value := Value - FIncrement;
  EditCanModify;
end;

procedure TNewDBSpinEdit.setCaptionDown(const Value: String);
begin
   if FCaptionDown<>value then FCaptionDown:=Value;
   FButtonDown.Caption:=FCaptionDown;
end;

procedure TNewDBSpinEdit.setCaptionUp(const Value: String);
begin
   if FCaptionUp<>value then FCaptionUp:=Value;
   FButtonUp.Caption:=FCaptionUp;
end;

procedure TNewDBSpinEdit.setProportional(const Value: Boolean);
begin
   if FProportional<>value then FProportional:=Value;
end;

procedure TNewDBSpinEdit.SetValue(NewValue: Integer);
begin
   Text := IntToStr (CheckValue (NewValue));
   EditText := Text; { força update }
end;

procedure TNewDBSpinEdit.setWidthButton(const Value: Integer);
begin
   if FWidthButton<>value then FWidthButton:=Value;
   autofit;
end;

function TNewDBSpinEdit.GetOnButtonDownClick: TNotifyEvent;
begin
   Result := FButtonDown.OnClick;
end;

function TNewDBSpinEdit.GetOnButtonUpClick: TNotifyEvent;
begin
  Result := FButtonUP.OnClick;
end;

function TNewDBSpinEdit.GetValue: LongInt;
begin
  try
    Result := StrToInt (Text);
  except
    Result := FMinValue;
  end;
end;

function TNewDBSpinEdit.IsValidChar(Key: Char): Boolean;
begin
   Result := (Key in ['+', '-', '0'..'9']) or ((Key < #32) and (Key <> Chr(VK_RETURN)));
   if not FEditorEnabled and Result and ((Key >= #32) or (Key = Char(VK_BACK)) or (Key = Char(VK_DELETE))) then Result := False;
end;

procedure TNewDBSpinEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
   if Key = VK_UP then UpClick (Self) else if Key = VK_DOWN then DownClick (Self);
   inherited KeyDown(Key, Shift);
end;

procedure TNewDBSpinEdit.KeyPress(var Key: Char);
begin
  if not IsValidChar(Key) then
  begin
    Key := #0;
    MessageBeep(0)
  end;
  if Key <> #0 then inherited KeyPress(Key);
end;

procedure TNewDBSpinEdit.SetOnButtonDownClick(Value: TNotifyEvent);
begin
   FButtonDown.onClick := Value;
end;

procedure TNewDBSpinEdit.SetOnButtonUpClick(Value: TNotifyEvent);
begin
  FButtonUP.onClick := Value;
end;

procedure TNewDBSpinEdit.SetGlyph(const Value: TBitmap);
begin
  FButtonUp.Glyph.assign(Value);
end;

procedure TNewDBSpinEdit.SetGlyphDown(const Value: TBitmap);
begin
  FButtonDown.Glyph.assign(Value);
end;

function TNewDBSpinEdit.GetGlyph: TBitmap;
begin
  result:=FButtonUp.Glyph;
end;

function TNewDBSpinEdit.GetGlyphDown: TBitmap;
begin
   result:=FButtonDown.Glyph;
end;

procedure TNewDBSpinEdit.CreateWnd;
begin
  inherited;
  autofit;
end;

procedure TNewDBSpinEdit.autofit;
begin
  FbuttonUP.top:=1;
  FbuttonUP.Height :=height-6;
  FButtonUp.Font:=FFontButtons;
  if FProportional then FButtonUp.Width:=FbuttonUP.Height
                   else FButtonUp.Width:=FWidthButton;
  FbuttonUP.Left := Width-FButtonUP.width-5;
  FbuttonDown.top:=1;
  FButtonDown.Font:=FFontButtons;
  FbuttonDown.Height :=height-6;
  if FProportional then FButtonDown.Width:=FButtonDown.Height
                   else FButtonDown.Width:=FWidthButton;
  FbuttonDown.Left := 1;
  Self.Perform(EM_SETMARGINS,EC_LEFTMARGIN,(FButtonDown.Width+4));
  Self.Perform(EM_SETMARGINS,EC_RIGHTMARGIN,(FButtonUP.Width+4)*$10000);
  Self.Repaint;
end;

procedure TNewDBSpinEdit.TextChanged(sender: TObject);
begin
  Autofit;
end;

procedure TNewDBSpinEdit.UpClick(Sender: TObject);
begin
  if ReadOnly then MessageBeep(0) else
  Value := Value + FIncrement;
  EditCanModify;
end;

end.


El otro

Código Delphi [-]
//Este componente deriva de los componentes NewDbedit,´JanbuttonEdit y DbSpinEdit

unit NewDBSpinEditDouble;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, DBneweditjl , mask,  DbTables, DB, DBCtrls;

type
  TNewDBSpinEditDouble = class(TDBNewEditJL)
    private
    FButtonUp      : TBitBtn;
    FButtonDown    : TBitBtn;
    FWidthButton  : Integer;
    FCaptionUp    : String;
    FCaptionDown  : String;
    FProportional : Boolean;
    FMinValue      : Double;
    FMaxValue      : Double;
    FIncrement    : Double;
    FEditorEnabled: Boolean;
    FFontButtons  : TFont;
    FDecimals      :  Integer;
    procedure SetGlyph(const Value: TBitmap);
    function  GetGlyph:TBitmap;
    procedure SetGlyphDown(const Value: TBitmap);
    function  GetGlyphDown:TBitmap;
    procedure autofit;
    procedure TextChanged(sender: TObject);
    procedure setCaptionUp(const Value:String);
    procedure setCaptionDown(const Value:String);
    procedure setWidthButton(const Value:Integer);
    procedure setProportional(const Value:Boolean);
    function  GetValue: Double;
    procedure SetValue (NewValue: Double);
    function  CheckValue (NewValue: Double): Double;
    procedure CMEnter(var Message: TCMGotFocus); message CM_ENTER;
    procedure CMExit(var Message: TCMExit);   message CM_EXIT;
    procedure WMPaste(var Message: TWMPaste);   message WM_PASTE;
    procedure WMCut(var Message: TWMCut);   message WM_CUT;
    procedure setDecimals(const Value:Integer);
  protected
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure CreateWnd;override;
    function GetOnButtonUpClick: TNotifyEvent;
    function GetOnButtonDownClick: TNotifyEvent;
    procedure SetOnButtonUpClick(Value: TNotifyEvent);
    procedure SetOnButtonDownClick(Value: TNotifyEvent);
    procedure KeyPress(var Key: Char); override;
    function IsValidChar(Key: Char): Boolean; virtual;
    procedure UpClick (Sender: TObject); virtual;
    procedure DownClick (Sender: TObject); virtual;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
  published
    property OnButtonUpClick: TNotifyEvent    read GetOnButtonUpClick    write SetOnButtonUpClick;
    property OnButtonDownClick: TNotifyEvent read GetOnButtonDownClick write SetOnButtonDownClick;
    property GlyphUP      :TBitmap read GetGlyph       write SetGlyph;
    property GlyphDown    :TBitmap read GetGlyphDown   write SetGlyphDown;
    property CaptionUp     :String  read FCaptionUp     write SetCaptionUp;
    property CaptionDown   :String   read FCaptionDown  write SetCaptionDown;
    property WidthButton   :Integer read FWidthButton  write SetWidthButton   default 15;
    property Proportional :Boolean read FProportional  write SetProportional default True;
    property MaxValue      ouble  read FMaxValue      write FMaxValue;
    property MinValue      ouble  read FMinValue      write FMinValue;
    property Value        ouble  read GetValue        write SetValue;
    property Increment    ouble  read FIncrement     write FIncrement;
    property FontButtons  :TFont   read FFontButtons   write FFontButtons;
    property Decimals     :Integer read FDecimals      write SetDecimals;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Data Controls', [TNewDBSpinEditDouble]);
end;

procedure TNewDBSpinEditDouble.WMCut(var Message: TWMCut);
begin
  if not FEditorEnabled or ReadOnly then Exit;
  inherited;
end;
//
procedure TNewDBSpinEditDouble.WMPaste(var Message: TWMPaste);
begin
  if not FEditorEnabled or ReadOnly then Exit;
  inherited;
end;
//
procedure TNewDBSpinEditDouble.WMSize(var Message: TWMSize);
begin
  inherited;
  autofit;
end;
//
function TNewDBSpinEditDouble.CheckValue(NewValue: Double): Double;
begin
  Result := NewValue;
  if (FMaxValue <> FMinValue) then
  begin
    if NewValue < FMinValue then Result := FMinValue
                            else if NewValue > FMaxValue then Result := FMaxValue;
  end;
end;
//
procedure TNewDBSpinEditDouble.CMEnter(var Message: TCMGotFocus);
begin
  if AutoSelect and not (csLButtonDown in ControlState) then
    SelectAll;
  inherited;
end;
//
procedure TNewDBSpinEditDouble.CMExit(var Message: TCMExit);
begin
   inherited;
  if CheckValue (Value) <> Value then
    SetValue (Value);
end;

constructor TNewDBSpinEditDouble.Create(AOwner: TComponent);
begin
  inherited;
  width           :=121;
  height         :=24;
  FCaptionDown   :='q';
  FCaptionUp     :='p';
  FWidthButton   :=15;
  FontButtons     :=TFont.Create;
  with FFontButtons do
  begin
     Name         :='wingdings 3';
     Size         :=7;
  end;
  FButtonUP       :=TBitbtn.Create (self);
  with FButtonUP do
  begin
    width         :=FWidthButton;
    height       :=15;
    Font         :=FFontButtons;
    top           :=1;
    parent       :=Self;
    Caption      :=FCaptionUp;
    OnClick       :=UpClick;
  end;
  FButtonDown     :=TBitbtn.Create (self);
  with FButtonDown do
  begin
    width         :=FWidthButton;
    height       :=15;
    Font         :=FFontButtons;
    top           :=1;
    parent       :=Self;
    Caption      :=FCaptionDown;
    OnClick       :=DownClick;
  end;
  FProportional   :=True;
  ControlStyle    := ControlStyle - [csSetCaption];
  FIncrement      := 0.01;
  Text           :='0,00';
  FDecimals       :=2;
end;

destructor  TNewDBSpinEditDouble.Destroy;
begin
  FButtonUP.Free;
  FbuttonDown.Free;
  FFontButtons.Free;
  inherited Destroy;
end;

procedure TNewDBSpinEditDouble.DownClick(Sender: TObject);
begin   //para bd
  if ReadOnly then MessageBeep(0)
  else
   Value := Value - FIncrement;
  EditCanModify;
end;

procedure TNewDBSpinEditDouble.setCaptionDown(const Value: String);
begin
   if FCaptionDown<>value then FCaptionDown:=Value;
   FButtonDown.Caption:=FCaptionDown;
end;

procedure TNewDBSpinEditDouble.setCaptionUp(const Value: String);
begin
   if FCaptionUp<>value then FCaptionUp:=Value;
   FButtonUp.Caption:=FCaptionUp;
end;

procedure TNewDBSpinEditDouble.setDecimals(const Value: Integer);
begin
   if (value>4) or (Value<0)  then
   begin
      MessageBeep(1000);
      ShowMessage('Los valores de este apartado estan entre 0 y 4 decimales');
   end else  if FDecimals<>value then FDecimals:=Value;
end;
//
procedure TNewDBSpinEditDouble.setProportional(const Value: Boolean);
begin
   if FProportional<>value then FProportional:=Value;
end;
//
procedure TNewDBSpinEditDouble.SetValue(NewValue: Double);
begin
   Text := FloatToStr (CheckValue (NewValue));
   EditText := Text; { força update }
  case FDecimals of
    0:Self.Text:=FormatFloat('#0',Self.Value);
    1:Self.Text:=FormatFloat('#0.0',Self.Value);
    2:Self.Text:=FormatFloat('#0.#0',Self.Value);
    3:Self.Text:=FormatFloat('#0.##0',Self.Value);
    4:Self.Text:=FormatFloat('#0.###0',Self.Value);
  end;
end;

procedure TNewDBSpinEditDouble.setWidthButton(const Value: Integer);
begin
   if FWidthButton<>value then FWidthButton:=Value;
   autofit;
end;

function TNewDBSpinEditDouble.GetOnButtonDownClick: TNotifyEvent;
begin
   Result := FButtonDown.OnClick;
end;
//
function TNewDBSpinEditDouble.GetOnButtonUpClick: TNotifyEvent;
begin
  Result := FButtonUP.OnClick;
end;
//
function TNewDBSpinEditDouble.GetValue: Double;
begin
  try
    Result := StrToFloat (Text);
  except
    Result := FMinValue;
  end;
end;
//
function TNewDBSpinEditDouble.IsValidChar(Key: Char): Boolean;
begin
   Result := (Key in [DecimalSeparator, '+', '-', '0'..'9']) or ((Key < #32) and (Key <> Chr(VK_RETURN)));
   if not FEditorEnabled and Result and ((Key >= #32) or (Key = Char(VK_BACK)) or (Key = Char(VK_DELETE))) then Result := False;
end;
//
procedure TNewDBSpinEditDouble.KeyDown(var Key: Word; Shift: TShiftState);
begin
   if Key = VK_UP then UpClick (Self) else if Key = VK_DOWN then DownClick (Self);
   inherited KeyDown(Key, Shift);
end;
//
procedure TNewDBSpinEditDouble.KeyPress(var Key: Char);
begin
  if not IsValidChar(Key) then
  begin
    Key := #0;
    MessageBeep(0)
  end;
  if Key <> #0 then inherited KeyPress(Key);
end;
//
procedure TNewDBSpinEditDouble.SetOnButtonDownClick(Value: TNotifyEvent);
begin
   FButtonDown.onClick := Value;
end;
//
procedure TNewDBSpinEditDouble.SetOnButtonUpClick(Value: TNotifyEvent);
begin
  FButtonUP.onClick := Value;
end;
//
procedure TNewDBSpinEditDouble.SetGlyph(const Value: TBitmap);
begin
  FButtonUp.Glyph.assign(Value);
end;
//
procedure TNewDBSpinEditDouble.SetGlyphDown(const Value: TBitmap);
begin
  FButtonDown.Glyph.assign(Value);
end;
//
function TNewDBSpinEditDouble.GetGlyph: TBitmap;
begin
  result:=FButtonUp.Glyph;
end;
//
function TNewDBSpinEditDouble.GetGlyphDown: TBitmap;
begin
   result:=FButtonDown.Glyph;
end;
//
procedure TNewDBSpinEditDouble.CreateWnd;
begin
  inherited;
  autofit;
end;

procedure TNewDBSpinEditDouble.autofit;
begin
  FbuttonUP.top:=1;
  FbuttonUP.Height :=height-6;
  FButtonUp.Font:=FFontButtons;
  if FProportional then FButtonUp.Width:=FbuttonUP.Height
                   else FButtonUp.Width:=FWidthButton;
  FbuttonUP.Left := Width-FButtonUP.width-5;
  FbuttonDown.top:=1;
  FButtonDown.Font:=FFontButtons;
  FbuttonDown.Height :=height-6;
  if FProportional then FButtonDown.Width:=FButtonDown.Height
                   else FButtonDown.Width:=FWidthButton;
  FbuttonDown.Left := 1;
  case FDecimals of
    0:Self.Text:=FormatFloat('#0',Self.Value);
    1:Self.Text:=FormatFloat('#0.0',Self.Value);
    2:Self.Text:=FormatFloat('#0.#0',Self.Value);
    3:Self.Text:=FormatFloat('#0.##0',Self.Value);
    4:Self.Text:=FormatFloat('#0.###0',Self.Value);
  end;
  Self.Perform(EM_SETMARGINS,EC_LEFTMARGIN,(FButtonDown.Width+4));
  Self.Perform(EM_SETMARGINS,EC_RIGHTMARGIN,(FButtonUP.Width+4)*$10000);
  Self.Repaint;
end;

procedure TNewDBSpinEditDouble.TextChanged(sender: TObject);
begin
  Autofit;
end;
//
procedure TNewDBSpinEditDouble.UpClick(Sender: TObject);
begin
  if ReadOnly then MessageBeep(0) else
  Value := Value + FIncrement;
  EditCanModify;
end;

end.

Espero os sean de utilidad.
__________________
Un saludo desde Canarias, "El abuelo Cebolleta"
Responder Con Cita