skinprinter.pas

DynamicSkinForm.v9.15.For.Delphi.BCB 很好的皮肤控件

procedure TspSkinPrintDialog.SetTitle(const Value: string);
begin
  FTitle := Value;
end;


{ TspPaperInfo }

function TspPaperInfo.IsEqual(Source: TspPaperInfo): Boolean;
begin
  Result := (DMPaper = Source.DMPaper) and (FName = Source.Name) and
    EqPoints(Size, Source.Size);
end;

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

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

procedure TspPaperInfo.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;
  AName: string;
  AValue: Integer;
  ASize: TPoint;
  APaper: TspPaperInfo;
  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 := TspPaperInfo.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
  TspBin = Word;
  TspBins = array[0..0] of TspBin;
  PbsBins = ^TspBins;
  TspBinName = array[0..bsBinNameLength - 1] of char;
  TspBinNames = array[0..0] of TspBinName;
  PbsBinNames = ^TspBinNames;
var
  ABins: PbsBins;
  ABinNames: PbsBinNames;
  ACount: Integer;
  I: Integer;
  AName: string;
  AValue: TspBin;
  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 TspSkinPrinterSetupDialog.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 TspSkinPrinterSetupDialog.Destroy;
begin
  ClearPapersAndBins;
  Papers.Free;
  Bins.Free;
  FDefaultLabelFont.Free;
  FDefaultButtonFont.Free;
  FDefaultSelectFont.Free;
  inherited;
end;

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

procedure TspSkinPrinterSetupDialog.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 := TspPaperInfo(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 TspSkinPrinterSetupDialog.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 TspPaperInfo(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 TspSkinPrinterSetupDialog.LoadPapersAndBins;
begin
  ClearPapersAndBins;
  GetPapers(Papers);
  GetBins(Bins);

  StopCheck := True;

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

  StopCheck := False;
end;

procedure TspSkinPrinterSetupDialog.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 TspSkinPrinterSetupDialog.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 TspSkinPrinterSetupDialog.RBPortraitClick(Sender: TObject);
begin
  Printer.Orientation := poPortrait;
  OrientationImage.Picture.Bitmap.LoadFromResourceName(HInstance, 'SP_PORTRAIT')
end;

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

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

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

function TspSkinPrinterSetupDialog.Execute;
var
  DSF: TspDynamicSkinForm;
  OldPrinterIndex: Integer;
  PrinterGroupBox: TspSkinGroupBox;
  PaperGroupBox: TspSkinGroupBox;
  OrientationGroupBox: TspSkinGroupBox;
  R: TRect;
  S1, S2, S3, S4: String;
  SkinMessage: TspSkinMessage;
  S: String;
begin
  if (Printer = nil) or (Printer.Printers.Count = 0)
  then
    begin
      SkinMessage := TspSkinMessage.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