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

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

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 26.01.2013, 16:10   #1
Paskal1
Пользователь
 
Аватар для Paskal1
 
Регистрация: 22.10.2010
Сообщений: 69
Восклицание Убрать рамку из печати

Ребята код не мой только под себя подточил.
1 Проблема такая: На выходе рисует рамку вокруг изображения.
2 Помогите с масштабом чтоб без всяких отступов вместить изображение в страницу.

Печатаю изображение с форматом *.jpg (размеры 2480x3506) на А4 ориентация книжная.

Много плюсов тому кто отзовется.
и большой поклон всем ГУРУ

мой код:
Код:
procedure TForm3.sBitBtn1Click(Sender: TObject);
var
  ScaleX, ScaleY: Integer;
  RR: TRect;
 PrintersInfo, TmpPrintersInfo: PPrinterInfo1;
 pcbNeeded, pcReturned, jpcbNeeded, jpcReturned: DWORD;
 I, J: Integer;
  papermmx, papermmy: Extended;
   x1, y2:Integer;
 hPrinter: THandle;
 JobInfo, TmpJobInfo: PJobInfo3;
begin

  with Printer do
  begin
    if {sComboBox1.ItemIndex = -1} 1=2then
    begin
    beep;
    ShowMessage('Нет принтеров для печати! Либо ваши принтеры установлены как виртуальные.');
    end
    else
    begin
    Printer.PrinterIndex:=sComboBox1.ItemIndex;
    Printer.PrinterIndex:=2;      //для теста
    BeginDoc;
    // The StartDoc function starts a print job.
    try
       papermmx := GetDeviceCaps(Printer.Canvas.Handle, PHYSICALWIDTH) /
        GetDeviceCaps(Printer.Canvas.Handle, LOGPIXELSX);
        papermmy := GetDeviceCaps(Printer.Canvas.Handle, PHYSICALHEIGHT) /
       GetDeviceCaps(Printer.Canvas.Handle, LOGPIXELSY);
       x1:= Round(papermmx);
       y2:= Round(papermmy);

      ScaleX := GetDeviceCaps(Handle,  logPixelsX) div 1 ; //
      ScaleY := GetDeviceCaps(Handle, logPixelsY) div 1 ; //
      // Retrieves information about the Pixels per Inch of the Printer.
      RR := Rect(0, 0, x1 * ScaleX , y2 * ScaleY);
      Canvas.StretchDraw(RR, Image2.Picture.Graphic);
      // Stretch to fit
    finally
      EndDoc;

    end;
    end;
  end;
  sleep(5000);
  if Printer.Printing = false then
  begin
     //очистка очереди печати
   EnumPrinters(PRINTER_ENUM_LOCAL, nil, 1, PrintersInfo, 0, pcbNeeded, pcReturned);
 if GetLastError = ERROR_INSUFFICIENT_BUFFER then
 begin
  GetMem(PrintersInfo, pcbNeeded);
  try
  if EnumPrinters(PRINTER_ENUM_LOCAL, nil, 1,
  PrintersInfo, pcbNeeded, pcbNeeded, pcReturned) then
  begin
  TmpPrintersInfo := PrintersInfo;
  for I := 0 to pcReturned - 1 do
  begin
  if OpenPrinter(TmpPrintersInfo^.pName, hPrinter, nil) then
  begin
  EnumJobs(hPrinter, 0, 100, 1, nil,
  0, jpcbNeeded, jpcReturned);
  if GetLastError in [NO_ERROR, ERROR_INSUFFICIENT_BUFFER] then
  begin
  GetMem(JobInfo, jpcbNeeded);
  try
  if EnumJobs(hPrinter, 0, 100, 3, JobInfo,
  jpcbNeeded, jpcbNeeded, jpcReturned) then
  begin
  TmpJobInfo := JobInfo;
  for J := 0 to jpcReturned - 1 do
  begin
  if not SetJob(hPrinter, TmpJobInfo^.JobId, 0,
  nil, JOB_CONTROL_DELETE) then RaiseLastOSError;
  Inc(TmpJobInfo);
  end;
  end
  else
  RaiseLastOSError;
  finally
  FreeMem(JobInfo);
  end;
  end
  else
  RaiseLastOSError;
  end
  else
  RaiseLastOSError;
  Inc(TmpPrintersInfo);
  end;
  end
  else
  RaiseLastOSError;
  finally
  FreeMem(PrintersInfo);
  end;
 end
 else
  RaiseLastOSError;
 end
 else
 begin
   Showmessage('Печать идет');
 end;
end;
Paskal1 вне форума Ответить с цитированием
Старый 26.01.2013, 16:22   #2
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,097
По умолчанию

Цитата:
На выходе рисует рамку вокруг изображения.
Можешь показать?
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 26.01.2013, 16:31   #3
Paskal1
Пользователь
 
Аватар для Paskal1
 
Регистрация: 22.10.2010
Сообщений: 69
По умолчанию Скрин

Цитата:
Сообщение от Stilet Посмотреть сообщение
Можешь показать?
http://www.vizit-kanc.com.ua/ewr.png
Paskal1 вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Убрать (Border) рамку у ВСЕХ объектов на листе VictorM Microsoft Office Excel 2 19.11.2012 11:18
Убрать рамку активной ячейки ratibor Microsoft Office Excel 8 03.07.2012 16:56
Убрать пунктирную рамку вокруг Image ivan.tiran Общие вопросы Delphi 3 17.05.2012 20:41
Убрать рамку при рисовании в MS WORD badfilin Microsoft Office Word 2 08.01.2010 12:41
Как убрать рамку фокуса ввода с TListBox? SalasAndriy Компоненты Delphi 2 01.04.2009 21:09