mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-12 08:36:04 +02:00
LazActiveX: Improvements. Issue #25908, patch from David Zimmer
git-svn-id: trunk@44518 -
This commit is contained in:
juha
parent
bd0336f030
commit
d29e0ee0a1
@ -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
|
||||
|
||||
@ -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 := '';
|
||||
|
||||
Loading…
Reference in New Issue
Block a user