Method to combine bitmaps into one bitmap as thumbnails

[w2m]

Does anyone have or know of a method to combine bitmaps into one bitmap as thumbnails? In Delphi Help I see a TileDraw method but I can not seem to make it work.

[Kambiz]

The TileDraw method is only available to CLX.

Here is an implememtation of that method:

Code: Select all

procedure TileDraw(Canvas: TCanvas; const Rect: TRect; G: TGraphic);
var
  R, Rows, C, Cols: Integer;
  ClipRgn: THandle;
begin
  if not G.Empty then
  begin
    Rows := ((Rect.Bottom - Rect.Top) div G.Height) + 1;
    Cols := ((Rect.Right - Rect.Left) div G.Width) + 1;
    ClipRgn := CreateRectRgnIndirect(Rect);
    try
      SelectClipRgn(Canvas.Handle, ClipRgn);
    finally
      DeleteObject(ClipRgn);
    end;
    for R := 1 to Rows do
      for C := 1 to Cols do
        Canvas.Draw(Rect.Left + (C-1) * G.Width, Rect.Top + (R-1) * G.Height, G);
    SelectClipRgn(Canvas.Handle, 0);
  end;
end;

For example:

Code: Select all

TileDraw(Bitmap.Canvas, Bitmap.Canvas.ClipRect, AnotherBitmap);

Or something like this:

Code: Select all

procedure TForm1.FormPaint(Sender: TObject);
begin
  // Image1.Visible is False
  TileDraw(Canvas, ClientRect, Image1.Picture.Graphic);
end;

Hope that it helps.
Kambiz

[Kambiz]

The following procedure draws the thumbnails of a set of images on the specified canvas.

Code: Select all

function ThumbnailDraw(Canvas: TCanvas; const Rect: TRect;
  ThumbWidth, ThumbHeight, Margin: Integer;
  Graphics: array of TGraphic): Integer;

  function ShrinkRect(const R: TRect; G: TGraphic): TRect;
  var
    iW, iH: Integer;
    rW, rH: Integer;
  begin
    iW := G.Width;
    iH := G.Height;
    rW := R.Right - R.Left;
    rH := R.Bottom - R.Top;
    if (iW > rW) or (iH > rH) then // Shrink only
    begin
      if (rW / iW) < (rH / iH) then
      begin
        iH := MulDiv(iH, rW, iW);
        iW := rW;
      end
      else
      begin
        iW := MulDiv(iW, rH, iH);
        iH := rH;
      end;
    end;
    SetRect(Result, 0, 0, iW, iH);
    OffsetRect(Result, R.Left + (rW - iW) div 2, R.Top + (rH - iH) div 2);
  end;

var
  ThumbRect: TRect;
  ClipRgn: THandle;
  I: Integer;
begin
  Result := 0;
  ClipRgn := CreateRectRgnIndirect(Rect);
  try
    SelectClipRgn(Canvas.Handle, ClipRgn);
  finally
    SelectClipRgn(Canvas.Handle, 0);
  end;
  SetRect(ThumbRect, 0, 0, ThumbWidth, ThumbHeight);
  OffsetRect(ThumbRect, Rect.Left, Rect.Top);
  for I := Low(Graphics) to High(Graphics) do
  begin
    Canvas.StretchDraw(ShrinkRect(ThumbRect, Graphics[I]), Graphics[I]);
    OffsetRect(ThumbRect, ThumbWidth + Margin, 0);
    Inc(Result);
    if ThumbRect.Left >= Rect.Right then
    begin
      OffsetRect(ThumbRect, Rect.Left - ThumbRect.Left, ThumbWidth + Margin);
      if ThumbRect.Top > Rect.Bottom then Break;
    end;
  end;
  SelectClipRgn(Canvas.Handle, 0);
end;

For example:

Code: Select all

procedure TForm1.FormPaint(Sender: TObject);
begin
  ThumbnailDraw(Canvas, ClientRect, 150, 150, 0,
    [Image1.Picture.Graphic, Image2.Picture.Graphic,
     Image3.Picture.Graphic, Image4.Picture.Graphic]);
end;

[w2m]

Thanks... but I need to load images from a thumbnail component where I have to get at each bitmap all at once in a for...to...do method:

for I = 0 to ThumbView1.ImageCount-1 do
BMP := ThumbView1.GetBitmap ( I );

Thanks for your help.

[w2m]

This works pretty well, but I suspect your way is better

Code: Select all

while ( Y < BMP.Height + dY ) and ( I <> ImageENMView1.ImageCount ) do begin
        X := 0;
        while ( X < BMP.Width - X ) and ( I <> ImageENMView1.ImageCount ) do begin
          TempBMP := ImageEnMView1.GetBitmap ( I );
          dX := TempBMP.Width + HBorder;
          dY := TempBMP.Height + VBorder;
          BMP.Canvas.Draw ( X, Y, TempBMP );
          BMP.Canvas.TextOut ( X, Y + TempBMP.Height, ImageEnMView1.ImageBottomText[I].Caption );
          Inc ( X, dX );
          ImageEnMView1.ReleaseBitmap ( I );
          if I <> ImageENMView1.ImageCount then
            Inc ( I );
        end;
        Inc ( Y, dY + 20 );
      end;


[Kambiz]

So, you had already the solution.

[w2m]

Sorry for all the messages.
How do you set the width and height of bitmap to hold all the thumbnails:

Code: Select all

procedure CreateContactSheet;
var
BMP: TBitmap;
TempBMP: TBitmap;
I: integer;
begin
  BMP := TBitmap.Create;
  TempBMP := TBitmap.Create;
  BMP.Width := //?? Printer.PageWidth - (LeftMargin + RightMargin);
  BMP.Height := //?? Printer.PageHeight - (TopMargin + BottomMargin);
      for I = 0 to ThumbView1.ImageCount-1 do
          TempBMP := ThumbView1.GetBitmap ( I );

 ThumbnailDraw(BMP.Canvas, ClientRect, 150, 150, 0, [TempBMP]);

In this prototype TempBMP is not in an array

[w2m]

Hurray! I almost have it using ThumbnailDraw ( BMP.Canvas, ClientRect, 150, 150, 0, GraphicsArray );

Code: Select all

procedure TMainForm.CreateContactSheet2;
var
  IE: TImageEnView;
  BMP: TBitmap;
  TempBMP: TBitmap;
  I: integer;
  GraphicsArray: array of TGraphic;
begin
  IE := TImageEnView.Create ( nil );
  try
    BMP := TBitmap.Create;
    try
      BMP.Width := ( ( PageSetupDialog1.PageWidth ) -(PageSetupDialog1.MarginLeft + PageSetupDialog1.MarginRight ) ) div 2;
      BMP.Height := ( ( PageSetupDialog1.PageHeight ) - ( PageSetupDialog1.MarginTop + PageSetupDialog1.MarginBottom ) ) div 10;
      BMP.PixelFormat := pf24bit;
      TempBMP := TBitmap.Create;
      I := 0;
      SetLength(GraphicsArray, ImageEnMView1.ImageCount);
      for i := 0 to ImageEnMView1.ImageCount - 1 do begin
        TempBMP := ImageEnMView1.GetBitmap ( I );
        GraphicsArray[I] := TempBMP;
      end;
      ThumbnailDraw ( BMP.Canvas, ClientRect, 150, 150, 0, GraphicsArray );
      ImageEnMView1.ReleaseBitmap ( I );
      fProperties.ContactSheet1.Blank;
      fProperties.ContactSheet1.IEBitmap.Assign ( BMP );
end;


All that remains is to set the width and height of the BMP to correspond to the printer page width and height - margins.

Myattemps to set correct bitmap size fail. The bitmap is too large ... especially height!!

Thanks

[Kambiz]

As I see, in the following line

Code: Select all

ThumbnailDraw ( BMP.Canvas, ClientRect, 150, 150, 0, GraphicsArray );

You are sending the client rectangle of the form to the function.

Try this way

Code: Select all

ThumbnailDraw ( BMP.Canvas, BMP.Canvas.ClipRect, 150, 150, 0, GraphicsArray );

By the way, why don't you draw the thumbnails directly on the printer's canvas?

[w2m]

In this case I am drawing to the BMP to load it into a print preview dialog. Thanks for your help. Your method is great!

[w2m]

Code: Select all

 ThumbnailDraw ( BMP.Canvas, BMP.Canvas.ClipRect, 150, 150, 0, GraphicsArray );

When I use BMP.Canvas.ClipRect the images all appear in the first row of thumbnails. Is the problem where I set the BMP.Width and BMP.Height?

How do you convert PageSetupDialog1.PageWidth into pixel dimensions?

Code: Select all

BMP.Width := ( ( PageSetupDialog1.PageWidth ) - ( PageSetupDialog1.MarginLeft + PageSetupDialog1.MarginRight ) ) div 2;
      BMP.Height := ( ( PageSetupDialog1.PageHeight ) - ( PageSetupDialog1.MarginTop + PageSetupDialog1.MarginBottom ) ) div 10;
      BMP.PixelFormat := pf24bit;
      TempBMP := TBitmap.Create;
      X := 0;
      Y := 0;
      I := 0;
      SetLength ( GraphicsArray, ImageEnMView1.ImageCount );
      SetLength ( CaptionArray, ImageEnMView1.ImageCount );
      for i := 0 to ImageEnMView1.ImageCount - 1 do begin
        TempBMP := ImageEnMView1.GetBitmap ( I );
        GraphicsArray[I] := TempBMP;
        CaptionArray[I] := ImageEnMView1.ImageBottomText[I].Caption;
      end;
      fContactSheet.fBorder := fProperties.UpDown9.Position;
      fContactSheet.fImageWidth := fProperties.UpDown10.Position;
      fContactSheet.fImageHeight := fProperties.UpDown11.Position;
      ThumbnailDraw ( BMP.Canvas, BMP.Canvas.ClipRect{ClientRect}, fContactSheet.fImageWidth, fContactSheet.fImageHeight, fContactSheet.fBorder, GraphicsArray, CaptionArray );


Again. Thanks for your help!

[w2m]

So, you had already the solution.

Well sort of but my attemp was kludgy . Yours is much better.
I discarded my method.

Thank you.