psetup.pas

suite component ace report

function DuplexDtoW(D: TSctPaperDuplex): Integer;
begin
  case D of
    pdSimplex:         result := DMDUP_SIMPLEX;
    pdDuplexLongEdge:  result := DMDUP_VERTICAL;
    pdDuplexShortEdge: result := DMDUP_HORIZONTAL;
  else Result := DMDUP_SIMPLEX;
  end;
end;

function DuplexWtoD(D: Integer): TSctPaperDuplex;
begin
  case D of
    DMDUP_SIMPLEX:    result := pdSimplex;
    DMDUP_VERTICAL:   result := pdDuplexLongEdge;
    DMDUP_HORIZONTAL: result := pdDuplexShortEdge;
  else Result := pdSimplex;
  end;
end;

function PrintQualityDtoW(pq: TSctPrintQuality): Integer;
begin
  case pq of
    pqHigh:        result := Integer(DMRES_HIGH);
    pqMedium:      result := Integer(DMRES_MEDIUM);
    pqLow:         result := Integer(DMRES_LOW);
    pqDraft:       result := Integer(DMRES_DRAFT);
    pqCustom:      result := 0;
  else result := Integer(DMRES_HIGH);
  end;
end;

function PrintQualityWtoD(pq: Integer): TSctPrintQuality;
begin
  case pq of
    Integer(DMRES_HIGH):  result := pqHigh;
    Integer(DMRES_MEDIUM):        result := pqMedium;
    Integer(DMRES_LOW):           result := pqLow;
    Integer(DMRES_DRAFT): result := pqDraft;
  else result := pqCustom;
  end;
end;

function ColorDtoW(c: Boolean): Integer;
begin
  if c then result := DMCOLOR_COLOR
  else result := DMCOLOR_MONOCHROME;
end;
{  This isn't currently used by anything so it is commented out to suppress hints }
{function ColorWtoD(c: Integer): Boolean;
begin
  if c = DMCOLOR_COLOR then result := True
  else result := False;
end;}

function TrueTypeOptionDtoW(tt: TSctTrueTypeOption): Integer;
begin
  case tt of
    ttBitMap:   result := DMTT_BITMAP;
    ttDownLoad: result := DMTT_DOWNLOAD;
    ttSubDev:   result := DMTT_SUBDEV;
{$ifdef WIN32}
    ttDownloadOutline: Result := DMTT_DOWNLOAD_OUTLINE;
{$endif}
  else
    result := DMTT_DOWNLOAD;
  end;
end;

function TrueTypeOptionWtoD(tt: Integer): TSctTrueTypeOption;
begin
  case tt of
    DMTT_BITMAP:   result := ttBitMap;
    DMTT_DOWNLOAD: result := ttDownLoad;
    DMTT_SUBDEV:   result := ttSubDev;
{$ifdef WIN32}
    DMTT_DOWNLOAD_OUTLINE: Result := ttDownLoadOutline;
{$endif}
  else
    result := ttDownLoad;
  end;
end;


{ TSctPageSetup }
constructor TSctPageSetup.Create;
begin
  FAcePrinterSetup := TAcePrinterSetup.Create;
  FAcePrinterSetup.GetData;

  FUM := TSctUnitMaster.Create;
  FOrientation := poUseCurrent;
  FSize := psUseCurrent;
  FSource := ppsUseCurrent;
  FCopies := 1;
  FDuplex := pdUseCurrent;

  FHeight := 11;
  FWidth := 8.5;
  FPixelsPerUnit := 300;
  FPrintQuality := pqUseCurrent;
  FLeftMargin := 0.5;
  FTopMargin := 0.5;
  FBottomMargin := 0.5;
  FRightMargin := 0.5;
  FColor := True;
  FUnits := unitInches;
  FRangeStart := 0;
  FRangeEnd := 0;
  FDestination := destScreen;

  FAnyPrinters := False;
{  FPreviewStream := psFile;}

  FLeftPrint := 0;
  FRightPrint := 0;
  FBottomPrint := 0;
  FTopPrint := 0;

  FAdjustMargin := True;

  FPreviewSettings := TSctPreviewSettings.Create;
  FTextDriverCompatibility := False;
  FTrueTypeOption := ttUseCurrent;
  FDirectPrinter := False;
  FCollatedCopies := True;
  FFormName := '';

  StoreHW := False;
end;

destructor TSctPageSetup.Destroy;
begin
  if FAcePrinterSetup <> nil then FAcePrinterSetup.Free;
  if FUM <> nil Then FUM.Free;
  if FPreviewSettings <> nil then FPreviewSettings.Free;
  inherited destroy;
end;

function TSctPageSetup.getanyprinters: Boolean;
begin
  result := FAcePrinterSetup.PrinterCount > 0;
end;

procedure TSctPageSetup.Assign(Source: TPersistent);
var
  ps: TSctPageSetup;
begin
  if Source is TSctPageSetup Then
  begin
    ps := TSctPageSetup( Source );

    SetAcePrinterSetup(ps.AcePrinterSetup);

    FOrientation := ps.Orientation;
    FSize := ps.Size;
    FSource := ps.Source;
    FCopies := ps.Copies;
    FDuplex := ps.Duplex;
    FHeight := ps.Height;
    FWidth := ps.Width;
    FPrintQuality := ps.PrintQuality;
    FColor := ps.Color;

    FPixelsPerUnit := ps.PixelsPerUnit;
    FLeftMargin := ps.LeftMargin;
    FTopMargin := ps.TopMargin;
    FBottomMargin := ps.BottomMargin;
    FRightMargin := ps.RightMargin;
    FUnits := ps.Units;
    FRangeStart := ps.RangeStart;
    FRangeEnd := ps.RangeEnd;
    FDestination := ps.Destination;
{    FPreviewStream := ps.PreviewStream;}

    FCollatedCopies := ps.CollatedCopies;
    FDirectPrinter := ps.DirectPrinter;
    FFormName := ps.FormName;
    FPreviewSettings.Assign( ps.PreviewSettings );
    FPage := ps.Page;

  end else Inherited Assign(Source);
end;

procedure TSctPageSetup.DefineProperties(Filer: TFiler);
begin
  Filer.DefineProperty('LeftMargin', ReadLM, WriteLM, FLeftMargin <> 0.5);
  Filer.DefineProperty('RightMargin', ReadRM, WriteRM, FRightMargin <> 0.5);
  Filer.DefineProperty('TopMargin', ReadTM, WriteTM, FTopMargin <> 0.5);
  Filer.DefineProperty('BottomMargin', ReadBM, WriteBM, FBottomMargin <> 0.5);
  Filer.DefineProperty('PixelsPerUnit', ReadPPU, nil, False);
  inherited DefineProperties(Filer);
end;
procedure TSctPageSetup.ReadPPU( Reader: TReader);
begin
  Reader.ReadFloat;
end;

procedure TSctPageSetup.ReadLM( Reader: TReader);
begin
  FLeftMargin := Reader.ReadFloat;
end;
procedure TSctPageSetup.WriteLM( Writer: TWriter);
begin
  Writer.WriteFloat(FLeftMargin);
end;
procedure TSctPageSetup.ReadRM( Reader: TReader);
begin
  FRightMargin := Reader.ReadFloat;
end;
procedure TSctPageSetup.WriteRM( Writer: TWriter);
begin
  Writer.WriteFloat(FRightMargin);
end;
procedure TSctPageSetup.ReadTM( Reader: TReader);
begin
  FTopMargin := Reader.ReadFloat;
end;
procedure TSctPageSetup.WriteTM( Writer: TWriter);
begin
  Writer.WriteFloat(FTopMargin);
end;
procedure TSctPageSetup.ReadBM( Reader: TReader);
begin
  FBottomMargin := Reader.ReadFloat;
end;
procedure TSctPageSetup.WriteBM( Writer: TWriter);
begin
  Writer.WriteFloat(FBottomMargin);
end;

procedure TSctPageSetup.PageRefresh;
var
  I: Integer;
  pg: TSctPage;
  report: TSctReport;
begin
  if (Page <> nil) Then
  begin
    pg := TSctPage(Page);
    report := TSctReport(pg.Parent);
    if Not (csLoading in pg.ComponentState) And
           (csDesigning in pg.ComponentState) Then
    begin
      Report.PositionButtons;
      pg.ArrangeBands;
      pg.Invalidate;
      Report.TopRuler.Invalidate;
      Report.LeftRuler.Invalidate;

      for I := 0 to pg.bands.Count - 1 do
      begin
        TSctBand(pg.bands.items[I]).Invalidate;
      end;
    end;
  end;
end;

function TSctPageSetup.getprintheight: Double;
begin
  result := height - topmargin - bottommargin;
end;

function TSctPageSetup.getprintwidth: Double;
begin
  result := width - leftmargin - rightmargin;
end;

function TSctPageSetup.GetPixelsPerInch: Integer;
begin
  result := Round(FPixelsPerUnit * um.UnitToUnit(1, FUnits, unitInches ));
end;

procedure TSctPageSetup.SetOrientation(O: TSctPaperOrientation);
var
  v: Double;
begin
  if FOrientation <> O Then
  begin
    if FSize <> psCustom then
    begin
      FHeight := um.Into(FAcePrinterSetup.Length, units);
      FWidth := um.Into(FAcePrinterSetup.Width, units);
      if (O <> poUseCurrent) And (OrientWtoD(FAcePrinterSetup.Orientation) <> O) then
      begin
        v := FWidth;
        FWidth := FHeight;
        FHeight := v;
      end;
    end;
    FOrientation := O;
    PageRefresh;
  end;
end;

procedure TSctPageSetup.SetSize( S: TSctPaperSize);
var
  SVal: Double;
begin
  if (FSize <> S) Then
  begin
    FSize := S;
    case FSize of
      psLetter,psLETTERSMALL:
      begin
        FWidth := um.InTo(8.5, units);
        FHeight := um.InTo(11, units);
      end;
      psExecutive:
      begin
        FWidth := um.InTo(7.25, units);
        FHeight := um.InTo(10.5, units);
      end;
      psLegal:
      begin
        FWidth := um.InTo(8.5, units);
        FHeight := um.InTo(14, units);
      end;
      psA4:
      begin
        FWidth := um.MMTo(210, units);
        FHeight := um.MMTo(297, units);
      end;
      psCustom:
      begin
      end;
      psTABLOID:
      begin
        FWidth := um.InTo(11, units);
        FHeight := um.InTo(17, units);
      end;
      psLEDGER:
      begin
        FWidth := um.InTo(17, units);
        FHeight := um.InTo(11, units);
      end;
      psSTATEMENT:
      begin
        FWidth := um.InTo(5.5, units);
        FHeight := um.InTo(8.5, units);
      end;
      psA3:
      begin
        FWidth := um.MMTo(297, units);
        FHeight := um.MMTo(420, units);
      end;
      psA4SMALL:
      begin
        FWidth := um.MMTo(210, units);
        FHeight := um.MMTo(297, units);
      end;
      psA5:
      begin
        FWidth := um.MMTo(148, units);
        FHeight := um.MMTo(210, units);
      end;
      psB4:
      begin
        FWidth := um.MMTo(250, units);
        FHeight := um.MMTo(354, units);
      end;
      psB5:
      begin
        FWidth := um.MMTo(182, units);
        FHeight := um.MMTo(257, units);
      end;
      psFOLIO:
      begin
        FWidth := um.InTo(8.5, units);
        FHeight := um.InTo(13, units);
      end;
      psQUARTO:
      begin
        FWidth := um.MMTo(215, units);