paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-09 01:48:03 +02:00
Code Issues Packages Projects Releases Wiki Activity

Carbon intf.: improved TSpeedButton look

Browse Source 
git-svn-id: trunk@11063 -
This commit is contained in:
tombo 2007-05-03 12:52:33 +00:00
parent 0c2043b380
commit 6a51600353
10 changed files with 128 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lcl/include/speedbutton.inc
View File

@ -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,

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

@ -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:

1
lcl/interfaces/carbon/carbondef.pp
View File

@ -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;

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

@ -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;

29
lcl/interfaces/carbon/carbonprivatewindow.inc
View File

@ -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;

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

@ -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

30
lcl/interfaces/carbon/carbonwinapi.inc
View File

@ -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;

2
lcl/interfaces/carbon/carbonwinapih.inc
View File

@ -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;

32
lcl/interfaces/carbon/carbonwsbuttons.pp
View File

@ -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.

1
lcl/widgetset/wsbuttons.pp
View File

@ -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;