bsskinprinter.pas

BusinessSkinForm的控件包与实例

end;

procedure TbsPaperInfo.Assign(Source: TbsPaperInfo);
begin
  FDMPaper := Source.FDMPaper;
  FName := Source.FName;
  FSize := Source.FSize;
end;

function TbsPaperInfo.GetSize(Index: Integer): Integer;
begin
  if Index = 0
  then
    Result := FSize.X
  else
    Result := FSize.Y;
end;

procedure TbsPaperInfo.SetSize(Index: Integer; Value: Integer);
begin
  if DMPaper < DMPAPER_USER then Exit;
  if Index = 0
  then
    FSize.X := Value
  else
    FSize.Y := Value;
end;


procedure GetPapers(APapers: TStrings);
const
  bsPaperNameLength = 64;
  bsPaperValueLength = SizeOf(Word);
  bsPaperSizeLength = SizeOf(TPoint);
type
  TspPaperSize = TPoint;
  TspPaperSizes = array[0..0] of TspPaperSize;
  PbsPaperSizes = ^TspPaperSizes;
  TspPaperValue = Word;
  TspPaperValues = array [0..0] of TspPaperValue;
  PbsPaperValues = ^TspPaperValues;
  TspPaperName = array[0..bsPaperNameLength - 1] of char;
  TspPaperNames = array [0..0] of TspPaperName;
  PbsPaperNames = ^TspPaperNames;
var
  APaperNames: PbsPaperNames;
  APaperValues: PbsPaperValues;
  APaperSizes: PbsPaperSizes;
  ACount: Integer;
  I: Integer;
  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
        GetMem(APaperNames, ACount * Sizeof( TspPapername ));
        try
          if WinSpool.DeviceCapabilities(PrinterName, Port, ACapability, PChar(APaperNames), nil) <> -1 then
          begin
            ACapability := DC_PAPERS;
            GetMem(APaperValues, ACount * Sizeof( TspPaperValue ));
           try
              if WinSpool.DeviceCapabilities(PrinterName, Port, ACapability, PChar(APaperValues), nil) <> -1 then
              begin
                ACapability := DC_PAPERSIZE;
                GetMem(APaperSizes, bsPaperSizeLength * ACount);
                try
                  if WinSpool.DeviceCapabilities(PrinterName, Port, ACapability, PChar(APaperSizes), nil) <> -1 then
                  begin
                    for I := 0 to ACount - 1 do
                    begin
                      APaper := TbsPaperInfo.Create;
                      with APaper do
                      begin
                        FSize := APaperSizes^[I];
                        FDMPaper :=  APaperValues^[I];
                        FName := APaperNames^[I];
                      end;
                      APapers.AddObject(APaper.Name, APaper);
                    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(sl: TStrings);
 type
   TBinName      = array [0..23] of Char;
   TBinNameArray = array [0..0] of TBinName;
   PBinnameArray = ^TBinNameArray;
   TBinArray     = array [0..0] of Word;
   PBinArray     = ^TBinArray;
 var
   Device, Driver, Port: array [0..255] of Char;
   hDevMode: THandle;
   i, numBinNames, numBins, temp: Integer;
   pBinNames: PBinnameArray;
   pBins: PBinArray;
 begin
   Printer.PrinterIndex := -1;
   Printer.GetPrinter(Device, Driver, Port, hDevmode);
   numBinNames := WinSpool.DeviceCapabilities(Device, Port, DC_BINNAMES, nil, nil);
   numBins     := WinSpool.DeviceCapabilities(Device, Port, DC_BINS, nil, nil);
   if numBins <> numBinNames then
   begin
     raise Exception.Create('DeviceCapabilities reports different number of bins and bin names!');
   end;
   if numBinNames > 0 then
   begin
     pBins := nil;
     GetMem(pBinNames, numBinNames * SizeOf(TBinname));
     GetMem(pBins, numBins * SizeOf(Word));
     try
       WinSpool.DeviceCapabilities(Device, Port, DC_BINNAMES, PChar(pBinNames), nil);
       WinSpool.DeviceCapabilities(Device, Port, DC_BINS, PChar(pBins), nil);
       sl.Clear;
       for i := 0 to numBinNames - 1 do
       begin
         temp := pBins^[i];
         sl.addObject(pBinNames^[i], TObject(temp));
       end;
     finally
       FreeMem(pBinNames);
       if pBins <> nil then
         FreeMem(pBins);
     end;
   end;
 end;


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

  FTitle := 'Print setup';
  FGroupBoxTransparentMode := False;
  

  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;