paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-05-15 07:42:52 +02:00
Code Issues Packages Projects Releases Wiki Activity

Made OpenURL dialog more user friendly

Browse Source 
git-svn-id: trunk@20622 -
This commit is contained in:
andrew 2009-06-13 23:58:52 +00:00
parent 00e3b0160c
commit e0673a43bf
3 changed files with 29 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
components/chmhelp/lhelp/basecontentprovider.pas
View File

@ -38,6 +38,10 @@ type
// example: RegisterContentProvider('chm://', TChmContentProvider);
function GetContentProvider(const Protocol: String): TBaseContentProviderClass;
// Result must be freed by caller
function GetContentProviderList: TStringList;
implementation
var
@ -62,6 +66,12 @@ begin
Result := TBaseContentProviderClass(ContentProviders.Objects[fIndex]);
end;
function GetContentProviderList: TStringList;
begin
Result := TStringList.Create;
Result.AddStrings(ContentProviders);
end;
{ TBaseContentProvider }

2
components/chmhelp/lhelp/chmcontentprovider.pas
View File

@ -180,7 +180,7 @@ begin
else
begin
TCHMHack(fChms).OpenNewFile(AFile);
WriteLn('Loading new chm: ', AFile);
//WriteLn('Loading new chm: ', AFile);
end;
if fChms = nil then Exit;

19
components/chmhelp/lhelp/lhelpcore.pas
View File

@ -154,8 +154,25 @@ end;
procedure THelpForm.FileMenuOpenURLItemClick(Sender: TObject);
var
fRes: String;
URLSAllowed: String;
Protocall: TStrings;
i: Integer;
begin
if InputQuery('Enter a URL', 'Please Enter a URL', fRes) then
Protocall := GetContentProviderList;
for i := 0 to Protocall.Count-1 do
begin
if i < 1 then
URLSAllowed := URLSAllowed + Protocall[i]
else
URLSAllowed := URLSAllowed + ', ' +Protocall[i]
end;
Protocall.Free;
URLSAllowed := Trim(URLSALLowed);
if InputQuery('Please Enter a URL', 'Supported URL type(s): (' +URLSAllowed+ ')', fRes) then
begin
OpenURL(fRes);
RefreshState;