acediag.pas

suite component ace report

  begin
    BlankLabels.DataIsFinished := True;
    BlankLabSum.AsString := 'There are no labels to check.';
  end;
end;

procedure TAceDiagForm.BlankLabelsDataSkip(Sender: TObject);
begin
  Inc(bl);
  if RPage.Labels <> nil then
  begin
    if bl >= RPage.Labels.Count then
    BlankLabels.DataIsFinished := True;
  end else
  BlankLabels.DataIsFinished := True;
end;

procedure TAceDiagForm.BlankLabelsDataFilter(Sender: TObject;
  var Result: Boolean);
var
  Lab: TSctLabel;
begin
  if RPage.Labels <> nil then
  begin
    Lab := TSctLabel(RPage.Labels[bl]);

    if lab is TSctVarLabel then
    begin
      if ((TSctVarLabel(lab).Variable = nil) and
          (TSctVarLabel(lab).Caption = '') and
          (TSctVarLabel(lab).Lines.Count = 0)) then
      begin
        BlanklabVar.AsString := TSctVarLabel(lab).Name
        + ' has no variable, its lines property is nil, and its'
        + ' caption is blank. ';
        BlanklabError := True;
        Result := True;
      end else if
       ((TSctVarLabel(lab).Variable = nil) and
       (TSctVarLabel(lab).Caption <> '') and
       (TSctVarLabel(lab).Lines.Count <> 0)) then
      begin
        BlankVar.AsString := TSctVarLabel(lab).Name
        + ' has its caption and its Lines property set. The'
        + ' Lines property will not be displayed.';
        BlankLabError := True;
        Result := True;
      end else if
       ((TSctVarLabel(lab).Variable <> nil) and
       (TSctVarLabel(lab).Caption = '') and
       (TSctVarLabel(lab).Lines.Count <> 0)) then
      begin
        BlanklabVar.AsString := TSctVarLabel(lab).Name
        + ' has its lines property and its variable set.'
        + ' The caption property will not be displayed. ';
        BlanklabError := True;
        Result := True;
      end else if
       ((TSctVarLabel(lab).Variable <> nil) and
       (TSctVarLabel(lab).Caption <> '') and
       (TSctVarLabel(lab).Lines.Count = 0)) then
      begin
         BlanklabVar.AsString := TSctVarLabel(lab).Name
        + ' has its variable and its caption set.'
        + ' The caption property will not be displayed. ';
        BlanklabError := True;
        Result := True;
      end else if
        ((TSctVarLabel(lab).Variable <> nil) and
        (TSctVarLabel(lab).Caption <> '') and
        (TSctVarLabel(lab).Lines.Count <> 0)) then
      begin
        BlanklabVar.AsString := TSctVarLabel(lab).Name
        + ' has its variable, its caption, and its Lines properties set.'
        + ' The caption and Lines properties will not be displayed. ';
        BlanklabError := True;
        Result := True;
      end
    else Result := False;
  end else if lab is TSctCheckLabel then
  begin
    if TSctCheckLabel(lab).Variable = nil then
    begin
      BlanklabVar.AsString := 'The TSctCheckLabel ' +
      TSctCheckLabel(lab).Name + ' has no variable';
      BlanklabError := True;
      Result := True;
    end else Result := False;
  end else if lab is TSctBarCodeLabel then
    begin
      if TSctBarCodeLabel(lab).Variable = nil then
      begin
        BlanklabVar.AsString := 'The TSctBarCodeLabel ' +
        TSctBarCodeLabel(lab).Name + ' has no variable';
        BlanklabError := True;
        Result := True;
      end else Result := False;
    end else if lab is TSctImageLabel then
    begin
      if (TSctImageLabel(lab).Variable = nil) And (TSctImageLabel(lab).Picture.Graphic = nil) then
      begin
        BlanklabVar.AsString := 'The TSctImageLabel '
        + TSctImageLabel(lab).Name + ' has no variable or picture filled in.';
        BlanklabError := True;
        Result := True;
      end else Result := False;
    end else if lab is TSctTotalVarLabel then
    begin
      if TSctTotalVarLabel(lab).TotalVariable = nil then
      begin
        BlanklabVar.AsString := TSctTotalVarLabel(lab).Name + ' has no variable';
        BlanklabError := True;
        Result := True;
      end else Result := False;
    end;
  end;
end;
procedure TAceDiagForm.MiscDataStart(Sender: TObject);
begin
  m := 0;
  if RPage.Labels = nil then
  begin
    Misc.DataIsFinished := True;
    MiscSumVar.AsString := 'There are no Labels to check.';
  end;
end;

procedure TAceDiagForm.MiscDataSkip(Sender: TObject);
begin
  Inc(m);
  if RPage.Labels <> nil then
  begin
    if m >= RPage.Labels.Count then
    Misc.DataIsFinished := True;
  end;
end;

procedure WriteString(Stream: TStream; Text: String);
var
  Len: LongInt;
begin
  Len := Length(Text);
  if Len > 0 then
  begin
    {$ifdef WIN32}
    Stream.WriteBuffer(Pointer(Text)^, Len);
    {$else}
    Stream.WriteBuffer(Text[1], Len);
    {$endif}
  end;
end;


procedure TAceDiagForm.MiscDataFilter(Sender: TObject; var Result: Boolean);
var
  Lab: TSctLabel;
  Str: TStream;

  procedure FillColorError;
  begin
    WriteString(Str,'You have changed the color of '+lab.Name
        + ' from its default, but you have left its transparent property to True.  ');
    WriteString(Str,'Transparent must be set to false in order to change the color of a label,'
        + ' otherwise the label will be the same color as whatever is underneath it.');

    MiscVar.AsStream := Str;
    MiscError := True;
    Result := True;
  end;
begin
  if RPage.Labels <> nil then
  begin
    Str := TMemoryStream.Create;
    lab := TSctLabel(RPage.Labels[m]);

    if ((lab.Stretch) and not(TSctBand(lab.Parent).Stretch)) then
    begin
      WriteString(Str, 'The label ' + lab.Name + ' has its Stretch property '
        + ' set to True, but the Stretch property of its band is false.  ');
      WriteString(Str, ' This may be intentional, but be sure that if '+ lab.Name
        + ' needs to stretch, that '+ lab.Parent.Name + ' is tall enough to allow'
        + ' it to grow as tall as it needs to be.');

      MiscVar.AsStream := Str;
      MiscError := True;
      Result := True;
    end;

    if (lab.WrapText) and not (lab.Stretch) then
    begin
      WriteString(Str, 'The label ' + lab.Name + ' has its Stretch property '
      + ' set to false, but its WrapText property is set to True. This means that ');
      WriteString(Str, lab.Name + ' will wrap text to a new line if necessary, '
      + 'but it will not grow in height in order to do so. You may have done this ');
      WriteString(Str, 'intentionally, but be careful to make sure that either'
      + lab.Name + '''s height is big enough to accomodate any possible caption ');
      WriteString(Str, 'it may get, or its Stretch property gets set to True.');
      MiscVar.AsStream := Str;
      MiscError := True;
      Result := True;
    end;

    if (lab.Stretch) and not (lab.WrapText) then
    begin
      WriteString(Str, 'The label ' + lab.Name + ' has its Stretch property'
      + ' set to true, but its WrapText property is set to false. This means that ');
      WriteString(Str, lab.Name + ' will grow in height if necessary, but it will not wrap text'
      + ', so it probably won''t have a chance to grow in height. This probably is not');
      WriteString(Str, ' the result you planned on. If you want the label to wrap text when necessary,'
      + ' set Stretch to true, and WrapText to true.');
      MiscVar.AsStream := Str;
      MiscError := True;
      Result := True;
    end;


    if lab is TSctVarLabel then
    begin
      if (TSctVarLabel(lab).Color <> clWhite) and TSctVarLabel(lab).Transparent = True then
      begin
        FillColorError;
      end else Result := False;

      if TSctVarLabel(lab).Variable <> nil then
      begin
        if TSctVarLabel(lab).Variable.DataType = dTypeMemo then
        begin
          if (not lab.WrapText) or (not lab.Stretch) then
          begin
            WriteString(Str, TSctVarLabel(lab).Name
            + '''s variable, ' + TSctVar(TSctVarLabel(lab).Variable).Name);
            WriteString(Str, ' is of type dTypeMemo, but '+ TSctVarLabel(lab).Name
            + ' has its WrapText or Stretch property set to false.');
            WriteString(Str, ' Both of these properties should probably be set to true.'
            + ' Otherwise, the label will not wrap or move text down to the ');
            WriteString(Str, ' next line when text goes beyond the end of the label.');
            MiscVar.AsStream := Str;
            MiscError := True;
            Result := True;
          end else Result := False;
        end;
      end;
    end else if (lab is TSctCheckLabel) or (lab is TSctBarCodeLabel)
             or (lab is TSctTVLabel) then
    begin
      if (lab.Color <> clWhite) and (lab.Transparent = True) then FillColorError
      else Result := False;
    end else Result := False;

    if not MiscError then  MiscSumVar.AsString := 'No miscellaneous errors to report.'
    else
    begin
      MiscSumVar.AsString := 'The above errors effect the appearance of your'
      + ' report, and should probably be fixed.';
    end;

    Str.Free;
  end;


end;

function TAceDiagForm.GetDSG(DS: TDataSource): TSctDataSourceGuide;
var
  i: Integer;
begin
  Result := nil;
  if RPage.DataSourceList <> nil then
  begin
    i := 0;
    while (Result = nil) And (i < RPage.DataSourceList.Count) do
    begin
      if TSctDataSourceGuide(RPage.DataSourceList[i]).DataSource = DS then
      begin
        Result := TSctDataSourceGuide(RPage.DataSourceList[i]);
      end else Inc(i);
    end;
  end;
end;

procedure TAceDiagForm.blanklabsumGetData(oVar: TSctVar);
var
  Stream: TMemoryStream;

  procedure AddLine(S: String);
  begin
    {$ifdef WIN32}
    Stream.WriteBuffer(Pointer(S)^, Length(S));
    {$else}
    Stream.WriteBuffer(S[1], Length(S));
    {$endif}
  end;
begin
  if BlanklabError then
  begin
    Stream := TMemoryStream.Create;
    AddLine('The above errors were caused by varlabels having both nil variables'
         +' and nil Lines properties. The new VarLabels have both of these'
         +' properties, and one of the two should not be nil.');

    AddLine('  The new VarLabels can be used to display their Lines property much'
         +' like The old TextLabels used to, or they can also be set to display'
         +' variables, just like VarLabels used to. Make sure that either the');

    AddLine(' varlabels get valid variables, or they get a non-nil value for their'
         +' lines property before they print.');
    oVar.AsStream := Stream;
    Stream.Free;
  end else
    BlankLabSum.AsString := 'All VarLabels Have valid variables. No errors to report.';
end;

end.