Programa de gestión desde 0

[[José Luis Garcí]]

Aquí el módulo que reúne las personas de contacto

Aquí la imagen


Aquí un detalle de datos de familia


Aquí el código
https://gist.github.com/anonymous/5693094

y por último las nuevas funciones usadas de mi fichero Fun.pas

Código Delphi [-]
//------------------------------------------------------------------------------
//****************************************************[ ImputFamiliaaMemo ]****
//  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. 01/05/2013 Basando me en el código de Felipe Monteiro , lo adapte a
// mis necesidades, creando un imput de doble entrada en mi caso para insertar
// dos edit y grabarlo a a un memo
//------------------------------------------------------------------------------
//  [Memo]          TMemo      Donde grabaremos los datos
//  [Acaption]       String     Texto en la barra del caption
//  [Aprompt]        String     Texto aclaratorio para el mensaje o petición
//------------------------------------------------------------------------------
//---EJEMPLO--------------------------------------------------------------------
//  procedure TForm1.Button1Click(Sender: TObject);
//  begin
//     Label1.Caption:=ImputFamiliaaMemo(MEmo1,'Datos de familia','Nombre de la Esposa');
//  end;
//------------------------------------------------------------------------------
function ImputFamiliaaMemo(Memo:TMemo;const ACaption, APrompt: 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;
  Combo: TSpinEdit;
  Ed:  TEdit;
  NomH:TEdit;
  Labelfec2: TLabel;
  labelnh:Tlabel;
  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(195, 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;
      Ed:=TEdit.Create(Form);
      with Ed do
      begin
        Parent     := Form;
        Left      := Prompt.Left;
        Top       := Prompt.top+Prompt.Height+5;
        Width     := MulDiv(180, DialogUnits.X, 4);
        Text      :='';
      end;
      Labelfec2   := TLabel.Create(Form);
      with Labelfec2 do
      begin
        Parent   := Form;
        Caption  := 'Número de hijos';
        Left     := Prompt.Left;
        Top      := ED.top+ED.Height+5;
        WordWrap := True;
      end;
      Combo := TSpinEdit.Create(Form);
      with Combo do
      begin
        Parent     := Form;
        Left      := Prompt.Left;
        Value      :=0;
        Top       := Labelfec2.top+Labelfec2.Height+5;
        Width     := MulDiv(178, DialogUnits.X, 4);
      end;
      labelnh   := TLabel.Create(Form);
      with labelnh do
      begin
        Parent   := Form;
        Caption  := 'Nombre de los hijos';
        Left     := Prompt.Left;
        Top      := Combo.top+Combo.Height+5;
        WordWrap := True;
      end;
      NomH := TEdit.Create(Form);
      with NomH do
      begin
        Parent     := Form;
        Left      := Prompt.Left;
        Top       := labelnh.top+labelnh.Height+5;
        Width     := MulDiv(180, DialogUnits.X, 4);
        Text      :='';
      end;
      ButtonTop    := NomH.top+NomH.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(137, DialogUnits.X, 4), ButtonTop,ButtonWidth, ButtonHeight);
        Form.ClientHeight :=ButtonTop+ButtonHeight+5;     //Altura
      end;
      if ShowModal = mrOk then
      begin
         if Ed.Text<>'' then  Memo.Lines.Add('Esposa:[ '+ed.Text+' ]');
         if Combo.Value<>0 then
         begin
           Memo.Lines.Add('Nº de hijos:[ '+IntToStr(Combo.Value)+' ]');
           if NomH.Text<>'' then Memo.Lines.Add('Nombre de los hijos:[ '+NomH.Text+' ]');
         end;
      end;
    finally
      Form.Free;
    end;
end;

//------------------------------------------------------------------------------
//**********************************[ FECHA_DBEDIT_ENTER ]*******
// Nueva 24/11/2010  Se encarga de Asignar una fecha si el edit esta vació
// se pone en el evento OnEnter del Dbedit
//-----------Ejemplo-------------
//   FECHA_DBEDIT(dbedit1,Fecha);
//------------------------------------------------------------------------------
//******************[ AÑADIR AL PRINCIPIO DEL unit de la función  ]*******
//    const
//   VMiAutoFECHA='';
//-----------------------------------------------------------------------------
function FECHA_DBEDIT_ENTER(dbedit:tdbedit;Fecha:String=VMiautoFecha):Tdate;
begin
    try
      try
          if dbedit.Text<>'' then dbedit.Text:=Fecha
                           else begin
                                  Fecha:=DateToStr(now);
                                  dbedit.Text:=fecha;
                                end;

       StrToDate(fecha);  //Para que se produzca una excepción si no es una fecha
      except
         on E: Exception do
         begin
              ShowMessage('Se ha producido un error: ' + 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)
                  + 'Se anula la Fecha introducida y se asigna la del sistema');
             dbedit.Text:=DateToStr(Now);
             Fecha:=DateToStr(now);
         end;
      end;
    finally
        Result:=StrToDate(Fecha);
    end;
end;

//------------------------------------------------------------------------------
//*******************************************************[ FECHA_DBEDIT ]*******
// Nueva 23/11/2010  Se encarga de que con las teclas Arriba/abajo aumentar
//reducir un día, se pone en el evento OnKeyDown del Dbedit
//-----------Ejemplo-------------
//   FECHA_DBEDIT(dbedit1,Key);
//------------------------------------------------------------------------------
function FECHA_DBEDIT(dbedit:tdbedit; Tecla:Word):Boolean;
begin
  if (Tecla=VK_UP) then DBEdit.text:=DateToStr(StrToDate(DBEdit.Text)+1);  //Añadimos un día
  if (Tecla=VK_DOWN) then DBEdit.Text:=DateToStr(StrToDate(DBEdit.Text)-1);//Disminuimos un día
end;

[[José Luis Garcí]]

Aquí el módulo que reúne los bancos

Aquí la imagen



Aquí el código https://gist.github.com/anonymous/5693125

y nuevas funciones usadas de mi archivo Fun.pas

Código Delphi [-]
//------------------------------------------------------------------------------
//************************************************************[ EditLogico ]****
// JLGT 01052013 Modificada de un procedure para admitir sólo unos caracteres en un edit
// BAsado en el código de la página   http://www.nochesdecode.com.ar/2012/...en-delphi.html
//--Partes----------------------------------------------------------------------
//--Ejemplo---------------------------------------------------------------------
//  procedure TFCLIENTES.DBEdit6Change(Sender: TObject);
//  begin
//     DBEdit6.text:=EditLogico(tedit(Dbedit6));  //sólo admitira  'S N s n'
//     //O
//      DBEdit6.text:=EditLogico(tedit(Dbedit6), '0123456789');  //sólo admitira  '0 1 2 3 4 5 6 7 8 9'
//  end;
//------------------------------------------------------------------------------
function EditLogico(edit:TEdit;Cadena:string='SNsn'):String;     
var
i : integer;
aux,aux2: string;
begin
        aux2:='';
        with Edit do
        begin
                aux:=text;
                for i:=1 to length(aux) do
                if pos(aux[i],Cadena)>0 then aux2:=aux2+aux[i];
                SelStart:=length(aux2);
        end;
        Result:=aux2;
end;

//------------------------------------------------------------------------------
//**************************************************************[ CalculaDC]****
//  Parte de la idea original de   ??? 15/05/2013
// bajada de http://www.delphiaccess.com/forum/in...=showfaq;id=78
//------------------------------------------------------------------------------
// tal como estaba sin modificaciones por mi parte
//------------------------------------------------------------------------------
//  [BancoOficina]  String     Banco más oficina de 4+4 usar la funcion ceros
//  [Cuenta]         String     El nº de cuenta de 10 digitos usar la funcion ceros
//------------------------------------------------------------------------------
//---EJEMPLO--------------------------------------------------------------------
//  procedure TForm1.Button1Click(Sender: TObject);
//  begin
//    Label1.Caption := IntToStr(CalculaDC('00851755','0000321764'));
//  end;
//------------------------------------------------------------------------------
function CalculaDC(BancoOficina, Cuenta: string):integer;
  const
    Pesos: array[0..9] of integer=(6,3,7,9,10,5,8,4,2,1);
  var
    n: byte;
    iTemp: integer;
  begin
    iTemp := 0;
    for n := 0 to 7 do
      iTemp := iTemp + StrToInt(Copy(BancoOficina, 8 - n, 1)) * Pesos[n];
    Result := 11 - iTemp mod 11;
    if (Result > 9) then Result := 1 - Result mod 10;
    iTemp := 0;
    for n := 0 to 9 do
       iTemp := iTemp + StrToInt(Copy(Cuenta, 10 - n, 1)) * Pesos[n];
    iTemp := 11 - iTemp mod 11;
    if (iTemp > 9) then iTemp := 1 - iTemp mod 10;
    Result := Result * 10 + iTemp;
  end;

//**************************************************************[ CEROS ]*******
//  Delvuelve unacadena reyena de ceros al frente
//  Propia
//        EJEMPLO
//        a2:=ceros(inttostr(32),4);
//        a2 = 0032
//------------------------------------------------------------------------------
function ceros(text:string;Cant:integer):string;
var
   valor,x:integer;
   dev,con:string;
begin
   con:='';
   valor:=length(text);
   if valorthen
   begin
        for x:=1 to (cant-valor) do
        begin
            con:=con+'0';
        end;
        dev:=con+text;
   end
   else
   dev:=text;
   result:=dev;
end;