 |
MESSAGE BOARD
|
| View previous topic :: View next topic |
| Author |
Message |
w2m
Member
Joined: 08 Mar 2003
Posts: 30
Location: New York, USA
|
 Posted: 04/11/03 15:48 Post subject: Prevent clipping and draw caption |
 |
|
I have your very nice ThumbnailDraw method almost working perfect.
Everything is good except sometimes depending on thumbnail width the thumbnails are clipped on the right edge of the page. The clipped images do not move to the next row until they are completely off the page right margin. See attached image of clipping.
I also modified ThumbnailDraw to optionally draw a thumbnail caption:
| Code: |
ThumbnailDraw ( BMP.Canvas, BMP.Canvas.ClipRect, fImageWidth, fImageHeight, fBorder, GraphicsArray, CaptionArray );
|
Here is the modified method. Do I have it correct?
| Code: |
function ThumbnailDraw ( Canvas: TCanvas;const Rect: TRect;
ThumbWidth, ThumbHeight, Margin: Integer;
Graphics: array of TGraphic;Caption: array of string ): 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] );
Canvas.Font.Name := 'Arial';
Canvas.Font.Size := 8;
Canvas.TextOut ( ThumbRect.Left + Canvas.Font.Size, ThumbRect.Bottom + 1, Caption[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;
|
I am using ThumbnailDraw in a CreateContactSheet procedure:
| Code: |
procedure TForm1.CreateContactSheet;
var
BMP: TBitmap;
TempBMP: TBitmap;
I: integer;
GraphicsArray: array of TGraphic;
CaptionArray: array of string;
PageWidth: integer;
PageHeight: integer;
MarginLeft: integer;
MarginRight: integer;
MarginTop: integer;
MarginBottom: integer;
PageClientWidth: integer;
PageClientHeight: integer;
BMPWidth: integer;
BMPHeight: integer;
begin
BMP := TBitmap.Create;
try
PageWidth := PageSetupDialog1.PageWidth;
PageHeight := PageSetupDialog1.PageHeight;
MarginLeft := PageSetupDialog1.MarginLeft;
MarginRight := PageSetupDialog1.MarginRight;
MarginTop := PageSetupDialog1.MarginTop;
MarginBottom := PageSetupDialog1.MarginBottom;
PageClientWidth := PageWidth - ( MarginLeft + MarginRight );
PageClientHeight := PageHeight - ( MarginTop + MarginBottom );
BMPWidth := ConvertUnits ( PageClientWidth, Screen.PixelsPerInch, mmHiEnglish, mmPixel );
BMPHeight := ConvertUnits ( PageClientHeight, Screen.PixelsPerInch, mmHiEnglish, mmPixel );
BMP.Width := BMPWidth;
BMP.Height := BMPHeight;
BMP.PixelFormat := pf24bit;
TempBMP := TBitmap.Create;
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.ImageTopText[I].Caption;
end;
fBorder := UpDown7.Position;
fImageWidth := UpDown1.Position;
fImageHeight := UpDown6.Position;
ThumbnailDraw ( BMP.Canvas, BMP.Canvas.ClipRect, fImageWidth, fImageHeight, fBorder, GraphicsArray, CaptionArray );
frmContactSheet.ImageEnView1.Blank;
frmContactSheet.ImageEnView1.IEBitmap.Assign ( BMP );
frmContactSheet.ImageEnView1.Update;
finally BMP.Free; end;
ImageEnMView1.ReleaseBitmap ( 0 );
end;
|
Questions:
1. Is the revised ThumbnailDraw function correct?
2. Can you fix the ThumbnailDraw method to prevent clipping?
3. Is there an easier way to set the bitmap width and height in the CreateContactSheet method?;
BMPWidth := ConvertUnits ( PageClientWidth, Screen.PixelsPerInch, mmHiEnglish, mmPixel );
BMPHeight := ConvertUnits ( PageClientHeight, Screen.PixelsPerInch, mmHiEnglish, mmPixel );
Thanks for the help.
| Description: |
| Image of contact sheet created with ThumbnailDraw. |
|
| Filesize: |
37.35 KB |
| Viewed: |
288 Time(s) |
|
_________________
w2m |
|
| Back to top |
|
 |
Kambiz
Administrator
Joined: 07 Mar 2003
Posts: 295
|
| Posted: 04/11/03 19:39 Post subject: |
|
|
I made the function a bit complicated. 
- Instead of the Margin parameter, you have the HorzGap and VertGap parameters.
- Using the Options parameter you can control the function's behavior.
I think for your case, you should use [tdoNoClip, tdoPartialOK] for the options.
| Code: | type
TThumbnailDrawOptions = set of (tdoNoClip, tdoPartialOK, tdoNoCaption);
function ThumbnailDraw(Canvas: TCanvas; const Rect: TRect;
ThumbWidth, ThumbHeight, HorzGap, VertGap: Integer;
Graphics: array of TGraphic; Captions: array of String;
Options: TThumbnailDrawOptions): 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
TextHeight: Integer;
TextAlign: Integer;
ThumbRect: TRect;
ClipRgn: THandle;
I: Integer;
begin
Result := 0;
if not (tdoNoClip in Options) then
begin
ClipRgn := CreateRectRgnIndirect(Rect);
try
SelectClipRgn(Canvas.Handle, ClipRgn);
finally
SelectClipRgn(Canvas.Handle, 0);
end;
end;
TextAlign := SetTextAlign(Canvas.Handle, TA_TOP or TA_CENTER);
try
if not (tdoNoCaption in Options) then
TextHeight := Canvas.TextHeight('H') + 2
else
TextHeight := 0;
SetRect(ThumbRect, 0, 0, ThumbWidth, ThumbHeight);
OffsetRect(ThumbRect, Rect.Left, Rect.Top);
if (tdoPartialOK in Options) or
((ThumbRect.Right <= Rect.Right) and (ThumbRect.Bottom <= Rect.Bottom)) then
begin
for I := Low(Graphics) to High(Graphics) do
begin
Canvas.StretchDraw(ShrinkRect(ThumbRect, Graphics[I]), Graphics[I]);
if TextHeight > 0 then
Canvas.TextOut((ThumbRect.Left + ThumbRect.Right) div 2, ThumbRect.Bottom + 1, Captions[I]);
OffsetRect(ThumbRect, ThumbWidth + HorzGap, 0);
Inc(Result);
if (ThumbRect.Left >= Rect.Right) or
(not (tdoPartialOK in Options) and (ThumbRect.Right > Rect.Right)) then
begin
OffsetRect(ThumbRect, Rect.Left - ThumbRect.Left, ThumbHeight + VertGap + TextHeight);
if (ThumbRect.Top >= Rect.Bottom) or
(not (tdoPartialOK in Options) and (ThumbRect.Bottom > Rect.Bottom))
then
Break;
end;
end;
end;
finally
SetTextAlign(Canvas.Handle, TextAlign);
if not (tdoNoClip in Options) then
SelectClipRgn(Canvas.Handle, 0);
end;
end; |
By the way, in my point of view, the bitmap size cannot be evaluated in an easier way.
Good luck,
Kambiz
|
|
| Back to top |
|
|
w2m
Member
Joined: 08 Mar 2003
Posts: 30
Location: New York, USA
|
| Posted: 05/11/03 00:53 Post subject: Thank You |
|
|
The improved ThumbnailDraw code works well, especially to eliminate most clipping (sometimes the captions are still clipped). Unfortunately I am still having trouble setting the size of area that the images are painted to. I seem to get the best results when I pass the ClientRect of the image component that contains the bitmap of thumbnails. When I pass the BMP.ClientRect as Rect then area for area to paint the images is only about 1/5th of the page in the print preview dialog. It's lind of clunky right now that you have to adjust the width and height of the form with the ContactSheet containing the thumbnails, but it works ok.
Boy this printing stuff always drive me nuts. I guess I have got to do some more reading and study.
Thanks for your help!
_________________
w2m |
|
| Back to top |
|
|
Kambiz
Administrator
Joined: 07 Mar 2003
Posts: 295
|
| Posted: 05/11/03 19:36 Post subject: |
|
|
I know what you mean anout printing problems. Seems there's no way to get rid of them.
Maybe instead of screen's resolution you should consider the printer's resolution to calculate then bitmap dimensions.
Please try the following code:
| Code: | BMPWidth := ConvertUnits ( PageClientWidth, GetDeviceCaps ( Printer.Handle, LOGPIXELSX ), mmHiEnglish, mmPixel );
BMPHeight := ConvertUnits ( PageClientHeight, GetDeviceCaps ( Printer.Handle, LOGPIXELSY ), mmHiEnglish, mmPixel ); |
|
|
| Back to top |
|
|
w2m
Member
Joined: 08 Mar 2003
Posts: 30
Location: New York, USA
|
| Posted: 06/11/03 02:15 Post subject: Using Printer vs Screen |
|
|
I tried using both:
| Code: | // Printer
PageWidth := PageSetupDialog1.PageWidth;
PageHeight := PageSetupDialog1.PageHeight;
MarginLeft := PageSetupDialog1.MarginLeft;
MarginRight := PageSetupDialog1.MarginRight;
MarginTop := PageSetupDialog1.MarginTop;
MarginBottom := PageSetupDialog1.MarginBottom;
PageClientWidth := PageWidth - ( MarginLeft + MarginRight );
PageClientHeight := PageHeight - ( MarginTop + MarginBottom );
BMPWidth := ConvertUnits ( PageClientWidth, GetDeviceCaps ( Printer.Handle, LOGPIXELSX ), mmHiEnglish, mmPixel );
BMPHeight := ConvertUnits ( PageClientHeight, GetDeviceCaps ( Printer.Handle, LOGPIXELSY ), mmHiEnglish, mmPixel );
with Rect do begin
Left := 0;
Right := BMPWidth;
Top := 0;
Bottom := BMPHeight;
end;
BMP.PixelFormat := pf24bit;
SetLength ( GraphicsArray, ImageEnMView1.ImageCount );
SetLength ( CaptionArray, ImageEnMView1.ImageCount );
fVertGap := fProperties.UpDown9.Position;
fHorzGap := fProperties.UpDown13.Position;
fImageWidth := fProperties.UpDown10.Position;
fImageHeight := fProperties.UpDown11.Position;
case fProperties.ComboBox1.ItemIndex of
0: fThumbOptions := [tdoNoClip]; // No Clipping
1: fThumbOptions := [tdoNoClip, tdoNoCaption]; // No Clipping & No Caption
2: fThumbOptions := [tdoPartialOK]; // Partial Clip OK
3: fThumbOptions := [tdoNoCaption]; // No Caption
4: fThumbOptions := [tdoNoClip, tdoPartialOK]; // No Clip & Partial Clip OK
5: fThumbOptions := [tdoNoClip, tdoPartialOK, tdoNoCaption] // No Clip, Partial Clip OK, No Caption
end; // case
for i := 0 to ImageEnMView1.ImageCount - 1 do begin
TempBMP := ImageEnMView1.GetBitmap ( I );
GraphicsArray[I] := TempBMP;
CaptionArray[I] := ImageEnMView1.ImageBottomText[I].Caption;
end;
fContactSheet.ContactSheet1.Blank;
ThumbnailDraw ( BMP.Canvas, Rect, fImageWidth, fImageHeight, fHorzGap, fVertGap, GraphicsArray, CaptionArray, fThumbOptions );
fContactSheet.ContactSheet1.IEBitmap.Assign ( BMP );
fContactSheet.ContactSheet1.Update;
for i := 0 to ImageEnMView1.ImageCount - 1 do
ImageEnMView1.ReleaseBitmap ( i );
//Printer Result
BMPWidth: 1950
BMPHeight: 2700
|
Printer Result
BMPWidth: 1950
BMPHeight: 2700
| Code: | // Screen
PageWidth := PageSetupDialog1.PageWidth;
PageHeight := PageSetupDialog1.PageHeight;
MarginLeft := PageSetupDialog1.MarginLeft;
MarginRight := PageSetupDialog1.MarginRight;
MarginTop := PageSetupDialog1.MarginTop;
MarginBottom := PageSetupDialog1.MarginBottom;
PageClientWidth := PageWidth - ( MarginLeft + MarginRight );
PageClientHeight := PageHeight - ( MarginTop + MarginBottom );
BMP.Width := BMPWidth;
BMP.Height := BMPHeight;
with Rect do begin
Left := 0;
Right := BMPWidth;
Top := 0;
Bottom := BMPHeight;
end;
BMPWidth := ConvertUnits ( PageClientWidth, Screen.PixelsPerInch, mmHiEnglish, mmPixel );
BMPHeight := ConvertUnits ( PageClientHeight, Screen.PixelsPerInch, mmHiEnglish, mmPixel );
with Rect do begin
Left := 0;
Right := BMPWidth;
Top := 0;
Bottom := BMPHeight;
end;
BMP.PixelFormat := pf24bit;
SetLength ( GraphicsArray, ImageEnMView1.ImageCount );
SetLength ( CaptionArray, ImageEnMView1.ImageCount );
fVertGap := fProperties.UpDown9.Position;
fHorzGap := fProperties.UpDown13.Position;
fImageWidth := fProperties.UpDown10.Position;
fImageHeight := fProperties.UpDown11.Position;
case fProperties.ComboBox1.ItemIndex of
0: fThumbOptions := [tdoNoClip]; // No Clipping
1: fThumbOptions := [tdoNoClip, tdoNoCaption]; // No Clipping & No Caption
2: fThumbOptions := [tdoPartialOK]; // Partial Clip OK
3: fThumbOptions := [tdoNoCaption]; // No Caption
4: fThumbOptions := [tdoNoClip, tdoPartialOK]; // No Clip & Partial Clip OK
5: fThumbOptions := [tdoNoClip, tdoPartialOK, tdoNoCaption] // No Clip, Partial Clip OK, No Caption
end; // case
for i := 0 to ImageEnMView1.ImageCount - 1 do begin
TempBMP := ImageEnMView1.GetBitmap ( I );
GraphicsArray[I] := TempBMP;
CaptionArray[I] := ImageEnMView1.ImageBottomText[I].Caption;
end;
fContactSheet.ContactSheet1.Blank;
ThumbnailDraw ( BMP.Canvas, Rect, fImageWidth, fImageHeight, fHorzGap, fVertGap, GraphicsArray, CaptionArray, fThumbOptions );
fContactSheet.ContactSheet1.IEBitmap.Assign ( BMP );
fContactSheet.ContactSheet1.Update;
for i := 0 to ImageEnMView1.ImageCount - 1 do
ImageEnMView1.ReleaseBitmap ( i );
//Screen Result
BMPWidth: 624
BMPHeight: 864
|
Screen Result
BMPWidth: 624
BMPHeight: 864
the Screen:
BMPWidth := ConvertUnits ( PageClientWidth, Screen.PixelsPerInch, mmHiEnglish, mmPixel );
BMPHeight := ConvertUnits ( PageClientHeight, Screen.PixelsPerInch, mmHiEnglish, mmPixel );
seems to give the best results.
The printer is a HP 2000 deskjet with letter lize page (8.5x11 inch) page in portrait mode.
When I pass the BMP to the ImageEN Print Preview Dialog the results match the printers page size the best when using the Screen, but when the image prints on my printer the top inch and a half gets cut off. I am beginning to wonder if the ImageEN Print Preview Dialog has a bug.
Do you own the ImageEN Library? If so I'd be glad to send you the source. Only VCL components and ImageEn are used in the source. The source is an icon editing application.
Thanks
_________________
w2m |
|
| Back to top |
|
|
Kambiz
Administrator
Joined: 07 Mar 2003
Posts: 295
|
| Posted: 06/11/03 17:10 Post subject: |
|
|
| I don't have the component.
|
|
| Back to top |
|
|
|
|
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
|
FAQ
Search
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
