acepset.pas

suite component ace report

  Spot: Integer;
begin
  Result := nil;
  Spot := 0;
  while (Result = nil) And (Spot < FBinList.Count) do
  begin
    if TAceBinInfo(FBinList.Items[Spot]).binNumber = BinNum then
      Result := TAceBinInfo(FBinList.Items[Spot])
    else Inc(Spot);
  end;
end;
{function TAcePrinterInfo.GetBinByName(BinName: String): TAceBinInfo;
var
  Spot: Integer;
begin
  Result := nil;
  Spot := 0;
  while (Result = nil) And (Spot < FBinList.Count) do
  begin
    if TAceBinInfo(FBinList.Items[Spot]).binName = BinName then
      Result := TAceBinInfo(FBinList.Items[Spot])
    else Inc(Spot);
  end;
end;
 }
function TAcePrinterInfo.FindBinByNum(BinNum: Integer): TAceBinInfo;
var
  BinName: String;
begin
  Result := GetBinByNum(BinNum);
  if Result = nil then
  begin
    BinName := GetBinName(BinNum);
    if BinName <> '' then Result := FindBinByName(BinName);
  end;
end;

function TAcePrinterInfo.FindBinByName(BinName: String): TAceBinInfo;
var
  Spot: Integer;
  BinInfo: TAceBinInfo;
begin
  Result := nil;
  Spot := 0;
  while (Result = nil) And (Spot < FBinList.Count) do
  begin
    BinInfo := TAceBinInfo(FBinList.Items[Spot]);
    if CompareStrings(BinName, BinInfo.BinName) then Result := BinInfo
    else Inc(Spot);
  end;
end;




{ TAcePrinterSettings }
constructor TAcePrinterSettings.Create;
var
  Spot: Integer;
begin
  FPropCount := 14;
  for Spot := 0 to FPropCount - 2 do FPSProperties[Spot] := 0;
  for Spot := 0 to FPropCount - 1 do FPrintSet[Spot] := False;

  FFormName := '';
  FCustomPaperSize := False;
end;

destructor TAcePrinterSettings.Destroy;
begin
  inherited Destroy;
end;

procedure TAcePrinterSettings.Assign( Source: TObject);
var
  aps: TAcePrinterSettings;
  Spot: Integer;
begin
  if Source is TAcePrinterSettings then
  begin
    aps := TAcePrinterSettings(Source);
    for Spot := 0 to FPropCount - 2 do FPSProperties[Spot] := aps.FPSProperties[Spot];
    for Spot := 0 to FPropCount - 1 do FPrintSet[Spot] := aps.FPrintSet[Spot];
    FFormName := aps.FFormName;
    FCustomPaperSize := aps.CustomPaperSize;
  end;
end;

function TAcePrinterSettings.GetPSProperty(Index: Integer): Integer;
begin
  Result := FPSProperties[Index];
end;

procedure TAcePrinterSettings.SetPSProperty(Index: Integer; Value: Integer);
begin
  if (FPSProperties[Index] <> Value) then FPSProperties[Index] := Value;
  FPrintSet[Index] := True;
end;

procedure TAcePrinterSettings.SetFormName(Value: String);
begin
  FFormName := Value;
  FPrintSet[Ord(apsFormName)] := True;
end;

procedure TAcePrinterSettings.GetValues;
var
  AcePaper: TAcePaper;
  FPrinterInfo: TAcePrinterInfo;
begin
  FPrinterInfo := TAcePrinterInfo.Create;
  try
    FPrinterInfo.GetDeviceMode(False);
    if FPrinterInfo.DeviceMode <> nil then
    begin
      AcePaper := nil;
      with FPrinterInfo.DeviceMode^ do
      begin
        if (DM_ORIENTATION and dmFields) = DM_ORIENTATION then SetPSProperty(ord(apsOrientation), dmOrientation);
        if (DM_PAPERSIZE and dmFields) = DM_PAPERSIZE then
        begin
          SetPSProperty(ord(apsPaperSize),dmPaperSize);
          AcePaper := FPrinterInfo.GetPaperByNum(dmPaperSize);
        end;
        {$ifdef WIN32}
        if (DM_FORMNAME and dmFields) = DM_FORMNAME then
        begin
          FFormName := StrPas(dmFormName);
          AcePaper := FPrinterInfo.GetPaperByName(FFormName);
        end;
        {$endif}

        if (DM_SCALE and dmFields) = DM_SCALE then SetPSProperty(ord(apsScale), dmScale);
        if (DM_COPIES and dmFields) = DM_COPIES then SetPSProperty(ord(apsCopies), dmCopies);
        if (DM_DEFAULTSOURCE and dmFields) = DM_DEFAULTSOURCE then SetPSProperty(ord(apsDefaultSource), dmDefaultSource);
        if (DM_PRINTQUALITY and dmFields) = DM_PRINTQUALITY then SetPSProperty(ord(apsPrintQuality), dmPrintQuality);
        if (DM_COLOR and dmFields) = DM_COLOR then SetPSProperty(ord(apsColor), dmColor);
        if (DM_DUPLEX and dmFields) = DM_DUPLEX then SetPSProperty(ord(apsDuplex), dmDuplex);
        if (DM_YRESOLUTION and dmFields) = DM_YRESOLUTION then SetPSProperty(ord(apsYResolution), dmYResolution);
        if (DM_TTOPTION and dmFields) = DM_TTOPTION then SetPSProperty(ord(apsTTOption), dmTTOption);

        {$ifdef WIN32}
        { don't believe these exists in win3.1 }
        if (DM_COLLATE and dmFields) = DM_COLLATE then SetPSProperty(ord(apsCollate), dmCollate);
        {$endif}

        if AcePaper <> nil then
        begin
          if AcePaper.PaperNum = DMPAPER_USER then
          begin
            CustomPaperSize := True;
            if (DM_PAPERLENGTH and dmFields) = DM_PAPERLENGTH then SetPSProperty(ord(apsPaperLength), dmPaperLength);
            if (DM_PAPERWIDTH and dmFields) = DM_PAPERWIDTH then SetPSProperty(ord(apsPaperWidth), dmPaperWidth);
          end else
          begin
            if Orientation = DMORIENT_PORTRAIT then
            begin
              SetPSProperty(ord(apsPaperLength), AcePaper.PaperSize.y);
              SetPSProperty(ord(apsPaperWidth), AcePaper.PaperSize.x);
            end else
            begin
              SetPSProperty(ord(apsPaperLength), AcePaper.PaperSize.x);
              SetPSProperty(ord(apsPaperWidth), AcePaper.PaperSize.y);
            end;
          end;
        end;
      end;  
    end;
  finally
    FPrinterInfo.ReleaseDeviceMode;
    FPrinterInfo.Free;
  end;
end;

procedure TAcePrinterSettings.SetValues;
var
  Good: Boolean;
  Value: Integer;
  AcePaper: TAcePaper;
  BinInfo: TAceBinInfo;

  StockPen, StockBrush, StockFont: THandle;
  SFont, SPen, SBrush: THandle;
  Current: TAcePrinterSettings;
  MyForm: String;
  FPrinterInfo: TAcePrinterInfo;

  function SetProp(ps: TAcePrintSettings; var MyValue: Integer): boolean;
  begin
    Result := False;
    if FPrintSet[ord(ps)] then
    begin
      MyValue := FPSProperties[ord(ps)];
      Result := True;
    end else
    begin
      if Current.FPrintSet[ord(ps)] then
      begin
        MyValue := Current.FPSProperties[ord(ps)];
        Result := True;
      end;
    end;
  end;
begin
  Good := True;
  if Good then
  begin
    FPrinterInfo := TAcePrinterInfo.Create;
    try
      FPrinterInfo.GetDeviceMode(True);
      if FPrinterInfo.DeviceMode <> nil then
      begin
        Current := FPrinterInfo.FPrinterSettings;
        with FPrinterInfo.DeviceMode^ do
        begin
          { ORIENTATION }
          if SetProp(apsOrientation, Value) then
          begin
            if (Value = DMORIENT_LANDSCAPE) or (Value = DMORIENT_PORTRAIT) then
            begin
              dmFields := dmFields or DM_ORIENTATION;
              dmOrientation := Value;
            end;
          end;

{          if Current.FPrintSet[ord(apsFormName)] or Current.FPrintSet[ord(apsPaperSize)] then}
          if FPrintSet[ord(apsFormName)] or FPrintSet[ord(apsPaperSize)] then
          begin
            { FormName AND PaperSize}
            AcePaper := nil;
            if FPrintSet[ord(apsFormName)] then
            begin
              MyForm := FFormName;
              if (MyForm <> '') then
              begin
                AcePaper := FPrinterInfo.GetPaperByName(MyForm)
              end;
            end else MyForm := Current.FFormName;

            if (AcePaper = nil) then
            begin
              if SetProp(apsPaperSize, Value) then AcePaper := FPrinterInfo.GetPaperByNum(Value);
            end;
            if (AcePaper = nil) And SetProp(apsPaperSize, Value) then
            begin
              AcePaper := FPrinterInfo.FindPaperByName(FPrinterInfo.GetPaperName(Value));
            end;
            if (AcePaper = nil) And (MyForm <> '') then
            begin
              AcePaper := FPrinterInfo.GetPaperByName(MyForm)
            end;

            dmFields := dmFields - (dmFields And DM_PAPERSIZE);
            {$ifdef WIN32}
            dmFields := dmFields - (dmFields And DM_FORMNAME);
            {$endif}

            if AcePaper <> nil then
            begin
              if FPrintSet[ord(apsFormName)] And (AceWinVersion = awvWinNT) then
              begin
              {$ifdef WIN32}
                dmFields := dmFields or DM_FORMNAME;
                StrPCopy(dmFormName, AcePaper.PaperName);
                dmFields := dmFields or DM_PAPERSIZE;
                dmPaperSize := AcePaper.PaperNum;
              {$endif}
              end else
              begin
                dmFields := dmFields or DM_PAPERSIZE;
                dmPaperSize := AcePaper.PaperNum;
              end;

              { custom size }
              if (AcePaper.PaperNum = DMPAPER_USER) or CustomPaperSize then
              begin
                if SetProp(apsPaperLength, Value) then
                begin
                  dmFields := dmFields or DM_PAPERLENGTH;
                  dmPaperLength := Value;
                end;
                if SetProp(apsPaperWidth, Value) then
                begin
                  dmFields := dmFields or DM_PAPERWIDTH;
                  dmPaperWidth := Value;
                end;
              end;
            end;
          end;

          { SCALE }
          if SetProp(apsScale, Value) then
          begin
            dmFields := dmFields or DM_SCALE;
            dmScale := Value;
          end;
          { COPIES }
          if SetProp(apsCopies, Value) then
          begin
            dmFields := dmFields or DM_COPIES;
            dmCopies := Value;
          end;
          { SOURCE }
          if SetProp(apsDefaultSource, Value) then
          begin
            BinInfo := FPrinterInfo.FindBinByNum(Value);
            if BinInfo <> nil then
            begin
              dmFields := dmFields or DM_DEFAULTSOURCE;
              dmDefaultSource := BinInfo.BinNumber;
            end;
          end;
          { PRINT QUALITY }
          if SetProp(apsPrintQuality, Value) then
          begin
            if (Value = Integer(DMRES_HIGH)) or (Value = Integer(DMRES_MEDIUM)) or
               (Value = Integer(DMRES_LOW)) or (Value = Integer(DMRES_DRAFT)) then
            begin
              dmFields := dmFields or DM_PRINTQUALITY;
              dmPrintQuality := Value;
            end;
          end;
          { COLOR }
          if SetProp(apsColor, Value) then
          begin
            if (Value = DMCOLOR_COLOR) or (Value = DMCOLOR_MONOCHROME) then
            begin
              dmFields := dmFields or DM_COLOR;
              dmColor := Value;
            end;
          end;
          { DUPLEX }
          if SetProp(apsDuplex, Value) then
          begin
{            if (Value = DMDUP_SIMPLEX) or (Value = DMDUP_HORIZONTAL) or
               (Value = DMDUP_VERTICAL) then
            begin}
              dmFields := dmFields or DM_DUPLEX;
              dmDuplex := Value;
{            end;}
          end;
          { TTOPTION }
          if SetProp(apsTTOption, Value) then
          begin
            { See if true type option exists on this device }
            if FPrinterInfo.TrueType > 0 then
            begin
              dmFields := dmFields or DM_TTOPTION;
              dmTTOption := Value;
            end;
          end;
          { COLLATE }
          {$ifdef WIN32}
          if SetProp(apsCollate, Value) then
          begin
            dmFields := dmFields or DM_COLLATE;
            dmCollate := Value;
          end;
          {$endif}
        end;
      end;


      { Only needs to be called if changing printer settings in the middle
        of a print job. }
      if Printers.Printer.Printing then
      begin
        { When resetting a DC you can only have stock objects selected }
        StockPen := GetStockObject(BLACK_PEN);
        StockBrush := GetStockObject(HOLLOW_BRUSH);
        StockFont := GetStockObject(SYSTEM_FONT);
        SPen := SelectObject(FPrinterInfo.Handle,StockPen);
        SBrush := SelectObject(FPrinterInfo.Handle,StockBrush);
        SFont := SelectObject(FPrinterInfo.Handle,StockFont);


        {$ifdef WIN32}
        ResetDC(FPrinterInfo.Handle, FPrinterInfo.DeviceMode^);
        {$else}
        ResetDC(FPrinterInfo.Handle, FPrinterInfo.DeviceMode);
        {$endif}

        SelectObject(FPrinterInfo.Handle,SPen);
        SelectObject(FPrinterInfo.Handle,SBrush);
        SelectObject(FPrinterInfo.Handle,SFont);
      end;
    finally
      FPrinterInfo.ReleaseDeviceMode;
      FPrinterInfo.Free;
    end;
  end;
end;




procedure ExitAcePSetUnit; far;
begin
  if PrinterList <> nil then
  begin
    ClearList(PrinterList);
    PrinterList.Free;
    PrinterList := nil;
  end;
end;

Initialization

  InAssignInfo := False;
  PrinterList := TList.Create;

{$IFNDEF WIN32}
  AddExitProc( ExitAcePSetUnit );
{$ELSE}
finalization
  ExitAcePSetUnit;
{$endif}


end.