unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Grids, ExtCtrls, Menus, ActnList, StdActns, ComCtrls,
XPMan, ImgList, ToolWin, Buttons, IniFiles, Shellapi;
type
TForm1 =
class(TForm)
StringGrid1: TStringGrid;
MainMenu1: TMainMenu;
Datei1: TMenuItem;
Info1: TMenuItem;
Neu1: TMenuItem;
StatusBar1: TStatusBar;
XPManifest1: TXPManifest;
Beenden1: TMenuItem;
ToolBar1: TToolBar;
Bearbeiten1: TMenuItem;
Info2: TMenuItem;
ImageList1: TImageList;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
ToolButton6: TToolButton;
ToolButton7: TToolButton;
N1: TMenuItem;
Speichern1: TMenuItem;
Neualt1: TMenuItem;
Datensatzndern1: TMenuItem;
Hilfe1: TMenuItem;
ToolButton8: TToolButton;
PopupMenu1: TPopupMenu;
ndern1: TMenuItem;
Lschen2: TMenuItem;
Neu2: TMenuItem;
Neufortlaufend1: TMenuItem;
N4: TMenuItem;
ToolButton9: TToolButton;
ToolButton10: TToolButton;
ToolButton11: TToolButton;
WebseiteBesuchen1: TMenuItem;
N5: TMenuItem;
ToolButton12: TToolButton;
ToolButton13: TToolButton;
procedure FormCreate(Sender: TObject);
procedure Beenden1Click(Sender: TObject);
procedure ToolButton7Click(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure ToolButton4Click(Sender: TObject);
procedure Info2Click(Sender: TObject);
procedure ToolButton6Click(Sender: TObject);
procedure ToolButton8Click(Sender: TObject);
procedure Hilfe1Click(Sender: TObject);
procedure Neu1Click(Sender: TObject);
procedure Neualt1Click(Sender: TObject);
procedure Speichern1Click(Sender: TObject);
procedure Datensatzndern1Click(Sender: TObject);
procedure Lschen1Click(Sender: TObject);
procedure FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
procedure ToolButton9Click(Sender: TObject);
procedure ToolButton10Click(Sender: TObject);
procedure Edit3KeyPress(Sender: TObject;
var Key: Char);
procedure WebseiteBesuchen1Click(Sender: TObject);
procedure ToolButton12Click(Sender: TObject);
procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
procedure ZeileBlenden(sg: TStringgrid; Zeile: integer);
end;
type typ_datensatz =
RECORD
nummer: Integer;
medium:
String[50];
name:
String[40];
kategorie:
String[20];
telefon:
String[20];
end;
type TDatum =
RECORD
asldatum:
String;
ruckdatum:
String;
end;
var
Form1: TForm1;
index :
Array[1..1000]
of typ_datensatz;
datum :
Array[1..1000]
of TDatum;
nummer :Integer;
datei :
File of typ_datensatz;
i,a,b,c,d,e,f :Integer;
aenderprf :Boolean;
implementation
uses Unit2, Unit3;
{$R *.dfm}
procedure gridspeichern(grd:TStringGrid;Datei:
string);
var sl:TStringlist;
x,y:integer;
begin
sl:=TStringlist.create;
sl.add(inttostr(grd.colcount));
sl.add(inttostr(grd.rowcount));
for x:=0
to grd.ColCount-1
do
for y:=0
to grd.RowCount-1
do
sl.add(grd.cells[x,y]);
for x:=0
to grd.ColCount-1
do
sl.add(inttostr(grd.ColWidths[x]));
for x:=0
to grd.RowCount-1
do
sl.add(inttostr(grd.RowHeights[x]));
sl.add(inttostr(grd.clientwidth));
sl.add(inttostr(grd.clientheight));
sl.add(inttostr(ord(grd.ScrollBars)));
sl.savetofile(datei);
sl.free;
end;
procedure gridladen(grd:TStringGrid;Datei:
string;angleichen:boolean);
var sl:TStringlist;
x,y,z:integer;
begin
sl:=TStringlist.create;
sl.loadfromfile(datei);
grd.colcount:=strtoint(sl.strings[0]);
grd.rowcount:=strtoint(sl.strings[1]);
z:=2;
for x:=0
to grd.ColCount-1
do
for y:=0
to grd.RowCount-1
do begin
grd.cells[x,y]:=sl.strings[z];
inc(z);
end;
if angleichen
then begin
for x:=0
to grd.ColCount-1
do begin
grd.ColWidths[x]:=strtoint(sl.strings[z]);
inc(z);
end;
for x:=0
to grd.RowCount-1
do begin
grd.RowHeights[x]:=strtoint(sl.strings[z]);
inc(z);
end;
grd.clientwidth:=strtoint(sl.strings[z]);
grd.clientheight:=strtoint(sl.strings[z+1]);
grd.ScrollBars:=TScrollStyle(strtoint(sl.strings[z+2]));
end;
sl.free;
end;
// Zeilen ein- und ausblenden
procedure ZeileBlenden(sg: TStringgrid; Zeile: integer);
begin
if (Zeile < sg.rowcount)
and (Zeile >= 0)
then begin
if sg.rowheights[Zeile] <= abs(sg.GridlineWidth)
then
sg.rowheights[Zeile] := sg.DefaultRowHeight
else sg.rowheights[Zeile] := -sg.GridlineWidth;
end;
end;
// Zeilen löschen
procedure GridDeleteRow(
const Grid : TStringGrid; RowNumber : Integer);
var
i : Integer;
begin
for i := RowNumber
to Grid.RowCount - 2
do
Grid.Rows[i].Assign(Grid.Rows[i+ 1]);
Grid.Rows[Grid.RowCount-1].Clear;
Grid.RowCount := Grid.RowCount - 1;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
Ini: TIniFile;
begin
Ini := TIniFile.Create(ExtractFilePath(ParamStr(0)) + '
Config.ini');
try
WindowState := TWindowState(Ini.ReadInteger('
Default', '
WindowState', 0));
finally
Ini.Free;
end;
aenderprf:=False;
// Titelzeile erstellen
StringGrid1.ColWidths[0]:=25;
StringGrid1.ColWidths[1]:=220;
StringGrid1.ColWidths[2]:=130;
StringGrid1.ColWidths[3]:=150;
StringGrid1.ColWidths[4]:=110;
StringGrid1.ColWidths[5]:=100;
StringGrid1.ColWidths[6]:=150;
Stringgrid1.cells[0,0]:='
';
Stringgrid1.cells[1,0]:='
Titel (Autor), Gegenstand';
Stringgrid1.cells[2,0]:='
Kategorie';
Stringgrid1.cells[3,0]:='
Name, Vorname';
Stringgrid1.cells[4,0]:='
Telefon';
Stringgrid1.cells[5,0]:='
Geliehen am';
Stringgrid1.cells[6,0]:='
';
// Letzte Zeile ausblenden
ZeileBlenden(StringGrid1, Stringgrid1.rowcount-1);
if FileExists('
db.lhh')
then
begin
gridladen(StringGrid1,'
db.lhh',true);
end else MessageDlg('
Die Datei "db.lhh" konnte nicht gefunden werden!' + CHR(13)
+ '
Das Programm wird nach dem Speichern eine neue erstellen.', mtWarning,[mbOK],0);
if Stringgrid1.rowcount=2
then ToolButton2.Enabled:=False;
if StringGrid1.RowCount=3
then
begin
StatusBar1.Panels[0].Text:=('
1 Eintrag');
end else
begin
StatusBar1.Panels[0].Text:=FloatToStr(Stringgrid1.RowCount-2)+ '
Einträge';
end;
a:=StringGrid1.ColWidths[0];
b:=StringGrid1.ColWidths[1];
c:=StringGrid1.ColWidths[2];
d:=StringGrid1.ColWidths[3];
e:=StringGrid1.ColWidths[4];
f:=StringGrid1.ColWidths[5];
StringGrid1.Row:=StringGrid1.RowCount-1;
end;
procedure TForm1.Beenden1Click(Sender: TObject);
begin
Close;
end;
procedure TForm1.ToolButton7Click(Sender: TObject);
var n: Integer;
begin
if Form3.GroupBox1.Visible=False
then
begin
if (StringGrid1.Row>-1)
and (StringGrid1.Row<StringGrid1.RowCount-1)
then
begin
if Application.MessageBox('
Möchten Sie wirklich diesen Eintrag löschen?','
Löschen bestätigen',36)=6
then
begin
GridDeleteRow(StringGrid1, StringGrid1.Row);
StringGrid1.Row:=StringGrid1.RowCount-1;
for n := 1
to StringGrid1.RowCount - 1
do
begin
StringGrid1.Cells[0,n]:=IntToStr(n);
end;
ZeileBlenden(StringGrid1, Stringgrid1.rowcount-1);
if Stringgrid1.rowcount=2
then
begin
ToolButton2.Enabled:=False;
end;
if StringGrid1.RowCount=3
then
begin
StatusBar1.Panels[0].Text:=('
1 Eintrag');
end else
begin
StatusBar1.Panels[0].Text:=FloatToStr(Stringgrid1.RowCount-2)+ '
Einträge';
end;
aenderprf:=True;
ToolButton4.Enabled:=True;
end;
end else Application.MessageBox('
Löschen nicht möglich, bitte erst einen Eintrag auswählen!','
Fehler',16);
end else Application.MessageBox('
Löschen nicht möglich!','
Fehler',16);
end;
procedure TForm1.ToolButton1Click(Sender: TObject);
begin
Form3.ShowModal;
//StringGrid1.Row:=StringGrid1.RowCount-1; ???
Form3.DateTimePicker1.Date:=Now;
Form3.GroupBox1.Caption:='
Neuen Eintrag einfügen';
Form3.Edit1.Text:='
';
Form3.Edit2.Text:='
';
Form3.Edit3.Text:='
';
Form3.ComboBox1.Text:='
';
Form3.Edit2.SetFocus;
Form3.BitBtn1.Visible:=True;
Form3.BitBtn3.Visible:=False;
Form3.BitBtn2.Enabled:=True;
end;
procedure TForm1.ToolButton2Click(Sender: TObject);
begin
if Stringgrid1.rowcount>2
then
begin
Form3.ShowModal;
StringGrid1.Row:=StringGrid1.RowCount-1;
Form3.DateTimePicker1.Date:=Now;
Form3.GroupBox1.Caption:='
Neuen Eintrag einfügen';
Form3.BitBtn1.Visible:=True;
Form3.BitBtn3.Visible:=False;
Form3.BitBtn2.Enabled:=True;
i:=Stringgrid1.rowcount-2;
index[i].kategorie:=Stringgrid1.cells[2,i];
index[i].
name:=Stringgrid1.cells[3,i];
index[i].telefon:=Stringgrid1.cells[4,i];
Form3.Edit2.Text:=index[i].
name;
Form3.ComboBox1.Text:=index[i].kategorie;
Form3.Edit3.Text:=index[i].telefon;
Form3.Edit1.SetFocus;
end else Application.MessageBox('
Diese Funktion steht erst ab den ersten Eintag zur Verfügung!','
Fehler',16);
end;
procedure TForm1.ToolButton4Click(Sender: TObject);
begin
gridspeichern(StringGrid1,'
db.lhh');
ToolButton4.Enabled:=False;
aenderprf:=False;
end;
procedure TForm1.Info2Click(Sender: TObject);
begin
AboutBox.Show;
end;
procedure TForm1.ToolButton6Click(Sender: TObject);
begin
if (StringGrid1.Row>-1)
and (StringGrid1.Row<StringGrid1.RowCount-1)
then
begin
Form3.ShowModal;
Form3.GroupBox1.Caption:='
Eintrag editieren';
Form3.BitBtn1.Visible:=False;
Form3.BitBtn3.Visible:=True;
Form3.BitBtn2.Enabled:=True;
Form3.Edit2.SetFocus;
i:=Stringgrid1.row;
index[i].medium:=StringGrid1.Cells[1,i];
index[i].kategorie:=Stringgrid1.cells[2,i];
index[i].
name:=Stringgrid1.cells[3,i];
index[i].telefon:=Stringgrid1.cells[4,i];
datum[i].asldatum:=Stringgrid1.cells[5,i];
Form3.Edit1.Text:=index[i].medium;
Form3.Edit2.Text:=index[i].
name;
Form3.ComboBox1.Text:=index[i].kategorie;
Form3.Edit3.Text:=index[i].telefon;
Form3.DateTimePicker1.Date:=StrToDate(datum[i].asldatum);
end else Application.MessageBox('
Editieren nicht möglich, bitte erst einen Eintrag auswählen!','
Fehler',16);
end;
procedure TForm1.ToolButton8Click(Sender: TObject);
begin
ShowMessage('
Die Hilfe steht noch nicht zur Verfügung!');
end;
procedure TForm1.Hilfe1Click(Sender: TObject);
begin
ToolButton8Click(Sender);
end;
procedure TForm1.Neu1Click(Sender: TObject);
begin
ToolButton1Click(Sender);
end;
procedure TForm1.Neualt1Click(Sender: TObject);
begin
ToolButton2Click(Sender);
end;
procedure TForm1.Speichern1Click(Sender: TObject);
begin
ToolButton4Click(Sender);
end;
procedure TForm1.Datensatzndern1Click(Sender: TObject);
begin
ToolButton6Click(Sender);
end;
procedure TForm1.Lschen1Click(Sender: TObject);
begin
ToolButton7Click(Sender);
end;
procedure TForm1.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
if (StringGrid1.ColWidths[0]<>a)
or (StringGrid1.ColWidths[1]<>b)
or (StringGrid1.ColWidths[2]<>c)
or (StringGrid1.ColWidths[3]<>d)
or (StringGrid1.ColWidths[4]<>e)
or (StringGrid1.ColWidths[5]<>f)
then
begin
aenderprf:=True;
end;
if aenderprf=True
then
begin
case MessageDlg('
Möchten Sie die Änderungen speichern?', mtConfirmation,
[mbYes, mbNo, mbCancel], 0)
of
idYes: ToolButton4Click(Sender);
idCancel: CanClose := False
end
end;
end;
procedure TForm1.FormClose(Sender: TObject;
var Action: TCloseAction);
var
Ini: TIniFile;
begin
Ini := TIniFile.Create(ExtractFilePath(ParamStr(0)) + '
Config.ini');
try
Ini.WriteInteger('
Default', '
WindowState', Ord(WindowState));
finally
Ini.Free;
end;
Action:=caFree;
end;
procedure TForm1.ToolButton9Click(Sender: TObject);
begin
AboutBox.Show;
end;
procedure TForm1.ToolButton10Click(Sender: TObject);
begin
Close;
end;
procedure TForm1.Edit3KeyPress(Sender: TObject;
var Key: Char);
begin
if not (Key
in ['
0'..'
9','
-', '
(', '
)', '
+', Char(VK_BACK)])
then
Key:=#0;
end;
procedure TForm1.ToolButton12Click(Sender: TObject);
begin
ShellExecute(Application.Handle, '
open', PChar('
http://www.ornec.de'),
nil,
nil, 0);
end;
procedure TForm1.WebseiteBesuchen1Click(Sender: TObject);
begin
ToolButton12Click(Sender);
end;
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var iTage: Integer;
begin
with StringGrid1
do
// auf Acol muss nicht reagiert werden = komplette Zeile färben
if ARow
in [FixedRows..RowCount-2]
then //nur die Zeilen färben
begin
iTage:=Round(Trunc(now) - StrToDate(Cells[5, ARow]));
if (iTage>=14)
and (iTage<28)
then
begin
Canvas.Brush.Color:=
RGB(176,176,255);
//Hintergrundfarbe - Blau
end else if (iTage>=28)
then
begin
Canvas.Brush.Color:=
RGB(255,106,106);
//Hintergrundfarbe - Rot
end;
Canvas.FillRect(Rect);
Canvas.TextOut(Rect.Left+2, Rect.Top+2, Cells[ACol, ARow]);
end;
end;
end.