rm_printer.pas

这是一个功能强大

    FLock.Release;
  end;
end;

function TRMCustomPrinter.GetDocumentProperties: THandle;
var
  lStubDevMode: TDeviceMode;
  lPrinterInfo: TRMPrinterInfo;
begin
  FLock.Acquire;
  try
    Result := 0;
    if FDevMode = 0 then
    begin
      lPrinterInfo := RMPrinters.PrinterInfo[FPrinterIndex];
      if lPrinterInfo = nil then
        Exit;
      FDevMode := GlobalAlloc(GHND,
        DocumentProperties(0, PrinterHandle, lPrinterInfo.Device, lStubDevMode, lStubDevMode, 0));
      if FDevMode <> 0 then
      begin
        FPDevMode := GlobalLock(FDevMode);
        if DocumentProperties(0, PrinterHandle, lPrinterInfo.Device, FPDevMode^, FPDevMode^, DM_OUT_BUFFER) >= 0 then
        begin
          FDefaultBin := FPDevMode^.dmDefaultSource;
        end
        else
          FreeDevMode;
      end;
    end;
    Result := FDevMode;
  finally
    FLock.Release;
  end;
end;

function TRMCustomPrinter.GetPDevMode: PDevMode;
begin
  FLock.Acquire;
  try
    GetDocumentProperties;
    Result := FPDevMode;
  finally
    FLock.Release;
  end;
end;

function TRMCustomPrinter.GetDC: HDC;
var
  lPrinterInfo: TRMPrinterInfo;
begin
  FLock.Acquire;
  try
    if FDC = 0 then
    begin
      lPrinterInfo := RMPrinters.PrinterInfo[FPrinterIndex];
      if (lPrinterInfo <> nil) and lPrinterInfo.IsValid then
      begin
        if FPrinting then
          FDC := CreateDC(lPrinterInfo.Driver, lPrinterInfo.Device, lPrinterInfo.Port, GetPDevMode)
        else
          FDC := CreateIC(lPrinterInfo.Driver, lPrinterInfo.Device, lPrinterInfo.Port, GetPDevMode);

        if FDC = 0 then
          lPrinterInfo.IsValid := False
        else
          lPrinterInfo.IsValid := True;

        if FCanvas <> nil then
          FCanvas.Handle := FDC;

        DeviceContextChanged;
      end;
    end;
    Result := FDC;
  finally
    FLock.Release;
  end;
end;

function TRMCustomPrinter.GetPrinterInfo: TRMPrinterInfo;
begin
  FLock.Acquire;
  try
    Result := RMPrinters.PrinterInfo[FPrinterIndex]
  finally
    FLock.Release;
  end;
end;

procedure TRMCustomPrinter.FreeDC;
begin
  if FDC = 0 then Exit;

  if FCanvas <> nil then
    FCanvas.Handle := 0;
  DeleteDC(FDC);
  FDC := 0;
end;

procedure TRMCustomPrinter.FreeDevMode;
begin
  if FDevMode = 0 then Exit;

  GlobalUnlock(FDevMode);
  GlobalFree(FDevMode);
  FDevMode := 0;
  FPDevMode := nil;
end;

procedure TRMCustomPrinter.FreePrinterHandle;
begin
  if FPrinterHandle <> 0 then
  begin
    ClosePrinter(FPrinterHandle);
    FPrinterHandle := 0;
    FCurrentInfo := nil;
  end;
end;

procedure TRMCustomPrinter.FreePrinterResources;
begin
  if FPrinting then Exit;

  FreeDC;
  FreeDevMode;
  FreePrinterHandle;
end;

function TRMCustomPrinter.GetCanvas: TCanvas;
begin
  FLock.Acquire;
  try
    if FCanvas = nil then
      FCanvas := TRMPrinterCanvas.Create(Self);
    Result := FCanvas;
  finally
    FLock.Release;
  end;
end;

procedure TRMCustomPrinter.SetDevMode(aDevMode: THandle);
begin
  FLock.Acquire;
  try
    if FPrinting then
      FResetDC := True
    else
      FreeDC;

    FreeDevMode;
    FDevMode := RMCopyHandle(aDevMode);
    FPDevMode := GlobalLock(FDevMode);
  finally
    FLock.Release;
  end;
end;

function TRMCustomPrinter.GetPrinterName: string;
begin
	if (FPrinterIndex >= 0) and (FPrinterIndex < RMPrinters.Count) then
		Result := RMPrinters.Printers[FPrinterIndex]
  else
  	Result := '';  
end;

procedure TRMCustomPrinter.SetPrinterIndex(Value: Integer);
var
  lPrinterInfo: TRMPrinterInfo;
  lSaveWidth, lSaveHeight: Integer;
  i, lCount: Integer;
begin
  FLock.Acquire;
  try
    if FPrinting or (Value < 0) or (FPrinterIndex = Value) then Exit;

    FreeDC;
    lPrinterInfo := RMPrinters.PrinterInfo[Value];
    if lPrinterInfo <> nil then
      FPrinterIndex := Value;

    if (lPrinterInfo = nil) or (FCurrentInfo = lPrinterInfo) then Exit;

    lSaveWidth := -1; lSaveHeight := -1;
    try
      if FCurrentInfo <> nil then
      begin
        with PrinterInfo do
        begin
          i := GetPaperSizeIndex(Self.PaperSize);
          lSaveWidth := PaperWidths[i];
          lSaveHeight := PaperHeights[i];
        end;
      end;
    except
    end;

    if FCurrentInfo <> nil then
      FreePrinterResources;

    FCurrentInfo := lPrinterInfo;
    if (lSaveWidth > 0) and (lSaveHeight > 0) then
    begin
      i := 0; lCount := FCurrentInfo.PaperSizesCount;
      with FCurrentInfo do
      begin
        while i < lCount do
        begin
          try
            if (abs(PaperWidths[i] - lSaveWidth) <= 1) and
            	(abs(PaperHeights[i] - lSaveHeight) <= 1) then
              Break;
          except
          end;

          Inc(i);
        end;
        if i < lCount then
          Self.PaperSize := StrToInt(FPaperSizes[i])
        else
          Self.PaperSize := 256;
      end;
    end;
  finally
    FLock.Release;
  end;
end;

function TRMCustomPrinter.HasColor: Boolean;
begin
  FLock.Acquire;
  try
    Result := (GetDeviceCaps(GetDC, NUMCOLORS) > 2) and (GetPDevMode^.dmColor = DMCOLOR_COLOR);
  finally
    FLock.Release;
  end;
end;

const
  FormLevel: Byte = 1;

procedure TRMCustomPrinter.UpdateForm(const aFormName: string; aDimensions: TPoint; aPrintArea: TRect);
var
  lSizeOfInfo: DWord;
  lFormInfo: TFormInfo1;
  lNewFormInfo, lCurrentFormInfo: PFormInfo1;
begin
	if Win32Platform <> VER_PLATFORM_WIN32_NT then Exit;

  FLock.Acquire;
  try
    with lFormInfo do
    begin
      Flags := 0;
      pName := PChar(aFormName);
      Size.cx := aDimensions.X;
      Size.cy := aDimensions.Y;
      ImageableArea.Left := aPrintArea.Left;
      ImageableArea.Top := aPrintArea.Top;
      ImageableArea.Right := aPrintArea.Right;
      ImageableArea.Bottom := aPrintArea.Bottom;
    end;

    lNewFormInfo := @lFormInfo;
    lSizeOfInfo := 0;
    Winspool.GetForm(PrinterHandle, PChar(aFormName), FormLevel, nil, 0, lSizeOfInfo);
    GetMem(lCurrentFormInfo, lSizeOfInfo);
    try
      if Winspool.GetForm(PrinterHandle, PChar(aFormName), FormLevel, lCurrentFormInfo, lSizeOfInfo, lSizeOfInfo) then
      begin
        if (lCurrentFormInfo.Size.cX <> lNewFormInfo.Size.cX) or
          (lCurrentFormInfo.Size.cY <> lNewFormInfo.Size.cY) or
          (lCurrentFormInfo.ImageableArea.Left <> lNewFormInfo.ImageableArea.Left) or
          (lCurrentFormInfo.ImageableArea.Top <> lNewFormInfo.ImageableArea.Top) or
          (lCurrentFormInfo.ImageableArea.Right <> lNewFormInfo.ImageableArea.Right) or
          (lCurrentFormInfo.ImageableArea.Bottom <> lNewFormInfo.ImageableArea.Bottom) then
          Winspool.SetForm(PrinterHandle, PChar(aFormName), FormLevel, lNewFormInfo);
      end
      else
      begin
        Winspool.AddForm(PrinterHandle, FormLevel, lNewFormInfo);
        //PrinterInfo.FAlreadlyGetInfo := False;
        //PrinterInfo;
      end;
    finally
      FreeMem(lCurrentFormInfo, lSizeOfInfo);
    end;
  finally
    FLock.Release;
  end;
end;

procedure TRMCustomPrinter.DeviceContextChanged;
begin
  FLock.Acquire;
  try
    if FDC = 0 then Exit;

    FPixelsPerInch.X := GetDeviceCaps(FDC, LOGPIXELSX);
    FPixelsPerInch.Y := GetDeviceCaps(FDC, LOGPIXELSY);

    FPaperWidth := GetDeviceCaps(FDC, PHYSICALWIDTH); //纸宽 ，单位为打印机象素
    FPaperHeight := GetDeviceCaps(FDC, PHYSICALHEIGHT);

    FPrintableWidth := GetDeviceCaps(FDC, HorzRes); //可打印纸宽 ，单位为打印机象素
    FPrintableHeight := GetDeviceCaps(FDC, VertRes);

    FPageGutters.Left := GetDeviceCaps(FDC, PHYSICALOFFSETX); //偏移量
    FPageGutters.Top := GetDeviceCaps(FDC, PHYSICALOFFSETY);

    FPageGutters.Right := FPaperWidth - FPageGutters.Left - FPrintableWidth;
    FPageGutters.Bottom := FPaperHeight - FPageGutters.Top - FPrintableHeight;

    FCanGrayScale := True;
    if (Win32Platform = VER_PLATFORM_WIN32_NT) and (GetDeviceCaps(FDC, SIZEPALETTE) = 2) and
      (GetDeviceCaps(FDC, NUMCOLORS) = 2) then
      FCanGrayScale := False;
  finally
    FLock.Release;
  end;
end;

function TRMCustomPrinter.GetCanGrayScale: Boolean;
begin
  FLock.Acquire;
  try
    GetDC;
    Result := FCanGrayScale;
  finally
    FLock.Release;
  end;
end;

function TRMCustomPrinter.GetPaperWidth: Longint;
var
  lindex: Integer;

  function _GetDefaultValue: Longint;
  var
    i: Integer;
  begin
    with PrinterInfo do
    begin
      lindex := GetPaperSizeIndex(PaperSize);
      if Orientation = rmpoPortrait then
        Result := PaperWidths[lindex]
      else
        Result := PaperHeights[lindex];
    end;

    if Result = 0 then
    begin
      for i := Low(RMDefaultPaperInfo) to High(RMDefaultPaperInfo) do
      begin
        if RMDefaultPaperInfo[i].Typ = PaperSize then
        begin
          if Orientation = rmpoPortrait then
            Result := RMDefaultPaperInfo[i].X
          else
            Result := RMDefaultPaperInfo[i].Y;
          Break;
        end;
      end;
    end;

    if (Result = 0) and (lIndex = PrinterInfo.FPaperSizes.Count - 1) then
    begin
      Result := FDefaultPaperWidth;
    end;
  end;

begin
  FLock.Acquire;
  try
    GetDC;
    Result := _GetDefaultValue;
  finally
    FLock.Release;
  end;
end;

function TRMCustomPrinter.GetPaperHeight: Longint;
var
  lindex: Integer;

  function _GetDefaultValue: Longint;
  var
    i: Integer;
  begin
    with PrinterInfo do
    begin
      lindex := GetPaperSizeIndex(PaperSize);
      if Orientation = rmpoPortrait then
        Result := PaperHeights[lindex]
      else
        Result := PaperWidths[lindex];
    end;

    if Result = 0 then
    begin
      for i := Low(RMDefaultPaperInfo) to High(RMDefaultPaperInfo) do
      begin
        if RMDefaultPaperInfo[i].Typ = PaperSize then
        begin
          if Orientation = rmpoPortrait then
            Result := RMDefaultPaperInfo[i].Y
          else
            Result := RMDefaultPaperInfo[i].X;
          Break;
        end;
      end;
    end;

    if (Result = 0) and (lIndex = PrinterInfo.FPaperSizes.Count - 1) then
    begin
      Result := FDefaultPaperHeight;
    end;
  end;

begin
  FLock.Acquire;
  try
    GetDC;
    Result := _GetDefaultValue;
  finally
    FLock.Release;
  end;
end;

function TRMCustomPrinter.GetPageGutters: TRect;
begin
  FLock.Acquire;
  try
    GetDC;
    if FDC <> 0 then
      Result := FPageGutters
    else
      Result := Rect(0, 0, 0, 0);
  finally
    FLock.Release;
  end;
end;

function TRMCustomPrinter.GetPixelsPerInch: TPoint;
begin
  FLock.Acquire;
  try
    GetDC;
    if FDC <> 0 then
      Result := FPixelsPerInch
    else
      Result := Point(Screen.PixelsPerInch, Screen.PixelsPerInch);
  finally
    FLock.Release;
  end;
end;

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