全模块化插件式框架设计方案实践手记（附效果图）

最进一直在想要弄个自动化框架，如何在接口已经实现的情况下快速对接，快速开发应用程序，小试了一把，初步成功了。

以下是关键代码部分，作为备忘：

  1 procedure TfrmMain.LoadMenu(Astr: string);
  2 var
  3   ribbonTab: TdxRibbonTab;
  4   ribbonTabGroup: TdxRibbonTabGroup;
  5   ItemLink: TdxBarItemLink;
  6   OBJ: TStringList;
  7   AClassName: String;
  8   btn, ParentBtn: TdxBarItem;
  9   AJSONObject, ARowData: TJSONObject;
 10   AMenuData: TJSONArray;
 11 const
 12   BarItemClassName: Array [0 .. 2] of string = ('TDXBARLARGEBUTTON', 'TDXBARBUTTON', 'TDXBARSUBITEM');
 13   Function ClassNameInArray(AClassName: String): Boolean;
 14   begin
 15     Result := False;
 16     for var I: Integer := 0 to High(BarItemClassName) do
 17       if BarItemClassName[I] = AClassName then
 18       begin
 19         Result := True;
 20         Break;
 21       end;
 22 
 23   end;
 24   procedure LoadGlyphFromStr(AGlyph: TdxSmartImage; Astr: string);
 25   var
 26     AGlyphSteam: TMemoryStream;
 27   begin
 28     AGlyphSteam := TMemoryStream.Create;
 29     AGlyphSteam.SetSize(Length(Astr) div 2);
 30     HexToBin(PChar(Astr), AGlyphSteam.Memory, AGlyphSteam.Size);
 31     try
 32       AGlyphSteam.Position := 0;
 33       AGlyph.LoadFromStream(AGlyphSteam);
 34     finally
 35       AGlyphSteam.Free;
 36     end;
 37   end;
 38 
 39 begin
 40   dxRibbon1.Tabs.Clear;
 41   OBJ := TStringList.Create;
 42   try
 43     AJSONObject := TJSONObject.ParseJSONValue(TEncoding.UTF8.GetBytes(Astr), 0) as TJSONObject;
 44     AMenuData := AJSONObject.GetValue<TJSONArray>('FDBS.Manager.TableList[0].RowList');
 45     for var I: Integer := 0 to AMenuData.Size - 1 do
 46     begin
 47       ARowData := (AMenuData[I] as TJSONObject).GetValue<TJSONObject>('Original');
 48       AClassName := ARowData.GetValue('MenuClassName').Value;
 49       // 开始创建菜单和组
 50       if AClassName.ToUpper = UpperCase('TdxRibbonTab') then
 51       begin
 52         ribbonTab := dxRibbon1.Tabs.Insert(dxRibbon1.Tabs.Count);
 53         ribbonTab.Caption := ARowData.GetValue('Caption').Value;;
 54         ribbonTab.Name := 'ID' + ARowData.GetValue('LevelCode').Value;
 55       end
 56       else if AClassName.ToUpper = UpperCase('TdxRibbonTabGroup') then
 57       begin
 58         ribbonTab := TdxRibbonTab(Self.Findcomponent('ID' + ARowData.GetValue('ParentID').Value));
 59         if ribbonTab <> nil then
 60         begin
 61           ribbonTabGroup := ribbonTab.Groups.Add;
 62           ribbonTabGroup.Caption := ARowData.GetValue('Caption').Value;
 63           ribbonTabGroup.ToolBar := dxBarManager1.AddToolBar(True);
 64           OBJ.AddObject('ID' + ARowData.GetValue('LevelCode').Value, ribbonTabGroup);
 65         end;
 66       end
 67       else if ClassNameInArray(AClassName.ToUpper) then
 68       begin
 69         btn := TdxBarItemClass(Findclass(AClassName)).Create(Self);
 70         if ARowData.FindValue('Router') <> nil then
 71           btn.Description := ARowData.GetValue('Router').Value;
 72         if (ARowData.FindValue('LargeGlyph') <> nil) and IsPublishedProp(btn, 'LargeGlyph') then
 73           LoadGlyphFromStr(btn.LargeGlyph, ARowData.GetValue('LargeGlyph').Value);
 74 
 75         if (ARowData.FindValue('Glyph') <> nil) and (IsPublishedProp(btn, 'Glyph')) then
 76           LoadGlyphFromStr(btn.Glyph, ARowData.GetValue('Glyph').Value);
 77 
 78         if OBJ.IndexOf('ID' + ARowData.GetValue('ParentID').Value) > -1 then//优先查找是否有父分组
 79         begin
 80           ribbonTabGroup := OBJ.Objects[OBJ.IndexOf('ID' + ARowData.GetValue('ParentID').Value)] as TdxRibbonTabGroup;
 81           ItemLink := ribbonTabGroup.ToolBar.ItemLinks.Add
 82         end
 83         else
 84         begin  //如果没有父分组，则去找是否有父按钮(类名：TdxBarSubItem)
 85           ParentBtn := TdxBarItem(Self.Findcomponent('ID' + ARowData.GetValue('ParentID').Value));
 86           if (ParentBtn <> nil) and (ParentBtn.ClassName='TdxBarSubItem') then
 87             ItemLink := TdxBarSubItem(ParentBtn).ItemLinks.Add;
 88         end;
 89 
 90         btn.Caption := ARowData.GetValue('Caption').Value;
 91         btn.Name := 'ID' + ARowData.GetValue('LevelCode').Value;
 92         ItemLink.Item := btn;
 93         btn.OnClick := OndxBarButtonClick;
 94 
 95       end;
 96     end;
 97   finally
 98     OBJ.Free;
 99     AJSONObject.Free;
100   end;
101 
102 end;

  1 uses
  2   qplugins_loader_lib, qstring;
  3 
  4 const
  5   ObjCastGUID: TGuid = '{CEDF24DE-80A4-447D-8C75-EB871DC121FD}';
  6 
  7 type
  8   TCrackdxRibbonTabCollection = class(TdxRibbonTabCollection);
  9 
 10   { TForm3 }
 11 
 12 procedure TfrmMain.AfterLogin(ASender: IQFormService; ATag: IQParams);
 13 var
 14   ss: TStringStream;
 15   AStream: TQStream;
 16 begin
 17   if ASender.ModalResult = mrOk then
 18   begin
 19     ss := TStringStream.Create('', TEncoding.UTF8);
 20     AStream := NewStream((ASender as IQService).Attrs.ByName('stMenu').AsStream);
 21     AStream.Position := 0;
 22     ss.LoadFromStream(AStream);
 23     try
 24       dxRibbonStatusBar1.Panels[1].Text := (ASender as IQService).Attrs.ByName('UserName').AsString.Value;
 25       dxRibbonStatusBar1.Panels[2].Text := (ASender as IQService).Attrs.ByName('Message').AsString.Value;
 26       LoadMenu(ss.DataString);
 27     finally
 28       AStream.Free;
 29       ss.Free;
 30       Self.Visible := True;
 31     end
 32   end
 33   else
 34   begin
 35     Application.Terminate;
 36   end;
 37 
 38 end;
 39 
 40 procedure TfrmMain.DockPage(AFormService: IQFormService; AHoldNeeded: Boolean);
 41 var
 42   APage: TcxTabSheet;
 43   AEvents: TQFormEvents;
 44   APageIndex: Integer;
 45   AVclFormService: TQVCLFormService;
 46 begin
 47   APageIndex := FFormList.IndexOf(AFormService);
 48   if APageIndex > -1 then
 49   begin
 50     pgc.ActivePageIndex := APageIndex;
 51     Exit;
 52   end;
 53   FFormList.Add(AFormService);
 54   APage := TcxTabSheet.Create(pgc);
 55   APage.PageControl := pgc;
 56   if Supports(AFormService, ObjCastGUID, AVclFormService) then
 57     APage.Caption := AVclFormService.Form.Caption;
 58   APage.Tag := IntPtr(AFormService);
 59   AFormService.DockTo(APage.Handle, TFormAlign.faDefault);
 60   FillChar(AEvents, SizeOf(AEvents), 0);
 61   AEvents.OnFree := DoDockChildFree;
 62   AFormService.HookEvents(AEvents);
 63   if AHoldNeeded then
 64     HoldByComponent(APage, AFormService);
 65   pgc.ActivePageIndex := pgc.PageCount - 1;
 66 
 67 end;
 68 
 69 procedure TfrmMain.DoDockChildFree(AForm: IQFormService);
 70 var
 71   I: Integer;
 72   AVclForm: TQVCLFormService;
 73 begin
 74   for I := 0 to pgc.PageCount - 1 do
 75   begin
 76     if pgc.Pages[I].Tag = IntPtr(AForm) then
 77     begin
 78       FFormList.Delete(FFormList.IndexOf(AForm));
 79       AForm.UnhookEvents;
 80       FreeObject(pgc.Pages[I]);
 81       if not AForm.IsMultiInstance then
 82       begin
 83         if Supports(AForm, ObjCastGUID, AVclForm) and Assigned(AVclForm.Form) then
 84           FreeObject(AVclForm.Form);
 85       end;
 86       Break;
 87     end;
 88   end;
 89 end;
 90 
 91 procedure TfrmMain.FormCreate(Sender: TObject);
 92 var
 93   APath: string;
 94   AFormService: IQFormService;
 95   AParam: IQParam;
 96 begin
 97   DisableAero := True;
 98   FFormList := TList.Create;
 99   APath := ExtractFilePath(Application.ExeName);
100   PluginsManager.Loaders.Add(TQDLLLoader.Create(APath, '.dll'));
101   PluginsManager.Start;
102   if GetService('/Services/Docks/Forms/System/LoginForm', IQFormService, AFormService) then
103   begin
104     AFormService.ShowModal(AfterLogin);
105   end
106   else
107     Application.Terminate;
108 end;
109 
110 procedure TfrmMain.FormDestroy(Sender: TObject);
111 var
112   AFormService: IQFormService;
113 begin
114   for var I: Integer := 0 to FFormList.Count - 1 do
115   begin
116     AFormService := IQFormService(FFormList[I]);
117     AFormService.UnhookEvents;
118   end;
119   FFormList.Free;
120 end;
121 
122 procedure TfrmMain.FormShow(Sender: TObject);
123 begin
124   if dxRibbon1.Tabs.Count < 2 then
125     dxRibbon1.ShowTabHeaders := False;
126 end;