~ubuntu-branches/ubuntu/saucy/lazarus/saucy

« back to all changes in this revision

Viewing changes to lcl/interfaces/carbon/carbonwinapi.inc

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
43
43
function TCarbonWidgetSet.BeginPaint(Handle: hWnd; var PS: TPaintStruct): hdc;
44
44
begin
45
45
  Result:=inherited BeginPaint(Handle, PS);
 
46
  PS.hdc:=Result;
46
47
end;
47
48
 
48
49
{------------------------------------------------------------------------------
97
98
  {$ENDIF}
98
99
  
99
100
  if not CheckWidget(Handle, 'ClientToScreen') then Exit;
100
 
  Result := TCarbonWidget(Handle).GetScreenBounds(R);
 
101
  Result := TCarbonWidget(Handle).GetScreenBounds(R{%H-});
101
102
  
102
103
  if Result then
103
104
  begin
225
226
  TCarbonRegion(Dest).CombineWith(TCarbonRegion(Src1), RGN_COPY);
226
227
 
227
228
  if fnCombineMode <> RGN_COPY then
228
 
    TCarbonRegion(Dest). CombineWith(TCarbonRegion(Src2), fnCombineMode);
 
229
    Result := TCarbonRegion(Dest).CombineWith(TCarbonRegion(Src2), fnCombineMode);
229
230
end;
230
231
 
231
232
{------------------------------------------------------------------------------
406
407
  H := Desc.Height;
407
408
  if H < 1 then H := 1;
408
409
 
 
410
  {$Note: check if DevDesc is the right parameter for QueryDescription}
 
411
  FillByte(DevDesc{%H-},SizeOf(DevDesc),0);
409
412
  QueryDescription(DevDesc, [riqfRGB, riqfAlpha], W, H);
410
413
 
411
414
  if DevDesc.IsEqual(Desc)
541
544
    DebugLn('TCarbonWidgetSet.DeleteCriticalSection Section: ' + DbgS(CritSection));
542
545
  {$ENDIF}
543
546
  
544
 
  ACritSec := System.PRTLCriticalSection(CritSection);
 
547
  ACritSec := {%H-}System.PRTLCriticalSection(CritSection);
545
548
 
546
549
  System.DoneCriticalsection(ACritSec^);
547
550
  Dispose(ACritSec);
647
650
    TObject(Handle).Free;
648
651
end;
649
652
 
 
653
function TCarbonWidgetSet.DPtoLP(DC: HDC; var Points; Count: Integer): BOOL;
 
654
var
 
655
  P: PPoint;
 
656
begin
 
657
  Result := False;
 
658
  if not CheckDC(DC, 'LPtoDP') then Exit;
 
659
  P := @Points;
 
660
  with TCarbonDeviceContext(DC).GetLogicalOffset do
 
661
    while Count > 0 do
 
662
    begin
 
663
      Dec(Count);
 
664
      dec(P^.X, X);
 
665
      dec(P^.Y, Y);
 
666
      inc(P);
 
667
    end;
 
668
  Result := True;
 
669
end;
 
670
 
650
671
{------------------------------------------------------------------------------
651
672
  Method:  DrawFocusRect
652
673
  Params:  DC   - Handle to device context
671
692
end;
672
693
 
673
694
{------------------------------------------------------------------------------
674
 
  Method:  DrawFrameControl
675
 
  Params:  DC     - Handle to device context
676
 
           Rect   - Bounding rectangle
677
 
           UType  - Frame-control type
678
 
           UState - Frame-control state
679
 
  Returns: If the function succeeds
680
 
 
681
 
  Draws a frame control of the specified type and style.
682
 
 ------------------------------------------------------------------------------}
683
 
function TCarbonWidgetSet.DrawFrameControl(DC: HDC; const Rect: TRect; UType,
684
 
  UState: Cardinal): Boolean;
685
 
begin
686
 
  Result := inherited DrawFrameControl(DC, Rect, UType, UState);
687
 
end;
688
 
 
689
 
function TCarbonWidgetSet.DrawEdge(DC: HDC; var ARect: TRect; Edge: Cardinal;
690
 
  grfFlags: Cardinal): Boolean;
691
 
begin
692
 
  Result:=inherited DrawEdge(DC, ARect, Edge, grfFlags);
693
 
end;
694
 
 
695
 
function TCarbonWidgetSet.DrawText(DC: HDC; Str: PChar; Count: Integer;
696
 
  var Rect: TRect; Flags: Cardinal): Integer;
697
 
begin
698
 
  Result:=inherited DrawText(DC, Str, Count, Rect, Flags);
699
 
end;
700
 
 
701
 
{------------------------------------------------------------------------------
702
695
  Method:  Ellipse
703
696
  Params:
704
697
           DC - Handle to device context
774
767
    DebugLn('TCarbonWidgetSet.EnterCriticalSection Section: ' + DbgS(CritSection));
775
768
  {$ENDIF}
776
769
  
777
 
  ACritSec:=System.PRTLCriticalSection(CritSection);
 
770
  ACritSec:={%H-}System.PRTLCriticalSection(CritSection);
778
771
  System.EnterCriticalsection(ACritSec^);
779
772
end;
780
773
 
785
778
  activeDspys: array[0..1024] of CGDirectDisplayID;
786
779
  i: integer;
787
780
begin
788
 
  if OSError(CGGetActiveDisplayList(1024, activeDspys, Count),
 
781
  if OSError(CGGetActiveDisplayList(1024, activeDspys, Count{%H-}),
789
782
    'TCarbonWidgetSet.EnumDisplayMonitors', 'CGGetActiveDisplayList') then Exit(False);
790
783
  Result := True;
791
784
  for i := 0 to Count - 1 do
819
812
var
820
813
  FamilyCount: LongWord;
821
814
  FamilyListPtr, PFamily: ^ATSUFontID;
822
 
  FontName: UTF8String;
 
815
  FontName: String;
823
816
  EnumLogFont: TEnumLogFontEx;
824
817
  Metric: TNewTextMetricEx;
825
818
  FontType, I: Integer;
839
832
  if (lpLogFont^.lfCharSet = DEFAULT_CHARSET) and (lpLogFont^.lfFaceName = '') then
840
833
  begin
841
834
    // all system fonts
842
 
    if OSError(ATSUFontCount(FamilyCount), SName, 'ATSUFontCount') then Exit;
 
835
    if OSError(ATSUFontCount(FamilyCount{%H-}), SName, 'ATSUFontCount') then Exit;
843
836
    
844
837
    GetMem(FamilyListPtr, SizeOf(ATSUFontID) * FamilyCount);
845
838
    try
855
848
        FontName := CarbonFontIDToFontName(PFamily^);
856
849
        if FontName <> '' then // execute callback
857
850
        begin
858
 
          FillChar(EnumLogFont, SizeOf(EnumLogFont), #0);
859
 
          FillChar(Metric, SizeOf(Metric), #0);
 
851
          FillChar(EnumLogFont{%H-}, SizeOf(EnumLogFont), #0);
 
852
          FillChar(Metric{%H-}, SizeOf(Metric), #0);
860
853
          FontType := 0;
861
854
          EnumLogFont.elfLogFont.lfFaceName := FontName;
862
855
          // TODO: get all attributes
914
907
 ------------------------------------------------------------------------------}
915
908
function TCarbonWidgetSet.ExtTextOut(DC: HDC; X, Y: Integer; Options: Longint;
916
909
  Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean;
 
910
var
 
911
  SavedDC: Integer;
917
912
begin
918
913
  Result := False;
919
914
 
923
918
  {$ENDIF}
924
919
  
925
920
  if not CheckDC(DC, 'ExtTextOut') then Exit;
926
 
  
 
921
 
 
922
  if ((Options and ETO_CLIPPED) > 0) and Assigned(Rect) then
 
923
  begin
 
924
    SavedDC := SaveDC(DC);
 
925
    with Rect^ do
 
926
      IntersectClipRect(DC, Left, Top, Right, Bottom);
 
927
  end;
 
928
 
927
929
  Result :=
928
930
    TCarbonDeviceContext(DC).ExtTextOut(X, Y, Options, Rect, Str, Count, Dx);
929
931
  
 
932
  if ((Options and ETO_CLIPPED) > 0) and Assigned(Rect) then
 
933
    RestoreDC(DC, SavedDC);
930
934
  {$IFDEF VerboseWinAPI}
931
935
    DebugLn('TCarbonWidgetSet.ExtTextOut Result: ' + DbgS(Result));
932
936
  {$ENDIF}
1024
1028
end;
1025
1029
 
1026
1030
{------------------------------------------------------------------------------
1027
 
  Method:  Frame
1028
 
  Params:  DC    - Handle to device context
1029
 
           ARect - Bounding box of frame
1030
 
  Returns: > 0 if the function succeeds
1031
 
 
1032
 
  Draws a border in Carbon native style
1033
 
 ------------------------------------------------------------------------------}
1034
 
function TCarbonWidgetSet.Frame(DC: HDC; const ARect: TRect): Integer;
1035
 
begin
1036
 
  Result := 0;
1037
 
 
1038
 
  {$IFDEF VerboseWinAPI}
1039
 
    DebugLn('TCarbonWidgetSet.Frame DC: ' + DbgS(DC) + ' R: ' + DbgS(ARect));
1040
 
  {$ENDIF}
1041
 
  
1042
 
  if not CheckDC(DC, 'Frame') then Exit;
1043
 
  
1044
 
  TCarbonDeviceContext(DC).Frame(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
1045
 
  
1046
 
  Result := 1;
1047
 
end;
1048
 
 
1049
 
{------------------------------------------------------------------------------
1050
1031
  Method:  Frame3D
1051
1032
  Params:  DC         - Handle to device context
1052
1033
           ARect      - Bounding box of frame
1099
1080
  {$ENDIF}
1100
1081
  
1101
1082
  if not CheckDC(DC, 'FrameRect') then Exit;
 
1083
  if not CheckGDIObject(hBr, 'FrameRect') then Exit;
1102
1084
 
1103
1085
  // Create a new Pen with default values and the color of the brush
1104
1086
  NewPen := TCarbonPen.Create(False);
1105
1087
  try
1106
 
    NewPen.SetColor(CarbonDC.CurrentBrush.ColorRef, True);
 
1088
    NewPen.SetColor(TCarbonBrush(hBr).ColorRef, True);
1107
1089
 
1108
1090
    OldPen := CarbonDC.CurrentPen;
1109
1091
    CarbonDC.CurrentPen := NewPen;
1345
1327
begin
1346
1328
  Result := False;
1347
1329
  
1348
 
  GetGlobalMouse(Pt);
 
1330
  GetGlobalMouse(Pt{%H-});
1349
1331
  
1350
1332
  lpPoint.X := Pt.h;
1351
1333
  lpPoint.Y := Pt.v;
1406
1388
  r : TRect;
1407
1389
begin
1408
1390
  {$IFDEF VerboseWinAPI}
1409
 
    DebugLn('TCarbonWidgetSet.GetDCOriginRelativeToWindow HWnd: ' + DbgS(HWnd) + ' PaintDC: ' + DbgS(PaintDC));
 
1391
    DebugLn(Format('TCarbonWidgetSet.GetDCOriginRelativeToWindow WindowHandle: %x PaintDC: %x',
 
1392
     [WindowHandle, PaintDC]));
1410
1393
  {$ENDIF}
1411
1394
 
1412
1395
  Result := CheckDC(PaintDC, 'GetDCOriginRelativeToWindow');
1414
1397
  begin
1415
1398
    DC := TCarbonDeviceContext(PaintDC);
1416
1399
    affine := CGContextGetCTM(DC.CGContext);
1417
 
    TCarbonWidget(WindowHandle).GetBounds(r);
 
1400
    TCarbonWidget(WindowHandle).GetBounds(r{%H-});
1418
1401
    OriginDiff.x := Round(affine.tx);
1419
1402
    OriginDiff.y := Round((r.Bottom - r.Top) - affine.ty);
1420
1403
    Result := true;
1545
1528
  if DisplayID = CGMainDisplayID then
1546
1529
  begin
1547
1530
    lpmi^.dwFlags := MONITORINFOF_PRIMARY;
1548
 
    if OSError(DMGetGDeviceByDisplayID(DisplayIDType(DisplayID), DeviceHandle, True),
 
1531
    if OSError(DMGetGDeviceByDisplayID(DisplayIDType(DisplayID), DeviceHandle{%H-}, True),
1549
1532
      'TCarbonWidgetSet.GetMonitorInfo', 'DMGetGDeviceByDisplayID') then Exit;
1550
 
    if OSError(GetAvailableWindowPositioningBounds(DeviceHandle, availRect),
 
1533
    if OSError(GetAvailableWindowPositioningBounds(DeviceHandle, availRect{%H-}),
1551
1534
      'TCarbonWidgetSet.GetMonitorInfo', 'GetAvailableWindowPositioningBounds') then Exit;
1552
1535
    with availRect do
1553
1536
      lpmi^.rcWork := Types.Rect(left, top, right, bottom);
1568
1551
function TCarbonWidgetSet.GetKeyState(nVirtKey: Integer): Smallint;
1569
1552
const
1570
1553
  StateDown    = SmallInt($FF80);
1571
 
  StateToggled = SmallInt($0001);
 
1554
  //StateToggled = SmallInt($0001);
1572
1555
begin
1573
1556
  Result := 0;
1574
1557
 
1627
1610
  APen: TCarbonPen absolute AObject;
1628
1611
  ALogPen: PLogPen absolute Buf;
1629
1612
  AExtLogPen: PExtLogPen absolute Buf;
 
1613
  AFont: TCarbonFont absolute AObject;
 
1614
  ALogFont: PLogFont absolute Buf;
1630
1615
begin
1631
1616
  Result := 0;
1632
1617
 
1648
1633
    Width := TCarbonBitmap(AObject).Width;
1649
1634
    Height := TCarbonBitmap(AObject).Height;
1650
1635
 
1651
 
    FillChar(DIB, SizeOf(TDIBSection), 0);
 
1636
    FillChar(DIB{%H-}, SizeOf(TDIBSection), 0);
1652
1637
 
1653
1638
    {dsBM - BITMAP}
1654
1639
    DIB.dsBm.bmType := $4D42;
1752
1737
    end;
1753
1738
  end
1754
1739
  else
 
1740
  {------------------------------------------------------------------------------
 
1741
    Font
 
1742
   ------------------------------------------------------------------------------}
 
1743
  if aObject is TCarbonFont then
 
1744
  begin
 
1745
    if Buf = nil then
 
1746
      Result := SizeOf(TLogFont)
 
1747
    else
 
1748
    if BufSize >= SizeOf(TLogFont) then
 
1749
    begin
 
1750
      Result := SizeOf(TLogFont);
 
1751
 
 
1752
      FillChar(ALogFont^, SizeOf(ALogFont^), 0);
 
1753
          AFont.QueryStyle(ALogFont);
 
1754
        end;
 
1755
  end
 
1756
  else
1755
1757
    DebugLn('TCarbonWidgetSet.GetObject Font, Brush TODO');
1756
1758
end;
1757
1759
 
1774
1776
  
1775
1777
  if TCarbonWidget(Handle) is TCarbonControl then
1776
1778
  begin
 
1779
    {$IFDEF VerboseWinAPI}
 
1780
      DebugLn('TCarbonWidgetSet.GetParent Widget: ' + DbgS(TCarbonControl(Handle).Widget));
 
1781
    {$ENDIF}
1777
1782
    Result := HWnd(GetCarbonWidget(HIViewGetSuperview(TCarbonControl(Handle).Widget)));
1778
1783
    if Result = 0 then // no parent control => then parent is a window?
1779
1784
      Result := HWnd(GetCarbonWidget(HIViewGetWindow(TCarbonControl(Handle).Widget)));
1940
1945
  
1941
1946
  Depth := CGDisplayBitsPerPixel(CGMainDisplayID);
1942
1947
  case NIndex of
1943
 
  //COLOR_GRADIENTACTIVECAPTION, COLOR_ACTIVECAPTION:
1944
 
  //COLOR_GRADIENTINACTIVECAPTION, COLOR_INACTIVECAPTION:
1945
1948
  COLOR_MENU:
1946
 
    R := GetThemeBrushAsColor(kThemeBrushMenuBackground, Depth, True, C);
 
1949
    R := GetThemeBrushAsColor(kThemeBrushMenuBackground, Depth, True, C{%H-});
1947
1950
  COLOR_MENUTEXT:
1948
1951
    R := GetThemeTextColor(kThemeTextColorMenuItemActive, Depth, True, C);
1949
1952
  COLOR_WINDOWFRAME, COLOR_ACTIVEBORDER, COLOR_INACTIVEBORDER,
1982
1985
  COLOR_BACKGROUND,
1983
1986
  COLOR_WINDOW, COLOR_FORM:
1984
1987
    R := GetThemeBrushAsColor(kThemeBrushDocumentWindowBackground, Depth, True, C);
1985
 
  COLOR_ACTIVECAPTION:
 
1988
  COLOR_ACTIVECAPTION,
 
1989
  COLOR_GRADIENTACTIVECAPTION:
1986
1990
    R := GetThemeBrushAsColor(kThemeBrushAlternatePrimaryHighlightColor, Depth, True, C);
1987
 
  COLOR_INACTIVECAPTION:
 
1991
  COLOR_INACTIVECAPTION,
 
1992
  COLOR_GRADIENTINACTIVECAPTION:
1988
1993
    R := GetThemeBrushAsColor(kThemeBrushSecondaryHighlightColor, Depth, True, C);
1989
1994
  COLOR_MENUBAR:
1990
1995
    R := GetThemeBrushAsColor(kThemeBrushMenuBackground, Depth, True, C);
2025
2030
    SM_CYVSCROLL:
2026
2031
      Result := GetCarbonThemeMetric(kThemeMetricScrollBarWidth);
2027
2032
    SM_CXSCREEN,
2028
 
    SM_CXVIRTUALSCREEN : Result := CGDisplayPixelsWide(CGMainDisplayID);
 
2033
    SM_CXVIRTUALSCREEN: Result := CGDisplayPixelsWide(CGMainDisplayID);
2029
2034
    SM_CYSCREEN,
2030
 
    SM_CYVIRTUALSCREEN : Result := CGDisplayPixelsHigh(CGMainDisplayID);
 
2035
    SM_CYVIRTUALSCREEN: Result := CGDisplayPixelsHigh(CGMainDisplayID);
 
2036
    SM_XVIRTUALSCREEN: Result := Round(CGDisplayBounds(CGMainDisplayID).origin.x);
 
2037
    SM_YVIRTUALSCREEN: Result := Round(CGDisplayBounds(CGMainDisplayID).origin.y);
 
2038
 
2031
2039
    SM_CXSMICON,
2032
2040
    SM_CYSMICON:
2033
2041
      Result := 16;
2047
2055
      Result := GetCarbonThemeMetric(kThemeMetricScrollBarMinThumbHeight);
2048
2056
    SM_SWSCROLLBARSPACING:
2049
2057
      Result:=0;
 
2058
    SM_CYCAPTION:
 
2059
      begin
 
2060
        Result := GetCarbonThemeMetric(kThemeMetricTitleBarControlsHeight);
 
2061
        Result := Result + (Result div 2) + 1;
 
2062
      end;
 
2063
    SM_CYMENU: Result := 0;
2050
2064
  else
2051
2065
    DebugLn('TCarbonWidgetSet.GetSystemMetrics TODO ', DbgS(NIndex));;
2052
2066
  end;
2061
2075
  Result := clNone;
2062
2076
 
2063
2077
  {$IFDEF VerboseWinAPI}
2064
 
    DebugLn('TCarbonWidgetSet.GetTextColor DC: ' + DbgS(HDC));
 
2078
    DebugLn('TCarbonWidgetSet.GetTextColor DC: ' + DbgS(DC));
2065
2079
  {$ENDIF}
2066
2080
 
2067
2081
  if not CheckDC(DC, 'GetTextColor') then Exit;
2221
2235
  {$ENDIF}
2222
2236
  
2223
2237
  if not CheckWidget(Handle, 'GetWindowRelativePosition') then Exit;
2224
 
  Result := TCarbonWidget(Handle).GetBounds(ARect);
 
2238
  Result := TCarbonWidget(Handle).GetBounds(ARect{%H-});
2225
2239
  
2226
2240
  if not Result then Exit;
2227
2241
  Left := ARect.Left;
2254
2268
  {$ENDIF}
2255
2269
  
2256
2270
  if not CheckWidget(Handle, 'GetWindowSize') then Exit;
2257
 
  Result := TCarbonWidget(Handle).GetBounds(ARect);
 
2271
  Result := TCarbonWidget(Handle).GetBounds(ARect{%H-});
2258
2272
    
2259
2273
  if not Result then Exit;
2260
2274
  Width := ARect.Right - ARect.Left;
2266
2280
  {$ENDIF}
2267
2281
end;
2268
2282
 
 
2283
type
 
2284
  TColorComponents = array[0..3] of CGFloat;
 
2285
 
 
2286
  PLinearGradientInfo = ^TLinearGradientInfo;
 
2287
  TLinearGradientInfo = record
 
2288
    colors: array[0..1] of TColorComponents;
 
2289
  end;
 
2290
 
 
2291
function VertexToColor(AVertex: tagTRIVERTEX): TColorComponents;
 
2292
var
 
2293
  TheAlpha: Byte;
 
2294
begin
 
2295
  TheAlpha := AVertex.Alpha shr 8;
 
2296
  if TheAlpha = 0 then
 
2297
    TheAlpha := 255;
 
2298
  with AVertex do
 
2299
  begin
 
2300
    Result[0] := (Red shr 8) / 255;
 
2301
    Result[1] := (Green shr 8) / 255;
 
2302
    Result[2] := (Blue shr 8 )/ 255;
 
2303
    Result[3] := TheAlpha / 255;
 
2304
  end;
 
2305
end;
 
2306
 
 
2307
function LinearGradientCreateInfo(TL, BR: tagTRIVERTEX): UnivPtr;
 
2308
var
 
2309
  Swap: Longint;
 
2310
  SwapColors: Boolean;
 
2311
  Info: PLinearGradientInfo;
 
2312
  Tmp: TColorComponents;
 
2313
begin
 
2314
  GetMem(Info, SizeOf(TLinearGradientInfo));
 
2315
  SwapColors := (BR.Y < TL.Y) and (BR.X < TL.X);
 
2316
  if BR.X < TL.X then
 
2317
  begin
 
2318
    Swap := BR.X;
 
2319
    BR.X := TL.X;
 
2320
    TL.X := Swap;
 
2321
  end;
 
2322
  if BR.Y < TL.Y then
 
2323
  begin
 
2324
    Swap := BR.Y;
 
2325
    BR.Y := TL.Y;
 
2326
    TL.Y := Swap;
 
2327
  end;
 
2328
  Info^.colors[0] := VertexToColor(TL);
 
2329
  Info^.colors[1] := VertexToColor(BR);
 
2330
  if SwapColors then
 
2331
  begin
 
2332
    Tmp := Info^.colors[0];
 
2333
    Info^.colors[0] := Info^.colors[1];
 
2334
    Info^.colors[1] := Tmp;
 
2335
  end;
 
2336
end;
 
2337
 
 
2338
procedure LinearGradientReleaseInfo(info: UnivPtr); mwpascal;
 
2339
begin
 
2340
  FreeMem(info);
 
2341
end;
 
2342
 
 
2343
procedure LinearGradientEvaluate(info: UnivPtr; inputValue: CGFloatPtr; outputValue: CGFloatPtr); mwpascal;
 
2344
var
 
2345
  GradientInfo: PLinearGradientInfo absolute info;
 
2346
  Position: CGFloat;
 
2347
  I: Integer;
 
2348
begin
 
2349
  Position := inputValue^;
 
2350
  if Position = 0 then
 
2351
    System.Move(GradientInfo^.colors[0], outputValue^, SizeOf(TColorComponents))
 
2352
  else
 
2353
    for I := 0 to 3 do
 
2354
      outputValue[I] := GradientInfo^.colors[0][I] + Position * (GradientInfo^.colors[1][I] - GradientInfo^.colors[0][I]);
 
2355
end;
 
2356
 
2269
2357
function TCarbonWidgetSet.GradientFill(DC: HDC; Vertices: PTriVertex;
2270
2358
  NumVertices: Longint; Meshes: Pointer; NumMeshes: Longint; Mode: Longint
2271
2359
  ): Boolean;
 
2360
 
 
2361
  function DoFillTriangle: Boolean; inline;
 
2362
  begin
 
2363
    Result := (Mode and GRADIENT_FILL_TRIANGLE) = GRADIENT_FILL_TRIANGLE;
 
2364
  end;
 
2365
 
 
2366
  function DoFillVRect: Boolean; inline;
 
2367
  begin
 
2368
    Result := (Mode and GRADIENT_FILL_RECT_V) = GRADIENT_FILL_RECT_V;
 
2369
  end;
 
2370
 
 
2371
  function FillRectMesh(Mesh: tagGradientRect) : boolean;
 
2372
  var
 
2373
    TL, BR: tagTRIVERTEX;
 
2374
    Shading: CGShadingRef;
 
2375
    ShadingFunction: CGFunctionRef;
 
2376
    ShadingCallbacks: CGFunctionCallbacks;
 
2377
    Context: CGContextRef;
 
2378
    domain: array[0..1] of CGFloat;
 
2379
    range: array[0..7] of CGFloat;
 
2380
    info: UnivPtr;
 
2381
  begin
 
2382
    with Mesh do
 
2383
    begin
 
2384
      Result :=
 
2385
        (UpperLeft < Cardinal(NumVertices)) and (UpperLeft >= 0) and
 
2386
        (LowerRight < Cardinal(NumVertices)) and (LowerRight >= 0);
 
2387
      if (LowerRight = UpperLeft) or not Result then
 
2388
        Exit;
 
2389
 
 
2390
      TL := Vertices[UpperLeft];
 
2391
      BR := Vertices[LowerRight];
 
2392
      info := LinearGradientCreateInfo(TL, BR);
 
2393
      Context := TCarbonDeviceContext(DC).CGContext;
 
2394
      CGContextSaveGState(Context);
 
2395
      // to draw a gradient in a rectangle we need to first clip it by that
 
2396
      // rectangle and only then draw the gradient
 
2397
      CGContextAddRect(Context, CGRectMake(TL.X, TL.Y, BR.X - TL.X, BR.Y - TL.Y));
 
2398
      CGContextClip(Context);
 
2399
 
 
2400
      ShadingCallbacks.version := 0;
 
2401
      ShadingCallbacks.evaluate := @LinearGradientEvaluate;
 
2402
      ShadingCallbacks.releaseInfo := @LinearGradientReleaseInfo;
 
2403
      domain[0] := 0;
 
2404
      domain[1] := 1;
 
2405
      range[0] := 0;
 
2406
      range[1] := 1;
 
2407
      range[2] := 0;
 
2408
      range[3] := 1;
 
2409
      range[4] := 0;
 
2410
      range[5] := 1;
 
2411
      range[6] := 0;
 
2412
      range[7] := 1;
 
2413
      ShadingFunction := CGFunctionCreate(Info, 1, @domain[0], 4, @range[0], ShadingCallbacks);
 
2414
      if DoFillVRect then
 
2415
        Shading := CGShadingCreateAxial(RGBColorSpace, CGPointMake(TL.X, TL.Y), CGPointMake(TL.X, BR.Y), ShadingFunction, 0, 0)
 
2416
      else
 
2417
        Shading := CGShadingCreateAxial(RGBColorSpace, CGPointMake(TL.X, TL.Y), CGPointMake(BR.X, TL.Y), ShadingFunction, 0, 0);
 
2418
 
 
2419
      CGContextDrawShading(Context, Shading);
 
2420
      CGShadingRelease(Shading);
 
2421
      CGContextRestoreGState(Context);
 
2422
    end;
 
2423
  end;
 
2424
 
 
2425
const
 
2426
  MeshSize: Array[Boolean] of Integer = (
 
2427
    SizeOf(tagGradientRect), SizeOf(tagGradientTriangle));
 
2428
var
 
2429
  i: Integer;
2272
2430
begin
2273
 
  Result:=inherited GradientFill(DC, Vertices, NumVertices, Meshes, NumMeshes,
2274
 
    Mode);
 
2431
  if not CheckDC(DC, 'GradientFill') then Exit(False);
 
2432
  Result := (Meshes <> nil) and (NumMeshes >= 1) and (NumVertices >= 2)
 
2433
          and (Vertices <> nil);
 
2434
  if Result and DoFillTriangle then
 
2435
  begin
 
2436
    Result := inherited;
 
2437
    Exit;
 
2438
  end;
 
2439
 
 
2440
  if Result then
 
2441
  begin
 
2442
    Result := False;
 
2443
 
 
2444
    //Sanity Checks For Vertices Size vs. Count
 
2445
    if MemSize(Vertices) < PtrUInt(SizeOf(tagTRIVERTEX)*NumVertices) then
 
2446
      exit;
 
2447
 
 
2448
    for I := 0 to NumMeshes - 1 do
 
2449
    begin
 
2450
      if not FillRectMesh(PGradientRect(Meshes)[I]) then
 
2451
        exit;
 
2452
    end;
 
2453
    Result := True;
 
2454
  end;
2275
2455
end;
2276
2456
 
2277
2457
{------------------------------------------------------------------------------
2306
2486
  New(ACritSec);
2307
2487
  
2308
2488
  System.InitCriticalSection(ACritSec^);
2309
 
  CritSection := TCriticalSection(ACritSec);
 
2489
  CritSection := {%H-}TCriticalSection(ACritSec);
2310
2490
  
2311
2491
  {$IFDEF VerboseWinAPI}
2312
2492
    DebugLn('TCarbonWidgetSet.InitializeCriticalSection Section: ' + DbgS(CritSection));
2341
2521
 ------------------------------------------------------------------------------}
2342
2522
function TCarbonWidgetSet.InvalidateRect(AHandle: HWND; Rect: pRect;
2343
2523
  bErase: Boolean): Boolean;
 
2524
var
 
2525
  Pt: TPoint;
2344
2526
begin
2345
2527
  Result := False;
2346
2528
 
2349
2531
  {$ENDIF}
2350
2532
  
2351
2533
  if not CheckWidget(AHandle, 'InvalidateRect') then Exit;
2352
 
  
 
2534
 
 
2535
  if Rect <> nil then
 
2536
  begin
 
2537
    Pt := TCarbonWidget(AHandle).ScrollOffset;
 
2538
    OffsetRect(Rect^, -Pt.X, -Pt.Y);
 
2539
  end;
2353
2540
  TCarbonWidget(AHandle).Invalidate(Rect);
2354
2541
  Result := True;
2355
2542
end;
2473
2660
    DebugLn('TCarbonWidgetSet.LeaveCriticalSection Section: ' + DbgS(CritSection));
2474
2661
  {$ENDIF}
2475
2662
  
2476
 
  ACritSec := System.PRTLCriticalSection(CritSection);
 
2663
  ACritSec := {%H-}System.PRTLCriticalSection(CritSection);
2477
2664
  System.LeaveCriticalsection(ACritSec^);
2478
2665
end;
2479
2666
 
2503
2690
  Result := True;
2504
2691
end;
2505
2692
 
 
2693
function TCarbonWidgetSet.LPtoDP(DC: HDC; var Points; Count: Integer): BOOL;
 
2694
var
 
2695
  P: PPoint;
 
2696
begin
 
2697
  Result := False;
 
2698
  if not CheckDC(DC, 'LPtoDP') then Exit;
 
2699
  P := @Points;
 
2700
  with TCarbonDeviceContext(DC).GetLogicalOffset do
 
2701
    while Count > 0 do
 
2702
    begin
 
2703
      Dec(Count);
 
2704
      inc(P^.X, X);
 
2705
      inc(P^.Y, Y);
 
2706
      inc(P);
 
2707
    end;
 
2708
  Result := True;
 
2709
end;
 
2710
 
2506
2711
function TCarbonWidgetSet.MessageBox(hWnd: HWND; lpText, lpCaption: PChar;
2507
2712
  uType: Cardinal): integer;
2508
2713
begin
2559
2764
  Result := inherited MoveWindowOrgEx(DC, dX, dY);
2560
2765
end;
2561
2766
 
 
2767
function TCarbonWidgetSet.OffsetRgn(RGN: HRGN; nXOffset, nYOffset: Integer): Integer;
 
2768
begin
 
2769
  if not (TObject(RGN) is TCarbonRegion) then
 
2770
    Exit(ERROR);
 
2771
  TCarbonRegion(RGN).Offset(nXOffset, nYOffset);
 
2772
  Result := TCarbonRegion(RGN).GetType;
 
2773
end;
 
2774
 
2562
2775
function TCarbonWidgetSet.PeekMessage(var lpMsg: TMsg; Handle: HWND;
2563
2776
  wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): Boolean;
2564
2777
begin
2780
2993
  // therefore we can only test bounding box of the clipping path.
2781
2994
  
2782
2995
  ClipBox := CGContextGetClipBoundingBox(TCarbonContext(DC).CGContext);
2783
 
  Result := IntersectRect(R, ARect, CGRectToRect(ClipBox));
 
2996
  Result := IntersectRect(R{%H-}, ARect, CGRectToRect(ClipBox));
2784
2997
  
2785
2998
  {$IFDEF VerboseWinAPI}
2786
2999
    DebugLn('TCarbonWidgetSet.RectVisible Result: ' + DbgS(Result) + ' Clip: ' + DbgS(CGRectToRect(ClipBox)));
2860
3073
  
2861
3074
  if not CheckWidget(Handle, 'RemoveProp') then Exit;
2862
3075
 
2863
 
  Result := THandle(TCarbonWidget(Handle).Properties[Str]);
 
3076
  Result := {%H-}THandle(TCarbonWidget(Handle).Properties[Str]);
2864
3077
  TCarbonWidget(Handle).Properties[Str] := nil;
2865
3078
end;
2866
3079
 
2925
3138
  Result:=inherited ScreenToClient(Handle, P);
2926
3139
end;
2927
3140
 
2928
 
function TCarbonWidgetSet.ScrollWindowEx(hWnd: HWND; dx, dy: Integer;
2929
 
  prcScroll, prcClip: PRect; hrgnUpdate: HRGN; prcUpdate: PRect; flags: UINT
2930
 
  ): Boolean;
2931
 
begin
2932
 
  Result:=inherited ScrollWindowEx(hWnd, dx, dy, prcScroll, prcClip,
2933
 
    hrgnUpdate, prcUpdate, flags);
2934
 
end;
 
3141
{$IFDEF NewScrollWindowEx}
 
3142
function TCarbonWidgetSet.ScrollWindowEx(hWnd: HWND; dx, dy: Integer;
 
3143
  prcScroll, prcClip: PRect; hrgnUpdate: HRGN; prcUpdate: PRect; flags: UINT
 
3144
  ): Boolean;
 
3145
const
 
3146
  SName = 'ScrollWindowEx';
 
3147
var
 
3148
  ACtl: TCarbonControl;
 
3149
  RFullSource: TRect;
 
3150
  R, R1: CGRect;
 
3151
  RR: TRect;
 
3152
begin
 
3153
  (* - On Windows prcScroll is used a source-rectangle. The Result can (and will)
 
3154
       be placed outside that area. It may be limited by prcClip.
 
3155
     - Carbon uses the rect given to HIViewScrollRect as source and Clip.
 
3156
       So to get the same effect as on Windows prcScroll may need to be extended
 
3157
     - SW_INVALIDATE: Carbon always invalidates. So nothing to do if the flag is set.
 
3158
       Todo: If it is not set, and if it was known that the area was not already
 
3159
       invalidated before, then maybe it can be re-validadet?
 
3160
  *)
 
3161
  {$IFDEF VerboseWinAPI}
 
3162
  DebugLn('TCarbonWidgetSet.ScrollWindowEx() HWnd=',dbgs(hWnd),' prcScroll ',dbgs(prcScroll <> nil),
 
3163
    ' prcClip ',dbgs(prcClip <> nil));
 
3164
  {$ENDIF}
 
3165
  Result := False;
 
3166
  if (dy = 0) and (dx = 0) then exit;
 
3167
  if (hWnd = 0) then exit;
 
3168
 
 
3169
  ACtl := TCarbonControl(hWnd);
 
3170
  OSError(HIViewGetBounds(ACtl.Content, R1),
 
3171
    Self, SName, 'HIViewGetBounds');
 
3172
 
 
3173
  RFullSource := CGRectToRect(R1);
 
3174
  {$ifdef VerboseScrollWindowEx}
 
3175
  DebugLn(['ScrollWindowEx A RFullSource=', dbgs(RFullSource),' dy=',dy, ' scroll=',dbgs(prcScroll^), ' clip=',dbgs(prcClip^)]);
 
3176
  {$ENDIF}
 
3177
 
 
3178
  if PrcScroll <> nil then
 
3179
  begin
 
3180
    RFullSource.Left   := Max(RFullSource.Left,   PrcScroll^.Left);
 
3181
    RFullSource.Top    := Max(RFullSource.Top,    PrcScroll^.Top);
 
3182
    RFullSource.Right  := Min(RFullSource.Right,  PrcScroll^.Right);
 
3183
    RFullSource.Bottom := Min(RFullSource.Bottom, PrcScroll^.Bottom);
 
3184
 
 
3185
    // extend
 
3186
    if dx < 0 then
 
3187
      RFullSource.Left := RFullSource.Left + dx;
 
3188
    if dx > 0 then
 
3189
      RFullSource.Right := RFullSource.Right + dx;
 
3190
    if dy < 0 then
 
3191
      RFullSource.Top := RFullSource.Top + dy;
 
3192
    if dy > 0 then
 
3193
      RFullSource.Bottom := RFullSource.Bottom + dy;
 
3194
    {$ifdef VerboseScrollWindowEx}
 
3195
    DebugLn(['ScrollWindowEx prcScroll RFullSource=', dbgs(RFullSource)]);
 
3196
    {$ENDIF}
 
3197
  end;
 
3198
 
 
3199
  if prcClip <> nil then
 
3200
  begin
 
3201
    // only limit the site towards which is scrolled
 
3202
    // the other side is required for invalidation
 
3203
    if dx < 0 then
 
3204
      RFullSource.Left := Max(RFullSource.Left, prcClip^.Left - dx);
 
3205
    if dx > 0 then
 
3206
      RFullSource.Right := Min(RFullSource.Right, prcClip^.Right - dx);
 
3207
    if dy < 0 then
 
3208
      RFullSource.Top := Max(RFullSource.Top, prcClip^.Top - dy);
 
3209
    if dy > 0 then
 
3210
      RFullSource.Bottom := Min(RFullSource.Bottom, prcClip^.Bottom - dy);
 
3211
    {$ifdef VerboseScrollWindowEx}
 
3212
    DebugLn(['ScrollWindowEx prcClip RFullSource=', dbgs(RFullSource)]);
 
3213
    {$ENDIF}
 
3214
  end;
 
3215
 
 
3216
  if prcUpdate <> nil then
 
3217
  begin
 
3218
    prcUpdate^ := RFullSource;
 
3219
    if dx < 0 then
 
3220
      prcUpdate^.Left := Max(RFullSource.Left, RFullSource.Right + dx);
 
3221
    if dx > 0 then
 
3222
      prcUpdate^.Right := Min(RFullSource.Right, RFullSource.Left + dx);
 
3223
    if dy < 0 then
 
3224
      prcUpdate^.Top := Max(RFullSource.Top, RFullSource.Bottom + dy);
 
3225
    if dy > 0 then
 
3226
      prcUpdate^.Bottom := Min(RFullSource.Bottom, RFullSource.Top + dy);
 
3227
    {$ifdef VerboseScrollWindowEx}
 
3228
    DebugLn(['ScrollWindowEx prcUpdate RFullSource=', dbgs(prcUpdate^)]);
 
3229
    {$ENDIF}
 
3230
  end;
 
3231
 
 
3232
  R := RectToCGRect(RFullSource);
 
3233
  OSError(HIViewScrollRect(ACtl.Content, HiRectPtr(@R), CGFloat(dx), CGFloat(dy)),
 
3234
    ACtl, SName, 'HIViewScrollRect');
 
3235
 
 
3236
  if (flags and SW_SCROLLCHILDREN <> 0) then
 
3237
  begin
 
3238
    // complete view scrolls
 
3239
    with ACtl.ScrollOffset do
 
3240
    begin
 
3241
      X := X + DX;
 
3242
      Y := Y + DY;
 
3243
    end;
 
3244
  end;
 
3245
 
 
3246
  Result := true;
 
3247
end;
 
3248
{$ELSE}
 
3249
function TCarbonWidgetSet.ScrollWindowEx(hWnd: HWND; dx, dy: Integer;
 
3250
  prcScroll, prcClip: PRect; hrgnUpdate: HRGN; prcUpdate: PRect; flags: UINT
 
3251
  ): Boolean;
 
3252
const
 
3253
  SName = 'ScrollWindowEx';
 
3254
var
 
3255
  ACtl: TCarbonControl;
 
3256
  R, R1: CGRect;
 
3257
  RR: TRect;
 
3258
begin
 
3259
  {$IFDEF VerboseWinAPI}
 
3260
  DebugLn('TCarbonWidgetSet.ScrollWindowEx() HWnd=',dbgs(hWnd),' prcScroll ',prcScroll <> nil,
 
3261
    ' prcClip ',prcClip <> nil,' flags ',flags);
 
3262
  {$ENDIF}
 
3263
  if (hWnd <> 0) then
 
3264
  begin
 
3265
    ACtl := TCarbonControl(hWnd);
 
3266
    if (flags and SW_SCROLLCHILDREN <> 0) then
 
3267
    begin
 
3268
      // complete view scrolls
 
3269
      // MFR: R is not initialized
 
3270
      OSError(HIViewScrollRect(ACtl.Content, HiRectPtr(@R), CGFloat(dx), CGFloat(dy)),
 
3271
        ACtl, SName, 'HIViewScrollRect');
 
3272
      with ACtl.ScrollOffset do
 
3273
      begin
 
3274
        X := X + DX;
 
3275
        Y := Y + DY;
 
3276
      end;
 
3277
      Result := True;
 
3278
    end else
 
3279
    if (Flags = 0) then
 
3280
    begin
 
3281
      if (prcScroll <> nil) then
 
3282
      begin
 
3283
        R := RectToCGRect(prcScroll^);
 
3284
        // TODO: create CGRect
 
3285
        OSError(HIViewGetBounds(ACtl.Content, R1{%H-}),
 
3286
          Self, SName, 'HIViewGetBounds');
 
3287
        RR := CGRectToRect(R1);
 
3288
        {$NOTE: check why RR is not used}
 
3289
        OSError(HIViewScrollRect(ACtl.Content, HiRectPtr(@R), CGFloat(dx), CGFloat(dy)),
 
3290
          ACtl, SName, 'HIViewScrollRect');
 
3291
        Result := True;
 
3292
      end;
 
3293
    end;
 
3294
 
 
3295
    if flags and SW_INVALIDATE <> 0 then
 
3296
    begin
 
3297
      if prcClip <> nil then
 
3298
      begin
 
3299
        prcUpdate := prcClip;
 
3300
        Result := InvalidateRect(hwnd, prcClip, flags and SW_ERASE <> 0)
 
3301
      end else
 
3302
      begin
 
3303
        prcUpdate := prcScroll;
 
3304
        Result := InvalidateRect(hwnd, prcScroll, flags and SW_ERASE <> 0);
 
3305
      end;
 
3306
    end;
 
3307
  end else
 
3308
    Result:=inherited ScrollWindowEx(hWnd, dx, dy, prcScroll, prcClip,
 
3309
      hrgnUpdate, prcUpdate, flags);
 
3310
end;
 
3311
{$ENDIF}
2935
3312
 
2936
3313
function TCarbonWidgetSet.SelectClipRGN(DC: hDC; RGN: HRGN): Longint;
2937
 
const
2938
 
  SName = 'TCarbonWidgetSet.SelectClipRGN';
2939
3314
begin
2940
3315
  {$IFDEF VerboseWinAPI}
2941
3316
    DebugLn('TCarbonWidgetSet.SelectClipRGN DC: ' + DbgS(DC) + ' RGN: ' +
3095
3470
  
3096
3471
  if not CheckDC(DC, 'SetBkColor') then Exit;
3097
3472
 
3098
 
  Result := TCarbonDeviceContext(DC).BkColor;
3099
 
  TCarbonDeviceContext(DC).BkColor := Color;
 
3473
  Result := TColorRef(TCarbonDeviceContext(DC).BkColor);
 
3474
  TCarbonDeviceContext(DC).BkColor := TColor(Color);
3100
3475
end;
3101
3476
 
3102
3477
{------------------------------------------------------------------------------
3278
3653
begin
3279
3654
  Result := False;
3280
3655
  {$IFDEF VerboseWinAPI}
3281
 
    DebugLn('TCarbonWidgetSet.SetMenu AWindowHAndle: ' + DbgS(HWnd) + ' AMenuHandle: ' + DbgS(AMenuHandle));
 
3656
    DebugLn(Format('TCarbonWidgetSet.SetMenu AWindowHAndle: %x AMenuHandle: %x',
 
3657
     [AWindowHandle, AMenuHandle]));
3282
3658
  {$ENDIF}
3283
3659
 
3284
3660
  if not CheckWidget(AWindowHandle, 'SetMenu') then Exit;
3437
3813
  
3438
3814
  if not CheckDC(DC, 'SetTextColor') then Exit;
3439
3815
  
3440
 
  Result := TCarbonDeviceContext(DC).TextColor;
3441
 
  TCarbonDeviceContext(DC).TextColor := Color;
 
3816
  Result := TColorRef(TCarbonDeviceContext(DC).TextColor);
 
3817
  TCarbonDeviceContext(DC).TextColor := TColor(Color);
3442
3818
end;
3443
3819
 
3444
3820
function TCarbonWidgetSet.SetViewPortOrgEx(DC: HDC; NewX, NewY: Integer;
3445
3821
  OldPoint: PPoint): Boolean;
3446
3822
begin
3447
 
  Result:=False;
3448
 
  {$IFDEF VerboseWinAPI}
3449
 
    DebugLn('TCarbonWidgetSet.SetViewPortOrgEx DC: ' + DbgS(DC) +
3450
 
      ' NewX: ' + DbgS(NewX) + ' NewY: '+DbgS(NewY));
3451
 
  {$ENDIF}
 
3823
  Result := False;
3452
3824
  if not CheckDC(DC, 'SetViewPortOrgEx') then Exit;
3453
3825
 
3454
 
  if Assigned(OldPoint) then OldPoint^:=TCarbonDeviceContext(DC).ViewPortOfs;
3455
 
  TCarbonDeviceContext(DC).ViewPortOfs:=Types.Point(NewX, NewY);
3456
 
  Result:=True;
 
3826
  if Assigned(OldPoint) then
 
3827
    OldPoint^ := TCarbonDeviceContext(DC).ViewPortOfs;
 
3828
  TCarbonDeviceContext(DC).ViewPortOfs := Types.Point(NewX, NewY);
 
3829
  Result := True;
3457
3830
end;
3458
3831
 
3459
3832
function TCarbonWidgetSet.SetWindowLong(Handle: HWND; Idx: Integer;
3474
3847
  OldPoint: PPoint): Boolean;
3475
3848
begin
3476
3849
  Result  := False;
3477
 
  {$IFDEF VerboseWinAPI}
3478
 
    DebugLn('TCarbonWidgetSet.SetWindowOrgEx DC: ' + DbgS(DC) + ' X: ' + DbgS(NewX) +
3479
 
          ' Y: ' + DbgS(NewY));
3480
 
  {$ENDIF}
3481
 
 
3482
3850
  if not CheckDC(DC, 'SetWindowOrgEx') then Exit;
3483
3851
 
3484
 
  if Assigned(OldPoint) then OldPoint^:=TCarbonDeviceContext(DC).WindowOfs;
3485
 
  TCarbonDeviceContext(DC).WindowOfs:=Types.Point(NewX, NewY);
 
3852
  if Assigned(OldPoint) then
 
3853
    OldPoint^ := TCarbonDeviceContext(DC).WindowOfs;
 
3854
  TCarbonDeviceContext(DC).WindowOfs := Types.Point(NewX, NewY);
 
3855
  Result := True;
3486
3856
end;
3487
3857
 
3488
3858
function TCarbonWidgetSet.SetWindowPos(hWnd: HWND; hWndInsertAfter: HWND; X, Y,
3524
3894
  Shows the window normal, minimized or maximized
3525
3895
------------------------------------------------------------------------------}
3526
3896
function TCarbonWidgetSet.ShowWindow(hWnd: HWND; nCmdShow: Integer): Boolean;
 
3897
var
 
3898
  ACtl: TCarbonControl;
3527
3899
begin
3528
3900
  Result := False;
3529
3901
 
3531
3903
    DebugLn('TCarbonWidgetSet.ShowWindow hWnd: ' + DbgS(hWnd) + ' nCmdShow: ' +
3532
3904
      DbgS(nCmdShow));
3533
3905
  {$ENDIF}
3534
 
  
3535
 
  if not CheckWidget(HWnd, 'ShowWindow', TCarbonWindow) then Exit;
3536
 
 
3537
 
  Result := TCarbonWindow(HWnd).Show(nCmdShow);
 
3906
 
 
3907
  if HWND = 0 then
 
3908
    exit;
 
3909
  ACtl := TCarbonControl(HWND);
 
3910
  if not (ACtl is TCarbonWindow) then
 
3911
  begin
 
3912
    if nCmdShow in [SW_SHOW, SW_HIDE] then
 
3913
    begin
 
3914
      ACtl.ShowHide(nCmdShow = SW_SHOW);
 
3915
      Result := True;
 
3916
    end;
 
3917
  end else
 
3918
  begin
 
3919
    if not CheckWidget(HWnd, 'ShowWindow', TCarbonWindow) then Exit;
 
3920
 
 
3921
    Result := TCarbonWindow(HWnd).Show(nCmdShow);
 
3922
  end;
3538
3923
end;
3539
3924
 
3540
3925
{------------------------------------------------------------------------------
3611
3996
    TCarbonBitmap(Mask), XMask, YMask, Rop);
3612
3997
end;
3613
3998
 
 
3999
function TCarbonWidgetSet.SystemParametersInfo(uiAction: DWord; uiParam: DWord;
 
4000
  pvParam: Pointer; fWinIni: DWord): LongBool;
 
4001
begin
 
4002
  Result:=True;
 
4003
  Case uiAction of
 
4004
    SPI_GETWORKAREA: begin
 
4005
      TRect(pvParam^):=Bounds(GetSystemMetrics(SM_XVIRTUALSCREEN),
 
4006
                              GetSystemMetrics(SM_YVIRTUALSCREEN),
 
4007
                              GetSystemMetrics(SM_CXVIRTUALSCREEN),
 
4008
                              GetSystemMetrics(SM_CYVIRTUALSCREEN));
 
4009
    end;
 
4010
    SPI_GETWHEELSCROLLLINES: PDword(pvPAram)^ := 3;
 
4011
    else
 
4012
      Result := False;
 
4013
  end;
 
4014
end;
 
4015
 
3614
4016
{------------------------------------------------------------------------------
3615
4017
  Method:  TextOut
3616
4018
  Params:  DC    - Handle of the device context
3670
4072
 
3671
4073
  P.h := Point.X;
3672
4074
  P.v := Point.Y;
3673
 
  if FindWindowOfClass(P, kAllWindowClasses, Window, @WindowPart) <> noErr then Exit;
 
4075
  if FindWindowOfClass(P, kAllWindowClasses, Window{%H-}, @WindowPart) <> noErr then Exit;
3674
4076
  if Window = nil then Exit;
3675
4077
  if WindowPart <> inContent then Exit;
3676
4078
  
3677
 
  if OSError(GetWindowBounds(Window, kWindowContentRgn, R), Self,
 
4079
  if OSError(GetWindowBounds(Window, kWindowContentRgn, R{%H-}), Self,
3678
4080
    'WindowFromPoint', SGetWindowBounds) then Exit;
3679
4081
    
3680
4082
  Dec(P.h, R.left);