Programade administracion

[Martin2]

El programa consta de dos Units
Unit 1:

Codigo

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, StdCtrls, Menus, cliente;

type
TForm1 = class(TForm)

MainMenu1: TMainMenu;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
Archivo1: TMenuItem;
Abrir1: TMenuItem;
Guardar1: TMenuItem;
Salir1: TMenuItem;
Buscar: TButton;
Salir: TButton;
Agregar: TButton;
verEditar: TButton;
Eliminar: TButton;
Label1: TLabel;
Edit1: TEdit;
StringGrid1: TStringGrid;
Label13: TLabel;
procedure Abrir1Click(Sender: TObject);
procedure Guardar1Click(Sender: TObject);
procedure Salir1Click(Sender: TObject);
procedure BuscarClick(Sender: TObject);
procedure SalirClick(Sender: TObject);
procedure AgregarClick(Sender: TObject);
procedure EliminarClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure StringGrid1Click(Sender: TObject);

private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
Form2: TForm2;
nu : TManejoSocios;
nombreArchivo : String;
buscarSocio : boolean;
eliminarSocio : boolean;
numeroDeRegistro : integer;
volver : boolean;

implementation

{$R *.dfm}

procedure TForm1.Abrir1Click(Sender: TObject);

var cod : byte;
var nomarchivo : string;



begin
nu := TManejoSocios.Create;

OpenDialog1.Execute;


nomarchivo:=form1.OpenDialog1.FileName;
if nomarchivo = '' then
begin

exit
end
else
begin
{$I-}
nu.AbrirArchivo(nomarchivo);
{$I+}
cod := IOResult;

if cod=0 then
begin

form1.Label13.Caption := '00';
nombreArchivo := nomarchivo;
end
else
begin

exit
end

end;

end;

procedure TForm1.Guardar1Click(Sender: TObject);

var nombreNuevo : string;

begin
Form1.SaveDialog1.Execute ;

nombreNuevo:= Form1.SaveDialog1.FileName;

if nombreNuevo = '' then
begin
showMessage('No se guardo con otro nombre');
exit;
end

else
begin
if nombreArchivo = '' then
begin
ShowMessage('No hay archivo abierto para copiar.');
end
else
begin
nu.GuardarComo(nombreArchivo, nombreNuevo);
end;
end;

end;

procedure TForm1.Salir1Click(Sender: TObject);
begin
form1.Close;
end;

procedure TForm1.BuscarClick(Sender: TObject);

begin

if Form1.Label13.Caption = '00' then
begin
buscarSocio:= true;
form1.Buscar.Enabled := true;

ShowMessage('Ingrese el numero de NOMBRE en el campo NOMBRE y preciones el boton Aceptar.');

exit;
end
else
begin
ShowMessage('Primero hay que abrir el archivo');
//cod:= 1;
end;


end;

procedure TForm1.SalirClick(Sender: TObject);
begin



if form1.Label13.Caption = '' then
begin
ShowMessage('No se puede cerrar el archivo porque no esta abierto.');
end
else

begin
nu.CerrarArchivo ;
form1.Label13.Caption := '';
nombreArchivo := '';
end;

end;

procedure TForm1.AgregarClick(Sender: TObject);

begin
Form2 := TForm2.Create(nil);
Try
Form2.ShowModal;
Finally
FreeAndNil(Form2);
End;
end;


procedure TForm1.EliminarClick(Sender: TObject);

begin

if Form1.Label13.Caption = '00' then
begin
form2.Edit2.Enabled := false;
form2.Edit3.Enabled := false;
form2.Edit4.Enabled := false;
form2.Edit5.Enabled := false;
form2.Edit6.Enabled := false;

ShowMessage('Precione el boton Eliminar y el Cliente sera eliminado.');

eliminarSocio := true;

//habilitamos el boton.
form1.Eliminar.Enabled := true;

end
else
begin
ShowMessage('Primero hay que abrir el archivo');

end;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin
with StringGrid1 do
begin
// Título de las columnas
Cells[0, 0] := 'APELLIDO NOMBRES';
Cells[1, 0] := 'SALDO';
Cells[2, 0] := 'TELEFONO';
Cells[3, 0] := 'EDAD';

end;
end;
procedure TForm1.StringGrid1Click(Sender: TObject);

begin

with StringGrid1 do
begin
// Título de las columnas
Cells[0, 0] := 'APELLIDO NOMBRES';
Cells[1, 0] := 'SALDO';
Cells[2, 0] := 'TELEFONO';
Cells[3, 0] := 'EDAD';

end;

end;

end.

[Martin2]

Unit2 se llama cliente

Código Delphi [-]

Unit cliente;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm2 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    Edit6: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Edit7: TEdit;
    Label9: TLabel;
    Edit8: TEdit;
    Label10: TLabel;
    Edit9: TEdit;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    end;


    //declaracion de la estructura tipo record Socio
    Type
    Socio= Record
    Apellido, nombres: string[20];
    DNI, dn, mn, an : Real;
    end;

    //declaracion de la estructura tipo record SocioPro
    Type
      SocioPro= Record
      Apellido, nombres: string[20];
      edad : Real;
    end;

  //declaracion de la clase TManejoSocios
  TManejoSocios = class


  private
  
    { Declaracion parte privada }
     Archi:File of Socio;

  public
    { Public declarations }

    Lista: array of SocioPro;



    procedure AbrirArchivo(ArchiFisico:string);
    procedure ArchivoNuevo(ArchiFisico:string);
    procedure GrabarSocio(c:Socio ;var cod:byte);
    procedure BuscarSocio(var i:integer; var c:Socio ; var m:string; numDoc:longint);
    procedure EliminarSocio(c:Socio; i:integer; var mensaje : string);
    procedure CerrarArchivo;
    procedure GuardarComo(viejo, nuevo : string);





  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

//---------------------------------------------
procedure TManejoSocios.AbrirArchivo(ArchiFisico:string);
begin
  AssignFile(Archi,ArchiFisico);
  Reset(Archi);
end;

//---------------------------------------------
procedure TManejoSocios.ArchivoNuevo(ArchiFisico:string);
begin
AssignFile(Archi,ArchiFisico);
Rewrite(Archi);
end;

//---------------------------------------------
procedure TManejoSocios.GrabarSocio(c:Socio; var
cod:byte);
begin
{$I-}
Seek(Archi, FileSize(archi));
{$I+};
cod:=IOResult;
If cod=0 then
Write(Archi,c);
end;

//---------------------------------------------
procedure TManejoSocios.BuscarSocio(var i:integer; var c:Socio; var m:string; numDoc:longint);

    var
       Largo:word;
       ii:integer;




    begin
{$I-}
 Largo:=FileSize(archi);
{$I+};

  If (IOResult<>0)
  then
    begin
      m:='Problemas con el archivo. Está creado o abierto ?';
      exit // sale del procedure
    end;

    //con un FOR, vamos a recorrer del primer al ultimo registro
    //y vemos con un IF si el string que mandamos a buscar coincide con
    //el que esta almacenado en el campo.
    for ii:= 0 to Largo - 1 do
    begin
       seek(Archi, ii);

        Read(archi,c);

        if c.DNI = numDoc then
            begin
              i:=ii;
              m:='Ok';
              exit;

            end
        else

    end;

   ShowMessage('No hay coincidencias');

  end;


//----------------------------------------------
procedure TManejoSocios.CerrarArchivo;
begin
CloseFile(Archi)
end;

//----------------------------------------------
procedure TManejoSocios.GuardarComo(viejo, nuevo: string);
var
arch_entrada, arch_salida: file;
buffer: array[1..2048] of char;
numleido, numescrito: longint;
begin
// open files - no error checking you should add that
assign(arch_entrada, viejo);
reset(arch_entrada, 1);
assign(arch_salida, nuevo);
rewrite(arch_salida, 1);

// copy file
repeat
blockread(arch_entrada, buffer, sizeof(buffer), numleido);
blockwrite(arch_salida, buffer, numleido, numescrito);
until (numleido = 0) or (numescrito <> numleido);
close(arch_entrada);
close(arch_salida);
ShowMessage('El archivo fue guardado como: ' + nuevo);
end;



//---------------------------------------------
procedure TManejoSocios.EliminarSocio (c:Socio; i:integer; var mensaje : string);

var cod:byte;

begin
{$I-}
Seek(Archi, i);
{$I+};
cod:=IOResult;

c.Apellido :='';
c.nombres :='';
c.DNI :=0;
c.dn := 0;
c.mn := 0;
c.an := 0;


If cod=0 then

  begin
    Write(Archi,c);
  end

else

  begin
   mensaje := 'Ha ocurrido un error y no pudo realizarce la operacion';
  end



end;


procedure TForm2.Button1Click(Sender: TObject);
begin
Close;
end;

end.

[Martin2]

Aca envio las captura de pantalla del Form1 que pertecene a la Unit1
Dentro del MainMenu Archivo contiene las opciones Abrir y Guardar

(ver imagen)

y el form2 que pertenece a la unit Cliente

(ver imagen)

Si no les llego las imagenes avisen no las pude pasar por aca porque dice que no tengo todavia esa autorizacion

[Neftali [Germán.Estévez]]

Empezado por Martin2

Aca envio las captura de pantalla del Form1 que pertecene a la Unit1
Dentro del MainMenu Archivo contiene las opciones Abrir y Guardar

(ver imagen)

y el form2 que pertenece a la unit Cliente

(ver imagen)

Si no les llego las imagenes avisen no las pude pasar por aca porque dice que no tengo todavia esa autorizacion

Hola Martin2, gracias por el código.
Cuando añadas código delphi utiliza los TAG's verás que se lee mucho mejor (arriba ya te los he añadido yo).

En cuanto a las imágenes, todavía no tienes permiso para añadirlas ya que eres nuevo en los foros. Puedes enviarme un privado con los links y yo te modifico el mensaje.