Einzelnen Beitrag anzeigen

zeina

Registriert seit: 8. Jun 2018
56 Beiträge
 
#4

AW: JPEG erstellen und Skallieren

  Alt 1. Feb 2019, 10: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;
  Mit Zitat antworten Zitat