fr_utils.pas

FASTREPORT报表工具,可以迅速制作报表.

          begin
            Result := c;
            Exit;
          end;
        end
        else
        begin
          Result := c;
          Exit;
        end;
    end;
  end;
end;

function frGetDataSet(ComplexName: String): TfrTDataSet;
begin
  Result := TfrTDataSet(frFindComponent(CurReport.Owner, ComplexName));
end;

function frGetFieldValue(F: TfrTField): Variant;
begin
{$IFDEF IBO}

  if F.IsNull then
  begin
    case F.SqlType of
      SQL_TEXT, SQL_TEXT_,
      SQL_BLOB, SQL_BLOB_,
      SQL_ARRAY, SQL_ARRAY_,
      SQL_VARYING, SQL_VARYING_: Result := '';
      SQL_DOUBLE, SQL_DOUBLE_,
      SQL_FLOAT, SQL_FLOAT_,
      SQL_LONG, SQL_LONG_,
      SQL_D_FLOAT, SQL_D_FLOAT_,
      SQL_QUAD, SQL_QUAD_,
      SQL_SHORT, SQL_SHORT_,
      SQL_INT64, SQL_INT64_,
// Dieter Tremel 18.04.2002 begin
      SQL_TYPE_TIME, SQL_TYPE_TIME_,
      SQL_TYPE_DATE, SQL_TYPE_DATE_,
// Dieter Tremel 18.04.2002 end
      SQL_DATE, SQL_DATE_: Result := 0;
    end;
  end else // not null

{$IFDEF Delphi4}
  if (F.SQLType = SQL_INT64) or (F.SQLType = SQL_INT64_) and (F.SQLScale = 0) then
     Result := F.DisplayText
  else
{$ENDIF}
  if (F.IsBoolean) and not ((F.SqlType=SQL_Text) or (F.SqlType=SQL_Text_)) then
      Result := F.AsBoolean
  else
    Result := F.AsVariant;

{$ELSE}  // not IBO
  if not F.DataSet.Active then
    F.DataSet.Open;
  if Assigned(F.OnGetText) then
    Result := F.DisplayText else
{$IFDEF Delphi4}
  if F.DataType in [ftLargeint] then
    Result := F.DisplayText
  else
{$ENDIF}
  Result := F.AsVariant;

  if Result = Null then
    if F.DataType = ftString then
      Result := ''
{$IFDEF Delphi4}
    else if F.DataType = ftWideString then
      Result := ''
{$ENDIF}
    else if F.DataType = ftBoolean then
      Result := False
    else
      Result := 0;
{$ENDIF}
end;

procedure frGetDataSetAndField(ComplexName: String; var DataSet: TfrTDataSet;
  var Field: String);
var
  i, j, n: Integer;
  f: TComponent;
  sl: TStringList;
  s: String;
  c: Char;
  cn: TControl;

  function FindField(ds: TfrTDataSet; FName: String): String;
  var
    sl: TStringList;
  begin
    Result := '';
    if ds <> nil then
    begin
      sl := TStringList.Create;
      frGetFieldNames(ds, sl);
      if sl.IndexOf(FName) <> -1 then
        Result := FName;
      sl.Free;
    end;
  end;

begin
  Field := '';
  f := CurReport.Owner;
  sl := TStringList.Create;

  n := 0; j := 1;
  for i := 1 to Length(ComplexName) do
  begin
    c := ComplexName[i];
    if c = '"' then
    begin
      sl.Add(Copy(ComplexName, i, 255));
      j := i;
      break;
    end
    else if c = '.' then
    begin
      sl.Add(Copy(ComplexName, j, i - j));
      j := i + 1;
      Inc(n);
    end;
  end;
  if j <> i then
    sl.Add(Copy(ComplexName, j, 255));

  case n of
    0: // field name only
      begin
        if DataSet <> nil then
        begin
          s := frRemoveQuotes(ComplexName);
          Field := FindField(DataSet, s);
        end;
      end;
    1: // DatasetName.FieldName
      begin
        DataSet := TfrTDataSet(frFindComponent(f, sl[0]));
        s := frRemoveQuotes(sl[1]);
        Field := FindField(DataSet, s);
      end;
    2: // FormName.DatasetName.FieldName
      begin
        f := FindGlobalComponent(sl[0]);
        if f <> nil then
        begin
          DataSet := TfrTDataSet(f.FindComponent(sl[1]));
          s := frRemoveQuotes(sl[2]);
          Field := FindField(DataSet, s);
        end;
      end;
    3: // FormName.FrameName.DatasetName.FieldName - Delphi5
      begin
        f := FindGlobalComponent(sl[0]);
        if f <> nil then
        begin
          cn := TControl(f.FindComponent(sl[1]));
          DataSet := TfrTDataSet(cn.FindComponent(sl[2]));
          s := frRemoveQuotes(sl[3]);
          Field := FindField(DataSet, s);
        end;
      end;
  end;

  sl.Free;
end;

function frFindComponent(Owner: TComponent; Name: String): TComponent;
var
  n: Integer;
  s1, s2: String;
begin
  Result := nil;
  n := Pos('.', Name);
  try
    if n = 0 then
      Result := Owner.FindComponent(Name)
    else
    begin
      s1 := Copy(Name, 1, n - 1);        // module name
      s2 := Copy(Name, n + 1, 255);      // component name
      Owner := FindGlobalComponent(s1);
      if Owner <> nil then
      begin
        n := Pos('.', s2);
        if n <> 0 then        // frame name - Delphi5
        begin
          s1 := Copy(s2, 1, n - 1);
          s2 := Copy(s2, n + 1, 255);
          Owner := Owner.FindComponent(s1);
          if Owner <> nil then
            Result := Owner.FindComponent(s2);
        end
        else
          Result := Owner.FindComponent(s2);
      end;
    end;
  except
    on Exception do
      raise EClassNotFound.Create('Missing ' + Name);
  end;
end;

{$HINTS OFF}
procedure frGetComponents(Owner: TComponent; ClassRef: TClass;
  List: TStrings; Skip: TComponent);
var
  i, j: Integer;

  procedure EnumComponents(f: TComponent);
  var
    i: Integer;
    c: TComponent;
  begin
{$IFDEF Delphi5}
    if f is TForm then
      for i := 0 to TForm(f).ControlCount - 1 do
      begin
        c := TForm(f).Controls[i];
        if c is TFrame then
          EnumComponents(c);
      end;
{$ENDIF}
    for i := 0 to f.ComponentCount - 1 do
    begin
      c := f.Components[i];
      if (c <> Skip) and (c is ClassRef) then
        if f = Owner then
          List.Add(c.Name)
        else if ((f is TForm) or (f is TDataModule)) then
          List.Add(f.Name + '.' + c.Name)
        else
          List.Add(TControl(f).Parent.Name + '.' + f.Name + '.' + c.Name)
    end;
  end;

begin
  List.Clear;
  for i := 0 to Screen.FormCount - 1 do
    EnumComponents(Screen.Forms[i]);
  for i := 0 to Screen.DataModuleCount - 1 do
    EnumComponents(Screen.DataModules[i]);
{$IFDEF Delphi6}
  with Screen do
    for i := 0 to CustomFormCount - 1 do
      with CustomForms[i] do
      if (ClassName = 'TDataModuleForm')  then
        for j := 0 to ComponentCount - 1 do
        begin
          if (Components[j] is TDataModule) then
            EnumComponents(Components[j]);
        end;
{$ENDIF}
end;
{$HINTS ON}

function frGetWindowsVersion: String;
var
  Ver: TOsVersionInfo;
begin
  Ver.dwOSVersionInfoSize := SizeOf(Ver);
  GetVersionEx(Ver);
  with Ver do begin
    case dwPlatformId of
      VER_PLATFORM_WIN32s: Result := '32s';
      VER_PLATFORM_WIN32_WINDOWS:
        begin
          dwBuildNumber := dwBuildNumber and $0000FFFF;
          if (dwMajorVersion > 4) or ((dwMajorVersion = 4) and
            (dwMinorVersion >= 10)) then
            Result := '98' else
            Result := '95';
        end;
      VER_PLATFORM_WIN32_NT: Result := 'NT';
    end;
  end;
end;

function frStrToFloat(s: String): Double;
var
  i: Integer;
begin
  for i := 1 to Length(s) do
    if s[i] in [',', '.'] then
      s[i] := DecimalSeparator;
  Result := StrToFloat(Trim(s));
end;

function frRemoveQuotes(const s: String): String;
begin
  if (Length(s) > 2) and (s[1] = '"') and (s[Length(s)] = '"') then
    Result := Copy(s, 2, Length(s) - 2) else
    Result := s;
end;

procedure frSetCommaText(Text: String; sl: TStringList);
var
  i: Integer;

  function ExtractCommaName(s: string; var Pos: Integer): string;
  var
    i: Integer;
  begin
    i := Pos;
    while (i <= Length(s)) and (s[i] <> ';') do Inc(i);
    Result := Copy(s, Pos, i - Pos);
    if (i <= Length(s)) and (s[i] = ';') then Inc(i);
    Pos := i;
  end;

begin
  i := 1;
  sl.Clear;
  while i <= Length(Text) do
    sl.Add(ExtractCommaName(Text, i));
end;

function frLoadStr(ID: Integer): String;
begin
  Result := frLocale.LoadStr(ID);
end;


end.