Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Низкоуровневое программирование > Win Api
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 29.08.2007, 18:14   #1
Shuraken
Форумчанин
 
Аватар для Shuraken
 
Регистрация: 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, вывожу на печать и о, чудо, он печатает именно так, как и поставлено.
Господа, кто-нибудь подскажите пожалуйста, где в Делфи можно так устанавливать параметры страницы. В свойствах принтера не предлагать, там такого нет (у меня точно)
Не надо ничего усложнять. Все достаточно тривиально.
Shuraken вне форума Ответить с цитированием
Старый 30.08.2007, 05:14   #2
Shuraken
Форумчанин
 
Аватар для Shuraken
 
Регистрация: 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.
Shuraken вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Как оперделить размеры кадра в видеофайле? 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