1 {
2  *****************************************************************************
3  *                              CocoaWSCheckLst.pp                           *
4  *                              ---------------                              *
5  *                                                                           *
6  *                                                                           *
7  *****************************************************************************
8 
9  *****************************************************************************
10   This file is part of the Lazarus Component Library (LCL)
11 
12   See the file COPYING.modifiedLGPL.txt, included in this distribution,
13   for details about the license.
14  *****************************************************************************
15 }
16 unit CocoaWSCheckLst;
17 
18 {$mode objfpc}{$H+}
19 {$modeswitch objectivec1}
20 {$modeswitch objectivec2}
21 
22 interface
23 
24 uses
25   // Libs
26   MacOSAll, CocoaAll, Classes, sysutils,
27   // LCL
28   Controls, StdCtrls, CheckLst, LCLType,
29   // Widgetset
30   WSCheckLst, WSLCLClasses,
31   // LCL Cocoa
32   CocoaWSCommon, CocoaPrivate, CocoaUtils, CocoaWSStdCtrls, CocoaTables, CocoaGDIObjects,
33   CocoaScrollers
34   ,LCLMessageGlue;
35 
36 type
37 
38   { TCocoaCheckStringList }
39 
40   TCocoaCheckStringList = class(TCocoaStringList)
41   protected
42     procedure ExchangeItems(Index1, Index2: Integer); override;
43   public
44     ChkState : array of SInt8;
45     procedure InsertItem(Index: Integer; const S: string; O: TObject); override;
46     procedure Delete(Index: Integer); override;
47     procedure Clear; override;
48   end;
49 
50   { TLCLCheckboxListCallback }
51 
52   TLCLCheckboxListCallback = class(TLCLListBoxCallback, IListViewCallback)
53   protected
AllocStringsnull54     function AllocStrings(ATable: NSTableView): TCocoaStringList; override;
55   public
56     checklist: TCustomCheckListBox;
57     constructor Create(AOwner: NSObject; ATarget: TWinControl; AHandleView: NSView); override;
GetItemCheckedAtnull58     function GetItemCheckedAt(ARow, ACol: Integer; var CheckState: Integer): Boolean; override;
59     procedure SetItemCheckedAt(ARow, ACol: Integer; CheckState: Integer); override;
60 
GetCheckStatenull61     function GetCheckState(Index: Integer; var AState: Integer): Boolean;
SetCheckStatenull62     function SetCheckState(Index: Integer; AState: Integer; InvalidateCocoa: Boolean = true): Boolean;
63   end;
64 
65 
66   { TCocoaWSCustomCheckListBox }
67 
68   TCocoaWSCustomCheckListBox = class(TWSCustomCheckListBox)
69   published
CreateHandlenull70     class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
GetStatenull71     class function GetState(const ACheckListBox: TCustomCheckListBox; const AIndex: integer): TCheckBoxState; override;
72     class procedure SetState(const ACheckListBox: TCustomCheckListBox; const AIndex: integer; const AState: TCheckBoxState); override;
73   end;
74 
CtrlToCheckListnull75 function CtrlToCheckList(ctrl: TWinControl; out tbl: TCocoaTableListView; out cb: TLCLCheckboxListCallback): Boolean;
76 
77 implementation
78 
CtrlToCheckListnull79 function CtrlToCheckList(ctrl: TWinControl; out tbl: TCocoaTableListView; out cb: TLCLCheckboxListCallback): Boolean;
80 begin
81   Result := Assigned(ctrl) and (ctrl.HandleAllocated) and (ctrl.Handle <> 0);
82   if not Result then begin
83     tbl := nil;
84     cb := nil;
85     Exit;
86   end;
87   tbl:=TCocoaTableListView(NSSCrollView(ctrl.Handle).documentView);
88   Result := Assigned(tbl);
89   if Result then
90     cb := TLCLCheckboxListCallback(tbl.lclGetCallback.GetCallbackObject)
91   else
92     cb := nil;
93 end;
94 
95 { TCocoaCheckStringList }
96 
97 procedure TCocoaCheckStringList.ExchangeItems(Index1, Index2: Integer);
98 var
99   t : Integer;
100 begin
101   inherited ExchangeItems(Index1, Index2);
102   t := ChkState[Index1];
103   ChkState[Index1] := ChkState[Index2];
104   ChkState[Index2] := t;
105 end;
106 
107 procedure TCocoaCheckStringList.InsertItem(Index: Integer; const S: string;
108   O: TObject);
109 var
110   cnt : integer;
111   sz : integer;
112 begin
113   cnt := Count;
114   inherited InsertItem(Index, S, O);
115 
116   if length(ChkState)<Capacity then
117     SetLength(ChkState, Capacity);
118 
119   sz := (cnt - Index) * sizeof(SInt8);
120   if sz>0 then System.Move(ChkState[Index], ChkState[Index+1], sz);
121 
122   ChkState[Index] := 0;
123 end;
124 
125 procedure TCocoaCheckStringList.Delete(Index: Integer);
126 var
127   sz  : Integer;
128 begin
129   inherited Delete(Index);
130   sz := (Count - Index) * sizeof(SInt8);
131   if (sz>0) and (Index < Count) then
132     System.Move(ChkState[Index+1], ChkState[Index], sz);
133 end;
134 
135 procedure TCocoaCheckStringList.Clear;
136 begin
137   inherited Clear;
138   SetLength(ChkState, 0);
139 end;
140 
141 { TLCLCheckboxListCallback }
142 
TLCLCheckboxListCallback.AllocStringsnull143 function TLCLCheckboxListCallback.AllocStrings(ATable: NSTableView): TCocoaStringList;
144 begin
145   Result:=TCocoaCheckStringList.Create(ATable);
146 end;
147 
148 constructor TLCLCheckboxListCallback.Create(AOwner: NSObject; ATarget: TWinControl; AHandleView: NSView);
149 begin
150   inherited Create(AOwner, ATarget, AHandleView);
151   if ATarget is TCustomCheckListBox then
152     checklist := TCustomCheckListBox(ATarget);
153 end;
154 
TLCLCheckboxListCallback.GetItemCheckedAtnull155 function TLCLCheckboxListCallback.GetItemCheckedAt(ARow, ACol: Integer;
156   var CheckState: Integer): Boolean;
157 begin
158   Result := GetCheckState(Arow, CheckState);
159 end;
160 
161 procedure TLCLCheckboxListCallback.SetItemCheckedAt(ARow, ACol: Integer;
162   CheckState: Integer);
163 var
164   changed : Boolean;
165 begin
166   changed := SetCheckState(ARow, CheckState, false); // returns true, if changed!s
167   if changed then LCLSendChangedMsg(Target, ARow);
168 end;
169 
GetCheckStatenull170 function TLCLCheckboxListCallback.GetCheckState(Index: Integer; var AState: Integer): Boolean;
171 var
172   chkstr : TCocoaCheckStringList;
173 begin
174   Result := Assigned(strings) and (Index>=0) and (Index<strings.Count);
175   if Result then
176   begin
177     chkstr := TCocoaCheckStringList(strings);
178     AState := chkstr.ChkState[Index];
179   end
180   else
181     ASTate := 0;
182 end;
183 
SetCheckStatenull184 function TLCLCheckboxListCallback.SetCheckState(Index: Integer; AState: Integer;
185   InvalidateCocoa: Boolean = true): Boolean;
186 var
187   chkstr : TCocoaCheckStringList;
188 begin
189   Result := Assigned(Strings) and (Index>=0) and (Index<strings.Count);
190   if not Result then Exit;
191   chkstr := TCocoaCheckStringList(strings);
192   Result := chkstr.ChkState[Index] <> AState;
193   if Result then
194   begin
195     chkstr.ChkState[Index] := AState;
196     if InvalidateCocoa and Assigned(listview) then
197       listview.reloadDataForRow_column(Index, 0);
198   end;
199 end;
200 
201 { TCocoaWSCustomCheckListBox }
202 
203 {------------------------------------------------------------------------------
204   Method:  TCocoaWSCustomCheckListBox.CreateHandle
205   Params:  AWinControl - LCL control
206            AParams     - Creation parameters
207   Returns: Handle to the control in Cocoa interface
208 
209   Creates new check list box in Cocoa interface with the specified parameters
210  ------------------------------------------------------------------------------}
TCocoaWSCustomCheckListBox.CreateHandlenull211 class function TCocoaWSCustomCheckListBox.CreateHandle(
212   const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle;
213 var
214   list: TCocoaTableListView;
215   scroll: TCocoaScrollView;
216 begin
217   list := AllocCocoaTableListView.lclInitWithCreateParams(AParams);
218   if not Assigned(list) then
219   begin
220     Result := 0;
221     Exit;
222   end;
223   list.callback := TLCLCheckboxListCallback.CreateWithView(list, AWinControl);
224   list.lclSetFirstColumCheckboxes(true);
225   //list.list := TCocoaStringList.Create(list);
226   list.addTableColumn(NSTableColumn.alloc.init);
227   list.setHeaderView(nil);
228   list.setDataSource(list);
229   list.setDelegate(list);
230   list.readOnly := true;
231   //todo:
232   //list.AllowMixedState := TCustomCheckListBox(AWinControl).AllowGrayed;
233   list.isOwnerDraw := TCustomCheckListBox(AWinControl).Style in [lbOwnerDrawFixed, lbOwnerDrawVariable];
234 
235   scroll := EmbedInScrollView(list);
236   if not Assigned(scroll) then
237   begin
238     list.dealloc;
239     Result := 0;
240     Exit;
241   end;
242   scroll.callback := list.callback;
243   scroll.setHasVerticalScroller(true);
244   scroll.setAutohidesScrollers(true);
245 
246   ScrollViewSetBorderStyle(scroll, TCustomCheckListBox(AWinControl).BorderStyle);
247   UpdateFocusRing(list, TCustomCheckListBox(AWinControl).BorderStyle);
248 
249   Result := TLCLIntfHandle(scroll);
250 end;
251 
252 {------------------------------------------------------------------------------
253   Method:  TCocoaWSCustomCheckListBox.GetState
254   Params:  ACustomCheckListBox - LCL custom check list box
255            AIndex              - Item index
256   Returns: If the specified item in check list box in Cocoa interface is
257            checked, grayed or unchecked
258  ------------------------------------------------------------------------------}
TCocoaWSCustomCheckListBox.GetStatenull259 class function TCocoaWSCustomCheckListBox.GetState(
260   const ACheckListBox: TCustomCheckListBox; const AIndex: integer): TCheckBoxState;
261 var
262   tbl: TCocoaTableListView;
263   cb : TLCLCheckboxListCallback;
264   cocoaSt: Integer;
265 begin
266   if not CtrlToCheckList(ACheckListBox, tbl, cb) then begin
267     Result := cbUnchecked;
268     Exit;
269   end;
270   if cb.GetCheckState(AIndex, cocoaSt) then
271     case cocoaSt of
272       NSOnState : Result := cbChecked;
273       NSMixedState : Result := cbGrayed;
274     else
275       Result := cbUnchecked;
276     end
277   else
278     Result := cbUnchecked;
279 end;
280 
281 {------------------------------------------------------------------------------
282   Method:  TCocoaWSCustomCheckListBox.SetState
283   Params:  ACustomCheckListBox - LCL custom check list box
284            AIndex              - Item index to change checked value
285            AChecked            - New checked value
286 
287   Changes checked value of item with the specified index of check list box in
288   Cocoa interface
289  ------------------------------------------------------------------------------}
290 class procedure TCocoaWSCustomCheckListBox.SetState(
291   const ACheckListBox: TCustomCheckListBox; const AIndex: integer;
292   const AState: TCheckBoxState);
293 var
294   tbl: TCocoaTableListView;
295   cb : TLCLCheckboxListCallback;
296   cocoaSt: Integer;
297 begin
298   if not CtrlToCheckList(ACheckListBox, tbl, cb) then Exit;
299 
300   case AState of
301     cbChecked: cocoaSt := NSOnState;
302     cbGrayed:  cocoaSt := NSMixedState;
303   else
304     cocoaSt := NSOffState;
305   end;
306   cb.SetCheckState(AIndex, cocoaSt, true);
307 end;
308 
309 end.
310