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

« back to all changes in this revision

Viewing changes to lcl/interfaces/carbon/carbonprivate.pp

  • 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:
1
 
{ $Id: $
2
 
                  --------------------------------------------
 
1
{                 --------------------------------------------
3
2
                  carbonprivate.pp  -  Carbon internal classes
4
3
                  --------------------------------------------
5
4
 
29
28
{$I carbondefines.inc}
30
29
 
31
30
uses
32
 
 // rtl+ftl
33
 
  Types, Classes, SysUtils, Math, Contnrs,
34
 
 // carbon bindings
 
31
  // rtl+ftl
 
32
  Types, Classes, SysUtils,
 
33
  // carbon bindings
35
34
  MacOSAll,
36
 
 // widgetset
37
 
  WSControls, WSLCLClasses, WSProc,
 
35
  {$ifdef CarbonUseCocoaAll}
 
36
  CocoaAll,
 
37
  {$endif}
 
38
  // widgetset
 
39
  WSLCLClasses,
38
40
 // LCL Carbon
39
41
  CarbonDef, CarbonGDIObjects, CarbonMenus,
40
42
 // LCL
45
47
  TCarbonControlEvent = (cceValueChanged, cceIndicatorMoved, cceDoAction,
46
48
    cceDraw, cceHit);
47
49
  TCarbonControlEvents = set of TCarbonControlEvent;
 
50
  TCarbonWidgetFlag = (cwfNone, cwdTToolBar, cwdTTabControl);
48
51
 
49
52
  { TCarbonControl }
50
53
  
51
54
  TCarbonControl = class(TCarbonWidget)
 
55
  private
 
56
    FCarbonWidgetFlag: TCarbonWidgetFlag;
52
57
  protected
53
58
    procedure RegisterEvents; override;
54
 
    procedure CreateWidget(const AParams: TCreateParams); override;
 
59
    procedure CreateWidget(const {%H-}AParams: TCreateParams); override;
55
60
    procedure DestroyWidget; override;
56
61
    procedure AddControlPart(const AControl: ControlRef);
57
62
    function GetContent: ControlRef; override;
58
63
    function GetControlContentRect(var ARect: TRect): Boolean;
59
 
    function GetFrame(Index: Integer): ControlRef; virtual;
 
64
    function GetFrame({%H-}Index: Integer): ControlRef; virtual;
60
65
    function GetFrameBounds(var ARect: TRect): Boolean; virtual;
61
66
    function GetForceEmbedInScrollView: Boolean; virtual;
62
67
    function UpdateContentBounds: Boolean;
66
71
  public
67
72
    class function GetFrameCount: Integer; virtual;
68
73
    class function GetValidEvents: TCarbonControlEvents; virtual;
69
 
    procedure Hit(AControlPart: ControlPartCode); virtual;
 
74
    procedure Hit({%H-}AControlPart: ControlPartCode); virtual;
70
75
    procedure Draw; virtual;
71
76
    procedure ValueChanged; virtual;
72
77
    procedure IndicatorMoved; virtual;
73
 
    procedure DoAction(AControlPart: ControlPartCode); virtual;
 
78
    procedure DoAction({%H-}AControlPart: ControlPartCode); virtual;
74
79
  public
75
 
    procedure AllowMenuProcess(MenuHotKey: AnsiChar; State: TShiftState; var AllowCommandProcess: Boolean); virtual;
 
80
    procedure AllowMenuProcess({%H-}MenuHotKey: AnsiChar; {%H-}State: TShiftState; var AllowCommandProcess: Boolean); virtual;
76
81
  public
77
82
    procedure AddToWidget(AParent: TCarbonWidget); override;
78
83
    function GetTopParentWindow: WindowRef; override;
95
100
    procedure SetZOrder(AOrder: HIViewZOrderOp; ARefWidget: TCarbonWidget); override;
96
101
    procedure ShowHide(AVisible: Boolean); override;
97
102
    
98
 
    function GetText(var S: String): Boolean; override;
 
103
    function GetText(var {%H-}S: String): Boolean; override;
99
104
    function SetText(const S: String): Boolean; override;
100
105
    
101
106
    function Update: Boolean; override;
108
113
    procedure SetMaximum(AValue: Integer);
109
114
    procedure SetViewSize(AValue: Integer);
110
115
  public
 
116
    // needed to avoid "Class is" or "ClassType"
 
117
    property CarbonWidgetFlag: TCarbonWidgetFlag read FCarbonWidgetFlag write FCarbonWidgetFlag;
111
118
  { Frame:
112
119
     = widget in controls without special frame control
113
120
     - frame area control of control
133
140
    procedure RegisterEvents; override;
134
141
    procedure CreateWidget(const AParams: TCreateParams); override;
135
142
    procedure DestroyWidget; override;
136
 
    function GetFrame(Index: Integer): ControlRef; override;
 
143
    function GetFrame({%H-}Index: Integer): ControlRef; override;
137
144
    function GetForceEmbedInScrollView: Boolean; override;
138
145
    procedure SendScrollUpdate;
 
146
    procedure UpdateLCLClientRect; override;
139
147
  public
140
148
    class function GetValidEvents: TCarbonControlEvents; override;
141
149
    procedure Draw; override;
144
152
    procedure Invalidate(Rect:PRect=nil);override;
145
153
  public
146
154
    procedure AddToWidget(AParent: TCarbonWidget); override;
147
 
    procedure SetColor(const AColor: TColor); override;
148
 
    procedure SetFont(const AFont: TFont); override;
 
155
    procedure SetColor(const {%H-}AColor: TColor); override;
 
156
    procedure SetFont(const {%H-}AFont: TFont); override;
149
157
    procedure GetScrollInfo(SBStyle: Integer; var ScrollInfo: TScrollInfo); override;
150
158
    function GetScrollbarVisible(SBStyle: Integer): Boolean; override;
151
159
    function SetScrollInfo(SBStyle: Integer; const ScrollInfo: TScrollInfo): Integer; override;
152
160
 
153
161
    property TextFractional: Boolean read FTextFractional write FTextFractional;
154
162
  end;
 
163
 
 
164
  { TCarbonToolBar }
 
165
 
 
166
  TCarbonToolBar = class(TCarbonCustomControl)
 
167
  protected
 
168
    procedure CreateWidget(const AParams: TCreateParams); override;
 
169
  end;
155
170
  
156
171
  { TCarbonScrollingWinControl }
157
172
 
167
182
  { TCarbonWindow }
168
183
 
169
184
  TCarbonWindow = class(TCarbonScrollingWinControl)
 
185
  private
 
186
    FSheetWin: WindowRef;
170
187
  protected
171
188
    fWindowRef  : WindowRef;
172
189
    fHiddenWin  : WindowRef;
206
223
    procedure SetZOrder(AOrder: HIViewZOrderOp; ARefWidget: TCarbonWidget); override;
207
224
    procedure ShowHide(AVisible: Boolean); override;
208
225
 
209
 
    function GetText(var S: String): Boolean; override;
 
226
    function GetText(var {%H-}S: String): Boolean; override;
210
227
    function SetText(const S: String): Boolean; override;
211
228
 
212
229
    function Update: Boolean; override;
213
 
    function WidgetAtPos(const P: TPoint): ControlRef; override;
 
230
    function WidgetAtPos(const {%H-}P: TPoint): ControlRef; override;
214
231
  public
215
232
    function Activate: Boolean; virtual;
216
233
 
227
244
    procedure SetFormBorderStyle(AFormBorderStyle: TFormBorderStyle); virtual;
228
245
  public
229
246
    property Window: WindowRef read FWindowRef;
 
247
    property SheetWin: WindowRef  read FSheetWin write FSheetWin; // used to show sheet in modal window
230
248
  end;
231
249
 
232
250
  { TCarbonHintWindow }
292
310
    procedure Draw; override;
293
311
  public
294
312
    function GetPreferredSize: TPoint; override;
295
 
    procedure SetColor(const AColor: TColor); override;
296
 
    procedure SetFont(const AFont: TFont); override;
297
 
    procedure UpdatePanel(AIndex: Integer = -1);
 
313
    procedure SetColor(const {%H-}AColor: TColor); override;
 
314
    procedure SetFont(const {%H-}AFont: TFont); override;
 
315
    procedure UpdatePanel({%H-}AIndex: Integer = -1);
298
316
  end;
299
317
 
300
318
  { TCarbonStaticText }
312
330
function GetCarbonWindow(AWidget: WindowRef): TCarbonWindow;
313
331
function GetCarbonControl(AWidget: ControlRef): TCarbonControl;
314
332
 
 
333
const
 
334
  larAXStaticTextRoles = [larClock, larLabel, larListItem, larTreeItem, larResizeGrip];
 
335
  larAXListRoles = [larListBox, larTreeView];
 
336
 
315
337
implementation
316
338
 
317
 
uses InterfaceBase, CarbonInt, CarbonProc, CarbonDbgConsts, CarbonUtils,
318
 
  CarbonWSStdCtrls, CarbonCanvas, CarbonCaret;
 
339
uses InterfaceBase, CarbonInt, CarbonProc, CarbonDbgConsts, CarbonUtils, CarbonCanvas, CarbonCaret;
319
340
 
320
341
var
321
342
  // recursive number of draw events called by OSX
410
431
    CreateNewWindow(kHelpWindowClass,
411
432
      kWindowCompositingAttribute or
412
433
      kWindowHideOnSuspendAttribute or kWindowStandardHandlerAttribute,
413
 
      ParamsToCarbonRect(AParams), AWindow),
 
434
      ParamsToCarbonRect(AParams), AWindow{%H-}),
414
435
    Self, SCreateWidget, 'CreateNewWindow') then RaiseCreateWidgetError(LCLObject);
415
436
 
416
437
  fWindowRef := AWindow;
537
558
  inherited;
538
559
  
539
560
  // create custom view above all others
540
 
  GetClientRect(R);
 
561
  GetClientRect(R{%H-});
541
562
  OffsetRect(R, -R.Left, -R.Top);
542
563
  FDesignControl := CreateCustomHIView(RectToCGRect(R));
543
564
  
562
583
procedure TCarbonDesignWindow.DestroyWidget;
563
584
begin
564
585
  DisposeControl(FDesignControl);
565
 
  
 
586
  LCLObject := nil;
566
587
  inherited;
567
588
end;
568
589
 
587
608
begin
588
609
  inherited;
589
610
 
590
 
  GetClientRect(R);
 
611
  GetClientRect(R{%H-});
591
612
  OffsetRect(R, -R.Left, -R.Top);
592
613
  OSError(HIViewSetFrame(FDesignControl, RectToCGRect(R)),
593
614
    Self, SSetBounds, SViewFrame);
638
659
  Name: CarbonScrollable_GetInfo
639
660
  Handles scrollable get info
640
661
 ------------------------------------------------------------------------------}
641
 
function CarbonScrollable_GetInfo(ANextHandler: EventHandlerCallRef;
 
662
function CarbonScrollable_GetInfo({%H-}ANextHandler: EventHandlerCallRef;
642
663
  AEvent: EventRef;
643
664
  AWidget: TCarbonWidget): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
644
665
var
669
690
  Name: CarbonScrollable_ScrollTo
670
691
  Handles scrollable get info
671
692
 ------------------------------------------------------------------------------}
672
 
function CarbonScrollable_ScrollTo(ANextHandler: EventHandlerCallRef;
 
693
function CarbonScrollable_ScrollTo({%H-}ANextHandler: EventHandlerCallRef;
673
694
  AEvent: EventRef;
674
695
  AWidget: TCarbonWidget): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
675
696
var
702
723
  
703
724
  if FScrollView <> Widget then
704
725
  begin
705
 
    TmpSpec := MakeEventSpec(kEventClassScrollable, kEventScrollableGetInfo);
706
 
    InstallControlEventHandler(Widget,
707
 
      RegisterEventHandler(@CarbonScrollable_GetInfo),
708
 
      1, @TmpSpec, Pointer(Self), nil);
709
 
 
710
726
    TmpSpec := MakeEventSpec(kEventClassScrollable, kEventScrollableScrollTo);
711
727
    InstallControlEventHandler(Widget,
712
728
      RegisterEventHandler(@CarbonScrollable_ScrollTo),
721
737
  Creates Carbon custom control
722
738
 ------------------------------------------------------------------------------}
723
739
procedure TCarbonCustomControl.CreateWidget(const AParams: TCreateParams);
 
740
var
 
741
  TmpSpec: EventTypeSpec;
 
742
  AStyle: TControlStyle;
724
743
begin
725
 
  Widget := CreateCustomHIView(ParamsToHIRect(AParams), LCLObject.ControlStyle);
 
744
  AStyle := LCLObject.ControlStyle;
 
745
 
 
746
  if CarbonWidgetFlag = cwdTToolBar then
 
747
    AStyle := AStyle + [csNoFocus];
 
748
 
 
749
  Widget := CreateCustomHIView(ParamsToHIRect(AParams), AStyle);
726
750
  if Widget = nil then RaiseCreateWidgetError(LCLObject);
727
751
 
 
752
  // The event must be installed before embedding ScrollView. related to #19425
 
753
  TmpSpec := MakeEventSpec(kEventClassScrollable, kEventScrollableGetInfo);
 
754
  InstallControlEventHandler(Widget,
 
755
    RegisterEventHandler(@CarbonScrollable_GetInfo),
 
756
    1, @TmpSpec, Pointer(Self), nil);
 
757
 
728
758
  FScrollView := EmbedInScrollView(AParams);
729
759
  FScrollSize := Classes.Point(0, 0);
730
760
  FScrollMin := Classes.Point(0, 0);
891
921
    FScrollOrigin.Y := Round(ANewOrigin.Y / FMulY);
892
922
  
893
923
  // send vertical scroll
894
 
  FillChar(ScrollMsg, SizeOf(TLMScroll), 0);
 
924
  FillChar(ScrollMsg{%H-}, SizeOf(TLMScroll), 0);
895
925
  with ScrollMsg do
896
926
  begin
897
927
    Msg := LM_VSCROLL;
977
1007
 ------------------------------------------------------------------------------}
978
1008
function TCarbonCustomControl.SetScrollInfo(SBStyle: Integer;
979
1009
  const ScrollInfo: TScrollInfo): Integer;
980
 
const
981
 
  SName = 'SetScrollInfo';
982
1010
begin
983
1011
  {$IFDEF VerboseScroll}
984
1012
    DebugLn('TCarbonCustomControl.SetScrollInfo ' + LCLObject.Name +
1035
1063
 ------------------------------------------------------------------------------}
1036
1064
procedure TCarbonCustomControl.GetScrollInfo(SBStyle: Integer;
1037
1065
  var ScrollInfo: TScrollInfo);
1038
 
const
1039
 
  SName = 'GetScrollInfo';
 
1066
var
 
1067
  AImageSize, AViewSize, ALineSize: HISize;
 
1068
  AOrigin: HIPoint;
 
1069
  Pt: TPoint;
1040
1070
begin
1041
1071
  {$IFDEF VerboseScroll}
1042
1072
    DebugLn('TCarbonCustomControl.GetScrollInfo ' + LCLObject.Name +
1053
1083
      ScrollInfo.nMax := FScrollSize.Y - FScrollMin.Y - 1;
1054
1084
  end;
1055
1085
 
1056
 
  if (SIF_POS and ScrollInfo.fMask) > 0 then
 
1086
  if ((SIF_POS and ScrollInfo.fMask) > 0) then
1057
1087
  begin
1058
1088
    if SBStyle = SB_HORZ then
1059
1089
      ScrollInfo.nPos := Trunc(FScrollOrigin.X) + FScrollMin.X;
1068
1098
    if SBStyle = SB_VERT then
1069
1099
      ScrollInfo.nPage := FScrollPageSize.Y;
1070
1100
  end;
 
1101
 
 
1102
  if ((SIF_TRACKPOS and ScrollInfo.fMask) > 0) then
 
1103
  begin
 
1104
    GetInfo(AImageSize, AViewSize, ALineSize, AOrigin);
 
1105
    Pt := HIPointToPoint(AOrigin);
 
1106
    if SBStyle = SB_HORZ then
 
1107
      ScrollInfo.nTrackPos := Pt.X
 
1108
    else
 
1109
    if SBStyle = SB_VERT then
 
1110
      ScrollInfo.nTrackPos := Pt.Y;
 
1111
  end;
1071
1112
  
1072
1113
  {$IFDEF VerboseScroll}
1073
1114
    DebugLn('TCarbonCustomControl.GetScrollInfo Result: ' + DbgS(ScrollInfo));
1140
1181
var
1141
1182
  ABox    : TCarbonGroupBox;
1142
1183
  Context : CGContextRef;
1143
 
  c : TColor;
 
1184
  c : TColorRef;
1144
1185
  b : TRect;
1145
1186
const
1146
1187
  rgbkoef = 1 / 255;
1162
1203
      if Assigned(Context) then
1163
1204
      begin
1164
1205
        c := ColorToRGB(ABox.FBoxColor);
1165
 
        ABox.GetBounds(b);
 
1206
        ABox.GetBounds(b{%H-});
1166
1207
        CGContextSaveGState(Context);
1167
1208
        CGContextSetRGBFillColor(Context, (c and $FF) * rgbkoef, ((c shr 8) and $FF)*rgbkoef,
1168
1209
          ((c shr 16) and $FF)*rgbkoef, 1);
1206
1247
begin
1207
1248
  if OSError(
1208
1249
    CreateGroupBoxControl(GetTopParentWindow, ParamsToCarbonRect(AParams),
1209
 
      nil, not (LCLObject.Parent is TCustomGroupBox), Control),
 
1250
      nil, not (LCLObject.Parent is TCustomGroupBox), Control{%H-}),
1210
1251
    Self, SCreateWidget, 'CreateGroupBoxControl') then RaiseCreateWidgetError(LCLObject);
1211
1252
 
1212
1253
  Widget := Control;
1213
1254
  
1214
 
  if not GetClientRect(R) then
 
1255
  if not GetClientRect(R{%H-}) then
1215
1256
  begin
1216
1257
    DebugLn('TCarbonGroupBox.CreateWidget Error - no content region!');
1217
1258
    Exit;
1260
1301
  BoundsRect: TRect;
1261
1302
begin
1262
1303
  Result := inherited;
1263
 
  if GetBounds(BoundsRect) and
 
1304
  if GetBounds(BoundsRect{%H-}) and
1264
1305
     ((BoundsRect.Right - BoundsRect.Left) = Result.X) and
1265
1306
     ((BoundsRect.Bottom - BoundsRect.Top) = Result.Y) then
1266
1307
  begin
1269
1310
    Result.Y := DefaultHeight;
1270
1311
  end
1271
1312
  else
1272
 
  if GetClientRect(ContentRect) then
 
1313
  if GetClientRect(ContentRect{%H-}) then
1273
1314
  begin
1274
1315
    Dec(Result.X, ContentRect.Right - ContentRect.Left);
1275
1316
    Dec(Result.Y, ContentRect.Bottom - ContentRect.Top);
1340
1381
    (kHIThemeTextHorizontalFlushLeft,kHIThemeTextHorizontalFlushRight,kHIThemeTextHorizontalFlushCenter);
1341
1382
begin
1342
1383
  cr:=RectToCGRect(r);
1343
 
  FillChar(info, sizeof(info), 0);
 
1384
  FillChar(info{%H-}, sizeof(info), 0);
1344
1385
  info.kind:=kThemeListHeaderButton;
1345
1386
  info.state:=kThemeStateActive;
1346
1387
  HIThemeDrawButton( cr, info, ctx, 0, nil);
1353
1394
    CreateCFString(data.Text, cf);
1354
1395
    if Assigned(cf) then
1355
1396
    begin
1356
 
      FillChar(txtinfo, sizeof(txtinfo), 0);
 
1397
      FillChar(txtinfo{%H-}, sizeof(txtinfo), 0);
1357
1398
      txtinfo.version:=1;
1358
1399
      //txtinfo.fontID:=kThemeMiniSystemFont;
1359
1400
      txtinfo.horizontalFlushness:=txtHorzFlush[data.align];
1477
1518
  end;
1478
1519
  {$else}
1479
1520
  StatusBar := LCLObject as TStatusBar;
1480
 
  GetClientRect(r);
 
1521
  GetClientRect(r{%H-});
1481
1522
  if StatusBar.SimplePanel then
1482
 
    DrawCarbonStatusBar( TCarbonContext(Context).CGContext, r, [], nil)
 
1523
  begin
 
1524
    SetLength(items, 1);
 
1525
    items[0].Width:=r.Right-r.Left;
 
1526
    items[0].Text:=StatusBar.SimpleText;
 
1527
    items[0].Align:=taLeftJustify; //todo: select proper Justify based on lanuage text-mode (r2l, l2r)!
 
1528
  end
1483
1529
  else
1484
1530
  begin
1485
1531
    SetLength(items, StatusBar.Panels.Count);
1489
1535
      items[i].Text:=StatusBar.Panels[i].Text;
1490
1536
      items[i].Align:=StatusBar.Panels[i].Alignment;
1491
1537
    end;
1492
 
    DrawCarbonStatusBar( TCarbonContext(Context).CGContext, r, items, nil)
1493
1538
  end;
 
1539
  DrawCarbonStatusBar( TCarbonContext(Context).CGContext, r, items, nil);
1494
1540
  {$endif}
1495
1541
end;
1496
1542
 
1555
1601
begin
1556
1602
{$ifdef CarbonOldStatusBar}
1557
1603
  StatusBar := LCLObject as TStatusBar;
1558
 
  
 
1604
 
1559
1605
  if StatusBar.SimplePanel then
1560
1606
  begin
1561
1607
    // hide panels
1631
1677
 
1632
1678
  if OSError(
1633
1679
    CreateStaticTextControl(GetTopParentWindow, ParamsToCarbonRect(AParams),
1634
 
      nil, @FontStyle, Control),
 
1680
      nil, @FontStyle, Control{%H-}),
1635
1681
    Self, SCreateWidget, 'CreateStaticTextControl') then RaiseCreateWidgetError(LCLObject);
1636
1682
 
1637
1683
  Widget := Control;