sctutil.pas

suite component ace report

unit SctUtil;

{ ----------------------------------------------------------------
  Ace Reporter
  Copyright 1995-1998 SCT Associates, Inc.
  Written by Kevin Maher, Steve Tyrakowski
  ---------------------------------------------------------------- }

interface
{$I ace.inc}
uses
{$IFDEF WIN32}
  windows,
{$ELSE}
  wintypes, winprocs,
{$ENDIF}
 classes, sysutils,extctrls, controls;


function SctStripFirst( const Str: String): String;
function SctMakeValidIDent(const Str: String; StripLeading: Boolean): String;
function SctAutoSetComponentName( comp: TComponent; const nm: string; StripLeading: Boolean): Boolean;
function SctSetComponentName(comp: TComponent; const nm: string): Boolean;
function SctEmpty(const S: String): Boolean;
function SctRightTrim(const S: String): String;



type


{ TSctUnits }
TSctUnits = (unitInches, unitMiliMeters, unitCentiMeters);

{ TSctUnitMaster }
TSctUnitMaster = class(TObject)
private
protected
public
  function UnitToUnit(Value: Double; From: TSctUnits; UTo: TSctUnits): Double;
  function ToIn(Value: Double; from: TSctUnits): Double; virtual;
  function ToMM(Value: Double; from: TSctUnits): Double; virtual;
  function ToCM(Value: Double; from: TSctUnits): Double; virtual;
  function InTo(Value: Double; uto: TSctUnits): Double; virtual;
  function MMTo(Value: Double; uto: TSctUnits): Double; virtual;
  function CMTo(Value: Double; uto: TSctUnits): Double; virtual;
end;

{ TSctRuler }
  TSctRuler = class(TCustomPanel)
  private
    FVertical: Boolean;
    FPixelsPerInch: Integer;
    FUnits: TSctUnits;
    FUM: TSctUnitMaster;
    FStartPixels: Integer;
    FShowCrossHair: Boolean;
    FCrossHairPosition: Integer;
  protected
    procedure Paint; override;
    procedure ChangeScale(M, D: Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Vertical: Boolean read FVertical write FVertical;
    property PixelsPerInch: Integer read FPixelsPerInch write FPixelsPerInch;
    property Units: TSctUnits read FUnits write FUnits;
    property Um: TSctUnitMaster read FUm write FUm;
    property StartPixels: Integer read FStartPixels write FStartPixels;
    property ShowCrossHair: Boolean read FShowCrossHair write FShowCrossHair;
    property CrossHairPosition: Integer read FCrossHairPosition write FCrossHairPosition;
    procedure UpdateHair(Position: Integer);
  end;

{ TSctRulerContainer }

  TSctRulerContainer = class(TCustomPanel)
  private
    FRulers: TList;
    FShowCrossHair: Boolean;
    FCrossHairPosition: Integer;
  protected
    procedure ChangeScale(M, D: Integer); override;
    function GetPage: TComponent;
    property Page: TComponent read GetPage;
    procedure SetPixelsPerInch(ppi: Integer);
    procedure SetUnits( u: TSctUnits);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure UpdateRulers;
    property PixelsPerInch: Integer write SetPixelsPerInch;
    property Units: TSctUnits write SetUnits;
    property ShowCrossHair: Boolean read FShowCrossHair write FShowCrossHair;
    property CrossHairPosition: Integer read FCrossHairPosition write FCrossHairPosition;
    procedure UpdateHair(Position: Integer);
  end;

function AceBandCheck(Page: TObject; SubBand, Creating: Boolean): Boolean;


implementation

uses forms,graphics, dialogs, sctvar, sctrep, aceutil;

function AceBandCheck(Page: TObject; SubBand, Creating: Boolean): Boolean;
var
  av: TAceVersionSet;
  Spot, SubCount, SubDataCount, SubLimit, SubDataLimit: Integer;
  pg: TSctGroupPage;
begin
  Result := True;
  pg := TSctGroupPage(Page);
  av := AceVersionSet;
  if (avtAceTrial in av) then
  begin
    SubCount := 0;
    SubDataCount := 0;
    for Spot := 0 to pg.Bands.Count - 1 do
    begin
      if TSctBand(pg.Bands[Spot]) is TSctSubBand then Inc(SubCount)
      else if TSctBand(pg.Bands[Spot]) is TSctSubDataBand then Inc(SubDataCount);
    end;
    if Creating then
    begin
      SubLimit := 5;
      SubDataLimit := 2;
    end else
    begin
      SubLimit := 6;
      SubDataLimit := 3;
    end;
    if ((SubCount > SubLimit) And SubBand)
       or ((SubDataCount > SubDataLimit) And Not SubBand) then
    begin
      ShowMessage('You have exceeded the six SubBand or 3 SubDataBand limit of '
        + 'this version.  Check the help for upgrade information.');
      Result := False;
    end;
  end;
end;

{ SctStripFirst }
function SctStripFirst( const Str: String): String;
var
  len: Integer;
  S: String;
begin
  Len := Length(Str);
  S := Str;
  { strip out T or TSCT, if its in front }
  if (len > 4) And (CompareText('TSCT', Copy(S, 0, 4)) = 0) then
  begin
    S := Copy(S, 5, len); { strip out TSCT }
  end else if (len > 1) And ((S[1] = 'T') or (S[1] = 't')) then
  begin
    S := Copy(S, 2, len); { strip out T }
  end;
  result := S;
end;

{ SctMakeValidIDent }
function SctMakeValidIDent(const Str: String; StripLeading: Boolean): String;
type
  idrange = set of '0'..'z';
const
  valid: idrange = ['_','0'..'9','A'..'Z','a'..'z'];
  firstvalid: idrange = ['_', 'A'..'Z', 'a'..'z'];
var
  len: Integer;
  S: String;
  spot: Integer;
begin
  if StripLeading then S := SctStripFirst(Str)
  else S := Str;
  len := Length(S);
  if len > 0 then
  begin
    { first character must be a letter of an underscore }
    spot := 1;
    if Not (S[spot] in firstvalid) Then S[spot] := '_';
    spot := spot + 1;
    while spot <= len do
    begin
      { rest of characters must be a letter, underscore or digit}
      if Not (S[spot] in valid) Then
      begin
        { change to a underscore }
        S[spot] := '_';
      end;
      spot := spot + 1;
    end;
  end;

  Result := S;
end;

{ SctAutoSetComponentName }
function SctAutoSetComponentName( comp: TComponent; const nm: string; StripLeading: Boolean): Boolean;
var
  S, S2: String;
  num: Integer;
begin
  S := SctMakeValidIdent(nm, StripLeading);
  if IsValidIdent( S ) And (Not sctEmpty( S )) then
  begin
    S2 := S;
    num := 1;
    while not SctSetComponentName(comp, S2) do
    begin
      S2 := S + IntToStr(num);
      Inc(num);
    end;
    result := True;
  end else result := False;
end;

{ SctSetComponentName }
function SctSetComponentName(comp: TComponent; const nm: string): Boolean;
begin
  Result := False;
  if (not sctEmpty(nm)) and IsValidIdent(nm) Then
    begin
      try
       comp.Name := nm;
       Result := True;
      except on EComponentError do {ignore rename error};
      end;
    end;
end;

{ SctEmpty }
function SctEmpty(const S: String): Boolean;
var
  pos: Integer;
begin
  result := True;
  pos := Length(S);
  while ( (Pos > 0) And result) Do
  begin
    if Copy(S, Pos, 1) <> ' ' Then result := False;
    dec(pos);
  end;
end;

function SctRightTrim(const S: String): String;
var
  len: Integer;
  pos: byte;
  Done: Boolean;
begin
  len := Length(S);
  Done := False;
  pos := len;
  while (pos > 0) And Not Done do
  begin
    if Copy(s,pos,1) <> Chr(32) then done := true
    else pos := pos - 1;
  end;
  result := Copy(S, 0, pos);
end;


{ TSctUnitMaster }
function TSctUnitMaster.UnittoUnit(Value: Double; from: TSctUnits; uto: TSctUnits): Double;
begin
  case from of
    unitInches: result := InTo(Value, uto);
    unitMiliMeters: result := MMTo(Value, uto);
    unitCentimeters: result := CMTo(Value, uto);
  else result := 0;
  end;
end;

function TSctUnitMaster.ToIn(Value: Double; from: TSctUnits): Double;
begin
  case from of
    unitInches: result := Value;
    unitMiliMeters: result := Value / 25.4;
    unitCentimeters: result := Value / 2.54;
  else result := 0;
  end;
end;

function TSctUnitMaster.ToMM(Value: Double; from: TSctUnits): Double;
begin
  case from of
    unitInches: result := Value * 25.4;
    unitMiliMeters: result := Value;
    unitCentimeters: result := Value * 10;
  else result := 0;
  end;
end;

function TSctUnitMaster.ToCM(Value: Double; from: TSctUnits): Double;
begin
  case from of
    unitInches: result := Value * 2.54;
    unitMiliMeters: result := Value / 10;
    unitCentimeters: result := Value;
  else result := 0;
  end;
end;

function TSctUnitMaster.InTo(Value: Double; uto: TSctUnits): Double;
begin
  case uto of
    unitInches: result := Value;
    unitMiliMeters: result := Value * 25.4;
    unitCentimeters: result := Value * 2.54;
  else result := 0;
  end;
end;

function TSctUnitMaster.MMTo(Value: Double; uto: TSctUnits): Double;
begin
  case uto of
    unitInches: result := Value / 25.4;
    unitMiliMeters: result := Value;
    unitCentimeters: result := Value / 10;