rm_common.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 1,262 行 · 第 1/3 页

      TypInfo.SetFloatProp(aObject, lPropInfo, aValue);
    tkString, tkLString:
      TypInfo.SetStrProp(aObject, lPropInfo, VarToStr(aValue));
    tkWString:
      {$IFDEF Delphi6}
      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;

procedure E_GetComponent(var aObject: TObject; var aPropName: string);
// PropName='Font.Color'
var
  lPropInfo: PPropInfo;
  lPos: integer;
begin
  while Pos('.', aPropName) > 0 do
  begin
    lPos := Pos('.', aPropName);
    lPropInfo := GetPropInfo(aObject.ClassInfo, Copy(aPropName, 1, lPos - 1));
    aObject := TObject(GetOrdProp(aObject, lPropInfo));
    Delete(aPropName, 1, lPos);
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMPersistent }

constructor TRMPersistent.Create;
begin
  inherited Create;

  FPropVars := nil;
end;

destructor TRMPersistent.Destroy;
begin
  FreeAndNil(FPropVars);
  inherited Destroy;
end;

function TRMPersistent.GetPropVars: TRMVariables;
begin
  if FPropVars = nil then
  begin
    FPropVars := TRMVariables.Create;
  end;

  Result := FPropVars;
end;

procedure TRMPersistent.LoadEventInfo(aStream: TStream);
var
  i, lCount: Integer;
  lStr: string;
begin
  lCount := RMReadWord(aStream);
  for i := 0 to lCount - 1 do
  begin
    lStr := RMReadString(aStream);
    PropVars[lStr] := RMReadString(aStream);
  end;
end;

procedure TRMPersistent.SaveEventInfo(aStream: TStream);
var
  i: Integer;
begin
  if FPropVars = nil then
    RMWriteWord(aStream, 0)
  else
  begin
    RMWriteWord(aStream, FPropVars.Count);
    for i := 0 to FPropVars.Count - 1 do
    begin
      RMWriteString(aStream, FPropVars.Name[i]);
      RMWriteString(aStream, FPropVars.Value[i]);
    end;
  end;
end;

function TRMPersistent.GetPropValue(aObject: TObject; aPropName: string;
  var aValue: Variant; Args: array of Variant): Boolean;
begin
  E_GetComponent(aObject, aPropName);
  Result := RMGetPropValue_1(aObject, aPropName, aValue);
end;

function TRMPersistent.SetPropValue(aObject: TObject; aPropName: string; aValue: Variant): Boolean;
begin
  Result := False;
end;

procedure TRMPersistent.SetName(const Value: string);
begin
  FName := Value;
end;

type
  THackEngine = class(TJvInterpreterFm);
  THackRMCustomComponent = class(TRMPersistent);

procedure TRMPersistent.SetObjectEvent(aEventList: TList; aEngine: TJvInterpreterFm);
var
  i: Integer;
  lMethod: TMethod;
  lPropInfo: PPropInfo;
  lPropName: string;
  lPropValue: string;
begin
  if FPropVars = nil then Exit;

  for i := 0 to PropVars.Count - 1 do
  begin
    lPropName := PropVars.Name[i];
    lPropValue := PropVars.Value[i];
    if (lPropValue <> '') and
      aEngine.FunctionExists('Report', lPropValue) then
    begin
      lPropInfo := TypInfo.GetPropInfo(Self, lPropName);
      try
        lMethod := TMethod(THackEngine(aEngine).NewEvent(
          'Report',
          lPropValue,
          lPropInfo^.PropType^.Name,
          Self));
        TypInfo.SetMethodProp(Self, lPropInfo, lMethod);
        aEventList.Add(lMethod.Data);
      except
      end;
    end;
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ 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 := clBlue;
  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;
end;

procedure TRMCustomPreview.SetOptions(Value: TRMPreviewOptions);
begin
  FOptions.Assign(Value);
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;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMComponent }

function TRMComponent.GetPropValue(aObject: TObject; aPropName: string;
  var aValue: Variant; Args: array of Variant): Boolean;
begin
  Result := False;
end;

function TRMComponent.SetPropValue(aObject: TObject; aPropName: string;
  aValue: Variant): Boolean;
begin
  Result := False;
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: TStringList = nil;
  FRMExportFilterList: TStringList = nil;
  FRMToolsList: TStringList = nil;
  FRMFunctionList: TList = nil;

function RMAddInObjectList: TStringList;
begin
  if FRMAddInObjectList = nil then
    FRMAddInObjectList := TStringList.Create;
  Result := FRMAddInObjectList;
end;

function RMExportFilterList: TStringList;
begin
  if FRMExportFilterList = nil then
    FRMExportFilterList := TStringList.Create;