From d29e0ee0a10c81f30044b889c89d592c01cc0ec3 Mon Sep 17 00:00:00 2001 From: juha Date: Tue, 25 Mar 2014 18:16:29 +0000 Subject: [PATCH] LazActiveX: Improvements. Issue #25908, patch from David Zimmer git-svn-id: trunk@44518 - --- components/activex/importtypelib.lfm | 76 +++++++++++++++++++------- components/activex/importtypelib.pas | 82 ++++++++++++++++------------ 2 files changed, 102 insertions(+), 56 deletions(-) diff --git a/components/activex/importtypelib.lfm b/components/activex/importtypelib.lfm index 06664f9c98..bd3f6468d5 100644 --- a/components/activex/importtypelib.lfm +++ b/components/activex/importtypelib.lfm @@ -10,6 +10,7 @@ object FrmTL: TFrmTL ClientWidth = 484 OnCreate = FormCreate OnDestroy = FormDestroy + OnResize = FormResize Position = poScreenCenter LCLVersion = '1.3' object FNETL: TFileNameEdit @@ -115,22 +116,33 @@ object FrmTL: TFrmTL Height = 318 Top = 5 Width = 464 - ActivePage = TabSheet1 + ActivePage = TabSheet2 Anchors = [akTop, akLeft, akRight, akBottom] BorderSpacing.Bottom = 6 - TabIndex = 0 + TabIndex = 1 TabOrder = 5 TabPosition = tpBottom OnChange = PageControl1Change object TabSheet1: TTabSheet Caption = 'Visual Controls' - ClientHeight = 285 + ClientHeight = 331 ClientWidth = 456 object lstControls: TListBox - Left = 17 - Height = 209 - Top = 14 - Width = 374 + AnchorSideLeft.Control = TabSheet1 + AnchorSideTop.Control = TabSheet1 + AnchorSideRight.Control = TabSheet1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = TabSheet1 + AnchorSideBottom.Side = asrBottom + Left = 10 + Height = 261 + Top = 10 + Width = 436 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 10 + BorderSpacing.Top = 10 + BorderSpacing.Right = 10 + BorderSpacing.Bottom = 60 ItemHeight = 0 OnClick = lstControlsClick Sorted = True @@ -139,13 +151,24 @@ object FrmTL: TFrmTL end object TabSheet2: TTabSheet Caption = 'ActiveX References' - ClientHeight = 281 - ClientWidth = 442 + ClientHeight = 285 + ClientWidth = 456 object lstRefs: TListBox - Left = 20 - Height = 201 - Top = 13 - Width = 376 + AnchorSideLeft.Control = TabSheet2 + AnchorSideTop.Control = TabSheet2 + AnchorSideRight.Control = TabSheet2 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = TabSheet2 + AnchorSideBottom.Side = asrBottom + Left = 10 + Height = 215 + Top = 10 + Width = 436 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 10 + BorderSpacing.Top = 10 + BorderSpacing.Right = 10 + BorderSpacing.Bottom = 60 ItemHeight = 0 OnClick = lstRefsClick Sorted = True @@ -165,12 +188,22 @@ object FrmTL: TFrmTL Visible = False end object GroupBox1: TGroupBox - Left = 30 - Height = 48 - Top = 232 - Width = 375 - ClientHeight = 26 - ClientWidth = 371 + AnchorSideLeft.Control = PageControl1 + AnchorSideTop.Control = PageControl1 + AnchorSideRight.Control = PageControl1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = PageControl1 + AnchorSideBottom.Side = asrBottom + Left = 24 + Height = 42 + Top = 249 + Width = 436 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 14 + BorderSpacing.Right = 14 + BorderSpacing.Bottom = 32 + ClientHeight = 20 + ClientWidth = 432 TabOrder = 7 object Label2: TLabel Left = 7 @@ -183,12 +216,15 @@ object FrmTL: TFrmTL object txtSearch: TEdit AnchorSideLeft.Control = Label2 AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = GroupBox1 + AnchorSideRight.Side = asrBottom Left = 57 Height = 28 Top = -4 - Width = 315 + Width = 367 Anchors = [akTop, akLeft, akRight] BorderSpacing.Left = 6 + BorderSpacing.Right = 8 OnChange = txtSearchChange TabOrder = 0 end diff --git a/components/activex/importtypelib.pas b/components/activex/importtypelib.pas index 4f64806e04..e200b7a46b 100644 --- a/components/activex/importtypelib.pas +++ b/components/activex/importtypelib.pas @@ -46,6 +46,7 @@ type procedure CBxTLPackageChange(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); + procedure FormResize(Sender: TObject); procedure lstControlsClick(Sender: TObject); procedure lstFilteredClick(Sender: TObject); procedure lstRefsClick(Sender: TObject); @@ -180,9 +181,8 @@ begin end; end; -function ReadDefaultVal(path: string; reg: TRegistry): string; +function ReadDefaultVal(path: string; var reg: TRegistry): string; begin - reg.RootKey := HKEY_CLASSES_ROOT; if reg.OpenKeyReadOnly(path) then begin Result := reg.ReadString(''); @@ -190,7 +190,7 @@ begin end; end; -function EnumKeys(path: string; reg: TRegistry; lst: TStringList): boolean; +function EnumKeys(path: string; var reg: TRegistry; var lst: TStringList): boolean; begin Result := False; if reg.OpenKeyReadOnly(path) then @@ -209,6 +209,7 @@ var key: string; Name: string; begin + if length(tlbid) = 0 then exit; reg := Tregistry.Create; subkeys := TStringList.Create; try @@ -250,7 +251,7 @@ var reg: TRegistry; clsids: TStringList; e: TEntry; - clsid: string; + clsid, clsidPath: string; map: TStringList; const catid_control = '\Implemented Categories\{40FC6ED4-2438-11cf-A3DB-080036F12502}'; @@ -261,43 +262,39 @@ begin map := TStringList.Create; try reg.RootKey := HKEY_CLASSES_ROOT; - if reg.OpenKeyReadOnly('\CLSID') then + if EnumKeys('\CLSID',reg, clsids) then begin - reg.GetKeyNames(clsids); - reg.CloseKey; for clsid in clsids do begin e := TEntry.Create; e.clsID := clsid; - clsid := '\CLSID\' + clsid; + clsidPath := '\CLSID\' + clsid; - e.typeLib := ReadDefaultVal(clsid + '\TypeLib', reg); - e.isControl := reg.KeyExists(clsID + '\Control'); + e.typeLib := ReadDefaultVal(clsidPath + '\TypeLib', reg); + e.isControl := reg.KeyExists(clsidPath + '\Control'); if not e.isControl then - e.isControl := reg.KeyExists(clsID + catid_control); + e.isControl := reg.KeyExists(clsidPath + catid_control); - if e.isControl and (length(e.typeLib) > 0) and - (map.IndexOf(e.typeLib) = -1) then + e.Name := GetTlbName(e.typeLib); + + if e.isControl and (length(e.typeLib) > 0) + and (map.IndexOf(e.typeLib) = -1) and (length(e.Name) > 0) then begin - e.Name := GetTlbName(e.typeLib); - if length(e.Name) > 0 then - begin - e.path := ReadDefaultVal(clsid + '\InprocServer32', reg); - e.progID := ReadDefaultVal(clsid + '\ProgID', reg); - e.version := ReadDefaultVal(clsid + '\Version', reg); - map.Add(e.typeLib); - lst.AddItem(e.Name, e); - end; + e.path := ReadDefaultVal(clsidPath + '\InprocServer32', reg); + e.progID := ReadDefaultVal(clsidPath + '\ProgID', reg); + e.version := ReadDefaultVal(clsidPath + '\Version', reg); + map.Add(e.typeLib); + lst.AddItem(e.Name, e); end else - e.Free; + FreeAndNil(e); end; end; finally - reg.Free; - clsids.Free; - map.Free; + FreeAndNil(reg); + FreeAndNil(clsids); + FreeAndNil(map); end; end; @@ -328,16 +325,16 @@ begin vers := TStringList.Create; if not EnumKeys('\TypeLib\' + clsid, reg, vers) then begin - vers.Free; - e.Free; + FreeAndNil(vers); + FreeAndNil(e); continue; end; ver := vers[vers.Count - 1]; revs := TStringList.Create; if not EnumKeys('\TypeLib\' + clsid + '\' + ver, reg, revs) then begin - revs.Free; - e.Free; + FreeAndNil(revs); + FreeAndNil(e); continue; end; @@ -354,14 +351,16 @@ begin else e.Free; - vers.Free; - revs.Free; + FreeAndNil(vers); + FreeAndNil(revs); end; end; finally reg.Free; clsids.Free; map.Free; + FreeAndNil(vers); + FreeAndNil(revs); end; end; @@ -388,9 +387,6 @@ begin CBxTLRecurse.Caption := axConvertDependantTypelibs; FNETL.Filter := axTypeLibraryFilesTlbDllExeOcxOlbTlbDllExeOcxOlbAllF; pagecontrol1.TabIndex := 0; - lstcontrols.SetBounds(lstrefs.Left, lstrefs.Top, lstrefs.Width, lstrefs.Height); - lstFiltered.SetBounds(lstrefs.Left + pagecontrol1.Left + 4, lstrefs.Top + - pagecontrol1.Top + 4, lstrefs.Width, lstrefs.Height); LoadVisualControls(lstControls); end; @@ -400,6 +396,20 @@ begin FreeObjects(lstrefs.items); end; +procedure TFrmTL.FormResize(Sender: TObject); +begin + { not anchored and handled dynamically so you can see + it exists seperate from others and still access/click others in IDE + lstFiltered is not a child of pagecontrol and floats over other controls + same as the groupbox with the search edit control does. (multiuse) } + try + lstFiltered.SetBounds(lstrefs.Left + pagecontrol1.Left + 4, + lstrefs.Top + pagecontrol1.Top + 4, + lstrefs.Width, lstrefs.Height); + finally + end; +end; + procedure TFrmTL.ListClickHandler(lst: TListBox); var e: TEntry; @@ -445,7 +455,7 @@ end; procedure TFrmTL.PageControl1Change(Sender: TObject); begin - //loaded on depand to reduce startup time.. + //loaded on demand to reduce startup time.. if (PageControl1.TabIndex = 1) and (lstrefs.Items.Count = 0) then LoadActiveXLibs(lstRefs); txtsearch.Text := '';