Win32 and GTK2 widgetset endless loop eliminated

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1033 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
macpgmr
2009-12-05 23:25:47 +00:00
parent 7ed85a3234
commit 7dc9c2a8a2
5 changed files with 47 additions and 8 deletions

View File

@@ -275,7 +275,11 @@ if (I <= 2) or (J > 0) then
ShellExecute(Handle, nil, StrPCopy(PC, S), StrPCopy(PC2, Params), ShellExecute(Handle, nil, StrPCopy(PC, S), StrPCopy(PC2, Params),
nil, SW_SHOWNORMAL); nil, SW_SHOWNORMAL);
{$ELSE} {$ELSE}
Shell('Open ' + S); {$IFDEF LCLCarbon}
Shell('Open "' + S + '.app"');
{$ELSE}
Shell('"' + S + '" "' + Params + '"');
{$ENDIF}
{$ENDIF} {$ENDIF}
{$ENDIF} {$ENDIF}
end end
@@ -304,7 +308,11 @@ if (I > 0) or (J > 0) then
{$IFDEF MSWINDOWS} {$IFDEF MSWINDOWS}
ShellExecute(Handle, nil, StrPCopy(PC, URL), nil, nil, SW_SHOWNORMAL); ShellExecute(Handle, nil, StrPCopy(PC, URL), nil, nil, SW_SHOWNORMAL);
{$ELSE} {$ELSE}
Shell('Open ' + URL); {$IFDEF LCLCarbon}
Shell('Open "' + URL + '.app"');
{$ELSE}
Shell('"' + URL + '"');
{$ENDIF}
{$ENDIF} {$ENDIF}
Handled := True; Handled := True;
Exit; Exit;
@@ -355,7 +363,7 @@ var
S: string; S: string;
I: integer; I: integer;
begin begin
{$IFNDEF DARWIN} //Launched file name not passed via command line with OS X. {$IFNDEF LCLCarbon} //Launched file name not passed via command line with app bundle.
if (ParamCount >= 1) then if (ParamCount >= 1) then
begin {Parameter is file to load} begin {Parameter is file to load}
{$IFNDEF LCL} {$IFNDEF LCL}
@@ -605,7 +613,11 @@ if FileExists(S) then
ShellExecute(Handle, nil, StrPCopy(PC, ParamStr(0)), ShellExecute(Handle, nil, StrPCopy(PC, ParamStr(0)),
StrPCopy(PC2, S+Dest), nil, SW_SHOWNORMAL); StrPCopy(PC2, S+Dest), nil, SW_SHOWNORMAL);
{$ELSE} {$ELSE}
Shell('Open ' + ParamStr(0)); {$IFDEF LCLCarbon}
Shell('Open "' + ParamStr(0) + '.app"');
{$ELSE}
Shell('"' + ParamStr(0) + '" "' + S+Dest + '"');
{$ENDIF}
{$ENDIF} {$ENDIF}
{$ENDIF} {$ENDIF}
end; end;
@@ -838,7 +850,11 @@ begin
ShellExecute(Handle, nil, StrPCopy(PC, ParamStr(0)), ShellExecute(Handle, nil, StrPCopy(PC, ParamStr(0)),
StrPCopy(PC2, NewWindowFile), nil, SW_SHOWNORMAL); StrPCopy(PC2, NewWindowFile), nil, SW_SHOWNORMAL);
{$ELSE} {$ELSE}
Shell('Open ' + ParamStr(0)); {$IFDEF LCLCarbon}
Shell('Open "' + ParamStr(0) + '.app"');
{$ELSE}
Shell('"' + ParamStr(0) + '" "' + NewWindowFile + '"');
{$ENDIF}
{$ENDIF} {$ENDIF}
{$ENDIF} {$ENDIF}
end; end;

View File

@@ -101,6 +101,13 @@ end;
function TFontForm.GetFontName: TFontName; function TFontForm.GetFontName: TFontName;
begin begin
{$IFNDEF MSWINDOWS}
if Screen.Fonts.Count = 0 then //GTK2 without HasX defined (empty list)?
begin
Result := FontViewer.DefFontName;
Exit;
end;
{$ENDIF}
try try
Result := FontListBox.Items[FontListBox.ItemIndex]; Result := FontListBox.Items[FontListBox.ItemIndex];
except except
@@ -118,6 +125,7 @@ if I < 0 then
{$IFNDEF MSWINDOWS} //System font only makes sense on Windows, so just select first font {$IFNDEF MSWINDOWS} //System font only makes sense on Windows, so just select first font
if I < 0 then if I < 0 then
I := 0; I := 0;
if Screen.Fonts.Count > 0 then //Check in case GTK2 without HasX defined
{$ENDIF} {$ENDIF}
FontListBox.ItemIndex := I; FontListBox.ItemIndex := I;
FontViewer.DefFontName := Value; FontViewer.DefFontName := Value;
@@ -212,6 +220,9 @@ end;
procedure TFontForm.ListBoxClicks(Sender: TObject); procedure TFontForm.ListBoxClicks(Sender: TObject);
begin begin
if Sender = FontListBox then if Sender = FontListBox then
{$IFNDEF MSWINDOWS}
if Screen.Fonts.Count = 0 then else //Check in case GTK2 without HasX defined
{$ENDIF}
FontName := FontListBox.Items[FontListBox.ItemIndex] FontName := FontListBox.Items[FontListBox.ItemIndex]
else if Sender = BackListBox then else if Sender = BackListBox then
Background := StringToColor(BackListBox.Items[BackListBox.ItemIndex]) Background := StringToColor(BackListBox.Items[BackListBox.ItemIndex])

View File

@@ -26,7 +26,7 @@
</CompilerOptions> </CompilerOptions>
<Description Value="HTML Components for Lazarus"/> <Description Value="HTML Components for Lazarus"/>
<License Value="MPL 1.1"/> <License Value="MPL 1.1"/>
<Version Release="2"/> <Version Release="3"/>
<Files Count="1"> <Files Count="1">
<Item1> <Item1>
<Filename Value="htmlcompreg.pas"/> <Filename Value="htmlcompreg.pas"/>

View File

@@ -4333,7 +4333,7 @@ end;
procedure ThtmlViewer.PaintWindow(DC: HDC); procedure ThtmlViewer.PaintWindow(DC: HDC);
begin begin
PaintPanel.RePaint; PaintPanel.RePaint;
BorderPanel.RePaint; BorderPanel.RePaint;
VScrollbar.RePaint; VScrollbar.RePaint;
HScrollbar.RePaint; HScrollbar.RePaint;
end; end;
@@ -5049,7 +5049,9 @@ var
begin begin
if FViewer.DontDraw or (Canvas2 <> Nil) then if FViewer.DontDraw or (Canvas2 <> Nil) then
Exit; Exit;
FViewer.DrawBorder; {$IFNDEF LCL}
FViewer.DrawBorder; //Causes endless loop for some reason on win32 and gtk2.
{$ENDIF}
OldPal := 0; OldPal := 0;
Canvas.Font := Font; Canvas.Font := Font;
Canvas.Brush.Color := Color; Canvas.Brush.Color := Color;

View File

@@ -1650,6 +1650,11 @@ Done := False;
S1 := NextFontName; S1 := NextFontName;
while (S1 <> '') and not Done do while (S1 <> '') and not Done do
begin begin
{$IFDEF LCL} //Generic2 fonts won't be in Screen.Fonts with GTK2, so make
// sure first font for family is selected.
if Result = '' then
Result := S1;
{$ENDIF}
Done := Screen.Fonts.IndexOf(S1) >= 0; Done := Screen.Fonts.IndexOf(S1) >= 0;
if Done then if Done then
Result := S1 Result := S1
@@ -1725,6 +1730,11 @@ S := Props[FontFamily];
S1 := NextFontName; S1 := NextFontName;
while (S1 <> '') and not Done do while (S1 <> '') and not Done do
begin begin
{$IFDEF LCL} //Generic2 fonts won't be in Screen.Fonts with GTK2, so make
// sure first font for family is selected.
if Font.iName = '' then
Font.iName := S1;
{$ENDIF}
Done := Screen.Fonts.IndexOf(S1) >= 0; Done := Screen.Fonts.IndexOf(S1) >= 0;
if Done then if Done then
begin begin