Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом
Логин:
Пароль:
Регистрация | Забыли пароль?

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

#   

Статистика за сегодня:  


Лучшие эксперты

Подробнее »

Вопрос # 1 728

Раздел: Delphi » Работа с устройствами и "железом"
/ вопрос открыт /

Здравствуйте!
Заранее всем спасибо. У меня задача: есть изображение. По введённым параметрам надо его отмасштабировать и вывести на принтер. В масштабе картинка мотбыть больше А4 (примерно 1500*500 мм). После распечатки листочки обрезаем, складываем, и получаем картинку 1:1. Как это сделать? Мотбыть есть какаято спецштука для работы с принтером? И как это изображение лучше хранить, чтоб масштабилось без особой потери качества. (рисунок типа эскиза детали-чернобелый)

red_88 Вопрос ожидает решения (принимаются ответы, доступен мини-форум)

Вопрос задал: red_88 (статус: Посетитель)
Вопрос отправлен: 25 июня 2008, 21:07
Состояние вопроса: открыт, ответов: 3.

Ответ #1. Отвечает эксперт: Мережников Андрей

Здравствуйте, red_88!
Может быть поможет информация, приведенная в приложении (опубликовано в DelphiWorld)

Приложение:
  1. procedure DrawImage(Canvas: TCanvas; DestRect: TRect; ABitmap:
  2. TBitmap);
  3. var
  4. Header, Bits: Pointer;
  5. HeaderSize: Integer;
  6. BitsSize: Longint;
  7. begin
  8. GetDIBSizes(ABitmap.Handle, HeaderSize, BitsSize);
  9. Header := MemAlloc(HeaderSize);
  10. Bits := MemAlloc(BitsSize);
  11. try
  12. GetDIB(ABitmap.Handle, ABitmap.Palette, Header^, Bits^);
  13. StretchDIBits(Canvas.Handle, DestRect.Left, DestRect.Top,
  14. DestRect.Right, DestRect.Bottom,
  15. 0, 0, ABitmap.Width, ABitmap.Height, Bits, TBitmapInfo(Header^),
  16. DIB_RGB_COLORS, SRCCOPY);
  17.  
  18.  
  19. finally
  20. MemFree(Header, HeaderSize);
  21. MemFree(Bits, BitsSize);
  22. end;
  23. end;
  24.  
  25.  
  26.  
  27. procedure PrintBitmap(ABitmap: TBitmap);
  28. var
  29. relheight, relwidth: integer;
  30. begin
  31. screen.cursor := crHourglass;
  32. Printer.BeginDoc;
  33. if ((ABitmap.width / ABitmap.height) > l(printer.pagewidth /
  34. printer.pageheight)) then
  35. begin
  36.  
  37. relwidth := printer.pagewidth;
  38. relheight := MulDiv(ABitmap.height, printer.pagewidth, ABitmap.width);
  39. end
  40. else
  41. begin
  42.  
  43. relwidth := MulDiv(ABitmap.width, printer.pageheight, ABitmap.height);
  44. relheight := printer.pageheight;
  45. end;
  46. DrawImage(Printer.Canvas, Rect(0, 0, relWidth, relHeight), ABitmap);
  47. Printer.EndDoc;
  48. screen.cursor := crDefault;
  49. end;
  50.  
  51.  


Ответ отправил: Мережников Андрей (статус: Абитуриент)
Время отправки: 25 июня 2008, 22:36

Ответ #2. Отвечает эксперт: ANBsoft

Здравствуйте, red_88!
Для таких целей существуют специальные программы, например PrpPoster.
Она делает как раз то, что Вам нужно.

Ответ отправил: ANBsoft (статус: Студент)
Время отправки: 25 июня 2008, 23:58

Ответ #3. Отвечает эксперт: Feniks

Здравствуйте, red_88!
Попробуйте еще функции из Приложения.

Желаю удачи.

Приложение:
  1. {
  2.  
  3.  
  4. (c) Alexey Torgashin, 2007
  5.  
  6.  
  7. http://atorg.net.ru/delphi/atviewer.htm
  8.  
  9.  
  10.  
  11.  
  12.  
  13.  
  14.  
  15.  
  16.  
  17.  
  18.  
  19.  
  20. -----------------------------------
  21.  
  22. Image printing. Uses Printers unit.
  23. Should work with all graphics: bitmaps, metafiles and icons.
  24.  
  25. Parameters:
  26. - AImage: TImage object.
  27. - ACopies: number of copies (you may set 0 for a single copy).
  28. - AFitToPage: fit image to a printer page. If image is smaller than a page and
  29. AFitOnlyLarger=False then image will be stretched up to a page.
  30. - AFitOnlyLarger: allows to stretch images smaller than a page.
  31. - ACenter: center image on a page.
  32. - APixelsPerInch: pass here value of PixelsPerInch property of your form or
  33. of a Screen object (Screen.PixelsPerInch).
  34. - ACaption: print job caption in Print Manager.
  35. }
  36.  
  37. function ImagePrint(
  38. AImage: TImage;
  39. ACopies: word;
  40. AFitToPage,
  41. AFitOnlyLarger,
  42. ACenter: boolean;
  43. APixelsPerInch: integer;
  44. const ACaption: string): boolean;
  45. var
  46. bmp: TBitmap;
  47. begin
  48. bmp:= TBitmap.Create;
  49. try
  50. bmp.PixelFormat:= pf24bit;
  51.  
  52. {$ifdef ADV_IMAGE_CONV}
  53. if not CorrectImageToBitmap(AImage, bmp, clWhite) then
  54. begin
  55. Result:= false;
  56. Exit
  57. end;
  58. {$else}
  59. with AImage.Picture do
  60. begin
  61. bmp.Width:= Graphic.Width;
  62. bmp.Height:= Graphic.Height;
  63. bmp.Canvas.Draw(0, 0, Graphic);
  64. end;
  65. {$endif}
  66.  
  67. Result:= BitmapPrint( //Declared below
  68. bmp,
  69. ACopies,
  70. AFitToPage,
  71. AFitOnlyLarger,
  72. ACenter,
  73. APixelsPerInch,
  74. ACaption);
  75.  
  76. finally
  77. bmp.Free;
  78. end;
  79. end;
  80.  
  81.  
  82. function BitmapPrint(
  83. ABitmap: TBitmap;
  84. ACopies: word;
  85. AFitToPage,
  86. AFitOnlyLarger,
  87. ACenter: boolean;
  88. APixelsPerInch: integer;
  89. const ACaption: string): boolean;
  90. var
  91. Scale, ScalePX, ScalePY, ScaleX, ScaleY: Double;
  92. SizeX, SizeY,
  93. RectSizeX, RectSizeY, RectOffsetX, RectOffsetY: integer;
  94. i: integer;
  95. Begin
  96. Result:= true;
  97.  
  98. Assert(
  99. Assigned(ABitmap) and (ABitmap.Width>0) and (ABitmap.Height>0),
  100. 'BitmapPrint: bitmap is empty.');
  101.  
  102. if ACopies = 0 then
  103. Inc(ACopies);
  104.  
  105. with Printer do
  106. begin
  107. SizeX:= PageWidth;
  108. SizeY:= PageHeight;
  109.  
  110. ScalePX:= GetDeviceCaps(Handle, LOGPIXELSX) / APixelsPerInch;
  111. ScalePY:= GetDeviceCaps(Handle, LOGPIXELSY) / APixelsPerInch;
  112.  
  113. ScaleX:= SizeX / ABitmap.Width / ScalePX;
  114. ScaleY:= SizeY / ABitmap.Height / ScalePY;
  115.  
  116. if ScaleX < ScaleY then
  117. Scale:= ScaleX
  118. else
  119. Scale:= ScaleY;
  120.  
  121. if (not AFitToPage) or (AFitOnlyLarger and (Scale > 1.0)) then
  122. Scale:= 1.0;
  123.  
  124. RectSizeX:= Trunc(ABitmap.Width * Scale * ScalePX);
  125. RectSizeY:= Trunc(ABitmap.Height * Scale * ScalePY);
  126.  
  127. if ACenter then
  128. begin
  129. RectOffsetX:= (SizeX - RectSizeX) div 2;
  130. RectOffsetY:= (SizeY - RectSizeY) div 2;
  131. end
  132. else
  133. begin
  134. RectOffsetX:= 0;
  135. RectOffsetY:= 0;
  136. end;
  137.  
  138. Title:= ACaption;
  139.  
  140. try
  141. BeginDoc;
  142. try
  143. for i:= 1 to ACopies do
  144. begin
  145. Canvas.StretchDraw(
  146. Rect(
  147. RectOffsetX,
  148. RectOffsetY,
  149. RectOffsetX + RectSizeX,
  150. RectOffsetY + RectSizeY),
  151. ABitmap
  152. );
  153. if i < ACopies then
  154. NewPage;
  155. end;
  156. finally
  157. EndDoc;
  158. end;
  159. except
  160. Result:= false;
  161. end;
  162. end;
  163. end;


Ответ отправил: Feniks (статус: Бакалавр)
Время отправки: 26 июня 2008, 10:02


Мини-форум вопроса

Всего сообщений: 5; последнее сообщение — 26 июня 2008, 10:56; участников в обсуждении: 2.
ANBsoft

ANBsoft (статус: Студент), 26 июня 2008, 00:01 [#1]:

Пардон, опечатка, нужно ProPoster.
Dron

Dron (статус: Студент), 26 июня 2008, 10:07 [#2]:

Бубырь Александр Николаевич: а ссылку на программу Вам было сложно привести?
С уважением.
ANBsoft

ANBsoft (статус: Студент), 26 июня 2008, 10:15 [#3]:

Для тех кто не хочет пользоваться поиском :)
http://depositfiles.com/files/6217459
Dron

Dron (статус: Студент), 26 июня 2008, 10:27 [#4]:

Цитата:

Для тех кто не хочет пользоваться поиском :)

А не в этом дело. Чем выше статус эксперта, тем более высокие требования к качеству ответов.

Цитата:

http://depositfiles.com/files/6217459

А официального сайта у программы нет что ли?
С уважением.
ANBsoft

ANBsoft (статус: Студент), 26 июня 2008, 10:56 [#5]:

В принципе согласен,
офф сайт http://www.ronyasoft.com/products/proposter/,
но для нормального человека достаточно знать что искать.
Яндекс по ключу "Proposter" выдал тучу ссылок.
А выложенная мной ссылка гораздо лучше чем офф,
кто скачал поймет о чем я ;).

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.
Версия движка: 2.6+ (26.01.2011)
© 2005-2025
Текущее время: 22 февраля 2025, 16:26
Выполнено за 0.02 сек.