/ideintf/oifavouriteproperties.pas

http://github.com/graemeg/lazarus · Pascal · 664 lines · 540 code · 61 blank · 63 comment · 59 complexity · 96b7b4a68cf5ac2eadc06a21772aa470 MD5 · raw file

  1. { $Id: oifavouriteproperties.pas 17395 2008-11-15 03:53:22Z paul $}
  2. {
  3. *****************************************************************************
  4. * *
  5. * See the file COPYING.modifiedLGPL.txt, included in this distribution, *
  6. * for details about the copyright. *
  7. * *
  8. * This program is distributed in the hope that it will be useful, *
  9. * but WITHOUT ANY WARRANTY; without even the implied warranty of *
  10. * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
  11. * *
  12. *****************************************************************************
  13. }
  14. unit OIFavouriteProperties;
  15. {$MODE OBJFPC}{$H+}
  16. interface
  17. uses
  18. // FCL
  19. SysUtils, Classes,
  20. // LCL
  21. LCLProc, InterfaceBase, LazConfigStorage, PropEdits;
  22. type
  23. TWidgetSetRestrictionsArray = array [TLCLPlatform] of Integer;
  24. { TOIFavouriteProperty
  25. BaseClassName }
  26. TOIFavouriteProperty = class
  27. protected
  28. BaseClass: TPersistentClass;
  29. BaseClassname: string;
  30. PropertyName: string;
  31. Include: boolean; // include or exclude
  32. public
  33. constructor Create(ABaseClass: TPersistentClass;
  34. const APropertyName: string; TheInclude: boolean);
  35. function Constrains(AnItem: TOIFavouriteProperty): boolean;
  36. function IsFavourite(AClass: TPersistentClass;
  37. const APropertyName: string): boolean;
  38. function Compare(AFavourite: TOIFavouriteProperty): integer;
  39. procedure SaveToConfig(ConfigStore: TConfigStorage; const Path: string);
  40. procedure Assign(Src: TOIFavouriteProperty); virtual;
  41. function CreateCopy: TOIFavouriteProperty;
  42. function DebugReportAsString: string;
  43. end;
  44. { TOIRestrictedProperty}
  45. TOIRestrictedProperty = class(TOIFavouriteProperty)
  46. protected
  47. FWidgetSets: TLCLPlatforms;
  48. public
  49. function IsRestricted(AClass: TPersistentClass;
  50. const APropertyName: string): TLCLPlatforms;
  51. procedure CheckRestrictions(
  52. AClass: TClass; var ARestrictions: TWidgetSetRestrictionsArray);
  53. property WidgetSets: TLCLPlatforms read FWidgetSets write FWidgetSets;
  54. end;
  55. { TOIFavouriteProperties }
  56. TOIFavouriteProperties = class
  57. private
  58. FItems: TFPList; // list of TOIFavouriteProperty
  59. FModified: Boolean;
  60. FSorted: Boolean;
  61. FDoublesDeleted: Boolean;
  62. protected
  63. function GetCount: integer; virtual;
  64. function GetItems(Index: integer): TOIFavouriteProperty; virtual;
  65. public
  66. constructor Create;
  67. destructor Destroy; override;
  68. procedure Clear; virtual;
  69. procedure Assign(Src: TOIFavouriteProperties); virtual;
  70. function CreateCopy: TOIFavouriteProperties;
  71. function Contains(AnItem: TOIFavouriteProperty): Boolean; virtual;
  72. procedure Add(NewItem: TOIFavouriteProperty); virtual;
  73. procedure AddNew(NewItem: TOIFavouriteProperty);
  74. procedure Remove(AnItem: TOIFavouriteProperty); virtual;
  75. procedure DeleteConstraints(AnItem: TOIFavouriteProperty); virtual;
  76. function IsFavourite(
  77. AClass: TPersistentClass; const PropertyName: string): boolean;
  78. function AreFavourites(
  79. Selection: TPersistentSelectionList; const PropertyName: string): boolean;
  80. procedure LoadFromConfig(ConfigStore: TConfigStorage; const Path: string);
  81. procedure SaveToConfig(ConfigStore: TConfigStorage; const Path: string);
  82. procedure MergeConfig(ConfigStore: TConfigStorage; const Path: string);
  83. procedure SaveNewItemsToConfig(
  84. ConfigStore: TConfigStorage;
  85. const Path: string; BaseFavourites: TOIFavouriteProperties);
  86. procedure Sort; virtual;
  87. procedure DeleteDoubles; virtual;
  88. function IsEqual(TheFavourites: TOIFavouriteProperties): boolean;
  89. function GetSubtractList(FavouritesToSubtract: TOIFavouriteProperties): TList;
  90. procedure WriteDebugReport;
  91. public
  92. property Items[Index: integer]: TOIFavouriteProperty read GetItems; default;
  93. property Count: integer read GetCount;
  94. property Modified: Boolean read FModified write FModified;
  95. property Sorted: Boolean read FSorted;
  96. property DoublesDeleted: boolean read FDoublesDeleted;
  97. end;
  98. TOIFavouritePropertiesClass = class of TOIFavouriteProperties;
  99. { TOIRestrictedProperties }
  100. TOIRestrictedProperties = class(TOIFavouriteProperties)
  101. protected
  102. FWidgetSetRestrictions: TWidgetSetRestrictionsArray;
  103. public
  104. constructor Create;
  105. function IsRestricted(AClass: TPersistentClass;
  106. const PropertyName: string): TLCLPlatforms;
  107. function AreRestricted(Selection: TPersistentSelectionList;
  108. const PropertyName: string): TLCLPlatforms;
  109. property WidgetSetRestrictions: TWidgetSetRestrictionsArray
  110. read FWidgetSetRestrictions;
  111. end;
  112. implementation
  113. function CompareOIFavouriteProperties(Data1, Data2: Pointer): integer;
  114. var
  115. Favourite1: TOIFavouriteProperty;
  116. Favourite2: TOIFavouriteProperty;
  117. begin
  118. Favourite1:=TOIFavouriteProperty(Data1);
  119. Favourite2:=TOIFavouriteProperty(Data2);
  120. Result:=Favourite1.Compare(Favourite2)
  121. end;
  122. { TOIFavouriteProperties }
  123. function TOIFavouriteProperties.GetCount: integer;
  124. begin
  125. Result:=FItems.Count;
  126. end;
  127. function TOIFavouriteProperties.GetItems(Index: integer): TOIFavouriteProperty;
  128. begin
  129. Result:=TOIFavouriteProperty(FItems[Index]);
  130. end;
  131. constructor TOIFavouriteProperties.Create;
  132. begin
  133. FItems:=TFPList.Create;
  134. end;
  135. destructor TOIFavouriteProperties.Destroy;
  136. begin
  137. Clear;
  138. FreeAndNil(FItems);
  139. inherited Destroy;
  140. end;
  141. procedure TOIFavouriteProperties.Clear;
  142. var
  143. i: Integer;
  144. begin
  145. for i:=0 to FItems.Count-1 do
  146. TObject(FItems[i]).Free;
  147. FItems.Clear;
  148. FSorted:=true;
  149. end;
  150. procedure TOIFavouriteProperties.Assign(Src: TOIFavouriteProperties);
  151. var
  152. i: Integer;
  153. begin
  154. Clear;
  155. for i:=0 to Src.Count-1 do
  156. FItems.Add(Src[i].CreateCopy);
  157. FModified:=Src.Modified;
  158. FDoublesDeleted:=Src.DoublesDeleted;
  159. FSorted:=Src.Sorted;
  160. end;
  161. function TOIFavouriteProperties.CreateCopy: TOIFavouriteProperties;
  162. begin
  163. Result:=TOIFavouriteProperties.Create;
  164. Result.Assign(Self);
  165. end;
  166. function TOIFavouriteProperties.Contains(AnItem: TOIFavouriteProperty
  167. ): Boolean;
  168. var
  169. i: Integer;
  170. begin
  171. for i:=Count-1 downto 0 do begin
  172. if Items[i].Compare(AnItem)=0 then begin
  173. Result:=true;
  174. exit;
  175. end;
  176. end;
  177. Result:=false;
  178. end;
  179. procedure TOIFavouriteProperties.Add(NewItem: TOIFavouriteProperty);
  180. begin
  181. FItems.Add(NewItem);
  182. FSorted:=(Count<=1)
  183. or (FSorted and (Items[Count-1].Compare(Items[Count-2])<0));
  184. FDoublesDeleted:=FSorted
  185. and ((Count<=1) or (Items[Count-1].Compare(Items[Count-2])<>0));
  186. Modified:=true;
  187. end;
  188. procedure TOIFavouriteProperties.AddNew(NewItem: TOIFavouriteProperty);
  189. begin
  190. if Contains(NewItem) then
  191. NewItem.Free
  192. else
  193. Add(NewItem);
  194. end;
  195. procedure TOIFavouriteProperties.Remove(AnItem: TOIFavouriteProperty);
  196. begin
  197. Modified:=FItems.Remove(AnItem)>=0;
  198. end;
  199. procedure TOIFavouriteProperties.DeleteConstraints(
  200. AnItem: TOIFavouriteProperty);
  201. // delete all items, that would constrain AnItem
  202. var
  203. i: Integer;
  204. CurItem: TOIFavouriteProperty;
  205. begin
  206. for i:=Count-1 downto 0 do begin
  207. CurItem:=Items[i];
  208. if CurItem.Constrains(AnItem) then begin
  209. FItems.Delete(i);
  210. Modified:=true;
  211. CurItem.Free;
  212. end;
  213. end;
  214. end;
  215. function TOIFavouriteProperties.IsFavourite(AClass: TPersistentClass;
  216. const PropertyName: string): boolean;
  217. var
  218. i: Integer;
  219. CurItem: TOIFavouriteProperty;
  220. BestItem: TOIFavouriteProperty;
  221. begin
  222. if (AClass=nil) or (PropertyName='') then begin
  223. Result:=false;
  224. exit;
  225. end;
  226. BestItem:=nil;
  227. for i:=0 to Count-1 do begin
  228. CurItem:=Items[i];
  229. if not CurItem.IsFavourite(AClass,PropertyName) then continue;
  230. if (BestItem=nil)
  231. or (AClass.InheritsFrom(BestItem.BaseClass)) then begin
  232. //debugln('TOIFavouriteProperties.IsFavourite ',AClass.ClassName,' ',PropertyName);
  233. BestItem:=CurItem;
  234. end;
  235. end;
  236. Result:=(BestItem<>nil) and BestItem.Include;
  237. end;
  238. function TOIFavouriteProperties.AreFavourites(
  239. Selection: TPersistentSelectionList; const PropertyName: string): boolean;
  240. var
  241. i: Integer;
  242. begin
  243. Result:=(Selection<>nil) and (Selection.Count>0);
  244. if not Result then exit;
  245. for i:=0 to Selection.Count-1 do begin
  246. if not IsFavourite(TPersistentClass(Selection[i].ClassType),PropertyName)
  247. then begin
  248. Result:=false;
  249. exit;
  250. end;
  251. end;
  252. end;
  253. procedure TOIFavouriteProperties.LoadFromConfig(ConfigStore: TConfigStorage;
  254. const Path: string);
  255. var
  256. NewCount: LongInt;
  257. i: Integer;
  258. NewItem: TOIFavouriteProperty;
  259. p: String;
  260. NewPropertyName: String;
  261. NewInclude: Boolean;
  262. NewBaseClassname: String;
  263. NewBaseClass: TPersistentClass;
  264. begin
  265. Clear;
  266. NewCount:=ConfigStore.GetValue(Path+'Count',0);
  267. for i:=0 to NewCount-1 do begin
  268. p:=Path+'Item'+IntToStr(i)+'/';
  269. NewPropertyName:=ConfigStore.GetValue(p+'PropertyName','');
  270. if (NewPropertyName='') or (not IsValidIdent(NewPropertyName)) then
  271. continue;
  272. NewInclude:=ConfigStore.GetValue(p+'Include',true);
  273. NewBaseClassname:=ConfigStore.GetValue(p+'BaseClass','');
  274. if (NewBaseClassname='') or (not IsValidIdent(NewBaseClassname)) then
  275. continue;
  276. NewBaseClass:=GetClass(NewBaseClassname);
  277. NewItem:=TOIFavouriteProperty.Create(NewBaseClass,NewPropertyName,
  278. NewInclude);
  279. NewItem.BaseClassName:=NewBaseClassname;
  280. Add(NewItem);
  281. end;
  282. {$IFDEF DebugFavouriteroperties}
  283. debugln('TOIFavouriteProperties.LoadFromConfig END');
  284. WriteDebugReport;
  285. {$ENDIF}
  286. end;
  287. procedure TOIFavouriteProperties.SaveToConfig(ConfigStore: TConfigStorage;
  288. const Path: string);
  289. var
  290. i: Integer;
  291. begin
  292. ConfigStore.SetDeleteValue(Path+'Count',Count,0);
  293. for i:=0 to Count-1 do
  294. Items[i].SaveToConfig(ConfigStore,Path+'Item'+IntToStr(i)+'/');
  295. end;
  296. procedure TOIFavouriteProperties.MergeConfig(ConfigStore: TConfigStorage;
  297. const Path: string);
  298. var
  299. NewFavourites: TOIFavouriteProperties;
  300. OldItem: TOIFavouriteProperty;
  301. NewItem: TOIFavouriteProperty;
  302. cmp: LongInt;
  303. NewIndex: Integer;
  304. OldIndex: Integer;
  305. begin
  306. NewFavourites:=TOIFavouritePropertiesClass(ClassType).Create;
  307. {$IFDEF DebugFavouriteroperties}
  308. debugln('TOIFavouriteProperties.MergeConfig ',dbgsName(NewFavourites),' ',dbgsName(NewFavourites.FItems));
  309. {$ENDIF}
  310. try
  311. // load config
  312. NewFavourites.LoadFromConfig(ConfigStore,Path);
  313. // sort both to see the differences
  314. NewFavourites.DeleteDoubles; // descending
  315. DeleteDoubles; // descending
  316. // add all new things from NewFavourites
  317. NewIndex:=0;
  318. OldIndex:=0;
  319. while (NewIndex<NewFavourites.Count) do begin
  320. NewItem:=NewFavourites[NewIndex];
  321. if OldIndex>=Count then begin
  322. // item only exists in config -> move to this list
  323. NewFavourites.FItems[NewIndex]:=nil;
  324. inc(NewIndex);
  325. FItems.Insert(OldIndex,NewItem);
  326. inc(OldIndex);
  327. end else begin
  328. OldItem:=Items[OldIndex];
  329. cmp:=OldItem.Compare(NewItem);
  330. //debugln('TOIFavouriteProperties.MergeConfig cmp=',dbgs(cmp),' OldItem=[',OldItem.DebugReportAsString,'] NewItem=[',NewItem.DebugReportAsString,']');
  331. if cmp=0 then begin
  332. // item already exists in this list
  333. inc(NewIndex);
  334. inc(OldIndex);
  335. end else if cmp<0 then begin
  336. // item exists only in old favourites
  337. // -> next old
  338. inc(OldIndex);
  339. end else begin
  340. // item only exists in config -> move to this list
  341. NewFavourites.FItems[NewIndex]:=nil;
  342. inc(NewIndex);
  343. FItems.Insert(OldIndex,NewItem);
  344. inc(OldIndex);
  345. end;
  346. end;
  347. end;
  348. finally
  349. NewFavourites.Free;
  350. end;
  351. {$IFDEF DebugFavouriteroperties}
  352. debugln('TOIFavouriteProperties.MergeConfig END');
  353. WriteDebugReport;
  354. {$ENDIF}
  355. end;
  356. procedure TOIFavouriteProperties.SaveNewItemsToConfig(
  357. ConfigStore: TConfigStorage; const Path: string;
  358. BaseFavourites: TOIFavouriteProperties);
  359. // Save all items, that are in this list and not in BaseFavourites
  360. // It does not save, if an item in BaseFavourites is missing in this list
  361. var
  362. SubtractList: TList;
  363. i: Integer;
  364. CurItem: TOIFavouriteProperty;
  365. begin
  366. SubtractList:=GetSubtractList(BaseFavourites);
  367. try
  368. ConfigStore.SetDeleteValue(Path+'Count',SubtractList.Count,0);
  369. {$IFDEF DebugFavouriteroperties}
  370. debugln('TOIFavouriteProperties.SaveNewItemsToConfig A Count=',dbgs(SubtractList.Count));
  371. {$ENDIF}
  372. for i:=0 to SubtractList.Count-1 do begin
  373. CurItem:=TOIFavouriteProperty(SubtractList[i]);
  374. CurItem.SaveToConfig(ConfigStore,Path+'Item'+IntToStr(i)+'/');
  375. {$IFDEF DebugFavouriteroperties}
  376. debugln(' i=',dbgs(i),' ',CurItem.DebugReportAsString);
  377. {$ENDIF}
  378. end;
  379. finally
  380. SubtractList.Free;
  381. end;
  382. end;
  383. procedure TOIFavouriteProperties.Sort;
  384. begin
  385. if FSorted then exit;
  386. FItems.Sort(@CompareOIFavouriteProperties);
  387. end;
  388. procedure TOIFavouriteProperties.DeleteDoubles;
  389. // This also sorts
  390. var
  391. i: Integer;
  392. begin
  393. if FDoublesDeleted then exit;
  394. Sort;
  395. for i:=Count-1 downto 1 do begin
  396. if Items[i].Compare(Items[i-1])=0 then begin
  397. Items[i].Free;
  398. FItems.Delete(i);
  399. end;
  400. end;
  401. FDoublesDeleted:=true;
  402. end;
  403. function TOIFavouriteProperties.IsEqual(TheFavourites: TOIFavouriteProperties
  404. ): boolean;
  405. var
  406. i: Integer;
  407. begin
  408. Result:=false;
  409. DeleteDoubles;
  410. TheFavourites.DeleteDoubles;
  411. if Count<>TheFavourites.Count then exit;
  412. for i:=Count-1 downto 1 do
  413. if Items[i].Compare(TheFavourites.Items[i])<>0 then exit;
  414. Result:=true;
  415. end;
  416. function TOIFavouriteProperties.GetSubtractList(
  417. FavouritesToSubtract: TOIFavouriteProperties): TList;
  418. // create a list of TOIFavouriteProperty of all items in this list
  419. // and not in FavouritesToSubtract
  420. var
  421. SelfIndex: Integer;
  422. SubtractIndex: Integer;
  423. CurItem: TOIFavouriteProperty;
  424. cmp: LongInt;
  425. begin
  426. Result:=TList.Create;
  427. DeleteDoubles; // this also sorts descending
  428. FavouritesToSubtract.DeleteDoubles; // this also sorts descending
  429. SelfIndex:=0;
  430. SubtractIndex:=0;
  431. while SelfIndex<Count do begin
  432. CurItem:=Items[SelfIndex];
  433. if SubtractIndex>=FavouritesToSubtract.Count then begin
  434. // item does not exist in SubtractIndex -> add it
  435. Result.Add(CurItem);
  436. inc(SelfIndex);
  437. end else begin
  438. cmp:=CurItem.Compare(FavouritesToSubtract[SubtractIndex]);
  439. //debugln('TOIFavouriteProperties.GetSubtractList cmp=',dbgs(cmp),' CurItem=[',CurItem.DebugReportAsString,'] SubtractItem=[',FavouritesToSubtract[SubtractIndex].DebugReportAsString,']');
  440. if cmp=0 then begin
  441. // item exists in SubtractIndex -> skip
  442. inc(SubtractIndex);
  443. inc(SelfIndex);
  444. end else if cmp>0 then begin
  445. // item does not exist in FavouritesToSubtract -> add it
  446. Result.Add(CurItem);
  447. inc(SelfIndex);
  448. end else begin
  449. // item exists only in FavouritesToSubtract -> skip
  450. inc(SubtractIndex);
  451. end;
  452. end;
  453. end;
  454. end;
  455. procedure TOIFavouriteProperties.WriteDebugReport;
  456. var
  457. i: Integer;
  458. begin
  459. debugln('TOIFavouriteProperties.WriteDebugReport Count=',dbgs(Count));
  460. for i:=0 to Count-1 do
  461. debugln(' i=',dbgs(i),' ',Items[i].DebugReportAsString);
  462. end;
  463. { TOIFavouriteProperty }
  464. constructor TOIFavouriteProperty.Create(ABaseClass: TPersistentClass;
  465. const APropertyName: string; TheInclude: boolean);
  466. begin
  467. BaseClass:=ABaseClass;
  468. PropertyName:=APropertyName;
  469. Include:=TheInclude;
  470. end;
  471. function TOIFavouriteProperty.Constrains(AnItem: TOIFavouriteProperty
  472. ): boolean;
  473. // true if this item constrains AnItem
  474. // This item constrains AnItem, if this is the opposite (Include) and
  475. // AnItem has the same or greater scope
  476. begin
  477. Result:=(Include<>AnItem.Include)
  478. and (CompareText(PropertyName,AnItem.PropertyName)=0)
  479. and (BaseClass.InheritsFrom(AnItem.BaseClass));
  480. end;
  481. function TOIFavouriteProperty.IsFavourite(AClass: TPersistentClass;
  482. const APropertyName: string): boolean;
  483. begin
  484. Result:=(CompareText(PropertyName,APropertyName)=0)
  485. and (AClass.InheritsFrom(BaseClass));
  486. end;
  487. function TOIFavouriteProperty.Compare(AFavourite: TOIFavouriteProperty
  488. ): integer;
  489. function CompareBaseClass: integer;
  490. begin
  491. if BaseClass<>nil then begin
  492. if AFavourite.BaseClass<>nil then
  493. Result:=ComparePointers(BaseClass,AFavourite.BaseClass)
  494. else
  495. Result:=CompareText(BaseClass.ClassName,AFavourite.BaseClassName);
  496. end else begin
  497. if AFavourite.BaseClass<>nil then
  498. Result:=CompareText(BaseClassName,AFavourite.BaseClass.ClassName)
  499. else
  500. Result:=CompareText(BaseClassName,AFavourite.BaseClassName);
  501. end;
  502. end;
  503. begin
  504. // first compare PropertyName
  505. Result:=CompareText(PropertyName,AFavourite.PropertyName);
  506. if Result<>0 then exit;
  507. // then compare Include
  508. if Include<>AFavourite.Include then begin
  509. if Include then
  510. Result:=1
  511. else
  512. Result:=-1;
  513. exit;
  514. end;
  515. // then compare BaseClass and BaseClassName
  516. Result:=CompareBaseClass;
  517. end;
  518. procedure TOIFavouriteProperty.SaveToConfig(ConfigStore: TConfigStorage;
  519. const Path: string);
  520. begin
  521. if BaseClass<>nil then
  522. ConfigStore.SetDeleteValue(Path+'BaseClass',BaseClass.ClassName,'')
  523. else
  524. ConfigStore.SetDeleteValue(Path+'BaseClass',BaseClassName,'');
  525. ConfigStore.SetDeleteValue(Path+'PropertyName',PropertyName,'');
  526. ConfigStore.SetDeleteValue(Path+'Include',Include,true);
  527. end;
  528. procedure TOIFavouriteProperty.Assign(Src: TOIFavouriteProperty);
  529. begin
  530. BaseClassName:=Src.BaseClassName;
  531. BaseClass:=Src.BaseClass;
  532. PropertyName:=Src.PropertyName;
  533. Include:=Src.Include;
  534. end;
  535. function TOIFavouriteProperty.CreateCopy: TOIFavouriteProperty;
  536. begin
  537. Result:=TOIFavouriteProperty.Create(BaseClass,PropertyName,Include);
  538. Result.BaseClass:=BaseClass;
  539. end;
  540. function TOIFavouriteProperty.DebugReportAsString: string;
  541. begin
  542. Result:='PropertyName="'+PropertyName+'"'
  543. +' Include='+dbgs(Include)
  544. +' BaseClassName="'+BaseClassName+'"'
  545. +' BaseClass='+dbgsName(BaseClass);
  546. end;
  547. { TOIRestrictedProperty }
  548. procedure TOIRestrictedProperty.CheckRestrictions(
  549. AClass: TClass; var ARestrictions: TWidgetSetRestrictionsArray);
  550. var
  551. lclPlatform: TLCLPlatform;
  552. begin
  553. if AClass.InheritsFrom(BaseClass) and (PropertyName = '') then
  554. for lclPlatform := Low(TLCLPlatform) to High(TLCLPlatform) do
  555. if lclPlatform in WidgetSets then
  556. Inc(ARestrictions[lclPlatform]);
  557. end;
  558. function TOIRestrictedProperty.IsRestricted(AClass: TPersistentClass;
  559. const APropertyName: string): TLCLPlatforms;
  560. begin
  561. //DebugLn('IsRestricted ', AClass.ClassName, ' ?= ', BaseClass.ClassName, ' ', APropertyName, ' ?= ', PropertyName);
  562. Result := [];
  563. if (CompareText(PropertyName,APropertyName) = 0)
  564. and (AClass.InheritsFrom(BaseClass)) then Result := WidgetSets;
  565. end;
  566. { TOIRestrictedProperties }
  567. constructor TOIRestrictedProperties.Create;
  568. var
  569. P: TLCLPlatform;
  570. begin
  571. inherited Create;
  572. for P := Low(TLCLPlatform) to High(TLCLPlatform) do
  573. FWidgetSetRestrictions[P] := 0;
  574. end;
  575. function TOIRestrictedProperties.IsRestricted(AClass: TPersistentClass;
  576. const PropertyName: string): TLCLPlatforms;
  577. var
  578. I: Integer;
  579. CurItem: TOIRestrictedProperty;
  580. begin
  581. Result := [];
  582. if (AClass=nil) or (PropertyName='') then Exit;
  583. for I := 0 to Count - 1 do
  584. begin
  585. if not (Items[I] is TOIRestrictedProperty) then Continue;
  586. CurItem:=Items[I] as TOIRestrictedProperty;
  587. Result := Result + CurItem.IsRestricted(AClass,PropertyName);
  588. end;
  589. end;
  590. function TOIRestrictedProperties.AreRestricted(
  591. Selection: TPersistentSelectionList;
  592. const PropertyName: string): TLCLPlatforms;
  593. var
  594. I: Integer;
  595. begin
  596. Result := [];
  597. if Selection = nil then Exit;
  598. for i:=0 to Selection.Count-1 do
  599. begin
  600. Result := Result + IsRestricted(TPersistentClass(Selection[i].ClassType), PropertyName);
  601. end;
  602. end;
  603. end.