unit Unit8;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Grids, ExtCtrls, DBCtrls,DateUtils, FileCtrl;
type
TFindFilesOption = (ffoExcludePath, ffoExcludeExt);
TFindFilesOptions =
set of TFindFilesOption;
TForm8 =
class(TForm)
Button3: TButton;
Button4: TButton;
Image1: TImage;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label9: TLabel;
Label10: TLabel;
Label11: TLabel;
Label12: TLabel;
Label13: TLabel;
Label14: TLabel;
Label15: TLabel;
Memo3: TMemo;
Memo4: TMemo;
Memo5: TMemo;
Memo6: TMemo;
Memo7: TMemo;
Memo8: TMemo;
Panel1: TPanel;
Panel2: TPanel;
Panel3: TPanel;
Panel4: TPanel;
Panel5: TPanel;
Panel6: TPanel;
Panel7: TPanel;
Panel8: TPanel;
Panel9: TPanel;
Panel10: TPanel;
Panel11: TPanel;
Panel12: TPanel;
Panel14: TPanel;
StringGrid1: TStringGrid;
Timer6: TTimer;
Button1: TButton;
FileListBox1: TFileListBox;
FileListBox2: TFileListBox;
Label7: TLabel;
Label8: TLabel;
Button2: TButton;
ListBox1: TListBox;
procedure Button1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure Panel12MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure Timer6Timer(Sender: TObject);
procedure FileListBox1Change(Sender: TObject);
procedure FileListBox2Change(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{Private-Deklarationen }
Lb,Celltext,liste1,liste2,Liste3,Liste4,
name :
String;
n :integer;
monocolor :boolean;
Textformat :cardinal;
pt: TPoint;
lehrerl :TFileName;
procedure Gridlade;
procedure Gridelade2;
procedure blauezelle;
procedure Memolade;
procedure Memolade2;
procedure bilderlade;
procedure bilderlade2;
function FindFiles (
const fileExpr:
String;files: TStrings; options: TFindFilesOptions = []): Boolean;
public
{ Public-Deklarationen }
end;
var
Form8: TForm8;
implementation
uses Unit2, Unit5, Unit7, Unit3, Unit9, Unit4;
{$R *.dfm}
// Sämtliche Quellen Angaben stehen auf der Form7 (sind die gleichen)
procedure TForm8.FormShow(Sender: TObject);
Var i :integer;
begin
Form8.Top:= 0;
Form8.Left:= 0;
Liste1:= (ExtractFilePath(ParamStr(0)) +('
Vertretungspläne\'+(IntToStr(YearOf(Date)))+'
_KW_'+(IntToStr(WeekOfTheYear(Date)))));
FileListBox1.Directory:= Liste1;
Liste2:= (ExtractFilePath(ParamStr(0)) +('
Vertretungspläne\'+(IntToStr(YearOf(Date)))+'
_KW_'+(IntToStr(WeekOfTheYear(Date)+1))));
FileListBox2.Directory := Liste2;
for i:=0
to ComponentCount-1
do //XP Anzeige
if Components[i]
is TPanel
then (Components[i]
as TPanel).ParentBackground:= False;
Label15.Caption:= '
Lehrer' + #13#10 + '
auswählen';
Label1.Caption := '
';
Label14.Caption := '
VERTRETUNGSPLAN für Koll. ';
Label9.Caption:= '
Kalenderwoche: ';
Label10.Caption:= '
Woche: ';
StringGrid1.Cells[0,0] := '
Wochentag';
StringGrid1.Cells[0,1]:= '
Montag';
StringGrid1.Cells[0,5]:= '
Dienstag';
StringGrid1.Cells[0,9]:= '
Mittwoch';
StringGrid1.Cells[0,13]:= '
Donnerstag';
StringGrid1.Cells[0,17]:= '
Freitag';
StringGrid1.Cells[0,21]:= '
Samstag';
StringGrid1.Cells[1,0]:= '
Klasse';
StringGrid1.Cells[2,0]:= '
1';
StringGrid1.Cells[3,0]:= '
2';
StringGrid1.Cells[4,0]:= '
3';
StringGrid1.Cells[5,0]:= '
4';
StringGrid1.Cells[6,0]:= '
5';
StringGrid1.Cells[7,0]:= '
6';
StringGrid1.Cells[8,0]:= '
';
StringGrid1.Cells[9,0]:= '
7';
StringGrid1.Cells[10,0]:= '
8';
end;
//==============Eigenschaften Zellen============================================
procedure TForm8.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin
Textformat:= DT_SINGLELINE;
with (Sender
as TStringGrid)
do
begin
Celltext:= Cells[ACol, ARow];
monocolor:= True;
//Standardeinstellung der Zellen ist einfarbig
if (Cells[ACol,ARow] = '
fa')
or (Cells[ACol,ARow] = '
FA')
then
begin
Canvas.Brush.Color:= ClRed;
//Zellenfarbe
Canvas.Font.Color:= ClWhite;
//Schriftfarbe
Canvas.Font.Style:= Canvas.Font.Style + [fsBold];
//Text fett
end;
if (Cells[ACol,ARow] = '
np')
or (Cells[ACol,ARow] = '
NP')
then
begin
Canvas.Brush.Color:= ClBlue;
//Zellenfarbe
Canvas.Font.Color:= ClWhite;
//Schriftfarbe
Canvas.Font.Style:= Canvas.Font.Style + [fsBold];
//Text fett
end;
if (Cells[ACol,ARow] = '
aa')
or (Cells[ACol,ARow] = '
AA')
then
begin
Canvas.Brush.Color:= ClGreen;
//Zellenfarbe
Canvas.Font.Color:= ClWhite;
//Schriftfarbe
Canvas.Font.Style:= Canvas.Font.Style + [fsBold];
//Text fett
end;
if (monocolor)
then
begin
//Hintergrund überschreiben
SetBkMode(StringGrid1.Canvas.Handle, OPAQUE);
Canvas.FillRect(Rect)
end ;
if (ACol = 1)
or (ACol = 0)
then
begin
// Text wird zentriert
Textformat:= Textformat
or DT_CENTER
or DT_VCENTER;
Canvas.Font.Style:= Canvas.Font.Style + [fsBold];
//Text fett
end;
if (ACol > 1)
then //Zentrieren für alle Zellen
begin
Textformat:= Textformat
or DT_CENTER
or DT_VCENTER;
//Text wird zentriert
end;
//Hier wird nun der Text ausgegeben
DrawText(Canvas.Handle, PChar(Celltext), Length(celltext),Rect,Textformat);
end;
begin //Linien zwischen Zellen erzeugen
n:= 0 ;
repeat
n:= n+4;
if (ARow = n)
and (ACol >= StringGrid1.FixedCols)
then
begin
StringGrid1.Canvas.Pen.Color:= clBlack;
//Linienfarbe
StringGrid1.Canvas.Pen.Width:= 2;
//Stärke der Linie
StringGrid1.Canvas.MoveTo(Rect.Left,Rect.Bottom);
StringGrid1.Canvas.LineTo(Rect.Right,Rect.Bottom);
end;
until n= 24;
end;
end;
//========StringGrid Laden======================================================
procedure TForm8.Gridlade;
var x, y, row, col,len :Word;
Grid1 :TFileName;
FileStream :TMemoryStream;
buff :
string;
begin
FileStream:= TMemoryStream.Create;
//MemoryStream erzeugen
Grid1:= FileListbox1.FileName;
FileStream.LoadFromFile(Grid1);
FileStream.
Read(row, SizeOf(Word));
FileStream.
Read(col, SizeOf(Word));
for x:= 0
to row
do
for y:= 0
to col
do
begin
FileStream.
Read(len, SizeOf(Word));
SetLength(buff, len);
FileStream.
Read(buff[1], len);
StringGrid1.Cells[y,x]:= buff;
end;
FileStream.Free;
end;
procedure TForm8.Gridelade2;
var x, y, row, col,len :Word;
Grid2 :TFileName;
FileStream :TMemoryStream;
buff :
string;
begin
FileStream:= TMemoryStream.Create;
//MemoryStream erzeugen
Grid2:= FileListbox2.FileName;
FileStream.LoadFromFile(Grid2);
FileStream.
Read(row, SizeOf(Word));
FileStream.
Read(col, SizeOf(Word));
for x:= 0
to row
do
for y:= 0
to col
do
begin
FileStream.
Read(len, SizeOf(Word));
SetLength(buff, len);
FileStream.
Read(buff[1], len);
StringGrid1.Cells[y,x]:= buff;
end;
FileStream.Free;
end;
//=======Memos laden============================================================
procedure TForm8.Memolade;
Var memos :TFileName;
FileStream :TMemoryStream;
i,l :Integer;
s :
String;
begin
FileStream := TMemoryStream.Create;
//FileStream erzeugen
//Übergabe der Datei
memos:=(ExtractFilepath(FileListBox1.FileName) + '
Bemerkungen\' + ExtractFileName(FileListBox1.FileName));
FileStream.LoadFromFile(memos);
l:= 0;
FileStream.Position:= 0;
//FileStream Position = Anfang
for i := 1
to 9
do //Schleifendurchlauf durch Komponenten
begin
FileStream.
Read(l, SizeOf(Integer));
//Größe des FileStream lesen
setlength(s, l);
FileStream.
Read(s[1], l);
case i
of
1: Memo3.Text:= s;
2: Memo4.Text:= s;
3: Memo5.Text:= s;
4: Memo6.Text:= s;
5: Memo7.Text:= s;
6: Memo8.Text:= s;
7: Label9.Caption:= s;
//Kalenderwoche
8: Label10.Caption:= s;
//Woche
9: Label14.Caption:= s;
//Lehrernamen
end;
end;
FileStream.Free;
//Datei freigeben
end;
//==laden der Momos2============================================================
procedure TForm8.Memolade2;
Var memos2 :TFileName;
FileStream2 :TMemoryStream;
i,l :Integer;
s :
String;
begin
FileStream2 := TMemoryStream.Create;
//FileStream erzeugen
//Übergabe der Datei
memos2:=(ExtractFilepath(FileListBox2.FileName) + '
Bemerkungen\' + ExtractFileName(FileListBox2.FileName));
FileStream2.LoadFromFile(memos2);
l:= 0;
FileStream2.Position:= 0;
//FileStream Position = Anfang
for i := 1
to 9
do //Schleifendurchlauf durch Komponenten
begin
FileStream2.
Read(l, SizeOf(Integer));
//Größe des FileStream lesen
setlength(s, l);
FileStream2.
Read(s[1], l);
case i
of
1: Memo3.Text:= s;
2: Memo4.Text:= s;
3: Memo5.Text:= s;
4: Memo6.Text:= s;
5: Memo7.Text:= s;
6: Memo8.Text:= s;
7: Label9.Caption:= s;
//Kalenderwoche
8: Label10.Caption:= s;
//Woche
9: Label14.Caption:= s;
//Lehrernamen
end;
end;
FileStream2.Free;
//Datei freigeben
end;
//====Blaue Zelle entfernen======================================================
procedure TForm8.blauezelle;
//Quelle: Delphi7 Kochbuch
var StringRec :TgridRect;
begin
with StringRec
do begin
Top:= -1;
Left:=Left -1;
Right:= -1;
Bottom:= -1;
end;
StringGrid1.Selection:= StringRec
end;
//=======Panel zum Sperren der Maus============================
procedure TForm8.Panel12MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
with FileListBox1
do
pt := Point( Left + 100, Top + 100);
Mouse.CursorPos := ClientToScreen(pt);
end;
//===========Laden der dateien=======================
procedure TForm8.FileListBox1Change(Sender: TObject);
begin
liste3:= LowerCase(ExtractFileExt(FileListBox1.Filename));
//Pfad in Variable übergeben RTF mit Pfadangabe
if (liste3 = '
.txt')
then
begin
Gridlade;
memolade;
bilderlade;
end;
end;
//==============Bilder laden========================
procedure TForm8.bilderlade;
begin
blauezelle;
if FileListbox1.ItemIndex > -1
then
begin
FileListBox1.ItemIndex;
//Markierte Spalte finden
Lb:= FileListBox1.Items[FileListBox1.ItemIndex];
//Makierung übergeben in Variable Lb
Label14.Caption:= '
VERTRETUNGSPLAN für Koll. '+ Lb;
if not FileExists (ExtractFilePath(ParamStr(0))+'
Lehrer_Fotos\'+Lb+'
.jpg')
then
begin
Image1.Visible:= False;
Label6.Visible:= False;
end
else
begin
Image1.Picture.LoadFromFile(ExtractFilePath(ParamStr(0))+'
Lehrer_Fotos\'+ Lb +'
.jpg') ;
Image1.Visible:= True;
Label6.Visible:= True;
if Panel14.Visible = True
then
begin
Label6.Caption := '
Bild des Lehrers '+ LB;
end
else
begin
Label6.Visible:= False;
end;
end;
end
else
begin
// Kein Inhalt, dient nur zur Fehlervermeidung
end;
end;
//==================Bilder laden vom lehrer=======================
procedure TForm8.bilderlade2;
begin
blauezelle;
if FileListbox2.ItemIndex > -1
then
begin
FileListBox2.ItemIndex;
//Markierte Spalte finden
Lb:= FileListBox2.Items[FileListBox2.ItemIndex];
//Makierung übergeben in Variable Lb
Label14.Caption:= '
VERTRETUNGSPLAN für Koll. '+ Lb;
if not FileExists (ExtractFilePath(ParamStr(0))+'
Lehrer_Fotos\'+Lb+'
.jpg')
then
begin
Image1.Visible:= False;
Label6.Visible:= False;
end
else
begin
Image1.Picture.LoadFromFile(ExtractFilePath(ParamStr(0))+'
Lehrer_Fotos\'+ Lb +'
.jpg') ;
Image1.Visible:= True;
Label6.Visible:= True;
if Panel14.Visible = True
then
begin
Label6.Caption := '
Bild des Lehrers '+ LB;
end
else
begin
Label6.Visible:= False;
end;
end;
end
else
begin
// Kein Inhalt, dient nur zur Fehlervermeidung
end;
end;
procedure TForm8.FileListBox2Change(Sender: TObject);
begin
liste4:= LowerCase(ExtractFileExt(FileListBox2.Filename));
//Pfad in Variable übergeben RTF mit Pfadangabe
if (liste4 = '
.txt')
then
begin
Gridelade2;
Memolade2;
bilderlade2;
end;
end;
//========Anwort von marabu=========================
function TForm8.FindFiles(
const fileExpr:
String; files: TStrings;
options: TFindFilesOptions): Boolean;
var
sr: TSearchRec;
path:
string;
extWanted: Boolean;
begin
path:= (ExtractFilePath(ParamStr(0)) +('
Vertretungspläne\'+(IntToStr(YearOf(Date)))+'
_KW_'+(IntToStr(WeekOfTheYear(Date)))));
showmessage(path);
Result := True;
files.Clear;
files.BeginUpdate;
if ffoExcludePath
in options
then path := '
'
else path := ExtractFilePath(fileExpr);
extWanted :=
not (ffoExcludeExt
in options);
if FindFirst(fileExpr, faArchive, sr) = 0
then
begin
repeat
if extWanted
then files.Add(path + sr.
Name)
else files.Add(ChangeFileExt(path + sr.
Name, '
'));
until FindNext(sr) <> 0;
FindClose(sr);
end else Result := False;
files.EndUpdate;
end;
procedure TForm8.Button2Click(Sender: TObject);
begin
FindFiles(ExtractFilePath(ParamStr(0)) +('
Vertretungspläne\'+(IntToStr(YearOf(Date)))+'
_KW_'+(IntToStr(WeekOfTheYear(Date)))), ListBox1.Items, [ffoExcludePath, ffoExcludeExt]);
end;