diff --git a/lcl/include/speedbutton.inc b/lcl/include/speedbutton.inc index b30a79fab3..5107b9c14f 100644 --- a/lcl/include/speedbutton.inc +++ b/lcl/include/speedbutton.inc @@ -451,7 +451,7 @@ begin FLastDrawFlags:=GetDrawFlags; //DebugLn('TCustomSpeedButton.Paint ',Name,':',ClassName,' Parent.Name=',Parent.Name); - TWSSpeedButton.DrawFrame(Self, FLastDrawFlags, PaintRect); + TWSSpeedButtonClass(WidgetSetClass).DrawFrame(Self, FLastDrawFlags, PaintRect); //debugln(['TCustomSpeedButton.Paint ',Name,':',ClassName,' Parent.Name=',Parent.Name, // ' DFCS_BUTTONPUSH=',FLastDrawFlags and DFCS_BUTTONPUSH, diff --git a/lcl/interfaces/carbon/carboncanvas.pp b/lcl/interfaces/carbon/carboncanvas.pp index 7d2522db4a..770a6ce7ac 100644 --- a/lcl/interfaces/carbon/carboncanvas.pp +++ b/lcl/interfaces/carbon/carboncanvas.pp @@ -99,6 +99,7 @@ type procedure SetAntialiasing(AValue: Boolean); public + procedure DrawFrameControl(var ARect: TRect; AType, AState: Cardinal); procedure Ellipse(X1, Y1, X2, Y2: Integer); procedure ExcludeClipRect(Left, Top, Right, Bottom: Integer); function ExtTextOut(X, Y: Integer; Options: Longint; Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean; @@ -596,6 +597,53 @@ begin CGContextSetShouldAntialias(CGContext, CBool(AValue)); end; +{------------------------------------------------------------------------------ + Method: TCarbonDeviceContext.DrawFrameControl + Params: Rect - Bounding rectangle, returned adujsted to frame client area + UType - Frame-control type + UState - Frame-control state + + Draws a frame control of the specified type and style + ------------------------------------------------------------------------------} +procedure TCarbonDeviceContext.DrawFrameControl(var ARect: TRect; AType, + AState: Cardinal); +var + DrawInfo: HIThemeButtonDrawInfo; + LabelRect: HIRect; +begin + case AType of + DFC_BUTTON: + begin + DrawInfo.version := 0; + + if (AState and DFCS_INACTIVE > 0) then + DrawInfo.state := kThemeStateInactive + else + begin + if (AState and DFCS_PUSHED > 0) then + DrawInfo.state := kThemeStatePressed + else + DrawInfo.state := kThemeStateActive; + end; + + DrawInfo.kind := kThemeBevelButtonSmall; + DrawInfo.value := 0; + DrawInfo.adornment := kThemeAdornmentNone; + + LabelRect := RectToCGRect(ARect); + + OSError( + HIThemeDrawButton(LabelRect, DrawInfo, CGContext, + kHIThemeOrientationNormal, @LabelRect), + Self, 'DrawFrameControl', 'HIThemeDrawButton'); + + ARect := CGRectToRect(LabelRect); + end; + else + DebugLn('TCarbonDeviceContext.DrawFrameControl TODO Type: ' + DbgS(AType)); + end; +end; + {------------------------------------------------------------------------------ Method: TCarbonDeviceContext.Ellipse Params: diff --git a/lcl/interfaces/carbon/carbondef.pp b/lcl/interfaces/carbon/carbondef.pp index 797dd51cde..090964354f 100644 --- a/lcl/interfaces/carbon/carbondef.pp +++ b/lcl/interfaces/carbon/carbondef.pp @@ -326,6 +326,7 @@ begin // Tweaking the memmanager is also not possible since only the class is public // and not the manager itself. + Node.Clear; UPPTree.Delete(Node); end; diff --git a/lcl/interfaces/carbon/carbonprivate.pp b/lcl/interfaces/carbon/carbonprivate.pp index 80c02f8420..f8bf944710 100644 --- a/lcl/interfaces/carbon/carbonprivate.pp +++ b/lcl/interfaces/carbon/carbonprivate.pp @@ -977,8 +977,8 @@ begin begin GetClientRect(R); - WidgetSet.ExtTextOut(HDC(Context), R.Top, R.Left, 0, nil, PChar(StatusBar.SimpleText), - Length(StatusBar.SimpleText), nil); + (Context as TCarbonDeviceContext).ExtTextOut(R.Top, R.Left, 0, nil, + PChar(StatusBar.SimpleText), Length(StatusBar.SimpleText), nil); end; end; diff --git a/lcl/interfaces/carbon/carbonprivatewindow.inc b/lcl/interfaces/carbon/carbonprivatewindow.inc index cdf520277d..f3f650cacd 100644 --- a/lcl/interfaces/carbon/carbonprivatewindow.inc +++ b/lcl/interfaces/carbon/carbonprivatewindow.inc @@ -313,9 +313,9 @@ const SName = 'CarbonWindow_KeyboardProc'; AGetEvent = 'GetEventParameter'; - //See what changed in the modifiers flag so that we can emulate a keyup/keydown - //note: this function assumes that only a bit of the flag can be modified at - //once + // See what changed in the modifiers flag so that we can emulate a keyup/keydown + // Note: this function assumes that only a bit of the flag can be modified at + // once function EmulateModifiersDownUp : boolean; var CurMod, diff : UInt32; begin @@ -490,12 +490,12 @@ const end; end; - //There is no known VK_ code for this characther. Use a dummy keycode - //(E8, which is unused by Windows) so that KeyUp/KeyDown events will be - //triggered by LCL. - //Note: we can't use the raw mac keycode, since it could collide with - //well known VK_ keycodes (e.g on my italian ADB keyboard, keycode for - //"è" is 33, which is the same as VK_PRIOR) + // There is no known VK_ code for this characther. Use a dummy keycode + // (E8, which is unused by Windows) so that KeyUp/KeyDown events will be + // triggered by LCL. + // Note: we can't use the raw mac keycode, since it could collide with + // well known VK_ keycodes (e.g on my italian ADB keyboard, keycode for + // "è" is 33, which is the same as VK_PRIOR) if VKKeyCode=VK_UNKNOWN then VKKeyCode:=$E8; {$IFDEF VerboseKeyboard} @@ -601,8 +601,15 @@ const Result := CallNextEventHandler(ANextHandler, AEvent); //Send a LM_(SYS)CHAR - if IsSysKey then CharMsg.Msg := LM_SYSCHAR + if IsSysKey then + begin + //CharMsg.Msg := LM_SYSCHAR + // Do not send LM_SYSCHAR message - workaround for disabling + // accelerators like "Cmd + C" for &Caption + Exit; + end else CharMsg.Msg := LM_CHAR; + if DeliverMessage(Widget.LCLObject, CharMsg) <> 0 then begin // the LCL handled the key @@ -759,10 +766,8 @@ begin Result := CallNextEventHandler(ANextHandler, AEvent); - EventKind := GetEventKind(AEvent); - Kind := -1; case EventKind of kEventWindowCollapsed: Kind := SIZEICONIC; diff --git a/lcl/interfaces/carbon/carbonproc.pp b/lcl/interfaces/carbon/carbonproc.pp index 7ee3e06ddd..681f2bc409 100644 --- a/lcl/interfaces/carbon/carbonproc.pp +++ b/lcl/interfaces/carbon/carbonproc.pp @@ -502,7 +502,7 @@ end; B - Rectangle to be excluded Returns: Array of CGRect, which are product of exclusion rectangle B from rectangle A. - Note: The returned rectangles may overlay. + Note: The returned rectangles may overlap. ------------------------------------------------------------------------------} function ExcludeRect(const A, B: TRect): CGRectArray; begin diff --git a/lcl/interfaces/carbon/carbonwinapi.inc b/lcl/interfaces/carbon/carbonwinapi.inc index 597d7512e6..af41f7b4be 100644 --- a/lcl/interfaces/carbon/carbonwinapi.inc +++ b/lcl/interfaces/carbon/carbonwinapi.inc @@ -438,10 +438,34 @@ begin TCarbonCursor(Handle).Free; end; -function TCarbonWidgetSet.DrawFrameControl(DC: HDC; const Rect: TRect; uType, - uState: Cardinal): Boolean; +{------------------------------------------------------------------------------ + Method: DrawFrameControl + Params: DC - Handle to device context + Rect - Bounding rectangle + UType - Frame-control type + UState - Frame-control state + Returns: If the function succeeds + + Draws a frame control of the specified type and style. + ------------------------------------------------------------------------------} +function TCarbonWidgetSet.DrawFrameControl(DC: HDC; const Rect: TRect; UType, + UState: Cardinal): Boolean; +var + R: TRect; begin - Result:=inherited DrawFrameControl(DC, Rect, uType, uState); + Result := False; + + {$IFDEF VerboseWinAPI} + DebugLn('TCarbonWidgetSet.DrawFrameControl DC: ' + DbgS(DC) + ' R: ' + + DbgS(Rect) + ' Type: ' + DbgS(UType) + ' Style: ' + DbgS(Style); + {$ENDIF} + + if not CheckDC(DC, 'DrawFrameControl') then Exit; + + R := Rect; + TCarbonDeviceContext(DC).DrawFrameControl(R, UType, UState); + + Result := True; end; function TCarbonWidgetSet.DrawEdge(DC: HDC; var ARect: TRect; Edge: Cardinal; diff --git a/lcl/interfaces/carbon/carbonwinapih.inc b/lcl/interfaces/carbon/carbonwinapih.inc index 03774a7a62..4a59c2f3cf 100644 --- a/lcl/interfaces/carbon/carbonwinapih.inc +++ b/lcl/interfaces/carbon/carbonwinapih.inc @@ -71,7 +71,7 @@ function DeleteDC(hDC: HDC): Boolean; override; function DeleteObject(GDIObject: HGDIOBJ): Boolean; override; function DestroyCaret(Handle : HWND): Boolean; override; function DestroyCursor(Handle: HCURSOR): Boolean; override; -function DrawFrameControl(DC: HDC; const Rect : TRect; uType, uState : Cardinal) : Boolean; override; +function DrawFrameControl(DC: HDC; const Rect: TRect; UType, UState: Cardinal) : Boolean; override; function DrawEdge(DC: HDC; var ARect: TRect; Edge: Cardinal; grfFlags: Cardinal): Boolean; override; function DrawText(DC: HDC; Str: PChar; Count: Integer; var Rect: TRect; Flags: Cardinal): Integer; Override; diff --git a/lcl/interfaces/carbon/carbonwsbuttons.pp b/lcl/interfaces/carbon/carbonwsbuttons.pp index efa51e11f1..aeb51732f7 100644 --- a/lcl/interfaces/carbon/carbonwsbuttons.pp +++ b/lcl/interfaces/carbon/carbonwsbuttons.pp @@ -33,7 +33,7 @@ uses // libs FPCMacOSAll, // LCL - Controls, Buttons, LCLType, LCLProc, Graphics, + Classes, Controls, Buttons, LCLType, LCLProc, Graphics, // widgetset WSButtons, WSLCLClasses, WSProc, // LCL Carbon @@ -68,13 +68,14 @@ type private protected public + class procedure DrawFrame(const ASpeedButton: TCustomSpeedButton; const ADrawFlags: Integer; var ARect: TRect); override; end; implementation uses - CarbonProc, CarbonDbgConsts; + CarbonProc, CarbonDbgConsts, CarbonCanvas; { TCarbonWSButton } @@ -155,6 +156,31 @@ begin TCarbonBitBtn(ABitBtn.Handle).SetLayout(AValue); end; +{ TCarbonWSSpeedButton } + +{------------------------------------------------------------------------------ + Method: TCarbonWSSpeedButton.DrawFrame + Params: ASpeedButton - LCL custom speed button + ADrawFlags - Frame draw flags (DFCS_*) + ARect - Frame rectangle, returned adjusted to frame client + area + + Draws a speed button frame according to the specified draw flags in Carbon + ------------------------------------------------------------------------------} +class procedure TCarbonWSSpeedButton.DrawFrame(const ASpeedButton: TCustomSpeedButton; + const ADrawFlags: Integer; var ARect: TRect); +var + DC: HDC; +begin + if (ADrawFlags and DFCS_FLAT) = 0 then + begin + DC := ASpeedButton.Canvas.GetUpdatedHandle([csBrushValid, csPenValid]); + + TCarbonDeviceContext(DC).DrawFrameControl(ARect, DFC_BUTTON, ADrawFlags); + end; + // TODO: transparent and colored opaque style +end; + initialization //////////////////////////////////////////////////// @@ -165,6 +191,6 @@ initialization //////////////////////////////////////////////////// RegisterWSComponent(TCustomButton, TCarbonWSButton); RegisterWSComponent(TCustomBitBtn, TCarbonWSBitBtn); -// RegisterWSComponent(TCustomSpeedButton, TCarbonWSSpeedButton); + RegisterWSComponent(TCustomSpeedButton, TCarbonWSSpeedButton); //////////////////////////////////////////////////// end. diff --git a/lcl/widgetset/wsbuttons.pp b/lcl/widgetset/wsbuttons.pp index 0f15e8c4e7..d10d24b01f 100644 --- a/lcl/widgetset/wsbuttons.pp +++ b/lcl/widgetset/wsbuttons.pp @@ -70,6 +70,7 @@ type { TWSSpeedButton } + TWSSpeedButtonClass = class of TWSSpeedButton; TWSSpeedButton = class(TWSGraphicControl) class procedure DrawFrame(const ASpeedButton: TCustomSpeedButton; const ADrawFlags: Integer; var ARect: TRect); virtual; end;