Programa de gestión desde 0

[Casimiro Notevi]

jeje... nos falta Zipi y Zape

[[José Luis Garcí]]

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.

[[José Luis Garcí]]

Hola compañeros, estoy un poco liado y en breve se supone que saldré de viaje, intentare poneros algo más antes de irme, pero de momento aquí tenéis un cambio que hay que realizar en la tabla documentos, hay que añadir el campo

PORCENTAJEFINANCIADO POR /* POR = NUMERIC(15,4) */

[Casimiro Notevi]

El trabajo es lo primero, y más hoy en día

[[José Luis Garcí]]

Aquí subo una pantalla de como va quedando la pantalla de documentos



Como podéis ver me he basado, en la que utilizaba en mi anterior programa, pero esta ya empieza a tener sus diferencias y espero no llegar a las 3000 lineas de código como en la otra, se que pueden parecer muchas, pero hay que tener en cuenta todo lo que controlamos., no pondré el código, hasta que más o menos empiece a estar operativa, pero iré poniendo vistas de como va quedando y lo que empieza a tener operativo.

[[José Luis Garcí]]

Bueno comencemos describiendo y poniendo el código de diferentes partes, ya que el código entero no lo pondré hasta el final. Es muy probable que el código de una función o procedure vaya modificándose según avancemos, ya iré explicando por que. Lo ire haciendo en diferentes post, para que quede un poco más esquematizado.


Lo primero será la forma de llamarlo, ya hemos visto la function Acceso, que nos habré los form, según sea nuestro nivel de usuario, con lo que evitamos mayores controles de usuarios y tener que estar poniendo o quitando accesos y ademas gracias al nivel de usuario, también podemos ocultar o mostrar ciertos datos en nuestro form de una manera bastante simple.

Veamos la llamada a facturas

Código Delphi [-]
procedure TFMenu.act_V_FacturasExecute(Sender: TObject);
//------------------------------------------------------------------------------
//**************************************************************[ Facturas ]****
// Gestión de facturas apto desde nivel 6
//------------------------------------------------------------------------------
begin
    VarSTipoDocumento:='FACTURA';
    FXPAF.PC.ActivePageIndex:=0;
    FXPAF.PC2.ActivePageIndex:=0;
    Acceso(6,FXPAF);
end;

como podemos ver la linea

VarSTipoDocumento:='FACTURA';

llama a una variable del formulario FXPAF, especificando el tipo de documento que es, de esta manera especificamos que documento tenemos seleccionado, ya que como os recuerdo, dentro de la tabla manejaremos 4 tipos de documentos diferentes.

Ademas nos aseguramos de colocar los Pagecontrol en página general, ya que podemos haber cambiado de una página/documento a otra al salir y volver a entrar.

[[José Luis Garcí]]

Vamos ahora con el botón nuevo, este es el código

Código Delphi [-]
procedure TFXPAF.SbNuevoClick(Sender: TObject);
//------------------------------------------------------------------------------
//*******************************************[ Creamos un nuevo registro ]******
//------------------------------------------------------------------------------

begin
  PC.ActivePageIndex:=1;
  DSPrincipal.DataSet.Insert;
  NSESerie.Value:=1;
  if DM.IBDCONFIUSARSERIEYEAR.Value='S' then
  begin
    NSESerie.Enabled:=False;
    DBNSerie.Field.Value:=Copy(IntToStr(Ano(now)),3,4);
  end else
  begin
    NSESerie.Enabled:=True;
    DBNSerie.Field.Value:=DM.IBDCONFISERIE.AsString;
  end;
  DBNNumeroDocumento.Field.value:=VerNumeroDocumento(VarSTipoDocumento,DBNSerie.Text);
  DBNSerie.SetFocus;
end;

Como podemos ver lo primero es activar el pagecontrol en datos, abrimos inserción de registro en la tabla, ponemos el TNewSpinEdit (NSESerie) en value a 1*, y pasamos a comprobar si en configuración hemos dicho de usar el año como serie, si es así cogemos los 2 últimos dígitos del año en curso, en caso contrario cogemos el valor de la serie por defecto que es la del campo Serie de la tabla de configuración, hecho esto pasamos a mostrar el número de documento perteneciente y pasamos el foco.

* este componente lo activamos o desactivamos ya que su uso es solo para poder elegir entre los tres seriales, por lo que si usamos el año como serie no nos es útil.

También hacemos un llamada a nuestra function VerNumeroDocumento, aquí su código.

Código Delphi [-]
function TFXPAF.VerNumeroDocumento(Tipo, Serie:string):string;
//------------------------------------------------------------------------------
//*****************************************************[ VerNumeroDocumento]****
//  Funcion para este módulo
//------------------------------------------------------------------------------
var  VarILargoSerie, VarINumero:Integer;
begin
  VarILargoSerie:=Length(Serie);
  if Tipo='FACTURA' then if DM.IBDCONFINUMEROFACTURA.Text='0' then VarINumero:=1 else VarINumero:=dm.IBDCONFINUMEROFACTURA.AsInteger+1;
  if Tipo='ALBARAN' then if DM.IBDCONFINUMEROALBARAN.Text='0' then VarINumero:=1 else VarINumero:=dm.IBDCONFINUMEROALBARAN.AsInteger+1;
  if Tipo='PEDIDO'  then if DM.IBDCONFINUMEROPEDIDO.Text='0' then VarINumero:=1 else VarINumero:=dm.IBDCONFINUMEROPEDIDO.AsInteger+1;
  if Tipo='PRESUPUESTO' then if DM.IBDCONFINUMEROPRESUPUESTO.Text='0' then VarINumero:=1 else VarINumero:=dm.IBDCONFINUMEROPRESUPUESTO.AsInteger+1;
  Result:=ceros(IntToStr(VarINumero),dm.IBDCONFILAGONUMEROS.Value-VarILargoSerie)
end;

El primer parámetro que le pasamos es el valor de nuestra variable que nos indica el tipo de documento y que la cargamos al entrar desde el menú o otro lado al documento, el segundo es la serie. Esta function lo que hace es comprobar el numerador de cada tipo de documento, si es cero cargamos como 1, en caso contrario, sera el número actual más 1, al devolvernos el resultado, nos aseguramos que nos lo devuelva relleno de ceros a la izquierda, y descontamos los espacios que va a ocupar la serie.

[[José Luis Garcí]]

Pongo nueva mente la imagen del formulario para ir orientándonos



Estamos en el campo serie, al lado esta el spinedit, que activamos o desactivamos, según nos es necesario, de aqui pasamos al número de documento que tiene los dos siguientes eventos,

Código Delphi [-]
procedure TFXPAF.DBNNumeroDocumentoChange(Sender: TObject);
//------------------------------------------------------------------------------
//********************************************[ Cambia el  nº de documento ]****
//------------------------------------------------------------------------------
begin
  LAbel44.Caption:='[ '+Trim(DBNSerie.Text)+DBNNumeroDocumento.Text+' ]';
end;

procedure TFXPAF.DBNNumeroDocumentoExit(Sender: TObject);
// ------------------------------------------------------------------------------
// ***************************************************[ Salir del Núm. Doc. ]****
// Muestra el número de documento
// ------------------------------------------------------------------------------
begin
  if not (DsPrincipal.DataSet.State in [dsEdit]) then
  begin
     ActQuery(IBQBuscarNumeroDocumento,'Select * From DOCUMENTOS where WHERE (DOCUMENTOS.TIPODOCUMENTO = '+QuotedStr(VarSTipoDocumento)+
                 ') AND (DOCUMENTOS.NUMERODOCUMENTO = '+QuotedStr(DBNNumeroDocumento.Text) +
                 ') AND (DOCUMENTOS.SERIE = '+QuotedStr(DBNSerie.Text)+')');
    if not IBQBuscarNumeroDocumento.IsEmpty then
    begin
      ShowMessage('Este número de documento ya existe');
      DBNNumeroDocumento.SetFocus;
    end;
  end;
end;

El 1º de los eventos, nuestra como queda el número de documento con la serie, el 2º evento crea una búsqueda en un querry para comprobar si el documento ya existe, para ello debemos comprobar, el tipo de documento, el número, asignado y la serie ala que pertenece, ya que recordemos, que es la misma tabla para varios documentos diferentes.
pasamos a la fecha, que al usar el componente DbNewEditJl y estar en Onlydate, controla que sea una fecha válida, nos permite que al entrar tenga la fecha actual y que podamos cambiar la fecha pulsando flecha arriba o abajo.

[[José Luis Garcí]]

Seguimos entrando en el código del cliente, que tiene los siguientes 3 eventos

Código Delphi [-]
procedure TFXPAF.DBNCodigoClienteChange(Sender: TObject);
// ------------------------------------------------------------------------------
// ********************************************************[ Change Cod Cli ]****
// Para posicionar en el cliente
// ------------------------------------------------------------------------------
begin
  if FXPAF.Active then
  begin
    if DBNCodigoCliente.Text <> '' then
    begin
        ActQuery(IBQClientes, 'Select * from Clientes where Upper(CODIGO)=Upper(' + QuotedStr (DBNCodigoCliente.Text) + ')');
    end;
  end;
end;


procedure TFXPAF.DBNCodigoClienteEnter(Sender: TObject);
// ------------------------------------------------------------------------------
// ****************************************************[ entrar en clientes ]****
// ------------------------------------------------------------------------------
begin
   SBClientesClick(Sender);
end;


procedure TFXPAF.DBNCodigoClienteExit(Sender: TObject);
// ------------------------------------------------------------------------------
// *************************************************[ Salir de cód. cliente ]****
// ------------------------------------------------------------------------------
begin
  if DBNCodigoCliente.Text = '' then
  begin
    ShowMessage('Este campo no puede quedar vacio, por favor rellene l campo [Código de cliente]');
    DBNCodigoCliente.SetFocus;
  end else
  begin
     if UpperCase(DBNCodigoCliente.Text)='B' then SBBuscarClienteClick(Sender) else
     begin
       if IBQClientes.IsEmpty then
       begin
          Case Application.MessageBox(pchar(  'El cliente búscado no se encuntra, ¿desea crearlo?'),
                                      pchar('No se encuentra el cliente'),4+32+0) of
           6:SBNuevoClienteClick(Sender);       //Si
           7BNCodigoCliente.SetFocus;       //No
          end;
       end else
       begin
          //Descripción del cliente
          if DBNNombreCliente.Text='' then DBNNombreCliente.Field.Value:=IBQClientesNOMBRE.Value else
          begin
             if DBNNombreCliente.Text<>IBQClientesNOMBRE.AsString then
             begin
                Case Application.MessageBox( pchar(  'El nombre de este cliente y el que tiene puesto no coinciden,            ¿desea cambiarlo por el nombre que tiene asignado este código?'),
                                              pchar('Datos diferentes'),4+64+0) of
                   6BNNombreCliente.Field.Value:=IBQClientesNOMBRE.Value;       //Si
                end;
             end;
          end;
          //Forma de pago
          if DBNFormaPago.Text='' then DBNFormaPago.Field.Value:=IBQClientesFORMAPAGO.Value else
          begin
             if DBNFormaPago.Text<>IBQClientesFORMAPAGO.AsString then
             begin
                Case Application.MessageBox( pchar(  'La forma de pago de este cliente y el que tiene puesta no coinciden,            ¿desea cambiarlo por la que tiene asignado este código?'),
                                              pchar('Datos diferentes'),4+64+0) of
                   6BNFormaPago.Field.Value:=IBQClientesFORMAPAGO.Value;       //Si
                end;
             end;
          end;
       end;
     end;
  end;
end;

En el 1º evento, comprobamos que el form este activo, para evitar errores y si el código del cliente no esta vació, creamos una búsqueda con un querry, esta nos permitirá tener otros datos a la vista del cliente, tanto en los siguientes campos, como en la pagecontrol de datos extendidos (PC3).
En el 2º evento, colocamos los datos visibles del cliente en el PC3.
y en el 3º evento, hacemos varias cosas, primero que no se quede vació, en caso contrario si hemos puesto una B únicamente llamamos al módulo de búsqueda para el cliente, en caso contrario al de la búsqueda, comprobamos si existe, si no es asi nos avisa y posiciona nuevamente, en caso de que exista, comprueba si ya tenemos relleno uina descripción o forma de pago del cliente, si no existe la pone y si existe comprueba si cuadra con la que tiene el cliente, en caso de ser diferentes, nos da la opción de modificarla por la que tiene el cliente o mantener la que ya tiene.

Pasaríamos al Nombre del cliente, este campo ha de ser editable y guardado independiente al del la tabla clientes, imaginemos el siguiente caso, tenemos el cliente código 0 (contado) y en un día de reparto tenemos 3 clientes con este código, en cambio podríamos editar en cada documento con Contado, Juan, Contado limpiadora Hotel XXXxxx, etc.

De aquí pasamos a la forma de pago que pasa con lo mismo que con el nombre del cliente, el caso típico es un cliente que tiene una forma de pago x y quiere en una factura determinada pagarla de contado.

En cuanto alos botones de nuevos y búsqueda, ya los veremos más adelante.

Creo que ya es bastante por hoy.

[[José Luis Garcí]]

Pequeñas correcciones en

Código Delphi [-]

procedure TFXPAF.DBNCodigoClienteExit(Sender: TObject);
//...  Cambiar 
    ShowMessage('Este campo no puede quedar vacio, por favor rellene l campo [Código de cliente]');
//...por 
   ShowMessage('Este campo no puede quedar vacio, por favor rellene el campo [Código de cliente]');

y en

Código Delphi [-]
procedure TFXPAF.DBNNumeroDocumentoExit(Sender: TObject);

//...Cambiar 
     ActQuery(IBQBuscarNumeroDocumento,'Select * From DOCUMENTOS where WHERE (DOCUMENTOS.TIPODOCUMENTO = '+QuotedStr(VarSTipoDocumento)+
                 ') AND (DOCUMENTOS.NUMERODOCUMENTO = '+QuotedStr(DBNNumeroDocumento.Text) +
                 ') AND (DOCUMENTOS.SERIE = '+QuotedStr(DBNSerie.Text)+')');
//...por 
      ActQuery(IBQBuscarNumeroDocumento,'Select * From DOCUMENTOS WHERE (DOCUMENTOS.TIPODOCUMENTO = '+QuotedStr(VarSTipoDocumento)+
                 ') AND (DOCUMENTOS.NUMERODOCUMENTO = '+QuotedStr(DBNNumeroDocumento.Text) +
                 ') AND (DOCUMENTOS.SERIE = '+QuotedStr(DBNSerie.Text)+')');

Os pido disculpas pues he visto varias faltas de ortografía, pero es el corrector de texto, que no se que problema tiene pero ha incluido varias palabras en el diccionario y me las cambia automáticamente, ya por defecto escribo y suele comerme o poner alguna letra demás y se que cometo varias faltas ortográficas.

[[José Luis Garcí]]

Supongo va quedando todo claro, ya que no veo preguntas, ni a nadie con la antorcha corriendo detrás de mi .

Por cierto espero vuestras valoraciones

[[José Luis Garcí]]

Ahora seguimos con el comercial o agente, comenzamos con el código del comercial con los siguientes tres eventos

Código Delphi [-]

procedure TFXPAF.DBNCodigoComercialChange(Sender: TObject);
// ------------------------------------------------------------------------------
// **************************************************[ Change Cod Comercial ]****
// ------------------------------------------------------------------------------
begin

  if FXPAF.Active then
  begin
    if DBNCodigoComercial.Text <> '' then
    begin
        ActQuery(IBQAgentes, 'Select * from EMPLEADOS where (EMPLEADOS.AGENTE = '+QuotedStr('S')+') AND (Upper(EMPLEADOS.CODIGO)=Upper('+
                             QuotedStr(DBNCodigoComercial.Text) + '))');
    end;
  end;
end;

procedure TFXPAF.DBNCodigoComercialEnter(Sender: TObject);
// ------------------------------------------------------------------------------
// *************************************************[ entrar en comerciales ]****
// ------------------------------------------------------------------------------
begin
   SBComercialesClick(Sender);
end;

procedure TFXPAF.DBNCodigoComercialExit(Sender: TObject);
// ------------------------------------------------------------------------------
// ***********************************************[ Salir de cód. Comercial ]****
// ------------------------------------------------------------------------------
begin
  if DBNCodigoComercial.Text = '' then
  begin
    ShowMessage('Este campo no puede quedar vacio, por favor rellene el campo [Código de ccomercial]');
    DBNCodigoComercial.SetFocus;
  end else
  begin
     if UpperCase(DBNCodigoComercial.Text)='B' then SBBuscarAgenteClick(Sender) else
     begin
       if IBQAgentes.IsEmpty then
       begin
          Case Application.MessageBox(pchar(  'El comercial buscado no se encuentra, ¿desea crearlo?'),
                                      pchar('No se encuentra el comercial'),4+32+0) of
           6:SBNuevoAgenteClick(Sender);       //Si
           7BNCodigoComercial.SetFocus;       //No
          end;
       end else
       begin  //Descripción del c
          if DBNNombreComercial.Text='' then DBNNombreComercial.Field.Value:=IBQAgentes.FieldByName('NOMBRE').Value else
          begin
             if DBNNombreComercial.Text<>IBQAgentes.FieldByName('NOMBRE').AsString then
             begin
                Case Application.MessageBox( pchar(  'El nombre de este comercial y el que tiene puesto no coinciden,            ¿desea cambiarlo por el nombre que tiene asignado este código?'),
                                              pchar('Datos diferentes'),4+64+0) of
                   6BNNombreComercial.Field.Value:=IBQagentes.FieldByName('NOMBRE').Value;       //Si
                end;
             end;
          end;
       end;
     end;
  end;
end;

El 1º evento, como podemos ver el primero según escribimos, nos va buscando el agente, pero sólo si es un agente ya que esta en la misma tabla que el resto de empleados
El 2º evento, posiciona la pestaña de datos auxiliares en los datos del comercial
Y el 3º evento, comprueba a la salida , si no esta vacio, si debemos buscarlo y si no tiene datos el campo nombre lo rellena y si lo tiene pero es diferente, nos pregunta si deseamos cambiarlo.

[[José Luis Garcí]]

Ups!, se me olvidó en la tabla de empleados, el campo NIF, lo tendréis que añadir

NIF T20 /* T20 = VARCHAR(20) */

[[José Luis Garcí]]

Tenemos que cambiar un procedure, de los anteriores por este

Código Delphi [-]
procedure TFXPAF.DBNCodigoComercialChange(Sender: TObject);
// ------------------------------------------------------------------------------
// **************************************************[ Change Cod Comercial ]****
// ------------------------------------------------------------------------------
begin
  if FXPAF.Active then
  begin
    if DBNCodigoComercial.Text <> '' then
    begin
        ActQuery(IBQAgentes, 'Select * from EMPLEADOS where (EMPLEADOS.AGENTE = '+QuotedStr('S')+') AND (Upper(EMPLEADOS.CODIGO)=Upper('+
                             QuotedStr(DBNCodigoComercial.Text) + '))');
        if Not IBQAgentes.IsEmpty then ActQuery(IBQAgenteIMAGEN, 'Select * from PC where (PC.MODULO = '+QuotedStr('EMPLEADOS')+') AND (Upper(PC.CODIGO)=Upper('+
                                                                  QuotedStr(DBNCodigoComercial.Text) + '))');
    end;
  end;
end;

ya que si no no podíamos mostrar la imagen del comercial

[[José Luis Garcí]]

Este es el evento para cuando cambiamos de ´numero de serie, al lado de la serie, se me había pasado

Código Delphi [-]
procedure TFXPAF.NSESerieChange(Sender: TObject);
//------------------------------------------------------------------------------
//***************************************************[ Cambiar la serie ]*******
//------------------------------------------------------------------------------
begin
   case NSESerie.Value of
      1BNSerie.Field.Value:=DM.IBDCONFISERIE.Value;
      2BNSerie.Field.Value:=DM.IBDCONFISERIE2.Value;
      3BNSerie.Field.Value:=DM.IBDCONFISERIE3.Value;
   end;
end;

[[José Luis Garcí]]

Otra modificación esta vez en SbNuevoClick

Código Delphi [-]
procedure TFXPAF.SbNuevoClick(Sender: TObject);
//------------------------------------------------------------------------------
//*******************************************[ Creamos un nuevo registro ]******
//------------------------------------------------------------------------------
begin
  ...
  NDBSENumeroProteccionDatos.Field.Value:=1;  //añadimos esta linea antes de 
  DBNNumeroDocumento.Field.value:=VerNumeroDocumento(VarSTipoDocumento,DBNSerie.Text);
  DBNSerie.SetFocus;
end;

[[José Luis Garcí]]

Cambios en mis componentes spinedit en el create, dentro de la creación de lo botones añadimos a cada uno la siguiente linea

Código Delphi [-]
TabStop       :=False;

Con esto evitamos que los botones UP y Down, reciban el foco.

Pongo el código del create de uno de ellos, sabéis lo que tenéis que hacer para cambiarlos en los demás

Código Delphi [-]

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;
    OnKeyPress   :=Self.OnKeyPress;
    OnKeyDown     :=Self.OnKeyDown;
    TabStop       :=False;
  end;
  FButtonDown     :=TBitbtn.Create (self);
  with FButtonDown do
  begin
    width         :=FWidthButton;
    height       :=15;
    Font         :=FFontButtons;
    top           :=1;
    parent       :=Self;
    Caption      :=FCaptionDown;
    OnClick       :=DownClick;
    OnKeyPress   :=Self.OnKeyPress;
    OnKeyDown     :=Self.OnKeyDown;
    TabStop       :=False;
  end;
  FProportional   :=True;
  ControlStyle    := ControlStyle - [csSetCaption];
  FIncrement      := 1;
  Text           :='0';
end;

[[José Luis Garcí]]

Claro esta también debemos adapta el evento KEypress de nuestro formulario

Código Delphi [-]
procedure TFXPAF.FormKeyPress(Sender: TObject; var Key: Char);
//------------------------------------------------------------------------------
//************************************************[  Al pulsar una tecla ]******
// Al pulsar la tecla salta al foco del siguiente componente, si esta admitido
//------------------------------------------------------------------------------
begin
    if (Key = #13) then {Si se ha pulsado enter }
    if (ActiveControl is TEdit)
    or (ActiveControl is TDBEdit)
    or (ActiveControl is TDBNewEditJL)
    or (ActiveControl is TNewDBSpinEdit)
    or (ActiveControl is TNewDBSpinEditDouble)
    or (ActiveControl is TDBComboBox) then
    begin
      Key := #0; { anula la puulsación }
      Perform(WM_NEXTDLGCTL, 0, 0); { mueve al próximo control }
    end;
end;

[[José Luis Garcí]]

y ya por último hoy el siguiente evento

Código Delphi [-]
procedure TFXPAF.NDBSENumeroProteccionDatosChange(Sender: TObject);
//------------------------------------------------------------------------------
//********************************************************[ Cambia la LOPD ]****
// Cambiamos la ley de protección de datos.
//------------------------------------------------------------------------------
begin
   if FXPAF.Active then
   begin
      if NDBSENumeroProteccionDatos.Text='' then NDBSENumeroProteccionDatos.Value:=1;
      if not ((NDBSENumeroProteccionDatos.Value<1) or (NDBSENumeroProteccionDatos.Value>3)) then
      begin
        Memo1.Lines.Clear;
        case NDBSENumeroProteccionDatos.Value of
           1:Memo1.Lines.Text:=DM.IBDCONFILDPD1.AsString;
           2:Memo1.Lines.Text:=DM.IBDCONFILDPD2.AsString;
           3:Memo1.Lines.Text:=DM.IBDCONFILDPD3.AsString;
        end;
      end else
      begin
         if (DSPrincipal.DataSet.State in [dsEdit,dsInsert])  then
         begin
          ShowMessage('El rango sólo esta permitido entre 1 y 3');
          NDBSENumeroProteccionDatos.SetFocus;
         end;
      end;
   end;
end;

[[José Luis Garcí]]

Pido disculpas por tantas rectificaciones, pero es que según voy haciendo en caso lo voy subiendo, muchas veces sin haber probado el código primero