gtk2 intf: fixed codetools include paths, fixed double painting

git-svn-id: trunk@10870 -

.gitattributes

@@ -2594,6 +2594,8 @@ lcl/interfaces/gtk2/gtk2wsspin.pp svneol=native#text/pascal
 lcl/interfaces/gtk2/gtk2wsstdctrls.pp svneol=native#text/pascal
 lcl/interfaces/gtk2/gtk2wstoolwin.pp svneol=native#text/pascal
 lcl/interfaces/gtk2/interfaces.pas svneol=native#text/pascal
+lcl/interfaces/gtk2/tests/checkbuttononfixed.lpi svneol=native#text/plain
+lcl/interfaces/gtk2/tests/checkbuttononfixed.lpr svneol=native#text/plain
 lcl/interfaces/qt/README.txt svneol=native#text/plain
 lcl/interfaces/qt/interfaces.pp svneol=native#text/pascal
 lcl/interfaces/qt/qt4.pas svneol=native#text/plain
@@ -2766,6 +2768,8 @@ lcl/tests/test1_4edit.lpi svneol=native#text/plain
 lcl/tests/test1_4edit.lpr svneol=native#text/pascal
 lcl/tests/test1_5checkbox.lpi svneol=native#text/plain
 lcl/tests/test1_5checkbox.lpr svneol=native#text/pascal
+lcl/tests/test1_6checkgroup.lpi svneol=native#text/plain
+lcl/tests/test1_6checkgroup.lpr svneol=native#text/plain
 lcl/tests/test2_1buttonnavigation.lpi svneol=native#text/plain
 lcl/tests/test2_1buttonnavigation.lpr svneol=native#text/pascal
 lcl/tests/test2_2labelattributes.lpi svneol=native#text/plain

components/codetools/codetoolsstrconsts.pas

@@ -191,6 +191,7 @@ ResourceString
   ctsInstallerDirectories = 'Installer directories';
   ctsDefsForLazarusSources = 'Definitions for the Lazarus Sources';
   ctsAddsDirToSourcePath = 'adds %s to SrcPath';
+  ctsAddsDirToIncludePath = 'adds %s to IncPath';
   ctsSetsIncPathTo = 'sets IncPath to %s';
   ctsSetsSrcPathTo = 'sets SrcPath to %s';
   ctsNamedDirectory = '%s Directory';

components/codetools/definetemplates.pas

@@ -3791,7 +3791,7 @@ var
   MainDir, DirTempl, SubDirTempl, IntfDirTemplate, IfTemplate,
   LCLUnitsDir, LCLUnitsCPUOSDir, LCLUnitsCPUOSWidgetSetDir,
   SubTempl: TDefineTemplate;
-  TargetOS, SrcOS, SrcPath: string;
+  TargetOS, SrcOS, SrcPath, IncPath: string;
   i: Integer;
   CurCPU, CurOS, CurWidgetSet, ExtraSrcPath: string;
   ElseTemplate: TDefineTemplate;
@@ -3810,6 +3810,7 @@ begin
   TargetOS:='$('+ExternalMacroStart+'TargetOS)';
   SrcOS:='$('+ExternalMacroStart+'SrcOS)';
   SrcPath:='$('+ExternalMacroStart+'SrcPath)';
+  IncPath:='$('+ExternalMacroStart+'IncPath)';
 
   // <LazarusSrcDir>
   MainDir:=TDefineTemplate.Create(
@@ -4110,7 +4111,7 @@ begin
   MainDir.AddChild(DirTempl);
   
   // <LazarusSrcDir>/lcl/forms
-  LCLWidgetSetDir:=TDefineTemplate.Create('Forms',Format(ctsNamedDirectory,['WidgetSet']),
+  LCLWidgetSetDir:=TDefineTemplate.Create('forms',Format(ctsNamedDirectory,['WidgetSet']),
     '','forms',da_Directory);
   LCLWidgetSetDir.AddChild(TDefineTemplate.Create('LCL path addition',
     Format(ctsAddsDirToSourcePath,['..']),
@@ -4118,7 +4119,7 @@ begin
   DirTempl.AddChild(LCLWidgetSetDir);
 
   // <LazarusSrcDir>/lcl/widgetset
-  LCLWidgetSetDir:=TDefineTemplate.Create('WidgetSet',Format(ctsNamedDirectory,['WidgetSet']),
+  LCLWidgetSetDir:=TDefineTemplate.Create('widgetset',Format(ctsNamedDirectory,['WidgetSet']),
     '','widgetset',da_Directory);
   LCLWidgetSetDir.AddChild(TDefineTemplate.Create('LCL path addition',
     Format(ctsAddsDirToSourcePath,['..']),
@@ -4126,7 +4127,7 @@ begin
   DirTempl.AddChild(LCLWidgetSetDir);
 
   // <LazarusSrcDir>/lcl/units
-  LCLUnitsDir:=TDefineTemplate.Create('Units',Format(ctsNamedDirectory,['Units']),
+  LCLUnitsDir:=TDefineTemplate.Create('units',Format(ctsNamedDirectory,['Units']),
     '','units',da_Directory);
   DirTempl.AddChild(LCLUnitsDir);
   for i:=Low(Lazarus_CPU_OS_Widget_Combinations)
@@ -4170,17 +4171,19 @@ begin
   end;
 
   // <LazarusSrcDir>/lcl/interfaces
-  SubDirTempl:=TDefineTemplate.Create('WidgetDirectory',
+  SubDirTempl:=TDefineTemplate.Create('interfaces',
     ctsWidgetDirectory,'','interfaces',da_Directory);
   // add lcl to the source path of all widget set directories
   SubDirTempl.AddChild(TDefineTemplate.Create('LCL Path',
     Format(ctsAddsDirToSourcePath,['lcl']),ExternalMacroStart+'SrcPath',
-    LazarusSrcDir+d('/lcl;')+LazarusSrcDir+d('/lcl/widgetset;')+SrcPath,
+    LazarusSrcDir+d('/lcl;')
+    +LazarusSrcDir+d('/lcl/widgetset;')
+    +SrcPath,
     da_DefineRecurse));
   DirTempl.AddChild(SubDirTempl);
   
   // <LazarusSrcDir>/lcl/interfaces/gtk
-  IntfDirTemplate:=TDefineTemplate.Create('gtkIntfDirectory',
+  IntfDirTemplate:=TDefineTemplate.Create('gtk',
     ctsIntfDirectory,'','gtk',da_Directory);
     // if LCLWidgetType=gtk2
     IfTemplate:=TDefineTemplate.Create('IF '''+WidgetType+'''=''gtk2''',
@@ -4188,6 +4191,12 @@ begin
       // then define gtk2
       IfTemplate.AddChild(TDefineTemplate.Create('Define gtk2',
         ctsDefineMacroGTK2,'gtk2','',da_Define));
+      IfTemplate.AddChild(TDefineTemplate.Create('add gtk2 to unit path',
+        Format(ctsAddsDirToSourcePath,[d('../gtk2')]),ExternalMacroStart+'SrcPath',
+        d('../gtk2;')+SrcPath,da_Define));
+      IfTemplate.AddChild(TDefineTemplate.Create('adds gtk2 as include path',
+        Format(ctsAddsDirToIncludePath,[d('../gtk2')]),ExternalMacroStart+'IncPath',
+        d('../gtk2;')+IncPath,da_Define));
     IntfDirTemplate.AddChild(IfTemplate);
     // else LCLWidgetType=gtk2
     ElseTemplate:=TDefineTemplate.Create('ELSE',
@@ -4199,7 +4208,7 @@ begin
   SubDirTempl.AddChild(IntfDirTemplate);
 
   // <LazarusSrcDir>/lcl/interfaces/gtk2
-  IntfDirTemplate:=TDefineTemplate.Create('gtk2IntfDirectory',
+  IntfDirTemplate:=TDefineTemplate.Create('gtk2',
     ctsGtk2IntfDirectory,'','gtk2',da_Directory);
   // add '../gtk' to the SrcPath
   IntfDirTemplate.AddChild(TDefineTemplate.Create('SrcPath',
@@ -4208,7 +4217,7 @@ begin
   SubDirTempl.AddChild(IntfDirTemplate);
   
   // <LazarusSrcDir>/lcl/interfaces/gnome
-  IntfDirTemplate:=TDefineTemplate.Create('gnomeIntfDirectory',
+  IntfDirTemplate:=TDefineTemplate.Create('gnome',
     ctsGnomeIntfDirectory,'','gnome',da_Directory);
   // add '../gtk' to the SrcPath
   IntfDirTemplate.AddChild(TDefineTemplate.Create('SrcPath',
@@ -4227,7 +4236,7 @@ begin
   // no special
 
   // <LazarusSrcDir>/lcl/interfaces/wince
-  IntfDirTemplate:=TDefineTemplate.Create('winceIntfDirectory',
+  IntfDirTemplate:=TDefineTemplate.Create('wince',
     ctsIntfDirectory,'','wince',da_Directory);
     // then define wince1
     IntfDirTemplate.AddChild(TDefineTemplate.Create('Define wince1',
@@ -4235,7 +4244,7 @@ begin
   SubDirTempl.AddChild(IntfDirTemplate);
 
   // <LazarusSrcDir>/lcl/interfaces/carbon
-  IntfDirTemplate:=TDefineTemplate.Create('carbonIntfDirectory',
+  IntfDirTemplate:=TDefineTemplate.Create('carbon',
     ctsIntfDirectory,'','carbon',da_Directory);
     // then define carbon1
     IntfDirTemplate.AddChild(TDefineTemplate.Create('Define carbon1',
@@ -4243,7 +4252,7 @@ begin
   SubDirTempl.AddChild(IntfDirTemplate);
 
   // <LazarusSrcDir>/lcl/interfaces/qt
-  IntfDirTemplate:=TDefineTemplate.Create('qtIntfDirectory',
+  IntfDirTemplate:=TDefineTemplate.Create('qt',
     ctsIntfDirectory,'','qt',da_Directory);
     // then define qt1
     IntfDirTemplate.AddChild(TDefineTemplate.Create('Define qt1',

components/codetools/expreval.pas

@@ -294,7 +294,7 @@ begin
       end else if (CompAtom('NOT')) then begin
         Result:=EvalAtPos();
         if ErrorPos>=0 then exit;
-        // Note: for Delphi compatibility: "IF not NotDefined" is valid
+        // Note: for Delphi compatibility: "IF not UndefinedVariable" is valid
         if (Result='0') then Result:='1'
         else Result:='0';
         exit;
@@ -309,8 +309,7 @@ begin
           ErrorPos:=CurPos;
           exit;
         end;
-        Result:=Variables[copy(Expr,AtomStart,AtomEnd-AtomStart)];
+        if IsDefined(copy(Expr,AtomStart,AtomEnd-AtomStart)) then
-        if Result<>'' then
           Result:='1'
         else
           Result:='0';

lcl/interfaces/gtk/gtkcallback.inc

@@ -78,6 +78,7 @@ var
   {$ENDIF}
 begin
   if (not RepaintAll) and ((Area^.Width<1) or (Area^.Width<1)) then exit;
+
   MSG.Msg := LM_GtkPAINT;
   MSG.Data:=TLMGtkPaintData.Create;
   MSG.Data.Widget := Widget;
@@ -462,7 +463,7 @@ function gtkExposeEventAfter(Widget: PGtkWidget; Event : PGDKEventExpose;
 var
   DesignOnlySignal: boolean;
   {$IFDEF GTK2}
-  children: PGList;
+  //children: PGList;
   {$ENDIF}
 begin
   Result := CallBackDefaultReturn;
@@ -485,13 +486,16 @@ begin
   end;
 
   //DebugLn(['gtkExposeEventAfter ',GetWidgetDebugReport(Widget),' ',dbgGRect(@Event^.Area)]);
-  
+
   // the expose area is ok, but some gtk widgets repaints everything on expose
   // -> maximize the area
   DeliverGtkPaintMessage(Data,Widget,@Event^.Area,true);
   {$IFDEF GTK2}
   // Some widgets in gtk2 don't have their own exclusive "windows" so a synthetic event must be sent
-  if GTK_IS_FIXED(Widget) then begin
+  // MG: That is already done by the gtk2. For which widgets does this not work?
+  //     Enabling this results in double painting, which is slower and
+  //     wrong for anitaliased text.
+  {if GTK_IS_FIXED(Widget) then begin
     children := gtk_container_get_children(PGtkContainer(Widget));
     while children <> nil do begin
       if (children^.data <> nil) then begin
@@ -502,7 +506,7 @@ begin
       end;
     end;
     g_list_free(children);
-  end;
+  end;}
   {$ENDIF}
 end;
 
@@ -1067,7 +1071,7 @@ begin
 
   if TObject(Data) is TCustomForm then begin
     TheForm := TCustomForm(Data);
-    DebugLn(['GTKWindowStateEventCB ',DbgSName(TheForm),' new_window_state=',state^.new_window_state,' changed_mask=',state^.changed_mask]);
+    //DebugLn(['GTKWindowStateEventCB ',DbgSName(TheForm),' new_window_state=',state^.new_window_state,' changed_mask=',state^.changed_mask]);
     if TheForm.Parent = nil then begin (* toplevel window, just as a sanity check *)
       if GTK_WIDGET_REALIZED(Widget) then begin
         // send a WMSize Message (see TCustomForm.WMSize)
@@ -1075,7 +1079,7 @@ begin
         if GtkWidth<0 then GtkWidth:=0;
         GtkHeight:=Widget^.Allocation.Height;
         if GtkHeight<0 then GtkHeight:=0;
-        debugln('GTKWindowStateEventCB ',DbgSName(TObject(Data)),' ',dbgs(state^.new_window_state),' ',WidgetFlagsToString(Widget));
+        //debugln('GTKWindowStateEventCB ',DbgSName(TObject(Data)),' ',dbgs(state^.new_window_state),' ',WidgetFlagsToString(Widget));
         if ((GDK_WINDOW_STATE_ICONIFIED and state^.new_window_state)>0) then begin
           {$IFDEF HasX}
           NetAtom := gdk_atom_intern('_NET_WM_DESKTOP', True);

lcl/interfaces/gtk/gtkproc.inc

@@ -611,6 +611,16 @@ begin
       Result:=Result+'St';
     if  GTK_WIDGET_PARENT_SENSITIVE(Widget) then
       Result:=Result+'Pr';
+    {$IFDEF Gtk2}
+    if GTK_WIDGET_NO_WINDOW(Widget) then
+      Result:=Result+'Nw';
+    if GTK_WIDGET_COMPOSITE_CHILD(Widget) then
+      Result:=Result+'Cc';
+    if GTK_WIDGET_APP_PAINTABLE(Widget) then
+      Result:=Result+'Ap';
+    if GTK_WIDGET_DOUBLE_BUFFERED(Widget) then
+      Result:=Result+'Db';
+    {$ENDIF}
   end;
   Result:=Result+']';
 end;

lcl/interfaces/gtk2/gtk2object.inc

@@ -284,11 +284,8 @@ function TGtk2WidgetSet.CreateComponent(Sender : TObject): THandle;
 var
   p: PGtkWidget;                 // ptr to the newly created GtkWidget
   CompStyle: integer;            // componentstyle (type) of GtkWidget which will be created
-  SetupProps : boolean;
 begin
   p := nil;
-  SetupProps:= false;
-
   CompStyle := GetCompStyle(Sender);
 
   case CompStyle of
@@ -303,7 +300,7 @@ begin
       Exit;
     end;
   end; //end case
-  FinishComponentCreate(Sender, P, SetupProps);
+  FinishComponentCreate(Sender, P);
   Result := THandle(P);
 end;
 

lcl/interfaces/gtk2/gtk2winapi.inc

@@ -68,8 +68,8 @@ function TGtk2WidgetSet.CreateCursor(ACursorInfo: PIconInfo): hCursor;
 var
   pixmap: PGdkPixmap;
   bitmap: PGdkBitmap;
-  w, h: integer;
+  Width, Height: integer;
-  max_w, max_h: guint;
+  MaxWidth, MaxHeight: guint;
   pixbuf, masked_pixbuf: PGdkPixbuf;
 begin
   Result := 0;
@@ -78,20 +78,21 @@ begin
   pixmap := PGDIObject(ACursorInfo^.hbmColor)^.GDIBitmapObject;
   bitmap := PGDIObject(ACursorInfo^.hbmColor)^.GDIBitmapMaskObject;
 
-  gdk_drawable_get_size(pixmap, @w, @h);
+  gdk_drawable_get_size(pixmap, @Width, @Height);
-  gdk_display_get_maximal_cursor_size(gdk_display_get_default, @max_w, @max_h);
+  gdk_display_get_maximal_cursor_size(gdk_display_get_default,
+                                      @MaxWidth, @MaxHeight);
   
-  if (w > max_w) or (h > max_h) then
+  if (Width > integer(MaxWidth)) or (Height > integer(MaxHeight)) then
     exit;
 
 {
-  max_w := gdk_display_get_default_cursor_size(gdk_display_get_default);
+  MaxWidth := gdk_display_get_default_cursor_size(gdk_display_get_default);
-  if (w > max_w) or (h > max_w) then
+  if (Width > MaxWidth) or (Height > MaxWidth) then
-    DebugLn(['CreateCursor cursor size:',w,'x',h,' > default size:', max_w]);
+    DebugLn(['CreateCursor cursor size:',Width,'x',Height,' > default size:', MaxWidth]);
 }
 
   // create alpha pixbuf
-  pixbuf := gdk_pixbuf_new(GDK_COLORSPACE_RGB, True, 8, w, h);
+  pixbuf := gdk_pixbuf_new(GDK_COLORSPACE_RGB, True, 8, Width, Height);
 
   // fill pixbuf from pixmap
   gdk_pixbuf_get_from_drawable(pixbuf, pixmap, nil, 0, 0, 0, 0, -1, -1);

lcl/interfaces/gtk2/gtk2wsstdctrls.pp

@@ -415,7 +415,6 @@ class procedure TGtk2WSCustomListBox.SetFont(const AWinControl: TWinControl;
   const AFont: TFont);
 var
   Widget: PGtkWidget;
-  Selection: PGtkTreeSelection;
 begin
   Widget:=GetWidgetInfo(Pointer(AWinControl.Handle),True)^.CoreWidget;
 
@@ -599,21 +598,14 @@ end;
 class function TGtk2WSCustomEdit.CreateHandle(const AWinControl: TWinControl;
   const AParams: TCreateParams): TLCLIntfHandle;
 var
-
   p: PGtkWidget;                 // ptr to the newly created GtkWidget
-  SetupProps : boolean;
-
-
 begin
-   SetupProps := false;
    p :=  gtk_entry_new();
    gtk_editable_set_editable (PGtkEditable(P), not TCustomEdit(AWinControl).ReadOnly);
    gtk_widget_show_all(P);
    Result := TLCLIntfHandle(P);
    if result = 0 then exit;
-   gtk2WidgetSet.FinishComponentCreate(AWinControl, P, SetupProps);
+   gtk2WidgetSet.FinishComponentCreate(AWinControl, P);
-
-
 end;
 
 

lcl/interfaces/gtk2/tests/checkbuttononfixed.lpi

@@ -0,0 +1,44 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="/"/>
+    <Version Value="5"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <IconPath Value="./"/>
+      <TargetFileExt Value=""/>
+    </General>
+    <VersionInfo>
+      <ProjectVersion Value=""/>
+    </VersionInfo>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="checkbuttononfixed.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="CheckButtonOnFixed"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="5"/>
+    <CodeGeneration>
+      <Generate Value="Faster"/>
+    </CodeGeneration>
+    <Other>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+</CONFIG>

lcl/interfaces/gtk2/tests/checkbuttononfixed.lpr

@@ -0,0 +1,60 @@
+program CheckButtonOnFixed;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, Gtk2, Gdk2, Glib2;
+
+function gtkExposeEventAfter(Widget: PGtkWidget; Event : PGDKEventExpose;
+  Data: gPointer): GBoolean; cdecl;
+var
+  children: PGList;
+begin
+  Result:=false;
+  writeln('gtkExposeEventAfter ',PChar(Data));
+
+  // Some widgets in gtk2 don't have their own exclusive "windows" so a synthetic event must be sent
+  // MG: That is already done by the gtk2. For which widgets does this not work?
+  //     Enabling this results in double painting, which is slower and
+  //     wrong for anitaliased text.
+  if GTK_IS_FIXED(Widget) then begin
+    children := gtk_container_get_children(PGtkContainer(Widget));
+    while children <> nil do begin
+      if (children^.data <> nil) then begin
+        if GTK_WIDGET_NO_WINDOW(PGtkWidget(children^.data)) then
+          gtk_container_propagate_expose(PGtkContainer(Widget), PGtkWidget(children^.data), Event);
+        if children^.next = nil then break;
+        children := children^.next;
+      end;
+    end;
+    g_list_free(children);
+  end;
+end;
+
+var
+  GtkWindow: PGtkWidget;
+  GtkFixed: PGtkWidget;
+  GtkCheckButton: PGtkWidget;
+  FixedName: String;
+  CheckButtonName: String;
+begin
+  gtk_init(@ARGC,@ARGV);
+  GtkWindow:=gtk_window_new(GTK_WINDOW_TOPLEVEL);
+  GtkFixed := gtk_fixed_new ();
+  gtk_fixed_set_has_window(PGtkFixed(GtkFixed), True);
+  FixedName:='GtkFixed';
+  g_signal_connect_after(PGtkObject(GtkFixed), 'expose-event',
+                         TGTKSignalFunc(@gtkExposeEventAfter), PChar(FixedName));
+
+  gtk_container_add (PGtkContainer(GtkWindow), GtkFixed);
+  
+  GtkCheckButton:=gtk_check_button_new_with_label('Second');
+  CheckButtonName:='GtkCheckButton';
+  g_signal_connect_after(PGtkObject(GtkCheckButton), 'expose-event',
+                         TGTKSignalFunc(@gtkExposeEventAfter), PChar(CheckButtonName));
+  gtk_fixed_put(PGtkFixed(GtkFixed),GtkCheckButton,10,10);
+  
+  gtk_widget_show_all(GtkWindow);
+  gtk_main;
+end.
+

lcl/tests/test1_5checkbox.lpi

@@ -36,9 +36,6 @@
   </ProjectOptions>
   <CompilerOptions>
     <Version Value="5"/>
-    <SearchPaths>
-      <LCLWidgetType Value="gtk2"/>
-    </SearchPaths>
     <CodeGeneration>
       <Checks>
         <IOChecks Value="True"/>

lcl/tests/test1_6checkgroup.lpi

@@ -0,0 +1,52 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="/"/>
+    <Version Value="5"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <IconPath Value="./"/>
+      <TargetFileExt Value=""/>
+      <Title Value="test1_6checkgroup"/>
+    </General>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="LCL"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="test1_6checkgroup.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="test1_6checkgroup"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="5"/>
+    <CodeGeneration>
+      <Checks>
+        <IOChecks Value="True"/>
+        <RangeChecks Value="True"/>
+        <OverflowChecks Value="True"/>
+        <StackChecks Value="True"/>
+      </Checks>
+      <Generate Value="Faster"/>
+    </CodeGeneration>
+    <Other>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+</CONFIG>

lcl/tests/test1_6checkgroup.lpr

@@ -0,0 +1,416 @@
+{
+ *****************************************************************************
+ *                                                                           *
+ *  This file is part of the Lazarus Component Library (LCL)                 *
+ *                                                                           *
+ *  See the file COPYING.LCL, included in this distribution,                 *
+ *  for details about the copyright.                                         *
+ *                                                                           *
+ *  This program is distributed in the hope that it will be useful,          *
+ *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
+ *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
+ *                                                                           *
+ *****************************************************************************
+ 
+  LCL Test 1_6
+
+  Showing a form at 0,0,320,240 with a single TCheckGroup at 5,10,175x125
+}
+program test1_6checkgroup;
+
+{$mode objfpc}{$H+}
+
+uses
+  Interfaces, FPCAdds, LCLProc, LCLType, Classes, Controls, Forms, TypInfo,
+  LMessages, StdCtrls, ExtCtrls, Buttons;
+
+type
+
+  { TForm1 }
+
+  TForm1 = class(TForm)
+    CheckGroup1: TCheckGroup;
+    procedure CheckGroup1ChangeBounds(Sender: TObject);
+    procedure CheckGroup1Click(Sender: TObject);
+    procedure CheckGroup1DblClick(Sender: TObject);
+    procedure CheckGroup1Enter(Sender: TObject);
+    procedure CheckGroup1Exit(Sender: TObject);
+    procedure CheckGroup1ItemClick(Sender: TObject; Index: integer);
+    procedure CheckGroup1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
+      );
+    procedure CheckGroup1KeyPress(Sender: TObject; var Key: char);
+    procedure CheckGroup1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
+    procedure CheckGroup1MouseDown(Sender: TOBject; Button: TMouseButton;
+      Shift: TShiftState; X, Y: Integer);
+    procedure CheckGroup1MouseEnter(Sender: TObject);
+    procedure CheckGroup1MouseLeave(Sender: TObject);
+    procedure CheckGroup1MouseMove(Sender: TObject; Shift: TShiftState; X,
+      Y: Integer);
+    procedure CheckGroup1MouseUp(Sender: TOBject; Button: TMouseButton;
+      Shift: TShiftState; X, Y: Integer);
+    procedure CheckGroup1Resize(Sender: TObject);
+    procedure Form1Activate(Sender: TObject);
+    procedure Form1ChangeBounds(Sender: TObject);
+    procedure Form1Click(Sender: TObject);
+    procedure Form1Close(Sender: TObject; var CloseAction: TCloseAction);
+    procedure Form1CloseQuery(Sender: TObject; var CanClose: boolean);
+    procedure Form1Create(Sender: TObject);
+    procedure Form1Deactivate(Sender: TObject);
+    procedure Form1Enter(Sender: TObject);
+    procedure Form1Exit(Sender: TObject);
+    function Form1Help(Command: Word; Data: Longint; var CallHelp: Boolean
+      ): Boolean;
+    procedure Form1Hide(Sender: TObject);
+    procedure Form1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+    procedure Form1KeyPress(Sender: TObject; var Key: char);
+    procedure Form1MouseDown(Sender: TOBject; Button: TMouseButton;
+      Shift: TShiftState; X, Y: Integer);
+    procedure Form1MouseEnter(Sender: TObject);
+    procedure Form1MouseLeave(Sender: TObject);
+    procedure Form1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer
+      );
+    procedure Form1MouseUp(Sender: TOBject; Button: TMouseButton;
+      Shift: TShiftState; X, Y: Integer);
+    procedure Form1MouseWheel(Sender: TObject; Shift: TShiftState;
+      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
+    procedure Form1MouseWheelDown(Sender: TObject; Shift: TShiftState;
+      MousePos: TPoint; var Handled: Boolean);
+    procedure Form1MouseWheelUp(Sender: TObject; Shift: TShiftState;
+      MousePos: TPoint; var Handled: Boolean);
+    procedure Form1Paint(Sender: TObject);
+    procedure Form1Resize(Sender: TObject);
+    procedure Form1Shortcut(var Msg: TLMKey; var Handled: Boolean);
+    procedure Form1Show(Sender: TObject);
+    procedure Form1UTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
+  public
+    constructor Create(TheOwner: TComponent); override;
+    function GetChecks(ACheckGroup: TCheckGroup): string;
+  end;
+
+{ TForm1 }
+
+procedure TForm1.CheckGroup1ChangeBounds(Sender: TObject);
+begin
+  debugln('TForm1.CheckGroup1ChangeBounds ',DbgSName(Sender),' Bounds=',dbgs(TControl(Sender).BoundsRect));
+end;
+
+procedure TForm1.CheckGroup1Click(Sender: TObject);
+begin
+  debugln('TForm1.CheckGroup1Click ',DbgSName(Sender),' '+GetChecks(Sender as TCheckGroup));
+end;
+
+procedure TForm1.CheckGroup1DblClick(Sender: TObject);
+begin
+  DebugLn(['TForm1.CheckGroup1DblClick ',DbgSName(Sender)]);
+end;
+
+procedure TForm1.CheckGroup1Enter(Sender: TObject);
+begin
+  debugln('TForm1.CheckGroup1Enter ',DbgSName(Sender));
+end;
+
+procedure TForm1.CheckGroup1Exit(Sender: TObject);
+begin
+  debugln('TForm1.CheckGroup1Exit ',DbgSName(Sender));
+end;
+
+procedure TForm1.CheckGroup1ItemClick(Sender: TObject; Index: integer);
+begin
+  DebugLn(['TForm1.CheckGroup1ItemClick ',DbgSName(Sender),' Index=',Index]);
+end;
+
+procedure TForm1.CheckGroup1KeyDown(Sender: TObject; var Key: Word;
+  Shift: TShiftState);
+begin
+  Debugln('TForm1.CheckGroup1KeyDown ',DbgSName(Sender),' Key=',dbgs(Key),
+          ' Shift=',dbgs(Shift),' '+GetChecks(Sender as TCheckGroup));
+end;
+
+procedure TForm1.CheckGroup1KeyPress(Sender: TObject; var Key: char);
+begin
+  debugln('TForm1.CheckGroup1KeyPress ',DbgSName(Sender),' Key=',DbgStr(Key),
+    ' ',GetChecks(Sender as TCheckGroup));
+end;
+
+procedure TForm1.CheckGroup1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState
+  );
+begin
+  Debugln('TForm1.CheckGroup1KeyUp ',DbgSName(Sender),' Key=',dbgs(Key),
+          ' Shift=',dbgs(Shift),' ',GetChecks(Sender as TCheckGroup));
+end;
+
+procedure TForm1.CheckGroup1MouseDown(Sender: TOBject; Button: TMouseButton;
+  Shift: TShiftState; X, Y: Integer);
+begin
+  debugln('TForm1.CheckGroup1MouseDown ',DbgSName(Sender),
+    ' Button=',GetEnumName(TypeInfo(TMouseButton),ord(Button)),
+    ' X=',dbgs(X),' Y=',dbgs(Y),' Shift=',dbgs(Shift),' ',
+    GetChecks(Sender as TCheckGroup));
+end;
+
+procedure TForm1.CheckGroup1MouseEnter(Sender: TObject);
+begin
+  debugln('TForm1.CheckGroup1MouseEnter ',DbgSName(Sender),' ',GetChecks(Sender as TCheckGroup));
+end;
+
+procedure TForm1.CheckGroup1MouseLeave(Sender: TObject);
+begin
+  debugln('TForm1.CheckGroup1MouseLeave ',DbgSName(Sender));
+end;
+
+procedure TForm1.CheckGroup1MouseMove(Sender: TObject; Shift: TShiftState; X,
+  Y: Integer);
+begin
+  debugln('TForm1.CheckGroup1MouseMove ',DbgSName(Sender),
+    ' X=',dbgs(X),' Y=',dbgs(Y),' Shift=',dbgs(Shift));
+end;
+
+procedure TForm1.CheckGroup1MouseUp(Sender: TOBject; Button: TMouseButton;
+  Shift: TShiftState; X, Y: Integer);
+begin
+  debugln('TForm1.CheckGroup1MouseUp ',DbgSName(Sender),
+    ' Button=',GetEnumName(TypeInfo(TMouseButton),ord(Button)),
+    ' X=',dbgs(X),' Y=',dbgs(Y),' Shift=',dbgs(Shift),' ',
+    GetChecks(Sender as TCheckGroup));
+end;
+
+procedure TForm1.CheckGroup1Resize(Sender: TObject);
+begin         ;
+  debugln('TForm1.CheckGroup1Resize ',DbgSName(Sender),' Bounds=',dbgs(TControl(Sender).BoundsRect));
+end;
+
+procedure TForm1.Form1Activate(Sender: TObject);
+begin
+  debugln('TForm1.Form1Activate ',DbgSName(Sender));
+end;
+
+procedure TForm1.Form1ChangeBounds(Sender: TObject);
+begin
+  debugln('TForm1.Form1ChangeBounds ',DbgSName(Sender),' Bounds=',dbgs(BoundsRect));
+end;
+
+procedure TForm1.Form1Click(Sender: TObject);
+begin
+  debugln('TForm1.Form1Click ',DbgSName(Sender));
+end;
+
+procedure TForm1.Form1Close(Sender: TObject; var CloseAction: TCloseAction);
+begin
+  debugln('TForm1.Form1Close ',DbgSName(Sender),' CloseAction=',
+          GetEnumName(TypeInfo(TCloseAction),ord(CloseAction)));
+end;
+
+procedure TForm1.Form1CloseQuery(Sender: TObject; var CanClose: boolean);
+begin
+  debugln('TForm1.Form1CloseQuery ',DbgSName(Sender),' CanClose',dbgs(CanClose));
+end;
+
+procedure TForm1.Form1Create(Sender: TObject);
+begin
+  debugln('TForm1.Form1Create ',DbgSName(Sender));
+end;
+
+procedure TForm1.Form1Deactivate(Sender: TObject);
+begin
+  debugln('TForm1.Form1Deactivate ',DbgSName(Sender));
+end;
+
+procedure TForm1.Form1Enter(Sender: TObject);
+begin
+  debugln('TForm1.Form1Enter ',DbgSName(Sender));
+end;
+
+procedure TForm1.Form1Exit(Sender: TObject);
+begin
+  debugln('TForm1.Form1Exit ',DbgSName(Sender));
+end;
+
+function TForm1.Form1Help(Command: Word; Data: Longint; var CallHelp: Boolean
+  ): Boolean;
+begin
+  debugln('TForm1.Form1Help Command=',dbgs(Command),' Data=',HexStr(Cardinal(Data),8),' CallHelp=',dbgs(CallHelp));
+  Result:=false;
+end;
+
+procedure TForm1.Form1Hide(Sender: TObject);
+begin
+  debugln('TForm1.Form1Hide ',DbgSName(Sender));
+end;
+
+procedure TForm1.Form1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
+  );
+begin
+  Debugln('TForm1.Form1KeyDown ',DbgSName(Sender),' Key=',dbgs(Key),
+          ' Shift=',dbgs(Shift));
+end;
+
+procedure TForm1.Form1KeyPress(Sender: TObject; var Key: char);
+begin
+  debugln('TForm1.Form1KeyPress ',DbgSName(Sender),' Key=',DbgStr(Key));
+end;
+
+procedure TForm1.Form1MouseDown(Sender: TOBject; Button: TMouseButton;
+  Shift: TShiftState; X, Y: Integer);
+begin
+  debugln('TForm1.Form1MouseDown ',DbgSName(Sender),
+    ' Button=',GetEnumName(TypeInfo(TMouseButton),ord(Button)),
+    ' X=',dbgs(X),' Y=',dbgs(Y),' Shift=',dbgs(Shift));
+end;
+
+procedure TForm1.Form1MouseEnter(Sender: TObject);
+begin
+  debugln('TForm1.Form1MouseEnter ',DbgSName(Sender));
+end;
+
+procedure TForm1.Form1MouseLeave(Sender: TObject);
+begin
+  debugln('TForm1.Form1MouseLeave ',DbgSName(Sender));
+end;
+
+procedure TForm1.Form1MouseMove(Sender: TObject; Shift: TShiftState; X,
+  Y: Integer);
+begin
+  debugln('TForm1.Form1MouseMove ',DbgSName(Sender),
+    ' X=',dbgs(X),' Y=',dbgs(Y),' Shift=',dbgs(Shift));
+end;
+
+procedure TForm1.Form1MouseUp(Sender: TOBject; Button: TMouseButton;
+  Shift: TShiftState; X, Y: Integer);
+begin
+  debugln('TForm1.Form1MouseUp ',DbgSName(Sender),
+    ' Button=',GetEnumName(TypeInfo(TMouseButton),ord(Button)),
+    ' X=',dbgs(X),' Y=',dbgs(Y),' Shift=',dbgs(Shift));
+end;
+
+procedure TForm1.Form1MouseWheel(Sender: TObject; Shift: TShiftState;
+  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
+begin
+  debugln('TForm1.Form1MouseWheel ',DbgSName(Sender),
+    ' WheelDelta=',dbgs(WheelDelta),' MousePos=',dbgs(MousePos),
+    ' Handled=',dbgs(Handled),' Shift=',dbgs(Shift));
+end;
+
+procedure TForm1.Form1MouseWheelDown(Sender: TObject; Shift: TShiftState;
+  MousePos: TPoint; var Handled: Boolean);
+begin
+  debugln('TForm1.Form1MouseWheelDown ',DbgSName(Sender),
+    ' MousePos=',dbgs(MousePos),
+    ' Handled=',dbgs(Handled),' Shift=',dbgs(Shift));
+end;
+
+procedure TForm1.Form1MouseWheelUp(Sender: TObject; Shift: TShiftState;
+  MousePos: TPoint; var Handled: Boolean);
+begin
+  debugln('TForm1.Form1MouseWheelUp ',DbgSName(Sender),
+    ' MousePos=',dbgs(MousePos),
+    ' Handled=',dbgs(Handled),' Shift=',dbgs(Shift));
+end;
+
+procedure TForm1.Form1Paint(Sender: TObject);
+begin
+  debugln('TForm1.Form1Paint ',DbgSName(Sender));
+end;
+
+procedure TForm1.Form1Resize(Sender: TObject);
+begin
+  debugln('TForm1.Form1Resize ',DbgSName(Sender),' Bounds=',dbgs(TControl(Sender).BoundsRect));
+end;
+
+procedure TForm1.Form1Shortcut(var Msg: TLMKey; var Handled: Boolean);
+begin
+  debugln('TForm1.Form1Shortcut Msg.CharCode=',dbgs(Msg.CharCode),
+          ' Handled=',dbgs(Handled));
+end;
+
+procedure TForm1.Form1Show(Sender: TObject);
+begin
+  debugln('TForm1.Form1Show ',DbgSName(Sender));
+end;
+
+procedure TForm1.Form1UTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
+begin
+  debugln('TForm1.Form1UTF8KeyPress ',DbgSName(Sender),' UTF8Key="',DbgStr(UTF8Key),'"');
+end;
+
+constructor TForm1.Create(TheOwner: TComponent);
+begin
+  OnActivate:=@Form1Activate;
+  OnChangeBounds:=@Form1ChangeBounds;
+  OnClick:=@Form1Click;
+  OnClose:=@Form1Close;
+  OnCloseQuery:=@Form1CloseQuery;
+  OnCreate:=@Form1Create;
+  OnDeactivate:=@Form1Deactivate;
+  OnEnter:=@Form1Enter;
+  OnExit:=@Form1Exit;
+  OnHelp:=@Form1Help;
+  OnHide:=@Form1Hide;
+  OnKeyDown:=@Form1KeyDown;
+  OnKeyDown:=@Form1KeyDown;
+  OnKeyPress:=@Form1KeyPress;
+  OnMouseDown:=@Form1MouseDown;
+  OnMouseEnter:=@Form1MouseEnter;
+  OnMouseLeave:=@Form1MouseLeave;
+  OnMouseMove:=@Form1MouseMove;
+  OnMouseUp:=@Form1MouseUp;
+  OnMouseWheel:=@Form1MouseWheel;
+  OnMouseWheelDown:=@Form1MouseWheelDown;
+  OnMouseWheelUp:=@Form1MouseWheelUp;
+  OnPaint:=@Form1Paint;
+  OnResize:=@Form1Resize;
+  OnShortcut:=@Form1Shortcut;
+  OnShow:=@Form1Show;
+  OnUTF8KeyPress:=@Form1UTF8KeyPress;
+  inherited Create(TheOwner);
+  
+  CheckGroup1:=TCheckGroup.Create(Self);
+  with CheckGroup1 do begin
+    Name:='CheckGroup1';
+    SetBounds(5,10,175,125);
+    Parent:=Self;
+    OnChangeBounds:=@CheckGroup1ChangeBounds;
+    OnClick:=@CheckGroup1Click;
+    OnDblClick:=@CheckGroup1DblClick;
+    OnEnter:=@CheckGroup1Enter;
+    OnExit:=@CheckGroup1Exit;
+    OnItemClick:=@CheckGroup1ItemClick;
+    OnKeyDown:=@CheckGroup1KeyDown;
+    OnKeyPress:=@CheckGroup1KeyPress;
+    OnKeyUp:=@CheckGroup1KeyUp;
+    OnMouseDown:=@CheckGroup1MouseDown;
+    OnMouseMove:=@CheckGroup1MouseMove;
+    OnMouseUp:=@CheckGroup1MouseUp;
+    OnResize:=@CheckGroup1Resize;
+    Items.Text:='First, Second'; //#10'Second'#10'Third'#10'Fourth';
+  end;
+end;
+
+function TForm1.GetChecks(ACheckGroup: TCheckGroup): string;
+var
+  i: Integer;
+begin
+  Result:='';
+  for i:=0 to ACheckGroup.Items.Count-1 do begin
+    if i>0 then
+      Result:=Result+' ';
+    Result:=Result+ACheckGroup.Items[i]+'=';
+    if ACheckGroup.Checked[i] then
+      Result:=Result+'+'
+    else
+      Result:=Result+'-';
+    if ACheckGroup.CheckEnabled[i] then
+      Result:=Result+'§'
+    else
+      Result:=Result+' ';
+  end;
+  Result:='['+Result+']';
+end;
+
+var
+  Form1: TForm1 = nil;
+begin
+  Application.Initialize;
+  Application.CreateForm(TForm1,Form1);
+  Application.Run;
+end.
+

lcl/widgetset/wscontrols.pp

@@ -139,7 +139,7 @@ begin
 end;
 
 class function TWSWinControl.CreateHandle(const AWinControl: TWinControl;
-  const AParams: TCreateParams): HWND;
+  const AParams: TCreateParams): TLCLIntfHandle;
 begin
   // For now default to the old creation routines
   Result := WidgetSet.CreateComponent(AWinControl);