1 { $Id: gtk2wsstdctrls.pp 9520 2006-06-28 21:26:52Z mattias $}
2 {
3  *****************************************************************************
4  *                             Gtk2CellRenderer.pas                          *
5  *                             --------------------                          *
6  *                                                                           *
7  *                                                                           *
8  *****************************************************************************
9 
10  *****************************************************************************
11   This file is part of the Lazarus Component Library (LCL)
12 
13   See the file COPYING.modifiedLGPL.txt, included in this distribution,
14   for details about the license.
15  *****************************************************************************
16 
17   An extended gtk_cell_renderer, to provide hooks for the LCL.
18   For example for custom drawing.
19 
20 }
21 unit Gtk2CellRenderer;
22 
23 {$mode objfpc}{$H+}
24 
25 interface
26 
27 uses
28   // RTL
29   Classes, SysUtils,
30   gtk2, gdk2, glib2,
31   // LCL
32   LCLType, LCLProc, Controls, StdCtrls, ComCtrls, LMessages,
33   Gtk2Int, Gtk2Proc, Gtk2Def;
34 
35 type
36   PLCLIntfCellRenderer = ^TLCLIntfCellRenderer;
37   TLCLIntfCellRenderer = record
38     // ! the TextRenderer must be the first attribute of this record !
39     TextRenderer: TGtkCellRendererText;
40     Index: integer;
41     ColumnIndex: Integer; // for TListView
42   end;
43 
44   PLCLIntfCellRendererClass = ^TLCLIntfCellRendererClass;
45   TLCLIntfCellRendererClass = record
46     ParentClass: TGtkCellRendererTextClass;
47     DefaultGtkGetSize: procedure(cell: PGtkCellRenderer;
48                                  widget: PGtkWidget;
49                                  cell_area: PGdkRectangle;
50                                  x_offset: pgint;
51                                  y_offset: pgint;
52                                  width: pgint;
53                                  height: pgint); cdecl;
54     DefaultGtkRender: procedure(cell: PGtkCellRenderer;
55                                 window: PGdkWindow;
56                                 widget: PGtkWidget;
57                                 background_area: PGdkRectangle;
58                                 cell_area: PGdkRectangle;
59                                 expose_area:PGdkRectangle;
60                                 flags: TGtkCellRendererState); cdecl;
61   end;
62 
LCLIntfCellRenderer_GetTypenull63 function LCLIntfCellRenderer_GetType: TGtkType;
LCLIntfCellRenderer_Newnull64 function LCLIntfCellRenderer_New: PGtkCellRenderer;
65 procedure LCLIntfCellRenderer_CellDataFunc(cell_layout:PGtkCellLayout;
66                                            cell: PGtkCellRenderer;
67                                            tree_model: PGtkTreeModel;
68                                            iter: PGtkTreeIter;
69                                            data: gpointer); cdecl;
70 
71 implementation
72 
73 uses
74   Gtk2Extra;
75 
76 type
77   TCustomListViewAccess = class(TCustomListView);
78 
GetControlnull79 function GetControl(cell: PGtkCellRenderer; Widget: PGtkWidget): TWinControl;
80 var
81   WidgetInfo: PWidgetInfo;
82   LCLObject: TObject;
83   MainWidget: PGtkWidget;
84 begin
85   Result := nil;
86   MainWidget := GetMainWidget(Widget);
87   if MainWidget = nil then
88     exit;
89   WidgetInfo := GetWidgetInfo(MainWidget);
90   if WidgetInfo = nil then
91     WidgetInfo := GetWidgetInfo(cell);
92   if WidgetInfo = nil then
93     exit;
94   LCLObject := WidgetInfo^.LCLObject; // the listbox or combobox
95   Result := LCLObject as TWinControl;
96 end;
97 
GetItemIndexnull98 function GetItemIndex(cell: PLCLIntfCellRenderer; {%H-}widget: PGtkWidget): Integer;
99 begin
100   Result:=cell^.Index;
101 end;
102 
103 procedure LCLIntfCellRenderer_GetSize(cell: PGtkCellRenderer; widget: PGtkWidget;
104   cell_area: PGdkRectangle; x_offset, y_offset, width, height: pgint); cdecl;
105 var
106   CellClass: PLCLIntfCellRendererClass;
107   AWinControl: TWinControl;
108   ItemIndex: Integer;
109   Msg: TLMMeasureItem;
110   MeasureItemStruct: TMeasureItemStruct;
111 begin
112   CellClass:=PLCLIntfCellRendererClass(gtk_object_get_class(cell));
113   CellClass^.DefaultGtkGetSize(cell, Widget, cell_area, x_offset, y_offset,
114                                width, height);
115   // DebugLn(['LCLIntfCellRenderer_GetSize ',GetWidgetDebugReport(Widget)]);
116   AWinControl := GetControl(cell, widget);
117   if [csDestroying,csLoading]*AWinControl.ComponentState<>[] then exit;
118 
119   if AWinControl is TCustomListbox then
120     if TCustomListbox(AWinControl).Style < lbOwnerDrawFixed then
121       exit;
122   if AWinControl is TCustomCombobox then
123     if not TCustomCombobox(AWinControl).Style.IsVariable then
124       exit;
125 
126   ItemIndex := GetItemIndex(PLCLIntfCellRenderer(cell), Widget);
127 
128   if ItemIndex < 0 then
129     ItemIndex := 0;
130 
131   MeasureItemStruct.itemID := UINT(ItemIndex);
132   MeasureItemStruct.itemWidth := UINT(width^);
133   MeasureItemStruct.itemHeight := UINT(height^);
134   Msg.Msg := LM_MEASUREITEM;
135   Msg.MeasureItemStruct := @MeasureItemStruct;
136   DeliverMessage(AWinControl, Msg);
137   width^ := gint(MeasureItemStruct.itemWidth);
138   height^ := gint(MeasureItemStruct.itemHeight);
139 end;
140 
GtkCellRendererStateToListViewDrawStatenull141 function GtkCellRendererStateToListViewDrawState(CellState: TGtkCellRendererState): TCustomDrawState;
142 begin
143   Result := [];
144   if CellState and GTK_CELL_RENDERER_SELECTED > 0 then Result := Result + [cdsSelected];
145   if CellState and GTK_CELL_RENDERER_PRELIT > 0 then Result := Result + [cdsHot];
146   if CellState and GTK_CELL_RENDERER_INSENSITIVE > 0 then Result := Result + [cdsDisabled, cdsGrayed];
147   if CellState and GTK_CELL_RENDERER_FOCUSED > 0 then Result := Result + [cdsFocused];
148 end;
149 
150 procedure LCLIntfCellRenderer_Render(cell: PGtkCellRenderer; Window: PGdkWindow;
151   Widget: PGtkWidget; background_area: PGdkRectangle; cell_area: PGdkRectangle;
152   expose_area: PGdkRectangle; flags: TGtkCellRendererState); cdecl;
153 var
154   CellClass: PLCLIntfCellRendererClass;
155   AWinControl: TWinControl;
156   ItemIndex: Integer;
157   ColumnIndex: Integer;
158   AreaRect: TRect;
159   State: TOwnerDrawState;
160   Msg: TLMDrawListItem;
161   DCWidget: PGtkWidget;
162   LVTarget: TCustomDrawTarget;
163   LVStage: TCustomDrawStage;
164   LVState: TCustomDrawState;
165   LVSubItem: Integer;
166   TmpDC1,
167   TmpDC2: HDC;
168   SkipDefaultPaint: Boolean;
169   OwnerDrawnListView: Boolean;
170 begin
171   {DebugLn(['LCLIntfCellRenderer_Render cell=',dbgs(cell),
172     ' ',GetWidgetDebugReport(Widget),' ',
173     ' background_area=',dbgGRect(background_area),
174     ' cell_area=',dbgGRect(cell_area),
175     ' expose_area=',dbgGRect(expose_area)]);}
176 
177   ColumnIndex := PLCLIntfCellRenderer(cell)^.ColumnIndex;
178 
179   AWinControl := GetControl(cell, widget);
180   if (ColumnIndex = -1) and (AWinControl <> nil) and
181     (AWinControl.FCompStyle = csListView) then
182       ColumnIndex := 0;
183 
184   OwnerDrawnListView := False;
185   if ColumnIndex > -1 then // listview
186   begin
187     OwnerDrawnListView := TCustomListViewAccess(AWinControl).OwnerDraw and
188       (TCustomListViewAccess(AWinControl).ViewStyle = vsReport);
189 
190     AreaRect := Bounds(background_area^.x, background_area^.y,
191                      background_area^.Width, background_area^.Height);
192 
193 
194     ItemIndex := GetItemIndex(PLCLIntfCellRenderer(cell), Widget);
195 
196     if ItemIndex < 0 then
197       ItemIndex := 0;
198 
199     if ColumnIndex > 0 then
200       LVTarget := dtSubItem
201     else
202       LVTarget := dtItem;
203     if AWinControl.FCompStyle = csListView then
204       LVSubItem := ColumnIndex
205     else
206       LVSubItem := ColumnIndex - 1;
207     LVStage := cdPrePaint;
208     LVState := GtkCellRendererStateToListViewDrawState(flags);
209     DCWidget:=Widget;
210     TmpDC1:=GTK2WidgetSet.CreateDCForWidget(DCWidget,Window,false);
211     TmpDC2 := TCustomListViewAccess(AWinControl).Canvas.Handle;
212     TCustomListViewAccess(AWinControl).Canvas.Handle := TmpDC1;
213     // paint
214     SkipDefaultPaint := cdrSkipDefault in TCustomListViewAccess(AWinControl).IntfCustomDraw(LVTarget, LVStage, ItemIndex, LVSubItem, LVState, @AreaRect);
215 
216     if SkipDefaultPaint then
217     begin
218       GTK2WidgetSet.ReleaseDC(HWnd({%H-}PtrUInt(Widget)),TmpDC1);
219       TCustomListViewAccess(AWinControl).Canvas.Handle := TmpDC2;
220       if not OwnerDrawnListView then
221         Exit;
222     end;
223   end;
224 
225   // draw default
226   CellClass := PLCLIntfCellRendererClass(gtk_object_get_class(cell));
227 
228   // do not call DefaultGtkRender when we are custom drawn listbox.issue #23093
229   if ColumnIndex < 0 then
230   begin
231     if [csDestroying,csLoading,csDesigning]*AWinControl.ComponentState<>[] then
232       AWinControl := nil;
233     if AWinControl is TCustomListbox then
234       if TCustomListbox(AWinControl).Style = lbStandard then
235         AWinControl := nil;
236     if AWinControl is TCustomCombobox then
237       AWinControl := nil;
238   end;
239   // do default draw only if we are not customdrawn.
240   if (ColumnIndex > -1) or ((ColumnIndex < 0) and (AWinControl = nil)) then
241   begin
242     if not OwnerDrawnListView then
243       CellClass^.DefaultGtkRender(cell, Window, Widget, background_area, cell_area,
244         expose_area, flags);
245   end;
246 
247   if ColumnIndex < 0 then  // is a listbox or combobox
248   begin
249     // send LM_DrawListItem message
250     AWinControl := GetControl(cell, widget);
251     if [csDestroying,csLoading]*AWinControl.ComponentState<>[] then exit;
252 
253     // check if the LCL object wants item paint messages
254     if AWinControl is TCustomListbox then
255       if TCustomListbox(AWinControl).Style = lbStandard then
256         exit;
257     if AWinControl is TCustomCombobox then
258       if not TCustomCombobox(AWinControl).Style.IsOwnerDrawn then
259         exit;
260 
261     // get itemindex and area
262 
263     AreaRect := Bounds(background_area^.x, background_area^.y,
264                      background_area^.Width, background_area^.Height);
265 
266     ItemIndex := GetItemIndex(PLCLIntfCellRenderer(cell), Widget);
267 
268     if ItemIndex < 0 then
269       ItemIndex := 0;
270 
271   // collect state flags
272     State:=[odBackgroundPainted];
273     if (flags and GTK_CELL_RENDERER_SELECTED)>0 then
274       Include(State, odSelected);
275     if not GTK_WIDGET_SENSITIVE(Widget) then
276       Include(State, odInactive);
277     if GTK_WIDGET_HAS_DEFAULT(Widget) then
278       Include(State, odDefault);
279     if (flags and GTK_CELL_RENDERER_FOCUSED) <> 0 then
280       Include(State, odFocused);
281 
282     if AWinControl is TCustomCombobox then begin
283       if TCustomComboBox(AWinControl).DroppedDown
284       and ((flags and GTK_CELL_RENDERER_PRELIT)>0) then
285       Include(State,odSelected);
286     end;
287   end
288   else // is a listview
289   begin
290     LVStage := cdPostPaint;
291     // paint
292     TCustomListViewAccess(AWinControl).IntfCustomDraw(LVTarget, LVStage, ItemIndex, LVSubItem, LVState, @AreaRect);
293 
294     TCustomListViewAccess(AWinControl).Canvas.Handle := TmpDC2;
295     GTK2WidgetSet.ReleaseDC(HWnd({%H-}PtrUInt(Widget)),TmpDC1);
296     if not OwnerDrawnListView then
297       Exit;
298   end;
299 
300   // ListBox and ComboBox
301   // create message and deliverFillChar(Msg,SizeOf(Msg),0);
302   if OwnerDrawnListView then
303   begin
304     // we are TListView (GtkTreeView) with OwnerDraw + vsReport
305     Msg.Msg := CN_DRAWITEM;
306 
307     // collect state flags
308     State := [];
309     if (flags and GTK_CELL_RENDERER_SELECTED)>0 then
310       Include(State, odSelected);
311     if not GTK_WIDGET_SENSITIVE(Widget) then
312       Include(State, odInactive);
313     if GTK_WIDGET_HAS_DEFAULT(Widget) then
314       Include(State, odDefault);
315     if (flags and GTK_CELL_RENDERER_FOCUSED) <> 0 then
316       Include(State, odFocused);
317 
318     AreaRect := Bounds(expose_area^.x, expose_area^.y,
319                      expose_area^.Width, expose_area^.Height);
320     if gtk_tree_view_get_headers_visible(PGtkTreeView(Widget)) then
321     begin
322       inc(AreaRect.Top, background_area^.height);
323       inc(AreaRect.Bottom, background_area^.height);
324     end;
325   end else
326     Msg.Msg:=LM_DrawListItem;
327   New(Msg.DrawListItemStruct);
328   try
329     FillChar(Msg.DrawListItemStruct^,SizeOf(TDrawListItemStruct),0);
330     with Msg.DrawListItemStruct^ do
331     begin
332       ItemID:=UINT(ItemIndex);
333       Area:=AreaRect;
334       // DebugLn(['LCLIntfCellRenderer_Render Widget=',GetWidgetDebugReport(Widget^.parent),' Area=',dbgs(Area)]);
335       DCWidget:=Widget;
336       if (DCWidget^.parent<>nil) and
337         (GtkWidgetIsA(DCWidget^.parent,gtk_menu_item_get_type)) then
338       begin
339         // the Widget is a sub widget of a menu item
340         // -> allow the LCL to paint over the whole menu item
341         DCWidget := DCWidget^.parent;
342         Area:=Rect(0,0,DCWidget^.allocation.width,DCWidget^.allocation.height);
343       end;
344       DC := GTK2WidgetSet.CreateDCForWidget(DCWidget,Window,false);
345       ItemState:=State;
346     end;
347     DeliverMessage(AWinControl, Msg);
348     GTK2WidgetSet.ReleaseDC(HWnd({%H-}PtrUInt(Widget)),Msg.DrawListItemStruct^.DC);
349   finally
350     Dispose(Msg.DrawListItemStruct);
351   end;
352 
353   //DebugLn(['LCLIntfCellRenderer_Render END ',DbgSName(LCLObject)]);
354 end;
355 
356 procedure LCLIntfCellRenderer_ClassInit(aClass: Pointer); cdecl;
357 //aClass: PLCLIntfCellRendererClass
358 var
359   LCLClass: PLCLIntfCellRendererClass;
360   RendererClass: PGtkCellRendererClass;
361 begin
362   //DebugLn(['LCLIntfCellRenderer_ClassInit ']);
363   LCLClass := PLCLIntfCellRendererClass(aClass);
364   RendererClass := GTK_CELL_RENDERER_CLASS(aClass);
365   LCLClass^.DefaultGtkGetSize := RendererClass^.get_size;
366   LCLClass^.DefaultGtkRender := RendererClass^.render;
367   RendererClass^.get_size := @LCLIntfCellRenderer_GetSize;
368   RendererClass^.render := @LCLIntfCellRenderer_Render;
369 end;
370 
371 procedure LCLIntfCellRenderer_Init({%H-}Instance:PGTypeInstance;
372   {%H-}theClass: Pointer); cdecl;
373 // Instance: PLCLIntfCellRenderer;
374 // theClass: PLCLIntfCellRendererClass
375 begin
376   //DebugLn(['LCLIntfCellRenderer_Init ']);
377 end;
378 
LCLIntfCellRenderer_GetTypenull379 function LCLIntfCellRenderer_GetType: TGtkType;
380 const
381   CR_NAME = 'LCLIntfCellRenderer';
382   crType: TGtkType = 0;
383   crInfo: TGTKTypeInfo = (
384     type_name: CR_NAME;
385     object_size: SizeOf(TLCLIntfCellRenderer)+100; // a TLCLIntfCellRenderer
386     class_size: SizeOf(TLCLIntfCellRendererClass)+100;
387     class_init_func: @LCLIntfCellRenderer_ClassInit;
388     object_init_func : @LCLIntfCellRenderer_Init;
389     reserved_1: nil;
390     reserved_2: nil;
391     base_class_init_func: nil;
392   );
393 var
394   IID: TGUID;
395   S: AnsiString;
396 begin
397   if (crType = 0)
398   then begin
399     // patch by tk: in case of shared library we must create unique name
400     if CreateGUID(IID) = 0 then
401       S := Format('LCL%d%d%d', [Word(IID.time_low), Word(IID.time_low shr 16), IID.time_mid]);
402     crType := gtk_type_from_name(PAnsiChar(S));
403     if crType = 0 then begin
404       crInfo.type_name:=PAnsiChar(S);
405       crType := gtk_type_unique(gtk_cell_renderer_text_get_type, @crInfo);
406     end;
407   end;
408   Result := crType;
409 end;
410 
LCLIntfCellRenderer_Newnull411 function LCLIntfCellRenderer_New: PGtkCellRenderer;
412 begin
413   Result := g_object_new(LCLIntfCellRenderer_GetType, nil,[]);
414 end;
415 
416 procedure LCLIntfCellRenderer_CellDataFunc(cell_layout:PGtkCellLayout;
417   cell: PGtkCellRenderer; tree_model: PGtkTreeModel; iter: PGtkTreeIter;
418   data: gpointer); cdecl;
419 var
420   LCLCellRenderer: PLCLIntfCellRenderer absolute cell;
421   WidgetInfo: PWidgetInfo;
422   APath: PGtkTreePath;
423   Str: String;
424   ListColumn: TListColumn;
425   ListItem: TListItem;
426   Value: TGValue;
427 begin
428   if G_IS_OBJECT(cell) = false then
429     exit;
430 
431   FillByte(Value{%H-},SizeOf(Value),0);
432   APath := gtk_tree_model_get_path(tree_model,iter);
433   LCLCellRenderer^.Index := gtk_tree_path_get_indices(APath)^;
434   LCLCellRenderer^.ColumnIndex := -1;
435   gtk_tree_path_free(APath);
436 
437   WidgetInfo := PWidgetInfo(data);
438   // DebugLn(['LCLIntfCellRenderer_CellDataFunc stamp=',iter^.stamp,' tree_model=',dbgs(tree_model),' cell=',dbgs(cell),' WidgetInfo=',WidgetInfo <> nil,' Time=',TimeToStr(Now)]);
439 
440   if (WidgetInfo <> nil) and
441     (WidgetInfo^.LCLObject is TCustomComboBox) and
442     not (TCustomComboBox(WidgetInfo^.LCLObject).Style.HasEditBox) and
443     not (TCustomComboBox(WidgetInfo^.LCLObject).DroppedDown) then
444   begin
445     g_value_init(@value, G_TYPE_UINT);
446     g_value_set_uint(@value, 0);
447     g_object_get_property(PgObject(cell), 'ypad', @Value);
448     g_value_set_uint(@value, 0);
449     g_object_set_property(PGObject(cell), 'ypad', @Value);
450     g_value_unset(@value);
451   end else
452   if (WidgetInfo <> nil) and (WidgetInfo^.LCLObject.InheritsFrom(TCustomListView)) then
453   begin
454     // DebugLn(['LCLIntfCellRenderer_CellDataFunc stamp=',iter^.stamp,' tree_model=',dbgs(tree_model),' cell=',dbgs(cell),' WidgetInfo=',WidgetInfo <> nil,' Time=',TimeToStr(Now)]);
455     gtk_tree_model_get(tree_model, iter, [0, @ListItem, -1]);
456     if (ListItem = nil) and TCustomListView(WidgetInfo^.LCLObject).OwnerData then
457       ListItem := TCustomListView(WidgetInfo^.LCLObject).Items[LCLCellRenderer^.Index];
458     if ListItem = nil then
459       Exit;
460     ListColumn := TListColumn(g_object_get_data(G_OBJECT(cell_layout), 'TListColumn'));
461     if ListColumn = nil then
462       LCLCellRenderer^.ColumnIndex := -1
463     else
464       LCLCellRenderer^.ColumnIndex := ListColumn.Index;
465 
466     if LCLCellRenderer^.ColumnIndex <= 0 then
467       Str := ListItem.Caption
468     else
469       if ListColumn.Index-1 <= ListItem.SubItems.Count-1 then
470         Str := ListItem.SubItems.Strings[LCLCellRenderer^.ColumnIndex-1];
471 
472     g_value_init(@value, G_TYPE_STRING);
473     g_value_set_string(@value, PChar(Str));
474     g_object_set_property(PGObject(cell), 'text', @Value);
475     g_value_unset(@value);
476   end;
477 
478   // DebugLn(['LCLIntfCellRenderer_CellDataFunc ItemIndex=',LCLCellRenderer^.Index]);
479 end;
480 
481 end.
482