Method to combine bitmaps into one bitmap as thumbnails

Please discuss general Delphi programming topics here.

Method to combine bitmaps into one bitmap as thumbnails

Postby w2m » November 1st, 2003, 2:07 pm

:idea: 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. :D
w2m
w2m
Senior Member
Senior Member
 
Posts: 76
Joined: March 8th, 2003, 7:11 pm
Location: New York, USA

Postby Kambiz » November 2nd, 2003, 3:14 pm

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
User avatar
Kambiz
Administrator
Administrator
 
Posts: 2408
Joined: March 7th, 2003, 7:10 pm

Postby Kambiz » November 2nd, 2003, 3:53 pm

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;
User avatar
Kambiz
Administrator
Administrator
 
Posts: 2408
Joined: March 7th, 2003, 7:10 pm

Thanks... Need to load images from Thumbnail Component

Postby w2m » November 3rd, 2003, 12:29 am

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
w2m
Senior Member
Senior Member
 
Posts: 76
Joined: March 8th, 2003, 7:11 pm
Location: New York, USA

This sort of works

Postby w2m » November 3rd, 2003, 12:41 am

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

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;
w2m
w2m
Senior Member
Senior Member
 
Posts: 76
Joined: March 8th, 2003, 7:11 pm
Location: New York, USA

Postby Kambiz » November 3rd, 2003, 12:50 am

So, you had already the solution. :)
User avatar
Kambiz
Administrator
Administrator
 
Posts: 2408
Joined: March 7th, 2003, 7:10 pm

How to set the size width and height of bitmap

Postby w2m » November 3rd, 2003, 12:56 am

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
w2m
Senior Member
Senior Member
 
Posts: 76
Joined: March 8th, 2003, 7:11 pm
Location: New York, USA

Almost have it

Postby w2m » November 3rd, 2003, 1:41 am

Hurray! :D 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. :D

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

Thanks
w2m
w2m
Senior Member
Senior Member
 
Posts: 76
Joined: March 8th, 2003, 7:11 pm
Location: New York, USA

Postby Kambiz » November 3rd, 2003, 2:14 pm

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?
User avatar
Kambiz
Administrator
Administrator
 
Posts: 2408
Joined: March 7th, 2003, 7:10 pm

Drawing to BMP

Postby w2m » November 3rd, 2003, 3:02 pm

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! :D
w2m
w2m
Senior Member
Senior Member
 
Posts: 76
Joined: March 8th, 2003, 7:11 pm
Location: New York, USA

BMP.Canvas.ClipRect Doesn't Work as Expected

Postby w2m » November 3rd, 2003, 3:12 pm

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! :D
w2m
w2m
Senior Member
Senior Member
 
Posts: 76
Joined: March 8th, 2003, 7:11 pm
Location: New York, USA

Already had the solution

Postby w2m » November 3rd, 2003, 3:16 pm

Kambiz wrote:So, you had already the solution. :)


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

Thank you.
w2m
w2m
Senior Member
Senior Member
 
Posts: 76
Joined: March 8th, 2003, 7:11 pm
Location: New York, USA


Return to Delphi Programming

Who is online

Users browsing this forum: Bing [Bot] and 2 guests