diff --git a/.gitattributes b/.gitattributes index c8f77be25b..8481b3254d 100644 --- a/.gitattributes +++ b/.gitattributes @@ -2474,6 +2474,7 @@ lcl/interfaces/carbon/carbonprivatewindow.inc svneol=native#text/pascal lcl/interfaces/carbon/carbonproc.pp svneol=native#text/pascal lcl/interfaces/carbon/carbonstrings.pp svneol=native#text/pascal lcl/interfaces/carbon/carbontabs.pp svneol=native#text/pascal +lcl/interfaces/carbon/carbonthemes.pas svneol=native#text/pascal lcl/interfaces/carbon/carbonutils.pas svneol=native#text/pascal lcl/interfaces/carbon/carbonwinapi.inc svneol=native#text/plain lcl/interfaces/carbon/carbonwinapih.inc svneol=native#text/plain diff --git a/lcl/interfaces/carbon/carbonint.pas b/lcl/interfaces/carbon/carbonint.pas index 730241e0b3..e6a2f93c7d 100644 --- a/lcl/interfaces/carbon/carbonint.pas +++ b/lcl/interfaces/carbon/carbonint.pas @@ -44,7 +44,7 @@ uses InterfaceBase, // LCL LCLStrConsts, LMessages, LCLMessageGlue, LCLProc, LCLIntf, LCLType, - GraphType, GraphMath, Graphics, Controls, Forms, Dialogs, Menus, Maps; + GraphType, GraphMath, Graphics, Controls, Forms, Dialogs, Menus, Maps, Themes; type @@ -60,6 +60,7 @@ type FMainMenu: TMainMenu; // Main menu attached to menu bar FCaptureWidget: HWND; // Captured widget (TCarbonWidget descendant) protected + function CreateThemeServices: TThemeServices; override; procedure PassCmdLineOptions; override; procedure SendCheckSynchronizeMessage; procedure OnWakeMainThread(Sender: TObject); @@ -141,6 +142,7 @@ uses // CarbonWSSpin, CarbonWSStdCtrls, // CarbonWSToolwin, + CarbonThemes, //////////////////////////////////////////////////// CarbonDef, CarbonPrivate, CarbonCanvas, CarbonGDIObjects, CarbonMenus, CarbonEdits, CarbonTabs, CarbonStrings, CarbonProc, CarbonDbgConsts, CarbonUtils, diff --git a/lcl/interfaces/carbon/carbonobject.inc b/lcl/interfaces/carbon/carbonobject.inc index 8226e25075..0466411718 100644 --- a/lcl/interfaces/carbon/carbonobject.inc +++ b/lcl/interfaces/carbon/carbonobject.inc @@ -458,6 +458,11 @@ begin CarbonWidgetSet := nil; end; +function TCarbonWidgetSet.CreateThemeServices: TThemeServices; +begin + Result := TCarbonThemeServices.Create; +end; + procedure TCarbonWidgetSet.PassCmdLineOptions; begin inherited PassCmdLineOptions; diff --git a/lcl/interfaces/carbon/carbonthemes.pas b/lcl/interfaces/carbon/carbonthemes.pas new file mode 100644 index 0000000000..b3d8e7f069 --- /dev/null +++ b/lcl/interfaces/carbon/carbonthemes.pas @@ -0,0 +1,203 @@ +unit CarbonThemes; + +{$mode objfpc}{$H+} + +interface + +uses + // rtl + Types, Classes, SysUtils, + // carbon bindings + FPCMacOSAll, + // lcl + LCLType, LCLProc, LCLIntf, Graphics, Themes, TmSchema, + // widgetset + CarbonProc, CarbonCanvas; + +type + { TCarbonThemeServices } + + TCarbonThemeServices = class(TThemeServices) + private + protected + function InitThemes: Boolean; override; + function UseThemes: Boolean; override; + function ThemedControlsEnabled: Boolean; override; + 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 DrawToolBarElement(DC: TCarbonDeviceContext; Details: TThemedElementDetails; R: TRect; ClipRect: PRect); + 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; + procedure DrawIcon(DC: HDC; Details: TThemedElementDetails; const R: TRect; himl: HIMAGELIST; Index: Integer); override; + procedure DrawText(DC: HDC; Details: TThemedElementDetails; const S: WideString; R: TRect; Flags, Flags2: Cardinal); override; + + function ContentRect(DC: HDC; Details: TThemedElementDetails; BoundingRect: TRect): TRect; override; + function HasTransparentParts(Details: TThemedElementDetails): Boolean; override; + end; + +implementation + +{ TCarbonThemeServices } + +function TCarbonThemeServices.GetDrawState(Details: TThemedElementDetails): ThemeDrawState; +{ + kThemeStateInactive = 0; + kThemeStateActive = 1; + kThemeStatePressed = 2; + kThemeStateRollover = 6; + kThemeStateUnavailable = 7; + kThemeStateUnavailableInactive = 8; + + kThemeStatePressedUp = 2; { draw with up pressed (increment/decrement buttons) } + kThemeStatePressedDown = 3; { draw with down pressed (increment/decrement buttons) } + +} +begin + if IsDisabled(Details) then + Result := kThemeStateInactive + else + if IsPushed(Details) then + Result := kThemeStatePressed + else + if IsHot(Details) then + Result := kThemeStateRollover + else + Result := kThemeStateActive; +end; + +procedure TCarbonThemeServices.DrawButtonElement(DC: TCarbonDeviceContext; + Details: TThemedElementDetails; R: TRect; ClipRect: PRect); +const + ButtonMap: array[BP_PUSHBUTTON..BP_USERBUTTON] of ThemeButtonKind = + ( +{BP_PUSHBUTTON } kThemePushButton, +{BP_RADIOBUTTON} kThemeRadioButton, +{BP_CHECKBOX } kThemeCheckBox, +{BP_GROUPBOX } kHIThemeGroupBoxKindPrimary, // ?? +{BP_USERBUTTON } kThemePushButton + ); +var + ButtonDrawInfo: HIThemeButtonDrawInfo; + // we can do so because GroupDrawIndo have common fields with ButtonDrawInfo + GroupDrawInfo: HIThemeGroupBoxDrawInfo absolute ButtonDrawInfo; + LabelRect: HIRect; +begin + ButtonDrawInfo.version := 0; + ButtonDrawInfo.State := GetDrawState(Details); + ButtonDrawInfo.kind := ButtonMap[Details.Part]; + 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 + OSError( + HIThemeDrawGroupBox(LabelRect, GroupDrawInfo, DC.CGContext, + kHIThemeOrientationNormal), + Self, 'DrawButtonElement', 'HIThemeDrawGroupBox') + else + OSError( + HIThemeDrawButton(LabelRect, ButtonDrawInfo, DC.CGContext, + kHIThemeOrientationNormal, @LabelRect), + Self, 'DrawButtonElement', 'HIThemeDrawButton'); +end; + +procedure TCarbonThemeServices.DrawToolBarElement(DC: TCarbonDeviceContext; + Details: TThemedElementDetails; R: TRect; ClipRect: PRect); +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'); + end; +end; + +function TCarbonThemeServices.InitThemes: Boolean; +begin + Result := True; +end; + +function TCarbonThemeServices.UseThemes: Boolean; +begin + Result := True; +end; + +function TCarbonThemeServices.ThemedControlsEnabled: Boolean; +begin + Result := True; +end; + +function TCarbonThemeServices.ContentRect(DC: HDC; + Details: TThemedElementDetails; BoundingRect: TRect): TRect; +begin + Result := BoundingRect; +end; + +procedure TCarbonThemeServices.DrawEdge(DC: HDC; + Details: TThemedElementDetails; const R: TRect; Edge, Flags: Cardinal; + AContentRect: PRect); +begin + +end; + +procedure TCarbonThemeServices.DrawElement(DC: HDC; + Details: TThemedElementDetails; const R: TRect; ClipRect: PRect); +var + Context: TCarbonDeviceContext absolute DC; +begin + if CheckDC(DC, 'TCarbonThemeServices.DrawElement') then + begin + case Details.Element of + teButton: DrawButtonElement(Context, Details, R, ClipRect); + teToolBar: DrawToolBarElement(Context, Details, R, ClipRect); + end; + end; +end; + +procedure TCarbonThemeServices.DrawIcon(DC: HDC; + Details: TThemedElementDetails; const R: TRect; himl: HIMAGELIST; + Index: Integer); +begin + +end; + +function TCarbonThemeServices.HasTransparentParts(Details: TThemedElementDetails): Boolean; +begin + Result := True; +end; + +procedure TCarbonThemeServices.InternalDrawParentBackground(Window: HWND; + Target: HDC; Bounds: PRect); +begin + // ? +end; + +procedure TCarbonThemeServices.DrawText(DC: HDC; Details: TThemedElementDetails; + const S: WideString; R: TRect; Flags, Flags2: Cardinal); +begin + // +end; + +end. + diff --git a/lcl/themes.pas b/lcl/themes.pas index 2a7609c86c..d20aba42b9 100644 --- a/lcl/themes.pas +++ b/lcl/themes.pas @@ -407,9 +407,6 @@ type FOnThemeChange: TNotifyEvent; // Called when the current window theme has changed. function GetThemesEnabled: Boolean; - function IsDisabled(Details: TThemedElementDetails): Boolean; - function IsPushed(Details: TThemedElementDetails): Boolean; - function IsHot(Details: TThemedElementDetails): Boolean; protected function InitThemes: Boolean; virtual; procedure UnloadThemeData; virtual; @@ -418,6 +415,10 @@ type function InternalColorToRGB(Details: TThemedElementDetails; Color: LongInt): LongInt; virtual; procedure InternalDrawParentBackground(Window: HWND; Target: HDC; Bounds: PRect); virtual; + + function IsDisabled(Details: TThemedElementDetails): Boolean; + function IsPushed(Details: TThemedElementDetails): Boolean; + function IsHot(Details: TThemedElementDetails): Boolean; public constructor Create; destructor Destroy; override;