|
|
Регистрация Восстановить пароль |
Регистрация | Задать вопрос |
Заплачу за решение |
Новые сообщения |
Сообщения за день |
Расширенный поиск |
Правила |
Всё прочитано |
|
Опции темы | Поиск в этой теме |
29.08.2007, 18:14 | #1 |
Форумчанин
Регистрация: 16.04.2007
Сообщений: 298
|
Изменить размеры страницы принтера
Есть у меня такая задача.
Загружаю метафайл в просмотрщик. Дальше надо его повернуть и распечатать. Для этого делаю следующее: 1. Устанавливаю контекст вывода: DC := Printer.Handle; Point.X := GetDeviceCaps(DC,PHYSICALOFFSETX); Point.Y := GetDeviceCaps(DC,PHYSICALOFFSETY); PixPerInch.X := GetDeviceCaps(DC,LOGPIXELSX); PixPerInch.Y := GetDeviceCaps(DC,LOGPIXELSY); SetWindowOrgEx(DC, 0, 0, nil); SetViewportOrgEx(DC, -Point.X, -Point.Y, @PrevPoint); 1. Конвертирую в bmp TmpBitmap := TBitmap.Create; try with TmpBitmap do begin Width := TmpMetafile.Width; Height := TmpMetafile.Height; Canvas.Draw(0, 0, TmpMetafile); end; 2. Поворачиваю RotateBitmap(TmpBitmap, 270, clWhite); 3. Сохраняю в файл (чисто для себя) TmpBitmap.SaveToFile('1.bmp'); 4. Вывожу на печать. Printer.Canvas.StretchDraw( Rect(0, 0, Trunc((Min(TmpBitmap.Height, TmpBitmap.Width)/ Screen.PixelsPerInch)*PixPerInch.X) , Trunc((Min(TmpBitmap.Height, TmpBitmap.Width)/ Screen.PixelsPerInch)*PixPerInch.Y) ), TmpBitmap); И вся проблема заключается в том, что когда он выводит на печать, правая и левая граница с очень большими отступами, порядка 2.5 см. Продолжение истории Загружаю сохраненный файл в ACDSee 7.0. Выбираю "Файл\Печать изображения\ параметры страницы. Вижу, что там установлены поля 25.4 по всем направлениям. Я везде ставлю 0, вывожу на печать и о, чудо, он печатает именно так, как и поставлено. Господа, кто-нибудь подскажите пожалуйста, где в Делфи можно так устанавливать параметры страницы. В свойствах принтера не предлагать, там такого нет (у меня точно)
Не надо ничего усложнять. Все достаточно тривиально.
|
30.08.2007, 05:14 | #2 |
Форумчанин
Регистрация: 16.04.2007
Сообщений: 298
|
Во, нашел (правда, еще не тестировал, но очень похоже на правду)! Выкладываю, может, кому и пригодится.
procedure DrawImage(Canvas: TCanvas; DestRect: TRect; ABitmap: TBitmap); var Header, Bits: Pointer; HeaderSize: Integer; BitsSize: Longint; begin GetDIBSizes(ABitmap.Handle, HeaderSize, BitsSize); Header := MemAlloc(HeaderSize); Bits := MemAlloc(BitsSize); try GetDIB(ABitmap.Handle, ABitmap.Palette, Header^, Bits^); StretchDIBits(Canvas.Handle, DestRect.Left, DestRect.Top, DestRect.Right, DestRect.Bottom, 0, 0, ABitmap.Width, ABitmap.Height, Bits, TBitmapInfo(Header^), DIB_RGB_COLORS, SRCCOPY); { вам может понадобиться цветовой стандарт DIB_PAL_COLORS, но это уже выходит за рамки моих знаний. } finally MemFree(Header, HeaderSize); MemFree(Bits, BitsSize); end; end; { Печатаем изображение, растягивая его до целого листа } procedure PrintBitmap(ABitmap: TBitmap); var relheight, relwidth: integer; begin screen.cursor := crHourglass; Printer.BeginDoc; if ((ABitmap.width / ABitmap.height) > l(printer.pagewidth / printer.pageheight)) then begin { Растягиваем ширину изображения до ширины бумаги } relwidth := printer.pagewidth; relheight := MulDiv(ABitmap.height, printer.pagewidth, ABitmap.width); end else begin { Растягиваем высоту изображения до высоты бумаги } relwidth := MulDiv(ABitmap.width, printer.pageheight, ABitmap.height); relheight := printer.pageheight; end; DrawImage(Printer.Canvas, Rect(0, 0, relWidth, relHeight), ABitmap); Printer.EndDoc; screen.cursor := crDefault; end; ------------------------ DRKB - мощная штука!
Не надо ничего усложнять. Все достаточно тривиально.
Последний раз редактировалось Shuraken; 30.08.2007 в 05:16. |
Похожие темы | ||||
Тема | Автор | Раздел | Ответов | Последнее сообщение |
Как оперделить размеры кадра в видеофайле? | froggy | Общие вопросы Delphi | 7 | 24.08.2008 23:11 |
Изменить размеры | Манжосов Денис :) | Gamedev - cоздание игр: Unity, OpenGL, DirectX | 2 | 16.05.2008 20:14 |
Как сделать разрыв страницы печати по условию и узнать номер страницы | Leanna | Microsoft Office Excel | 2 | 21.01.2008 06:59 |
Microsoft Office Outlook : Размеры вложений | ale140 | Софт | 0 | 12.12.2007 17:13 |
Как изменять размеры StringGrid Мышкой | Inbox | Компоненты Delphi | 4 | 30.06.2007 14:34 |