Módulo de personas de contacto de programa de Gestión desde 0

UPC

unit UPC;

{$R BOTONERA.RES}
interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, IBDatabase,
  MMSystem,   					//Para la botonera
  NewPanelDB, 				  //Para usar el NEwPanelDB
  SPBBC,        	 			//Para TSpeedButtonBC
  Lapelpanel,   				//Para paneles con solapa
  MyDbIbMemo,   				//Para DbiMemo
  TDbIbchkbox,  				//Para campos boolean en Firebird
  Mask, DbEditDefault,  //PAra usar los DbeditDefault en vez de los Dbedit normal
  DBCBEXT,							//Para usar el DbCombobox Extendido
  GroupboxJL,           //Para usar el CgoupBox especial
  Dialogs, ComCtrls, ExtCtrls, Grids, DBGrids, StdCtrls, Spin, Buttons, DB, DBCtrls, Clipbrd, jpeg, ShellAPI,
  ExtDlgs;

type
  TFPC = class(TForm)
    PanelBotonera: TNewPanelDB;
    SBBarraStatus: TStatusBar;
    Panel1: TPanel;
    Panel2: TPanel;
    PanelDatos: TNewPanelDB;
    Panel3: TPanel;
    DBGNoEnable: TDBGrid;
    PanelConfirmar: TNewPanelDB;
    DsPrincipal: TDataSource;
    SBPrimero: TSpeedButtonBC;
    SBMenosx: TSpeedButtonBC;
    SBMenos1: TSpeedButtonBC;
    SBMas1: TSpeedButtonBC;
    SBMasX: TSpeedButtonBC;
    SBUltimo: TSpeedButtonBC;
    SbNuevo: TSpeedButtonBC;
    SbModificar: TSpeedButtonBC;
    SbBorrar: TSpeedButtonBC;
    SB_Salir: TSpeedButtonBC;
    SBBuscar: TSpeedButtonBC;
    SBImprimir: TSpeedButtonBC;
    SBConfirmar: TSpeedButtonBC;
    SBCancelar: TSpeedButtonBC;
    Label14: TLabel;
    SEMobeByX: TSpinEdit;
    GBBuscar: TGroupBoxJL;
    Ebusqueda: TEdit;
    BLimpiar: TButton;
    BBuscar: TButton;
    BCerrar: TButton;
    GBImprimir: TGroupBoxJL;
    CBVistaPrevia: TCheckBox;
    CBVerDialogo: TCheckBox;
    BCerrarIMP: TButton;
    Timer1: TTimer;
    Label1: TLabel;
    DBEdit1: TDBEdit;
    Label2: TLabel;
    DBEdit2: TDBEdit;
    Label3: TLabel;
    DBEdit3: TDBEdit;
    Label4: TLabel;
    DBEdit4: TDBEdit;
    Label5: TLabel;
    DBEdit5: TDBEdit;
    Label6: TLabel;
    DBEdit6: TDBEdit;
    Label7: TLabel;
    DBEdit7: TDBEdit;
    Label8: TLabel;
    DBEdit8: TDBEdit;
    Label9: TLabel;
    DBEdit9: TDBEdit;
    Label10: TLabel;
    DBEdit10: TDBEdit;
    Label11: TLabel;
    DBImage1: TDBImage;
    DBIBMemo1: TDBIBMemo;
    Label12: TLabel;
    SpeedButtonBC1: TSpeedButtonBC;
    SpeedButtonBC2: TSpeedButtonBC;
    OpenPictureDialog1: TOpenPictureDialog;
    SpeedButtonBC3: TSpeedButtonBC;
    SpinEdit1: TSpinEdit;
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure SBPrimeroClick(Sender: TObject);
    procedure SBMenosxClick(Sender: TObject);
    procedure SBMenos1Click(Sender: TObject);
    procedure SBMas1Click(Sender: TObject);
    procedure SBMasXClick(Sender: TObject);
    procedure SBUltimoClick(Sender: TObject);
    procedure SbNuevoClick(Sender: TObject);
    procedure SbModificarClick(Sender: TObject);
    procedure SbBorrarClick(Sender: TObject);
    procedure SBBuscarClick(Sender: TObject);
    procedure BLimpiarClick(Sender: TObject);
    procedure BBuscarClick(Sender: TObject);
    procedure BCerrarClick(Sender: TObject);
    procedure EbusquedaChange(Sender: TObject);
    procedure SBImprimirClick(Sender: TObject);
    procedure BCerrarIMPClick(Sender: TObject);
    procedure SB_SalirClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure SBCancelarClick(Sender: TObject);
    procedure SBConfirmarClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure DBEdit6Change(Sender: TObject);
    procedure DBEdit6Exit(Sender: TObject);
    procedure DBEdit8Enter(Sender: TObject);
    procedure DBEdit8KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure SpeedButtonBC1Click(Sender: TObject);
    procedure SpeedButtonBC2Click(Sender: TObject);
    procedure SpeedButtonBC3Click(Sender: TObject);
    procedure DBGNoEnableDrawColumnCell(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumn; State: TGridDrawState);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FPC: TFPC;
   IBT:TIBTransaction;

implementation

{$R *.dfm}

uses UDM,Fun, Umenu, Fun_Errores, FUN_DBGRID, Uclientes;

procedure TFPC.BBuscarClick(Sender: TObject);
//------------------------------------------------------------------------------
//**************************************************************[ Buscar ]******
//------------------------------------------------------------------------------
var Campo:string;
begin
     Campo:='NOMBRE';  {Dato a rellenar por el progrmador con el nombre del campo en la busqueda}
     DSPrincipal.DataSet.Locate(Campo,Ebusqueda.Text,[loCaseInsensitive,loPartialKey]);
end;

procedure TFPC.BCerrarClick(Sender: TObject);
//------------------------------------------------------------------------------
//*****************************************************[ Cerrar Busqueda ]******
//------------------------------------------------------------------------------
begin
   BLimpiarClick(Sender);
   GBBuscar.Visible:=False;
end;

procedure TFPC.BCerrarIMPClick(Sender: TObject);
//------------------------------------------------------------------------------
//****************************************************[ Cerrar Imrprimir ]******
//------------------------------------------------------------------------------
begin
   GBImprimir.Visible:=False;
end;

procedure TFPC.BLimpiarClick(Sender: TObject);
//------------------------------------------------------------------------------
//**************************************************[ Limpia la busqueda ]******
//------------------------------------------------------------------------------
begin
   Ebusqueda.Text:='';
   BBuscarClick(Sender);
   Ebusqueda.SetFocus;
end;

procedure TFPC.DBEdit6Change(Sender: TObject);
//------------------------------------------------------------------------------
//***********************************************************[ Para varios ]****
//  Para que sólo admita los Caracteres S N s n
//------------------------------------------------------------------------------
begin
  TDBEdit(Sender).Text:=EditLogico(TEdit(Sender));   //LLamada usada por varios edits
end;

procedure TFPC.DBEdit6Exit(Sender: TObject);
//------------------------------------------------------------------------------
//********************************************************[ Usar en varios ]****
//   Para usar en varios con por defecto sea N de No
//------------------------------------------------------------------------------
begin
  TDBEdit(Sender).Text:=EditSalida(TEdit(Sender));
end;

procedure TFPC.DBEdit8Enter(Sender: TObject);
//------------------------------------------------------------------------------
//***************************************************[ Fecha de nacimiento ]****
//------------------------------------------------------------------------------
begin
   if DBEdit8.Text='' then FECHA_DBEDIT_ENTER(DBEdit8);
end;

procedure TFPC.DBEdit8KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
//------------------------------------------------------------------------------
//***************************************[ Cambiar la fecha con las teclas ]****
//------------------------------------------------------------------------------
begin
	FECHA_DBEDIT(DBEdit8,Key)
end;

procedure TFPC.DBGNoEnableDrawColumnCell(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
//------------------------------------------------------------------------------
//*******************************************************[ ZEbaro del Grid ]****
//------------------------------------------------------------------------------
begin
  Zebrado(DsPrincipal,DBGNoEnable, Rect, Column, State, COLOR1GRID,COLOR2GRID);
end;

procedure TFPC.EbusquedaChange(Sender: TObject);
//------------------------------------------------------------------------------
//*************************************[ Mientras se escribe en busqueda ]******
//------------------------------------------------------------------------------
begin
    BBuscarClick(sender);
end;

procedure TFPC.FormActivate(Sender: TObject);
//------------------------------------------------------------------------------
//********************************************[ Cuando se activa El form ]******
// Lo que queremos que haga nuestro Form Cuando se Actiba
//------------------------------------------------------------------------------
begin
    //Carganmos las imagenes de los botones
    SBPrimero.Glyph.Handle:=Loadbitmap(HInstance,'FIRST');
    SBMenosx.Glyph.Handle:=Loadbitmap(HInstance,'RETROCEDER');
    SBMenos1.Glyph.Handle:=Loadbitmap(HInstance,'PRIOR');
    SBMas1.Glyph.Handle:=Loadbitmap(HInstance,'NEXT');
    SBMasX.Glyph.Handle:=Loadbitmap(HInstance,'AVANZAR');
    SBUltimo.Glyph.Handle:=Loadbitmap(HInstance,'LAST');
    SbNuevo.Glyph.Handle:=Loadbitmap(HInstance,'NUEVO');
    SbModificar.Glyph.Handle:=Loadbitmap(HInstance,'EDIT');
    SbBorrar.Glyph.Handle:=Loadbitmap(HInstance,'BORRAR');
    SB_Salir.Glyph.Handle:=Loadbitmap(HInstance,'SALIR');
    SBBuscar.Glyph.Handle:=Loadbitmap(HInstance,'BUSCAR');
    SBImprimir.Glyph.Handle:=Loadbitmap(HInstance,'IMPRIMIR');
    SBConfirmar.Glyph.Handle:=Loadbitmap(HInstance,'CHECKROUND');
    SBCancelar.Glyph.Handle:=Loadbitmap(HInstance,'CANCEL');
    if Timer1.Enabled=false then Timer1.Enabled:=True;
    //Ponemos el Juego de colores de mis  NewPanelDB
    PanelBotonera.ColorNotActive:=COLORPANELACT;
    PanelBotonera.ActiveColor:=COLORPANELNOACT;
    PanelDatos.ActiveColor:=COLORPANELACT;
    PanelDatos.ColorNotActive:=COLORPANELNOACT;
    PanelConfirmar.ActiveColor:=COLORPANELACT;
    PanelConfirmar.ColorNotActive:=COLORPANELNOACT;
end;

procedure TFPC.FormClose(Sender: TObject; var Action: TCloseAction);
//------------------------------------------------------------------------------
//*************************************************[ Al Cerrarse El Form ]******
// Cerramos todos los procesos para que no consuman memoria y posibles errores
//------------------------------------------------------------------------------
begin
   if Timer1.Enabled=true then  Timer1.Enabled:=False;
   ActIbdataset(DM.IBDPC,'SELECT * FROM PC');
   //Retornos al modulo de llamada
   if VarSNomMod='CLIENTES' then FClientes.SpeedButtonBC4Click(sender);
   //Según se van creando los módulos de llamada ir añadiendo, ejmplo Proveedores, Agentes, Personal, etc
end;

procedure TFPC.FormCreate(Sender: TObject);
//------------------------------------------------------------------------------
//***************************************************[ Al Crearse el Fom ]******
// Cosas que queremos que haga según se inicie el Form
//------------------------------------------------------------------------------
begin
    IBT:=UDM.DM.IBTransaction1; // Aquí especificar el modulo y el IBTransaction a usar
    {Cosas que queremos que haga según se inicie el Form}
end;

procedure TFPC.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 TDBComboBox) then
    begin
      Key := #0; { anula la puulsación }
      Perform(WM_NEXTDLGCTL, 0, 0); { mueve al próximo control }
    end
end;

procedure TFPC.SbBorrarClick(Sender: TObject);
//------------------------------------------------------------------------------
//*******************************************[ Borrar el Actual Registro ]******
//------------------------------------------------------------------------------
begin                                //Cambiar por el mensaje elegido
   if not DsPrincipal.DataSet.IsEmpty then
   begin
     if (MessageBox(0, '¿Esta seguro  de eliminar el registro actual?',
     'Eliminar Registro', MB_ICONSTOP or MB_YESNO or MB_DEFBUTTON2) = ID_No) then abort
     else begin
        DSPrincipal.DataSet.Delete;
        ShowMessage('El registro ha sido eliminado');
     end;
   end else ShowMessage('No hay registros que poder borrar');
end;

procedure TFPC.SBBuscarClick(Sender: TObject);
//------------------------------------------------------------------------------
//******************************************************[ Abrir Busqueda ]******
//------------------------------------------------------------------------------
begin
   GBBuscar.Visible:=True;
   Ebusqueda.SetFocus;
end;

procedure TFPC.SBCancelarClick(Sender: TObject);
//------------------------------------------------------------------------------
//*****************************************************[ Cancelar Proceso]******
//------------------------------------------------------------------------------
begin
  DSPrincipal.DataSet.Cancel;
  IBT.RollbackRetaining;   //Donde IBT es el nombre de su Ibtrasaction, con ruta
end;

procedure TFPC.SBConfirmarClick(Sender: TObject);
//------------------------------------------------------------------------------
//********************************************************[ Grabar datos ]******
//------------------------------------------------------------------------------
begin
  try
    if DBEdit3.Text<>'' then
    begin
	    DSPrincipal.DataSet.Post;
  	  IBT.CommitRetaining;    //Donde IBT es el nombre de su Ibtrasaction, con ruta
    end else ShowMessage('Para poder grabar los datos, como mínimo debe poner el nombre');
  except
    on E: Exception do
    begin
        MessageBeep(1000);
        ShowMessage('Se ha producido un error y el proceso no se ha podido terminar   Unidad:[ UPC ]   Modulo:[ Grabar ]' + Chr(13) + Chr(13)
                  + 'Clase de error: ' + E.ClassName + Chr(13) + Chr(13)
                  + 'Mensaje del error:' + E.Message+Chr(13) + Chr(13)
                  + '    '+Chr(13) + Chr(13)
                  + 'El proceso ha quedado interrumpido');
        if DsPrincipal.DataSet.State in [dsEdit, dsInsert] then DSPrincipal.DataSet.Cancel;
   IBT.RollbackRetaining;    //Donde IBT es el nombre de su Ibtrasaction, con ruta
    end;
  end;
end;

procedure TFPC.SBImprimirClick(Sender: TObject);
//------------------------------------------------------------------------------
//******************************************************[ Abrir Imprimir ]******
//------------------------------------------------------------------------------
begin
   GBImprimir.Visible:=True;
end;

procedure TFPC.SBMas1Click(Sender: TObject);
//------------------------------------------------------------------------------
//*************************************************[ Avanzar un registro ]******
//------------------------------------------------------------------------------
begin
   DSPrincipal.DataSet.Next;
end;

procedure TFPC.SBMasXClick(Sender: TObject);
//------------------------------------------------------------------------------
//*************************************************[ Avanzar x Registros ]******
//------------------------------------------------------------------------------
begin
    DSPrincipal.DataSet.MoveBy(SEMobeByX.Value);
end;

procedure TFPC.SBMenos1Click(Sender: TObject);
//------------------------------------------------------------------------------
//***********************************************[ Retroceder 1 registro ]******
//------------------------------------------------------------------------------
begin
  DSPrincipal.DataSet.Prior;
end;

procedure TFPC.SBMenosxClick(Sender: TObject);
//------------------------------------------------------------------------------
//**********************************************[ Retroceder x Registros ]******
//------------------------------------------------------------------------------
begin
  DSPrincipal.DataSet.MoveBy(-SEMobeByX.Value);
end;

procedure TFPC.SbModificarClick(Sender: TObject);
//------------------------------------------------------------------------------
//*******************************************[ Editar el actual registro ]******
//------------------------------------------------------------------------------
begin
   if DsPrincipal.DataSet.IsEmpty<>true then
   begin
      DSPrincipal.DataSet.Edit;
      DBEdit3.SetFocus;
   end else ShowMessage('No hay tregistros disponibles para editar')
end;

procedure TFPC.SbNuevoClick(Sender: TObject);
//------------------------------------------------------------------------------
//*******************************************[ Creamos un nuevo registro ]******
//------------------------------------------------------------------------------
begin
  DSPrincipal.DataSet.Insert;
  DBIBMemo1.Lines.Clear;
  DsPrincipal.DataSet.FieldByName('MODULO').Value:=VarSNomMod;
  DsPrincipal.DataSet.FieldByName('CODIGO').Value:=VarsCod;
  DBEdit3.SetFocus;
end;

procedure TFPC.SBPrimeroClick(Sender: TObject);
//------------------------------------------------------------------------------
//***********************************************[ Ir al Primer Registro ]******
//------------------------------------------------------------------------------
begin
  DSPrincipal.DataSet.First;
end;

procedure TFPC.SBUltimoClick(Sender: TObject);
//------------------------------------------------------------------------------
//***********************************************[ Ir al último registro ]******
//------------------------------------------------------------------------------
begin
   DSPrincipal.DataSet.Last;
end;

procedure TFPC.SB_SalirClick(Sender: TObject);
//------------------------------------------------------------------------------
//******************************************************[ Salir Del Form ]******
//------------------------------------------------------------------------------
begin
   FPC.Close;
end;

procedure TFPC.SpeedButtonBC1Click(Sender: TObject);
//------------------------------------------------------------------------------
//*************************************************************[ Cargar imagen ]****
//------------------------------------------------------------------------------
begin
  if OpenPictureDialog1.Execute then
  begin
     DBImage1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
  end;
end;
procedure TFPC.SpeedButtonBC2Click(Sender: TObject);
//------------------------------------------------------------------------------
//*********************************************************[ Botón pegar ]******
//  código bajado de http://www.clubdelphi.com/foros/showthread.php?t=57360
//  Del compañero Gluglu, para pegar desde el portapapeles
// Añadir al Uses las unit   Clipbrd, jpeg, ShellAPI
//------------------------------------------------------------------------------
var
  f    : TFileStream;
  Jpg  : TJpegImage;
  Hand : THandle;
  Buffer    : Array [0..MAX_PATH] of Char;
  numFiles  : Integer;
  File_Name : String;
  Jpg_Bmp   : String;
  BitMap    : TBitMap;
  ImageAux  : TImage;

begin

  ImageAux := TImage.Create(Self);

  if Clipboard.HasFormat(CF_HDROP) then begin

    Clipboard.Open;
    try
      Hand := Clipboard.GetAsHandle(CF_HDROP);
      If Hand <> 0 then begin
        numFiles := DragQueryFile(Hand, $FFFFFFFF, nil, 0) ;       //Unit ShellApi
        if numFiles > 1 then begin
          Clipboard.Close;
          ImageAux.Free;
          Errorx('Pegar-1','Persona Contacto','Pegar','El Portapapeles contiene más de un único fichero. No es posible pegar','','',False,clSkyBlue,clNavy,500);
          Exit;
        end;
        Buffer[0] := #0;
        DragQueryFile( Hand, 0, buffer, sizeof(buffer)) ;
        File_Name := buffer;
      end;
    finally
      Clipboard.close;
    end;

    f      := TFileStream.Create(File_Name, fmOpenRead);
    Jpg    := TJpegImage.Create;
    Bitmap := TBitmap.Create;

    // Check if Jpg File
    try
      Jpg.LoadFromStream(f);
      ImageAux.Picture.Assign(Jpg);
      Jpg_Bmp := 'JPG';
    except
      f.seek(0,soFromBeginning);
      Jpg_Bmp := '';
    end;

    if Jpg_Bmp = '' then begin
      try
        Bitmap.LoadFromStream(f);
        Jpg.Assign(Bitmap);
        ImageAux.Picture.Assign(Jpg);
        Jpg_Bmp := 'BMP';
      except
        Jpg_Bmp := '';
      end;
    end;

    Jpg.Free;
    Bitmap.Free;
    f.Free;

    if Jpg_Bmp = '' then begin
      ImageAux.Free;
      Errorx('Pegar-2','Persona Contacto','Pegar','Fichero seleccionado no contiene ninguna Imagen del Tipo JPEG o BMP','','',False,clSkyBlue,clNavy,500);
      Exit;
    end;

  end
  else if Clipboard.HasFormat(CF_BITMAP) then
    ImageAux.Picture.Assign(Clipboard)
  else begin
    ImageAux.Free;
    Errorx('Pegar-3','Persona Contacto','Pegar','El Portapapeles no contiene ninguna Imagen del Tipo JPEG o BMP','','',False,clSkyBlue,clNavy,500);
    Exit;
  end;

  Jpg := TJpegImage.Create;
  try
    Jpg.Assign(ImageAux.Picture.Graphic);
  except
    ImageAux.Free;
    Errorx('Pegar-4','Persona Contacto','Pegar','El Portapapeles no contiene ninguna Imagen del Tipo JPEG o BMP','','',False,clSkyBlue,clNavy,500);
    Jpg.Free;
    Exit;
  end;
  Jpg.Free;
  DBImage1.Picture.Assign(ImageAux.Picture);
end;

procedure TFPC.SpeedButtonBC3Click(Sender: TObject);
//------------------------------------------------------------------------------
//*********************************************************[ Datos familia ]****
//------------------------------------------------------------------------------
begin
    ImputFamiliaaMemo(TMemo(DBIBMemo1),'Datos de familia','Nombre de la Esposa');
end;

procedure TFPC.Timer1Timer(Sender: TObject);
//------------------------------------------------------------------------------
//*************************************************[ El evento del Timer ]******
//------------------------------------------------------------------------------
begin
  SBBarraStatus.Panels[2].Text:=TimeToStr(now);
  if SBBarraStatus.Panels[1].Text<>DateToStr(Now) then SBBarraStatus.Panels[1].Text:=DateToStr(Now);
end;

end.