rm_common.pas

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

  Result := FRMExportFilterList;
end;

function RMToolsList: TStringList;
begin
  if FRMToolsList = nil then
    FRMToolsList := TStringList.Create;
  Result := FRMToolsList;
end;

function RMAddIns(index: Integer): TRMAddInObjectInfo;
begin
  Result := TRMAddInObjectInfo(FRMAddInObjectList.Objects[index]);
end;

function RMAddInsCount: Integer;
begin
  if FRMAddInObjectList = nil then
    Result := -1
  else
    Result := FRMAddinObjectList.Count;
end;

function RMFilters(index: Integer): TRMExportFilterInfo;
begin
  Result := TRMExportFilterInfo(FRMExportFilterList.Objects[index]);
end;

function RMFiltersCount: Integer;
begin
  if FRMExportFilterList = nil then
    Result := -1
  else
    Result := FRMExportFilterList.Count;
end;

function RMTools(index: Integer): TRMToolsInfo;
begin
  Result := TRMToolsInfo(FRMToolsList.Objects[index]);
end;

function RMToolsCount: Integer;
begin
  if FRMToolsList = nil then
    Result := -1
  else
    Result := FRMToolsList.Count;
end;

function RMFunctionList: TList;
begin
  if FRMFunctionList = nil then
    FRMFunctionList := TList.Create;
  Result := FRMFunctionList;
end;

function RMAddInFunctionCount: Integer;
begin
  if FRMFunctionList <> nil then
    Result := FRMFunctionList.Count
  else
    Result := 0;
end;

function RMAddInFunctions(Index: Integer): TRMCustomFunctionLibrary;
begin
  if (Index >= 0) and (Index < RMFunctionList.Count) then
    Result := TRMCustomFunctionLibrary(FRMFunctionList[Index])
  else
    Result := nil;
end;


{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMAddInObjectInfo}

constructor TRMAddInObjectInfo.Create(AClassRef: TClass;
  AEditorFormClass: TFormClass; const AButtonBmpRes: string;
  const AButtonHint: string; AIsControl: Boolean);
begin
  inherited Create;
  FClassRef := TRMClass(AClassRef);
  FEditorFormClass := AEditorFormClass;
  FButtonBmpRes := AButtonBmpRes;
  FButtonHint := AButtonHint;
  FIsControl := AIsControl;
  FPage := '';
  FIsPage := True;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMExportFilterInfo}

constructor TRMExportFilterInfo.Create(AClassRef: TRMCustomExportFilter;
  const AFilterDesc: string; const AFilterExt: string);
begin
  inherited Create;
  FFilter := AClassRef;
  FFilterDesc := AFilterDesc;
  FFilterExt := AFilterExt;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMToolsInfo}

constructor TRMToolsInfo.Create(const ACaption: string;
  const AButtonBmpRes: string; AOnClick: TNotifyEvent);
begin
  inherited Create;
  FCaption := ACaption;
  FButtonBmpRes := AButtonBmpRes;
  FOnClick := AOnClick;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{登记注册一个Add-in Object}

procedure RMRegisterObjectByRes(ClassRef: TClass; const ButtonBmpRes: string;
  const ButtonHint: string; EditorFormClass: TFormClass);
var
  tmp: TRMAddinObjectInfo;
begin
  tmp := TRMAddinObjectInfo.Create(ClassRef, EditorFormClass, ButtonBmpRes, ButtonHint,
    False);
  RMAddinObjectList.AddObject('', tmp);
end;

procedure RMRegisterControl(ClassRef: TClass; const ButtonBmpRes, ButtonHint: string);
var
  tmp: TRMAddinObjectInfo;
begin
  tmp := TRMAddinObjectInfo.Create(ClassRef, nil, ButtonBmpRes, ButtonHint, TRUE);
  RMAddinObjectList.AddObject('', tmp);
end;

function _FindRegisteredControl(aPage: string): Boolean;
var
  i: Integer;
  lInfo: TRMAddInObjectInfo;
begin
  Result := False;
  for i := 0 to RMAddinsCount - 1 do
  begin
    lInfo := RMAddins(i);
    if lInfo.IsPage and RMCmp(lInfo.Page, aPage) then
    begin
      Result := True;
      Exit;
    end;
  end;
end;

procedure RMRegisterControl(const aPage, aPageButtonBmpRes: string; aIsControl: Boolean;
  aClassRef: TClass;  aButtonBmpRes, aButtonHint: string);
var
  tmp: TRMAddinObjectInfo;
begin
  if not _FindRegisteredControl(aPage) then
  begin
    tmp := TRMAddinObjectInfo.Create(nil, nil, aPageButtonBmpRes,
      '', aIsControl);
    tmp.Page := aPage;
    tmp.IsPage := True;
    RMAddinObjectList.AddObject('', tmp);
  end;

  tmp := TRMAddinObjectInfo.Create(aClassRef, nil, aButtonBmpRes,
      aButtonHint, aIsControl);
  tmp.Page := aPage;
  tmp.IsPage := False;
  RMAddinObjectList.AddObject('', tmp);
end;

procedure RMRegisterControls(const aPage, aPageButtonBmpRes: string;
  aIsControl: Boolean;
  AryClassRef: array of TClass;
  AryButtonBmpRes: array of string;
  AryButtonHint: array of string);
var
  tmp: TRMAddinObjectInfo;
  i: Integer;
begin
  if not _FindRegisteredControl(aPage) then
  begin
    tmp := TRMAddinObjectInfo.Create(nil, nil, aPageButtonBmpRes,
      '', aIsControl);
    tmp.Page := aPage;
    tmp.IsPage := True;
    RMAddinObjectList.AddObject('', tmp);
  end;

  for i := Low(AryClassRef) to High(AryClassRef) do
  begin
    tmp := TRMAddinObjectInfo.Create(AryClassRef[i], nil, AryButtonBmpRes[i],
      AryButtonHint[i], aIsControl);
    tmp.Page := aPage;
    tmp.IsPage := False;
    RMAddinObjectList.AddObject('', tmp);
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{登记注册一个Export}

procedure RMRegisterExportFilter(Filter: TRMCustomExportFilter; const FilterDesc, FilterExt: string);
var
  i: Integer;
  tmp: TRMExportFilterInfo;
begin
  for i := 0 to RMFiltersCount - 1 do
  begin
    if RMFilters(i).Filter.ClassName = Filter.ClassName then Exit;
  end;
  tmp := TRMExportFilterInfo.Create(Filter, FilterDesc, FilterExt);
  RMExportFilterList.AddObject('', tmp);
end;

procedure RMUnRegisterExportFilter(Filter: TRMCustomExportFilter);
var
  i: Integer;
begin
  if FRMExportFilterList = nil then Exit;

  for i := 0 to RMFiltersCount - 1 do
  begin
    if RMFilters(i).Filter.ClassName = Filter.ClassName then
    begin
      TRMExportFilterInfo(RMExportFilterList.Objects[i]).Free;
      RMExportFilterList.Delete(i);
      Break;
    end;
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{登记注册一个Design Tools}

procedure RMRegisterTool(const MenuCaption: string; const ButtonBmpRes: string; OnClick: TNotifyEvent);
var
  tmp: TRMToolsInfo;
begin
  tmp := TRMToolsInfo.Create(MenuCaption, ButtonBmpRes, OnClick);
  RMToolsList.AddObject('', tmp);
end;

procedure RMUnRegisterTool(const MenuCaption: string);
var
  i: Integer;
begin
  if FRMToolsList = nil then Exit;

  for i := 0 to RMToolsList.Count - 1 do
  begin
    if TRMToolsInfo(RMToolsList.Objects[i]).Caption = MenuCaption then
    begin
      TRMToolsInfo(RMToolsList.Objects[i]).Free;
      RMToolsList.Delete(i);
      Break;
    end;
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}

procedure RMRegisterFunctionLibrary(ClassRef: TClass);
var
  i: Integer;
  tmp: TRMCustomFunctionLibrary;
begin
  for i := 0 to RMFunctionList.Count - 1 do
  begin
    if TRMCustomFunctionLibrary(RMFunctionList[i]).ClassName = ClassRef.ClassName then
      Exit;
  end;
  tmp := TRMCustomFunctionLibrary(ClassRef.NewInstance);
  tmp.Create;
  RMFunctionList.Add(tmp);
end;

procedure RMUnRegisterFunctionLibrary(ClassRef: TClass);
var
  i: Integer;
begin
  if FRMFunctionList = nil then Exit;

  for i := 0 to RMFunctionList.Count - 1 do
  begin
    if TRMCustomFunctionLibrary(RMFunctionList[i]).ClassName = ClassRef.ClassName then
    begin
      TRMCustomFunctionLibrary(RMFunctionList[i]).Free;
      RMFunctionList.Delete(i);
      Break;
    end;
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMCustomFunctionLibrary}

constructor TRMCustomFunctionLibrary.Create;
begin
  inherited Create;
  
  FList := TStringList.Create;
  FFunctionList := TList.Create;
end;

destructor TRMCustomFunctionLibrary.Destroy;
begin
  Clear;
  FFunctionList.Free;
  FList.Free;
  
  inherited Destroy;
end;

procedure TRMCustomFunctionLibrary.Clear;
begin
  while FFunctionList.Count > 0 do
  begin
    Dispose(PRMFunctionDesc(FFunctionList[0]));
    FFunctionList.Delete(0);
  end;
end;

function TRMCustomFunctionLibrary.OnFunction(aParser: TRMParser; const aFunctionName: string;
  aParams: array of Variant; var aValue: Variant): Boolean;
var
  i: Integer;
begin
  Result := False;
  i := FList.IndexOf(aFunctionName);
  if i >= 0 then
  begin
    DoFunction(aParser, i, aParams, aValue);
    Result := True;
  end;
end;

procedure TRMCustomFunctionLibrary.AddFunctionDesc(const aFuncName, aCategory,
	aDescription, aFuncPara: string);
var
  pfunc: PRMFunctionDesc;
begin
  New(pfunc);
  pfunc^.FuncName := aFuncName;
  pfunc^.Category := aCategory;
  pfunc^.Description := aDescription;
  pfunc^.FuncPara := aFuncPara;
  
  FFunctionList.Add(pfunc);
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}

procedure FreeAddInObjectList;
var
  i: Integer;
begin
  if FRMAddInObjectList = nil then Exit;
  for i := 0 to FRMAddInObjectList.Count - 1 do
    FRMAddInObjectList.Objects[i].Free;

  FreeAndNil(FRMAddInObjectList);
end;

procedure FreeExportFilterList;
var
  i: Integer;
begin
  if FRMExportFilterList = nil then Exit;
  for i := 0 to FRMExportFilterList.Count - 1 do
    FRMExportFilterList.Objects[i].Free;

  FreeAndNil(FRMExportFilterList);
end;

procedure FreeToolsList;
var
  i: Integer;
begin
  if FRMToolsList = nil then Exit;
  for i := 0 to FRMToolsList.Count - 1 do
    FRMToolsList.Objects[i].Free;

  FreeAndNil(FRMToolsList);
end;

procedure FreeFunctionList;
var
  i: Integer;
begin
  if FRMFunctionList = nil then Exit;
  for i := 0 to FRMFunctionList.Count - 1 do
    TRMCustomFunctionLibrary(FRMFunctionList[i]).Free;

  FreeAndNil(FRMFunctionList);
end;

initialization
  RMRegRootKey := 'Software\WHF SoftWare\Report Machine';

finalization
  FreeAddInObjectList;
  FreeExportFilterList;
  FreeToolsList;
  FreeFunctionList;

end.