frxprinter.pas

报表源码 FastReport 3 is new generation of the report generators components. It consists of report engin

  FLeftMargin:= 5;
  FTopMargin:= 5;
  FRightMargin:= 5;
  FBottomMargin:= 5;
end;

procedure TfrxVirtualPrinter.SetPrintParams(APaperSize:Integer;
  APaperWidth, APaperHeight:Extended; AOrientation:TPrinterOrientation;
  ABin, ACopies, ADuplex:Integer);
begin
  SetViewParams(APaperSize, APaperWidth, APaperHeight, AOrientation);
  FBin:= ABin;
end;

procedure TfrxVirtualPrinter.PropertiesDlg;
begin
end;

{ TfrxPrinter }

destructor TfrxPrinter.Destroy;
begin
  FreeDevMode;
  inherited;
end;

procedure TfrxPrinter.Init;

  procedure FillPapers;
  var
    i, PaperSizesCount:Integer;
    PaperSizes:array[0..255] of Word;
    PaperNames:PChar;
  begin
    FillChar(PaperSizes, SizeOf(PaperSizes), 0);
    PaperSizesCount:= DeviceCapabilities(PChar(FName), PChar(FPort), DC_PAPERS, @PaperSizes, FMode);
    GetMem(PaperNames, PaperSizesCount * 64);
    DeviceCapabilities(PChar(FName), PChar(FPort), DC_PAPERNAMES, PaperNames, FMode);

    for i:= 0 to PaperSizesCount-1 do
      if PaperSizes[i]<>256 then
        FPapers.AddObject(StrPas(PaperNames+i * 64), Pointer(PaperSizes[i]));

    FreeMem(PaperNames, PaperSizesCount * 64);
  end;

  procedure FillBins;
  var
    i, BinsCount:Integer;
    BinNumbers:array[0..255] of Word;
    BinNames:PChar;
  begin
    FillChar(BinNumbers, SizeOf(BinNumbers), 0);
    BinsCount:= DeviceCapabilities(PChar(FName), PChar(FPort), DC_BINS, @BinNumbers[0], FMode);
    GetMem(BinNames, BinsCount * 64);
    DeviceCapabilities(PChar(FName), PChar(FPort), DC_BINNAMES, BinNames, FMode);

    for i:= 0 to BinsCount-1 do
      if BinNumbers[i]<>DMBIN_AUTO then
        FBins.AddObject(StrPas(BinNames+i * 24), Pointer(BinNumbers[i]));

    FreeMem(BinNames, BinsCount * 64);
  end;

begin
  if FInitialized then Exit;

  CreateDevMode;
  if FDeviceMode = 0 then Exit;
  RecreateDC;

  UpdateDeviceCaps;
  FDefPaper:= FMode.dmPaperSize;
  FDefPaperWidth:= FPaperWidth;
  FDefPaperHeight:= FPaperHeight;
  if FMode.dmOrientation = DMORIENT_PORTRAIT then
    FDefOrientation:= poPortrait else
    FDefOrientation:= poLandscape;

  FillPapers;
  FillBins;
  FBin:=-1;

  FInitialized:= True;
end;

procedure TfrxPrinter.Abort;
begin
  AbortDoc(FDC);
  EndDoc;
end;

procedure TfrxPrinter.BeginDoc;
var
  DocInfo:TDocInfo;
begin
  FPrinting:= True;

  FillChar(DocInfo, SizeOf(DocInfo), 0);
  DocInfo.cbSize:= SizeOf(DocInfo);
  DocInfo.lpszDocName:= PChar(FTitle);
  if FFileName<>'' then
    DocInfo.lpszOutput:= PChar(FFileName);

  RecreateDC;
  StartDoc(FDC, DocInfo);
end;

procedure TfrxPrinter.BeginPage;
begin
  StartPage(FDC);
end;

procedure TfrxPrinter.EndDoc;
begin
  Windows.EndDoc(FDC);
  FPrinting:= False;
  RecreateDC;
  FBin:=-1;
end;

procedure TfrxPrinter.EndPage;
begin
  Windows.EndPage(FDC);
end;

procedure TfrxPrinter.BeginRAWDoc;
var
  DocInfo1:TDocInfo1;
begin
  RecreateDC;
  DocInfo1.pDocName:= PChar(FTitle);
  DocInfo1.pOutputFile:= nil;
  DocInfo1.pDataType:= 'RAW';
  StartDocPrinter(FHandle, 1, @DocInfo1);
  StartPagePrinter(FHandle);
end;

procedure TfrxPrinter.EndRAWDoc;
begin
  EndPagePrinter(FHandle);
  EndDocPrinter(FHandle);
end;

procedure TfrxPrinter.WriteRAWDoc(const buf:String);
var
  N:DWORD;
begin
  WritePrinter(FHandle, PChar(buf), Length(buf), N);
end;

procedure TfrxPrinter.CreateDevMode;
var
  bufSize:Integer;
  dm:TDeviceMode;
begin
  if OpenPrinter(PChar(FName), FHandle, nil) then
  begin
    bufSize:= DocumentProperties(0, FHandle, PChar(FName), dm, dm, 0);
    if bufSize > 0 then
    begin
      FDeviceMode:= GlobalAlloc(GHND, bufSize);
      if FDeviceMode<>0 then
      begin
        FMode:= GlobalLock(FDeviceMode);
        if DocumentProperties(0, FHandle, PChar(FName), FMode^, FMode^,
          DM_OUT_BUFFER) < 0 then
        begin
          GlobalUnlock(FDeviceMode);
          GlobalFree(FDeviceMode);
          FDeviceMode:= 0;
          FMode:= nil;
        end
      end;
    end;
  end;
end;

procedure TfrxPrinter.FreeDevMode;
begin
  FCanvas.Handle:= 0;
  if FDC<>0 then
    DeleteDC(FDC);
  if FHandle<>0 then
    ClosePrinter(FHandle);
  if FDeviceMode<>0 then
  begin
    GlobalUnlock(FDeviceMode);
    GlobalFree(FDeviceMode);
  end;
end;

procedure TfrxPrinter.RecreateDC;
begin
  if FDC<>0 then
    DeleteDC(FDC);
  FDC:= 0;
  GetDC;
end;

procedure TfrxPrinter.GetDC;
begin
  if FDC = 0 then
  begin
    if FPrinting then
      FDC:= CreateDC(PChar(FDriver), PChar(FName), nil, FMode) else
      FDC:= CreateIC(PChar(FDriver), PChar(FName), nil, FMode);
    FCanvas.Handle:= FDC;
    FCanvas.Refresh;
    FCanvas.UpdateFont;
  end;
end;

procedure TfrxPrinter.SetViewParams(APaperSize:Integer;
  APaperWidth, APaperHeight:Extended; AOrientation:TPrinterOrientation);
begin
  if APaperSize<>256 then
  begin
    FMode.dmFields:= DM_PAPERSIZE or DM_ORIENTATION;
    FMode.dmPaperSize:= APaperSize;
    if AOrientation = poPortrait then
      FMode.dmOrientation:= DMORIENT_PORTRAIT else
      FMode.dmOrientation:= DMORIENT_LANDSCAPE;
    RecreateDC;
    UpdateDeviceCaps;
  end
  else
  begin
    // copy the margins from A4 paper
    SetViewParams(DMPAPER_A4, 0, 0, AOrientation);
    FPaperHeight:= APaperHeight;
    FPaperWidth:= APaperWidth;
  end;

  FPaper:= APaperSize;
  FOrientation:= AOrientation;
end;

procedure TfrxPrinter.SetPrintParams(APaperSize:Integer;
  APaperWidth, APaperHeight:Extended; AOrientation:TPrinterOrientation;
  ABin, ACopies, ADuplex:Integer);
begin
  FMode.dmFields:= FMode.dmFields or DM_PAPERSIZE or DM_ORIENTATION or DM_COPIES or
    DM_DEFAULTSOURCE;
  if ADuplex<>1 then
    FMode.dmFields:= FMode.dmFields or DM_DUPLEX;

  if APaperSize = 256 then
  begin
    FMode.dmFields:= FMode.dmFields or DM_PAPERLENGTH or DM_PAPERWIDTH;
    FMode.dmPaperLength:= Round(APaperHeight * 10);
    FMode.dmPaperWidth:= Round(APaperWidth * 10);
  end;

  FMode.dmPaperSize:= APaperSize;

  if AOrientation = poPortrait then
    FMode.dmOrientation:= DMORIENT_PORTRAIT else
    FMode.dmOrientation:= DMORIENT_LANDSCAPE;

  FMode.dmCopies:= ACopies;
  if FBin<>-1 then
    ABin:= FBin;
  FMode.dmDefaultSource:= ABin;
  if ADuplex = 4 then
    FMode.dmDuplex:= DMDUP_SIMPLEX
  else if ADuplex<>1 then
    FMode.dmDuplex:= ADuplex;

  FDC:= ResetDC(FDC, FMode^);
  FDC:= ResetDC(FDC, FMode^); // needed for some printers
  FCanvas.Refresh;
  UpdateDeviceCaps;
  FPaper:= APaperSize;
  FOrientation:= AOrientation;
end;

procedure TfrxPrinter.UpdateDeviceCaps;
begin
  FDPI:= Point(GetDeviceCaps(FDC, LOGPIXELSX), GetDeviceCaps(FDC, LOGPIXELSY));
  FPaperHeight:= GetDeviceCaps(FDC, PHYSICALHEIGHT) / FDPI.Y * 25.4;
  FPaperWidth:= GetDeviceCaps(FDC, PHYSICALWIDTH) / FDPI.X * 25.4;
  FLeftMargin:= GetDeviceCaps(FDC, PHYSICALOFFSETX) / FDPI.X * 25.4;
  FTopMargin:= GetDeviceCaps(FDC, PHYSICALOFFSETY) / FDPI.Y * 25.4;
  FRightMargin:= FPaperWidth-GetDeviceCaps(FDC, HORZRES) / FDPI.X * 25.4-FLeftMargin;
  FBottomMargin:= FPaperHeight-GetDeviceCaps(FDC, VERTRES) / FDPI.Y * 25.4-FTopMargin;
end;

procedure TfrxPrinter.PropertiesDlg;
var
  h:THandle;
begin
  if Screen.ActiveForm<>nil then
    h:= Screen.ActiveForm.Handle else
    h:= 0;
  if DocumentProperties(h, FHandle, PChar(FName), FMode^,
    FMode^, DM_IN_BUFFER or DM_OUT_BUFFER or DM_IN_PROMPT) > 0 then
  begin
    FBin:= FMode.dmDefaultSource;
    RecreateDC;
  end;
end;

{ TfrxPrinters }

constructor TfrxPrinters.Create;
begin
  FPrinterList:= TList.Create;
  FPrinters:= TStringList.Create;

  FillPrinters;
  if FPrinterList.Count = 0 then
  begin
    FPrinterList.Add(TfrxVirtualPrinter.Create(frxResources.Get('prVirtual'), ''));
    FHasPhysicalPrinters:= False;
    PrinterIndex:= 0;
  end
  else
  begin
    FHasPhysicalPrinters:= True;
    PrinterIndex:= IndexOf(GetDefaultPrinter);
  end;
end;

destructor TfrxPrinters.Destroy;
begin
  Clear;
  FPrinterList.Free;
  FPrinters.Free;
  inherited;
end;

procedure TfrxPrinters.Clear;
begin
  while FPrinterList.Count > 0 do
  begin
    TObject(FPrinterList[0]).Free;
    FPrinterList.Delete(0);
  end;
end;

function TfrxPrinters.GetItem(Index:Integer):TfrxCustomPrinter;
begin
  Result:= FPrinterList[Index];
end;

function TfrxPrinters.IndexOf(AName:String):Integer;
var
  i:Integer;
begin
  Result:=-1;
  for i:= 0 to FPrinterList.Count-1 do
    if AnsiCompareText(Items[i].Name, AName) = 0 then
    begin
      Result:= i;
      break;
    end;
end;

procedure TfrxPrinters.SetPrinterIndex(Value:Integer);
begin
  FPrinterIndex:= Value;
  if Value<>-1 then
    Items[FPrinterIndex].Init;
end;

function TfrxPrinters.GetCurrentPrinter:TfrxCustomPrinter;
begin
  Result:= Items[PrinterIndex];
end;

function TfrxPrinters.GetDefaultPrinter:String;
var
  prnName:array[0..79] of Char;
begin
  GetProfileString('windows', 'device', '', prnName, 79);
  Result:= Copy(prnName, 1, Pos(',', prnName)-1);
end;

procedure TfrxPrinters.FillPrinters;
var
  i, j:Integer;
  Buf, prnInfo:PChar;
  Flags, bufSize, prnCount:DWORD;
  Level:Byte;
  sl:TStringList;

  procedure AddPrinter(ADevice, APort:String);
  begin
    FPrinterList.Add(TfrxPrinter.Create(ADevice, APort));
    FPrinters.Add(ADevice);
  end;

begin
  Clear;
  if Win32Platform = VER_PLATFORM_WIN32_NT then
  begin
    Flags:= PRINTER_ENUM_CONNECTIONS or PRINTER_ENUM_LOCAL;
    Level:= 4;
  end
  else
  begin
    Flags:= PRINTER_ENUM_LOCAL;
    Level:= 5;
  end;

  bufSize:= 0;
  EnumPrinters(Flags, nil, Level, nil, 0, bufSize, prnCount);
  if bufSize = 0 then Exit;

  GetMem(Buf, bufSize);
  try
    if not EnumPrinters(Flags, nil, Level, PByte(Buf), bufSize, bufSize, prnCount) then
      Exit;
    prnInfo:= Buf;

    for i:= 0 to prnCount-1 do
      if Level = 4 then
        with PPrinterInfo4(prnInfo)^ do
        begin
          AddPrinter(pPrinterName, '');
          Inc(prnInfo, SizeOf(TPrinterInfo4));
        end
      else
        with PPrinterInfo5(prnInfo)^ do
        begin
          sl:= TStringList.Create;
          frxSetCommaText(pPortName, sl, ',');

          for j:= 0 to sl.Count-1 do
            AddPrinter(pPrinterName, sl[j]);

          sl.Free;
          Inc(prnInfo, SizeOf(TPrinterInfo5));
        end;

  finally
    FreeMem(Buf, bufSize);
  end;
end;

function frxPrinters:TfrxPrinters;
begin
  if FPrinters = nil then
    FPrinters:= TfrxPrinters.Create;
  Result:= FPrinters;
end;

initialization
  FPrinters:= nil;

finalization
  if FPrinters<>nil then
    FPrinters.Free;
  FPrinters:= nil;

end.