unit FPic;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls,jpeg, MPlayer,
ActiveX,ShellAPI,ShlObj ;
type
TPicshowForm =
class(TForm)
Panel1: TPanel;
Image1: TImage;
Edit1: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Timer1: TTimer;
Label4: TLabel;
Label5: TLabel;
Label7: TLabel;
SlideshowTimer: TTimer;
Label6: TLabel;
Label8: TLabel;
Mediatimer: TTimer;
MediaPlayer1: TMediaPlayer;
SaveDialog1: TSaveDialog;
procedure FormShow(Sender: TObject);
procedure Label2Click(Sender: TObject);
procedure Label1Click(Sender: TObject);
procedure Label1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Label1MouseLeave(Sender: TObject);
procedure Label2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Label2MouseLeave(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Label5MouseLeave(Sender: TObject);
procedure Label5MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Label5Click(Sender: TObject);
procedure SlideshowTimerTimer(Sender: TObject);
procedure Label8Click(Sender: TObject);
procedure Label6Click(Sender: TObject);
procedure Label6MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Label8MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Label8MouseLeave(Sender: TObject);
procedure Label6MouseLeave(Sender: TObject);
procedure MediatimerTimer(Sender: TObject);
procedure Label7Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
PicshowForm: TPicshowForm;
var x,pic,max:integer;
var
TextPfad:
string;
TextDatei:text;
implementation
uses FSsAbfrage, Fautorun, FStart;
{$R *.dfm}
function GetSpecialFolder(hWindow: HWND; Folder: Integer):
String;
var
pMalloc: IMalloc;
pidl: PItemIDList;
Path: PChar;
begin
// get IMalloc interface pointer
if (SHGetMalloc(pMalloc) <> S_OK)
then
begin
MessageBox(hWindow, '
Couldn''
t get pointer to IMalloc interface.',
'
SHGetMalloc(pMalloc)', 16);
Exit;
end;
// retrieve path
SHGetSpecialFolderLocation(hWindow, Folder, pidl);
GetMem(Path, MAX_PATH);
SHGetPathFromIDList(pidl, Path);
Result := Path;
FreeMem(Path);
// free memory allocated by SHGetSpecialFolderLocation
pMalloc.Free(pidl);
end;
procedure TPicshowForm.FormShow(Sender: TObject);
begin
ShowWindow(
handle,SW_MAXIMIZE);
x:=strTOInt(Edit1.text);
pic:=1;
case x
of
0:
begin
Image1.Picture.LoadFromFile('
./pics/kursfahrt/frankreich/allg/'+Inttostr(pic) +'
.jpg');
max:=41;
end;
1:
begin
Image1.Picture.LoadFromFile('
./pics/kursfahrt/frankreich/sehens/'+Inttostr(pic) +'
.jpg');
max:=36;
end;
2:
begin
Image1.Picture.LoadFromFile('
./pics/kursfahrt/frankreich/cont/'+Inttostr(pic) +'
.jpg');
max:=4;
end;
end;
if image1.picture.Width>image1.Picture.Height
then
begin
panel1.Width:=802;
panel1.Height:=602;
panel1.Left:=111;
end
else
begin
panel1.Width:=452;
panel1.Height:=602;
panel1.Left:=286;
end;
end;
procedure TPicshowForm.Label2Click(Sender: TObject);
begin
case x
of
0:
begin
if pic=41
then pic:=1
else pic:=pic+1;
Image1.Picture.LoadFromFile('
./pics/kursfahrt/frankreich/allg/'+Inttostr(pic) +'
.jpg');
end;
1:
begin
if pic=36
then pic:=1
else pic:=pic+1;
Image1.Picture.LoadFromFile('
./pics/kursfahrt/frankreich/sehens/'+Inttostr(pic) +'
.jpg');
end;
2:
begin
if pic=4
then pic:=1
else pic:=pic+1;
Image1.Picture.LoadFromFile('
./pics/kursfahrt/frankreich/cont/'+Inttostr(pic) +'
.jpg');
end;
end;
if image1.picture.Width>image1.Picture.Height
then
begin
panel1.Width:=802;
panel1.Height:=602;
panel1.Left:=111;
end
else
begin
panel1.Width:=452;
panel1.Height:=602;
panel1.Left:=286;
end;
end;
procedure TPicshowForm.Label1Click(Sender: TObject);
begin
case x
of
0:
begin
if pic=1
then pic:=41
else pic:=pic-1;
Image1.Picture.LoadFromFile('
./pics/kursfahrt/frankreich/allg/'+Inttostr(pic) +'
.jpg');
end;
1:
begin
if pic=1
then pic:=36
else pic:=pic-1;
Image1.Picture.LoadFromFile('
./pics/kursfahrt/frankreich/sehens/'+Inttostr(pic) +'
.jpg');
end;
2:
begin
if pic=1
then pic:=4
else pic:=pic-1;
Image1.Picture.LoadFromFile('
./pics/kursfahrt/frankreich/cont/'+Inttostr(pic) +'
.jpg');
end;
end;
if image1.picture.Width>image1.Picture.Height
then
begin
panel1.Width:=802;
panel1.Height:=602;
panel1.Left:=111;
end
else
begin
panel1.Width:=452;
panel1.Height:=602;
panel1.Left:=286;
end;
end;
procedure TPicshowForm.Label1MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
Label1.cursor:=crhandpoint;
Label1.Font.Color:=clred;
end;
procedure TPicshowForm.Label1MouseLeave(Sender: TObject);
begin
Label1.Font.Color:=clsilver;
Label1.cursor:=crdefault;
end;
procedure TPicshowForm.Label2MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
Label2.cursor:=crhandpoint;
Label2.Font.Color:=clred;
end;
procedure TPicshowForm.Label2MouseLeave(Sender: TObject);
begin
Label2.Font.Color:=clsilver;
Label2.cursor:=crdefault;
end;
procedure TPicshowForm.Timer1Timer(Sender: TObject);
var
NewFileName:
string;
begin
Label4.caption:='
Bild '+ inttostr(pic) +'
/ '+ inttostr(max) +'
';
NewFileName:= ExtractFilePath(Application.ExeName);
case x
of
0:
begin
Label3.Caption:='
Quelle: '+ NewFileName +'
pics\kursfahrt\frankreich\allg\'+Inttostr(pic) +'
.jpg';
end;
1:
begin
Label3.Caption:='
Quelle: '+ NewFileName +'
pics\kursfahrt\frankreich\sehens\'+Inttostr(pic) +'
.jpg';
end;
2:
begin
Label3.Caption:='
Quelle: '+ NewFileName +'
pics\kursfahrt\frankreich\cont\'+Inttostr(pic) +'
.jpg';
end;
end;
end;
procedure TPicshowForm.Label5MouseLeave(Sender: TObject);
begin
Label5.Font.Color:=clsilver;
Label5.cursor:=crdefault;
end;
procedure TPicshowForm.Label5MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
Label5.cursor:=crhandpoint;
Label5.Font.Color:=clred;
end;
procedure TPicshowForm.Label5Click(Sender: TObject);
begin
if Label5.caption='
Slideshow starten'
then
begin
Label5.Caption:='
Slideshow stoppen';
SsForm.show;
end
else
begin
slideshowtimer.Enabled:=false;
Label5.caption:='
Slideshow starten';
end;
end;
procedure TPicshowForm.SlideshowTimerTimer(Sender: TObject);
begin
case x
of
0:
begin
if pic=41
then pic:=0;
pic:=pic+1;
Image1.Picture.LoadFromFile('
./pics/kursfahrt/frankreich/allg/'+Inttostr(pic) +'
.jpg');
end;
1:
begin
if pic=36
then pic:=0;
pic:=pic+1;
Image1.Picture.LoadFromFile('
./pics/kursfahrt/frankreich/sehens/'+Inttostr(pic) +'
.jpg');
end;
2:
begin
if pic=4
then pic:=0;
pic:=pic+1;
Image1.Picture.LoadFromFile('
./pics/kursfahrt/frankreich/cont/'+Inttostr(pic) +'
.jpg');
end;
end;
if image1.picture.Width>image1.Picture.Height
then
begin
panel1.Width:=802;
panel1.Height:=602;
panel1.Left:=111;
end
else
begin
panel1.Width:=452;
panel1.Height:=602;
panel1.Left:=286;
end;
end;
procedure TPicshowForm.Label8Click(Sender: TObject);
begin
SlideshowTimer.Enabled:=false;
mediaplayer1.filename:='
./media/klick.wav';
mediaplayer1.open;
mediaplayer1.play;
MediaTimer.Enabled:=true;
Mainform.visible:=true;
PicshowForm.visible:=false;
end;
procedure TPicshowForm.Label6Click(Sender: TObject);
begin
mediaplayer1.filename:='
./media/klick.wav';
mediaplayer1.open;
mediaplayer1.play;
StartForm.cltimer.enabled:=true;
end;
procedure TPicshowForm.Label6MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
Label6.Font.Color:=clblue;
Label6.cursor:=crhandpoint;
end;
procedure TPicshowForm.Label8MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
Label8.Font.Color:=clblue;
Label8.cursor:=crhandpoint;
end;
procedure TPicshowForm.Label8MouseLeave(Sender: TObject);
begin
Label8.Font.Color:=clsilver;
Label8.cursor:=crdefault;
end;
procedure TPicshowForm.Label6MouseLeave(Sender: TObject);
begin
Label6.Font.Color:=clsilver;
Label6.cursor:=crdefault;
end;
procedure TPicshowForm.MediatimerTimer(Sender: TObject);
begin
Mediaplayer1.close;
MediaTimer.Enabled:=false;
end;
procedure TPicshowForm.Label7Click(Sender: TObject);
var filename2:
string;
var
SD: TSaveDialog;
begin
SD := TSaveDialog.Create(Self);
with SD
do
begin
Filename := '
Bild' + inttostr(pic);
Filename2:='
'+Filename+'
.jpg';
Filter := '
Jpeg Files (*.jpg)|*.jpg';
Title := '
Bild speichern unter ';
InitialDir := GetSpecialFolder(Application.Handle, CSIDL_DESKTOPDIRECTORY);
// Initalisierungs Verzeichnis ist Desktop
if Execute
then
begin
Image1.Picture.SaveToFile(filename2);
// Image1.Picture.SaveToFile(IncludeTrailingPathDelimiter(ExtractFileDir(Filename)) + 'bild'+Inttostr(pic)+'.jpg'); // speichert im vom User ausgewählten Verzeichnis ab.
end;
end;
SD.Free;
case FileExists(Filename2)
of
True: SHowMessage('
Datei wurde gespeichert');
False: ShowMessage('
Fehler beim Speichern der Datei: ' + filename2);
end;
end;
{with savedialog1 do
begin
savedialog1.InitialDir := GetSpecialFolder(Application.Handle, CSIDL_DESKTOPDIRECTORY);
savedialog1.filename:='Bild'+InttoStr(pic)+'';
savedialog1.execute;
end;}
end.