paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-06 12:47:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

Carbon intf: fixed #0009686: Carbon TPanel.color ingored

Browse Source 
- fixed #0009801 Carbon TScrollBar calls OnScroll inappropriately
- flat speed buttons do not draw its border
- improved theme content rect

git-svn-id: trunk@12349 -
This commit is contained in:
tombo 2007-10-06 14:58:29 +00:00
parent 23cb06a031
commit 697e09d161
4 changed files with 54 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
lcl/interfaces/carbon/carbonbars.pp
View File

@ -89,7 +89,7 @@ type
procedure CreateWidget(const AParams: TCreateParams); override;
public
class function GetValidEvents: TCarbonControlEvents; override;
procedure ValueChanged; override;
procedure IndicatorMoved; override;
procedure DoAction(AControlPart: ControlPartCode); override;
procedure SetParams; virtual;
end;
@ -322,11 +322,11 @@ begin
end;
{------------------------------------------------------------------------------
Method: TCarbonScrollBar.ValueChanged
Method: TCarbonScrollBar.IndicatorMoved
Value changed event handler
Indicator moved event handler
------------------------------------------------------------------------------}
procedure TCarbonScrollBar.ValueChanged;
procedure TCarbonScrollBar.IndicatorMoved;
var
ScrollMsg: TLMScroll;
begin
@ -336,7 +336,8 @@ begin
ScrollMsg.ScrollCode := SB_THUMBTRACK;
ScrollMsg.Pos := GetControl32BitValue(ControlRef(Widget));
ScrollMsg.ScrollBar := HWND(Widget);
ValueChanged;
DeliverMessage(LCLObject, ScrollMsg);
end;

2
lcl/interfaces/carbon/carboncanvas.pp
View File

@ -919,6 +919,8 @@ var
const
SName = 'Frame3D';
begin
FillRect(ARect, CurrentBrush);
if Style = bvRaised then
begin
if OSError(GetThemeMetric(kThemeMetricPrimaryGroupBoxContentInset, D),

6
lcl/interfaces/carbon/carbonprivatecommon.inc
View File

@ -40,7 +40,7 @@ function CarbonCommon_Draw(ANextHandler: EventHandlerCallRef;
AWidget: TCarbonWidget): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
var
AStruct: PPaintStruct;
EraseMsg: TLMEraseBkgnd;
//EraseMsg: TLMEraseBkgnd;
begin
{$IFDEF VerbosePaint}
Debugln('CarbonCommon_Draw ', DbgSName(AWidget.LCLObject));
@ -56,9 +56,9 @@ begin
'CarbonCommon_Draw', SGetEvent, 'kEventParamCGContextRef') then Exit;
// erase background
EraseMsg.Msg := LM_ERASEBKGND;
{EraseMsg.Msg := LM_ERASEBKGND;
EraseMsg.DC := HDC(AWidget.Context);
DeliverMessage(AWidget.LCLObject, EraseMsg);
DeliverMessage(AWidget.LCLObject, EraseMsg);}
// let carbon draw/update
Result := CallNextEventHandler(ANextHandler, AEvent);

70
lcl/interfaces/carbon/carbonthemes.pas
View File

@ -33,10 +33,10 @@ type
procedure InternalDrawParentBackground(Window: HWND; Target: HDC; Bounds: PRect); override;
function GetDrawState(Details: TThemedElementDetails): ThemeDrawState;
procedure DrawButtonElement(DC: TCarbonDeviceContext; Details: TThemedElementDetails; R: TRect; ClipRect: PRect);
procedure DrawHeaderElement(DC: TCarbonDeviceContext; Details: TThemedElementDetails; R: TRect; ClipRect: PRect);
procedure DrawRebarElement(DC: TCarbonDeviceContext; Details: TThemedElementDetails; R: TRect; ClipRect: PRect);
procedure DrawToolBarElement(DC: TCarbonDeviceContext; Details: TThemedElementDetails; R: TRect; ClipRect: PRect);
function DrawButtonElement(DC: TCarbonDeviceContext; Details: TThemedElementDetails; R: TRect; ClipRect: PRect): TRect;
function DrawHeaderElement(DC: TCarbonDeviceContext; Details: TThemedElementDetails; R: TRect; ClipRect: PRect): TRect;
function DrawRebarElement(DC: TCarbonDeviceContext; Details: TThemedElementDetails; R: TRect; ClipRect: PRect): TRect;
function DrawToolBarElement(DC: TCarbonDeviceContext; Details: TThemedElementDetails; R: TRect; ClipRect: PRect): TRect;
public
procedure DrawElement(DC: HDC; Details: TThemedElementDetails; const R: TRect; ClipRect: PRect); override;
procedure DrawEdge(DC: HDC; Details: TThemedElementDetails; const R: TRect; Edge, Flags: Cardinal; AContentRect: PRect); override;
@ -79,7 +79,7 @@ begin
if IsHot(Details) then
Result := kThemeStateRollover
else
Result := kThemeStateActive;
Result := kThemeStateActive;
end;
{------------------------------------------------------------------------------
@ -88,11 +88,12 @@ end;
Details - Details for themed element
R - Bounding rectangle
ClipRect - Clipping rectangle
Returns: ClientRect
Draws a button element with native Carbon look
------------------------------------------------------------------------------}
procedure TCarbonThemeServices.DrawButtonElement(DC: TCarbonDeviceContext;
Details: TThemedElementDetails; R: TRect; ClipRect: PRect);
function TCarbonThemeServices.DrawButtonElement(DC: TCarbonDeviceContext;
Details: TThemedElementDetails; R: TRect; ClipRect: PRect): TRect;
const
ButtonMap: array[BP_PUSHBUTTON..BP_USERBUTTON] of ThemeButtonKind =
(
@ -114,7 +115,6 @@ begin
ButtonDrawInfo.value := kThemeButtonOff;
ButtonDrawInfo.adornment := kThemeAdornmentNone;
//InflateRect(R, 0, -2); // HiThemeDrawButton can draw outside it rect
LabelRect := RectToCGRect(R);
if Details.Part = BP_GROUPBOX then
@ -127,6 +127,8 @@ begin
HIThemeDrawButton(LabelRect, ButtonDrawInfo, DC.CGContext,
kHIThemeOrientationNormal, @LabelRect),
Self, 'DrawButtonElement', 'HIThemeDrawButton');
Result := CGRectToRect(LabelRect);
end;
{------------------------------------------------------------------------------
@ -135,11 +137,12 @@ end;
Details - Details for themed element
R - Bounding rectangle
ClipRect - Clipping rectangle
Returns: ClientRect
Draws a header (THeaderControl same as ListView header) element with native Carbon look
------------------------------------------------------------------------------}
procedure TCarbonThemeServices.DrawHeaderElement(DC: TCarbonDeviceContext;
Details: TThemedElementDetails; R: TRect; ClipRect: PRect);
function TCarbonThemeServices.DrawHeaderElement(DC: TCarbonDeviceContext;
Details: TThemedElementDetails; R: TRect; ClipRect: PRect): TRect;
var
HeaderDrawInfo: HiThemeHeaderDrawInfo;
PaintRect: HIRect;
@ -151,7 +154,10 @@ begin
OSError(
HIThemeDrawHeader(PaintRect, HeaderDrawInfo, DC.CGContext,
kHIThemeOrientationNormal),
Self, 'DrawHeaderElement', 'HIThemeDrawHeader')
Self, 'DrawHeaderElement', 'HIThemeDrawHeader');
Result := CGRectToRect(PaintRect);
InflateRect(Result, -2, -2);
end;
{------------------------------------------------------------------------------
@ -160,11 +166,12 @@ end;
Details - Details for themed element
R - Bounding rectangle
ClipRect - Clipping rectangle
Returns: ClientRect
Draws a rebar element (splitter) with native Carbon look
------------------------------------------------------------------------------}
procedure TCarbonThemeServices.DrawRebarElement(DC: TCarbonDeviceContext;
Details: TThemedElementDetails; R: TRect; ClipRect: PRect);
function TCarbonThemeServices.DrawRebarElement(DC: TCarbonDeviceContext;
Details: TThemedElementDetails; R: TRect; ClipRect: PRect): TRect;
var
SplitterInfo: HIThemeSplitterDrawInfo;
PlacardInfo: HIThemePlacardDrawInfo;
@ -193,6 +200,8 @@ begin
HIThemeDrawPlacard(ARect, PlacardInfo, DC.CGContext, kHIThemeOrientationNormal),
Self, SName, 'HIThemeDrawPlacard');
end;
Result := CGRectToRect(ARect);
end;
{------------------------------------------------------------------------------
@ -201,33 +210,40 @@ end;
Details - Details for themed element
R - Bounding rectangle
ClipRect - Clipping rectangle
Returns: ClientRect
Draws a tool bar element with native Carbon look
------------------------------------------------------------------------------}
procedure TCarbonThemeServices.DrawToolBarElement(DC: TCarbonDeviceContext;
Details: TThemedElementDetails; R: TRect; ClipRect: PRect);
function TCarbonThemeServices.DrawToolBarElement(DC: TCarbonDeviceContext;
Details: TThemedElementDetails; R: TRect; ClipRect: PRect): TRect;
var
ButtonDrawInfo: HIThemeButtonDrawInfo;
LabelRect: HIRect;
begin
if Details.Part = TP_BUTTON then
begin
// TODO: if state is inactive or normal button should not have borders (or maybe I am wrong for mac?)
ButtonDrawInfo.version := 0;
ButtonDrawInfo.State := GetDrawState(Details);
ButtonDrawInfo.kind := kThemeBevelButtonSmall;
ButtonDrawInfo.value := kThemeButtonOff;
ButtonDrawInfo.adornment := kThemeAdornmentNone;
//InflateRect(R, 0, -2); // HiThemeDrawButton can draw outside it rect
LabelRect := RectToCGRect(R);
OSError(
HIThemeDrawButton(LabelRect, ButtonDrawInfo, DC.CGContext,
kHIThemeOrientationNormal, @LabelRect),
Self, 'DrawButtonElement', 'HIThemeDrawButton');
// if button is normal or disabled, draw it to dummy context, to eliminate borders
if (ButtonDrawInfo.State = kThemeStateActive) or
(ButtonDrawInfo.State = kThemeStateInActive) then
OSError(
HIThemeDrawButton(LabelRect, ButtonDrawInfo, DefaultContext.CGContext,
kHIThemeOrientationNormal, @LabelRect),
Self, 'DrawButtonElement', 'HIThemeDrawButton')
else
OSError(
HIThemeDrawButton(LabelRect, ButtonDrawInfo, DC.CGContext,
kHIThemeOrientationNormal, @LabelRect),
Self, 'DrawButtonElement', 'HIThemeDrawButton');
Result := CGRectToRect(LabelRect);
end;
end;
@ -270,11 +286,11 @@ function TCarbonThemeServices.ContentRect(DC: HDC;
begin
Result := BoundingRect;
// If you know how to get actual value, please do
// This should be one of theme metric
case Details.Element of
teHeader: InflateRect(Result, -2, -2);
teHeader: Result := DrawHeaderElement(DefaultContext, Details, BoundingRect, nil);
teButton: Result := DrawButtonElement(DefaultContext, Details, BoundingRect, nil);
teRebar: Result := DrawRebarElement(DefaultContext, Details, BoundingRect, nil);
teToolBar: Result := DrawToolBarElement(DefaultContext, Details, BoundingRect, nil);
end;
end;