bsskinprinter.pas

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

type
  TbsPaperSize = TPoint;
  TbsPaperSizes = array[0..0] of TbsPaperSize;
  PbsPaperSizes = ^TbsPaperSizes;
  TbsPaperValue = Word;
  TbsPaperValues = array[0..0] of TbsPaperValue;
  PbsPaperValues = ^TbsPaperValues;
  TbsPaperName = array[0..bsPaperNameLength - 1] of char;
  TbsPaperNames = array[0..0] of TbsPaperName;
  PbsPaperNames = ^TbsPaperNames;
var
  APaperNames: PbsPaperNames;
  APaperValues: PbsPaperValues;
  APaperSizes: PbsPaperSizes;
  ACount: Integer;
  I: Integer;
  AName: string;
  AValue: Integer;
  ASize: TPoint;
  APaper: TbsPaperInfo;
  ACapability: UINT;
  ASaveFirstDMPaper: TPoint;
  PrinterName, Driver, Port: array[0..79] of Char;
  DevModeHandle: THandle;
begin
  Printer.GetPrinter(PrinterName, Driver, Port, DevModeHandle);
  if APapers <> nil then
  try
    APapers.Clear;
    ACapability := DC_PAPERNAMES;
    ACount := WinSpool.DeviceCapabilities(PrinterName, Port, ACapability, nil, nil);
    if ACount > 0 then
      begin
        APaperNames := AllocMem(bsPaperNameLength * ACount);
        try
          if WinSpool.DeviceCapabilities(PrinterName, Port, ACapability, PChar(APaperNames), nil) <> -1 then
          begin
            ACapability := DC_PAPERS;
            APaperValues := AllocMem(bsPaperValueLength * ACount);
            try
              if WinSpool.DeviceCapabilities(PrinterName, Port, ACapability, PChar(APaperValues), nil) <> -1 then
              begin
                ACapability := DC_PAPERSIZE;
                APaperSizes := AllocMem(bsPaperSizeLength * ACount);
                try
                  if WinSpool.DeviceCapabilities(PrinterName, Port, ACapability, PChar(APaperSizes), nil) <> -1 then
                  begin
                    for I := 0 to ACount - 1 do
                    begin
                      AName := APaperNames^[I];
                      AValue := APaperValues^[I];
                      ASize := APaperSizes^[I];
                      APaper := TbsPaperInfo.Create;
                      with APaper do
                      begin
                        FSize := ASize;
                        FDMPaper := AValue;
                        FName := AName;
                      end;
                      APapers.AddObject(APaper.Name, APaper);
                      if AValue = DMPAPER_FIRST then ASaveFirstDMPaper := ASize;
                    end;
                  end;
                finally
                  FreeMem(APaperSizes, bsPaperSizeLength * ACount);
                end;
              end;
            finally
              FreeMem(APaperValues, bsPaperValueLength * ACount);
            end;
          end;
        finally
          FreeMem(APaperNames, bsPaperNameLength * ACount);
        end;
    end;
  except
    raise;
  end;
end;

procedure GetBins(Bins: TStrings);
const
  bsBinLength = SizeOf(Word);
  bsBinNameLength = 24;
type
  TbsBin = Word;
  TbsBins = array[0..0] of TbsBin;
  PbsBins = ^TbsBins;
  TbsBinName = array[0..bsBinNameLength - 1] of char;
  TbsBinNames = array[0..0] of TbsBinName;
  PbsBinNames = ^TbsBinNames;
var
  ABins: PbsBins;
  ABinNames: PbsBinNames;
  ACount: Integer;
  I: Integer;
  AName: string;
  AValue: TbsBin;
  ACapability: UINT;
  PrinterName, Driver, Port: array[0..79] of Char;
  DevModeHandle: THandle;
begin
  if Bins <> nil then
  try
    Bins.Clear;
    if Printer.Printers.Count > 0 then
    begin
      Printer.GetPrinter(PrinterName, Driver, Port, DevModeHandle);
      ACapability := DC_BINS;
      ACount := WinSpool.DeviceCapabilities(PrinterName, Port, ACapability, nil, nil);
      if ACount > 0 then
      begin
        ABins := AllocMem(bsBinLength * ACount);
        try
          if WinSpool.DeviceCapabilities(PrinterName, Port, ACapability, PChar(ABins), nil) <> -1 then
          begin
            ABinNames := AllocMem(bsBinNameLength * ACount);
            try
              ACapability := DC_BINNAMES;
              if WinSpool.DeviceCapabilities(PrinterName, Port, ACapability, PChar(ABinNames), nil) <> -1 then
              begin
                for I := 0 to ACount - 1 do
                begin
                  AName := ABinNames^[I];
                  AValue := ABins^[I];
                  Bins.AddObject(AName, TObject(AValue));
                end;
              end;
            finally
              FreeMem(ABinNames, bsBinNameLength * ACount);
            end;
          end;
        finally
          FreeMem(ABins, bsBinLength * ACount);
        end;
      end;
    end;
  except
    raise;
  end;
end;


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

  FTitle := 'Print setup';

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

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

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

  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;

  Bins := TStringList.Create;

  Papers := TStringList.Create;

  StopCheck := False;
end;

destructor TbsSkinPrinterSetupDialog.Destroy;
begin
  ClearPapersAndBins;
  Papers.Free;
  Bins.Free;
  FDefaultLabelFont.Free;
  FDefaultButtonFont.Free;
  FDefaultSelectFont.Free;
  inherited;
end;

procedure TbsSkinPrinterSetupDialog.ClearPapersAndBins;
var
  I: Integer;
begin
  if Papers.Count = 0 then Exit;
  for I := 0 to Papers.Count - 1 do
    TbsPaperInfo(Papers.Objects[I]).Free;
  Papers.Clear;
  Bins.Clear;  
end;

procedure TbsSkinPrinterSetupDialog.SaveCurrentPaperAndBin;
var
  PPrinterDevMode: PDevMode;
  DevModeHandle: THandle;
  hPrinter: THandle;
  PrinterName, Driver, Port: array[0..79] of Char;
  I: Integer;
begin
  Printer.GetPrinter(PrinterName, Driver, Port, DevModeHandle);
  if not OpenPrinter(PrinterName, hPrinter, nil)
  then
    raise EPrinter.Create(SysErrorMessage(GetLastError ));
  PPrinterDevMode := GlobalLock(DevModeHandle);
  //
  I := SizeComboBox.ItemIndex;
  if I <> -1
  then
   PPrinterDevMode^.dmPaperSize := TbsPaperInfo(Papers.Objects[I]).DMPaper;
  I := SourceComboBox.ItemIndex;
  if I <> -1
  then
    PPrinterDevMode^.dmDefaultSource := Integer(Bins.Objects[I]);
  //
  DocumentProperties(0, hPrinter, PrinterName, PPrinterDevMode^, PPrinterDevMode^, DM_OUT_BUFFER or DM_IN_BUFFER);
  GlobalUnlock(DevModeHandle);
  ClosePrinter(hPrinter);
end;

procedure TbsSkinPrinterSetupDialog.LoadCurrentPaperAndBin;
var
  PPrinterDevMode: PDevMode;
  DevModeHandle: THandle;
  hPrinter: THandle;
  PrinterName, Driver, Port: array[0..79] of Char;
  dm_Size: Integer;
  dm_Source: Integer;
  I, J: Integer;
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);
  dm_Size := PPrinterDevMode^.dmPaperSize;
  dm_Source := PPrinterDevMode^.dmDefaultSource;
  GlobalUnlock(DevModeHandle);
  ClosePrinter(hPrinter);
  //
  J := 0;
  for I := 0 to SizeComboBox.Items.Count - 1 do
  begin
    if TbsPaperInfo(Papers.Objects[I]).DMPaper = dm_Size
    then
      begin
        J := I;
        Break;
      end;
  end;
  SizeComboBox.ItemIndex := J;
  //
  J := 0;
  for I := 0 to SourceComboBox.Items.Count - 1 do
  begin
    if Integer(Bins.Objects[I]) = dm_Source
    then
      begin
        J := I;
        Break;
      end;
  end;
  SourceComboBox.ItemIndex := J;
  //

  //
end;

procedure TbsSkinPrinterSetupDialog.LoadPapersAndBins;
begin
  ClearPapersAndBins;
  GetPapers(Papers);
  GetBins(Bins);

  StopCheck := True;

  SizeComboBox.Items.Assign(Papers);
  SourceComboBox.Items.Assign(Bins);
  LoadCurrentPaperAndBin;



  StopCheck := False;
end;

procedure TbsSkinPrinterSetupDialog.PropertiesButtonClick(Sender: TObject);
begin
  CallDocumentPropertiesDialog(Form.Handle);
  StopCheck := True;
  if Printer.Orientation = poPortrait
  then
    RBPortrait.Checked := True
  else
    RBLandscape.Checked := True;
  LoadCurrentPaperAndBin;
  StopCheck := False;
end;

procedure TbsSkinPrinterSetupDialog.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;
  LoadPapersAndBins;
end;

procedure TbsSkinPrinterSetupDialog.RBPortraitClick(Sender: TObject);
begin
  Printer.Orientation := poPortrait;
  OrientationImage.Picture.Bitmap.LoadFromResourceName(HInstance, 'BS_PORTRAIT')
end;

procedure TbsSkinPrinterSetupDialog.RBLandScapeClick(Sender: TObject);
begin
  Printer.Orientation := poLandscape;
  OrientationImage.Picture.Bitmap.LoadFromResourceName(HInstance, 'BS_LANDSCAPE');
end;

procedure TbsSkinPrinterSetupDialog.SizeComboBoxChange(Sender: TObject);
begin
  if StopCheck then Exit;
  SaveCurrentPaperAndBin;
end;

procedure TbsSkinPrinterSetupDialog.SourceComboBoxChange(Sender: TObject);
begin
  if StopCheck then Exit;
  SaveCurrentPaperAndBin;
end;

function TbsSkinPrinterSetupDialog.Execute;
var
  BSF: TbsBusinessSkinForm;
  OldPrinterIndex: Integer;
  PrinterGroupBox: TbsSkinGroupBox;
  PaperGroupBox: TbsSkinGroupBox;
  OrientationGroupBox: TbsSkinGroupBox;
  R: TRect;
  S1, S2, S3, S4: String;
  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 :=  460;
  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;

  with TbsSkinStdLabel.Create(Self) do
  begin
    Parent := PrinterGroupBox;
    Left := R.Left + 10;
    Top := R.Top + 10;
    WordWrap := False;
    DefaultFont := DefaultLabelFont;
    UseSkinFont := Self.UseSkinFont;