Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   Varios (https://www.clubdelphi.com/foros/forumdisplay.php?f=11)
-   -   Programa de gestión desde 0 (https://www.clubdelphi.com/foros/showthread.php?t=83457)

Casimiro Notevi 09-07-2013 23:18:49

jeje... nos falta Zipi y Zape :)

José Luis Garcí 10-07-2013 18:14:03

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      :Double  read FMaxValue      write FMaxValue;
    property MinValue      :Double  read FMinValue      write FMinValue;
    property Value        :Double  read GetValue        write SetValue;
    property Increment    :Double  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í 16-07-2013 09:18:26

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

Cita:

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

Casimiro Notevi 16-07-2013 09:57:29

El trabajo es lo primero, y más hoy en día ^\||/

José Luis Garcí 16-07-2013 11:59:24

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í 18-07-2013 11:08:00

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

Cita:

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í 18-07-2013 11:30:51

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í 18-07-2013 12:22:25

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í 18-07-2013 13:16:53

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
           7:DBNCodigoCliente.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
                   6:DBNNombreCliente.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
                   6:DBNFormaPago.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í 18-07-2013 13:25:54

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í 18-07-2013 17:20:39

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

Por cierto espero vuestras valoraciones

José Luis Garcí 20-07-2013 13:13:50

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
           7:DBNCodigoComercial.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
                   6:DBNNombreComercial.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í 20-07-2013 13:16:33

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

Cita:

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

José Luis Garcí 20-07-2013 15:19:15

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í 20-07-2013 15:44:16

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
      1:DBNSerie.Field.Value:=DM.IBDCONFISERIE.Value;
      2:DBNSerie.Field.Value:=DM.IBDCONFISERIE2.Value;
      3:DBNSerie.Field.Value:=DM.IBDCONFISERIE3.Value;
   end;
end;

José Luis Garcí 20-07-2013 16:25:58

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í 20-07-2013 16:43:32

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í 20-07-2013 16:45:39

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í 20-07-2013 16:46:57

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í 20-07-2013 16:48:28

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 :o

José Luis Garcí 21-07-2013 12:11:03

Vamos a hora por el botón "Escribir nota" con el siguiente código

Código Delphi [-]
procedure TFXPAF.SBEscribirNotaClick(Sender: TObject);
//------------------------------------------------------------------------------
//******************************************************************[ Nota ]****
//------------------------------------------------------------------------------
var VarSText:string;
begin
   VarSText:=DBIBMemo2.Lines.Text;
   DBIBMemo2.Lines.Text:=InputMemo('Nota','Escriba su nota',VarSText);
end;

y como no estoy seguro de si puse esta function aquí os la pongo

Código Delphi [-]
//------------------------------------------------------------------------------
//*************************************************************[ ImputMemo ]****
//  Parte de la idea original de   Felipe Monteiro  del 25/05/2006
// bajada de http://www.planetadelphi.com.br/dica...tbox-com-combo)
//------------------------------------------------------------------------------
// J.L.G.T. 06/08/2012 Basando me en el código de Felipe Monteiro , lo adapte a
// mis necesidades, creando un imput para entradas en memo
//------------------------------------------------------------------------------
//  [Acaption]       String     Texto en la barra del caption
//  [Aprompt]        String     Texto aclaratorio para elmensaje o petición
//  [Text]           String     Texto del MEmo
//------------------------------------------------------------------------------
//---EJEMPLO--------------------------------------------------------------------
//  procedure TForm1.Button1Click(Sender: TObject);
//  begin
//     DBMEMO1.lines.text:=InputMemo('Comentario con fecha','Comentario');
//  end;
//------------------------------------------------------------------------------
function InputMemo(const ACaption, APrompt: string; Text:String =''): string;
  function GetCharSize(Canvas: TCanvas): TPoint;
  var
    I: Integer;
    Buffer: array[0..51] of Char;
  begin
    for I := 0 to 25 do Buffer[i] := Chr(I + Ord('A'));
    for I := 0 to 25 do Buffer[I + 26] := Chr(I + Ord('a'));
    GetTextExtentPoint(Canvas.Handle, Buffer, 52, TSize(Result));
    Result.X := Result.X div 52;
  end;

var
  Form: TForm;
  Prompt: TLabel;
  MEM: TMemo;
  DialogUnits: TPoint;
  ButtonTop, ButtonWidth, ButtonHeight: Integer;
  R: TRect;
begin
  Result := '';
  Form   := TForm.Create(Application);
  with Form do
    try
      Canvas.Font     := Font;
      DialogUnits     := GetCharSize(Canvas);
      BorderStyle     := bsDialog;
      FormStyle        :=fsStayOnTop;
      Caption         := ACaption;
      ClientWidth     := MulDiv(396, DialogUnits.X, 4);
      Position        := poScreenCenter;
      Prompt          := TLabel.Create(Form);
      with Prompt do
      begin
        Parent   := Form;
        Caption  := APrompt;
        Left     := MulDiv(8, DialogUnits.X, 4);
        Top      := MulDiv(8, DialogUnits.Y, 8);
        Constraints.MaxWidth := MulDiv(180, DialogUnits.X, 4);
        WordWrap := True;
      end;
      MEM := TMemo.Create(Form);
      with MEM do
      begin
        Parent         := Form;
        Left          := Prompt.Left;
        Top           := Prompt.top+Prompt.Height+5;
        Height        := 150;
        Width         := MulDiv(380, DialogUnits.X, 4);
        Lines.Text    := Text;
      end;
      ButtonTop    := MEM.top+MEM.Height+10;;
      ButtonWidth  := MulDiv(50, DialogUnits.X, 4);
      ButtonHeight := MulDiv(14, DialogUnits.Y, 8);
      with TButton.Create(Form) do
      begin
        Parent      := Form;
        Caption     := 'OK';
        ModalResult := mrOk;
        default     := True;
        SetBounds(MulDiv(Prompt.Left-2, DialogUnits.X, 4), ButtonTop, ButtonWidth,
          ButtonHeight);
      end;
      with TButton.Create(Form) do
      begin
        Parent      := Form;
        Caption     := 'Cancelar';
        ModalResult := mrCancel;
        Cancel      := True;
        SetBounds(MulDiv(340, DialogUnits.X, 4), ButtonTop,ButtonWidth, ButtonHeight);
        Form.ClientHeight := 220;
      end;
      MEM.Lines.Clear;
      MEM.Lines.Add(Text);
      if ShowModal = mrOk then Result:=MEM.Lines.Text
                          else Result:=Text;   //Devuelve el original
    finally
      Form.Free;
    end;
end;

Ahora pasamos al desglose de la factura, explicare la función de algunos botones, el resto son iguales a los de siempre

José Luis Garcí 21-07-2013 13:22:04

Otra modificación

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

begin
  ...
  Memo2.Lines.Clear;
  DBNSerie.SetFocus;
end;

José Luis Garcí 21-07-2013 13:23:13

y otra

Código Delphi [-]
procedure TFXPAF.SBEscribirNotaClick(Sender: TObject);
//------------------------------------------------------------------------------
//******************************************************************[ Nota ]****
//------------------------------------------------------------------------------
var VarSText:string;
begin
   VarSText:=Memo2.Lines.Text;
   Memo2.Lines.Text:=InputMemo('Nota','Escriba su nota',VarSText);
end;

José Luis Garcí 21-07-2013 14:51:45

más y más modificaciones

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) + ')');
        if not IBQDirecciones.isempty then ActQuery(IBQDirecciones,'SELECT * FROM DIRECCIONES WHERE (DIRECCIONES.MODULO = '+
                                                    QuotedStr ('CLIENTES')+') AND (DIRECCIONES.CODIGO = '+QuotedStr (DBNCodigoCliente.Text)+')');
    end;
  end;
end;

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;
  NDBSENumeroProteccionDatos.Field.Value:=1;
  DBNNumeroDocumento.Field.value:=VerNumeroDocumento(VarSTipoDocumento,DBNSerie.Text);
  DSPrincipal.DataSet.FieldByName('PORCENTAJEFINANCIADO').Value:=0;
  DSPrincipal.DataSet.FieldByName('TIPODOCUMENTO').Value:=VarSTipoDocumento;
  Memo2.Lines.Clear;
  DBNSerie.SetFocus;
end;

kokorski 21-07-2013 16:10:04

Gracias por tu esfuerzo que te aseguro seguimos muchos con interes

José Luis Garcí 22-07-2013 09:29:22

Muchas gracias Kokorski, pero si quieres ayudarme haz una valoración del tutorial como solicito en post anteriores, esto me permitirá, junto con la valoración de otros compañeros, a mejorar mis puntos débiles como ya exprese en el siguiente post

Cita:

Empezado por José Luis Garcí (Mensaje 463323)
Si no es molestia, podrían hacerme el favor de valorar el trabajo hasta este momento, lo más sinceramente posible, el motivo, es que como siempre he dicho y he mantenido, yo no soy un experto y necesito saber cuales son mis puntos fuertes, para intentar mejorar.

Me gustaría que lo valorarais de la siguiente manera, del 1 al 10, siendo 1 la menor valoración claro, cada una de las siguientes facetas, y si se os ocurre alguna, ya sabéis.

Explicaciones
Claridad
Código
Tablas
Descripciones
Diseño
Conceptos
forma de aplicar los conceptos
y utilidad

Esto me permitirá, en cuanto al tutorial, intentar corregir y mejorarlo , si puedo y ha nivel personal, seguir aprendiendo y como no autoestima, que me la podéis hundir más :D :D :D o nivelar :rolleyes:

En las empresas que he estado muchos años, siempre e hecho los programas, de hecho en algunas siguen usándolo, pero realmente no se si tengo nivel suficiente como para dedicarme a la venta de programas, al público en general, este cuestionario, sería un serio indicativo, de si es o no posible que me dedique a ello de manera esporádica.

kokorski 22-07-2013 20:13:10

Cita:

Empezado por José Luis Garcí (Mensaje 464234)
Muchas gracias Kokorski, pero si quieres ayudarme haz una valoración del tutorial como solicito en post anteriores, esto me permitirá, junto con la valoración de otros compañeros, a mejorar mis puntos débiles como ya exprese en el siguiente post



En las empresas que he estado muchos años, siempre e hecho los programas, de hecho en algunas siguen usándolo, pero realmente no se si tengo nivel suficiente como para dedicarme a la venta de programas, al público en general, este cuestionario, sería un serio indicativo, de si es o no posible que me dedique a ello de manera esporádica.

No me cabe duda de que estas sobradamente preparado para afrontar cualquier iniciativa, y mas si es dirigida al publlico en general, nada lo demuestra mejor que este aporte que nos estas haciendo a todos de forma desinteresada. No dudes de tu capacidad y adelante con todo....

Explicaciones....... 8
Claridad ........ 8
Código ....... 7
Tablas ...... 7
Descripciones ...... 8
Diseño ........ 5 (esto es muy personal jejeje)
Conceptos ......... 9
forma de aplicar los conceptos ........ 8
y utilidad ...... dependera de cada uno

Saludos

Casimiro Notevi 22-07-2013 20:44:09

Cita:

Empezado por José Luis Garcí (Mensaje 464234)
pero realmente no se si tengo nivel suficiente como para dedicarme a la venta de programas, al público en general, este cuestionario, sería un serio indicativo, de si es o no posible que me dedique a ello de manera esporádica.

A la venta, seguro que puedes dedicarte :)
Supongo que quieres decir "a crearlos para venderlos". Si es así, entonces sí que puedes, el usuario final sólo quiere que haga bien lo que tiene que hacer, que lo haga rápido y que sea fácil de hacerlo. Y si es barato, mejor :)
Ahora bien, si lo dices por entrar a formar parte de un equipo de programación, pienso que lo principal que tendrías que cambiar es a usar la nomenclatura que utilicen en ese sitio. En algunos sitios son más estrictos y en otros son más abiertos a que cada uno use su forma habitual.
Ya sabes, la nomenclatura, la notación para las variables, componentes, etc., la forma de escribir el código, incluso los espacios de tabulación para las sangrías del código. Pero todo eso es informarse y usarlo, nada más.
En cuanto a la estética, como siempre, te tienes que habituar a lo que usen en ese lugar, aunque también es normal que haya una persona encargada de "dar el toque" a las pantallas, así cada programador no tiene que esmerarse mucho en ese aspecto.
En general, claro que sí tienes nivel.
Si hacemos una división muy genérica de niveles, podría ser:
  • 0. Gurú
  • 1. Muy avanzado
  • 2. Avanzado
  • 3. Medio
  • 4. Aficionado
  • 5. Novato
Que cada uno se apunte al nivel que quiera :D
Puedes crear una encuesta y comparar según lo que contesten los demás :)

En cuanto a las explicaciones, es como siempre, alguien novato o aficionado puede que no lo entienda muy bien, es normal. Sin embargo, alguien medio o avanzado te entenderá perfectamente.

José Luis Garcí 23-07-2013 09:25:34

Cita:

Empezado por kokorski (Mensaje 464254)
No me cabe duda de que estas sobradamente preparado para afrontar cualquier iniciativa, y mas si es dirigida al publlico en general, nada lo demuestra mejor que este aporte que nos estas haciendo a todos de forma desinteresada. No dudes de tu capacidad y adelante con todo....

...


Saludos

Gracias kokorski, te agradezco tanto el comentario como la valoración.

Cita:

Empezado por Casimiro Notevi (Mensaje 464255)
A la venta, seguro que puedes dedicarte :)
Supongo que quieres decir "a crearlos para venderlos". Si es así, entonces sí que puedes, el usuario final sólo quiere que haga bien lo que tiene que hacer, que lo haga rápido y que sea fácil de hacerlo. Y si es barato, mejor :)
Ahora bien, si lo dices por entrar a formar parte de un equipo de programación, pienso que lo principal que tendrías que cambiar es a usar la nomenclatura que utilicen en ese sitio. En algunos sitios son más estrictos y en otros son más abiertos a que cada uno use su forma habitual.
Ya sabes, la nomenclatura, la notación para las variables, componentes, etc., la forma de escribir el código, incluso los espacios de tabulación para las sangrías del código. Pero todo eso es informarse y usarlo, nada más.
En cuanto a la estética, como siempre, te tienes que habituar a lo que usen en ese lugar, aunque también es normal que haya una persona encargada de "dar el toque" a las pantallas, así cada programador no tiene que esmerarse mucho en ese aspecto.
En general, claro que sí tienes nivel.
Si hacemos una división muy genérica de niveles, podría ser:
  • 0. Gurú
  • 1. Muy avanzado
  • 2. Avanzado
  • 3. Medio
  • 4. Aficionado
  • 5. Novato
Que cada uno se apunte al nivel que quiera :D
Puedes crear una encuesta y comparar según lo que contesten los demás :)

En cuanto a las explicaciones, es como siempre, alguien novato o aficionado puede que no lo entienda muy bien, es normal. Sin embargo, alguien medio o avanzado te entenderá perfectamente.

Muchas gracias Casimiro, de todas maneras, yo considero que soy más nivel Aficionado o medio, que otro, despues de tantos años creo que no puedo considerarme novato y aunque aun me pierdo con muchos conceptos ahí estoy, dando caña para intentar entenderlos.

En cuanto a mi aportación, debo decir que la mayor parte que aporto yo son los conceptos y la aplicación (a mi forma) de ellos al programa, pero no considero que en ningún momento este descubriendo la pólvora, en cuanto al código, ya que este en su mayor parte, es de compañeros del club de libros y de otras páginas en Internet, que mio propio, lo que si he hecho yo es interpretar este y adaptarlo a mis necesidades. Lo mismo pasa con mis componentes.

Claro Casimiro que las explicaciones, dependerán de quien las lea sean más claras o no y estoy seguro de que más del 90% le interesa más el concepto que el código en si, ya que lo piensan aplicar a su propio estilo, pero también considero, que tener un punto de partida, es fundamental. Ya esto lo he contado en el club, cuando comencé con Clipper compre un libro (Que aún conservo), para iniciarte en el mundo de este lenguaje, los primeros capítulos, eran conceptos, pero de ahí en adelante era una aplicación sencilla pero completa y debo decir, que me enseño muchísimo, cosa que hasta la fecha no he visto en Delphi.

y no no es que me vaya con un equipo de programación, me refiero a que si me sale la oportunidad de hacer algún programa que me soliciten, si creis que tengo suficiente nivel como para vender al público mis programas.

En cuanto al diseño, se que debo mejorarlo, pero espero a que alguno de los maestro, escriba alguna guía o tutorial, con los conceptos y reglas a respetar, de hecho puse el tema
http://www.clubdelphi.com/foros/showthread.php?t=83663, para intentar aprender de los compañeros y aún por desgracia no ha participado nadie.

Disculparme como siempre por la verborrea, pero para todos los años que llevo en el club no participo mucho.

José Luis Garcí 23-07-2013 09:52:03

Siguiendo con el tutorial, lo siguiente es

Código Delphi [-]
procedure TFXPAF.SBDireccionesClick(Sender: TObject);
//------------------------------------------------------------------------------
//****************************************************[ Buscar direcciones ]****
//------------------------------------------------------------------------------
begin
  if DBNCodigoCliente.Text<>'' then
  begin
    VarSTabla:='DIRECCIONES';  //Pertenece al formularios  UFbusquedaFP
    VarSNomMod:='XPAFD';  //Desde que modulo lo llamamos
    FbusquedaFP.Show;
  end else ShowMessage('Debe seleccionar primero el código del cliente');
end;

y estos son los cambios más significativos hechos en UFbusquedaFP

Código Delphi [-]

//------------------------------------------------------------------------------
//****************************************************[ Hace la búsqueda ]******
//------------------------------------------------------------------------------
begin  // Usamos por defecto locate pero lo podemos cambiar por un Query y sus cláusulas
    if comboCampos.Text<>'' then
    begin
       if VarSNomMod='XPAFD' then  //Módulo de documentos (direcciones)
       begin
            if CheckBox1.Checked then ActQuery(IBQBusqueda,'Select * From '+VarSTabla+' WHERE (DIRECCIONES.MODULO = '+ QuotedStr('CLIENTES')+
                                                           ') AND (DIRECCIONES.CODIGO = '+ QuotedStr(FXPAF.DBNCodigoCliente.Text)+
                                                           ') AND (UPPER('+comboCampos.text+ ') LIKE UPPER('+QuotedStr('%'+Edbusqueda.Text+'%')+'))')
                                 else ActQuery(IBQBusqueda,'Select * From '+VarSTabla+' WHERE (DIRECCIONES.MODULO = '+ QuotedStr('CLIENTES')+
                                                           ') AND (DIRECCIONES.CODIGO = '+ QuotedStr(FXPAF.DBNCodigoCliente.Text)+
                                                           ') AND (UPPER('+comboCampos.text+') WHERE UPPER('+QuotedStr(Edbusqueda.Text)+'))');
       end else
       begin
          if CheckBox1.Checked then ActQuery(IBQBusqueda,'Select * From '+VarSTabla+' WHERE UPPER('+comboCampos.text+') LIKE UPPER('+QuotedStr('%'+Edbusqueda.Text+'%')+')')
                               else ActQuery(IBQBusqueda,'Select * From '+VarSTabla+' WHERE UPPER('+comboCampos.text+') WHERE UPPER('+QuotedStr(Edbusqueda.Text)+')');
       end;
    end else ShowMessage('Debe seleccionar el campo por el que buscar');
end;


procedure TFbusquedaFP.FormActivate(Sender: TObject);
//------------------------------------------------------------------------------
//********************[ Cargamos los Campos de la tabla  en el ComboBox  ]******
//------------------------------------------------------------------------------
begin  //Comprobamos si el combo esta vacio cargamos los datos
  if Edbusqueda.Text='' then
  begin
     if (VarSTabla='DIRECCIONES') AND (VarSNomMod='XPAFD') then
     begin
       if VarSTabla='DIRECCIONES' then Caption:='Búsquedas en direcciones';  //Caption del Form
       ActQuery(IBQBusqueda,'Select * From '+VarSTabla+' WHERE (DIRECCIONES.MODULO = '+ QuotedStr('CLIENTES')+
                             ') AND (DIRECCIONES.CODIGO = '+ QuotedStr(FXPAF.DBNCodigoCliente.Text)+ ')');
    end else ActQuery(IBQBusqueda,'Select * From '+VarSTabla);
  end;
  if IBQBusqueda.IsEmpty then
  begin
     ShowMessage('No hay datos para buscar o mostrar');
     SB_SalirClick(Sender);
  end else
  begin
     if comboCampos.Items.Count=0 then DataSource1.DataSet.GetFieldNames(comboCampos.items);

      ...

     if VarSTabla='DIRECCIONES' then
     begin
       CarGarGrid(0,'ID',50,'ID');
       CarGarGrid(1,'CODIGO',130,'Código');
       CarGarGrid(2,'DIRECCION',520,'Dirección');
       CarGarGrid(3,'CP',65,'Dirección');
       CarGarGrid(4,'POBLACION',520,'Población');
       CarGarGrid(5,'PROVINCIA',520,'Provincía');
       CarGarGrid(6,'PAIS',520,'País');
     end;
  end;
end;


procedure TFbusquedaFP.FormClose(Sender: TObject; var Action: TCloseAction);
//------------------------------------------------------------------------------
//****************************************************************[ Cerrar ]****
//------------------------------------------------------------------------------
begin

   ...

   if (VarSNomMod='XPAFD')  and (FXPAF.DsPrincipal.DataSet.State in [dsEdit,dsInsert]) then
   begin
       DM.IBDDocumentosIDDIRECCIONES.AsInteger:=IBQBusqueda.FieldByName('ID').AsInteger; //Ponemos el código elegido
       FXPAF.Show;
   end;
   Button3Click(Sender);
   QuerryOC(IBQBusqueda);
   comboCampos.Items.Clear;
end;


procedure TFbusquedaFP.FormShow(Sender: TObject);
//------------------------------------------------------------------------------
//****************************************************************[ OnShow ]****
// Adaptamos el título del form a la tabla que usamos
//------------------------------------------------------------------------------
begin

  ...

  if (VarSTabla='DIRECCIONES') AND (VarSNomMod='XPAFD') then
  begin
    if VarSTabla='DIRECCIONES' then Caption:='Búsquedas en direcciones';  //Caption del Form
    ActQuery(IBQBusqueda,'Select * From '+VarSTabla+' WHERE (DIRECCIONES.MODULO = '+ QuotedStr('CLIENTES')+
                         ') AND (DIRECCIONES.CODIGO = '+ QuotedStr(FXPAF.DBNCodigoCliente.Text)+ ')');
                         ShowMessage(IBQBusqueda.SQL.Text);
  end;
end;

Como podéis ver al tratarse de una tabla auxiliar que va vinculada a los módulos y el código, el tratamiento es un poco diferente.

José Luis Garcí 23-07-2013 10:07:49

Como va quedando el botón nuevo documento

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;
  NDBSENumeroProteccionDatos.Field.Value:=1;
  DBNNumeroDocumento.Field.value:=VerNumeroDocumento(VarSTipoDocumento,DBNSerie.Text);
  //Campos que no pueden quedar nulos
  DSPrincipal.DataSet.FieldByName('PORCENTAJEFINANCIADO').Value:=0;
  DSPrincipal.DataSet.FieldByName('TIPODOCUMENTO').Value:=VarSTipoDocumento;
  DSPrincipal.DataSet.FieldByName('COBRADO').Value:='N';
  DSPrincipal.DataSet.FieldByName('TOTALCOMISIONES').Value:=0;
  DSPrincipal.DataSet.FieldByName('MODIFICACIONES').Value:=0;
  DSPrincipal.DataSet.FieldByName('SUBTOTAL').Value:=0;
  DSPrincipal.DataSet.FieldByName('TOTALIMPUESTOS').Value:=0;
  DSPrincipal.DataSet.FieldByName('TOTALIMPUESTO1').Value:=0;
  DSPrincipal.DataSet.FieldByName('TOTALIMPUESTO2').Value:=0;
  DSPrincipal.DataSet.FieldByName('TOTALIMPUESTO3').Value:=0;
  DSPrincipal.DataSet.FieldByName('TOTALIMPUESTO4').Value:=0;
  DSPrincipal.DataSet.FieldByName('TOTALPESO').Value:=0;
  DSPrincipal.DataSet.FieldByName('TOTALDESCUENTOS').Value:=0;
  Memo2.Lines.Clear;
  DBNSerie.SetFocus;
end;

José Luis Garcí 23-07-2013 10:26:40

Bueno empezamos con la botonera de detalles del documento, explicaremos algunos botones, los otros, son iguales a los anteriores

Código Delphi [-]
procedure TFXPAF.SBDetalleNuevoClick(Sender: TObject);
// ------------------------------------------------------------------------------
// *********************************************************[ Nuevo Detalle ]****
// ------------------------------------------------------------------------------
var I, varIPaso:Integer;
begin
  varIPaso:=0;  //Si sigue a 0 grabará y pasará al siguiente
  if DsPrincipal.DataSet.State in [DsInsert] then
  begin { Si esta en insercion, lo salvamos y editamos, para que acepte los cambios posteriores }
    if DM.IBDDocumentosIDDIRECCIONES.IsNull then
    begin
       if IBQDirecciones.IsEmpty then DM.IBDDocumentosIDDIRECCIONES.Value:=0
                                 else DM.IBDDocumentosIDDIRECCIONES.Value:=IBQDirecciones.FieldByName('IDDIRECCIONES').Value;
    end;
    DSPrincipal.DataSet.FieldByName('NUMERODOCUMENTO').Value:=DBNNumeroDocumento.Text;
    DSPrincipal.DataSet.FieldByName('SERIE').Value:=DBNSerie.Text;
    if DSPrincipal.DataSet.FieldByName('CODIGOCLIENTE').IsNull then varIPaso:=1;
    if DSPrincipal.DataSet.FieldByName('CODIGOAGENTE').IsNull then varIPaso:=2;
    if DSPrincipal.DataSet.FieldByName('FECHA').IsNull then varIPaso:=3;
    if DSPrincipal.DataSet.FieldByName('FORMADEPAGO').IsNull then varIPaso:=4;
    if DSPrincipal.DataSet.FieldByName('NUMEROPROTECCIONDATOS').IsNull then varIPaso:=5;
    if varIPaso=0 then
    begin
       DsPrincipal.DataSet.Post;
       DsPrincipal.DataSet.Edit;
    end;
  end;
  if varIPaso=0 then
  begin
    DsDetalle.DataSet.Insert;
    FExtPPAF.ListView1.Items.Clear;
    for I := 1 to FExtPPAF.StringGrid1.RowCount - 1 do   FExtPPAF.StringGrid1.Rows[i].Clear;
    FExtPPAF.Show;
    FExtPPAF.DBEdit1.SetFocus;
  end else
  begin
     case varIPaso of
        1:begin
             ShowMessage('Falta por rellenar el código de cliente');
             DBNCodigoCliente.SetFocus;
          end;
        2:begin
             ShowMessage('Falta por rellenar el código de agente/comercial');
             DBNCodigoComercial.SetFocus;
          end;
        3:begin
             ShowMessage('Falta por rellenar la fecha');
             DBNFecha.SetFocus;
          end;
        4:begin
             ShowMessage('Falta por rellenar la forma de pago');
             DBNFormaPago.SetFocus;
          end;
        5:begin
             ShowMessage('Falta por rellenar el número de protección de datos');
             NDBSENumeroProteccionDatos.SetFocus;
          end;
     end;
  end;
end;

Se que el código cliente y otros, tienen control de salida, por lo que no permite quedarse vacio, pero puede pasar que el cliente con el ratón salte los pasos y lo coloque en otra posición dejando en blanco o nulos, campos que deben tener datos. Para evitarlo creamos la variable VarIPaso y la iniciamos a 0, si se mantiene a 0 todo va bien, en caso contrario según su valor nos indica donde se encuentra el error.

José Luis Garcí 23-07-2013 10:33:02

Ahora los botones Modificar y borrar de detalle

Código Delphi [-]
procedure TFXPAF.SBDetalleModificarClick(Sender: TObject);
// ------------------------------------------------------------------------------
// *******************************************[ Editar el actual registro ]******
// ------------------------------------------------------------------------------
begin
  if DsDetalle.DataSet.IsEmpty<>true then
  begin
    DsDetalle.DataSet.Edit;
    FExtPPAF.Show;
    FExtPPAF.DBEdit1.SetFocus;
  end else  ShowMessage('No existen datos para poder editar');
end;

procedure TFXPAF.SBDetalleBorrarClick(Sender: TObject);
// ------------------------------------------------------------------------------
// **********************************[ Borrar el Actual Registro Desgloce ]******
// ------------------------------------------------------------------------------
begin // Cambiar por el mensaje elegido
  if not DsDetalle.DataSet.IsEmpty then
  begin
    if (MessageBox(0, '¿Esta seguro  de eliminar el registro detalle?', // Aqui no se porque me manda la última comilla simple y la coma a la linea de abajo, por favor subir al final de la linea anterior
        'Eliminar Registro', MB_ICONSTOP or MB_YESNO or MB_DEFBUTTON2) = ID_No) then
      Abort
    else
    begin
      DsDetalle.DataSet.Delete;
      ShowMessage('El registro ha sido eliminado');
    end;
  end
  else ShowMessage('No existen datos para eliminar');
end;

Casimiro Notevi 23-07-2013 10:51:16

Cita:

Empezado por José Luis Garcí (Mensaje 464308)
me refiero a que si me sale la oportunidad de hacer algún programa que me soliciten, si creis que tengo suficiente nivel como para vender al público mis programas.

Por supuesto que sí. No hay duda.

Cita:

Empezado por José Luis Garcí (Mensaje 464308)
En cuanto al diseño, se que debo mejorarlo, pero espero a que alguno de los maestro, escriba alguna guía o tutorial, con los conceptos y reglas a respetar, de hecho puse el tema http://www.clubdelphi.com/foros/showthread.php?t=83663, para intentar aprender de los compañeros y aún por desgracia no ha participado nadie.

Es que es algo muy ambiguo, hoy puedes hacer la pantalla de una manera y la semana que viene la haces de otra distinta. Normalmente se procura hacer según un "estandar" que nos hemos creado nosotros mismos en ese programa. Al igual que con otro programa usamos una presentación totalmente distinta porque "nos ha parecido" que debe hacerse de otra manera.
De todas formas, hay información por internet y libros que hablan de ese tema, aunque no soy muy partidario de seguirlos "al dedillo" porque prefiero hacer las cosas a mi manera.

Por ahí tenemos un hilo, creo recordar que 2 hilos, que hablan sobre ese asunto y los foreros pusieron capturas de pantallas de sus programas, por si acaso te sirve de algo echarles un vistazo.
Por comentarte algo personal, prefiero ponerlo todo muy recogido, ocupando el menor espacio posible. Sin embargo eso va en contra de una pantalla táctil o de alguien que tenga algún defecto ocular y prefiera todo más grande. Creo que en estas cosas cada uno tiene sus gustos y pueden ser totalmente diferentes al del resto.

José Luis Garcí 23-07-2013 10:55:13

Debido a que voy a usar este método más de una vez he modificado el código del botón nuevo y creado una nueva función para este módulo

Código Delphi [-]
procedure TFXPAF.SBDetalleNuevoClick(Sender: TObject);
// ------------------------------------------------------------------------------
// *********************************************************[ Nuevo Detalle ]****
// ------------------------------------------------------------------------------
var I:Integer;
begin
  if CambiarEstado=0 then
  begin
    DsDetalle.DataSet.Insert;
    FExtPPAF.ListView1.Items.Clear;
    for I := 1 to FExtPPAF.StringGrid1.RowCount - 1 do   FExtPPAF.StringGrid1.Rows[i].Clear;
    FExtPPAF.Show;
    FExtPPAF.DBEdit1.SetFocus;
  end;
end;

Después del cambio es como queda este procedure y ahora la function

Código Delphi [-]
function TFXPAF.CambiarEstado: Integer;
//------------------------------------------------------------------------------
//*********************************************************[ CambiarEstado ]****
// Nos permite comprobar si los datos necesarios estan rellenos
//------------------------------------------------------------------------------
var varIPaso:Integer;
begin
  varIPaso:=0;  //Si sigue a 0 grabará y pasará al siguiente
  if DsPrincipal.DataSet.State in [DsInsert] then
  begin { Si esta en insercion, lo salvamos y editamos, para que acepte los cambios posteriores }
    if DM.IBDDocumentosIDDIRECCIONES.IsNull then
    begin
       if IBQDirecciones.IsEmpty then DM.IBDDocumentosIDDIRECCIONES.Value:=0
                                 else DM.IBDDocumentosIDDIRECCIONES.Value:=IBQDirecciones.FieldByName('IDDIRECCIONES').Value;
    end;
    DSPrincipal.DataSet.FieldByName('NUMERODOCUMENTO').Value:=DBNNumeroDocumento.Text;
    DSPrincipal.DataSet.FieldByName('SERIE').Value:=DBNSerie.Text;
    if DSPrincipal.DataSet.FieldByName('CODIGOCLIENTE').IsNull then varIPaso:=1;
    if DSPrincipal.DataSet.FieldByName('CODIGOAGENTE').IsNull then varIPaso:=2;
    if DSPrincipal.DataSet.FieldByName('FECHA').IsNull then varIPaso:=3;
    if DSPrincipal.DataSet.FieldByName('FORMADEPAGO').IsNull then varIPaso:=4;
    if DSPrincipal.DataSet.FieldByName('NUMEROPROTECCIONDATOS').IsNull then varIPaso:=5;
    if varIPaso=0 then
    begin
       DsPrincipal.DataSet.Post;
       DsPrincipal.DataSet.Edit;
    end else
    begin
       case varIPaso of
          1:begin
               ShowMessage('Falta por rellenar el código de cliente');
               DBNCodigoCliente.SetFocus;
            end;
          2:begin
               ShowMessage('Falta por rellenar el código de agente/comercial');
               DBNCodigoComercial.SetFocus;
            end;
          3:begin
               ShowMessage('Falta por rellenar la fecha');
               DBNFecha.SetFocus;
            end;
          4:begin
               ShowMessage('Falta por rellenar la forma de pago');
               DBNFormaPago.SetFocus;
            end;
          5:begin
               ShowMessage('Falta por rellenar el número de protección de datos');
               NDBSENumeroProteccionDatos.SetFocus;
            end;
       end;
      end;
  end;
  if varIPaso=0 then Result:=0 else Result:=1;  //0 = OK, 1 = problema
end;

José Luis Garcí 23-07-2013 11:01:46

Cita:

Empezado por Casimiro Notevi (Mensaje 464317)
Por supuesto que sí. No hay duda.


Es que es algo muy ambiguo, hoy puedes hacer la pantalla de una manera y la semana que viene la haces de otra distinta. Normalmente se procura hacer según un "estandar" que nos hemos creado nosotros mismos en ese programa. Al igual que con otro programa usamos una presentación totalmente distinta porque "nos ha parecido" que debe hacerse de otra manera.
De todas formas, hay información por internet y libros que hablan de ese tema, aunque no soy muy partidario de seguirlos "al dedillo" porque prefiero hacer las cosas a mi manera.

Por ahí tenemos un hilo, creo recordar que 2 hilos, que hablan sobre ese asunto y los foreros pusieron capturas de pantallas de sus programas, por si acaso te sirve de algo echarles un vistazo.
Por comentarte algo personal, prefiero ponerlo todo muy recogido, ocupando el menor espacio posible. Sin embargo eso va en contra de una pantalla táctil o de alguien que tenga algún defecto ocular y prefiera todo más grande. Creo que en estas cosas cada uno tiene sus gustos y pueden ser totalmente diferentes al del resto.

Primero gracias Casimiro, en cuanto a "Por ahí tenemos un hilo, creo recordar que 2 hilos," creo que te refieres al color de nuestros programas (o un titulo parecido), me pareció muy interesante y lo seguí, diría yo que hasta la fecha, el problema es que no puedes hacer una verdadera comparación ya que cada programa es un mundo, por eso decía yo poniendo un formulario, sin muchas complicaciones de ver como los compañeros eran capaces de dejar el aspecto de dicha pantalla, lo que me serviría a mi y supongo que a otros muchos compañeros, de mucha utilidad, ya que veríamos como podemos mejorar visualmente un mismo diseño.

Casimiro Notevi 23-07-2013 11:19:00

Te entiendo, José Luis, aunque lo que trataba de decirte es que ese diseño variará dependiendo de muchos factores, tanto personales como preferencias del cliente, técnicos, etc.
Es lo que te comentaba, yo prefiero hacer las pantallas muy reducidas, ajustadas, lo más pequeña posible, etc. pero si me dicen que el el programa es para usar en una pantalla táctil, entonces cambio mis preferencias y me adapto a esa cuestión técnica. O lo mismo si el cliente me dice que prefiere las letras grandes porque en su empresa están todos cegatos.
O sea, que hacer esa pantalla que indicas, si fuese para mí, creo que la reduciría tanto que entrarían 4 pantallas en el tamaño que ocupa solo una :D

José Luis Garcí 23-07-2013 11:23:57

Cita:

Empezado por Casimiro Notevi (Mensaje 464325)
O sea, que hacer esa pantalla que indicas, si fuese para mí, creo que la reduciría tanto que entrarían 4 pantallas en el tamaño que ocupa solo una :D


Oye te vamos a cambiar el nick (Don Cicuta Supertacañon) y el avatar por este

A ver si adivinas por qué :D:D:D:D

José Luis Garcí 23-07-2013 11:33:34

Ahora insertar un comentario

Código Delphi [-]
procedure TFXPAF.SBInsertarComentarioClick(Sender: TObject);
// ------------------------------------------------------------------------------
// ************************************************[ Insertar Comentario ]*******
// ------------------------------------------------------------------------------
var VarScadena: string;
begin
  VarScadena := InputBox('Comentario a insertar', 'Su comentario', '');
  if VarScadena <> '' then
  begin
    if CambiarEstado=0 then
    begin
      DsDetalle.DataSet.Insert;
      DsDetalle.DataSet.FieldByName('CODIGOARTICULO').value:='COM.';
      DsDetalle.DataSet.FieldByName('DESCRIPCIONARTICULO').value:=VarScadena;
      DsDetalle.DataSet.FieldByName('CANTIDAD').value:=0;
      DsDetalle.DataSet.FieldByName('PRECIOUNIDAD').value:=0;
      DsDetalle.DataSet.FieldByName('IMPUESTO').value:=0;
      DsDetalle.DataSet.FieldByName('DESCUENTO').value:=0;
      DsDetalle.DataSet.FieldByName('COMISION').value:=0;
      DsDetalle.DataSet.FieldByName('PESOUNIDAD').value:=0;
      DsDetalle.DataSet.FieldByName('MODIFICADO').value:=0;
      DsDetalle.DataSet.FieldByName('SERVICIO').value:='N';
    end;
  end;
end;

Casimiro Notevi 23-07-2013 12:20:04

Cita:

Empezado por José Luis Garcí (Mensaje 464326)
Oye te vamos a cambiar el nick (Don Cicuta Supertacañon) y el avatar por este
A ver si adivinas por qué :D

Sí, qué tiempos aquellos, era joven y tenía pelo para peinar :rolleyes:


La franja horaria es GMT +2. Ahora son las 16:04:43.

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi