home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d6 / RX275D6.ZIP / Units / PRESRDSN.PAS < prev    next >
Pascal/Delphi Source File  |  2001-06-24  |  14KB  |  479 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 1995, 1996 AO ROSNO             }
  6. {                                                       }
  7. {*******************************************************}
  8.  
  9. unit PresrDsn;
  10.  
  11. {$I RX.INC}
  12.  
  13. interface
  14.  
  15. uses
  16.   SysUtils, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, 
  17.   Buttons, ExtCtrls, RXCtrls, Placemnt, RXProps, Consts, RTLConsts, DesignIntf, DesignEditors, VCLEditors, VclUtils;
  18.  
  19. type
  20.  
  21. {$IFNDEF RX_D4}
  22.   IDesigner = TDesigner;
  23. {$ENDIF}
  24.  
  25. { TFormPropsDlg }
  26.  
  27.   TFormPropsDlg = class(TForm)
  28.     Bevel1: TBevel;
  29.     Label30: TLabel;
  30.     Label31: TLabel;
  31.     Label2: TLabel;
  32.     UpBtn: TSpeedButton;
  33.     DownBtn: TSpeedButton;
  34.     StoredList: TTextListBox;
  35.     PropertiesList: TTextListBox;
  36.     ComponentsList: TTextListBox;
  37.     FormBox: TGroupBox;
  38.     ActiveCtrlBox: TCheckBox;
  39.     PositionBox: TCheckBox;
  40.     StateBox: TCheckBox;
  41.     AddButton: TButton;
  42.     DeleteButton: TButton;
  43.     ClearButton: TButton;
  44.     OkBtn: TButton;
  45.     CancelBtn: TButton;
  46.     procedure AddButtonClick(Sender: TObject);
  47.     procedure ClearButtonClick(Sender: TObject);
  48.     procedure ListClick(Sender: TObject);
  49.     procedure FormDestroy(Sender: TObject);
  50.     procedure DeleteButtonClick(Sender: TObject);
  51.     procedure StoredListClick(Sender: TObject);
  52.     procedure UpBtnClick(Sender: TObject);
  53.     procedure DownBtnClick(Sender: TObject);
  54.     procedure StoredListDragOver(Sender, Source: TObject; X, Y: Integer;
  55.       State: TDragState; var Accept: Boolean);
  56.     procedure StoredListDragDrop(Sender, Source: TObject; X, Y: Integer);
  57.     procedure PropertiesListDblClick(Sender: TObject);
  58.   private
  59.     { Private declarations }
  60.     FCompOwner: TComponent;
  61.     FDesigner: IDesigner;
  62.     procedure ListToIndex(List: TCustomListBox; Idx: Integer);
  63.     procedure UpdateCurrent;
  64.     procedure DeleteProp(I: Integer);
  65.     function FindProp(const CompName, PropName: string; var IdxComp,
  66.       IdxProp: Integer): Boolean;
  67.     procedure ClearLists;
  68.     procedure CheckAddItem(const CompName, PropName: string);
  69.     procedure AddItem(IdxComp, IdxProp: Integer; AUpdate: Boolean);
  70.     procedure BuildLists(StoredProps: TStrings);
  71.     procedure CheckButtons;
  72.     procedure SetStoredList(AList: TStrings);
  73.   public
  74.     { Public declarations }
  75.   end;
  76.  
  77. { TFormStorageEditor }
  78.  
  79.   TFormStorageEditor = class(TComponentEditor)
  80.     procedure ExecuteVerb(Index: Integer); override;
  81.     function GetVerb(Index: Integer): string; override;
  82.     function GetVerbCount: Integer; override;
  83.   end;
  84.  
  85. { TStoredPropsProperty }
  86.  
  87.   TStoredPropsProperty = class(TClassProperty)
  88.   public
  89.     function GetAttributes: TPropertyAttributes; override;
  90.     function GetValue: string; override;
  91.     procedure Edit; override;
  92.   end;
  93.  
  94. { Show component editor }
  95. function ShowStorageDesigner(ACompOwner: TComponent; ADesigner: IDesigner;
  96.   AStoredList: TStrings; var Options: TPlacementOptions): Boolean;
  97.  
  98. implementation
  99.  
  100. {$IFDEF WIN32}
  101. uses Windows, BoxProcs, TypInfo, RXLConst;
  102. {$ELSE}
  103. uses WinTypes, WinProcs, Str16, BoxProcs, TypInfo, RXLConst;
  104. {$ENDIF}
  105.  
  106. {$R *.DFM}
  107.  
  108. {$IFDEF WIN32}
  109.  {$D-}
  110. {$ENDIF}
  111.  
  112. { TFormStorageEditor }
  113.  
  114. procedure TFormStorageEditor.ExecuteVerb(Index: Integer);
  115. var
  116.   Storage: TFormStorage;
  117.   Opt: TPlacementOptions;
  118. begin
  119.   Storage := Component as TFormStorage;
  120.   if Index = 0 then begin
  121.     Opt := Storage.Options;
  122.     if ShowStorageDesigner(TComponent(Storage.Owner), Designer,
  123.       Storage.StoredProps, Opt) then
  124.     begin
  125.       Storage.Options := Opt;
  126. {$IFDEF WIN32}
  127.       Storage.SetNotification;
  128. {$ENDIF}
  129.     end;
  130.   end;
  131. end;
  132.  
  133. function TFormStorageEditor.GetVerb(Index: Integer): string;
  134. begin
  135.   case Index of
  136.     0: Result := LoadStr(srStorageDesigner);
  137.     else Result := '';
  138.   end;
  139. end;
  140.  
  141. function TFormStorageEditor.GetVerbCount: Integer;
  142. begin
  143.   Result := 1;
  144. end;
  145.  
  146. { TStoredPropsProperty }
  147.  
  148. function TStoredPropsProperty.GetAttributes: TPropertyAttributes;
  149. begin
  150.   Result := inherited GetAttributes + [paDialog] - [paSubProperties];
  151. end;
  152.  
  153. function TStoredPropsProperty.GetValue: string;
  154. begin
  155.   if TStrings(GetOrdValue).Count > 0 then Result := inherited GetValue
  156.   else Result := ResStr(srNone);
  157. end;
  158.  
  159. procedure TStoredPropsProperty.Edit;
  160. var
  161.   Storage: TFormStorage;
  162.   Opt: TPlacementOptions;
  163. begin
  164.   Storage := GetComponent(0) as TFormStorage;
  165.   Opt := Storage.Options;
  166.   if ShowStorageDesigner(Storage.Owner as TComponent, Designer,
  167.     Storage.StoredProps, Opt) then
  168.   begin
  169.     Storage.Options := Opt;
  170. {$IFDEF WIN32}
  171.     Storage.SetNotification;
  172. {$ENDIF}
  173.   end;
  174. end;
  175.  
  176. { Show component editor }
  177.  
  178. function ShowStorageDesigner(ACompOwner: TComponent; ADesigner: IDesigner;
  179.   AStoredList: TStrings; var Options: TPlacementOptions): Boolean;
  180. begin
  181.   with TFormPropsDlg.Create(Application) do
  182.   try
  183.     FCompOwner := ACompOwner;
  184.     FDesigner := ADesigner;
  185.     Screen.Cursor := crHourGlass;
  186.     try
  187.       UpdateStoredList(ACompOwner, AStoredList, False);
  188.       SetStoredList(AStoredList);
  189.       ActiveCtrlBox.Checked := fpActiveControl in Options;
  190.       PositionBox.Checked := fpPosition in Options;
  191.       StateBox.Checked := fpState in Options;
  192.     finally
  193.       Screen.Cursor := crDefault;
  194.     end;
  195.     Result := ShowModal = mrOk;
  196.     if Result then begin
  197.       AStoredList.Assign(StoredList.Items);
  198.       Options := [];
  199.       if ActiveCtrlBox.Checked then Include(Options, fpActiveControl);
  200.       if PositionBox.Checked then Include(Options, fpPosition);
  201.       if StateBox.Checked then Include(Options, fpState);
  202.     end;
  203.   finally
  204.     Free;
  205.   end;
  206. end;
  207.  
  208. { TFormPropsDlg }
  209.  
  210. procedure TFormPropsDlg.ListToIndex(List: TCustomListBox; Idx: Integer);
  211.  
  212.   procedure SetItemIndex(Index: Integer);
  213.   begin
  214.     if TTextListBox(List).MultiSelect then
  215.       TTextListBox(List).Selected[Index] := True;
  216.     List.ItemIndex := Index;
  217.   end;
  218.  
  219. begin
  220.   if Idx < List.Items.Count then
  221.     SetItemIndex(Idx)
  222.   else if Idx - 1 < List.Items.Count then
  223.     SetItemIndex(Idx - 1)
  224.   else if (List.Items.Count > 0) then
  225.     SetItemIndex(0);
  226. end;
  227.  
  228. procedure TFormPropsDlg.UpdateCurrent;
  229. var
  230.   IdxProp: Integer;
  231.   List: TStrings;
  232. begin
  233.   IdxProp := PropertiesList.ItemIndex;
  234.   if IdxProp < 0 then IdxProp := 0;
  235.   if ComponentsList.Items.Count <= 0 then
  236.   begin
  237.     PropertiesList.Clear;
  238.     Exit;
  239.   end;
  240.   if (ComponentsList.ItemIndex < 0) then
  241.     ComponentsList.ItemIndex := 0;
  242.   List := TStrings(ComponentsList.Items.Objects[ComponentsList.ItemIndex]);
  243.   if List.Count > 0 then PropertiesList.Items := List
  244.   else PropertiesList.Clear;
  245.   ListToIndex(PropertiesList, IdxProp);
  246.   CheckButtons;
  247. end;
  248.  
  249. procedure TFormPropsDlg.DeleteProp(I: Integer);
  250. var
  251.   CompName, PropName: string;
  252.   IdxComp, IdxProp, Idx: Integer;
  253.   StrList: TStringList;
  254. begin
  255.   Idx := StoredList.ItemIndex;
  256.   if ParseStoredItem(StoredList.Items[I], CompName, PropName) then begin
  257.     StoredList.Items.Delete(I);
  258.     if FDesigner <> nil then FDesigner.Modified;
  259.     ListToIndex(StoredList, Idx);
  260.     {I := ComponentsList.ItemIndex;}
  261.     if not FindProp(CompName, PropName, IdxComp, IdxProp) then begin
  262.       if IdxComp < 0 then begin
  263.         StrList := TStringList.Create;
  264.         try
  265.           StrList.Add(PropName);
  266.           ComponentsList.Items.AddObject(CompName, StrList);
  267.           ComponentsList.ItemIndex := ComponentsList.Items.IndexOf(CompName);
  268.         except
  269.           StrList.Free;
  270.           raise;
  271.         end;
  272.       end
  273.       else begin
  274.         TStrings(ComponentsList.Items.Objects[IdxComp]).Add(PropName);
  275.       end;
  276.       UpdateCurrent;
  277.     end;
  278.   end;
  279. end;
  280.  
  281. function TFormPropsDlg.FindProp(const CompName, PropName: string; var IdxComp,
  282.   IdxProp: Integer): Boolean;
  283. begin
  284.   Result := False;
  285.   IdxComp := ComponentsList.Items.IndexOf(CompName);
  286.   if IdxComp >= 0 then begin
  287.     IdxProp := TStrings(ComponentsList.Items.Objects[IdxComp]).IndexOf(PropName);
  288.     if IdxProp >= 0 then Result := True;
  289.   end;
  290. end;
  291.  
  292. procedure TFormPropsDlg.ClearLists;
  293. var
  294.   I: Integer;
  295. begin
  296.   for I := 0 to ComponentsList.Items.Count - 1 do begin
  297.     ComponentsList.Items.Objects[I].Free;
  298.   end;
  299.   ComponentsList.Items.Clear;
  300.   ComponentsList.Clear;
  301.   PropertiesList.Clear;
  302.   StoredList.Clear;
  303. end;
  304.  
  305. procedure TFormPropsDlg.AddItem(IdxComp, IdxProp: Integer; AUpdate: Boolean);
  306. var
  307.   Idx: Integer;
  308.   StrList: TStringList;
  309.   CompName, PropName: string;
  310.   Component: TComponent;
  311. begin
  312.   CompName := ComponentsList.Items[IdxComp];
  313.   Component := FCompOwner.FindComponent(CompName);
  314.   if Component = nil then Exit;
  315.   StrList := TStringList(ComponentsList.Items.Objects[IdxComp]);
  316.   PropName := StrList[IdxProp];
  317.   StrList.Delete(IdxProp);
  318.   if StrList.Count = 0 then begin
  319.     Idx := ComponentsList.ItemIndex;
  320.     StrList.Free;
  321.     ComponentsList.Items.Delete(IdxComp);
  322.     ListToIndex(ComponentsList, Idx);
  323.   end;
  324.   StoredList.Items.AddObject(CreateStoredItem(CompName, PropName), Component);
  325.   if FDesigner <> nil then FDesigner.Modified;
  326.   StoredList.ItemIndex := StoredList.Items.Count - 1;
  327.   if AUpdate then UpdateCurrent;
  328. end;
  329.  
  330. procedure TFormPropsDlg.CheckAddItem(const CompName, PropName: string);
  331. var
  332.   IdxComp, IdxProp: Integer;
  333. begin
  334.   if FindProp(CompName, PropName, IdxComp, IdxProp) then
  335.     AddItem(IdxComp, IdxProp, True);
  336. end;
  337.  
  338. procedure TFormPropsDlg.BuildLists(StoredProps: TStrings);
  339. var
  340.   I, J: Integer;
  341.   C: TComponent;
  342.   List: TPropInfoList;
  343.   StrList: TStrings;
  344.   CompName, PropName: string;
  345. begin
  346.   ClearLists;
  347.   if FCompOwner <> nil then begin
  348.     for I := 0 to FCompOwner.ComponentCount - 1 do begin
  349.       C := FCompOwner.Components[I];
  350.       if (C is TFormPlacement) or (C.Name = '') then Continue;
  351.       List := TPropInfoList.Create(C, tkProperties);
  352.       try
  353.         StrList := TStringList.Create;
  354.         try
  355.           TStringList(StrList).Sorted := True;
  356.           for J := 0 to List.Count - 1 do
  357.             StrList.Add(List.Items[J]^.Name);
  358.           ComponentsList.Items.AddObject(C.Name, StrList);
  359.         except
  360.           StrList.Free;
  361.           raise;
  362.         end;
  363.       finally
  364.         List.Free;
  365.       end;
  366.     end;
  367.     if StoredProps <> nil then begin
  368.       for I := 0 to StoredProps.Count - 1 do begin
  369.         if ParseStoredItem(StoredProps[I], CompName, PropName) then
  370.           CheckAddItem(CompName, PropName);
  371.       end;
  372.       ListToIndex(StoredList, 0);
  373.     end;
  374.   end
  375.   else StoredList.Items.Clear;
  376.   UpdateCurrent;
  377. end;
  378.  
  379. procedure TFormPropsDlg.SetStoredList(AList: TStrings);
  380. begin
  381.   BuildLists(AList);
  382.   if ComponentsList.Items.Count > 0 then
  383.     ComponentsList.ItemIndex := 0;
  384.   CheckButtons;
  385. end;
  386.  
  387. procedure TFormPropsDlg.CheckButtons;
  388. var
  389.   Enable: Boolean;
  390. begin
  391.   AddButton.Enabled := (ComponentsList.ItemIndex >= 0) and
  392.     (PropertiesList.ItemIndex >= 0);
  393.   Enable := (StoredList.Items.Count > 0) and
  394.     (StoredList.ItemIndex >= 0);
  395.   DeleteButton.Enabled := Enable;
  396.   ClearButton.Enabled := Enable;
  397.   UpBtn.Enabled := Enable and (StoredList.ItemIndex > 0);
  398.   DownBtn.Enabled := Enable and (StoredList.ItemIndex < StoredList.Items.Count - 1);
  399. end;
  400.  
  401. procedure TFormPropsDlg.AddButtonClick(Sender: TObject);
  402. var
  403.   I: Integer;
  404. begin
  405.   if PropertiesList.SelCount > 0 then begin
  406.     for I := PropertiesList.Items.Count - 1 downto 0 do begin
  407.       if PropertiesList.Selected[I] then
  408.         AddItem(ComponentsList.ItemIndex, I, False);
  409.     end;
  410.     UpdateCurrent;
  411.   end
  412.   else AddItem(ComponentsList.ItemIndex, PropertiesList.ItemIndex, True);
  413.   CheckButtons;
  414. end;
  415.  
  416. procedure TFormPropsDlg.ClearButtonClick(Sender: TObject);
  417. begin
  418.   if StoredList.Items.Count > 0 then begin
  419.     SetStoredList(nil);
  420.     if FDesigner <> nil then FDesigner.Modified;
  421.   end;
  422. end;
  423.  
  424. procedure TFormPropsDlg.DeleteButtonClick(Sender: TObject);
  425. begin
  426.   DeleteProp(StoredList.ItemIndex);
  427. end;
  428.  
  429. procedure TFormPropsDlg.ListClick(Sender: TObject);
  430. begin
  431.   if Sender = ComponentsList then UpdateCurrent
  432.   else CheckButtons;
  433. end;
  434.  
  435. procedure TFormPropsDlg.FormDestroy(Sender: TObject);
  436. begin
  437.   ClearLists;
  438. end;
  439.  
  440. procedure TFormPropsDlg.StoredListClick(Sender: TObject);
  441. begin
  442.   CheckButtons;
  443. end;
  444.  
  445. procedure TFormPropsDlg.UpBtnClick(Sender: TObject);
  446. begin
  447.   BoxMoveFocusedItem(StoredList, StoredList.ItemIndex - 1);
  448.   if FDesigner <> nil then FDesigner.Modified;
  449.   CheckButtons;
  450. end;
  451.  
  452. procedure TFormPropsDlg.DownBtnClick(Sender: TObject);
  453. begin
  454.   BoxMoveFocusedItem(StoredList, StoredList.ItemIndex + 1);
  455.   if FDesigner <> nil then FDesigner.Modified;
  456.   CheckButtons;
  457. end;
  458.  
  459. procedure TFormPropsDlg.StoredListDragOver(Sender, Source: TObject; X,
  460.   Y: Integer; State: TDragState; var Accept: Boolean);
  461. begin
  462.   BoxDragOver(StoredList, Source, X, Y, State, Accept, StoredList.Sorted);
  463.   CheckButtons;
  464. end;
  465.  
  466. procedure TFormPropsDlg.StoredListDragDrop(Sender, Source: TObject; X,
  467.   Y: Integer);
  468. begin
  469.   BoxMoveFocusedItem(StoredList, StoredList.ItemAtPos(Point(X, Y), True));
  470.   if FDesigner <> nil then FDesigner.Modified;
  471.   CheckButtons;
  472. end;
  473.  
  474. procedure TFormPropsDlg.PropertiesListDblClick(Sender: TObject);
  475. begin
  476.   if AddButton.Enabled then AddButtonClick(nil);
  477. end;
  478.  
  479. end.