gmprinter.pas

GmPrintSuite 2.96.7] a

end;

function TGmPrinterInfo.GetPrintableSizeY: Extended;
begin
  if not FIsUpdated then UpdatePrinter;
  Result := FPrintableSize.Y / FPpi.Y;
end;

function TGmPrinterInfo.GmOpenPrinter: Boolean;
begin
  Result := False;
  FDeviceMode := 0;
  if Printer.Printers.Count = 0 then Exit;
  Printer.GetPrinter(FDevice, FDriver, FPort, FDeviceMode);
  if FDeviceMode <> 0 Then
  begin
    FDevMode := GlobalLock(FDeviceMode);
    Result := True;
  end;
end;

function TGmPrinterInfo.GetPrinterAvailable: HDC;
var
	{$IFDEF D4+}
  DevMode: Cardinal;
  {$ELSE}
  DevMode: THandle;
  {$ENDIF}
begin
  Printer.GetPrinter(FDevice, FDriver, FPort, DevMode);
  //Printer.SetPrinter(FDevice, FDriver, FPort, 0);
  with TGmPrinterDevice(Printer.Printers.Objects[Printer.PrinterIndex]) do
    Result := CreateIC(PChar(Driver), PChar(Device), PChar(Port), nil);
end;

procedure TGmPrinterInfo.GmClosePrinter;
begin
  if not Printer.Printing then
  begin
    try
      Printer.SetPrinter(FDevice, FDriver, FPort, FDeviceMode);
    except
      Printer.SetPrinter(FDevice, FDriver, FPort, 0);
    end;
  end;
  GlobalUnlock(FDeviceMode);
  FDevMode := nil;
end;

procedure TGmPrinterInfo.ResetPrinter;
var
  TestPrinter: HDC;
begin
  if Printer.Printers.Count > 0 then
  begin
    TestPrinter := GetPrinterAvailable;
    if TestPrinter = 0 then
      FUseDefaultValues := True
    else
    begin
      FUseDefaultValues := False;
      DeleteDC(TestPrinter);
    end;
  end;
  UpdatePrinter;
end;

procedure TGmPrinterInfo.UseDefaultValues;
begin
  FPhysicalSize       := Point(2481, 3507);
  FPrintableSize      := Point(2358, 3407);
  FGutters            := Rect(65, 50, 58, 50);
  FPrintableSize.X    := FPhysicalSize.X - (FGutters.Left + FGutters.Right);
  FPrintableSize.Y    := FPhysicalSize.Y - (FGutters.Top + FGutters.Bottom);
  FPpi                := Point(300, 300);
  FScreenPrinterScale := Screen.PixelsPerInch / FPpi.x;
  FOrientation        := gmPortrait;
  FRotationDirection  := gmRotate90;
end;

procedure TGmPrinterInfo.UpdatePrinter;
var
  LastOrientation: TPrinterOrientation;
begin
  FIsUpdated := True;
  if (Printer.Printers.Count <= 0) or (FUseDefaultValues) then
  begin
    UseDefaultValues;
    Exit;
  end;
  LastOrientation := Printer.Orientation;
  try
    Printer.Orientation := poPortrait;
    FPhysicalSize.x     := GetDeviceCaps(Printer.Handle, PHYSICALWIDTH);
    FPhysicalSize.y     := GetDeviceCaps(Printer.Handle, PHYSICALHEIGHT);
    FPrintableSize.x    := GetDeviceCaps(Printer.Handle, HORZRES);
    FPrintableSize.y    := GetDeviceCaps(Printer.Handle, VERTRES);
    FOrientation        := AsGmOrientation(Printer.Orientation);
    FGutters.Left       := GetDeviceCaps(Printer.Handle, PhysicalOffsetX);
    FGutters.Top        := GetDeviceCaps(Printer.Handle, PhysicalOffsetY);
    FGutters.Right      := FGutters.Left;//FPhysicalSize.x - (FPrintableSize.x + FGutters.Left);
    FGutters.Bottom     := FPhysicalSize.y - (FPrintableSize.y + FGutters.Top);
    FPpi.x              := GetDeviceCaps(Printer.Handle, LogPixelsX);
    FPpi.y              := GetDeviceCaps(Printer.Handle, LogPixelsY);
    FScreenPrinterScale := Screen.PixelsPerInch / FPpi.x;
    FRotationDirection  := GetOrientationRotation;
  finally
    if not Printer.Printing then
    begin
      Printer.Orientation := LastOrientation;
    end;
  end;
end;

//------------------------------------------------------------------------------

// *** TGmPrinter ***

constructor TGmPrinter.Create;
begin
  inherited Create;
  FPrinterInfo := TGmPrinterInfo.Create;
  FFont := TFont.Create;
  FPrinterBins := TStringList.Create;
  FPaperSizes := TStringList.Create;
  FOrientation := gmPortrait;
  FTitle := DEFAULT_TITLE;
  FFileName := '';
  FInitialized := False;
  FPrinting := False;
  FPagesPerSheet := gmOnePage;
  FReversePrintOrder := False;
  if Printers.Count > 0 then
    FPrinterInfo.ResetPrinter;
end;

destructor TGmPrinter.Destroy;
begin
  FPrinterInfo.Free;
  FFont.Free;
  FPrinterBins.Free;
  FPaperSizes.Free;
  inherited Destroy;
end;

function TGmPrinter.GetPaperDimensions(Measurement: TGmMeasurement): TGmSize;
begin
  with FPrinterInfo do
  begin
    Result.Width := ConvertValue(PhysicalSizeX, gmInches, Measurement);
    Result.Height := ConvertValue(PhysicalSizeY, gmInches, Measurement);
  end;
end;

procedure TGmPrinter.Abort;
begin
  if not FPrinting then Exit;
  if Printer.Printing then Printer.Abort;
  FAborted := True;
  FPrinting := False;
  if Assigned(FOnAbortPrint) then FOnAbortPrint(Self);
end;

function TGmPrinter.GetAvailableHeight(Measurement: TGmMeasurement): Extended;
begin
  Result := ConvertValue(FPrinterInfo.GetAvailableHeight / FPrinterInfo.PpiY, gmInches, Measurement);
end;

function TGmPrinter.GetAvailableWidth(Measurement: TGmMeasurement): Extended;
begin
  Result := ConvertValue(FPrinterInfo.GetAvailableWidth / FPrinterInfo.PpiX, gmInches, Measurement);
end;

function TGmPrinter.GetCanvas: TCanvas;
begin
  Result := Printer.Canvas;
end;

function TGmPrinter.GetCollate: Boolean;
begin
  Result := False;
  with FPrinterInfo do
  begin
    if not GmOpenPrinter then Exit;
    try
      FDevMode^.dmFields := FDevMode^.dmFields or DM_COLLATE;
      case FDevMode^.dmCollate of
        DMCOLLATE_TRUE     : Result := True;
        DMCOLLATE_FALSE    : Result := False;
      end;
    finally
      GmClosePrinter;
    end;
  end;
end;

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

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

function TGmPrinter.GetPaperSize: TGmPaperSize;
begin
  Result := Custom;
  with FPrinterInfo do
  begin
    if not GmOpenPrinter then Exit;
    try
      FDevMode^.dmFields := FDevMode^.dmFields or DM_PAPERSIZE;
      Result := AsGmPaperSize(FDevMode^.dmPaperSize);
    finally
      GmClosePrinter;
    end;
  end;
end;

function TGmPrinter.GetPrintColor: TGmPrintColor;
begin
  Result := gmColor;
  with FPrinterInfo do
  begin
    if not GmOpenPrinter then Exit;
    try
      FDevMode^.dmFields := FDevMode^.dmFields or DM_COLOR;
      case FDevMode^.dmColor of
        DMCOLOR_MONOCHROME: Result := gmMonochrome;
        DMCOLOR_COLOR     : Result := gmColor;
      end;
    finally
      GmClosePrinter;
    end;
  end;
end;

function TGmPrinter.GetPrintCopies: integer;
begin
  Result := 1;
  with FPrinterInfo do
  begin
    if not GmOpenPrinter then Exit;
    try
      FDevMode^.dmFields := FDevMode^.dmFields or DM_COPIES;
     Result := FDevMode^.dmCopies;
    finally
      GmClosePrinter;
    end;
  end;
end;

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

function TGmPrinter.GetHandle: THandle;
begin
  Result := Printer.Handle;
end;

function TGmPrinter.GetIndexOf(Value: string): integer;
begin
  Result := Printers.IndexOf(Value);
end;

function TGmPrinter.GetIsColorPrinter: Boolean;
begin
  with FPrinterInfo do
  begin
    if GmOpenPrinter then
    try
      Result := ((FDevMode^.dmFields and DM_COLOR) = DM_COLOR);
    finally
      GmClosePrinter;
    end
    else
      Result := False;
  end;
end;

function TGmPrinter.GetPrinterBinIndex: integer;
type
  BinNumArray = array[0..MAX_PATH] of Word;
var
  NumBins: integer;
  BinNumList: BinNumArray;
  ICount: integer;
begin
  Result := -1;
  with FPrinterInfo do
  begin
    if GmOpenPrinter then
    try
      NumBins := DeviceCapabilities(FDevice, FPort, DC_BINS, nil, nil);
      DeviceCapabilities(FDevice, FPort, DC_BINS, @BinNumList, nil);
      for ICount := 0 to NumBins-1 do
        if BinNumList[ICount] = Word(FDevMode^.dmDefaultSource) then Result := ICount;
    finally
      GmClosePrinter;
    end;
  end;
end;

function TGmPrinter.GetPrinterBins: TStrings;
var
  ICount : Integer;
  ABin : PChar;
begin
  FPrinterBins.Clear;
  with FPrinterInfo do
  begin
    if GmOpenPrinter then
    try
      GetMem(ABin,24*DeviceCapabilities(FDevice, FPort, DC_BINNAMES, nil, nil));
      try
        with FPrinterBins do
        begin
          for ICount := 1 to DeviceCapabilities(FDevice, FPort, DC_BINNAMES, ABin, nil) do
            Add(ABin+24 * (ICount-1));
        end;
      finally
        FreeMem(ABin);
      end;
    finally
      GmClosePrinter;
    end;
  end;
  Result := FPrinterBins;
end;

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

function TGmPrinter.GetPrinterIndex: integer;
begin
  Result := Printer.PrinterIndex;
end;

function TGmPrinter.GetPrinters: TStrings;
begin
  Result := Printer.Printers;
end;

function TGmPrinter.GetPrinterSelected: Boolean;
begin