Мастера DELPHI, Delphi programming community Рейтинг@Mail.ru Титульная страница Поиск, карта сайта Написать письмо 
| Новости |
Новости сайта
Поиск |
Поиск по лучшим сайтам о Delphi
FAQ |
Огромная база часто задаваемых вопросов и, конечно же, ответы к ним ;)
Статьи |
Подборка статей на самые разные темы. Все о DELPHI
Книги |
Новинки книжного рынка
Новости VCL
Обзор свежих компонент со всего мира, по-русски!
|
| Форумы
Здесь вы можете задать свой вопрос и наверняка получите ответ
| ЧАТ |
Место для общения :)
Орешник |
Коллекция курьезных вопросов из форумов
KOL и MCK |
KOL и MCK - Компактные программы на Delphi
Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / rsdn.org

 
Чтобы не потерять эту дискуссию, сделайте закладку « предыдущая ветвь | форум | следующая ветвь »

Пришлите, пожалуйста, Printers.pas от последних версий Delphi


Тимохов Дима ©   (10.04.18 20:14

Коллеги!

Пришлите, пожалуйста, на почту timokhov собака gmail дот com Printers.pas от последних версий дельфи, которые совместимы с Windows 10. Я, признать, не знаю, что сейчас является совместимым с Windows 10. Токио? Берлин? Сиетл? В общем, чем более поздний дельфи, тем лучше.

Проблема в том, что, похоже, что Delphi 2007 не верно определят принтер по умолчанию в TPrinter.SetToDefaultPrinter. Хочу посмотреть, как они дописали указанный метод для более новых версий Windows.

Спасибо!


dmk ©   (10.04.18 22:36[1]

У меня тоже с принтерами глюки в XE6. Это в 10-ке после обновления какого-то проблемы появились. Даже рекомендуемый код от майкрософт не работает.


Тимохов Дима ©   (13.04.18 13:34[2]


> dmk ©   (10.04.18 22:36) [1]

Т.к. у меня клиенты далеко, ехать мне лень, то сделал просто - сделал им выбор принтера. Пусть сами выбирают.

Но косвенно могу понять, что в их случае проблема в том, что неверно определяется принтер по умолчанию, ибо Printer.Printers выдает несколько принтеров, в т/ч три штуки через принт-сервер. Вот где-то то тут и зарыта собака.


Rouse_ ©   (14.04.18 23:55[3]

Ушло.
Embarcadero® Delphi 10.2 Version 25.0.27659.1188


Rouse_ ©   (14.04.18 23:57[4]

А по поводу принтеров, вот такой код работает без сбоев:

function TSysInfoOSData.RawPrinterData(out DefaultIndex: Integer): TStringList;
begin
 Result := TStringList.Create;
 with TPrinter.Create do
 try
   Result.Assign(Printers);
   DefaultIndex := PrinterIndex;
 finally
   Free;
 end;
end;

function TSysInfoOSData.GetPrinterData: string;

 procedure Add(const Value: string);
 begin
   if Result = '' then
     Result := Value
   else
     Result := Result + sLineBreak + '  - ' + Value;
 end;

var
 S: TStringList;
 I, A: Integer;
begin
 Result := '';
 S := RawPrinterData(A);
 try
   for I := 0 to S.Count - 1 do
     if I = A then
       Add(S[I] + ' (default)')
     else
       Add(S[I]);
 finally
   S.Free;
 end;
end;


dmk ©   (15.04.18 18:42[5]

>вот такой код работает без сбоев:
Все бы хорошо, но у меня WinApi:

function TWinPrinter.UpdateProperties(ShowDialog: boolean): boolean;
var
 bFlag: Boolean;
 IntFlag: Integer;
 DataSize: Integer;
 pDefaults: _PRINTER_DEFAULTSW;
 pDevMode: Pointer;

begin
 pDefaults.pDatatype := nil;
 pDefaults.pDevMode := nil;
 pDefaults.DesiredAccess := PRINTER_ALL_ACCESS;
 FPrinterInfo2W := nil;

 Result := False;

 //Попробуем открыть принтер и получить FPrinterHandle
 if OpenPrinter(PChar(FPrinterName), FPrinterHandle, nil) then
 begin
   DataSize := 0;

   //PRINTER_INFO_2
   //Первый вызов для получения размера буфера
   bFlag := GetPrinter(FPrinterHandle, 2, FPrinterInfo2W, DataSize, @DataSize);
   if ((bFlag = false) and (DataSize = 0)) then
   begin
     raise Exception.Create('GetPrinter data size error: ' + IntToStr(GetLastError));
   end
   else
   begin
     //Выделим память под полную структуру принтера
     GetMem64(FPrinterInfo2W, DataSize);

     //Теперь получим информацию о принтере
     bFlag := GetPrinter(FPrinterHandle, 2, FPrinterInfo2W, DataSize, @DataSize);
     if (bFlag = false) then
     begin
       FreeMem64(FPrinterInfo2W);
       raise Exception.Create('GetPrinter info error: ' + IntToStr(GetLastError));
     end;
   end;
 end
 else raise Exception.Create('OpenPrinter error: ' + IntToStr(GetLastError));

 //Вызов 1
 //Узнаем размер буфера для структуры DevMode
 IntFlag := DocumentProperties(0, FPrinterHandle, PChar(FPrinterName), nil, nil, 0);
 if (IntFlag < 0) then
 begin
   FreeMem64(FPrinterInfo2W);
   raise Exception.Create('UpdateProperties error: ' + IntToStr(GetLastError));
 end
 else//Иначе выделим память под хранение DevMode
 begin
   GetMem64(pDevMode, IntFlag);
 end;

 //Вызов 2
 //Данный вызов проверяет параметры в FDevMode, чтобы допустить их для изменения
 case ShowDialog of
   True: IntFlag := DocumentProperties(FParentWindow, FPrinterHandle, PChar(FPrinterName),
                                       PDeviceModeW(pDevMode)^, PPrinterInfo2W(FPrinterInfo2W).pDevMode^,
                                       DM_IN_PROMPT or DM_OUT_BUFFER or DM_IN_BUFFER);

  False: IntFlag := DocumentProperties(0, FPrinterHandle, PChar(FPrinterName),
                                       PDeviceModeW(pDevMode)^, PPrinterInfo2W(FPrinterInfo2W).pDevMode^,
                                       DM_OUT_BUFFER or DM_IN_BUFFER);
 end;

 if Integer(IntFlag) < 0 then
 begin
   FreeMem64(FPrinterInfo2W);
   FreeMem64(pDevMode);
   raise Exception.Create('UpdateProperties error: ' + IntToStr(GetLastError));
 end;

 //Если вызвали диалог, то заберем новые данные
 if ((IntFlag = ID_Ok) and ShowDialog) then
 begin
   FPaperOrientation := PDeviceModeW(pDevMode)^.dmOrientation;
   FCopies := PDeviceModeW(pDevMode)^.dmCopies;
 end;

 //Здесь меняем данные
 if (IntFlag = ID_Ok) then
 begin
   PDeviceModeW(pDevMode)^.dmOrientation := FPaperOrientation;
   PDeviceModeW(pDevMode)^.dmCopies := FCopies;

   PDeviceModeW(pDevMode)^.dmFields := DM_ORIENTATION;
   PDeviceModeW(pDevMode)^.dmFields := DM_COPIES;
 end;

 //Вызов 3
 //Данный вызов проверяет pDevMode, чтобы допустить их для создания DC
 IntFlag := DocumentProperties(0, FPrinterHandle, PChar(FPrinterName), PDeviceModeW(pDevMode)^,
                                PDeviceModeW(pDevMode)^, DM_OUT_BUFFER or DM_IN_BUFFER);
 if (IntFlag < 0) then
 begin
   FreeMem64(FPrinterInfo2W);
   FreeMem64(pDevMode);
   raise Exception.Create('UpdateProperties error: ' + IntToStr(GetLastError));
 end;

 //...
 PPrinterInfo2W(FPrinterInfo2W).pDevMode^ := PDeviceModeW(pDevMode)^;

 //Меняем данные у принтера
 if SetPrinter(FPrinterHandle, 2, FPrinterInfo2W, 0) then else //<- ТУТ ОШИБКА ВЫСКАКИВАЕТ
 begin
   FreeMem64(FPrinterInfo2W);
   FreeMem64(pDevMode);
   raise Exception.Create('SetPrinter error: ' + IntToStr(GetLastError));
 end;

 //---
 FDevMode^ := PDeviceModeW(pDevMode)^;
 if (pDevMode <> nil) then FreeMem64(pDevMode);

 //Ориентация бумаги - 1: DMORIENT_PORTRAIT; 2: DMORIENT_LANDSCAPE
 FPaperOrientation := FDevMode.dmOrientation;
 FCopies := FDevMode.dmCopies;

 //Расчет физических характеристик принтера
 UpdatePhysInfo;

 bFlag := ClosePrinter(FPrinterHandle);
 if bFlag = false then
 begin
   FreeMem64(FPrinterInfo2W);
   FreeMem64(pDevMode);
   raise Exception.Create('ClosePrinter error: ' + IntToStr(GetLastError));
 end;

 FreeMem64(FPrinterInfo2W);
 Result := true;
end;


версия для печати

Написать ответ

Ваше имя (регистрация  E-mail 







Разрешается использование тегов форматирования текста:
<b>жирный</b> <i>наклонный</i> <u>подчеркнутый</u>,
а для выделения текста программ, используйте <code> ... </code>
и не забывайте закрывать теги! </b></i></u></code> :)


Наверх

  Рейтинг@Mail.ru     Титульная страница Поиск, карта сайта Написать письмо