rm_prntr.pas

进销存管理 编译环境Delphi7+Win2000 用到的控件 ReportMachine2.6 InfoPower4000Pro_vcl7 RxLib2.7 SkinEngine 3

        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;

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

begin
  GetDC;
  if (RMPrinters.Count = 2) or (FPrinterIndex = 1) then
  begin
    Result := _GetDefaultValue;
  end
  else
  begin
    if (FPixelsPerInch.X > 0) and (FPaperWidth > 0) then
    begin
      Result := Round(FPaperWidth * 254 / FPixelsPerInch.X);
      if Abs(Result - FTruePaperWidth) <= 1 then
        Result := FTruePaperWidth;
    end
    else
      Result := _GetDefaultValue;
  end;
end;

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

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

begin
  GetDC;
  if (RMPrinters.Count = 2) or (FPrinterIndex = 1) then
  begin
    Result := _GetDefaultValue;
  end
  else
  begin
    if (FPixelsPerInch.Y > 0) and (FPaperHeight > 0) then
    begin
      Result := Round(FPaperHeight * 254 / FPixelsPerInch.Y);
      if Abs(Result - FTruePaperHeight) <= 1 then
        Result := FTruePaperHeight;
    end
    else
      Result := _GetDefaultValue;
  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.FillPrnInfo(var p: TRMPrnInfo);
var
  kx, ky: Double;
  lindex: Integer;
begin
  kx := 93 / 1.022;
  ky := 93 / 1.015;
  if (FPrinterIndex = 1) or (RMPrinters.Count = 2) 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));
      end
      else
      begin
        Pgw := Round(RMConvertToPixels(PaperHeights[lindex], rmsuMM));
        Pgh := Round(RMConvertToPixels(PaperWidths[lindex], rmsuMM));
      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 / 10, rmsuMM));
      Pgh := Round(RMConvertToPixels(PaperHeight / 10, rmsuMM));
    end;
  end;
end;

procedure TRMPrinter.GetSettings;
var
  lDevMode: THandle;
  lPDevMode: PDeviceMode;
begin
  GetDevMode(lDevMode);
  if lDevMode = 0 then Exit;
  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);
    end;
  finally
    GlobalFree(lDevMode);
  end;
end;

procedure TRMPrinter.SetSettings(aPgWidth, aPgHeight: Integer);
var
  lRect: TRect;
  lPoint: TPoint;
  lDevMode: THandle;
  lPDevMode: PDeviceMode;
  lindex, lPaperWidth, lPaperHeight: Integer;
begin
  if (FPrinterIndex = 1) or (RMPrinters.Count = 2) then // 虚拟打印机
  begin
    if PaperSize = 256 then
    begin
      lindex := PrinterInfo.PaperSizesCount - 1;
      if Orientation = poPortrait then
      begin
        PrinterInfo.PaperWidths[lindex] := aPgWidth;
        PrinterInfo.PaperHeights[lindex] := aPgHeight;
      end
      else
      begin
        PrinterInfo.PaperWidths[lindex] := aPgHeight;
        PrinterInfo.PaperHeights[lindex] := aPgWidth;
      end;
    end;
    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 = 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;

    FTruePaperWidth := aPgWidth;
    FTruePaperHeight := aPgHeight;
    lPDevMode^.dmFields := lPDevMode^.dmFields or DM_COPIES or DM_ORIENTATION or DM_PAPERSIZE or DM_DUPLEX;
    lPDevMode^.dmPaperSize := PaperSize; //纸张类型
    if lindex >= PrinterInfo.AddInPaperSizeIndex then
    begin
      lPDevMode^.dmFields := lpDevMode^.dmFields or DM_PAPERLENGTH or DM_PAPERWIDTH;
      lpDevMode^.dmPaperSize := PrinterInfo.FCustomPageSize; //256;
      if Orientation = poPortrait 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 = 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
  begin
    Result := (pgSize = PaperSize) and (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.