rm_common.pas

这是一个功能强大

function RMGetBrackedVariable(const aStr: WideString;
  var aBeginPos, aEndPos: Integer): WideString;
var
  c: Integer;
  lFlag1, lFlag2: Boolean;
  lStrLen: Integer;
begin
  Result := '';
  aEndPos := aBeginPos; lFlag1 := True; lFlag2 := True; c := 0;
  lStrLen := Length(aStr);
  if (aStr = '') or (aBeginPos >= lStrLen) then Exit;

  Dec(aEndPos);
  repeat
    Inc(aEndPos);
    if lFlag1 and lFlag2 then
    begin
      if aStr[aEndPos] = '[' then
      begin
        if c = 0 then
          aBeginPos := aEndPos;

        Inc(c);
      end
      else if aStr[aEndPos] = ']' then
        Dec(c);
    end;

    if lFlag1 then
    begin
      if aStr[aEndPos] = '"' then
        lFlag2 := not lFlag2;
    end;

    if lFlag2 then
    begin
      if aStr[aEndPos] = '''' then
        lFlag1 := not lFlag1;
    end;
  until (c = 0) or (aEndPos >= lStrLen);

  if c = 0 then
    Result := Copy(aStr, aBeginPos + 1, aEndPos - aBeginPos - 1)
  else
    Result := '';
end;

function RMCmp(const S1, S2: string): Boolean;
begin
  Result := (Length(S1) = Length(S2)) and
    (CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, PChar(S1),
    -1, PChar(S2), -1) = 2);
end;


function RMDataSetList: TList;
begin
  if FDataSetList = nil then
    FDataSetList := TList.Create;

  Result := FDataSetList;
end;

function RMGetPropValue_1(aObject: TObject; aPropName: string; var aValue: Variant): Boolean;
var
  lPropInfo: PPropInfo;
begin
  lPropInfo := TypInfo.GetPropInfo(aObject.ClassInfo, aPropName);
  if lPropInfo = nil then
  begin
    Result := False;
    Exit;
  end;

  Result := True;
  case lPropInfo.PropType^^.Kind of
    tkInteger, tkChar, tkWChar, tkClass:
      aValue := TypInfo.GetOrdProp(aObject, lPropInfo);
    tkEnumeration:
      aValue := TypInfo.GetOrdProp(aObject, lPropInfo);
    tkSet:
      aValue := TypInfo.GetOrdProp(aObject, lPropInfo);
    tkFloat:
      aValue := TypInfo.GetFloatProp(aObject, lPropInfo);
    tkMethod:
      aValue := lPropInfo^.PropType^.Name;
    tkString, tkLString:
      aValue := TypInfo.GetStrProp(aObject, lPropInfo);
    tkWString:
{$IFDEF COMPILER6_UP}
      aValue := TypInfo.GetWideStrProp(aObject, lPropInfo);
{$ELSE}
      aValue := TypInfo.GetStrProp(aObject, lPropInfo);
{$ENDIF}
    tkVariant:
      aValue := TypInfo.GetVariantProp(aObject, lPropInfo);
    tkInt64:
{$IFDEF COMPILER6_UP}
      aValue := TypInfo.GetInt64Prop(aObject, lPropInfo);
{$ELSE}
      aValue := TypInfo.GetInt64Prop(aObject, lPropInfo) + 0.0;
{$ENDIF}
    tkDynArray:
      DynArrayToVariant(aValue, Pointer(GetOrdProp(aObject, lPropInfo)), lPropInfo^.PropType^);
  else
    Result := False;
  end;
end;

function RMSetPropValue(aObject: TObject; aPropName: string; aValue: Variant): Boolean;

  function _RangedValue(const AMin, AMax: Int64): Int64;
  begin
    Result := Trunc(aValue);
    if (Result < AMin) or (Result > AMax) then
    begin
      //raise ERangeError.CreateRes(@SRangeError);
    end;
  end;

var
  lPropInfo: PPropInfo;
  lTypeData: PTypeData;
  lDynArray: Pointer;
begin
  Result := False;
  lPropInfo := GetPropInfo(aObject, aPropName);
  if lPropInfo = nil then Exit;

  Result := True;
  lTypeData := GetTypeData(lPropInfo^.PropType^);
  case lPropInfo.PropType^^.Kind of
    tkInteger, tkChar, tkWChar:
      if lTypeData^.MinValue < lTypeData^.MaxValue then
        TypInfo.SetOrdProp(aObject, lPropInfo, _RangedValue(lTypeData^.MinValue,
          lTypeData^.MaxValue))
      else
        TypInfo.SetOrdProp(aObject, lPropInfo,
          _RangedValue(LongWord(lTypeData^.MinValue),
          LongWord(lTypeData^.MaxValue)));
    tkEnumeration:
      if VarType(aValue) = varString then
        TypInfo.SetEnumProp(aObject, lPropInfo, VarToStr(aValue))
      else if VarType(aValue) = varBoolean then
        TypInfo.SetOrdProp(aObject, lPropInfo, Abs(Trunc(aValue)))
      else
        TypInfo.SetOrdProp(aObject, lPropInfo, _RangedValue(lTypeData^.MinValue,
          lTypeData^.MaxValue));
    tkSet:
      if VarType(aValue) = varInteger then
        TypInfo.SetOrdProp(aObject, lPropInfo, aValue)
      else
        TypInfo.SetSetProp(aObject, lPropInfo, VarToStr(aValue));
    tkFloat:
      TypInfo.SetFloatProp(aObject, lPropInfo, aValue);
    tkString, tkLString:
      TypInfo.SetStrProp(aObject, lPropInfo, VarToStr(aValue));
    tkWString:
{$IFDEF COMPILER6_UP}
      TypInfo.SetWideStrProp(aObject, lPropInfo, VarToWideStr(aValue));
{$ELSE}
      TypInfo.SetStrProp(aObject, lPropInfo, VarToStr(aValue));
{$ENDIF}
    tkVariant:
      TypInfo.SetVariantProp(aObject, lPropInfo, aValue);
    tkInt64:
      TypInfo.SetInt64Prop(aObject, lPropInfo, _RangedValue(lTypeData^.MinInt64Value,
        lTypeData^.MaxInt64Value));
    tkDynArray:
      begin
        DynArrayFromVariant(lDynArray, aValue, lPropInfo^.PropType^);
        TypInfo.SetOrdProp(aObject, lPropInfo, Integer(lDynArray));
      end;
  else
    Result := False;
  end;
end;

function RMHavePropertyName(aObject: TObject; const aPropName: string): Boolean;
var
  lPropInfo: PPropInfo;
begin
  lPropInfo := TypInfo.GetPropInfo(aObject.ClassInfo, aPropName);
  Result := lPropInfo <> nil;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
  {TRMVariables}

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMCustomView }

class function TRMCustomView.CanPlaceOnGridView: Boolean;
begin
  Result := True;
end;

class procedure TRMCustomView.DefaultSize(var aKx, aKy: Integer);
begin
  aKx := 96;
  aKy := 18;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMPreviewOptions }

constructor TRMPreviewOptions.Create;
begin
  inherited;

  FRulerUnit := rmutScreenPixels;
  FRulerVisible := False;

  FDrawBorder := False;
  FBorderPen := TPen.Create;
  FBorderPen.Color := clGray;
  FBorderPen.Style := psDash;
  FBorderPen.Width := 1;
end;

destructor TRMPreviewOptions.Destroy;
begin
  FreeAndNil(FBorderPen);

  inherited;
end;

procedure TRMPreviewOptions.Assign(Source: TPersistent);
begin
  FRulerUnit := TRMPreviewOptions(Source).RulerUnit;
  FRulerVisible := TRMPreviewOptions(Source).RulerVisible;

  FDrawBorder := TRMPreviewOptions(Source).DrawBorder;
  FBorderPen.Assign(TRMPreviewOptions(Source).BorderPen);
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMCustomPreview }

constructor TRMCustomPreview.Create(AOwner: TComponent);
begin
  inherited;

  FOptions := TRMPreviewOptions.Create;
end;

destructor TRMCustomPreview.Destroy;
begin
  FreeAndNil(FOptions);

  inherited Destroy;
end;

procedure TRMCustomPreview.SetOptions(Value: TRMPreviewOptions);
begin
  FOptions.Assign(Value);
end;

procedure TRMCustomPreview.CloseForm;
begin
//
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMBandMsg }

constructor TRMBandMsg.Create;
begin
  inherited;

  FFont := TFont.Create;
  if RMIsChineseGB then
    FFont.Name := '宋体'
  else
    FFont.Name := 'Arial';
  FFont.Size := 10;
  FFont.Charset := StrToInt(RMLoadStr(SCharset)); //RMCharset;

  FLeftMemo := TStringList.Create;
  FCenterMemo := TStringList.Create;
  FRightMemo := TStringList.Create;
end;

destructor TRMBandMsg.Destroy;
begin
  FreeAndNil(FFont);
  FreeAndNil(FLeftMemo);
  FreeAndNil(FCenterMemo);
  FreeAndNil(FRightMemo);

  inherited;
end;

procedure TRMBandMsg.Assign(Source: TPersistent);
begin
  if Source is TRMBandMsg then
  begin
    FFont.Assign(TRMBandMsg(Source).Font);
    FLeftMemo.Assign(TRMBandMSg(Source).LeftMemo);
    FCenterMemo.Assign(TRMBandMSg(Source).CenterMemo);
    FRightMemo.Assign(TRMBandMSg(Source).RightMemo);
  end;
end;

procedure TRMBandMsg.SetFont(Value: TFont);
begin
  FFont.Assign(Value);
end;

procedure TRMBandMsg.SetLeftMemo(Value: TStringList);
begin
  FLeftMemo.Assign(Value);
end;

procedure TRMBandMsg.SetCenterMemo(Value: TStringList);
begin
  FCenterMemo.Assign(Value);
end;

procedure TRMBandMsg.SetRightMemo(Value: TStringList);
begin
  FRightMemo.Assign(Value);
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMPageCaptionMsg }

constructor TRMPageCaptionMsg.Create;
begin
  inherited;

  FTitleFont := TFont.Create;
  FTitleMemo := TStringList.Create;
  FCaptionMsg := TRMBandMsg.Create;

  if RMIsChineseGB then
    FTitleFont.Name := '宋体'
  else
    FTitleFont.Name := 'Arial';
  FTitleFont.Size := 10;
  FTitleFont.Charset := StrToInt(RMLoadStr(SCharset)); //RMCharset;
end;

destructor TRMPageCaptionMsg.Destroy;
begin
  FreeAndNil(FTitleFont);
  FreeAndNil(FTitleMemo);
  FreeAndNil(FCaptionMsg);

  inherited;
end;

procedure TRMPageCaptionMsg.Assign(Source: TPersistent);
begin
  if Source is TRMPageCaptionMsg then
  begin
    TitleFont := TRMPageCaptionMsg(Source).TitleFont;
    TitleMemo := TRMPageCaptionMsg(Source).TitleMemo;
    CaptionMsg := TRMPageCaptionMsg(Source).CaptionMsg;
  end;
end;

procedure TRMPageCaptionMsg.SetTitleFont(Value: TFont);
begin
  FTitleFont.Assign(Value);
end;

procedure TRMPageCaptionMsg.SetTitleMemo(Value: TStringList);
begin
  FTitleMemo.Assign(Value);
end;

procedure TRMPageCaptionMsg.SetCaptionMsg(Value: TRMBandMsg);
begin
  FCaptionMsg.Assign(Value);
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMTempFileStream }

const
  sDefPrefix = 'dfs';

function GetTempFile(const prefix: string): string;
var
  path, pref3: string;
  ppref: PChar;
begin
  SetLength(path, 1024);
  SetLength(path, GetTempPath(1024, @path[1]));
  SetLength(Result, 1024);
  Result[1] := #0;
  case length(prefix) of
    0: ppref := PChar(sDefPrefix);
    1, 2:
      begin
        pref3 := prefix;
        while length(pref3) < 3 do
          pref3 := pref3 + '_';

        ppref := PChar(pref3);
      end;
    3: ppref := PChar(prefix);
  else
    pref3 := Copy(prefix, 1, 3);
    ppref := PChar(pref3);
  end;

  GetTempFileName(PChar(path), ppref, 0, PChar(Result));
  SetLength(Result, StrLen(PChar(Result)));
end;

constructor TRMTempFileStream.Create;
begin
  FFileName := GetTempFile(''); // Windows.GetTempFileName creates the file...
  inherited Create(FFileName, fmOpenReadWrite or fmShareDenyWrite);
end;

destructor TRMTempFileStream.Destroy;
begin
  DeleteFile(PChar(FFileName));
  inherited;
end;


{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
var
  FRMAddInObjectList: TList = nil;
  FRMExportFilterList: TList = nil;
  FRMToolsList: TList = nil;
  FRMFunctionList: TList = nil;
  FRMPageEditorList: TList = nil;
  FRMDsgPageButtonList: TList = nil;
  FRMAddInReportPageList: TList = nil;
  FComAdapterList: TList = nil;

function RMComAdapterList: TList;
begin
  if FComAdapterList = nil then
    FComAdapterList := TList.Create;

  Result := FComAdapterList;
end;