rm_printer.pas

这是一个功能强大

function TRMCustomPrinter.GetPrintableWidth: LongInt;
begin
  FLock.Acquire;
  try
    GetDC;
    Result := FPrintableWidth;
  finally
    FLock.Release;
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMPrinter}

constructor TRMPrinter.Create;
begin
  inherited Create;
  FCopies := 1;
  PaperSize := 9;
end;

destructor TRMPrinter.Destroy;
begin
  inherited Destroy;
end;

procedure TRMPrinter.FillPrinterInfo(var p: TRMPageInfo);
var
  lindex: Integer;
begin
  FLock.Acquire;
  try
    if (FPrinterIndex = 1) or (RMPrinters.Count = 2) then
    begin
      with PrinterInfo do
      begin
        lindex := GetPaperSizeIndex(PaperSize);
        if Orientation = rmpoPortrait then
        begin
          p.ScreenPageWidth := RMToScreenPixels(PaperWidths[lindex] * 100, rmutMMThousandths);
          p.ScreenPageHeight := RMToScreenPixels(PaperHeights[lindex] * 100, rmutMMThousandths);
        end
        else
        begin
          p.ScreenPageWidth := RMToScreenPixels(PaperHeights[lindex] * 100, rmutMMThousandths);
          p.ScreenPageHeight := RMToScreenPixels(PaperWidths[lindex] * 100, rmutMMThousandths);
        end;
      end;
    end
    else
    begin
      p.PrinterPageWidth := FPaperWidth;
      p.PrinterPageHeight := FPaperHeight;
      p.ScreenPageWidth := RMToScreenPixels(PaperWidth * 100, rmutMMThousandths);
      p.ScreenPageHeight := RMToScreenPixels(PaperHeight * 100, rmutMMThousandths);
      p.PrinterPageWidth := Round(PaperWidth * FPixelsPerInch.X * RMInchPerMM / 10);
      p.PrinterPageHeight := Round(PaperHeight * FPixelsPerInch.Y * RMInchPerMM / 10);

      p.PrinterOffsetX := PageGutters.Left;
      p.PrinterOffsetY := PageGutters.Top;
    end;

    FFactorX := p.PrinterPageWidth / p.ScreenPageWidth;
    FFactorY := p.PrinterPageHeight / p.ScreenPageHeight;
  finally
    FLock.Release;
  end;
end;

procedure TRMPrinter.GetSettings;
var
  lDevMode: THandle;
  lPDevMode: PDeviceMode;
begin
  FLock.Acquire;
  try
    GetDevMode(lDevMode);
    if lDevMode = 0 then
    begin
      DefaultPaper := DMPAPER_A4;
      FDefaultPaperWidth := PaperWidth;
      FDefaultPaperHeight := PaperHeight;
      FDefaultPaperOr := rmpoPortrait;
      Exit;
    end;

    lPDevMode := GlobalLock(lDevMode);
    if lPDevMode = nil then Exit;
    try
      try
        PaperSize := lPDevMode^.dmPaperSize;
        Bin := lPDevMode^.dmDefaultSource;
        if lPDevMode^.dmOrientation = DMORIENT_PORTRAIT then
          Orientation := rmpoPortrait
        else
          Orientation := rmpoLandscape;

        GlobalUnlock(lDevMode);
      except
        GlobalUnlock(lDevMode);
      end;

      DefaultPaper := PaperSize;
      GetDC;
      if FDC <> 0 then
      begin
        FDefaultPaperWidth := Round(FPaperWidth * 254 / FPixelsPerInch.X);
        FDefaultPaperHeight := Round(FPaperHeight * 254 / FPixelsPerInch.Y);
	      FDefaultPaperOr := Orientation;
      end;
    finally
      GlobalFree(lDevMode);
    end;
  finally
    FLock.Release;
  end;
end;

procedure TRMPrinter.SetSettings(aPgWidth, aPgHeight: Integer);
var
  lRect: TRect;
  lPoint: TPoint;
  lDevMode: THandle;
  lPDevMode: PDeviceMode;
  lIndex, lPaperWidth, lPaperHeight: Integer;
begin
  FLock.Acquire;
  try
    if PaperSize = PrinterInfo.PaperSizes[PrinterInfo.PaperSizesCount - 1] then
    begin
      lIndex := PrinterInfo.PaperSizesCount - 1;
      if Orientation = rmpoPortrait then
      begin
        PrinterInfo.PaperWidths[lIndex] := aPgWidth;
        PrinterInfo.PaperHeights[lIndex] := aPgHeight;
      end
      else
      begin
        PrinterInfo.PaperWidths[lIndex] := aPgHeight;
        PrinterInfo.PaperHeights[lIndex] := aPgWidth;
      end;

      if (FPrinterIndex = 1) or (RMPrinters.Count = 2) then // 虚拟打印机
        Exit;
    end;

    GetDevMode(lDevMode);
    lPDevMode := GlobalLock(lDevMode);
    if lPDevMode = nil then Exit;

    lPaperWidth := 0; lPaperHeight := 0;
    lIndex := PrinterInfo.GetPaperSizeIndex(PaperSize);
    if lIndex >= PrinterInfo.AddInPaperSizeIndex then
    begin
      with PrinterInfo do
      begin
        if lIndex = PaperSizesCount - 1 then
        begin
          lPaperWidth := aPgWidth;
          lPaperHeight := aPgHeight;
        end
        else
        begin
          if Orientation = rmpoPortrait then //竖放
          begin
            lPaperWidth := PaperWidths[lIndex];
            lPaperHeight := PaperHeights[lIndex];
          end
          else
          begin
            lPaperWidth := PaperHeights[lIndex];
            lPaperHeight := PaperWidths[lIndex];
          end;
        end;
      end;
    end;

    try
      if (Win32Platform = VER_PLATFORM_WIN32_NT) and (lIndex >= PrinterInfo.AddInPaperSizeIndex) then // WinNT,自定义纸张
      begin
        if Orientation = rmpoPortrait then //竖放
        begin
          lPoint.X := lPaperWidth * 100;
          lPoint.Y := lPaperHeight * 100;
        end
        else
        begin
          lPoint.X := lPaperHeight * 100;
          lPoint.Y := lPaperWidth * 100;
        end;
        lRect := Rect(0, 0, lPoint.X, lPoint.Y);

        UpdateForm('Custom', lPoint, lRect);
        //lPDevMode^.dmFields := DM_FORMNAME;
        lPDevMode^.dmFormName := 'Custom';
      end;

      FTruePaperWidth := aPgWidth;
      FTruePaperHeight := aPgHeight;
      lPDevMode^.dmFields := DM_COPIES or DM_DUPLEX or DM_ORIENTATION or DM_PAPERSIZE or
        DM_COLOR;

      lPDevMode^.dmPaperSize := PaperSize; //纸张类型
      if lIndex >= PrinterInfo.AddInPaperSizeIndex then
      begin
        lPDevMode^.dmFields := lpDevMode^.dmFields or DM_PAPERLENGTH or DM_PAPERWIDTH;
//        if Win32Platform = VER_PLATFORM_WIN32_NT then
//          lpDevMode^.dmPaperSize := 512
//        else
//          lpDevMode^.dmPaperSize := PrinterInfo.CustomPaperSize;

        //lpDevMode^.dmPaperSize := 256;    // 2005.9.5  whf，可能有问题
        if Orientation = rmpoPortrait then //竖放
        begin
          lPDevMode^.dmPaperWidth := lPaperWidth;
          lPDevMode^.dmPaperLength := lPaperHeight;
        end
        else
        begin
          lPDevMode^.dmPaperWidth := lPaperHeight;
          lPDevMode^.dmPaperLength := lPaperWidth;
        end;
      end
      else
        lPDevMode^.dmFields := lPDevMode^.dmFields and not (DM_PAPERLENGTH or DM_PAPERWIDTH);

      lPDevMode^.dmDuplex := 1;
      if Orientation = rmpoPortrait then
        lPDevMode^.dmOrientation := DMORIENT_PORTRAIT
      else
        lPDevMode^.dmOrientation := DMORIENT_LANDSCAPE;
      if FCopies < 1 then
        lPDevMode^.dmCopies := 1
      else
        lPDevMode^.dmCopies := FCopies;
      if PrinterInfo.FBins.IndexOf(IntToStr(Bin)) >= 0 then //进纸方式
      begin
        if (Bin and $FFFF) <> $FFFF then
          lPDevMode^.dmDefaultSource := Bin
        else // 默认进纸方式
          lPDevMode^.dmDefaultSource := FDefaultBin;
        lPDevMode^.dmFields := lPDevMode^.dmFields or DM_DEFAULTSOURCE;
      end;

      if FColorPrint then // 彩色打印
        lPDevMode^.dmColor := DMCOLOR_COLOR
      else
        lPDevMode^.dmColor := DMCOLOR_MONOCHROME;
      case FDuplex of
        rmdpNone: lPDevMode^.dmDuplex := DMDUP_SIMPLEX;
        rmdpHorizontal: lPDevMode^.dmDuplex := DMDUP_HORIZONTAL;
        rmdpVertical: lPDevMode^.dmDuplex := DMDUP_VERTICAL;
      end;
    finally
      GlobalUnlock(lDevMode);
      SetDevMode(lDevMode);
      GlobalFree(lDevMode);
    end;
  finally
    FLock.Release;
  end;
end;

function TRMPrinter.IsEqual(apgSize, apgWidth, apgHeight, apgBin: Integer; apgOr: TRMPrinterOrientation;
  aDuplex: TRMDuplex): Boolean;
begin
  Result := (PaperSize = apgSize) and (Orientation = apgOr) and
    ((Bin = apgBin) or ((apgBin and $FFFF) = $FFFF)) and
    (abs(PaperWidth - apgWidth) <= 3) and (abs(PaperHeight - apgHeight) <= 3) and
    (Duplex = aDuplex);
end;

procedure TRMPrinter.SetPrinterInfo(aPageSize, aPageWidth, aPageHeight, aPageBin: Integer;
  aPageOrientation: TRMPrinterOrientation; aSetImmediately: Boolean);
var
  lIndex: Integer;
  lPrinterInfo: TRMPrinterInfo;

  procedure _SetpgSize;
  var
    lOldWidth, lOldHeight, lIndex: Integer;
  begin
    lIndex := lPrinterInfo.GetPaperSizeIndex(aPageSize);
    if lIndex >= lPrinterInfo.AddInPaperSizeIndex then  // 不是自定义纸张
    begin
      aPageSize := lPrinterInfo.PaperSizes[lIndex];
      Exit;
    end;

    if aPageOrientation = rmpoPortrait then //竖放
    begin
      lOldWidth := lPrinterInfo.PaperWidths[lIndex];
      lOldHeight := lPrinterInfo.PaperHeights[lIndex];
    end
    else
    begin
      lOldWidth := lPrinterInfo.PaperHeights[lIndex];
      lOldHeight := lPrinterInfo.PaperWidths[lIndex];
    end;

    if (abs(aPageWidth - lOldWidth) > 1) or (abs(aPageHeight - lOldHeight) > 1) then
    begin
      aPageSize := lPrinterInfo.PaperSizes[lPrinterInfo.PaperSizesCount - 1];
    end;
  end;

begin
	if Printing then Exit;

  FLock.Acquire;
  try
    lPrinterInfo := PrinterInfo;
//    if aPageSize = 256 then
//      aPageSize := PrinterInfo.CustomPaperSize;

    if (aPageWidth = 0) or (aPageHeight = 0) then // 可能是用代码设置页面信息
    begin
      lIndex := lPrinterInfo.GetPaperSizeIndex(aPageSize);
      if lIndex < lPrinterInfo.AddInPaperSizeIndex then
      begin
        if aPageOrientation = rmpoPortrait then //竖放
        begin
          aPageWidth := lPrinterInfo.PaperWidths[lIndex];
          aPageHeight := lPrinterInfo.PaperHeights[lIndex];
        end
        else
        begin
          aPageWidth := lPrinterInfo.PaperHeights[lIndex];
          aPageHeight := lPrinterInfo.PaperWidths[lIndex];
        end;
      end;
    end;

    if not aSetImmediately then
    begin
      if IsEqual(aPageSize, aPageWidth, aPageHeight, aPageBin, aPageOrientation, Duplex) then
        Exit;
    end;

    _SetpgSize; // 如果是自定义的大小，需要判断是否与旧的格式一样
    PaperSize := aPageSize;
    Orientation := aPageOrientation;
    Bin := aPageBin;
    SetSettings(aPageWidth, aPageHeight);
  finally
    FLock.Release;
  end;
end;

function TRMPrinter.PropertiesDlg: Boolean;
var
  lDevMode: THandle;
  lPDevMode: PDeviceMode;
  lForm: TForm;
  lResult: Boolean;
begin
  FLock.Acquire;
  try
    GetDevMode(lDevMode);
    Result := False;
    lResult := FALSE;
    try
      lPDevMode := GlobalLock(lDevMode);
      lForm := Screen.ActiveForm;
      if (lPDevMode <> nil) and (lForm <> nil) then
        lResult := (Winspool.DocumentProperties(lForm.Handle, PrinterHandle, PrinterInfo.Device, lPDevMode^, lPDevMode^, DM_IN_BUFFER or DM_IN_PROMPT or DM_OUT_BUFFER) > 0);

      if lResult then
      begin
        SetDevMode(lDevMode);
        Result := True;
      end;

      GlobalUnlock(lDevMode);
    finally
      GlobalFree(lDevMode);
    end;
  finally
    FLock.Release;
  end;
end;

procedure TRMPrinter.Update;
begin
  FLock.Acquire;
  try
//  GetSettings;
  finally
    FLock.Release;
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMPageSetting }

procedure TRMPageSetting.SetValue(Index: integer; Value: Double);
begin
  case Index of
    0: if Value >= 0 then
        FMarginLeft := Value;
    1: if Value >= 0 then
        FMarginTop := Value;
    2: if Value >= 0 then
        FMarginRight := Value;
    3: if Value >= 0 then
        FMarginBottom := Value;
    4: if Value >= 0 then
        FColGap := Value;
  end;
end;

procedure TRMPageSetting.SetColCount(Value: Integer);
begin
  if Value > 0 then
    FColCount := Value;
end;

procedure TRMPageSetting.SetPageOr(Value: TRMPrinterOrientation);
var
  liSavePageWidth: Integer;
begin
  if FPageOr = Value then
    Exit;
  FPageOr := Value;
  liSavePageWidth := FPageWidth;
  FPageWidth := FPageHeight;
  FPageHeight := liSavePageWidth;
end;


{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
var
  FSaveOnAfterInitEvent: TRMRMOnAfterInit;

procedure Init;
var
  i: Integer;
begin
  for i := 0 to PAPERCOUNT - 1 do
    RMDefaultPaperInfo[i].Name := RMLoadStr(SPaper1 + i);
end;

procedure OnAfterInitEvent(aFirstTime: Boolean);
begin
  Init;
  if Assigned(FSaveOnAfterInitEvent) then FSaveOnAfterInitEvent(aFirstTime);
end;

initialization
//  rmThreadDone := True;
  Init;
  FSaveOnAfterInitEvent := RMResourceManager.OnAfterInit;
  RMResourceManager.OnAfterInit := OnAfterInitEvent;

finalization
  FreeAndNil(FRMPrinter);
  FreeAndNil(FRMPrinters);

end.