paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-09 23:08:05 +02:00
Code Issues Packages Projects Releases Wiki Activity

IDE: When "Show Information Box" is enabled, show text correctly at bottom of OI. Issue #20524, patch from cobines

Browse Source 
git-svn-id: trunk@33052 -
This commit is contained in:
juha 2011-10-23 15:34:43 +00:00
parent 1133218b71
commit f0c9e4e57f
3 changed files with 131 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

155
ide/idehelpmanager.pas
View File

@ -123,7 +123,6 @@ type
FProvider: TAbstractIDEHTMLProvider;
FURL: string;
procedure SetProvider(const AValue: TAbstractIDEHTMLProvider);
function HTMLToCaption(const s: string; MaxLines: integer): string;
public
constructor Create(AOwner: TComponent); override;
function GetURL: string;
@ -134,6 +133,23 @@ type
property MaxLineCount: integer read FMaxLineCount write FMaxLineCount;
end;
{ TScrollableHTMLControl
At the moment it is a TMemo that simply strips all tags }
TScrollableHTMLControl = class(TMemo,TIDEHTMLControlIntf)
private
FProvider: TAbstractIDEHTMLProvider;
FURL: string;
procedure SetProvider(const AValue: TAbstractIDEHTMLProvider);
public
constructor Create(AOwner: TComponent); override;
function GetURL: string;
procedure SetURL(const AValue: string);
property Provider: TAbstractIDEHTMLProvider read FProvider write SetProvider;
procedure SetHTMLContent(Stream: TStream; const NewURL: string);
procedure GetPreferredControlSize(out AWidth, AHeight: integer);
end;
{ TIDEHelpDatabases }
TIDEHelpDatabases = class(THelpDatabases)
@ -246,16 +262,25 @@ implementation
{$R *.lfm}
function LazCreateIDEHTMLControl(Owner: TComponent;
var Provider: TAbstractIDEHTMLProvider): TControl;
var
HTMLControl: TSimpleHTMLControl;
var Provider: TAbstractIDEHTMLProvider;
Flags: TIDEHTMLControlFlags): TControl;
begin
HTMLControl:=TSimpleHTMLControl.Create(Owner);
Result:=HTMLControl;
if ihcScrollable in Flags then
Result:=TScrollableHTMLControl.Create(Owner)
else
Result:=TSimpleHTMLControl.Create(Owner);
if Provider=nil then
Provider:=CreateIDEHTMLProvider(HTMLControl);
Provider.ControlIntf:=HTMLControl;
HTMLControl.Provider:=Provider;
Provider:=CreateIDEHTMLProvider(Result);
if ihcScrollable in Flags then
begin
Provider.ControlIntf:=TScrollableHTMLControl(Result);
TScrollableHTMLControl(Result).Provider:=Provider;
end
else
begin
Provider.ControlIntf:=TSimpleHTMLControl(Result);
TSimpleHTMLControl(Result).Provider:=Provider;
end;
end;
function LazCreateIDEHTMLProvider(Owner: TComponent): TAbstractIDEHTMLProvider;
@ -316,16 +341,7 @@ begin
debugln(['TSimpleFPCKeywordHelpDatabase.ShowHelp Keyword=',Keyword]);
end;
{ TSimpleHTMLControl }
procedure TSimpleHTMLControl.SetProvider(const AValue: TAbstractIDEHTMLProvider);
begin
if FProvider=AValue then exit;
FProvider:=AValue;
end;
function TSimpleHTMLControl.HTMLToCaption(const s: string; MaxLines: integer
): string;
function HTMLToCaption(const s: string; MaxLines: integer): string;
var
p: Integer;
EndPos: Integer;
@ -336,7 +352,7 @@ var
CurTagName: String;
begin
Result:=s;
//debugln(['TSimpleHTMLControl.HTMLToCaption HTML="',Result,'"']);
//debugln(['HTMLToCaption HTML="',Result,'"']);
Line:=1;
p:=1;
// remove UTF8 BOM
@ -366,7 +382,7 @@ begin
end;
inc(EndPos);
end;
//debugln(['TSimpleHTMLControl.HTMLToCaption CurTagName=',CurTagName,' Tag="',copy(Result,p,EndPos-p),'"']);
//debugln(['HTMLToCaption CurTagName=',CurTagName,' Tag="',copy(Result,p,EndPos-p),'"']);
if CurTagName='HTML' then
begin
@ -416,7 +432,7 @@ begin
else
NewTag:='';
if NewTag='' then begin
//debugln(['TSimpleHTMLControl.HTMLToCaption deleting tag ',copy(Result,p,EndPos-p)]);
//debugln(['HTMLToCaption deleting tag ',copy(Result,p,EndPos-p)]);
System.Delete(Result,p,EndPos-p);
end
else begin
@ -465,7 +481,25 @@ begin
while (p>0) and (Result[p] in [' ',#9,#10,#13]) do dec(p);
SetLength(Result,p);
//DebugLn(['TSimpleHTMLControl.HTMLToCaption Caption="',dbgstr(Result),'"']);
//DebugLn(['HTMLToCaption Caption="',dbgstr(Result),'"']);
end;
function HTMLToCaption(Stream: TStream; MaxLines: integer): string;
var
s: string;
begin
SetLength(s,Stream.Size);
if s<>'' then
Stream.Read(s[1],length(s));
Result:=HTMLToCaption(s,MaxLines);
end;
{ TSimpleHTMLControl }
procedure TSimpleHTMLControl.SetProvider(const AValue: TAbstractIDEHTMLProvider);
begin
if FProvider=AValue then exit;
FProvider:=AValue;
end;
constructor TSimpleHTMLControl.Create(AOwner: TComponent);
@ -487,7 +521,6 @@ end;
procedure TSimpleHTMLControl.SetURL(const AValue: string);
var
Stream: TStream;
s: string;
NewURL: String;
begin
if Provider=nil then raise Exception.Create('TSimpleHTMLControl.SetURL missing Provider');
@ -498,10 +531,7 @@ begin
try
Stream:=Provider.GetStream(FURL,true);
try
SetLength(s,Stream.Size);
if s<>'' then
Stream.Read(s[1],length(s));
Caption:=HTMLToCaption(s,MaxLineCount);
Caption:=HTMLToCaption(Stream, MaxLineCount);
finally
Provider.ReleaseStream(FURL);
end;
@ -514,14 +544,9 @@ end;
procedure TSimpleHTMLControl.SetHTMLContent(Stream: TStream;
const NewURL: string);
var
s: string;
begin
FURL:=NewURL;
SetLength(s,Stream.Size);
if s<>'' then
Stream.Read(s[1],length(s));
Caption:=HTMLToCaption(s,MaxLineCount);
Caption:=HTMLToCaption(Stream,MaxLineCount);
//debugln(['TSimpleHTMLControl.SetHTMLContent ',Caption]);
end;
@ -552,6 +577,68 @@ begin
//DebugLn(['TSimpleHTMLControl.GetPreferredControlSize Caption="',Caption,'" ',AWidth,'x',AHeight]);
end;
{ TScrollableHTMLControl }
procedure TScrollableHTMLControl.SetProvider(const AValue: TAbstractIDEHTMLProvider);
begin
if FProvider=AValue then exit;
FProvider:=AValue;
end;
constructor TScrollableHTMLControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
BorderSpacing.Around := 4;
BorderStyle := bsNone;
ReadOnly := True;
ScrollBars := ssAutoVertical;
end;
function TScrollableHTMLControl.GetURL: string;
begin
Result:=FURL;
end;
procedure TScrollableHTMLControl.SetURL(const AValue: string);
var
Stream: TStream;
s: string;
NewURL: String;
begin
if Provider=nil then raise Exception.Create('TScrollableHTMLControl.SetURL missing Provider');
if FURL=AValue then exit;
NewURL:=Provider.MakeURLAbsolute(Provider.BaseURL,AValue);
if FURL=NewURL then exit;
FURL:=NewURL;
try
Stream:=Provider.GetStream(FURL,true);
try
Caption:=HTMLToCaption(Stream, MaxInt);
finally
Provider.ReleaseStream(FURL);
end;
except
on E: Exception do begin
Caption:=E.Message;
end;
end;
end;
procedure TScrollableHTMLControl.SetHTMLContent(Stream: TStream;
const NewURL: string);
begin
FURL:=NewURL;
Caption:=HTMLToCaption(Stream,MaxInt);
//debugln(['TScrollableHTMLControl.SetHTMLContent ',Caption]);
end;
procedure TScrollableHTMLControl.GetPreferredControlSize(out AWidth, AHeight: integer);
begin
AWidth:=0;
AHeight:=0;
GetPreferredSize(AWidth, AHeight);
end;
{ TLazIDEHTMLProvider }
procedure TLazIDEHTMLProvider.SetProviders(const AValue: TLIHProviders);

3
ide/main.pp
View File

@ -17539,10 +17539,11 @@ var
begin
if FOIHelpProvider = nil then
begin
HelpControl := CreateIDEHTMLControl(ObjectInspector1, FOIHelpProvider);
HelpControl := CreateIDEHTMLControl(ObjectInspector1, FOIHelpProvider, [ihcScrollable]);
HelpControl.Parent := ObjectInspector1.InfoPanel;
HelpControl.Align := alClient;
HelpControl.BorderSpacing.Around := 2;
HelpControl.Color := clForm;
end;
Result := FOIHelpProvider;
end;

9
ideintf/idehelpintf.pas
View File

@ -129,8 +129,15 @@ type
property ControlIntf: TIDEHTMLControlIntf read FControlIntf write FControlIntf;
end;
TIDEHTMLControlFlag = (
ihcScrollable
);
TIDEHTMLControlFlags = set of TIDEHTMLControlFlag;
TCreateIDEHTMLControlEvent =
function(Owner: TComponent; var Provider: TAbstractIDEHTMLProvider): TControl;
function(Owner: TComponent; var Provider: TAbstractIDEHTMLProvider;
Flags: TIDEHTMLControlFlags = []): TControl;
TCreateIDEHTMLProviderEvent =
function(Owner: TComponent): TAbstractIDEHTMLProvider;