Delphi-PRAXiS
Seite 3 von 5     123 45      

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Sonstige Fragen zu Delphi (https://www.delphipraxis.net/19-sonstige-fragen-zu-delphi/)
-   -   Delphi bild speichern unter (https://www.delphipraxis.net/59158-bild-speichern-unter.html)

dahead 18. Dez 2005 16:48

Re: bild speichern unter
 
wie gesagt, dann sag mal was in der fehlermeldung steht. lass dir den dateinamen anzeigen und poste mir diese meldung (dialoge einfach via Strg-C kopieren und hier im forum mit Strg-V einfügen).

In der Hilfe von Delphi gibt es Infos zu FileExists.

Beispiel:

Delphi-Quellcode:
 case FileExists(Dateiname) of
  True: SHowMessage('Speichern OK!');
  False: ShowMessage('Fehler beim Speichern der Datei: ' + Dateiname);
 end;

f4r 18. Dez 2005 16:54

Re: bild speichern unter
 
fehlermeldung hab ich doch scho oben gepostet

Ratte 18. Dez 2005 16:59

Re: bild speichern unter
 
Wann tritt der Fehler denn genau auf? Geh das Programm mal im Einzelschrittmodus (F8) durch und schau wann der Fehler kommt. Der Teil hier sieht nämlich OK aus.

Ratte

dahead 18. Dez 2005 17:02

Re: bild speichern unter
 
Zitat:

Zitat von f4r
fehlermeldung hab ich doch scho oben gepostet

ja, aber die sagt ja nur aus, dass dateiname oder verzeichnis falsch sind, bzw. nicht existieren. daher sollst du ja auch den dateinamen der an savetofile übergeben wird VOR dem speichern mal anzeigen.

dann kuckst du ob da alles ok ist, bzw. postest ihn hier. wie gesagt, evtl. hast du zwei backslashs drin.

f4r 18. Dez 2005 17:05

Re: bild speichern unter
 
Liste der Anhänge anzeigen (Anzahl: 2)
der fehler tritt auf wenn ich zum beispiel programm zurück gehen mäöchte !
oder das naechste bild laden mööchten dann sieht die fehlermeldung allerdings ein bisschen anders aus was sehr interessant ist und drauf schließt lässt das irgendwas mit desktop funktion net ganz i.o. ist .
hier mal die meldung vor dme laden der neuen datei !

das programm denkt wohl irgendwie das es jetzt in einem anderen verzeichnis ist

gruss
edit

normalerweise muesste ersich im pfad d:\abibuch\.... befinden

Ratte 18. Dez 2005 17:09

Re: bild speichern unter
 
Wie lädts du das nächste Bild? Zeig mal den QT, wo der Fehler kommt.

Ratte

f4r 18. Dez 2005 17:11

Re: bild speichern unter
 
Delphi-Quellcode:
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.

Ratte 18. Dez 2005 17:24

Re: bild speichern unter
 
Und wo kommt der Fehler? Ich blick da nicht ganz durch...
Ratte

f4r 18. Dez 2005 17:28

Re: bild speichern unter
 
in dem momentan wo ich auf ein label klicke
bsp
label2click ist der weiterbutton sozusagen es wird normalerweise das naechst bild geladen

alle bilder haben lediglich nummern von 1 ... 41 z.b.
so war es leichter fuer mich das zu proggen

ich weis es ist ein heilloses durcheinander :(

dahead 18. Dez 2005 17:38

Re: bild speichern unter
 
jetzt mal was grundsätzliches:

sind die bilder bereits vorhanden oder muss man auch welche speichern können. für mich sieht das nach einer art slideshow programm aus.

falls dem so wäre, könntest du via FindFiles (siehe Codelib) alle Jpeg-Dateien auflisten lassen, in einer TStringList speichern und dann einfach vor oder zurück navigieren.


Alle Zeitangaben in WEZ +1. Es ist jetzt 10:01 Uhr.
Seite 3 von 5     123 45      

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz