mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-11 10:56:06 +02:00
Carbon inf:
- fixed bug #0009410: Carbon TMainMenu does not reflect currently focused form - fixed bug #0009409: Carbon Widgetset: Radio TMenuItem does not update - fixed bug #0009266: UTF8 conversion problem with the output of components when using the cabon interace - applied patch #0009423: Fix for Carbon custom control keyboard focus from Jonas Maebe, added to Contributors.txt - corrected DefaultBitmap and CGBitmapContext creation - fixed ExtTextOut origin with rotated font - fixed FindCarbonFontID, implemented Get/SetWindowOrgEx from Phil J. Hess git-svn-id: trunk@11915 -
This commit is contained in:
tombo
parent
9c1f90ed0a
commit
f8b9b1966c
@ -1,4 +1,4 @@
|
||||
The following people contributed to Lazarus:
|
||||
The following people contributed to Lazarus:
|
||||
|
||||
A. J. Venter
|
||||
Aleksey Lagunov
|
||||
@ -46,6 +46,7 @@ Jeffrey A. Wormsley
|
||||
Jeroen van Idekinge
|
||||
Jesus Reyes
|
||||
Joerg Braun - german translation
|
||||
Jonas Maebe
|
||||
Joost van der Sluis
|
||||
Jouke Rensma
|
||||
Juan Salvador Perez García
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
See Contributors.txt for all contributors.
|
||||
See Contributors.txt for all contributors.
|
||||
This file is only a placeholder for the correct spelling
|
||||
of some names until all widgetsets correctly display
|
||||
utf8 names.
|
||||
@ -14,4 +14,5 @@ Júnior Gonçalves
|
||||
Luiz Américo
|
||||
Márton Papp
|
||||
Sérgio Marcelo
|
||||
Tomáš Gregorovič
|
||||
Valdas Jankūnas
|
||||
|
||||
@ -106,6 +106,7 @@ type
|
||||
procedure EndTextRender(var ALayout: ATSUTextLayout);
|
||||
|
||||
procedure SetAntialiasing(AValue: Boolean);
|
||||
function DrawCGImage(X, Y, Width, Height: Integer; CGImage: CGImageRef): Boolean;
|
||||
public
|
||||
procedure DrawFocusRect(const ARect: TRect);
|
||||
procedure DrawFrameControl(var ARect: TRect; AType, AState: Cardinal);
|
||||
@ -652,7 +653,7 @@ begin
|
||||
PValue := @CGContext;
|
||||
if OSError(ATSUSetLayoutControls(ALayout, 1, @Tag, @DataSize, @PValue),
|
||||
Self, SName, 'ATSUSetLayoutControls', 'CGContext') then Exit;
|
||||
|
||||
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
@ -683,6 +684,36 @@ begin
|
||||
CGContextSetShouldAntialias(CGContext, CBool(AValue));
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCarbonDeviceContext.DrawCGImage
|
||||
Params: X, Y - Left, Top
|
||||
Width, Height
|
||||
CGImage
|
||||
Returns: If the function succeeds
|
||||
|
||||
Draws CGImage into CGContext
|
||||
------------------------------------------------------------------------------}
|
||||
function TCarbonDeviceContext.DrawCGImage(X, Y, Width, Height: Integer;
|
||||
CGImage: CGImageRef): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
|
||||
// save dest context
|
||||
CGContextSaveGState(CGContext);
|
||||
|
||||
CGContextSetBlendMode(CGContext, kCGBlendModeNormal);
|
||||
try
|
||||
if OSError(
|
||||
HIViewDrawCGImage(CGContext,
|
||||
GetCGRectSorted(X, Y, X + Width, Y + Height), CGImage),
|
||||
'DrawCGImage', 'HIViewDrawCGImage') then Exit;
|
||||
finally
|
||||
CGContextRestoreGState(CGContext);
|
||||
end;
|
||||
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCarbonDeviceContext.DrawFocusRect
|
||||
Params: ARect - Bounding rectangle
|
||||
@ -836,6 +867,8 @@ function TCarbonDeviceContext.ExtTextOut(X, Y: Integer; Options: Longint;
|
||||
var
|
||||
TextLayout: ATSUTextLayout;
|
||||
TextBefore, TextAfter, Ascent, Descent: ATSUTextMeasurement;
|
||||
MX, MY: ATSUTextMeasurement;
|
||||
A: Single;
|
||||
const
|
||||
SName = 'ExtTextOut';
|
||||
begin
|
||||
@ -853,6 +886,7 @@ begin
|
||||
|
||||
Exit;
|
||||
end;
|
||||
|
||||
try
|
||||
// get text ascent
|
||||
if OSError(
|
||||
@ -860,23 +894,33 @@ begin
|
||||
TextBefore, TextAfter, Ascent, Descent),
|
||||
Self, SName, SGetUnjustifiedBounds) then Exit;
|
||||
|
||||
// fill drawed text background
|
||||
if (Options and ETO_OPAQUE) > 0 then
|
||||
if CurrentFont.LineRotation <> 0 then // TODO: fill rotated text background
|
||||
begin
|
||||
BkBrush.Apply(Self, False); // do not use ROP2
|
||||
CGContextFillRect(CGContext, GetCGRectSorted(X - TextBefore shr 16,
|
||||
-Y, X + TextAfter shr 16, -Y - (Ascent + Descent) shr 16));
|
||||
A := CurrentFont.LineRotation * (PI / ($10000 * 180));
|
||||
MX := Round(Ascent * Sin(A));
|
||||
MY := Round(Ascent - Ascent * Cos(A));
|
||||
end
|
||||
else
|
||||
begin
|
||||
MX := 0;
|
||||
MY := 0;
|
||||
|
||||
// fill drawed text background
|
||||
if (Options and ETO_OPAQUE) > 0 then
|
||||
begin
|
||||
BkBrush.Apply(Self, False); // do not use ROP2
|
||||
CGContextFillRect(CGContext, GetCGRectSorted(X - TextBefore shr 16,
|
||||
-Y, X + TextAfter shr 16, -Y - (Ascent + Descent) shr 16));
|
||||
end;
|
||||
end;
|
||||
|
||||
// apply text color
|
||||
TextBrush.Apply(Self, False); // do not use ROP2
|
||||
|
||||
|
||||
// finally draw the text
|
||||
if OSError(ATSUDrawText(TextLayout, kATSUFromTextBeginning, kATSUToTextEnd,
|
||||
X shl 16 - TextBefore, -(Y shl 16) - Ascent),
|
||||
X shl 16 - TextBefore + MX, -(Y shl 16) - Ascent + MY),
|
||||
Self, SName, 'ATSUDrawText') then Exit;
|
||||
|
||||
Result := True;
|
||||
finally
|
||||
EndTextRender(TextLayout);
|
||||
@ -1288,76 +1332,77 @@ var
|
||||
SubImage, SubMask: Boolean;
|
||||
Bitmap: TCarbonBitmap;
|
||||
LayRect, DstRect: CGRect;
|
||||
sts: OSStatus;
|
||||
LayerContext: CGContextRef;
|
||||
Layer: CGLayerRef;
|
||||
begin
|
||||
Result := False;
|
||||
|
||||
// save dest context
|
||||
CGContextSaveGState(CGContext);
|
||||
Image := nil;
|
||||
Bitmap := SrcDC.GetBitmap;
|
||||
if Bitmap <> nil then Image := Bitmap.CGImage;
|
||||
|
||||
CGContextSetBlendMode(CGContext, kCGBlendModeNormal);
|
||||
try
|
||||
Image := nil;
|
||||
Bitmap := SrcDC.GetBitmap;
|
||||
if Bitmap <> nil then Image := Bitmap.CGImage;
|
||||
if Image = nil then Exit;
|
||||
|
||||
if Image = nil then Exit;
|
||||
|
||||
DstRect := CGRectMake(X, Y, Abs(Width), Abs(Height));
|
||||
|
||||
SubMask := (Msk <> nil)
|
||||
and (Msk.CGImage <> nil)
|
||||
and ( (XMsk <> 0)
|
||||
or (YMsk <> 0)
|
||||
or (Msk.Width <> SrcWidth)
|
||||
or (Msk.Height <> SrcHeight));
|
||||
DstRect := CGRectMake(X, Y, Abs(Width), Abs(Height));
|
||||
|
||||
SubImage := ((Msk <> nil) and (Msk.CGImage <> nil))
|
||||
or (XSrc <> 0)
|
||||
or (YSrc <> 0)
|
||||
or (SrcWidth <> Bitmap.Width)
|
||||
or (SrcHeight <> Bitmap.Height);
|
||||
|
||||
SubMask := (Msk <> nil)
|
||||
and (Msk.CGImage <> nil)
|
||||
and ( (XMsk <> 0)
|
||||
or (YMsk <> 0)
|
||||
or (Msk.Width <> SrcWidth)
|
||||
or (Msk.Height <> SrcHeight));
|
||||
|
||||
if SubMask
|
||||
then MskImage := Msk.CreateSubImage(Bounds(XMsk, YMsk, SrcWidth, SrcHeight))
|
||||
else if Msk <> nil
|
||||
then MskImage := Msk.CGImage
|
||||
SubImage := ((Msk <> nil) and (Msk.CGImage <> nil))
|
||||
or (XSrc <> 0)
|
||||
or (YSrc <> 0)
|
||||
or (SrcWidth <> Bitmap.Width)
|
||||
or (SrcHeight <> Bitmap.Height);
|
||||
|
||||
|
||||
if SubMask then
|
||||
MskImage := Msk.CreateSubImage(Bounds(XMsk, YMsk, SrcWidth, SrcHeight))
|
||||
else
|
||||
if Msk <> nil then MskImage := Msk.CGImage
|
||||
else MskImage := nil;
|
||||
|
||||
if SubImage
|
||||
then Image := Bitmap.CreateSubImage(Bounds(XSrc, YSrc, SrcWidth, SrcHeight));
|
||||
|
||||
if SubImage then
|
||||
Image := Bitmap.CreateSubImage(Bounds(XSrc, YSrc, SrcWidth, SrcHeight));
|
||||
|
||||
if MskImage = nil
|
||||
then begin
|
||||
try
|
||||
if MskImage = nil then
|
||||
begin
|
||||
// Normal drawing
|
||||
sts := HIViewDrawCGImage(CGContext, DstRect, Image);
|
||||
Result := not OSError(sts, 'StretchMaskBlt', 'HIViewDrawCGImage');
|
||||
Result := DrawCGImage(X, Y, Width, Height, Image);
|
||||
end
|
||||
else begin
|
||||
else
|
||||
begin
|
||||
// use temp layer to mask source image
|
||||
// todo find a way to maks "hard" when stretching, now some soft remains are visible
|
||||
LayRect := CGRectMake(0, 0, SrcWidth, SrcHeight);
|
||||
Layer := CGLayerCreateWithContext(SrcDC.CGContext, LayRect.size, nil);
|
||||
LayerContext := CGLayerGetContext(Layer);
|
||||
CGContextScaleCTM(LayerContext, 1, -1);
|
||||
CGContextTranslateCTM(LayerContext, 0, -SrcHeight);
|
||||
CGContextClipToMask(LayerContext, LayRect, MskImage);
|
||||
CGContextDrawImage(LayerContext, LayRect, Image);
|
||||
CGContextDrawLayerInRect(CGContext, DstRect, Layer);
|
||||
CGLayerRelease(Layer);
|
||||
Result := True;
|
||||
try
|
||||
LayerContext := CGLayerGetContext(Layer);
|
||||
CGContextScaleCTM(LayerContext, 1, -1);
|
||||
CGContextTranslateCTM(LayerContext, 0, -SrcHeight);
|
||||
CGContextClipToMask(LayerContext, LayRect, MskImage);
|
||||
CGContextDrawImage(LayerContext, LayRect, Image);
|
||||
CGContextDrawLayerInRect(CGContext, DstRect, Layer);
|
||||
|
||||
Result := True;
|
||||
finally
|
||||
CGLayerRelease(Layer);
|
||||
end;
|
||||
end;
|
||||
|
||||
finally
|
||||
if SubImage then CGImageRelease(Image);
|
||||
if SubMask then CGImageRelease(MskImage);
|
||||
|
||||
finally
|
||||
CGContextRestoreGState(CGContext);
|
||||
end;
|
||||
|
||||
//DebugLn('StretchMaskBlt succeeds: ', Format('Dest %d Src %d X %d Y %d',
|
||||
// [Integer(CGContext),
|
||||
// Integer(Image),
|
||||
// X, Y]));
|
||||
end;
|
||||
|
||||
{ TCarbonScreenContext }
|
||||
@ -1481,6 +1526,8 @@ end;
|
||||
Resets the bitmap context properties to defaults (pen, brush, ...)
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TCarbonBitmapContext.Reset;
|
||||
var
|
||||
Info: CGBitmapInfo;
|
||||
begin
|
||||
if CGContext <> nil then CGContextRelease(CGContext);
|
||||
|
||||
@ -1506,9 +1553,14 @@ begin
|
||||
|
||||
// create CGBitmapContext
|
||||
|
||||
Info := FBitmap.Info;
|
||||
// convert kCGImageAlphaFirst -> kCGImageAlphaNoneSkipFirst
|
||||
if (Info and kCGImageAlphaFirst > 0) then
|
||||
Info := (Info and (not kCGImageAlphaFirst)) or kCGImageAlphaNoneSkipFirst;
|
||||
|
||||
CGContext := CGBitmapContextCreate(FBitmap.Data, FBitmap.Width, FBitmap.Height,
|
||||
FBitmap.BitsPerComponent, FBitmap.BytesPerRow, FBitmap.ColorSpace,
|
||||
FBitmap.Info);
|
||||
Info);
|
||||
|
||||
// flip and offset CTM to upper left corner
|
||||
CGContextTranslateCTM(CGContext, 0, FBitmap.Height);
|
||||
|
||||
@ -932,17 +932,9 @@ end;
|
||||
Text changed event handler
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TCarbonSpinEdit.TextDidChange;
|
||||
var
|
||||
NewValue: Single;
|
||||
begin
|
||||
NewValue := StrToFloatDef((LCLObject as TCustomFloatSpinEdit).Text, FValue);
|
||||
|
||||
if FMax > FMin then
|
||||
begin
|
||||
if NewValue > FMax then NewValue := FMax;
|
||||
if NewValue < FMin then NewValue := FMin;
|
||||
end;
|
||||
FValue := NewValue;
|
||||
FValue := (LCLObject as TCustomFloatSpinEdit).StrToValue(
|
||||
(LCLObject as TCustomFloatSpinEdit).Text);
|
||||
|
||||
inherited TextDidChange;
|
||||
end;
|
||||
@ -959,14 +951,8 @@ begin
|
||||
kControlUpButtonPart: FValue := FValue + FIncrement;
|
||||
kControlDownButtonPart: FValue := FValue - FIncrement;
|
||||
end;
|
||||
if FMax > FMin then
|
||||
begin
|
||||
if FValue < FMin then FValue := FMin;
|
||||
if FValue > FMax then FValue := FMax;
|
||||
end;
|
||||
|
||||
(LCLObject as TCustomFloatSpinEdit).Text :=
|
||||
FloatToStrF(FValue, ffFixed, 20, FDecimalPlaces);
|
||||
inherited SetText((LCLObject as TCustomFloatSpinEdit).ValueToStr(FValue));
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -1010,17 +996,8 @@ end;
|
||||
Sets the text of edit control
|
||||
------------------------------------------------------------------------------}
|
||||
function TCarbonSpinEdit.SetText(const S: String): Boolean;
|
||||
var
|
||||
NewValue: Single;
|
||||
begin
|
||||
NewValue := StrToFloatDef(S, FValue);
|
||||
|
||||
if FMax > FMin then
|
||||
begin
|
||||
if NewValue > FMax then NewValue := FMax;
|
||||
if NewValue < FMin then NewValue := FMin;
|
||||
end;
|
||||
FValue := NewValue;
|
||||
FValue := (LCLObject as TCustomFloatSpinEdit).StrToValue(S);
|
||||
|
||||
Result := inherited SetText(S);
|
||||
end;
|
||||
@ -1042,7 +1019,7 @@ begin
|
||||
FDecimalPlaces := SpinEdit.DecimalPlaces;
|
||||
|
||||
// update edit text
|
||||
SpinEdit.Text := FloatToStrF(FValue, ffFixed, 20, FDecimalPlaces);
|
||||
inherited SetText((LCLObject as TCustomFloatSpinEdit).ValueToStr(FValue));
|
||||
end;
|
||||
|
||||
{ TCarbonEdit }
|
||||
|
||||
@ -100,6 +100,7 @@ type
|
||||
constructor Create(const AColor: TColor; ASolid, AGlobal: Boolean);
|
||||
procedure SetColor(const AColor: TColor; ASolid: Boolean);
|
||||
procedure GetRGBA(AROP2: Integer; out AR, AG, AB, AA: Single);
|
||||
function CreateCGColor: CGColorRef;
|
||||
end;
|
||||
|
||||
{ TCarbonBrush }
|
||||
@ -159,6 +160,7 @@ type
|
||||
TCarbonBitmap = class(TCarbonGDIObject)
|
||||
private
|
||||
FData: Pointer;
|
||||
FFreeData: Boolean;
|
||||
FDataSize: Integer;
|
||||
FBytesPerRow: Integer;
|
||||
FDepth: Byte;
|
||||
@ -171,7 +173,9 @@ type
|
||||
function GetColorSpace: CGColorSpaceRef;
|
||||
function GetInfo: CGBitmapInfo;
|
||||
public
|
||||
constructor Create(AWidth, AHeight, ADepth, ABitsPerPixel: Integer; AAlignment: TCarbonBitmapAlignment; AType: TCarbonBitmapType; AData: Pointer);
|
||||
constructor Create(AWidth, AHeight, ADepth, ABitsPerPixel: Integer;
|
||||
AAlignment: TCarbonBitmapAlignment; AType: TCarbonBitmapType;
|
||||
AData: Pointer; ACopyData: Boolean = True);
|
||||
destructor Destroy; override;
|
||||
procedure Update;
|
||||
function CreateSubImage(const ARect: TRect): CGImageRef;
|
||||
@ -871,6 +875,22 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCarbonColorObject.CreateCGColor
|
||||
Returns: CGColor
|
||||
------------------------------------------------------------------------------}
|
||||
function TCarbonColorObject.CreateCGColor: CGColorRef;
|
||||
var
|
||||
F: Array [0..3] of Single;
|
||||
begin
|
||||
F[0] := FR / 255;
|
||||
F[1] := FG / 255;
|
||||
F[2] := FB / 255;
|
||||
F[3] := Byte(FA);
|
||||
|
||||
Result := CGColorCreate(RGBColorSpace, @F[0]);
|
||||
end;
|
||||
|
||||
{ TCarbonBrush }
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -1043,6 +1063,10 @@ begin
|
||||
else Result := RGBColorSpace
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCarbonBitmap.GetInfo
|
||||
Returns: The CGBitmapInfo for this type of bitmap
|
||||
------------------------------------------------------------------------------}
|
||||
function TCarbonBitmap.GetInfo: CGBitmapInfo;
|
||||
begin
|
||||
Result := BITMAPINFOMAP[FType];
|
||||
@ -1056,10 +1080,13 @@ end;
|
||||
ABitsPerPixel - The number of allocated bits per pixel (can be larget that depth)
|
||||
AAlignment - Alignment of the data for each row
|
||||
ABytesPerRow - The number of bytes between rows
|
||||
ACopyData - Copy supplied bitmap data (OPTIONAL)
|
||||
|
||||
Creates Carbon bitmap with the specified characteristics
|
||||
------------------------------------------------------------------------------}
|
||||
constructor TCarbonBitmap.Create(AWidth, AHeight, ADepth, ABitsPerPixel: Integer; AAlignment: TCarbonBitmapAlignment; AType: TCarbonBitmapType; AData: Pointer);
|
||||
constructor TCarbonBitmap.Create(AWidth, AHeight, ADepth, ABitsPerPixel: Integer;
|
||||
AAlignment: TCarbonBitmapAlignment; AType: TCarbonBitmapType; AData: Pointer;
|
||||
ACopyData: Boolean);
|
||||
const
|
||||
ALIGNBITS: array[TCarbonBitmapAlignment] of Integer = (0, 1, 3, 7, $F);
|
||||
var
|
||||
@ -1084,12 +1111,21 @@ begin
|
||||
then Inc(FBytesPerRow, ALIGNBITS[AAlignment] + 1 - m);
|
||||
|
||||
FDataSize := FBytesPerRow * FHeight;
|
||||
System.GetMem(FData, FDataSize);
|
||||
if AData <> nil then
|
||||
System.Move(AData^, FData^, FDataSize) // copy data
|
||||
|
||||
if (AData = nil) or ACopyData then
|
||||
begin
|
||||
System.GetMem(FData, FDataSize);
|
||||
FFreeData := True;
|
||||
if AData <> nil then
|
||||
System.Move(AData^, FData^, FDataSize) // copy data
|
||||
else
|
||||
FillDWord(FData^, FDataSize shr 2, 0); // clear bitmap
|
||||
end
|
||||
else
|
||||
FillDWord(FData^, FDataSize shr 2, 0); // clear bitmap
|
||||
|
||||
begin
|
||||
FData := AData;
|
||||
FFreeData := False;
|
||||
end;
|
||||
//DebugLn(Format('TCarbonBitmap.Create %d x %d Data: %d RowSize: %d Size: %d',
|
||||
// [AWidth, AHeight, Integer(AData), DataRowSize, FDataSize]));
|
||||
|
||||
@ -1106,7 +1142,7 @@ end;
|
||||
destructor TCarbonBitmap.Destroy;
|
||||
begin
|
||||
CGImageRelease(FCGImage);
|
||||
System.FreeMem(FData);
|
||||
if FFreeData then System.FreeMem(FData);
|
||||
|
||||
inherited Destroy;
|
||||
end;
|
||||
@ -1137,7 +1173,7 @@ begin
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCarbonBitmap.GetSubImage
|
||||
Method: TCarbonBitmap.CreateSubImage
|
||||
Returns: New image ref to portion of image data according to the rect
|
||||
------------------------------------------------------------------------------}
|
||||
function TCarbonBitmap.CreateSubImage(const ARect: TRect): CGImageRef;
|
||||
@ -1517,7 +1553,7 @@ initialization
|
||||
BlackPen := TCarbonPen.Create(True);
|
||||
|
||||
DefaultContext := TCarbonBitmapContext.Create;
|
||||
DefaultBitmap := TCarbonBitmap.Create(1, 1, 1, 1, cbaDQWord, cbtMono, nil);
|
||||
DefaultBitmap := TCarbonBitmap.Create(1, 1, 32, 32, cbaDQWord, cbtARGB, nil);
|
||||
DefaultContext.Bitmap := DefaultBitmap;
|
||||
|
||||
ScreenContext := TCarbonScreenContext.Create;
|
||||
|
||||
@ -92,7 +92,7 @@ type
|
||||
procedure AppBringToFront; override;
|
||||
procedure AppSetTitle(const ATitle: string); override;
|
||||
|
||||
procedure AttachMenuToWindow(AMenuObject: TComponent); Override;
|
||||
procedure AttachMenuToWindow(AMenuObject: TComponent); override;
|
||||
|
||||
function DCGetPixel(CanvasHandle: HDC; X, Y: integer): TGraphicsColor; override;
|
||||
procedure DCSetPixel(CanvasHandle: HDC; X, Y: integer; AColor: TGraphicsColor); override;
|
||||
@ -111,6 +111,7 @@ type
|
||||
|
||||
public
|
||||
procedure SetMainMenuEnabled(AEnabled: Boolean);
|
||||
procedure SetRootMenu(const AMenu: TMainMenu);
|
||||
public
|
||||
procedure SetCaptureWidget(const AWidget: HWND);
|
||||
end;
|
||||
|
||||
@ -481,6 +481,24 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCarbonWidgetSet.SetRootMenu
|
||||
Params: AMenu - Main menu
|
||||
|
||||
Sets the menu to menu bar
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TCarbonWidgetSet.SetRootMenu(const AMenu: TMainMenu);
|
||||
begin
|
||||
if (AMenu <> nil) and AMenu.HandleAllocated then
|
||||
begin
|
||||
if not CheckMenu(AMenu.Handle, 'SetRootMenu') then Exit;
|
||||
|
||||
TCarbonMenu(AMenu.Handle).AttachToMenuBar;
|
||||
end
|
||||
else
|
||||
OSError(FPCMacOSAll.SetRootMenu(EmptyMenu), Self, 'SetRootMenu', 'SetRootMenu');
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: SetCaptureWidget
|
||||
Params: AWidget - Carbon widget to capture
|
||||
|
||||
@ -62,7 +62,7 @@ type
|
||||
procedure Remove(AMenu: TCarbonMenu);
|
||||
procedure Attach(AParentMenu: TCarbonMenu);
|
||||
procedure AttachToMenuBar;
|
||||
|
||||
|
||||
procedure SetCaption(const ACaption: String);
|
||||
procedure SetVisible(AVisible: Boolean);
|
||||
procedure SetEnable(AEnabled: Boolean);
|
||||
@ -74,6 +74,9 @@ type
|
||||
|
||||
function CheckMenu(const Menu: HMENU; const AMethodName: String; AParamName: String = ''): Boolean;
|
||||
|
||||
var
|
||||
EmptyMenu: MenuRef; // menu for clearing menu bar workaround
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
@ -279,7 +282,7 @@ begin
|
||||
{$ENDIF}
|
||||
|
||||
Index := GetIndex;
|
||||
if FParentMenu.FRoot then MenuNeeded; // menu tiem is in toplevel of root menu
|
||||
if FParentMenu.FRoot then MenuNeeded; // menu item is in toplevel of root menu
|
||||
|
||||
if LCLMenuItem.Caption = cLineCaption then // menu item is separator
|
||||
OSError(
|
||||
@ -531,7 +534,8 @@ begin
|
||||
|
||||
if Item.LCLMenuItem.RadioItem and Item.LCLMenuItem.AutoCheck and
|
||||
(Item.LCLMenuItem.GroupIndex = LCLMenuItem.GroupIndex) then
|
||||
Item.SetCheck(False);
|
||||
SetItemMark(FParentMenu.Menu, Item.GetIndex + 1, #0);
|
||||
|
||||
end;
|
||||
end
|
||||
else
|
||||
@ -610,6 +614,14 @@ begin
|
||||
SetItemStyle(FParentMenu.Menu, GetIndex + 1, Style);
|
||||
end;
|
||||
|
||||
initialization
|
||||
|
||||
OSError(CreateNewMenu(0, kMenuAttrAutoDisable, EmptyMenu),
|
||||
'CarbonMenus.initialization', 'CreateNewMenu');
|
||||
|
||||
finalization
|
||||
|
||||
DisposeMenu(EmptyMenu);
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -896,19 +896,7 @@ begin
|
||||
DebugLn('TCarbonWidgetSet.AttachMenuToWindow ' + AMenuObject.Name);
|
||||
{$ENDIF}
|
||||
|
||||
if (AMenuObject is TMainMenu) and (TMainMenu(AMenuObject).Handle <> 0) then
|
||||
begin
|
||||
if not CheckMenu(TMainMenu(AMenuObject).Handle, SName) then Exit;
|
||||
|
||||
if FMainMenu <> nil then
|
||||
begin
|
||||
DebugLn(SName + ' Unable to change main menu - menu bar is set yet!');
|
||||
Exit;
|
||||
end;
|
||||
|
||||
TCarbonMenu(TMainMenu(AMenuObject).Handle).AttachToMenuBar;
|
||||
FMainMenu := TMainMenu(AMenuObject);
|
||||
end;
|
||||
// menus are attached on each form activation
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
|
||||
@ -308,8 +308,10 @@ var
|
||||
const
|
||||
SName = 'CarbonCommon_SetFocusPart';
|
||||
begin
|
||||
//if not (AWidget.LCLObject is TCustomControl) then
|
||||
Result := CallNextEventHandler(ANextHandler, AEvent);
|
||||
if not (AWidget.LCLObject is TCustomControl) then
|
||||
Result := CallNextEventHandler(ANextHandler, AEvent)
|
||||
else
|
||||
Result := noErr;
|
||||
|
||||
if OSError(
|
||||
GetEventParameter(AEvent, kEventParamControlPart, typeControlPartCode, nil,
|
||||
|
||||
@ -386,7 +386,7 @@ const
|
||||
VKKeyCode:=VK_UNKNOWN;
|
||||
|
||||
KeyData:=GetCarbonMsgKeyState;
|
||||
IsSysKey:=(GetCurrentEventKeyModifiers and optionKey)>0;
|
||||
IsSysKey:=(GetCurrentEventKeyModifiers and cmdKey)>0;
|
||||
|
||||
if OSError(GetEventParameter(AEvent, kEventParamKeyCode, typeUInt32, nil,
|
||||
Sizeof(KeyCode), nil, @KeyCode), SName, AGetEvent,
|
||||
@ -742,13 +742,25 @@ begin
|
||||
|
||||
EventKind := GetEventKind(AEvent);
|
||||
case EventKind of
|
||||
kEventWindowActivated: Msg.msg := LM_ACTIVATE;
|
||||
kEventWindowDeactivated: Msg.msg := LM_DEACTIVATE;
|
||||
kEventWindowActivated:
|
||||
begin
|
||||
Msg.msg := LM_ACTIVATE;
|
||||
if (AWidget.LCLObject is TCustomForm) then
|
||||
CarbonWidgetSet.SetRootMenu((AWidget.LCLObject as TCustomForm).Menu);
|
||||
end;
|
||||
kEventWindowDeactivated:
|
||||
begin
|
||||
Msg.msg := LM_DEACTIVATE;
|
||||
if (AWidget.LCLObject is TCustomForm) then
|
||||
CarbonWidgetSet.SetRootMenu(nil);
|
||||
end;
|
||||
else
|
||||
DebugLn('CarbonWindow_ActivateProc invalid event kind: ' + DbgS(EventKind));
|
||||
Exit;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
DeliverMessage(AWidget.LCLObject, Msg);
|
||||
end;
|
||||
|
||||
|
||||
@ -370,7 +370,7 @@ begin
|
||||
if (FontName <> '') and not SameText(FontName, 'default') then
|
||||
begin
|
||||
OSError(ATSUFindFontFromName(@FontName[1], Length(FontName),
|
||||
kFontFamilyName, kFontMacintoshPlatform, kFontRomanScript,
|
||||
kFontFullName, kFontMacintoshPlatform, kFontRomanScript,
|
||||
kFontEnglishLanguage, Result),
|
||||
'FindCarbonFontID', 'ATSUFindFontFromName');
|
||||
end;
|
||||
@ -489,6 +489,7 @@ function CFStringToStr(AString: CFStringRef): String;
|
||||
var
|
||||
Str: Pointer;
|
||||
StrSize: CFIndex;
|
||||
StrRange: CFRange;
|
||||
begin
|
||||
if AString = nil then
|
||||
begin
|
||||
@ -503,14 +504,16 @@ begin
|
||||
else
|
||||
begin
|
||||
// if that doesn't work this will
|
||||
StrSize := CFStringGetLength(AString) + 1; // + 1 for null terminator
|
||||
GetMem(Str, StrSize);
|
||||
try
|
||||
CFStringGetCString(AString, Str, StrSize, DEFAULT_CFSTRING_ENCODING);
|
||||
Result := PChar(Str);
|
||||
finally
|
||||
System.FreeMem(Str);
|
||||
end;
|
||||
StrRange.location := 0;
|
||||
StrRange.length := CFStringGetLength(AString);
|
||||
|
||||
CFStringGetBytes(AString, StrRange, DEFAULT_CFSTRING_ENCODING,
|
||||
0, False, nil, 0, StrSize);
|
||||
SetLength(Result, StrSize);
|
||||
|
||||
if StrSize > 0 then
|
||||
CFStringGetBytes(AString, StrRange, DEFAULT_CFSTRING_ENCODING,
|
||||
0, False, @Result[1], StrSize, StrSize);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -885,7 +888,7 @@ initialization
|
||||
// test 'com.apple.HITextView'
|
||||
OSError(
|
||||
HIObjectRegisterSubclass(CustomControlClassID, HIViewClassID, 0,
|
||||
CustomControlHandlerUPP, 5, @EventSpec[0], nil, nil),
|
||||
CustomControlHandlerUPP, Length(EventSpec), @EventSpec[0], nil, nil),
|
||||
'CarbonProc.initialization', 'HIObjectRegisterSubclass');
|
||||
|
||||
finalization
|
||||
|
||||
@ -233,10 +233,25 @@ begin
|
||||
Result:=inherited CreateCaret(Handle, Bitmap, width, Height);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: CreateCompatibleBitmap
|
||||
Params: DC - Handle to memory device context
|
||||
Width - Bitmap width
|
||||
Height - Bitmap height
|
||||
|
||||
Returns: Handle to a bitamp
|
||||
|
||||
Creates a bitamp compatible with the specified device
|
||||
------------------------------------------------------------------------------}
|
||||
function TCarbonWidgetSet.CreateCompatibleBitmap(DC: HDC; Width, Height: Integer
|
||||
): HBITMAP;
|
||||
begin
|
||||
Result:=inherited CreateCompatibleBitmap(DC, Width, Height);
|
||||
{$IFDEF VerboseWinAPI}
|
||||
DebugLn('TCarbonWidgetSet.CreateCompatibleBitmap');
|
||||
{$ENDIF}
|
||||
|
||||
// TODO: consider DC depth
|
||||
Result := HBITMAP(TCarbonBitmap.Create(Width, Height, 32, 32, cbaDQWord, cbtARGB, nil));
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -252,6 +267,7 @@ begin
|
||||
DebugLn('TCarbonWidgetSet.CreateCompatibleDC');
|
||||
{$ENDIF}
|
||||
|
||||
// TODO: consider DC depth
|
||||
Result := HDC(TCarbonBitmapContext.Create);
|
||||
end;
|
||||
|
||||
@ -490,7 +506,7 @@ begin
|
||||
Result := False;
|
||||
|
||||
{$IFDEF VerboseWinAPI}
|
||||
DebugLn('TCarbonWidgetSet.DrawFocusRect DC: ' + DbgS(DC) + ' Rect: ' + DbgS(Rect);
|
||||
DebugLn('TCarbonWidgetSet.DrawFocusRect DC: ' + DbgS(DC) + ' Rect: ' + DbgS(Rect));
|
||||
{$ENDIF}
|
||||
|
||||
if not CheckDC(DC, 'DrawFocusRect') then Exit;
|
||||
@ -519,7 +535,7 @@ begin
|
||||
|
||||
{$IFDEF VerboseWinAPI}
|
||||
DebugLn('TCarbonWidgetSet.DrawFrameControl DC: ' + DbgS(DC) + ' R: ' +
|
||||
DbgS(Rect) + ' Type: ' + DbgS(UType) + ' Style: ' + DbgS(Style);
|
||||
DbgS(Rect) + ' Type: ' + DbgS(UType) + ' Style: ' + DbgS(UState));
|
||||
{$ENDIF}
|
||||
|
||||
if not CheckDC(DC, 'DrawFrameControl') then Exit;
|
||||
@ -1659,9 +1675,37 @@ begin
|
||||
Result:=inherited GetWindowLong(Handle, int);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: GetWindowOrgEx
|
||||
Params: DC - Handle of device context
|
||||
P - Record for context origin
|
||||
Returns: if the function succeeds, the return value is nonzero; if the
|
||||
function fails, the return value is zero
|
||||
|
||||
Retrieves the origin of the specified context
|
||||
------------------------------------------------------------------------------}
|
||||
function TCarbonWidgetSet.GetWindowOrgEx(dc: hdc; P: PPoint): Integer;
|
||||
var
|
||||
Transform: CGAffineTransform;
|
||||
SizeP: TPoint;
|
||||
begin
|
||||
Result:=inherited GetWindowOrgEx(dc, P);
|
||||
Result := 0;
|
||||
|
||||
{$IFDEF VerboseWinAPI}
|
||||
DebugLn('TCarbonWidgetSet.GetWindowOrgEx DC: ' + DbgS(DC));
|
||||
{$ENDIF}
|
||||
|
||||
if not CheckDC(DC, 'GetWindowOrgEx') then Exit;
|
||||
|
||||
Transform := CGContextGetCTM(TCarbonContext(DC).CGContext);
|
||||
GetDeviceSize(DC, SizeP);
|
||||
P^.X := Round(Transform.tx);
|
||||
P^.Y := SizeP.Y - Round(Transform.ty);
|
||||
Result := 1;
|
||||
|
||||
{$IFDEF VerboseWinAPI}
|
||||
DebugLn('TCarbonWidgetSet.GetWindowOrgEx ' + DbgS(P^.X) + ', ' + DbgS(P^.Y));
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -1864,7 +1908,10 @@ begin
|
||||
Exit;
|
||||
end;
|
||||
|
||||
TCarbonWidget(Handle).InvalidateRgn(TCarbonRegion(Rgn).Shape);
|
||||
if Rgn = 0 then
|
||||
TCarbonWidget(Handle).Invalidate(nil)
|
||||
else
|
||||
TCarbonWidget(Handle).InvalidateRgn(TCarbonRegion(Rgn).Shape);
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
@ -2759,10 +2806,31 @@ begin
|
||||
Result:=inherited SetWindowLong(Handle, Idx, NewLong);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: SetWindowOrgEx
|
||||
Params: DC - Handle to device context.
|
||||
NewX, NewY - New context origin
|
||||
Returns: If the function succeeds
|
||||
|
||||
Sets the origin of the specified device context
|
||||
------------------------------------------------------------------------------}
|
||||
function TCarbonWidgetSet.SetWindowOrgEx(DC: HDC; NewX, NewY: Integer;
|
||||
OldPoint: PPoint): Boolean;
|
||||
var
|
||||
OldP: TPoint;
|
||||
begin
|
||||
Result:=inherited SetWindowOrgEx(DC, NewX, NewY, OldPoint);
|
||||
Result := False;
|
||||
|
||||
{$IFDEF VerboseWinAPI}
|
||||
DebugLn('TCarbonWidgetSet.SetWindowOrgEx DC: ' + DbgS(DC) + ' X: ' + DbgS(NewX) +
|
||||
' Y: ' + DbgS(NewY));
|
||||
{$ENDIF}
|
||||
|
||||
GetWindowOrgEx(DC, @OldP);
|
||||
|
||||
Result := MoveWindowOrgEx(DC, NewX - OldP.X, NewY - OldP.Y);
|
||||
if OldPoint <> nil then
|
||||
OldPoint := @OldP;
|
||||
end;
|
||||
|
||||
function TCarbonWidgetSet.SetWindowPos(hWnd: HWND; hWndInsertAfter: HWND; X, Y,
|
||||
|
||||
Loading…
Reference in New Issue
Block a user