unit Geber_u;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, ComCtrls, ExtCtrls, Mask, Menus, jpeg;
type
t_Str30 =
string[30];
//string auf maximal 30 zeichen beegrenzen
t_Daten =
Record// record erzeugen
Name, Vorname, Wohnort : t_Str30;
//variablen vom typ string im record
Geburtsdatum : TDateTime;
//variablen vom typ TDateTime im record
end;
t_Datei =
File of T_Daten;
Tfrm_geber =
class(TForm)
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
ed_wohnort: TEdit;
ed_nachname: TEdit;
me_Ausgabe: TMemo;
btn_Aufrufen: TButton;
btn_neu: TButton;
BitBtn1: TBitBtn;
btn_speichern: TButton;
btn_next: TButton;
ed_vorname: TEdit;
ed_datum: TMaskEdit;
ed_geburtsdatum: TMaskEdit;
btn_zurueck: TButton;
btn_aendern: TButton;
btn_loeschen: TButton;
MainMenu1: TMainMenu;
ndern2: TMenuItem;
ndenr1: TMenuItem;
lschen1: TMenuItem;
ANFANG1: TMenuItem;
Image1: TImage;
btn_naechste: TButton;
procedure btn_AufrufenClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btn_speichernClick(Sender: TObject);
procedure btn_neuClick(Sender: TObject);
procedure btn_nextClick(Sender: TObject);
procedure btn_naechsteClick(Sender: TObject);
procedure btn_zurueckClick(Sender: TObject);
procedure btn_aendernClick(Sender: TObject);
procedure btn_loeschenClick(Sender: TObject);
procedure ndern2Click(Sender: TObject);
procedure ndenr1Click(Sender: TObject);
procedure lschen1Click(Sender: TObject);
procedure ANFANG1Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
datum,Gdatum : TDateTime;
end;
var
frm_geber: Tfrm_geber;
meine_Datei : T_Datei;
meine_Daten : T_Daten;
implementation
{$R *.DFM}
// DATEI ÖFFNEN ****************************************************************
Procedure Datei_oeffnen(
Var Datei:T_Datei);
BEGIN
TRY
reset(Datei);
// Datei existiert schon
EXCEPT
rewrite(Datei);
// Neue Datei
END;
END;
// NEUE DATEI ERSTELLEN ********************************************************
PROCEDURE Tfrm_geber.FormCreate(Sender: TObject);
BEGIN
btn_next.visible := false;
ed_datum.text := DateToStr(date);
//aktuelles datum in ed_feld ausgeben
datum := date;
me_ausgabe.CLEAR;
//memofeld leeren
ASSIGNFILE(Meine_Datei,'
Mayer.Dat');
// Datei namen geben
Datei_oeffnen(Meine_Datei);
//Datei öfnnen
end;
// nächster Datensatz lesen ****************************************************
procedure Tfrm_geber.btn_AufrufenClick(Sender: TObject);
begin
btn_aufrufen.caption := '
-->';
// beschriftung von btn ändern
btn_next.visible := false;
btn_zurueck.Visible := true;
IF NOT eof(meine_datei)
THEN BEGIN
read(meine_Datei,Meine_Daten);
// 1 Datensatz lesen
ed_nachname.text:= Meine_Daten.
Name;
// ausgeben
ed_Vorname.text := Meine_Daten.Vorname ;
ed_wohnort.text := Meine_Daten.Wohnort;
ed_Geburtsdatum.text:= datetostr(Meine_Daten.Geburtsdatum);
// geburtsdatum in ed_feld ausgeb
btn_Aufrufen.visible := true;
END
ELSE BEGIN
showmessage('
Dateiende');
// meldung ausgeben
btn_Aufrufen.visible := false;
btn_next.visible := true;
btn_zurueck.Visible := false;
btn_aendern.visible := false;
btn_loeschen.Visible := false;
btn_neu.Visible := false;
END;
END;
// SPEICHERN********************************************************************
PROCEDURE Tfrm_geber.btn_speichernClick(Sender: TObject);
BEGIN
WITH Meine_Daten
DO BEGIN
//daten aus ed_feld in variable speichern
name := ed_nachname.text;
Vorname := ed_vorname.text;
wohnort := ed_Wohnort.text;
Geburtsdatum := strtodate(ed_Geburtsdatum.text);
END;
//satzzeiger auf letzte stelle verschieben
SEEK(meine_Datei,filesize(meine_datei));
// Datensatz in Datei schreiben
write(Meine_Datei, Meine_Daten);
ed_nachname.text := '
';
ed_vorname.text := '
';
ed_geburtsdatum.text := '
';
ed_wohnort.text := '
';
//SetFocus bewirkt, daß Tastaturereignisse an das Eingabefeld weitergeleitet werden. Dieses erhält den Fokus allerdings nicht, wenn es durch einen Aufruf der Methode Hide ausgeblendet wurde.
ed_nachname.setfocus
END;
// ERSTER DS AUFRUFEN***********************************************************
PROCEDURE Tfrm_geber.btn_nextClick(Sender: TObject);
BEGIN
btn_next.Visible := false;
btn_speichern.visible := false;
// satzzeiger auf 0 setzen
seek(Meine_Datei,0);
// auf eof prüfen
IF NOT eof(meine_datei)
THEN BEGIN
ed_nachname.visible := true;
ed_vorname.visible := true;
ed_wohnort.visible := true;
ed_geburtsdatum.visible := true;
label1.visible := true;
label2.visible := true;
label3.visible := true;
// Datensatz lesen
read(meine_Datei,Meine_Daten);
// ausgeben
ed_Nachname.text:= Meine_Daten.
Name;
ed_Vorname.text := Meine_Daten.Vorname ;
ed_wohnort.text := Meine_Daten.Wohnort;
ed_Geburtsdatum.text:= datetostr(Meine_Daten.Geburtsdatum);
btn_Aufrufen.visible := true;
END
ELSE BEGIN
btn_aufrufen.visible := false;
// meldung ausgeben wenn keine datei vorhanden ist
showmessage('
keine Daten vorhanden');
END;
END;
//anstehende gebursttage in memofeld ausgeben***********************************
PROCEDURE Tfrm_geber.btn_naechsteClick(Sender: TObject);
VAR i : integer;
jahrH,monatH,tagH,jahrG,monatG,tagG :word;
vorname,nachname,Wohnort :
STRING;
hilf,datum1,datum2 : tdatetime;
BEGIN
me_ausgabe.Visible := true;
// me leeren
me_Ausgabe.Clear;
// in erste zeiele wir nächste geburtstage ausgegeben
me_Ausgabe.lines[0] := '
Nächste Geburtstage ' ;
// leerzeile
me_Ausgabe.lines.add('
');
// in datum wird aktuelles datum geschrieben
datum := date;
//satzzeiger auf 0
seek(meine_Datei,0);
// schleifenbeginn von 1-ende von datei
FOR i:=1
TO FileSize(meine_datei)
DO BEGIN
// auf eof prüfen
IF NOT eof(meine_datei)
THEN BEGIN
// datensatz lensen
read(meine_Datei,Meine_Daten);
// daten in variablen schreiben
vorname := meine_daten.Vorname;
nachname := Meine_Daten.
Name;
Wohnort := meine_daten.wohnort;
Gdatum := Meine_Daten.Geburtsdatum;
//datum in jah,tag und monat auspalten
decodedate(datum,jahrH,monatH,tagH);
decodedate(Gdatum,jahrG,monatG,tagG);
// wenn der geburtstag schon war dann aktuelles jahr +1 ausgeben
IF (monatH>monatG)
THEN BEGIN
jahrH := jahrH +1;
hilf := encodedate(jahrH,monatG,TagG) ;
me_Ausgabe.lines.add(vorname + '
' + nachname + '
' +datetostr(hilf)+ '
'+ wohnort);
me_Ausgabe.lines.add('
');
// leerzeile
END
// wenn der geburtstag noch kommt einfach datum ausgeben mi aktuellem jahr
ELSE BEGIN
hilf := encodedate(jahrH,monatG,tagG);
me_ausgabe.lines.add(vorname + '
' + nachname + '
' +datetostr(hilf)+ '
'+ wohnort);
me_Ausgabe.lines.add('
');
//leerzeile
END;
END;
END;
// satzzeiger auf 0
seek(Meine_Datei,0);
END;
//zurück blättern **************************************************************
PROCEDURE Tfrm_geber.btn_zurueckClick(Sender: TObject);
VAR position :integer;
BEGIN
IF NOT (eof(meine_datei))
AND (filepos(meine_datei)>1)
// auf dateiende prüfen
THEN BEGIN
position:= filepos(meine_datei)-2;
// satzzeigerPOSITION -2
seek (meine_datei,position) ;
// satzzeiger um -2 ZURÜCK SChIEBEN
read(meine_Datei,Meine_Daten);
//datensatz lesen
ed_Nachname.text:= Meine_Daten.
Name;
// daten in ed_feld schreiben
ed_Vorname.text := Meine_Daten.Vorname ;
// daten in ed_feld schreiben
ed_wohnort.text := Meine_Daten.Wohnort;
ed_Geburtsdatum.text:= datetostr(Meine_Daten.Geburtsdatum);
END;
END;
//ändern***********************************************************************
PROCEDURE Tfrm_geber.btn_aendernClick(Sender: TObject);
BEGIN
WITH Meine_Daten
DO BEGIN
name := ed_nachname.text;
// daten in variablen schreiben
Vorname := ed_vorname.text;
wohnort := ed_Wohnort.text;
Geburtsdatum := strtodate(ed_Geburtsdatum.text);
// daten in variablen schreiben
END;
seek(meine_Datei,filepos(meine_datei)-1);
//satzzeiger 1 zurück schieben
write(Meine_Datei, Meine_Daten);
// Datensatz in Datei schreiben
// button labels etc visible ändern
ed_vorname.Visible := false ;
ed_nachname.Visible := false ;
ed_wohnort.Visible := false ;
ed_geburtsdatum.Visible := false ;
label1.Visible := false ;
label2.Visible := false ;
label3.Visible := false ;
label4.Visible := false ;
btn_aendern.Visible := false;
btn_aufrufen.visible := false;
btn_zurueck.Visible := false;
btn_naechste.visible := true;
me_ausgabe.visible := true;
END;
//loeschen**********************************************************************
PROCeDURE Tfrm_geber.btn_loeschenClick(Sender: TObject);
VAR
pos1 : integer ;
BEGIN
pos1 := filepos(meine_datei)-1;
// position vom letzten datensatz merken
seek(meine_datei,(filesize(meine_datei)-1));
// satzzeiger auf letzte datei
WITH Meine_Daten
DO BEGIN
read(meine_datei,meine_daten);
// datensatz lesen
name := Meine_Daten.
Name;
// daten in variablen schreiben
vorname := Meine_daten.Vorname;
wohnort := meine_daten.Wohnort;
geburtsdatum := meine_daten.Geburtsdatum;
seek(meine_datei,(filesize(meine_datei)-1));
// satzzeiger auf letzte datei
Truncate(meine_datei);
// alle datensätze die noch folgen abschneiden
seek(meine_datei,pos1);
// satzzeiger auf zuvor gemerkte position zurüeck schieben
write(Meine_Datei, Meine_Daten);
// daten schreiben
meine_daten.vorname := vorname;
// in record schreiben alte daten überschreiben
meine_daten.
name :=
name;
meine_daten.wohnort := wohnort ;
meine_daten.geburtsdatum := geburtsdatum;
END;
// button labels etc visible ändern
ed_vorname.Visible := false ;
ed_nachname.Visible := false ;
ed_wohnort.Visible := false ;
ed_geburtsdatum.Visible := false ;
label1.Visible := false ;
label2.Visible := false ;
label3.Visible := false ;
label4.Visible := false ;
btn_aufrufen.Visible := false;
btn_zurueck.Visible := false;
btn_aendern.Visible := false;
btn_naechste.visible := true;
me_ausgabe.visible := true;
btn_loeschen.visible := false;
me_ausgabe.visible := false;
btn_next.visible := false;
END;
//menü speichern****************************************************************
PROCEDURE Tfrm_geber.ndern2Click(Sender: TObject);
BEGIN
// button labels etc visible ändern
ed_vorname.Visible := true ;
ed_nachname.Visible := true ;
ed_wohnort.Visible := true ;
ed_geburtsdatum.Visible := true ;
label1.Visible := true ;
label2.Visible := true ;
label3.Visible := true ;
label4.Visible := true ;
btn_speichern.Visible := true ;
btn_speichern.Caption := '
speichern';
btn_naechste.Visible := false ;
btn_neu.Visible := true ;
btn_aendern.Visible := false;
btn_aufrufen.visible := false;
btn_next.visible := false;
me_ausgabe.Visible := false;
END;
//menü ändern*******************************************************************
PROCEDURE Tfrm_geber.ndenr1Click(Sender: TObject);
BEGIN
// button labels etc visible ändern
ed_vorname.Visible := true ;
ed_nachname.Visible := true ;
ed_wohnort.Visible := true ;
ed_geburtsdatum.Visible := true ;
label1.Visible := true ;
label2.Visible := true ;
label3.Visible := true ;
label4.Visible := true ;
btn_aufrufen.Visible := true;
btn_loeschen.Visible := false;
btn_neu.Visible := false;
btn_zurueck.Visible := false;;
btn_speichern.Visible := false;
btn_aendern.Visible := true;
btn_naechste.visible := false;
me_ausgabe.visible := false;
END;
//menü löschen******************************************************************
PROCEDURE Tfrm_geber.lschen1Click(Sender: TObject);
BEGIN
// button labels etc visible ändern
ed_vorname.Visible := true ;
ed_nachname.Visible := true ;
ed_wohnort.Visible := true ;
ed_geburtsdatum.Visible := true ;
label1.Visible := true ;
label2.Visible := true ;
label3.Visible := true ;
label4.Visible := true ;
btn_aufrufen.Visible := true;
btn_zurueck.Visible := false;
btn_next.Visible := true;
btn_aendern.Visible := false;
btn_naechste.visible := false;
me_ausgabe.visible := false;
btn_loeschen.Visible := true;
END;
//menü auf ANFANG***************************************************************
PROCEDURE Tfrm_geber.ANFANG1Click(Sender: TObject);
BEGIN
// button labels etc visible ändern
ed_vorname.Visible := false ;
ed_nachname.Visible := false ;
ed_wohnort.Visible := false ;
ed_geburtsdatum.Visible := false ;
label1.Visible := false ;
label2.Visible := false ;
label3.Visible := false ;
label4.Visible := false ;
btn_aufrufen.Visible := false;
btn_zurueck.Visible := false;
btn_aendern.Visible := false;
btn_naechste.visible := true;
btn_next.Visible := false;
btn_speichern.visible := false;
btn_neu.Visible := false;
me_ausgabe.visible := false;;
btn_loeschen.Visible := false;
END;
// NEU**************************************************************************
PROCEDURE Tfrm_geber.btn_neuClick(Sender: TObject);
BEGIN
//ed_felder leeren und buttons sichtbar machen
ed_nachname.visible := true;
ed_vorname.visible := true;
ed_wohnort.visible := true;
ed_geburtsdatum.visible := true;
label1.visible := true;
label2.visible := true;
label3.visible := true;
ed_nachname.text := '
';
ed_vorname.text := '
';
ed_Wohnort.text := '
';
ed_geburtsdatum.text := '
';
ed_nachname.setfocus;
btn_speichern.visible := true;
END;
END.
//<--- PROGRAMM ENDE