paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-05-29 17:22:49 +02:00
Code Issues Packages Projects Releases Wiki Activity

carbon: fix inproper scrollbars showing #16613

Browse Source 
git-svn-id: trunk@26636 -
This commit is contained in:
dmitry 2010-07-14 08:19:46 +00:00
parent 22a192ff6e
commit 82860f9b73
2 changed files with 37 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
lcl/interfaces/carbon/carbonprivate.pp
View File

@ -135,12 +135,14 @@ type
procedure DestroyWidget; override; procedure DestroyWidget; override;
function GetFrame(Index: Integer): ControlRef; override; function GetFrame(Index: Integer): ControlRef; override;
function GetForceEmbedInScrollView: Boolean; override; function GetForceEmbedInScrollView: Boolean; override;
procedure SendScrollUpdate;
public public
class function GetValidEvents: TCarbonControlEvents; override; class function GetValidEvents: TCarbonControlEvents; override;
procedure Draw; override; procedure Draw; override;
procedure GetInfo(out AImageSize, AViewSize, ALineSize: HISize; out AOrigin: HIPoint); virtual; procedure GetInfo(out AImageSize, AViewSize, ALineSize: HISize; out AOrigin: HIPoint); virtual;
procedure ScrollTo(const ANewOrigin: HIPoint); virtual; procedure ScrollTo(const ANewOrigin: HIPoint); virtual;
public public
procedure AddToWidget(AParent: TCarbonWidget); override;
procedure SetColor(const AColor: TColor); override; procedure SetColor(const AColor: TColor); override;
procedure SetFont(const AFont: TFont); override; procedure SetFont(const AFont: TFont); override;
procedure GetScrollInfo(SBStyle: Integer; var ScrollInfo: TScrollInfo); override; procedure GetScrollInfo(SBStyle: Integer; var ScrollInfo: TScrollInfo); override;
@ -749,6 +751,13 @@ begin
inherited DestroyWidget; inherited DestroyWidget;
end; end;
procedure TCarbonCustomControl.AddToWidget(AParent: TCarbonWidget);
begin
inherited AddToWidget(AParent);
// Updating ScrollInfo of the control. Sometimes Carbon shows "unused" scrollbars #16613
SendScrollUpdate;
end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
Method: TCarbonCustomControl.GetFrame Method: TCarbonCustomControl.GetFrame
Params: Frame index Params: Frame index
@ -942,16 +951,13 @@ end;
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
function TCarbonCustomControl.SetScrollInfo(SBStyle: Integer; function TCarbonCustomControl.SetScrollInfo(SBStyle: Integer;
const ScrollInfo: TScrollInfo): Integer; const ScrollInfo: TScrollInfo): Integer;
var
Event: EventRef;
after, before : TRect;
const const
SName = 'SetScrollInfo'; SName = 'SetScrollInfo';
begin begin
{$IFDEF VerboseScroll} {.$IFDEF VerboseScroll}
DebugLn('TCarbonCustomControl.SetScrollInfo ' + LCLObject.Name + DebugLn('TCarbonCustomControl.SetScrollInfo ' + LCLObject.Name +
' SBStyle: ' + DbgS(SBStyle) + ' ' + DbgS(ScrollInfo)); ' SBStyle: ' + DbgS(SBStyle) + ' ' + DbgS(ScrollInfo));
{$ENDIF} {.$ENDIF}
if (SIF_RANGE and ScrollInfo.fMask) > 0 then if (SIF_RANGE and ScrollInfo.fMask) > 0 then
begin begin
@ -990,22 +996,7 @@ begin
if (SBStyle in [SB_HORZ, SB_VERT]) and if (SBStyle in [SB_HORZ, SB_VERT]) and
((ScrollInfo.fMask and (SIF_RANGE or SIF_POS or SIF_PAGE)) > 0) then ((ScrollInfo.fMask and (SIF_RANGE or SIF_POS or SIF_PAGE)) > 0) then
begin SendScrollUpdate;
if OSError(
CreateEvent(nil, kEventClassScrollable, kEventScrollableInfoChanged, 0,
kEventAttributeUserEvent, Event),
Self, SName, 'CreateEvent') then Exit;
try
GetClientRect(before);
OSError(SendEventToEventTarget(Event, GetControlEventTarget(FScrollView)),
Self, SName, 'SendEventToEventTarget');
GetClientRect(after);
if not CompareRect(@before, @after) then
UpdateLCLClientRect;
finally
ReleaseEvent(Event);
end;
end;
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------

26
lcl/interfaces/carbon/carbonprivatecontrol.inc
View File

@ -212,7 +212,7 @@ begin
end; end;
AParent.ControlAdded; AParent.ControlAdded;
//DebugLn('TCarbonControl.AddToWidget ' + LCLObject.Name + ' ' + DbgS(LCLObject.Parent.ClientRect)); //DebugLn('TCarbonControl.AddToWidget ' + LCLObject.Name + ' ' + DbgS(LCLObject.Parent.ClientRect));
end; end;
@ -547,6 +547,30 @@ begin
end; end;
end; end;
procedure TCarbonCustomControl.SendScrollUpdate;
var
Event: EventRef;
after, before : TRect;
const
SName='SendScrollUpdate';
begin
if OSError(
CreateEvent(nil, kEventClassScrollable, kEventScrollableInfoChanged, 0,
kEventAttributeUserEvent, Event),
Self, SName, 'CreateEvent') then Exit;
try
GetClientRect(before);
OSError(SendEventToEventTarget(Event, GetControlEventTarget(FScrollView)),
Self, SName, 'SendEventToEventTarget');
GetClientRect(after);
if not CompareRect(@before, @after) then
UpdateLCLClientRect;
finally
ReleaseEvent(Event);
end;
end;
procedure TCarbonControl.AllowMenuProcess(MenuHotKey: AnsiChar; State: TShiftState; var AllowCommandProcess: Boolean); procedure TCarbonControl.AllowMenuProcess(MenuHotKey: AnsiChar; State: TShiftState; var AllowCommandProcess: Boolean);
begin begin
AllowCommandProcess:=True; AllowCommandProcess:=True;