rm_prntr.pas

report machine 2.3 功能强大

end;

const
  FormLevel: Byte = 1;

procedure TRMCustomPrinter.UpdateForm(const aFormName: string; aDimensions: TPoint; aPrintArea: TRect);
var
  liSizeOfInfo: DWord;
  lFormInfo: TFormInfo1;
  lpNewFormInfo, lpCurrentFormInfo: PFormInfo1;
begin
  if Win32Platform <> VER_PLATFORM_WIN32_NT then Exit;
  with lFormInfo do
  begin
    Flags := 0; {indicates form is not built-in}
    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;

  lpNewFormInfo := @lFormInfo;
  liSizeOfInfo := 0;
  Winspool.GetForm(PrinterHandle, PChar(aFormName), FormLevel, nil, 0, liSizeOfInfo);
  GetMem(lpCurrentFormInfo, liSizeOfInfo);
  try
    if Winspool.GetForm(PrinterHandle, PChar(aFormName), FormLevel, lpCurrentFormInfo, liSizeOfInfo, liSizeOfInfo) then
    begin
      if (lpCurrentFormInfo.Size.cX <> lpNewFormInfo.Size.cX) or
        (lpCurrentFormInfo.Size.cY <> lpNewFormInfo.Size.cY) or
        (lpCurrentFormInfo.ImageableArea.Left <> lpNewFormInfo.ImageableArea.Left) or
        (lpCurrentFormInfo.ImageableArea.Top <> lpNewFormInfo.ImageableArea.Top) or
        (lpCurrentFormInfo.ImageableArea.Right <> lpNewFormInfo.ImageableArea.Right) or
        (lpCurrentFormInfo.ImageableArea.Bottom <> lpNewFormInfo.ImageableArea.Bottom) then
        Winspool.SetForm(PrinterHandle, PChar(aFormName), FormLevel, lpNewFormInfo);
    end
    else
      Winspool.AddForm(PrinterHandle, FormLevel, lpNewFormInfo);
  finally
    FreeMem(lpCurrentFormInfo, liSizeOfInfo);
  end;
end;

procedure TRMCustomPrinter.DeviceContextChanged;
var
  lPrintableSize, lOffSet: TPoint;
begin
  if FDC = 0 then Exit;
  FPixelsPerInch.X := GetDeviceCaps(FDC, LOGPIXELSX);
  FPixelsPerInch.Y := GetDeviceCaps(FDC, LOGPIXELSY);

  FPaperWidth := GetDeviceCaps(FDC, PHYSICALWIDTH);
  FPaperHeight := GetDeviceCaps(FDC, PHYSICALHEIGHT);

  lPrintableSize.X := GetDeviceCaps(FDC, HorzRes);
  lPrintableSize.Y := GetDeviceCaps(FDC, VertRes);

  lOffSet.X := GetDeviceCaps(FDC, PHYSICALOFFSETX);
  lOffSet.Y := GetDeviceCaps(FDC, PHYSICALOFFSETY);

  FPrintableWidth := lPrintableSize.X;
  FPrintableHeight := lPrintableSize.Y;

  FPageGutters.Left := lOffSet.X;
  FPageGutters.Top := lOffSet.Y;
  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;
end;

function TRMCustomPrinter.GetCanGrayScale: Boolean;
begin
  GetDC;
  Result := FCanGrayScale;
end;

function TRMCustomPrinter.GetPaperWidth: Longint;
var
  lindex: Integer;
begin
  GetDC;
  if (FPrinterIndex = 0) and (RMPrinters.FDefaultPrinterIndex < 0) then
  begin
    with PrinterInfo do
    begin
      lindex := GetPaperSizeIndex(PaperSize);
      if Orientation = poPortrait then
        Result := PaperWidths[lindex]
      else
        Result := PaperHeights[lindex];
    end;
  end
  else
  begin
    if FPixelsPerInch.X > 0 then
      Result := Round(FPaperWidth * 254 / FPixelsPerInch.X)
    else
      Result := 0;
  end;
end;

function TRMCustomPrinter.GetPaperHeight: Longint;
var
  lindex: Integer;
begin
  GetDC;
  if (FPrinterIndex = 0) and (RMPrinters.FDefaultPrinterIndex < 0) then
  begin
    with PrinterInfo do
    begin
      lindex := GetPaperSizeIndex(PaperSize);
      if Orientation = poPortrait then
        Result := PaperHeights[lindex]
      else
        Result := PaperWidths[lindex];
    end;
  end
  else
  begin
    if FPixelsPerInch.Y > 0 then
      Result := Round(FPaperHeight * 254 / FPixelsPerInch.Y)
    else
      Result := 0;
  end;
end;

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

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

function TRMCustomPrinter.GetPrintableHeight: LongInt;
begin
  GetDC;
  Result := FPrintableHeight;
end;

function TRMCustomPrinter.GetPrintableWidth: LongInt;
begin
  GetDC;
  Result := FPrintableWidth;
end;

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

constructor TRMPrinter.Create;
var
  i: Integer;
begin
  inherited Create;
  FCopies := 1;
  PaperSize := 9;
  for i := 0 to PAPERCOUNT - 1 do
    PaperInfo[i].Name := RMLoadStr(SPaper1 + i);
end;

destructor TRMPrinter.Destroy;
begin
  inherited Destroy;
end;

procedure TRMPrinter.GetSettings;
var
  lDevMode: THandle;
  lPDevMode: PDeviceMode;
begin
  GetDevMode(lDevMode);
  lPDevMode := GlobalLock(lDevMode);
  if (lPDevMode = nil) then Exit;
  try
    try
      PaperSize := lPDevMode^.dmPaperSize;
      Bin := lPDevMode^.dmDefaultSource;
      if lPDevMode^.dmOrientation = DMORIENT_PORTRAIT then
        Orientation := poPortrait
      else
        Orientation := poLandscape;
      GlobalUnlock(lDevMode);
    except
      GlobalUnlock(lDevMode);
//      PrinterIndex := FDefaultPrinter;
    end;
  finally
    GlobalFree(lDevMode);
  end;
end;

procedure TRMPrinter.FillPrnInfo(var p: TRMPrnInfo);
var
  kx, ky: Double;
  lindex: Integer;
begin
  kx := 93 / 1.022;
  ky := 93 / 1.015;
  if (FPrinterIndex = 0) and (RMPrinters.FDefaultPrinterIndex < 0) then
  begin
    with p, PrinterInfo do
    begin
      lindex := GetPaperSizeIndex(PaperSize);
      if Orientation = poPortrait then
      begin
        Pgw := Round(RMConvertToPixels(PaperWidths[lindex], rmsuMM));
        Pgh := Round(RMConvertToPixels(PaperHeights[lindex], rmsuMM));
//        Pgw := Round(PaperWidths[lindex] * kx / 254);
//        Pgh := Round(PaperHeights[lindex] * ky / 254);
      end
      else
      begin
        Pgw := Round(RMConvertToPixels(PaperHeights[lindex], rmsuMM));
        Pgh := Round(RMConvertToPixels(PaperWidths[lindex], rmsuMM));
//        Pgw := Round(PaperHeights[lindex] * kx / 254);
//        Pgh := Round(PaperWidths[lindex] * ky / 254);
      end;
      Ofx := Round(50 * kx / 254);
      Ofy := Round(50 * ky / 254);
      Pw := Pgw - Ofx * 2;
      Ph := Pgh - Ofy * 2;
    end;
  end
  else
  begin
    with p do
    begin
      if PixelsPerInch.X > 0 then kx := kx / PixelsPerInch.X;
      if PixelsPerInch.Y > 0 then ky := ky / PixelsPerInch.Y;
      PPgw := FPaperWidth; Pgw := Round(PPgw * kx);
      PPgh := FPaperHeight; Pgh := Round(PPgh * ky);
      POfx := PageGutters.Left; Ofx := Round(POfx * kx);
      POfy := PageGutters.Top; Ofy := Round(POfy * ky);
      PPw := PrintableWidth; Pw := Round(PPw * kx);
      PPh := PrintableHeight; Ph := Round(PPh * ky);
      Pgw := Round(RMConvertToPixels(PaperWidth, rmsuMM));
      Pgh := Round(RMConvertToPixels(PaperHeight, rmsuMM));
    end;
  end;
end;

procedure TRMPrinter.SetSettings(aPgWidth, aPgHeight: Integer);
var
  lRect: TRect;
  lPoint: TPoint;
  lDevMode: THandle;
  lPDevMode: PDeviceMode;
  lindex, lPaperWidth, lPaperHeight: Integer;
begin
  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 = poPortrait 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
    begin
      if Orientation = poPortrait 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);
      StrPCopy(lPDevMode^.dmFormName, 'Custom');
    end;

    lPDevMode^.dmFields := lPDevMode^.dmFields or DM_COPIES or DM_ORIENTATION or DM_PAPERSIZE;
    lPDevMode^.dmPaperSize := PaperSize; //纸张类型
    if lindex >= PrinterInfo.AddInPaperSizeIndex then
    begin
      lpDevMode^.dmPaperSize := PrinterInfo.FCustomPageSize; //256;
      lPDevMode^.dmFields := lpDevMode^.dmFields or DM_PAPERLENGTH or DM_PAPERWIDTH;
      if Orientation = poPortrait then //竖放
      begin
        lPDevMode^.dmPaperWidth := lPaperWidth;
        lPDevMode^.dmPaperLength := lPaperHeight;
      end
      else
      begin
        lPDevMode^.dmPaperWidth := lPaperHeight;
        lPDevMode^.dmPaperLength := lPaperWidth;
      end;
    end;

    if Orientation = poPortrait 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;
  finally
    GlobalUnlock(lDevMode);
    SetDevMode(lDevMode);
    GlobalFree(lDevMode);
  end;
//  GetSettings;
end;

function TRMPrinter.IsEqual(pgSize, pgWidth, pgHeight, pgBin: Integer;
  pgOr: TPrinterOrientation): Boolean;
begin
  if (PaperSize = pgSize) and (pgSize > 68) then //(pgSize >= DMPAPER_USER) then
  begin
    Result := (Orientation = pgOr) and ((Bin = pgBin) or ((pgBin and $FFFF) = $FFFF)) and
      (abs(PaperWidth - pgWidth) <= 1) and (abs(PaperHeight - pgHeight) <= 1);
  end
  else
    Result := (PaperSize = pgSize) and (Orientation = pgOr) and
      ((Bin = pgBin) or ((pgBin and $FFFF) = $FFFF));
end;

procedure TRMPrinter.SetPrinterInfo(pgSize, pgWidth, pgHeight, pgBin: Integer;
  pgOr: TPrinterOrientation; SetImmediately: Boolean);
begin
  if Printing then Exit;
  if pgSize = 256 then pgSize := PrinterInfo.CustomPaperSize;
  if not SetImmediately then
  begin
    if IsEqual(pgSize, pgWidth, pgHeight, pgBin, pgOr) then Exit;
  end;
  PaperSize := pgSize;
  Orientation := pgOr;
  Bin := pgBin;
  SetSettings(pgWidth, pgHeight);
end;

procedure TRMPrinter.PropertiesDlg;
var
  lDevMode: THandle;
  lPDevMode: PDeviceMode;
  lForm: TForm;
  lResult: Boolean;
begin
  GetDevMode(lDevMode);
  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
      SetDevMode(lDevMode);

    GlobalUnlock(lDevMode);
  finally
    GlobalFree(lDevMode);
  end;
end;

procedure TRMPrinter.Update;
begin
//  GetSettings;
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: TPrinterOrientation);
var
  liSavePageWidth: Integer;
begin
  if FPageOr = Value then Exit;
  FPageOr := Value;
  liSavePageWidth := FPageWidth;
  FPageWidth := FPageHeight;
  FPageHeight := liSavePageWidth;
end;

initialization
//  rmThreadDone := True;

finalization
  FRMPrinters.Free; FRMPrinters := nil;
  FRMPrinter.Free; FRMPrinter := nil;

end.