DELPHI AREA
MESSAGE BOARD
 
 FAQFAQ   SearchSearch   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

Method to combine bitmaps into one bitmap as thumbnails

 
   Reply to topic    DELPHI AREA Forum Index -> Delphi Programming
View previous topic :: View next topic  
Author Message
w2m
Member


Joined: 08 Mar 2003
Posts: 28
Location: New York, USA
PostPosted: 01/11/03 14:07    Post subject: Method to combine bitmaps into one bitmap as thumbnails Reply with quote
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.
_________________
w2m
Back to top
View user's profile Send e-mail Visit poster's website
Kambiz
Administrator


Joined: 07 Mar 2003
Posts: 253
PostPosted: 02/11/03 15:14    Post subject: Reply with quote
The TileDraw method is only available to CLX.

Here is an implememtation of that method:

Code:
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:
TileDraw(Bitmap.Canvas, Bitmap.Canvas.ClipRect, AnotherBitmap);

Or something like this:

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

Hope that it helps.
Kambiz
Back to top
View user's profile Send e-mail Visit poster's website
Kambiz
Administrator


Joined: 07 Mar 2003
Posts: 253
PostPosted: 02/11/03 15:53    Post subject: Reply with quote
The following procedure draws the thumbnails of a set of images on the specified canvas.

Code:
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:
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;
Back to top
View user's profile Send e-mail Visit poster's website
w2m
Member


Joined: 08 Mar 2003
Posts: 28
Location: New York, USA
PostPosted: 03/11/03 00:29    Post subject: Thanks... Need to load images from Thumbnail Component Reply with quote
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
Back to top
View user's profile Send e-mail Visit poster's website
w2m
Member


Joined: 08 Mar 2003
Posts: 28
Location: New York, USA
PostPosted: 03/11/03 00:41    Post subject: This sort of works Reply with quote
This works pretty well, but I suspect your way is better

Code:

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
Back to top
View user's profile Send e-mail Visit poster's website
Kambiz
Administrator


Joined: 07 Mar 2003
Posts: 253
PostPosted: 03/11/03 00:50    Post subject: Reply with quote
So, you had already the solution. Smile
Back to top
View user's profile Send e-mail Visit poster's website
w2m
Member


Joined: 08 Mar 2003
Posts: 28
Location: New York, USA
PostPosted: 03/11/03 00:56    Post subject: How to set the size width and height of bitmap Reply with quote
Sorry for all the messages.
How do you set the width and height of bitmap to hold all the thumbnails:
Code:
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
Back to top
View user's profile Send e-mail Visit poster's website
w2m
Member


Joined: 08 Mar 2003
Posts: 28
Location: New York, USA
PostPosted: 03/11/03 01:41    Post subject: Almost have it Reply with quote
Hurray! I almost have it using ThumbnailDraw ( BMP.Canvas, ClientRect, 150, 150, 0, GraphicsArray );

Code:

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. Confused The bitmap is too large ... especially height!!

Thanks
_________________
w2m
Back to top
View user's profile Send e-mail Visit poster's website
Kambiz
Administrator


Joined: 07 Mar 2003
Posts: 253
PostPosted: 03/11/03 14:14    Post subject: Reply with quote
As I see, in the following line

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

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

Try this way

Code:
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?
Back to top
View user's profile Send e-mail Visit poster's website
w2m
Member


Joined: 08 Mar 2003
Posts: 28
Location: New York, USA
PostPosted: 03/11/03 15:02    Post subject: Drawing to BMP Reply with quote
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
Back to top
View user's profile Send e-mail Visit poster's website
w2m
Member


Joined: 08 Mar 2003
Posts: 28
Location: New York, USA
PostPosted: 03/11/03 15:12    Post subject: BMP.Canvas.ClipRect Doesn't Work as Expected Reply with quote
Code:
 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:

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
Back to top
View user's profile Send e-mail Visit poster's website
w2m
Member


Joined: 08 Mar 2003
Posts: 28
Location: New York, USA
PostPosted: 03/11/03 15:16    Post subject: Already had the solution Reply with quote
Kambiz wrote:
So, you had already the solution. Smile


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

Thank you.
_________________
w2m
Back to top
View user's profile Send e-mail Visit poster's website
Display posts from previous:   
   Reply to topic    DELPHI AREA Forum Index -> Delphi Programming All times are GMT
Page 1 of 1

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum
You cannot attach files in this forum
You can download files in this forum


Powered by phpBB 2.0.6 © 2001, 2002 phpBB Group