bsskinprinter.pas

一套非常优秀的皮肤组件包

  DevModeHandle: THandle;
  hPrinter: THandle;
  PrinterName, Driver, Port: array[0..79] of Char;
begin
  Printer.GetPrinter(PrinterName, Driver, Port, DevModeHandle);
  if not OpenPrinter(PrinterName, hPrinter, nil)
  then
    raise EPrinter.Create(SysErrorMessage(GetLastError ));
  PPrinterDevMode := GlobalLock(DevModeHandle);
  DocumentProperties(H, hPrinter, PrinterName, PPrinterDevMode^, PPrinterDevMode^, DM_OUT_BUFFER or DM_IN_BUFFER or DM_IN_PROMPT);
  GlobalUnlock(DevModeHandle);
  ClosePrinter(hPrinter);
end;

procedure SetCollate(Value: Boolean);
var
  PPrinterDevMode: PDevMode;
  DevModeHandle: THandle;
  hPrinter: THandle;
  PrinterName, Driver, Port: array[0..79] of Char;
begin
  Printer.GetPrinter(PrinterName, Driver, Port, DevModeHandle);
  if not OpenPrinter(PrinterName, hPrinter, nil)
  then
    raise EPrinter.Create(SysErrorMessage(GetLastError ));
  PPrinterDevMode := GlobalLock(DevModeHandle);
  if Value
  then PPrinterDevMode^.dmCollate := 1
  else PPrinterDevMode^.dmCollate := 0;
  DocumentProperties(0, hPrinter, PrinterName, PPrinterDevMode^, PPrinterDevMode^, DM_OUT_BUFFER or DM_IN_BUFFER);
  GlobalUnlock(DevModeHandle);
  ClosePrinter(hPrinter);
end;

function GetCollate: Boolean;
var
  PPrinterDevMode: PDevMode;
  DevModeHandle: THandle;
  hPrinter: THandle;
  PrinterName, Driver, Port: array[0..79] of Char;
begin
  Printer.GetPrinter(PrinterName, Driver, Port, DevModeHandle);
  if not OpenPrinter(PrinterName, hPrinter, nil)
  then
    raise EPrinter.Create(SysErrorMessage(GetLastError ));
  PPrinterDevMode := GlobalLock(DevModeHandle);
  DocumentProperties(0, hPrinter, PrinterName, PPrinterDevMode^, PPrinterDevMode^, DM_OUT_BUFFER or DM_IN_BUFFER);
  Result := PPrinterDevMode^.dmCollate > 0;
  GlobalUnlock(DevModeHandle);
  ClosePrinter(hPrinter);
end;

procedure RestoreDocumentProperties;
var
  PPrinterDevMode: PDevMode;
  DevModeHandle: THandle;
  hPrinter: THandle;
  PrinterName, Driver, Port: array[0..79] of Char;
begin
  Printer.GetPrinter(PrinterName, Driver, Port, DevModeHandle);
  if not OpenPrinter(PrinterName, hPrinter, nil)
  then
    raise EPrinter.Create(SysErrorMessage(GetLastError ));
  PPrinterDevMode := GlobalLock(DevModeHandle);
  DocumentProperties(0, hPrinter, PrinterName, PPrinterDevMode^, PPrinterDevMode^, DM_OUT_BUFFER);
  GlobalUnlock(DevModeHandle);
  ClosePrinter(hPrinter);
end;

procedure GetPrinterInfo(var AStatus, AType, APort, AComment: String);
var
  Flags, ACount, NumInfo: DWORD;
  Buffer, PInfo: PChar;
  PrinterName, Driver, Port: array[0..79] of Char;
  DevModeHandle: THandle;
  I: Integer;
  S1, S2: String;
begin
  Printer.GetPrinter(PrinterName, Driver, Port, DevModeHandle);

  Flags := PRINTER_ENUM_CONNECTIONS or PRINTER_ENUM_LOCAL;
  ACount := 0;
  EnumPrinters(Flags, nil, 2, nil, 0, ACount, NumInfo);
  if ACount = 0 then Exit;
  GetMem(Buffer, ACount);
  if not EnumPrinters(Flags, nil, 2, PByte(Buffer), ACount, ACount, NumInfo)
  then
    begin
      FreeMem(Buffer, ACount);
      Exit;
    end;

  PInfo := Buffer;

  S1 := PrinterName;
  for i := 0 to NumInfo - 1 do
  begin
    S2 := PPrinterInfo2(PInfo)^.pPrinterName;
    if S1 = S2
    then
      Break
    else
      Inc(PInfo, Sizeof(TPrinterInfo2));
  end;

  AStatus := GetStatusString(PPrinterInfo2(PInfo)^.Status);
  AType := PPrinterInfo2(PInfo)^.pDriverName;
  APort := PPrinterInfo2(PInfo)^.pPortName;
  AComment := PPrinterInfo2(PInfo)^.pComment;

  FreeMem(Buffer, ACount);
end;


constructor TbsSkinPrintDialog.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FTitle := 'Print';

  FAlphaBlend := False;
  FAlphaBlendAnimation := False;
  FAlphaBlendValue := 200;

  FButtonSkinDataName := 'button';
  FLabelSkinDataName  := 'stdlabel';
  FSelectSkinDataName := 'combobox';

  FDefaultLabelFont := TFont.Create;
  FDefaultButtonFont := TFont.Create;
  FDefaultSelectFont := TFont.Create;

  StopCheck := False;

  FUseSkinFont := True;

  with FDefaultLabelFont do
  begin
    Name := 'Arial';
    Style := [];
    Height := 14;
  end;

  with FDefaultButtonFont do
  begin
    Name := 'Arial';
    Style := [];
    Height := 14;
  end;

  with FDefaultSelectFont do
  begin
    Name := 'Arial';
    Style := [];
    Height := 14;
  end;
end;

destructor TbsSkinPrintDialog.Destroy;
begin
  FDefaultLabelFont.Free;
  FDefaultButtonFont.Free;
  FDefaultSelectFont.Free;
  inherited;
end;

procedure TbsSkinPrintDialog.FromPageEditChange(Sender: TObject);
begin
  RBPages.Checked := True;
end;

procedure TbsSkinPrintDialog.ToPageEditChange(Sender: TObject);
begin
  RBPages.Checked := True;
end;

procedure TbsSkinPrintDialog.PropertiesButtonClick(Sender: TObject);
begin
  CallDocumentPropertiesDialog(Form.Handle);
  StopCheck := True;
  NumCopiesEdit.Value :=  Printer.Copies;
  CollateCheckBox.Checked := GetCollate;
  StopCheck := False;
end;

procedure TbsSkinPrintDialog.PrinterComboBoxChange(Sender: TObject);
var
  S1, S2, S3, S4: String;
begin
  Printer.PrinterIndex := PrinterComboBox.ItemIndex;
  GetPrinterInfo(S1, S2, S3, S4);
  L1.Caption := S1;
  L2.Caption := S2;
  L3.Caption := S3;
  L4.Caption := S4;
  StopCheck := True;
  NumCopiesEdit.Value := Printer.Copies;
  CollateCheckBox.Checked := GetCollate;
  StopCheck := False;
end;

procedure TbsSkinPrintDialog.CollateCheckBoxClick(Sender: TObject);
begin
  if not StopCheck then SetCollate(CollateCheckBox.Checked);
  if CollateCheckBox.Checked
  then
    CollateImage.Picture.Bitmap.LoadFromResourceName(HInstance, 'BS_COLLATE')
  else
    CollateImage.Picture.Bitmap.LoadFromResourceName(HInstance, 'BS_NOCOLLATE');
end;

procedure TbsSkinPrintDialog.NumCopiesEditChange(Sender: TObject);
begin
  Printer.Copies := Round(NumCopiesEdit.Value);
  CollateCheckBox.Enabled := NumCopiesEdit.Value > 1;
end;

procedure TbsSkinPrintDialog.SetNumCopies(Value: Integer);
begin
  FCopies := Value;
  Printer.Copies := Value;
end;

function TbsSkinPrintDialog.Execute;
var
  BSF: TbsBusinessSkinForm;
  OldPrinterIndex: Integer;
  PrinterGroupBox: TbsSkinGroupBox;
  PrintRangeGroupBox: TbsSkinGroupBox;
  CopiesGroupBox: TbsSkinGroupBox;
  R: TRect;
  S1, S2, S3, S4: String;
  fromL, toL: TbsSkinStdLabel;
  SkinMessage: TbsSkinMessage;
  S: String;
begin
  if (Printer = nil) or (Printer.Printers.Count = 0)
  then
    begin
      SkinMessage := TbsSkinMessage.Create(Self);
      SkinMessage.SkinData := Self.SkinData;
      SkinMessage.CtrlSkinData := Self.CtrlSkinData;
      if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
      then
        S:= SkinData.ResourceStrData.GetResStr('PRNDLG_WARNING')
      else
        S := BS_PRNDLG_WARNING;
      SkinMessage.MessageDlg(S, mtError, [mbOk], 0);
      SkinMessage.Free;
      Exit;
    end;
  Form := TForm.Create(Application);
  Form.BorderStyle := bsDialog;
  Form.Position := poScreenCenter;
  Form.Caption := FTitle;
  BSF := TbsBusinessSkinForm.Create(Form);
  BSF.BorderIcons := [];
  BSF.SkinData := SkinData;
  BSF.MenusSkinData := CtrlSkinData;
  BSF.AlphaBlend := AlphaBlend;
  BSF.AlphaBlendAnimation := AlphaBlendAnimation;
  BSF.AlphaBlendValue := AlphaBlendValue;

  Form.ClientWidth :=  470;
  Form.ClientHeight := 340;

  PrinterGroupBox := TbsSkinGroupBox.Create(Self);

  with PrinterGroupBox do
  begin
    Parent := Form;
    Left := 10;
    Top := 10;
    Width := Form.ClientWidth - 20;
    Height := 150;
    SkinData := CtrlSkinData;
    if (CtrlSkinData <> nil) and (CtrlSkinData.ResourceStrData <> nil)
    then
      Caption := CtrlSkinData.ResourceStrData.GetResStr('PRNDLG_PRINTER')
    else
      Caption := BS_PRNDLG_PRINTER;
  end;

  R := PrinterGroupBox.GetSkinClientRect;

  PrintToFileCheckBox := TbsSkinCheckRadioBox.Create(Self);
  with PrintToFileCheckBox do
  begin
    Parent := PrinterGroupBox;
    Checked := Self.PrintToFile;
    Left := R.Right - 100;
    Top := R.Bottom - 35;
    Width := 80;
    SkinData := CtrlSkinData;
    if (CtrlSkinData <> nil) and (CtrlSkinData.ResourceStrData <> nil)
    then
      Caption := CtrlSkinData.ResourceStrData.GetResStr('PRNDLG_PRINTTOFILE')
    else
      Caption := BS_PRNDLG_PRINTTOFILE;
    Enabled := not (bspoDisablePrintToFile in Options);
    Visible := bspoPrintToFile in Options;
    OnClick := CollateCheckBoxClick;
  end;

  with TbsSkinStdLabel.Create(Self) do
  begin
    Parent := PrinterGroupBox;
    Left := R.Left + 10;
    Top := R.Top + 10;
    WordWrap := False;
    DefaultFont := DefaultLabelFont;
    UseSkinFont := Self.UseSkinFont;
    SkinData := CtrlSkinData;
    if (CtrlSkinData <> nil) and (CtrlSkinData.ResourceStrData <> nil)
    then
      Caption := CtrlSkinData.ResourceStrData.GetResStr('PRNDLG_NAME')
    else
      Caption := BS_PRNDLG_NAME;
  end;

  PrinterCombobox := TbsSkinCombobox.Create(Form);
  with PrinterCombobox do
  begin
    Parent := PrinterGroupBox;
    DefaultFont := DefaultComboboxFont;
    UseSkinFont := Self.UseSkinFont;
    Items.Assign(Printer.Printers);
    ItemIndex := Printer.PrinterIndex;
    SkinDataName := FSelectSkinDataName;
    SkinData := CtrlSkinData;
    OnChange := PrinterComboBoxChange;
    Top := R.Top + 7;
    Left := R.Left + 80;
    Width := RectWidth(R) - 180;
   end;

  with TbsSkinButton.Create(Self) do
  begin
    Parent := PrinterGroupBox;
    Left := PrinterCombobox.Left + PrinterCombobox.Width + 10;
    Top := R.Top + 5;
    Width := 80;
    DefaultFont := DefaultButtonFont;
    UseSkinFont := Self.UseSkinFont;
    SkinData := CtrlSkinData;
    if (CtrlSkinData <> nil) and (CtrlSkinData.ResourceStrData <> nil)
    then
      Caption := CtrlSkinData.ResourceStrData.GetResStr('PRNDLG_PROPERTIES')
    else
      Caption := BS_PRNDLG_PROPERTIES;
    OnClick := PropertiesButtonClick;
  end;

  with TbsSkinStdLabel.Create(Self) do
  begin
    Parent := PrinterGroupBox;
    Left := R.Left + 10;
    Top := R.Top + 40;
    WordWrap := False;
    DefaultFont := DefaultLabelFont;
    UseSkinFont := Self.UseSkinFont;
    SkinData := CtrlSkinData;
    if (CtrlSkinData <> nil) and (CtrlSkinData.ResourceStrData <> nil)
    then
      Caption := CtrlSkinData.ResourceStrData.GetResStr('PRNDLG_STATUS')
    else
      Caption := BS_PRNDLG_STATUS;
  end;

  L1 := TbsSkinStdLabel.Create(Self);
  with L1 do
  begin
    Parent := PrinterGroupBox;
    Left := R.Left + 80;
    Top := R.Top + 40;
    WordWrap := False;
    DefaultFont := DefaultLabelFont;
    UseSkinFont := Self.UseSkinFont;
    SkinData := CtrlSkinData;
    Caption := '';
  end;

  with TbsSkinStdLabel.Create(Self) do
  begin
    Parent := PrinterGroupBox;
    Left := R.Left + 10;
    Top := R.Top + 60;
    WordWrap := False;
    DefaultFont := DefaultLabelFont;
    UseSkinFont := Self.UseSkinFont;
    SkinData := CtrlSkinData;
    if (CtrlSkinData <> nil) and (CtrlSkinData.ResourceStrData <> nil)
    then
      Caption := CtrlSkinData.ResourceStrData.GetResStr('PRNDLG_TYPE')
    else
      Caption := BS_PRNDLG_TYPE;
  end;

  L2 := TbsSkinStdLabel.Create(Self);
  with L2 do
  begin
    Parent := PrinterGroupBox;
    Left := R.Left + 80;
    Top := R.Top + 60;
    WordWrap := False;
    DefaultFont := DefaultLabelFont;
    UseSkinFont := Self.UseSkinFont;
    SkinData := CtrlSkinData;
    Caption := '';
  end;


  with TbsSkinStdLabel.Create(Self) do
  begin
    Parent := PrinterGroupBox;
    Left := R.Left + 10;
    Top := R.Top + 80;
    WordWrap := False;
    DefaultFont := DefaultLabelFont;
    UseSkinFont := Self.UseSkinFont;
    SkinData := CtrlSkinData;
    if (CtrlSkinData <> nil) and (CtrlSkinData.ResourceStrData <> nil)
    then
      Caption := CtrlSkinData.ResourceStrData.GetResStr('PRNDLG_WHERE')
    else
      Caption := BS_PRNDLG_WHERE;
  end;