Конференция "Прочее" » Пришлите, пожалуйста, Printers.pas от последних версий Delphi
 
  • Тимохов Дима © (10.04.18 20:14) [0]
    Коллеги!

    Пришлите, пожалуйста, на почту 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;
 
Конференция "Прочее" » Пришлите, пожалуйста, Printers.pas от последних версий Delphi
Есть новые Нет новых   [134427   +34][b:0][p:0.001]