home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue31 / system / LibExpert / LibTestForm.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1998-02-02  |  12.0 KB  |  388 lines
  1. unit LibTestForm;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   DsgnIntf, LibIntf, StdCtrls, ExtCtrls, Tabs, Menus;
  8.  
  9. type
  10.   TLibExTest = class(TForm)
  11.     TabSet1: TTabSet;
  12.     Notebook1: TNotebook;
  13.     GroupBox1: TGroupBox;
  14.     Label1: TLabel;
  15.     BaseReg: TEdit;
  16.     GroupBox5: TGroupBox;
  17.     ComboBox1: TComboBox;
  18.     Image2: TImage;
  19.     cbLockState: TCheckBox;
  20.     Label5: TLabel;
  21.     PathAndBaseName: TLabel;
  22.     Label7: TLabel;
  23.     AppHandle: TLabel;
  24.     Label8: TLabel;
  25.     IDETime: TLabel;
  26.     Label9: TLabel;
  27.     WinSize: TLabel;
  28.     Label4: TLabel;
  29.     Image1: TImage;
  30.     GroupBox4: TGroupBox;
  31.     Label2: TLabel;
  32.     HelpClassName: TEdit;
  33.     ClassHelpOK: TButton;
  34.     GroupBox3: TGroupBox;
  35.     ComboBox2: TComboBox;
  36.     Label10: TLabel;
  37.     Button1: TButton;
  38.     GroupBox6: TGroupBox;
  39.     SelectionType: TLabel;
  40.     SelectionName: TLabel;
  41.     FirstSelectionType: TLabel;
  42.     SelectedList: TListBox;
  43.     SetLockState: TCheckBox;
  44.     SelectAll: TButton;
  45.     DeleteAll: TButton;
  46.     PropertyList: TListBox;
  47.     EventList: TListBox;
  48.     Label11: TLabel;
  49.     Label12: TLabel;
  50.     Button2: TButton;
  51.     CompCount: TLabel;
  52.     FileSystem: TLabel;
  53.     FormName: TLabel;
  54.     Show: TButton;
  55.     ScrollBox1: TScrollBox;
  56.     Image3: TImage;
  57.     Ancestor: TLabel;
  58.     FirstCompName: TLabel;
  59.     Hide: TButton;
  60.     NewName: TButton;
  61.     TabCompCount: TLabel;
  62.     FirstNVComp: TLabel;
  63.     GroupBox2: TGroupBox;
  64.     CIName: TLabel;
  65.     CIEventCount: TLabel;
  66.     EventCombo: TComboBox;
  67.     Label3: TLabel;
  68.     procedure FormCreate(Sender: TObject);
  69.     procedure HelpClassNameChange(Sender: TObject);
  70.     procedure ClassHelpOKClick(Sender: TObject);
  71.     procedure FormPaint(Sender: TObject);
  72.     procedure TabSet1Change(Sender: TObject; NewTab: Integer;
  73.       var AllowChange: Boolean);
  74.     procedure ComboBox1Change(Sender: TObject);
  75.     procedure Button1Click(Sender: TObject);
  76.     procedure SetLockStateClick(Sender: TObject);
  77.     procedure SelectAllClick(Sender: TObject);
  78.     procedure DeleteAllClick(Sender: TObject);
  79.     procedure Button2Click(Sender: TObject);
  80.     procedure HideClick(Sender: TObject);
  81.     procedure ShowClick(Sender: TObject);
  82.     procedure NewNameClick(Sender: TObject);
  83.   private
  84.     { Private declarations }
  85.     procedure GetPropertiesProc (Prop: TIProperty);
  86.     procedure GetEventsProc (Prop: TIProperty);
  87.     function InitFormDesignerPage: Boolean;
  88.   public
  89.     { Public declarations }
  90.   end;
  91.  
  92. implementation
  93.  
  94. {$R *.DFM}
  95.  
  96. procedure TLibExTest.FormCreate(Sender: TObject);
  97. begin
  98.     TabSet1.Tabs := NoteBook1.Pages;
  99.     ComboBox1.ItemIndex := 0;
  100.     ComboBox2.ItemIndex := 0;
  101.     ComboBox1Change (Self);
  102. end;
  103.  
  104. procedure TLibExTest.HelpClassNameChange(Sender: TObject);
  105. begin
  106.     ClassHelpOK.Enabled := HelpClassName.Text <> '';
  107. end;
  108.  
  109. procedure TLibExTest.ClassHelpOKClick(Sender: TObject);
  110. begin
  111.     DelphiIDE.ShowClassHelp (HelpClassName.Text);
  112. end;
  113.  
  114. procedure TLibExTest.FormPaint(Sender: TObject);
  115. var
  116.     Item: TIPaletteItem;
  117. begin
  118.     with DelphiIDE do
  119.         if GetToolSelected then begin
  120.             Label4.Visible := True;
  121.             Image1.Visible := True;
  122.             Item := GetCurCompClass;
  123.             try
  124.                 Item.Paint (Image1.Canvas, 0, 0);
  125.             finally
  126.                 Item.Free;
  127.             end;
  128.         end
  129.         else begin
  130.             Label4.Visible := False;
  131.             Image1.Visible := False;
  132.         end;
  133. end;
  134.  
  135. procedure TLibExTest.TabSet1Change (Sender: TObject; NewTab: Integer;
  136.                                     var AllowChange: Boolean);
  137. var
  138.     r: TRect;
  139.     Idx: Integer;
  140.     Selection: TComponentList;
  141. begin
  142.     { Case out on the active page name }
  143.     if NoteBook1.Pages [NewTab] = 'Form Designer' then AllowChange := InitFormDesignerPage;
  144.     if not AllowChange then Exit else NoteBook1.PageIndex := NewTab;
  145.  
  146.     if NoteBook1.Pages [NewTab] = 'Miscellaneous' then with DelphiIDE do begin
  147.         BaseReg.Text := GetBaseRegKey;
  148.         cbLockState.Checked := LockState;
  149.         PathAndBaseName.Caption := GetPathAndBaseExeName;
  150.         AppHandle.Caption := '$' + IntToHex (GetAppHandle, 8);
  151.         IDETime.Caption := '$' + IntToHex (GetCurTime, 8);
  152.         r := GetMainWindowSize;
  153.         WinSize.Caption := Format ('(%d,%d)-(%d,%d)', [r.Left, r.Top, r.Right, r.Bottom]);
  154.     end;
  155.  
  156.     if NoteBook1.Pages [NewTab] = 'Selections' then with CompLib do begin
  157.         if GetSelectionName <> '' then
  158.             SelectionName.Caption := 'Name of selected component - ' + GetSelectionName
  159.         else SelectionName.Caption := '--No component selected--';
  160.  
  161.         if GetSelectionType <> '' then
  162.             SelectionType.Caption := 'Type of selected component - ' + GetSelectionType
  163.         else SelectionType.Caption := '--No component selected--';
  164.  
  165.         if GetFirstSelectionType <> '' then
  166.             FirstSelectionType.Caption := 'Type of first selected - ' + GetFirstSelectionType
  167.         else FirstSelectionType.Caption := '--No component selected--';
  168.  
  169.         Selection := TComponentList.Create;
  170.         try
  171.             { Delphi 3 Bug - only call GetSelection if there is a selection }
  172.             if GetFirstSelectionType <> '' then GetSelection (Selection);
  173.  
  174.             SelectedList.Clear;
  175.             if Selection.Count = 0 then SelectedList.Items.Add ('---no selection---') else
  176.                 for Idx := 0 to Selection.Count - 1 do
  177.                     with Selection [Idx] as TControl do
  178.                         SelectedList.Items.Add (Format ('%s (%s)', [Name, ClassName]));
  179.  
  180.         finally
  181.             Selection.Free;
  182.         end;
  183.  
  184.         Self.SetLockState.Checked := DelphiIDE.LockState;
  185.     end;
  186.  
  187.     if NoteBook1.Pages [NewTab] = 'More Selection Info' then with CompLib do begin
  188.         PropertyList.Clear;
  189.         EventList.Clear;
  190.         GetProperties (pkProperties, GetPropertiesProc);
  191.         GetProperties (pkEvents, GetEventsProc);
  192.     end;
  193. end;
  194.  
  195. procedure TLibExTest.ComboBox1Change(Sender: TObject);
  196. var
  197.     Item: TIPaletteItem;
  198.     Cls: TComponentClass;
  199. begin
  200.     with DelphiIDE do begin
  201.         case ComboBox1.ItemIndex of
  202.             0:      Cls := TMainMenu;
  203.             1:      Cls := TPopupMenu;
  204.             2:      Cls := TLabel;
  205.             3:      Cls := TEdit;
  206.             4:      Cls := TMemo;
  207.             5:      Cls := TButton;
  208.             6:      Cls := TCheckBox;
  209.             7:      Cls := TRadioButton;
  210.             8:      Cls := TListBox;
  211.             9:      Cls := TComboBox;
  212.             10:     Cls := TScrollBar;
  213.             11:     Cls := TGroupBox;
  214.             12:     Cls := TRadioGroup;
  215.             13:     Cls := TPanel;
  216.             else    Cls := Nil;
  217.         end;
  218.  
  219.         if Cls = Nil then Image2.Visible := False else begin
  220.             Item := GetPaletteItem (Cls);
  221.             try
  222.                 Item.Paint (Image2.Canvas, 0, 0);
  223.             finally
  224.                 Item.Free;
  225.             end;
  226.             Image2.Visible := True;
  227.             Image2.Invalidate;
  228.         end;
  229.     end;
  230. end;
  231.  
  232. procedure TLibExTest.Button1Click (Sender: TObject);
  233. begin
  234.     { This will do nothing if there's no active form }
  235.     DelphiIDE.ExecDesignDialog (TDesignDialog (ComboBox2.ItemIndex));
  236. end;
  237.  
  238. procedure TLibExTest.GetPropertiesProc (Prop: TIProperty);
  239. begin
  240.     PropertyList.Items.Add (Prop.GetName);
  241.     Prop.Free;
  242. end;
  243.  
  244. procedure TLibExTest.GetEventsProc (Prop: TIProperty);
  245. begin
  246.     EventList.Items.Add (Prop.GetName);
  247.     Prop.Free;
  248. end;
  249.  
  250. procedure TLibExTest.SetLockStateClick (Sender: TObject);
  251. begin
  252.     CompLib.SetLockState (SetLockState.Checked);
  253. end;
  254.  
  255. procedure TLibExTest.SelectAllClick (Sender: TObject);
  256. begin
  257.     CompLib.EditAction (eaSelectAll);
  258. end;
  259.  
  260. procedure TLibExTest.DeleteAllClick(Sender: TObject);
  261. begin
  262.     CompLib.EditAction (eaSelectAll);
  263.     CompLib.EditAction (eaCut);
  264. end;
  265.  
  266. procedure TLibExTest.Button2Click(Sender: TObject);
  267. var
  268.     Form: TIForm;
  269.     module: TIModule;
  270. begin
  271.     Form := CompLib.GetActiveForm;
  272.     if Form <> Nil then begin
  273.         module := Form.GetModule;
  274.         if module <> Nil then Module.SwapSourceFormView;
  275.     end;
  276. end;
  277.  
  278. { @@@@ }
  279.  
  280. function TLibExTest.InitFormDesignerPage: Boolean;
  281. var
  282.     Idx: Integer;
  283.     Str: String;
  284.     CInfo: TICompInfo;
  285.     ActiveForm: TIForm;
  286. begin
  287.     { Assume no active form }
  288.     Result := False;
  289.     ActiveForm := CompLib.GetActiveForm;
  290.     if ActiveForm = Nil then begin
  291.         ShowMessage ('Can''t access this page without an active form');
  292.         Exit;
  293.     end;
  294.  
  295.     { OK - we've got an active form }
  296.     Result := True;
  297.     with ActiveForm do begin
  298.         CompCount.Caption := Format ('Number of components on form = %d', [GetCompCount]);
  299.         Str := GetFileSystem;
  300.         if Str = '' then Str := '[Default]';
  301.         FileSystem.Caption := Format ('File system = %s', [Str]);
  302.         FormName.Caption := Format ('Name of form = %s', [GetFormName]);
  303.         Ancestor.Caption := Format ('Name of ancestor = %s', [GetAncestorName]);
  304.         Image3.Picture.Bitmap.Handle := GetFormImage;
  305.         if GetCompCount > 0 then Str := GetCompName (0) else Str := '--none--';
  306.         FirstCompName.Caption := Format ('Name of first component = %s', [Str]);
  307.         TabCompCount.Caption := Format ('Number of TabStop Components = %d', [GetTabCompCount]);
  308.         { Find first non-visual component, if any }
  309.         Str := '--none--';
  310.         for Idx := 0 to GetCompCount - 1 do
  311.             if GetNVComp (Idx) <> Nil then begin
  312.                 Str := TComponent (GetNVComp (Idx)).Name;
  313.                 break;
  314.             end;
  315.  
  316.         FirstNVComp.Caption := Format ('First non-visual component = %s', [Str]);
  317.  
  318.         { Do something to demonstrate the TICompInfo interface }
  319.         GroupBox2.Visible := GetCompCount > 0;
  320.         if GroupBox2.Visible then begin
  321.             CInfo := GetCompInfo (0);
  322.             try
  323.                 CIName.Caption := TComponent(CInfo.GetComponentHandle).Name;
  324.                 CIName.Caption := CIName.Caption + Format (' (%s)', [CInfo.GetClassName]);
  325.                 CIEventCount.Caption := Format ('%d Possible Event handlers', [CInfo.GetEventCount]);
  326.                 EventCombo.Items.Clear;
  327.                 for Idx := 0 to CInfo.GetEventCount - 1 do begin
  328.                     Str := CInfo.GetEventValue (Idx);
  329.                     if Str <> '' then EventCombo.Items.Add (Str);
  330.                 end;
  331.  
  332.                 if EventCombo.Items.Count = 0 then EventCombo.Items.Add ('--none--');
  333.                 EventCombo.ItemIndex := 0;
  334.             finally
  335.                 CInfo.Free;
  336.             end;
  337.         end;
  338.     end;
  339. end;
  340.  
  341. procedure TLibExTest.HideClick(Sender: TObject);
  342. begin
  343.     CompLib.GetActiveForm.Hide;
  344. end;
  345.  
  346. procedure TLibExTest.ShowClick(Sender: TObject);
  347. begin
  348.     CompLib.GetActiveForm.Show;
  349. end;
  350.  
  351. procedure TLibExTest.NewNameClick(Sender: TObject);
  352. var
  353.     NewName: String;
  354. begin
  355.     with CompLib.GetActiveForm do begin
  356.         NewName := InputBox ('LibIntf Expert', 'Enter a new name for the form', GetFormName);
  357.         if (NewName <> '') and (NewName <> GetFormName) then begin
  358.             SetFormName (NewName);
  359.             InitFormDesignerPage;
  360.         end;
  361.     end;
  362. end;
  363.  
  364. end.
  365.  
  366.   public
  367.     procedure Align (Affect:TAffect);                                   { $2C }
  368.     procedure CreateComponent (Item: TICompClass);              { $30 }
  369.     function  FindCompClass (const CompName: String): String;          { $34 }
  370.     procedure GetDependentForms(Proc:TGetFormProc);              { $40 }
  371.     procedure GetFormDependencies (Proc: TGetFormProc);          { $48 }
  372.     function  GetModule: TIModule;                      { $54 }
  373.     function  GetFormInterface: TIFormInterface;              { $60 }
  374.     function  GetState: TFormState;                      { $70 }
  375.     procedure GoDormant;
  376.     procedure RemoveDependentLinks;
  377.     procedure Scale(Factor:integer);                                    { $98 }
  378.     procedure SetSelection(const Name:string);
  379.     procedure ShowAs(ShowState:TShowState);
  380.     procedure Size(Affect:TSizeAffect; Value:integer);                  { $B8 }
  381.   end;
  382.  
  383.  
  384.  
  385.  
  386.  
  387.  
  388.