JPeg skalieren

[khh]

Hallo zusammen,
zum Skalieren von JPEGs habe ich folgende Delphi procedure gefunden.

Code: Alles auswählen

procedure ResizeJPEG(j:TJPEGImage; AWidth,AHeight:Integer);
var Bmp1,Bmp2: TBitmap;
    Faktor: double;
begin
 Bmp1:=TBitmap.Create;
 try
  Bmp1.Assign(j);
  Bmp2:=TBitmap.Create;
  try
   with Bmp2 do begin
    if (j.Height>=j.Width) then
     begin
      Faktor := j.Width/j.Height;
      Height := AHeight;
      Width  := Trunc(AHeight*Faktor)
     end; // if (j.Height>=j.Width) then
 
    if (j.Height<j.Width) then
     begin
      Faktor := j.Height/j.Width;
      Height := Trunc(AWidth*Faktor);
      Width  := AWidth
     end; // if (j.Height>=j.Width) then
 
    Canvas.StretchDraw(Rect(0,0,Bmp2.Width,Bmp2.Height),Bmp1);
   end;
  j.Assign(Bmp2);
  finally
   Bmp2.Free;
  end;
 finally
  Bmp1.Free;
 end;
end;

leider gibts in Lazarus die unit JPEG nicht, und die lazjpeg hat nur einen deprecated Eintrag

type
TJPGImage = TJPEGImage; // deprecated

Welche Möglichkeit gibts unter Lazarus?

EDIT: gelöst , TJPGImage ist in der Unit Graphics

Danke Gruss KH

[theo]

EDIT: gelöst , TJPGImage ist in der Unit Graphics

Schon, allerdings ist die Einschränkung in diesem Code völlig überflüssig.
Deklaration ändern geht auch:

procedure ResizeJPEG(j:TCustomBitmap; AWidth,AHeight:Integer);

Dann kannst du es auch so benutzen:

Image1.Picture.LoadFromFile('bild.jpg');
ResizeJPEG(Image1.Picture.Bitmap,40,40);

Aber nat. auch mit TJPegimage.

[khh]

EDIT: gelöst , TJPGImage ist in der Unit Graphics

Schon, allerdings ist die Einschränkung in diesem Code völlig überflüssig.
Deklaration ändern geht auch:

procedure ResizeJPEG(j:TCustomBitmap; AWidth,AHeight:Integer);

Dann kannst du es auch so benutzen:

Image1.Picture.LoadFromFile('bild.jpg');
ResizeJPEG(Image1.Picture.Bitmap,40,40);

Aber nat. auch mit TJPegimage.

ich danke dir, so ists noch bedeutend einfacher.

Gruss KH

[theo]

Den Code kannst du nat. noch kürzen und die proc. umbenennen, dann ist das auch wiederverwendbar

Code: Alles auswählen

procedure ResizeBitmap(ABmp:TCustomBitmap; AWidth,AHeight:Integer);
var TempBmp: TBitmap;
begin
  if (ABmp.Width>0) and (ABmp.Height>0) then
  begin
    TempBmp:=TBitmap.Create;
    try
      if (ABmp.Height>=ABmp.Width) then
        TempBmp.SetSize(Trunc(AHeight*(ABmp.Width/ABmp.Height)),AHeight) else
      if (ABmp.Height<ABmp.Width) then
        TempBmp.SetSize(AWidth,Trunc(AWidth*(ABmp.Height/ABmp.Width)));
      TempBmp.Canvas.StretchDraw(Rect(0,0,TempBmp.Width,TempBmp.Height),ABmp);
      ABmp.Assign(TempBmp);
    finally
     TempBmp.Free;
    end;
  end;
end;

[khh]

danke dir

folgendes Konstukt bringt einen Fehler:

TempBmp.Canvas.StretchDraw(Rect(0,0,TempBmp.Width,TempBmp.Height),ABmp);
hier erwarte er nach der ersten 0 eine Klammer.

ich habs folgendermassen abgeändert und dann gehts,

Code: Alles auswählen

x: TRECT;
dann 
        x.Left:= 0 ;
       x.Right:= Bmp2.Width;
       x.Top:= 0 ;
       x.Bottom:=x.Top+Bmp2.Height;
 
       Canvas.StretchDraw(x,Bmp1);

aber warum?


Danke gruss KH

[theo]

Hast du die unit windows an hinterer Stelle in der uses?
Afair gibt es da auch ein Rect welches dann in die Quere kommt. Nimm windows (wenn überhaupt) an den Anfang der Uses.

[khh]

Hast du die unit windows an hinterer Stelle in der uses?
Afair gibt es da auch ein Rect welches dann in die Quere kommt. Nimm windows (wenn überhaupt) an den Anfang der Uses.

ok, das wars,

ich danke dir.

heisst dass eine in der Users Klausel später definierte classe zuerst berücksichtigt wird?

ich war der Meinung es ist umgekehrt



Gruss KH

[theo]

heisst dass eine in der Users Klausel später definierte classe zuerst berücksichtigt wird?

Ja, du kannst dir das als "überschreiben" vorstellen.

[theo]

Bist du eigentlich sicher, dass du die unit windows benötigst?
In LCLIntf sind viele Kompatibilitätsfunktionen drin. Wenn du diese unit einbindest und keine anderen spezifischen winapi Funktionen benötigst, ist deine Anwendung dann quasi "gratis" cross-platform tauglich.

[khh]

Bist du eigentlich sicher, dass du die unit windows benötigst?
In LCLIntf sind viele Kompatibilitätsfunktionen drin. Wenn du diese unit einbindest und keine anderen spezifischen winapi Funktionen benötigst, ist deine Anwendung dann quasi "gratis" cross-platform tauglich.

mit:
x := GetSystemMetrics(SM_CXSCREEN);
lese ich den Screen aus, dazu brauch ich die unit Windows.
muss mal durchchecken ob sonst noch was aus windows benutzt wird, auf das Auslesen der Auflösung könnte ich zu gunsten der cross-platformtauglichkeit evtl. verzichten.


Gruss KH

[theo]

x := GetSystemMetrics(SM_CXSCREEN);

Ich weiss nicht was das genau macht, aber mit dem globalen Instanz von TScreen geht das wahrsch. auch.

Nichts createn, einfach:
Screen.Width
Screen.Height
Screen.PixelsPerInch
etc.

[khh]

x := GetSystemMetrics(SM_CXSCREEN);

Ich weiss nicht was das genau macht, aber mit dem globalen Instanz von TScreen geht das wahrsch. auch.

Nichts createn, einfach:
Screen.Width
Screen.Height
Screen.PixelsPerInch
etc.

Probiere ich aus, ich danke dir

Gruss KH