gmprinter.pas

GmPrintSuite 2.96.7] a

  Result := Printer.Printers.Count > 0;
end;

function TGmPrinter.GetPrinterWidth(Measurement: TGmMeasurement): Extended;
begin
  Result := ConvertValue(FPrinterInfo.PhysicalSizeY * FPrinterInfo.PpiY, gmInches, Measurement);
end;

procedure TGmPrinter.AlterOrientation;
begin
  if FPagesPerSheet = gmTwoPage then
  begin
    case FOrientation of
      gmPortrait : FOrientation := gmLandscape;
      gmLandscape: FOrientation := gmPortrait;
    end;
  end;
end;

procedure TGmPrinter.SetCollate(Value: Boolean);
begin
  with FPrinterInfo do
  begin
    if not GmOpenPrinter then Exit;
    try
      FDevMode^.dmFields := FDevMode^.dmFields or DM_COLLATE;
      case Value of
        True : FDevMode^.dmCollate := DMCOLLATE_TRUE;
        False: FDevMode^.dmCollate := DMCOLLATE_FALSE;
      end;
    finally
      GmClosePrinter;
    end;
  end;
end;

procedure TGmPrinter.SetDitherType(Value: TGmDitherType);
begin
  with FPrinterInfo do
  begin
    if not GmOpenPrinter then Exit;
    try
      FDevMode^.dmFields := FDevMode^.dmFields or DM_DITHERTYPE;
      case Value of
        gmNone      : FDevMode^.dmDitherType := DMDITHER_NONE;
        gmCourse    : FDevMode^.dmDitherType := DMDITHER_COARSE;
        gmFine      : FDevMode^.dmDitherType := DMDITHER_FINE;
        gmLineArt   : FDevMode^.dmDitherType := DMDITHER_LINEART;
        gmGrayScale : FDevMode^.dmDitherType := DMDITHER_GRAYSCALE;
      end;
    finally
      GmClosePrinter;
    end;
  end;
end;

procedure TGmPrinter.SetDrawingArea(PageNum: integer);
var
  PW, PH: integer;
  AScale: Integer;
  AOffset: TPoint;
  TopHalf,
  BottomHalf,
  LeftHalf,
  RightHalf,
  TopLeftQuater,
  TopRightQuater,
  BottomLeftQuater,
  BottomRightQuater: TRect;
  ViewportRect: TRect;
begin
  with FPrinterInfo do
  begin
    //UpdatePrinter;
    PW := Round(PhysicalSizeX * PpiX);
    PH := Round(PhysicalSizeY * PpiY);
    AOffset := GetGutters(AsGmOrientation(Printer.Orientation)).TopLeft;
  end;
  // calculate pare areas...
  TopHalf    := Rect(0, 0, PW, PH div 2);
  BottomHalf := Rect(0, PH div 2, PW, PH);
  LeftHalf   := Rect(0, 0, PW div 2, PH);
  RightHalf  := Rect(PW div 2, 0, PW, PH);
  TopLeftQuater     := Rect(0, 0, PW div 2, PH div 2);
  TopRightQuater    := Rect(PW div 2, 0, PW, PH div 2);
  BottomLeftQuater  := Rect(0, PH div 2, PW div 2, PH);
  BottomRightQuater := Rect(PW div 2, PH div 2, PW, PH);
  // initialize viewport and scaling values...
  ViewportRect := Rect(0, 0, PW, PH);
  AScale := 100;
  if FPagesPerSheet = gmTwoPage then
  begin
    if FOrientation = gmPortrait then
    begin
      case PageNum mod 2 of
        1: ViewportRect := TopHalf;
        0: ViewportRect := BottomHalf;
      end;
    end
    else
    begin
      case PageNum mod 2 of
        1: ViewportRect := LeftHalf;
        0: ViewportRect := RightHalf;
      end;
    end;
    AScale := Trunc((MinInt(PW, PH) / MaxInt(PW, PH)) * 100);
  end
  else
  if FPagesPerSheet = gmFourPage then
  begin
    case PageNum mod 4 of
      1: ViewportRect := TopLeftQuater;
      2:ViewportRect := TopRightQuater;
      3:ViewportRect := BottomLeftQuater;
      0:ViewportRect := BottomRightQuater;
    end;
    AScale := 49;
  end;
  // set the custom mapping mode...
  SetMapMode(Printer.Canvas.Handle, MM_ANISOTROPIC);
  SetWindowExtEx(Printer.Canvas.Handle, RectWidth(ViewportRect), RectHeight(ViewportRect), nil);
  SetViewportExtEx(Printer.Canvas.Handle,
                   RectWidth(ViewportRect),
                   RectHeight(ViewportRect),
                   nil);
  ScaleViewportExtEx(Printer.Canvas.Handle, AScale, 100, AScale, 100, nil);
  SetViewportOrgEx(Printer.Canvas.Handle,
                   0-AOffset.X + ViewportRect.Left,
                   0-AOffset.Y + ViewportRect.Top, nil);
end;

procedure TGmPrinter.SetDuplexType(Value: TGmDuplexType);
begin
  with FPrinterInfo do
  begin
    if not GmOpenPrinter then Exit;
    try
      if DeviceCapabilities(FDevice, FPort, DC_DUPLEX, nil, nil) = 1 then;
      begin
        case Value of
          gmSimplex   : FDevMode^.dmDuplex := DMDUP_SIMPLEX;
          gmHorzDuplex: FDevMode^.dmDuplex := DMDUP_HORIZONTAL;
          gmVertDuplex: FDevMode^.dmDuplex := DMDUP_VERTICAL;
        end;
      end;
    finally
      GmClosePrinter;
    end;
  end;
end;

procedure TGmPrinter.SetOrientation(Value: TGmOrientation);
begin
  if FOrientation = Value then Exit;
  FOrientation := Value;
  FPrinterInfo.FOrientation := FOrientation;
  FPrinterInfo.UpdatePrinter;
end;

procedure TGmPrinter.SetGmPaperSize(Value: TGmPaperSize);
begin
  with FPrinterInfo do
  begin
    if not GmOpenPrinter then Exit;
    try
      FDevMode^.dmFields := FDevMode^.dmFields or DM_PAPERSIZE;
      FDevMode^.dmPaperSize := AsDmPaperSize(Value);
    finally
      GmClosePrinter;
    end;
  end;
end;

procedure TGmPrinter.SetPrintColor(Value: TGmPrintColor);
begin
  with FPrinterInfo do
  begin
    if not GmOpenPrinter then Exit;
    try
      FDevMode^.dmFields := FDevMode^.dmFields or DM_COLOR;
      case Value of
        gmColor     : FDevMode^.dmColor := DMCOLOR_COLOR;
        gmMonochrome: FDevMode^.dmColor := DMCOLOR_MONOCHROME;
      end;
    finally
      GmClosePrinter;
    end;
  end;
end;

procedure TGmPrinter.SetPrinterBinIndex(Value: integer);
type
  BinNumArray = array[0..MAX_PATH] of Word;
var
  BinNumList: BinNumArray;
begin
  with FPrinterInfo do
  begin
    if not GmOpenPrinter then Exit;
    try
      DeviceCapabilities(FDevice, FPort, DC_BINS, @BinNumList, nil);
      FDevMode^.dmDefaultSource := BinNumList[Value];
    finally
      GmClosePrinter;
    end;
  end;
end;

procedure TGmPrinter.SetPrintCopies(Value: integer);
begin
  with FPrinterInfo do
  begin
    if not GmOpenPrinter then Exit;
    try
      FDevMode^.dmFields := FDevMode^.dmFields or DM_COPIES;
      FDevMode^.dmCopies := Value;
    finally
      GmClosePrinter;
    end;
  end;
end;

procedure TGmPrinter.SetPrinterIndex(Value: integer);
var
  FDevice, FDriver, FPort: array[0..80] of Char;
  FDeviceMode: THandle;
begin
  Printer.PrinterIndex := Value;
  Printer.GetPrinter(FDevice, FDriver, FPort, FDeviceMode);
  Printer.SetPrinter(FDevice, FDriver, FPort, 0);
  FPrinterInfo.UpdatePrinter;
  if Assigned(FOnChangePrinter) then FOnChangePrinter(Self);
end;

procedure TGmPrinter.SetPrintQuality(Value: TGmPrintQuality);
begin
  with FPrinterInfo do
  begin
    if not GmOpenPrinter then Exit;
    try
      FDevMode^.dmFields := FDevMode^.dmFields or DM_PRINTQUALITY;
      case Value of
        gmDraft : FDevMode^.dmPrintQuality := Short(DMRES_DRAFT);
        gmLow   : FDevMode^.dmPrintQuality := Short(DMRES_LOW);
        gmMedium: FDevMode^.dmPrintQuality := Short(DMRES_MEDIUM);
        gmHigh  : FDevMode^.dmPrintQuality := Short(DMRES_HIGH);
      end;
    finally
      GmClosePrinter;
    end;
  end;
  FPrinterInfo.UpdatePrinter;
end;

procedure TGmPrinter.BeginDoc(FileName: string);
var
  LastIndex: integer;
  TestCanvas: HDC;
begin
  TestCanvas := FPrinterInfo.GetPrinterAvailable;
  try
    if TestCanvas = 0 then
    begin
      ShowMessage('Unable to print... No Printer available.');
      Exit;
    end;
  finally
    DeleteDC(TestCanvas);
  end;
  if (FPrinting) or (Printer.Printers.Count = 0) then Exit;
  FPrinting := True;
  FAborted := False;
  LastIndex := PrinterIndex;
  if Assigned(FBeforePrint) then FBeforePrint(Self);
  if FAborted then Exit;
  if LastIndex <> PrinterIndex then
    SetPrinterIndex(Printer.PrinterIndex);
  AlterOrientation;
  Printer.Orientation := AsPrinterOrientation(FOrientation);
  FPrinterInfo.UpdatePrinter;
  Printer.Title := FTitle;
  Printer.BeginDoc;
  FPrintCount := 1;
  SetDrawingArea(FPrintCount);
end;

procedure TGmPrinter.NewPage;
var
  NeedNewPage: Boolean;
begin
  Inc(FPrintCount);
  NeedNewPage := False;
  case FPagesPerSheet of
    gmOnePage : NeedNewPage := True;
    gmTwoPage : NeedNewPage := ((FPrintCount-1) mod 2 = 0);
    gmFourPage: NeedNewPage := ((FPrintCount-1) mod 4 = 0);
  end;
  if NeedNewPage then
  begin
    with FPrinterInfo do
    begin
      // start a new printer page of the desired orientation...
      Printer.GetPrinter(FDevice, FDriver, FPort, FDeviceMode);
      FDevMode := GlobalLock(FDevicemode);
      try
        with FDevMode^ do
        begin
          dmFields := dmFields or DM_ORIENTATION;
          if Self.FOrientation = gmPortrait then
            dmOrientation := DMORIENT_PORTRAIT;
          if Self.FOrientation = gmLandscape then
            dmOrientation := DMORIENT_LANDSCAPE;
        end;
        Windows.EndPage(Printer.Handle);
        ResetDC(Printer.Handle, FDevMode^);
      finally
        GlobalUnlock(FDeviceMode);
        Windows.StartPage(Printer.Handle);
      end;
      Printer.Canvas.Refresh;
    end;
  end;
  SetDrawingArea(FPrintCount);
end;

procedure TGmPrinter.EndDoc;
begin
  if not FPrinting then Exit;
  Printer.EndDoc;
  FPrinting := False;
  if Assigned(FAfterPrint) then FAfterPrint(Self);
end;

procedure TGmPrinter.SetDMPaperSize(APaperSize: integer);
begin
  with FPrinterInfo do
  begin
    if not GmOpenPrinter then Exit;
    try
      with FDevMode^ do
      begin
        dmPapersize := APaperSize;
        dmFields := dmFields or DM_PAPERSIZE;
      end;
    finally
      GmClosePrinter;
    end;
  end;
  FPrinterInfo.UpdatePrinter;
end;

procedure TGmPrinter.GetPaperNames(const Papers: TStrings);
type
	TPaperName = array[0..63] of Char;
  TPaperNameArray = array [1..High(Integer) div Sizeof(TPaperName)] of TPaperName;
  PPapernameArray = ^TPaperNameArray;
  TPaperArray = array [1..High(Integer) div Sizeof(Word)] of Word;
  PPaperArray = ^TPaperArray;
Var
  i, numPaperNames, numPapers, temp: Integer;
  pPaperNames: PPapernameArray;
  pPapers: PPaperArray;
begin
  with FPrinterInfo do
  begin
    if not GmOpenPrinter then Exit;
    try
      numPaperNames := WinSpool.DeviceCapabilities(FDevice, FPort, DC_PAPERNAMES, nil, nil);
      numPapers := WinSpool.DeviceCapabilities(FDevice, FPort, DC_PAPERS, nil, nil);
      if numPaperNames > 0 then
      begin
        GetMem(pPaperNames, numPaperNames * Sizeof(TPapername));
        GetMem(pPapers, numPapers * Sizeof(Word));
        try
          WinSpool.DeviceCapabilities(FDevice, FPort, DC_PAPERNAMES,
      		  Pchar(pPaperNames), nil);
          WinSpool.DeviceCapabilities(FDevice, FPort, DC_PAPERS,
            Pchar(pPapers), nil );
          Papers.clear;
          for i:= 1 to numPaperNames Do
          begin
            temp := pPapers^[i];
            Papers.addObject(pPaperNames^[i], TObject(temp));
          end;
        finally
          FreeMem(pPaperNames);
          if pPapers <> nil then FreeMem(pPapers);
        end;
      end;
    finally
      GmClosePrinter;
    end;
  end;
end;

end.