Registriert seit: 8. Jun 2018
56 Beiträge
|
AW: JPEG erstellen und Skallieren
1. Feb 2019, 11:04
Wenn ich es mit Stretch einstellen ,denn die Qualität nicht schön aussieht
Code:
procedure TForm1.SaveJPEG;
begin
bmp := TBitmap.Create;
try
bmp.Assign(Form1.GetFormImage);
StringGrid1.Visible := False;
jpg := TJpegImage.Create;
try
jpg.Assign(bmp);
jpg.SaveToFile(ExtractFilePath(ParamStr(0)) + 'Foto.jpg');
finally
jpg.Free;
end;
finally
bmp.Free;
end;
end;
procedure TForm1.verkleinen;
begin
jpg := TJpegImage.Create;
try
jpg.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'Foto.jpg');
if jpg.Height > jpg.Width THEN
scale := min(Round(Screen.Height / jpg.Height),
Round(Form1.Height / jpg.Height)) // org 50
else
scale := min(Round(Screen.Width / jpg.Width),
Round(Screen.Width / jpg.Width)); // org 50
bmp := TBitmap.Create;
try
bmp.Width := Trunc(jpg.Width / scale);
bmp.Height := Trunc(jpg.Height / scale);
bmp.Canvas.StretchDraw(bmp.Canvas.Cliprect, jpg);
// Self.Canvas.Draw(0,0, bmp);
jpg.Assign(bmp);
jpg.CompressionQuality := 100;
jpg.Compress;
Image1.Picture.Graphic := jpg;
finally
bmp.Free;
end;
finally
jpg.Free;
end;
end;
procedure TForm1.vergrößen;
begin
jpg := TJpegImage.Create;
try
jpg.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'Foto.jpg');
if jpg.Height > jpg.Width then
scale := max(Round(jpg.Height / Screen.Height),
Round(jpg.Height / Form1.Height)) // org 50
else
scale := max(Round(jpg.Width / Screen.Width),
Round(jpg.Width / Form1.Width));
bmp := TBitmap.Create;
try
bmp.Width := Round(jpg.Width / scale);
bmp.Height := Round(jpg.Height / scale);
bmp.Canvas.StretchDraw(bmp.Canvas.Cliprect, jpg);
Self.Canvas.Draw(0, 0, bmp);
jpg.Assign(bmp);
jpg.CompressionQuality := 100;
jpg.Compress;
Image1.Picture.Graphic := jpg;
finally
bmp.Free;
end;
finally
jpg.Free;
end;
end;
procedure TForm1.FormResize(Sender: TObject);
begin
if assigned (Form1) then begin
if Form1.WindowState = wsMaximized then begin
vergrößen;
end
else if Form1.WindowState = wsNormal then
begin
verkleinen;
end;
end;
end;
|
|
Zitat
|