Problem mit Stretchdraw/SaveToFile (Erstellt 0 KB Dateien)

[Chris WF]

Hi,

ich schreibe ein Programm, das Thumbnails erstellt, dazu benutze ich 2 Arrays of TPicture. Ich lade die Bilder mit LoadFromFile, ändere die Größe mit Stretchdraw und will dann wieder mit SaveToFile speichern. Aber irgendwie klappts nich so ganz. Es kommt zwar kein Fehler, aber ich hab nachher nur 0 KB Dateien im Zielordner...

Hier mal der Code:

Delphi-Quellcode:

     for i := 0 to count-1 do
     begin
          srcpics[i].SaveToFile(dest + '\img' + inttostr(i) + '.jpg');
          h := srcpics[i].Height;
          w := srcpics[i].Width;
          if h < w then
          begin
               p := h / w;
               r.Left := 1;
               r.Top := 1;
               r.Right := twidth;
               r.Bottom := round(p * twidth);
               tpics[i].Bitmap.Canvas.StretchDraw(r,srcpics[i].Graphic);
               tpics[i].SaveToFile(dest + '\t_img' + inttostr(i) + '.jpg');
          end;
          if h >= w then
          begin
               p := w / h;
               r.Left := 1;
               r.Top := 1;
               r.Right := theight;
               r.Bottom := round(p * theight);
               tpics[i].Bitmap.Canvas.StretchDraw(r,srcpics[i].Graphic);
               tpics[i].SaveToFile(dest + '\t_img' + inttostr(i) + '.jpg');
          end;

     end;

(Die Variablen

Delphi-Quellcode:

Global:
var
  Form1: TForm1;
  src, dest: string;
  twidth, theight, rows, cols, count: integer;
  comment: boolean;
  srcpics, tpics: array of TPicture;
Lokal:
var i, h, w: integer;
var p, q: real;
var r: TRect;

[Reinhold]

Hallo,
Schau mal in Zeile 3, müßte da nicht LoadFromFile stehen und nicht SaveToFile.

Gruß Reinhold

[Chris WF]

Wieso?
Das ist schon richtig so.
Das LoadFromFile ist noch mal vorher.

Delphi-Quellcode:

i := 0;
if SysUtils.FindFirst(Folder + '\*.jpg', faAnyFile, Rec) = 0 then
  try
    repeat
      inc(i);
      setlength(srcpics,i);
      srcpics[i-1] := TPicture.Create;
      srcpics[i-1].LoadFromFile(Folder + '\' + Rec.Name);
    until SysUtils.FindNext(Rec) <> 0;
  finally
    SysUtils.FindClose(Rec);
  end;

//EDIT: Übrigens, das speichern des Orginals im Zielordner funktioniert...

[Reinhold]

Hallo,

vieleicht hilft Dir dieser Code, zur Ermittlung der neuen Größe.

Delphi-Quellcode:

function DestRect(DestWidth, DestHeight, SourceWidth, SourceHeight: Integer;
         Center: Boolean): TRect;
var
  cw, ch, w, h: Integer;
  xyaspect: Double;
begin
  cw := DestWidth;
  ch := DestHeight;
  w := SourceWidth;
  h := SourceHeight;

  xyaspect := w / h;
  if w > h then begin
    w := cw;
    h := Trunc(cw / xyaspect);
    if h > ch then begin
      h := ch;
      w := Trunc(cw * xyaspect);
    end
  end else begin
    h := ch;
    w := Trunc(ch * xyaspect);
    if w > cw then begin
      w := cw;
      h := Trunc(ch / xyaspect);
    end
  end;

  with Result do begin
    Left := 0;
    Top := 0;
    Right := w;
    Bottom := h;
  end;

  if Center then
    OffsetRect(Result, (cw - w) div 2, (ch - h) div 2);
end;

Gruß Reinhold

[Chris WF]

Die Größe des Rechtecks ist ja korrekt, das habe ich schon überprüft.

[Chris WF]

Hat den keiner ne Idee, woran es liegen kann???

[pacman1986]

normalerweise muss man das rect createn. oder ?

[Hawkeye219]

Hallo,

du solltest vor dem Zeichnen eines Bilds die Größe des Zielbilds setzen:

Delphi-Quellcode:

tpics[i].Bitmap.Width := ...;
tpics[i].Bitmap.Height := ...;

Gruß Hawkeye

[Steve]

Zitat von pacman1986:

normalerweise muss man das rect createn. oder ?

Nein, da TRect keine Klasse, sondern ein Record ist

²Chris: Auf den ersten Blick sehe ich den Fehler auch nicht...
Gruß
Stephan

[Chris WF]

Zitat von Hawkeye219:

Hallo,

du solltest vor dem Zeichnen eines Bilds die Größe des Zielbilds setzen:

Delphi-Quellcode:

tpics[i].Bitmap.Width := ...;
tpics[i].Bitmap.Height := ...;

Gruß Hawkeye

Danke!
Das wars, jetzt klappts