Hvordan gemmes et billede til stream rezised 10%

Du vil med adnere ord have en ThumbNail på 40X40 GEMT I DIN db ?

Ja det kan man godt sige!

Eller hellere 10% af originalstørrelse, da nogle billeder er højere end de er brede og omvendt.

Jammen det er ikke noget probelm ... 2 sek

Prøv den her :

unit JpegConv;

interface

uses Windows, Graphics, SysUtils, Classes;

procedure CreateThumbnail(const InFileName, OutFileName: string; Width, Height: Integer; Compress: Boolean = true; ProgressEvent : TProgressEvent = nil); overload;

implementation

uses Jpeg;

procedure CreateThumbnail(InStream, OutStream: TStream; Width, Height: Integer; Compress: Boolean; ProgressEvent : TProgressEvent); overload;
var
  JpegImage: TJpegImage;
  Bitmap: TBitmap;
  Ratio: Double;
  ARect: TRect;
  AHeight (*, AHeightOffset*): Integer;
  AWidth (*, AWidthOffset*): Integer;
begin
//  Check for invalid parameters
  JpegImage := TJpegImage.Create;
  try
//  Load the image
    JpegImage.LoadFromStream(InStream);
    if Width = 0 then
      Width := JpegImage.Width;
    if Height = 0 then
      Height := JpegImage.Height;

    // Create bitmap, and calculate parameters
    Bitmap := TBitmap.Create;
    try
      Ratio := JpegImage.Width / JpegImage.Height;
      if Ratio > 1 then
      begin
        AHeight := Round(Width / Ratio);
//        AHeightOffset:=(Height-AHeight) div 2;
        AWidth := Width;
//        AWidthOffset:=0;
      end
      else
      begin
        AWidth := Round(Height * Ratio);
//        AWidthOffset:=(Width-AWidth) div 2;
        AHeight := Height;
//        AHeightOffset:=0;
      end;

      Bitmap.Width := AWidth;
      Bitmap.Height := AHeight;
//      Bitmap.Canvas.Brush.Color:=FillColor;
//      Bitmap.Canvas.FillRect(Rect(0,0,Width,Height));
// StretchDraw original image
//      ARect:=Rect(AWidthOffset,AHeightOffset,AWidth+AWidthOffset,AHeight+AHeightOffset);
      ARect := Rect(0, 0, AWidth, AHeight);
      Bitmap.Canvas.StretchDraw(ARect, JpegImage);
// Assign back to the Jpeg, and save to the file
      JpegImage.Free;

      JpegImage := TJpegImage.Create;
      JpegImage.OnProgress := ProgressEvent;
      JpegImage.Assign(Bitmap);

      if Compress then
        JpegImage.CompressionQuality := 30;
     
      JpegImage.SaveToStream(OutStream);
    finally
      Bitmap.Free;
    end;
  finally
    JpegImage.Free;
  end;
end;

procedure CreateThumbnail(const InFileName, OutFileName: string; Width, Height: Integer; Compress: Boolean; ProgressEvent : TProgressEvent); overload;
var
  InStream, OutStream: TFileStream;
begin
  InStream := TFileStream.Create(InFileName, fmOpenRead);
  try
    OutStream := TFileStream.Create(OutFileName, fmOpenWrite or fmCreate);
    try
      CreateThumbnail(InStream, OutStream, Width, Height, Compress, ProgressEvent);
    finally
      OutStream.Free;
    end;
  finally
    InStream.Free;
  end;
end;

end.

Du angiver blot max brede og højde fx. 40 x 40 så laver den en thumbnail som passer ... Prøv det.

Prøver lige

Skal lige bruge lidt tid til at studere din løsning nærmere + flette det ind i mit:)

Da du højst sandsynligt er meget mere vaks end jeg, giver jeg dig lige koden, som jeg skal have din lønsning flettet ind i.. Med mine ringe evner kan det godt tage lidt tid, inden jeg selv kommer videre. så har du tid vil jeg da gerne have lidt hjælp. Er ellers ikke faldet i søvn og eksperiemnterer stadig .

Her der dette sjeg skal have det flettet ind i, sådan at billedet gennes i field "Thrumbs"  og image 24 viser min trumbnail på skærmen:

procedure TStart.Image11Click(Sender: TObject);
var
  Jpg: TJpegImage;
  Stream: TMemoryStream;
  FileExt: string;
  GraphType: TGraphType;
  begin
begin
  if dlgOpenPicture.Execute then begin
    Jpg := nil;
    Stream := nil;
    try
      Stream := TMemoryStream.Create;
      FileExt := LowerCase(ExtractFileExt(dlgOpenPicture.FileName));
      if (FileExt = '.bmp') or (FileExt = '.dib') then begin
        GraphType := gtBitmap;
        Stream.Write(GraphType, 1);
        with Image10.Picture.Bitmap do begin
          LoadFromFile(dlgOpenPicture.FileName);
          Image10.Picture.Bitmap.SaveToStream(Stream);
        end;
      end else if (FileExt = '.ico') then begin
        GraphType := gtIcon;
        Stream.Write(GraphType, 1);
        with Image10.Picture.Icon do begin
          LoadFromFile(dlgOpenPicture.FileName);
          Image10.Picture.Bitmap.SaveToStream(Stream);
        end;
      end else if (FileExt = '.emf') or (FileExt = '.wmf') then begin
        GraphType := gtMetafile;
        Stream.Write(GraphType, 1);
        with Image10.Picture.Metafile do begin
          LoadFromFile(dlgOpenPicture.FileName);
          Image10.Picture.Bitmap.SaveToStream(Stream);
        end;
      end else if (FileExt = '.jpg') or (FileExt = '.jpeg')
        or (FileExt = '.jpe') then begin
        Jpg := TJpegImage.Create;
        Jpg.LoadFromFile(dlgOpenPicture.FileName);
        Image10.Picture.Assign(Jpg);
        GraphType := gtJpeg;
        Stream.Write(GraphType, 1);
        Jpg.SaveToStream(Stream);
      end;
      if (Table1.State <> dsEdit) and (Table1.State <> dsInsert) then
        Table1.Edit;
      Stream.Position := 0;
      TBlobField(Table1.FieldByName('Billed')).LoadFromStream(Stream);
    except
      jpg.Free;
      Stream.Free;
      raise;
    end;
    jpg.Free;
    Stream.Free;
  end;
end;

  //her billede 24 Til thumbnail

        begin

    try
      Stream := TMemoryStream.Create;
      FileExt := LowerCase(ExtractFileExt(dlgOpenPicture.FileName));
      if (FileExt = '.bmp') or (FileExt = '.dib') then begin
        GraphType := gtBitmap;
        Stream.Write(GraphType, 1);
        with Image24.Picture.Bitmap do begin
          LoadFromFile(dlgOpenPicture.FileName);

          Image24.Picture.Bitmap.SaveToStream(Stream);
        end;
      end else if (FileExt = '.ico') then begin
        GraphType := gtIcon;
        Stream.Write(GraphType, 1);
        with Image24.Picture.Icon do begin
          LoadFromFile(dlgOpenPicture.FileName);

          Image24.Picture.Bitmap.SaveToStream(Stream);
        end;
      end else if (FileExt = '.emf') or (FileExt = '.wmf') then begin
        GraphType := gtMetafile;
        Stream.Write(GraphType, 1);
        with Image24.Picture.Metafile do begin
          LoadFromFile(dlgOpenPicture.FileName);

          Image24.Picture.Bitmap.SaveToStream(Stream);
        end;
      end else if (FileExt = '.jpg') or (FileExt = '.jpeg')
        or (FileExt = '.jpe') then begin
        Jpg := TJpegImage.Create;
        Jpg.LoadFromFile(dlgOpenPicture.FileName);
        Image24.Picture.Assign(Jpg);
        GraphType := gtJpeg;
        Stream.Write(GraphType, 1);

        Jpg.SaveToStream(Stream);
      end;
      if (Table1.State <> dsEdit) and (Table1.State <> dsInsert) then
        Table1.Edit;
      Stream.Position := 0;
      TBlobField(Table1.FieldByName('Thrums')).LoadFromStream(Stream);
    except
      jpg.Free;
      Stream.Free;
      raise;
    end;
    jpg.Free;
    Stream.Free;
  end;
end;

procedure TStart.Table1AfterScroll(DataSet: TDataSet);
var
  Stream: TMemoryStream;
  Jpg: TJpegImage;
  GraphType: TGraphType;
  begin  //app start



  begin  //1
  Jpg := nil;
  Stream := nil;
  try
    Stream := TMemoryStream.Create;
      TBlobField(Table1.FieldByName('Billed')).SaveToStream(Stream);

    if Stream.Size > 0 then begin
      Stream.Position := 0;
      Stream.Read(GraphType, 1);
      case GraphType of
      gtBitmap:  Image10.Picture.Bitmap.LoadFromStream(Stream);
      gtIcon:    Image10.Picture.Icon.LoadFromStream(Stream);
      gtMetafile: Image10.Picture.Metafile.LoadFromStream(Stream);
      gtJpeg:  begin
                  Jpg := TJpegImage.Create;
                  Jpg.LoadFromStream(Stream);
                  Image10.Picture.Assign(Jpg);
      end else
        Image10.Picture.Assign(nil);
      end;
    end else
      Image10.Picture.Assign(nil);
  except
    Image10.Picture.Assign(nil);
  end;
  jpg.Free;
  Stream.Free;
end;  //1end

  //Thrums
    begin    Jpg := nil;
  Stream := nil;
  try
    Stream := TMemoryStream.Create;
      TBlobField(Table1.FieldByName('Thrums')).SaveToStream(Stream);

    if Stream.Size > 0 then begin
      Stream.Position := 0;
      Stream.Read(GraphType, 1);
      case GraphType of
      gtBitmap:  Image24.Picture.Bitmap.LoadFromStream(Stream);
      gtIcon:    Image24.Picture.Icon.LoadFromStream(Stream);
      gtMetafile: Image24.Picture.Metafile.LoadFromStream(Stream);
      gtJpeg:  begin
                  Jpg := TJpegImage.Create;
                  Jpg.LoadFromStream(Stream);
                  Image24.Picture.Assign(Jpg);
      end else
        Image24.Picture.Assign(nil);
      end;
    end else
      Image24.Picture.Assign(nil);
  except
    Image24.Picture.Assign(nil);
  end;
  jpg.Free;
  Stream.Free;
end;  //Trums end
end;

Ellers flot du kunne komme med løsningsforslag så hurtigt og jeg er også sikker på det virker, blot det flettes rigtigt ind.

Prøv det her, jeg tror det virker med bmp (jeg kan altid prøve at lave det, så det virker med de andre formater):

procedure TStart.Image11Click(Sender: TObject);
var
  Jpg: TJpegImage;
  Stream: TMemoryStream;
  FileExt: string;
  GraphType: TGraphType;

begin
  if dlgOpenPicture.Execute then begin
    Jpg := nil;
    Stream := nil;
  try
      Stream := TMemoryStream.Create;
      FileExt := LowerCase(ExtractFileExt(dlgOpenPicture.FileName));
 
  if (FileExt = '.bmp') or (FileExt = '.dib') then begin
        GraphType := gtBitmap;
        Stream.Write(GraphType, 1);
      with Image24.Picture.Bitmap do begin
          LoadFromFile(dlgOpenPicture.FileName);
    Image24.Picture.Bitmap.Canvas.StretchDraw(Bounds(0, 0, Image24.Picture.Bitmap.Width div 10, Image24.Picture.Bitmap.Height div 10), Image24.Picture.Graphic);
    Image24.Picture.Bitmap.Width := Image2.Picture.Bitmap.Width div 10;
    Image24.Picture.Bitmap.Height := Image2.Picture.Bitmap.Height div 10;  Image24.Picture.Bitmap.SaveToStream(Stream);
        end;
      end else if (FileExt = '.ico') then begin
 
    GraphType := gtIcon;
        Stream.Write(GraphType, 1);
        with Image24.Picture.Icon do begin
          LoadFromFile(dlgOpenPicture.FileName);
            Image24.Width:=40; //****************************PROBLE
            Image24.Height:=40 ; //****************************PROBLEM                Image24.Picture.Bitmap.SaveToStream(Stream);
        end;
 
  end else if (FileExt = '.emf') or (FileExt = '.wmf') then begin
        GraphType := gtMetafile;
        Stream.Write(GraphType, 1);
        with Image24.Picture.Metafile do begin
          LoadFromFile(dlgOpenPicture.FileName);
        Image24.Width:=40; //****************************PROBLEM             
                Image24.Height:=40 ; //****************************PROBLEM             
          Image24.Picture.Bitmap.SaveToStream(Stream);
        end;
 
end else if (FileExt = '.jpg') or (FileExt = '.jpeg')
        or (FileExt = '.jpe') then begin
        Jpg := TJpegImage.Create;
        Jpg.LoadFromFile(dlgOpenPicture.FileName);
        Image24.Picture.Assign(Jpg);
        GraphType := gtJpeg;
        Stream.Write(GraphType, 1);
            Image24.Width:=40; //****************************PROBLEM             
                Image24.Height:=40 ; //****************************PROBLEM             
        Jpg.SaveToStream(Stream);
      end;

  if (Table1.State <> dsEdit) and (Table1.State <> dsInsert) then
        Table1.Edit;
      Stream.Position := 0;
      TBlobField(Table1.FieldByName('Thrums')).LoadFromStream(Stream);
    except
      jpg.Free;
      Stream.Free;
      raise;
    end;
    jpg.Free;
    Stream.Free;
  end;

Har selv løst problemet v. h.a.

var
  bmp: TBitmap;
  jpg: TJpegImage;
  scale: Double;
begin
    // Abrir la imagen
  if opendialog1.execute then
  begin
    jpg := TJpegImage.Create;
    try
        // Cargar la imagen
      jpg.Loadfromfile(opendialog1.filename);
      if jpg.Height > jpg.Width then
        scale := 50 / jpg.Height
      else
        scale := 50 / jpg.Width;
      bmp := TBitmap.Create;
      try
        //Crear el thumbnail
        bmp.Width := Round(jpg.Width * scale);
        bmp.Height := Round(jpg.Height * scale);
        bmp.Canvas.StretchDraw(bmp.Canvas.Cliprect, jpg);
        // Dibujarlo en el control
        Self.Canvas.Draw(100, 10, bmp);
        // Convertirlo y guardarlo en disco.
        jpg.Assign(bmp);
        jpg.SaveToFile(ChangeFileext(opendialog1.filename, '_thumb.JPG'));
      finally
        bmp.free;
      end;
    finally
      jpg.free;
    end;
  end;