NiceChart: Update delphi demo project

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8871 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/nicechart/demo/Delphi/Project1.dof

@@ -138,6 +138,5 @@ Comments=
 Count=1
 Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
 [HistoryLists\hlSearchPath]
-Count=2
+Count=1
 Item0=..\..\source
-Item1=D:\My\Comps\Commons

components/nicechart/source/NiceChart.pas

@@ -130,9 +130,13 @@ type
     FSmallMargin: Integer;
     FAxisDefSize: Integer;
     FLegendItemSize: Integer;
+    {$IFNDEF FPC}
+    FClipRgn: HRGN;
+    {$ENDIF}
     procedure InternalClear;
     procedure InternalPaint(ACanvas: TCanvas);
     procedure Calculate(AWidth, AHeight: Integer);
+    procedure DoCalculate(ACanvas: TCanvas; AWidth, AHeight: Integer);
     procedure DoPaint;
     procedure SetGridColor(const Value: TColor);
     procedure SetShowLegend(const Value: Boolean);
@@ -185,6 +189,7 @@ type
     procedure Changed;
     procedure ChartToClient(const AX, AY: Double; var X, Y: Integer);
     procedure CreateHandle; override;
+    procedure ClipToRect(ACanvas: TCanvas; const ARect: TRect; AEnable: Boolean);
     {$IFDEF FPC}
     procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; const AXProportion, AYProportion: Double); override;
     {$ENDIF}
@@ -355,8 +360,8 @@ procedure TNiceSeries.InternalClear;
 var
   x: Integer;
 begin
-  for x := 0 to Values.Count-1
-    do Dispose(PXYInfo(Values[x]));
+  for x := 0 to Values.Count-1 do
+    Dispose(PXYInfo(Values[x]));
   Values.Clear;
 end;
 
@@ -399,8 +404,8 @@ var
   x: Integer;
 begin
   Result := -MaxDouble;
-  for x := 0 to Values.Count-1
-    do Result := Max(Result, PXYInfo(Values[x])^.X);
+  for x := 0 to Values.Count-1 do
+    Result := Max(Result, PXYInfo(Values[x])^.X);
 end;
 
 function TNiceSeries.GetMinXValue: Double;
@@ -408,8 +413,8 @@ var
   x: Integer;
 begin
   Result := MaxDouble;
-  for x := 0 to Values.Count-1
-    do Result := Min(Result, PXYInfo(Values[x])^.X);
+  for x := 0 to Values.Count-1 do
+    Result := Min(Result, PXYInfo(Values[x])^.X);
 end;
 
 function TNiceSeries.GetMaxYValue: Double;
@@ -417,8 +422,8 @@ var
   x: Integer;
 begin
   Result := -MaxDouble;
-  for x := 0 to Values.Count-1
-    do Result := Max(Result, PXYInfo(Values[x])^.Y);
+  for x := 0 to Values.Count-1 do
+    Result := Max(Result, PXYInfo(Values[x])^.Y);
 end;
 
 function TNiceSeries.GetMinYValue: Double;
@@ -426,8 +431,8 @@ var
   x: Integer;
 begin
   Result := MaxDouble;
-  for x := 0 to Values.Count-1
-    do Result := Min(Result, PXYInfo(Values[x])^.Y);
+  for x := 0 to Values.Count-1 do
+    Result := Min(Result, PXYInfo(Values[x])^.Y);
 end;
 
 procedure TNiceSeries.SetCaption(const Value: string);
@@ -550,7 +555,7 @@ begin
   if FGridColor <> value then
   begin
     FGridColor := Value;
-    DoPaint;
+    Invalidate;
   end;
 end;
 
@@ -699,7 +704,7 @@ begin
   if (FShowXAxisLine <> Value) then
   begin
     FShowXAxisLine := Value;
-    DoPaint;
+    Invalidate;
   end;
 end;
 
@@ -708,7 +713,7 @@ begin
   if (FShowXGrid <> Value) then
   begin
     FShowXGrid := Value;
-    DoPaint;
+    Invalidate;
   end;  
 end;
 
@@ -717,7 +722,7 @@ begin
   if (FShowYAxisLine <> Value) then
   begin
     FShowYAxisLine := Value;
-    DoPaint;
+    Invalidate;
   end;
 end;
 
@@ -726,7 +731,7 @@ begin
   if (FShowYGrid <> Value) then
   begin
     FShowYGrid := Value;
-    DoPaint;
+    Invalidate;
   end;  
 end;
 
@@ -735,7 +740,7 @@ begin
   if (FTickLength <> Value) and (Value >= 0) then
   begin
     FTickLength := Value;
-    DoPaint;
+    Invalidate;
   end;
 end;
 
@@ -748,7 +753,7 @@ procedure TNiceChart.EndUpdate;
 begin
   FUpdating := False;
   Calculate(ClientWidth, ClientHeight);
-  DoPaint;
+  Invalidate;
 end;
 
 procedure TNiceChart.Changed;
@@ -756,7 +761,7 @@ begin
   if not FUpdating then
   begin
     Calculate(ClientWidth, ClientHeight);
-    DoPaint;
+    Invalidate;
   end;
 end;
 
@@ -904,6 +909,26 @@ begin
 end;
 
 procedure TNiceChart.Calculate(AWidth, AHeight: Integer);
+var
+  bmp: TBitmap;
+begin
+  if Canvas.HandleAllocated then
+    DoCalculate(Canvas, AWidth, AHeight)
+  else
+  begin
+    // Use an auxiliary bitmap in case of early calls when the Canvas has not handle, yet.
+    bmp := TBitmap.Create;
+    try
+      bmp.Width := AWidth;
+      bmp.Height := AHeight;
+      DoCalculate(bmp.Canvas, AWidth, AHeight);
+    finally
+      bmp.Free;
+    end;
+  end;
+end;
+
+procedure TNiceChart.DoCalculate(ACanvas: TCanvas; AWidth, AHeight: Integer);
 var
   x, w, h, y, g: Integer;
   Titled: Boolean;
@@ -920,24 +945,24 @@ begin
   Titled := False;
   if FShowTitle and (FTitle <> '') then
   begin
-    Canvas.Font.Assign(TitleFont);
-    w := Canvas.TextHeight(FTitle);
+    ACanvas.Font.Assign(TitleFont);
+    w := ACanvas.TextHeight(FTitle);
     RcTitle := Rect(RcChart.Left, RcChart.Top, RcChart.Right, RcChart.Left + w);
-    DrawText(Canvas.Handle, PChar(FTitle), Length(FTitle), RcTitle,
+    DrawText(ACanvas.Handle, PChar(FTitle), Length(FTitle), RcTitle,
       DT_CENTER or DT_VCENTER or DT_WORDBREAK or DT_CALCRECT);
     RcChart.Top := RcTitle.Bottom + FInnerMargin;
     Titled := True;
   end else
     SetRectEmpty(RcTitle);
 
-  Canvas.Font.Assign(FNormalFont);
-  h := Canvas.TextHeight('Ag');
+  ACanvas.Font.Assign(FNormalFont);
+  h := ACanvas.TextHeight('Ag');
   RcChart.Bottom := RcChart.Bottom - (2 * h) - FInnerMargin - FTickLength - FSmallmargin;
 
   BuildYAxis;
   w := 0;
-  for x := 0 to YAxis.Count-1
-    do w := Max(w, Canvas.TextWidth(PAxisInfo(YAxis[x])^.Caption));
+  for x := 0 to YAxis.Count-1 do
+    w := Max(w, ACanvas.TextWidth(PAxisInfo(YAxis[x])^.Caption));
   RcChart.Left := RcChart.Left + h + FInnerMargin + w + FTickLength + FSmallMargin;
   RcTitle.Left := RcChart.Left;
   RcTitle.Right := RcChart.Right;
@@ -945,16 +970,16 @@ begin
 
   if FShowLegend and (List.Count > 0) then
   begin
-    Canvas.Font.Assign(FNormalFont);
+    ACanvas.Font.Assign(FNormalFont);
     w := 0;
     h := FInnerMargin;
-    g := Canvas.TextHeight('Ag');
+    g := ACanvas.TextHeight('Ag');
     for x := 0 to List.Count-1 do
     begin
       TNiceSeries(List[x]).Top := h;
       Temp.Text := Trim(TNiceSeries(List[x]).FCaption);
-      for y := 0 to Temp.Count-1
-        do w := Max(w, Canvas.TextWidth(Trim(Temp[y])));
+      for y := 0 to Temp.Count-1 do
+        w := Max(w, ACanvas.TextWidth(Trim(Temp[y])));
       h := h + Max(FLegendItemSize, Temp.Count * g);
       if (x <> List.Count-1)
         then h := h + FSmallMargin;
@@ -1458,7 +1483,6 @@ end;
 
 //-----------------------------------------------------------------------------//
 
-
 procedure TNiceChart.DrawSeries(ACanvas: TCanvas; Index: Integer);
 var
   x: Integer;
@@ -1473,14 +1497,21 @@ begin
   begin
     if (sr.FKind = skBar) then
     begin
+      ClipToRect(ACanvas, RcChart, true);
+      try
         Pen.Width := 1;
         for x := 0 to Sr.Values.Count-1 do
         begin
           P := PXYInfo(Sr.Values[x]);
           Rectangle(P^.Rc);
         end;
+      finally
+        ClipToRect(ACanvas, RcChart, false);
+      end;
     end else
     begin
+      ClipToRect(ACanvas, RcChart, true);
+      try
         if (sr.FKind = skLine) then
         begin
           Pen.Width := sr.LineWidth;
@@ -1497,10 +1528,14 @@ begin
           Pen.Width := sr.LineWidth;
           sr.Spline.Draw(ACanvas);
         end;
+      finally
+        ClipToRect(ACanvas, RcChart, false);
+      end;
       Pen.Width := 1;
       for x := 0 to Sr.Values.Count-1 do
       begin
         P := PXYInfo(Sr.Values[x]);
+        if PtInRect(RcChart, Point(P^.Px, P^.Py)) then
           Marker(ACanvas, P^.Px, P^.Py, MarkSize);
       end;
     end;
@@ -1674,6 +1709,28 @@ begin
   end;
 end;
 
+procedure TNiceChart.ClipToRect(ACanvas: TCanvas; const ARect: TRect; AEnable: Boolean);
+begin
+  {$IFDEF FPC}
+  if AEnable then
+    ACanvas.ClipRect := ARect;
+  ACanvas.Clipping := AEnable;
+  {$ELSE}
+  if AEnable then
+  begin
+    if FClipRgn <> 0 then
+      DeleteObject(FClipRgn);
+    FClipRgn := CreateRectRgn(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
+    SelectClipRgn(ACanvas.Handle, FClipRgn);
+  end else
+  begin
+    SelectClipRgn(ACanvas.Handle, HRGN(nil));
+    DeleteObject(FClipRgn);
+    FClipRgn := 0;
+  end;
+  {$ENDIF}
+end;
+
 {$IFNDEF FPC}
 function TNiceChart.CreateMetafile: TMetafile;
 const

components/nicegrid/demos/Basic Demo/Project_Lazarus/basic_demo.lpi

@@ -37,12 +37,12 @@
         <PackageName Value="NiceGridLaz"/>
       </Item1>
     </RequiredPackages>
-    <Units Count="10">
+    <Units Count="14">
       <Unit0>
         <Filename Value="basic_demo.lpr"/>
         <IsPartOfProject Value="True"/>
         <CursorPos X="47" Y="15"/>
-        <UsageCount Value="30"/>
+        <UsageCount Value="35"/>
         <Loaded Value="True"/>
       </Unit0>
       <Unit1>
@@ -66,10 +66,11 @@
       <Unit3>
         <Filename Value="C:\Lazarus\lazarus-main_fpc3.2.2\lcl\controls.pp"/>
         <UnitName Value="Controls"/>
-        <EditorIndex Value="-1"/>
-        <TopLine Value="2386"/>
-        <CursorPos X="20" Y="2414"/>
-        <UsageCount Value="12"/>
+        <EditorIndex Value="5"/>
+        <TopLine Value="2446"/>
+        <CursorPos X="15" Y="2463"/>
+        <UsageCount Value="14"/>
+        <Loaded Value="True"/>
       </Unit3>
       <Unit4>
         <Filename Value="C:\Lazarus\lazarus-main_fpc3.2.2\components\lazutils\laztracer.pas"/>
@@ -100,8 +101,9 @@
         <ResourceBaseClass Value="Form"/>
         <UnitName Value="Main"/>
         <EditorIndex Value="1"/>
-        <CursorPos X="74" Y="23"/>
-        <UsageCount Value="28"/>
+        <TopLine Value="121"/>
+        <CursorPos X="3" Y="126"/>
+        <UsageCount Value="33"/>
         <Loaded Value="True"/>
         <LoadedDesigner Value="True"/>
       </Unit7>
@@ -110,9 +112,9 @@
         <UnitName Value="NiceGrid"/>
         <IsVisibleTab Value="True"/>
         <EditorIndex Value="3"/>
-        <TopLine Value="1305"/>
-        <CursorPos X="32" Y="1323"/>
-        <UsageCount Value="11"/>
+        <TopLine Value="551"/>
+        <CursorPos X="14" Y="573"/>
+        <UsageCount Value="14"/>
         <Loaded Value="True"/>
       </Unit8>
       <Unit9>
@@ -120,127 +122,165 @@
         <EditorIndex Value="2"/>
         <TopLine Value="740"/>
         <CursorPos Y="771"/>
-        <UsageCount Value="11"/>
+        <UsageCount Value="14"/>
         <Loaded Value="True"/>
       </Unit9>
+      <Unit10>
+        <Filename Value="C:\Lazarus\lazarus-main_fpc3.2.2\lcl\include\winapih.inc"/>
+        <EditorIndex Value="7"/>
+        <TopLine Value="287"/>
+        <CursorPos X="10" Y="305"/>
+        <UsageCount Value="12"/>
+        <Loaded Value="True"/>
+      </Unit10>
+      <Unit11>
+        <Filename Value="C:\Lazarus\lazarus-main_fpc3.2.2\lcl\lcltype.pp"/>
+        <UnitName Value="LCLType"/>
+        <EditorIndex Value="6"/>
+        <TopLine Value="1202"/>
+        <CursorPos X="3" Y="1220"/>
+        <UsageCount Value="12"/>
+        <Loaded Value="True"/>
+      </Unit11>
+      <Unit12>
+        <Filename Value="..\..\..\source\nicegridreg.pas"/>
+        <UnitName Value="NiceGridReg"/>
+        <EditorIndex Value="4"/>
+        <TopLine Value="46"/>
+        <CursorPos X="14" Y="64"/>
+        <UsageCount Value="12"/>
+        <Loaded Value="True"/>
+      </Unit12>
+      <Unit13>
+        <Filename Value="C:\Lazarus\fpc-3.2.2\source\rtl\objpas\types.pp"/>
+        <UnitName Value="Types"/>
+        <EditorIndex Value="8"/>
+        <TopLine Value="317"/>
+        <CursorPos X="10" Y="335"/>
+        <UsageCount Value="12"/>
+        <Loaded Value="True"/>
+      </Unit13>
     </Units>
     <JumpHistory Count="30" HistoryIndex="29">
       <Position1>
         <Filename Value="..\..\..\source\nicegrid.pas"/>
-        <Caret Line="311" Column="15" TopLine="295"/>
+        <Caret Line="522" Column="35" TopLine="504"/>
       </Position1>
       <Position2>
         <Filename Value="..\..\..\source\nicegrid.pas"/>
-        <Caret Line="1334" Column="63" TopLine="1334"/>
+        <Caret Line="3698" Column="3" TopLine="3680"/>
       </Position2>
       <Position3>
         <Filename Value="..\..\..\source\nicegrid.pas"/>
+        <Caret Line="3708" Column="58" TopLine="3691"/>
       </Position3>
       <Position4>
         <Filename Value="..\..\..\source\nicegrid.pas"/>
-        <Caret Line="64" Column="84" TopLine="34"/>
+        <Caret Line="3681" Column="36" TopLine="3663"/>
       </Position4>
       <Position5>
         <Filename Value="..\..\..\source\nicegrid.pas"/>
-        <Caret Line="205" Column="12" TopLine="175"/>
+        <Caret Line="290" Column="30" TopLine="274"/>
       </Position5>
       <Position6>
         <Filename Value="..\..\..\source\nicegrid.pas"/>
-        <Caret Line="249" Column="13" TopLine="221"/>
+        <Caret Line="1300" Column="57" TopLine="1283"/>
       </Position6>
       <Position7>
         <Filename Value="..\..\..\source\nicegrid.pas"/>
-        <Caret Line="222" Column="13" TopLine="222"/>
+        <Caret Line="1251" Column="57" TopLine="1226"/>
       </Position7>
       <Position8>
         <Filename Value="..\..\..\source\nicegrid.pas"/>
+        <Caret Line="1232" Column="59" TopLine="1213"/>
       </Position8>
       <Position9>
         <Filename Value="..\..\..\source\nicegrid.pas"/>
-        <Caret Line="251" Column="16" TopLine="223"/>
+        <Caret Line="1212" Column="59" TopLine="1194"/>
       </Position9>
       <Position10>
         <Filename Value="..\..\..\source\nicegrid.pas"/>
-        <Caret Line="627" Column="14" TopLine="598"/>
+        <Caret Line="1156" Column="16" TopLine="1144"/>
       </Position10>
       <Position11>
         <Filename Value="..\..\..\source\nicegrid.pas"/>
-        <Caret Line="1325" Column="21" TopLine="1296"/>
+        <Caret Line="699" Column="11" TopLine="677"/>
       </Position11>
       <Position12>
         <Filename Value="..\..\..\source\nicegrid.pas"/>
-        <Caret Line="1331" Column="21" TopLine="1302"/>
+        <Caret Line="323" Column="52" TopLine="307"/>
       </Position12>
       <Position13>
-        <Filename Value="..\..\..\source\nicegrid.pas"/>
-        <Caret Line="1339" Column="16" TopLine="1310"/>
+        <Filename Value="..\common\main.pas"/>
+        <Caret Line="35" Column="7" TopLine="17"/>
       </Position13>
       <Position14>
         <Filename Value="..\..\..\source\nicegrid.pas"/>
-        <Caret Line="2369" Column="16" TopLine="2340"/>
+        <Caret Line="415" Column="25" TopLine="396"/>
       </Position14>
       <Position15>
         <Filename Value="..\..\..\source\nicegrid.pas"/>
-        <Caret Line="2385" Column="16" TopLine="2356"/>
+        <Caret Line="643" Column="36" TopLine="625"/>
       </Position15>
       <Position16>
         <Filename Value="..\..\..\source\nicegrid.pas"/>
-        <Caret Line="2485" Column="20" TopLine="2456"/>
+        <Caret Line="640" Column="8" TopLine="630"/>
       </Position16>
       <Position17>
         <Filename Value="..\..\..\source\nicegrid.pas"/>
-        <Caret Line="2499" Column="20" TopLine="2455"/>
+        <Caret Line="557" Column="88" TopLine="536"/>
       </Position17>
       <Position18>
-        <Filename Value="..\..\..\source\nicegrid.pas"/>
-        <Caret Line="547" Column="10" TopLine="529"/>
+        <Filename Value="..\common\main.pas"/>
+        <Caret Line="35" Column="35" TopLine="18"/>
       </Position18>
       <Position19>
-        <Filename Value="..\..\..\source\nicegrid.pas"/>
-        <Caret Line="553" Column="35" TopLine="529"/>
+        <Filename Value="..\common\main.pas"/>
+        <Caret Line="126" Column="3" TopLine="121"/>
       </Position19>
       <Position20>
         <Filename Value="..\..\..\source\nicegrid.pas"/>
-        <Caret Line="633" Column="25" TopLine="604"/>
+        <Caret Line="290" Column="30" TopLine="274"/>
       </Position20>
       <Position21>
         <Filename Value="..\..\..\source\nicegrid.pas"/>
-        <Caret Line="2360" Column="23" TopLine="2331"/>
+        <Caret Line="3175" Column="15" TopLine="3171"/>
       </Position21>
       <Position22>
         <Filename Value="..\..\..\source\nicegrid.pas"/>
-        <Caret Line="2447" Column="44" TopLine="2447"/>
+        <Caret Line="522" Column="35" TopLine="504"/>
       </Position22>
       <Position23>
         <Filename Value="..\..\..\source\nicegrid.pas"/>
+        <Caret Line="4180" Column="16" TopLine="4178"/>
       </Position23>
       <Position24>
         <Filename Value="..\..\..\source\nicegrid.pas"/>
-        <Caret Line="636" Column="12" TopLine="607"/>
+        <Caret Line="523" Column="33" TopLine="505"/>
       </Position24>
       <Position25>
         <Filename Value="..\..\..\source\nicegrid.pas"/>
-        <Caret Line="2437" Column="14" TopLine="2407"/>
+        <Caret Line="4191" Column="36" TopLine="4188"/>
       </Position25>
       <Position26>
         <Filename Value="..\..\..\source\nicegrid.pas"/>
-        <Caret Line="2535" Column="14" TopLine="2506"/>
+        <Caret Line="575" Column="5" TopLine="551"/>
       </Position26>
       <Position27>
         <Filename Value="..\..\..\source\nicegrid.pas"/>
-        <Caret Line="423" Column="14" TopLine="405"/>
+        <Caret Line="523" Column="46" TopLine="505"/>
       </Position27>
       <Position28>
         <Filename Value="..\..\..\source\nicegrid.pas"/>
-        <Caret Line="2306" Column="20" TopLine="2286"/>
+        <Caret Line="519" Column="43" TopLine="501"/>
       </Position28>
       <Position29>
         <Filename Value="..\..\..\source\nicegrid.pas"/>
-        <Caret Line="332" Column="14" TopLine="319"/>
+        <Caret Line="4203" Column="16" TopLine="4201"/>
       </Position29>
       <Position30>
         <Filename Value="..\..\..\source\nicegrid.pas"/>
-        <Caret Line="627" Column="14" TopLine="598"/>
+        <Caret Line="4195" Column="3" TopLine="4177"/>
       </Position30>
     </JumpHistory>
   </ProjectOptions>

components/nicegrid/demos/Basic Demo/common/main.lfm

@@ -102,11 +102,14 @@ object MainForm: TMainForm
     TabOrder = 1
   end
   object CheckBox2: TCheckBox
-    Left = 88
+    AnchorSideLeft.Control = CheckBox1
+    AnchorSideLeft.Side = asrBottom
+    Left = 69
     Height = 19
     Top = 464
     Width = 93
     Anchors = [akLeft, akBottom]
+    BorderSpacing.Left = 16
     Caption = 'System Colors'
     Checked = True
     OnClick = CheckBox2Click
@@ -114,31 +117,40 @@ object MainForm: TMainForm
     TabOrder = 2
   end
   object CheckBox3: TCheckBox
-    Left = 192
+    AnchorSideLeft.Control = CheckBox2
+    AnchorSideLeft.Side = asrBottom
+    Left = 178
     Height = 19
     Top = 464
     Width = 80
     Anchors = [akLeft, akBottom]
+    BorderSpacing.Left = 16
     Caption = 'Fit to Width'
     OnClick = CheckBox3Click
     TabOrder = 3
   end
   object CheckBox4: TCheckBox
-    Left = 288
+    AnchorSideLeft.Control = CheckBox3
+    AnchorSideLeft.Side = asrBottom
+    Left = 274
     Height = 19
     Top = 464
     Width = 125
     Anchors = [akLeft, akBottom]
+    BorderSpacing.Left = 16
     Caption = 'Auto Column Width'
     OnClick = CheckBox4Click
     TabOrder = 4
   end
   object CheckBox5: TCheckBox
-    Left = 424
+    AnchorSideLeft.Control = CheckBox4
+    AnchorSideLeft.Side = asrBottom
+    Left = 415
     Height = 19
     Top = 464
     Width = 77
     Anchors = [akLeft, akBottom]
+    BorderSpacing.Left = 16
     Caption = 'Show Grids'
     Checked = True
     OnClick = CheckBox5Click
@@ -146,11 +158,14 @@ object MainForm: TMainForm
     TabOrder = 5
   end
   object Button1: TButton
-    Left = 272
+    AnchorSideLeft.Control = Button3
+    AnchorSideLeft.Side = asrBottom
+    Left = 284
     Height = 25
     Top = 501
     Width = 129
     Anchors = [akLeft, akBottom]
+    BorderSpacing.Left = 16
     Caption = '&Hide 3rd Column'
     OnClick = Button1Click
     TabOrder = 8
@@ -159,39 +174,50 @@ object MainForm: TMainForm
     Left = 16
     Height = 25
     Top = 501
-    Width = 121
+    Width = 108
     Anchors = [akLeft, akBottom]
+    AutoSize = True
     Caption = '&Insert New Row'
     OnClick = Button2Click
     TabOrder = 6
   end
   object Button3: TButton
-    Left = 144
+    AnchorSideLeft.Control = Button2
+    AnchorSideLeft.Side = asrBottom
+    Left = 140
     Height = 25
     Top = 501
-    Width = 121
+    Width = 128
     Anchors = [akLeft, akBottom]
+    AutoSize = True
+    BorderSpacing.Left = 16
     Caption = '&Delete Current Row'
     OnClick = Button3Click
     TabOrder = 7
   end
   object Button4: TButton
-    Left = 416
+    AnchorSideLeft.Control = Button1
+    AnchorSideLeft.Side = asrBottom
+    Left = 429
     Height = 25
     Top = 501
     Width = 182
     Anchors = [akLeft, akBottom]
     AutoSize = True
+    BorderSpacing.Left = 16
     Caption = 'Toggle ReadOnly 3rd Column'
     OnClick = Button4Click
     TabOrder = 9
   end
   object CheckBox6: TCheckBox
-    Left = 528
+    AnchorSideLeft.Control = CheckBox5
+    AnchorSideLeft.Side = asrBottom
+    Left = 508
     Height = 19
     Top = 464
     Width = 84
     Anchors = [akLeft, akBottom]
+    BorderSpacing.Left = 16
     Caption = 'Show Footer'
     OnClick = CheckBox6Click
     TabOrder = 10

components/nicegrid/source/nicegrid.pas

@@ -48,7 +48,7 @@ uses
   {$ELSE}
   Windows, Messages,
   {$ENDIF}
-  Forms, Controls, SysUtils, Classes, Graphics, Contnrs,
+  Forms, Controls, SysUtils, Types, Classes, Graphics, Contnrs,
   StdCtrls, ExtCtrls, Clipbrd;
 
 type
@@ -62,6 +62,7 @@ type
   TVertAlign = (vaTop, vaCenter, vaBottom);
   TGutterKind = (gkNone, gkBlank, gkPointer, gkNumber, gkString);
   TGridHittest = (gtNone, gtLeftTop, gtLeft, gtTop, gtCell, gtColSizing, gtSmallBox);
+  TNiceGridState = (gsNormal, gsSelAll, gsSelRow, gsSelCol, gsCell, gsColSize, gsBoxDrag);
 
   TNiceGrid = class;
 
@@ -216,6 +217,7 @@ type
     FDefRowHeight: Integer;
     FDefColWidth: Integer;
     FFlat: Boolean;
+    FGridState: TNiceGridState;
 
     FHeaderLine: Integer;
     FHeaderInfos: TList;
@@ -318,7 +320,7 @@ type
     procedure SetDefColWidth(Value: Integer);
     procedure SetDefRowHeight(Value: Integer);
     procedure SetFlat(Value: Boolean);
-    procedure SetColor(Value: TColor);
+    procedure SetColor(Value: TColor); reintroduce;
     procedure SetAlternateColor(Value: TColor);
     procedure SetGridColor(Value: TColor);
     procedure SetShowGrid(Value: Boolean);
@@ -361,6 +363,7 @@ type
     function SafeGetCell(X, Y: Integer): string;
     function GetCellColor(X, Y: Integer): TColor;
     procedure DrawCell(X, Y: Integer);
+    procedure InvalidateCell(X, Y: Integer);
     function FastDrawCell(X, Y: Integer; IsEditing: Boolean): TPoint;
     procedure ForceHideCaret;
     procedure ForceShowCaret;
@@ -403,6 +406,7 @@ type
     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
     procedure KeyPress(var Key: Char); override;
+    function TextExtent(const s: String): TSize;
     {$IFDEF FPC}
     procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; const AXProportion, AYProportion: Double); override;
     {$ENDIF}
@@ -550,10 +554,26 @@ const
 
   CursorArray: array [TGridHitTest] of TCursor =
   //(gtNone, gtLeftTop, gtLeft, gtTop, gtCell, gtColSizing, gtSmallBox);
+    {$IFDEF LCLGtk3}  // Issue with loading cursors in GTK3 --> use predefined cursors.
+    (crDefault, crSizeSE, crSizeE, crSizeS, crHandPoint, crHSplit, crCross);
+    {$ELSE}
     (crDefault, crLeftTop, crRight, crDown, crPlus, crHSplit, crSmallCross);
+    {$ENDIF}
+
+  GridStateArray: array[TGridHitTest] of TNiceGridState =
+    (gsNormal, gsSelAll, gsSelRow, gsSelCol, gsCell, gsColSize, gsBoxDrag);
 
   MergeID = -2;
 
+{$HINTS OFF}
+procedure Unused(const A1); overload;
+begin
+end;
+
+procedure Unused(const A1, A2); overload;
+begin
+end;
+{$HINTS ON}
 
 { TNiceGrid }
 
@@ -628,12 +648,15 @@ begin
   SizingCol := -1;
   SizingColX := -1;
 
+  {$IFNDEF LCLGtk3}  // Issue with loading cursors in GTK3.
   Screen.Cursors[crPlus] := LoadCursor(hinstance, 'CR_PLUS');
   Screen.Cursors[crSmallCross] := LoadCursor(hInstance, 'CR_CROSS');
   Screen.Cursors[crRight] := LoadCursor(hinstance, 'CR_RIGHT');
   Screen.Cursors[crDown] := LoadCursor(hinstance, 'CR_DOWN');
   Screen.Cursors[crLeftTop] := LoadCursor(hinstance, 'CR_LEFTTOP');
+  {$ENDIF}
   Cursor := crPlus;
+  FGridState := gsNormal;
 
   FColumns := TNiceColumns.Create(Self);
   FEdit := TNiceInplace.Create(Self);
@@ -673,7 +696,11 @@ end;
 procedure TNiceGrid.SetScrollBar(AKind, AMax, APos, AMask: Integer);
 var Info: TScrollInfo;
 begin
+  {$IFDEF FPC}
+  Info := Default(TScrollInfo);
+  {$ELSE}
   FillChar(Info, SizeOf(TScrollInfo), 0);
+  {$ENDIF}
   Info.cbSize := SizeOf(TScrollInfo);
   Info.nMin := 0;
   Info.nMax := AMax;
@@ -816,6 +843,8 @@ var
   WidthAvail, HeightAvail: Integer;
   v: Integer;
   LastBodyWidth: Integer;
+  bmp: TBitmap;
+  lCanvas: TCanvas;
 
   function GetColAutoWidth(i: Integer): Integer;
   var
@@ -824,8 +853,8 @@ var
   begin
     Result := 0;
     t := Columns[i].FStrings;
-    for n := 0 to t.Count-1
-      do Result := Max(Result, Canvas.TextWidth(t[n]) + 7);
+    for n := 0 to t.Count-1 do
+      Result := Max(Result, lCanvas.TextWidth(t[n]) + 7);
     Result := Max(Result, 20);
   end;
 
@@ -835,6 +864,19 @@ begin
 
   BuildMergeData;
 
+  if Canvas.HandleAllocated then
+  begin
+    lCanvas := Canvas;
+    bmp := nil;
+  end else
+  begin
+    bmp := TBitmap.Create;
+    bmp.Width := 100;
+    bmp.Height := 100;
+    bmp.Canvas.Font.Assign(Font);
+    lCanvas := bmp.Canvas;
+  end;
+
   VisCount := 0;
   for x := 0 to FColumns.Count-1 do
   begin
@@ -854,7 +896,7 @@ begin
 
   if FAutoColWidth then
   begin
-    Canvas.Font.Assign(Font);
+    lCanvas.Font.Assign(Font);
     for x := 0 to FColumns.Count-1
       do FColumns[x].FWidth := Max(FDefColWidth, GetColAutoWidth(x));
   end;
@@ -968,6 +1010,8 @@ begin
     AllHeight := Min(ClientHeight, BodyHeight + FixedHeight);
     CellBox := Rect(FixedWidth, FixedHeight, ClientWidth, ClientHeight);
   end;
+
+  bmp.Free;
 end;
 
 function DrawString(Canvas: TCanvas; Str: string; Rc: TRect;
@@ -1117,12 +1161,13 @@ var
 begin
   if (FGutterKind = gkNone)
     then Exit;
-  CopyRect(GutterBox, CellBox);
+  GutterBox := CellBox;
   GutterBox.Left := 0;
   for x := 0 to FRowCount-1 do
   begin
     R := Rect(-1, (x * FDefRowHeight) - 1, FGutterWidth, ((x + 1) * FDefRowHeight));
     OffsetRect(R, 0, -FVertOffset + FixedHeight);
+    Dummy := Rect(0, 0, 0, 0);  // to silence the compiler
     if IntersectRect(Dummy, R, GutterBox) then
     begin
       case FGutterKind of
@@ -1173,6 +1218,7 @@ begin
            FDefRowHeight * (P^.Rc.Bottom + 1)
          );
     OffsetRect(R, -FHorzOffset + FixedWidth, 0);
+    Dummy := Rect(0, 0, 0, 0);  // to silence the compiler
     if IntersectRect(Dummy, R, ClientRect)
       then DrawFixCell(R, P^.Str, FHeaderFont, FOnDrawHeader);
   end;
@@ -1193,6 +1239,7 @@ begin
   begin
     R := Rect(GetColCoord(x)-1, FooterTop, GetColCoord(x+1), FooterBottom);
     OffsetRect(R, -FHorzOffset + FixedWidth, 0);
+    Dummy := Rect(0, 0, 0, 0);  // to silence the compiler
     if IntersectRect(Dummy, R, ClientRect)
       then DrawFixCell(R, FColumns[x].FFooter, FFooterFont, FOnDrawFooter);
   end;
@@ -1205,14 +1252,14 @@ end;
 
 procedure TNiceGrid.DrawCell(X, Y: Integer);
 var
-  R, Rc, Dummy: TRect;
+  Rc, Dummy: TRect;
   Column: TNiceColumn;
   Handled: Boolean;
 begin
   Handled := False;
   Rc := GetCellRect(x, y);
   OffsetRect(Rc, -FHorzOffset + FixedWidth, -FVertOffset + FixedHeight);
-  R := Rc;
+  Dummy := Rect(0, 0, 0, 0);  // to silence the compiler
   if IntersectRect(Dummy, Rc, CellBox) then
   begin
     Column := FColumns[x];
@@ -1243,6 +1290,14 @@ begin
   end;
 end;
 
+procedure TNiceGrid.InvalidateCell(X, Y: Integer);
+var
+  Rc: TRect;
+begin
+  Rc := GetCellRect(X, Y);
+  InvalidateRect(Handle, @Rc, false);
+end;
+
 function TNiceGrid.FastDrawCell(X, Y: Integer; IsEditing: Boolean): TPoint;
 var
   R, Dummy: TRect;
@@ -1253,6 +1308,7 @@ begin
   Result := Point(-1, -1);
   R := GetCellRect(x, y);
   OffsetRect(R, -FHorzOffset + FixedWidth, -FVertOffset + FixedHeight);
+  Dummy := Rect(0, 0, 0, 0);  // to silence the compiler
   if IntersectRect(Dummy, R, CellBox) then
   begin
     Column := FColumns[x];
@@ -1711,7 +1767,8 @@ begin
   end else
     t[Y] := Value;
   if not FUpdating
-    then FastDrawCell(X, Y, False);
+    then InvalidateCell(X, Y);
+//    then FastDrawCell(X, Y, False);
 end;
 
 procedure TNiceGrid.SetCell(X, Y: Integer; Value: string);
@@ -2102,6 +2159,28 @@ begin
           UpdateColRow;
         end;
 
+      {$IFDEF FPC}
+      VK_F2:
+        begin
+          {
+          BuffString := '';
+          Pt := GetCellAtPos(X, Y);
+          FCol := Pt.X;
+          FRow := Pt.Y;
+//          if (Pt.X = FCol) and (Pt.Y = FRow) then
+          begin
+          }
+            EnsureVisible(FCol, FRow);
+            if (not FReadOnly) and (not FColumns[FCol].FReadOnly) then
+            begin
+              IsEditing := True;
+              FEdit.ShowEdit(FCol, FRow);
+              FEdit.SelectAll;
+            end;
+          //end;
+        end;
+      {$ENDIF}
+
       VK_RETURN:
         begin
           OldS := GetCell(Col, Row);
@@ -2272,6 +2351,27 @@ begin
 
 end;
 
+function TNiceGrid.TextExtent(const s: String): TSize;
+var
+  bmp: TBitmap;
+begin
+  if Canvas.HandleAllocated then
+    Result := Canvas.TextExtent(s)
+  else
+  begin
+    bmp := TBitmap.Create;
+    try
+      bmp.Width := 100;
+      bmp.Height := 100;
+      bmp.Canvas.Font.Assign(self.Font);
+      Result := bmp.Canvas.TextExtent(s);
+    finally
+      bmp.Free;
+    end;
+  end;
+end;
+
+
 function TNiceGrid.GetHitTestInfo(X, Y: Integer): TGridHitTest;
 var
   a, i1, i2: Integer;
@@ -2334,6 +2434,85 @@ begin
     Exit;
   end;
 
+  case FGridState of
+    gsColSize:
+      begin
+        ForceHideCaret;
+        SizingColX := GetColCoord(SizingCol);
+      end;
+    gsBoxDrag:
+      begin
+        ForceHideCaret;
+        SmallBoxArea := FSelectArea;
+      end;
+    gsSelAll:
+      begin
+        FRow := 0;
+        FCol := 0;
+        BuffString := '';
+        EnsureVisible(0, 0);
+        FCol2 := ColCount-1;
+        FRow2 := FRowCount-1;
+        SetSelectArea(Rect(0, 0, ColCount-1, FRowCount-1));
+        ColRowChanged;
+      end;
+    gsSelRow:
+      begin
+        FRow := GetRowFromY(Y);
+        FCol := 0;
+        LastHover := FRow;
+        BuffString := '';
+        EnsureVisible(FCol, FRow);
+        FCol2 := ColCount-1;
+        FRow2 := FRow;
+        SmallBoxPos := 2;
+        AdjustSelection(Rect(0, FRow, ColCount-1, FRow), True);
+        ColRowChanged;
+        if Assigned(OnGutterClick)
+          then FOnGutterClick(Self, FRow, Button, Shift);
+      end;
+    gsSelCol:
+      begin
+        FCol := GetColFromX(X);
+        FRow := 0;
+        LastHover := FCol;
+        BuffString := '';
+        EnsureVisible(FCol, FRow);
+        FCol2 := FCol;
+        FRow2 := FRowCount-1;
+        SmallBoxPos := 1;
+        AdjustSelection(Rect(FCol, 0, FCol, FRowCount-1), True);
+        ColRowChanged;
+        if Assigned(FOnHeaderClick)
+          then FOnHeaderClick(Self, FCol, Button, Shift);
+      end;
+    gsCell:
+      begin
+        BuffString := '';
+        Pt := GetCellAtPos(X, Y);
+        if (Pt.X = FCol) and (Pt.Y = FRow) then
+        begin
+          EnsureVisible(FCol, FRow);
+          if (not FReadOnly) and (not FColumns[FCol].FReadOnly) then
+          begin
+            IsEditing := True;
+            FEdit.ShowEdit(FCol, FRow);
+          end;
+        end else
+        if (Pt.X <> -1) and (pt.Y <> -1) then
+        begin
+          EnsureVisible(Pt.X, Pt.Y);
+          FCol := Pt.X;
+          FRow := Pt.Y;
+          BuffString := '';
+          FCol2 := FCol;
+          FRow2 := FRow;
+          SetSelectArea(Rect(FCol, FRow, FCol, FRow));
+        end;
+        ColRowChanged;
+      end;
+  end;
+  (*
   if (Cursor = crHSplit) then
   begin
     ForceHideCaret;
@@ -2415,6 +2594,7 @@ begin
     end;
     ColRowChanged;
   end;
+  *)
   SetCapture(Handle);
 
   SetFocus;
@@ -2432,9 +2612,9 @@ var
   i: Integer;
 
 begin
-
   if not FEnabled then
   begin
+    FGridState := gsNormal;
     Cursor := crDefault;
     inherited;
     Exit;
@@ -2442,6 +2622,93 @@ begin
 
   if (ssLeft in Shift) then
   begin
+    case FGridState of
+      gsCell:
+        begin
+          Pt := GetCellAtPos(X, Y);
+          if (Pt.X <> -1) and (Pt.Y <> -1) then
+          begin
+            l := Min(Pt.X, FCol);
+            t := Min(Pt.Y, FRow);
+            r := Max(Pt.X, FCol);
+            b := Max(Pt.Y, FRow);
+            FCol2 := Pt.X;
+            FRow2 := Pt.Y;
+            SetSelectArea(Rect(l, t, r, b));
+            EnsureVisible(FCol2, FRow2);
+          end;
+        end;
+      gsBoxDrag:
+        begin
+          Pt := GetCellAtPos(X, Y);
+          if (Pt.X <> -1) and (Pt.Y <> -1) then
+          begin
+            l := Min(Pt.X, SmallBoxArea.Left);
+            t := Min(Pt.Y, SmallBoxArea.Top);
+            r := Max(Pt.X, SmallBoxArea.Right);
+            b := Max(Pt.Y, SmallBoxArea.Bottom);
+            FCol2 := Pt.X;
+            FRow2 := Pt.Y;
+            SetSelectArea(Rect(l, t, r, b));
+            EnsureVisible(FCol2, FRow2);
+          end;
+        end;
+      gsSelRow:
+        begin
+          i := GetRowFromY(Y);
+          if (i <> -1) and (i <> LastHover) then
+          begin
+            LastHover := i;
+            t := Min(i, FRow);
+            b := Max(i, FRow);
+            FRow2 := i;
+            SmallBoxPos := 2;
+            AdjustSelection(Rect(0, t, ColCount-1, b), True);
+          end;
+        end;
+      gsSelCol:
+        begin
+          i := GetColFromX(X);
+          if (i <> -1) and (i <> LastHover) then
+          begin
+            LastHover := i;
+            l := Min(i, FCol);
+            r := Max(i, FCol);
+            FCol2 := i;
+            SmallBoxPos := 1;
+            AdjustSelection(Rect(l, 0, r, FRowCount-1), True);
+          end;
+        end;
+      gsColSize:
+        begin
+          Suggested := Max(5, X + FHorzOffset - SizingColX - FixedWidth);
+          if FFitToWidth then
+          begin
+            if (SizingCol = ColCount-1) or (SizingCol = -1) then
+            begin
+              inherited;
+              Exit;
+            end;
+            Total2Col := (ClientWidth - FixedWidth) - (TotalWidth - Columns[SizingCol].FWidth - Columns[SizingCol+1].FWidth);
+            if (Total2Col > 10) then
+            begin
+              Columns[SizingCol].FWidth := Suggested;
+              Columns[SizingCol+1].FWidth := Total2Col - Suggested;
+            end;
+            if (Columns[SizingCol+1].FWidth < 5) then
+            begin
+              Columns[SizingCol].FWidth := Total2Col - 5;
+              Columns[SizingCol+1].FWidth := 5;
+            end;
+          end else
+          begin
+            Columns[SizingCol].FWidth := Suggested;
+          end;
+          Recalculate;
+          InvalidateRightWard(FixedWidth);
+        end;
+    end;
+     (*
     if (Cursor = crPlus) then
     begin
       Pt := GetCellAtPos(X, Y);
@@ -2529,11 +2796,12 @@ begin
       end;
       Recalculate;
       InvalidateRightWard(FixedWidth);
-    end;
+    end;  *)
 
   end else
   begin
     Cursor := CursorArray[GetHitTestInfo(X, Y)];
+    FGridState := GridStateArray[GetHitTestInfo(X, Y)];
   end;
 
   inherited;
@@ -2600,6 +2868,7 @@ begin
   end;
 
   Cursor := CursorArray[GetHitTestInfo(X, Y)];
+  FGridState := GridStateArray[GetHitTestInfo(X, Y)];
   ReleaseCapture;
   LastHover := -1;
 
@@ -2907,6 +3176,7 @@ end;
 
 procedure TNiceGrid.WMSetFocus(var Msg: {$IFDEF FPC}TLMSetFocus{$ELSE}TWMSetFocus{$ENDIF});
 begin
+  Unused(Msg);
   CreateCaret(Handle, 0, 1, FDefRowHeight - 2);
   CaretVisible := False;
   InvalidateCells;
@@ -3421,7 +3691,7 @@ var
 begin
   for x := 0 to Mergeds.Count-1 do
   begin
-    CopyRect(Rc, TMergeCell(Mergeds[x]).Rc);
+    Rc := TMergeCell(Mergeds[x]).Rc;
     for y := Rc.Left to Rc.Right do
     begin
       if (y >= FColumns.Count)
@@ -3438,7 +3708,7 @@ end;
 procedure TNiceGrid.DrawMergedCell(Index: Integer);
 var
   Data: TMergeCell;
-  R, Rc, Dummy: TRect;
+  Rc, Dummy: TRect;
   l1, l2, t, h: Integer;
 begin
   Data := TMergeCell(Mergeds[Index]);
@@ -3448,7 +3718,7 @@ begin
   h := FDefRowHeight * (Data.Rc.Bottom - Data.Rc.Top + 1);
   Rc := Rect(l1-1, t-1, l2, t+h);
   OffsetRect(Rc, -FHorzOffset + FixedWidth, -FVertOffset + FixedHeight);
-  R := Rc;
+  Dummy := Rect(0, 0, 0, 0);   // to silence the compiler
   if IntersectRect(Dummy, Rc, CellBox) then
   begin
     with Canvas do
@@ -3815,6 +4085,10 @@ begin
   SetAlignment(Column.FHorzAlign);
   Text := FGrid.SafeGetCell(X, Y);
   Font.Assign(Column.FFont);
+  {$IFDEF FPC}
+  if Font.Height = 0 then
+    Font.Height := GetFontData(Font.Reference.Handle).Height;
+  {$ENDIF}
 
   Rc := FGrid.GetCellRect(X, Y);
   Rc := FGrid.CellRectToClient(Rc);
@@ -3826,6 +4100,7 @@ begin
   l := Rc.Left;
   w := Rc.Right - Rc.Left;
   t := 0;
+//  h := FGrid.TextExtent('gM').CY;
   h := FGrid.Canvas.TextHeight('gM');
   case Column.FVertAlign of
     vaTop:    t := Rc.Top - 1;
@@ -3906,6 +4181,7 @@ end;
 
 procedure TNiceGridSync.SetScrollBar(AKind, AMax, APos, AMask: Integer);
 begin
+  Unused(AMax);
   if (AKind = SB_VERT) and Assigned(FGrid) then
   begin
     if ((AMask and SIF_POS) <> 0)
@@ -3916,6 +4192,7 @@ end;
 procedure TNiceGridSync.ShowHideScrollBar(HorzVisible,
   VertVisible: Boolean);
 begin
+  Unused(HorzVisible, VertVisible);
   ShowScrollBar(Handle, SB_HORZ, True);
   ShowScrollBar(Handle, SB_VERT, False);
   EnableScrollBar(Handle, SB_HORZ, 3{ESB_DISABLE_BOTH});
@@ -3923,6 +4200,7 @@ end;
 
 procedure TNiceGridSync.SyncColRow(Sender: TObject; ACol, ARow: Integer);
 begin
+  Unused(ACol);
   if Assigned(FGrid)
     then FGrid.Row := ARow;
 end;

components/nicegrid/source/nicegridreg.pas

@@ -60,7 +60,7 @@ uses
 
 type
   TNiceGridEditor = class(TComponentEditor)
-  protected
+  public
     function GetVerbCount: Integer; override;
     function GetVerb(Index: Integer): string; override;
     procedure ExecuteVerb(Index: Integer); override;

components/nicesidebar/Demo1/common/Unit1.dfm

@@ -562,7 +562,7 @@ object Form1: TForm1
       000000000000}
   end
   object ImageList2: TImageList
-    Left = 256
+    Left = 296
     Top = 136
     Bitmap = {
       494C010107000900040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600

components/nicesidebar/Demo1/common/Unit1.pas

@@ -15,6 +15,9 @@ uses
   SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, StdCtrls, ExtCtrls, NiceSideBar, ImgList;
   
+  // When switching compilation from Delphi XE11 to Delphi 7, the automatically
+  // added unit System.ImageList must be removed manually.
+
 type
 
   { TForm1 }

components/nicesidebar/source/NiceSideBar.pas

@@ -33,6 +33,7 @@ unit NiceSideBar;
 
 {$IFDEF FPC}
  {$MODE Delphi}
+ {$WARN 4055 off : Conversion between ordinals and pointers is not portable}
 {$ENDIF}
 
 interface
@@ -43,7 +44,7 @@ uses
   {$ELSE}
   Windows, Messages,
   {$ENDIF}
-  Graphics, SysUtils, Controls, Classes, ImgList, Math,
+  Graphics, SysUtils, Types, Controls, Classes, ImgList, Math,
   ExtCtrls, Forms;
 
 const
@@ -326,6 +327,7 @@ type
     procedure DrawSubItem(ACanvas: TCanvas; Rc: TRect; Str: string; States: TSideBarStates); virtual;
     procedure DrawNonItem(ACanvas: TCanvas; Rc: TRect); virtual;
     procedure DrawScroller(ACanvas: TCanvas; Rc: TRect; Up: Boolean; Hover: Boolean); virtual;
+    procedure InvalidateItem(Index: Integer); virtual;
     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
     {$IFDEF FPC}
     procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; const AXProportion, AYProportion: Double); override;
@@ -411,6 +413,11 @@ const
   SBITEM_STATE_DISABLED = $00000001;
   SBITEM_STATE_HIDDEN   = $00000004;
 
+{$HINTS OFF}
+procedure Unused(const A1);
+begin
+end;
+{$HINTS ON}
 
 { TSideBarItem }
 
@@ -514,16 +521,16 @@ function TSideBarItem.GetItemEnabled(Index: Integer): Boolean;
 begin
   Result := True;
   if (FStates.Count > Index)
-    then Result := (Integer(FStates[Index]) and SBITEM_STATE_DISABLED) = 0;
+    then Result := (NativeUInt(FStates[Index]) and SBITEM_STATE_DISABLED) = 0;
 end;
 
 procedure TSideBarItem.SetItemEnabled(Index: Integer; const Value: Boolean);
 var
-  State: Integer;
+  State: NativeUInt;
 begin
   while (FStates.Count <= Index)
     do FStates.Add(nil);
-  State := Integer(FStates[Index]);
+  State := NativeUInt(FStates[Index]);
   if Value
     then State := State and not SBITEM_STATE_DISABLED
     else State := State or SBITEM_STATE_DISABLED;
@@ -535,16 +542,16 @@ function TSideBarItem.GetItemVisible(Index: Integer): Boolean;
 begin
   Result := True;
   if (FStates.Count > Index)
-    then Result := (Integer(FStates[Index]) and SBITEM_STATE_HIDDEN) = 0;
+    then Result := (NativeUInt(FStates[Index]) and SBITEM_STATE_HIDDEN) = 0;
 end;
 
 procedure TSideBarItem.SetItemVisible(Index: Integer; const Value: Boolean);
 var
-  State: Integer;
+  State: NativeUInt;
 begin
   while (FStates.Count <= Index)
     do FStates.Add(nil);
-  State := Integer(FStates[Index]);
+  State := NativeUInt(FStates[Index]);
   if Value
     then State := State and not SBITEM_STATE_HIDDEN
     else State := State or SBITEM_STATE_HIDDEN;
@@ -842,8 +849,8 @@ begin
       begin
         FItemIndex := P^.ItemIndex;
         FSubItemIndex := P^.SubIndex;
-        DoDrawItem(LastSubIndex);
-        DoDrawItem(i);
+        InvalidateItem(LastSubIndex);
+        InvalidateItem(i);
         LastSubIndex := i;
       end;
     end;
@@ -856,9 +863,9 @@ begin
     begin
       if FItems[FItemIndex].FExpanded then
       begin
-        DoDrawItem(LastIndex);
-        DoDrawItem(LastSubIndex);
-        DoDrawItem(i);
+        InvalidateItem(LastIndex);
+        InvalidateItem(LastSubIndex);
+        InvalidateItem(i);
         LastIndex := i;
         LastSubIndex := -1;
       end else
@@ -872,10 +879,10 @@ begin
     end else
     // on sub items
     begin
-      DoDrawItem(LastIndex);
-      DoDrawItem(LastSubIndex);
-      DoDrawItem(i);
-      DoDrawItem(i - FSubItemIndex - 1);
+      InvalidateItem(LastIndex);
+      InvalidateItem(LastSubIndex);
+      InvalidateItem(i);
+      InvalidateItem(i - FSubItemIndex - 1);
       LastSubIndex := i;
       LastIndex := i - FSubItemIndex - 1;
     end;
@@ -892,6 +899,7 @@ procedure TNiceSidebar.MouseMove(Shift: TShiftState; X, Y: Integer);
 var
   i: Integer;
   P: PSBInfo;
+  Rc, tmpRc: TRect;
 begin
 
   if ScTopVisible then
@@ -901,8 +909,8 @@ begin
       if (HoverIndex <> SCTOPINDEX) then
       begin
         HoverIndex := SCTOPINDEX;
-        DoDrawItem(LastHover);
-        DoDrawItem(HoverIndex);
+        InvalidateItem(LastHover);
+        InvalidateItem(HoverIndex);
         LastHover := SCTOPINDEX;
       end;
       Exit;
@@ -916,8 +924,8 @@ begin
       if (HoverIndex <> SCBOTTOMINDEX) then
       begin
         HoverIndex := SCBOTTOMINDEX;
-        DoDrawItem(LastHover);
-        DoDrawItem(HoverIndex);
+        InvalidateItem(LastHover);
+        InvalidateItem(HoverIndex);
         LastHover := SCBOTTOMINDEX;
       end;  
       Exit;
@@ -929,8 +937,8 @@ begin
   if (i > -1) then
   begin
     P := PSBInfo(FList[i]);
-    if (P^.Level = 0) and FAlwaysExpand
-      then i := -1;
+    if (P^.Level = 0) and FAlwaysExpand then
+      i := -1;
   end;
 
   if FHandPointCursor then
@@ -943,14 +951,23 @@ begin
   if (i <> HoverIndex) then
   begin
     HoverIndex := i;
-    if (LastHover >= 0) and (LastHover < FList.Count)
-      then DoDrawItem(LastHover);
+    if (LastHover >= 0) and (LastHover < FList.Count) then
+      InvalidateItem(LastHover);
     if (HoverIndex > -1) then
     begin
-      DoDrawItem(HoverIndex);
+      InvalidateItem(HoverIndex);
       P := PSBInfo(FList[i]);
       if Assigned(FOnHover)
         then FOnHover(Self, P^.ItemIndex, P^.SubIndex, P^.Caption);
+
+      Rc := P^.Rc;
+      OffsetRect(Rc, 0, -DeltaY);
+      tmpRc := Rect(0, 0, 0, 0);  // To silence the compiler
+      if IntersectRect(tmpRc, ScTop, Rc) then
+        InvalidateItem(SCTOPINDEX);
+
+      if IntersectRect(tmpRc, ScBottom, Rc) then
+        InvalidateItem(SCBOTTOMINDEX);
     end;
     LastHover := HoverIndex;
   end;
@@ -961,11 +978,12 @@ end;
 
 procedure TNiceSideBar.CMMouseLeave(var Msg: {$IFDEF FPC}TLMessage{$ELSE}TMessage{$ENDIF});
 begin
+  Unused(Msg);
   if (HoverIndex <> -1) then
   begin
     HoverIndex := -1;
-    if (LastHover >= 0) and (LastHover < FList.Count)
-      then DoDrawItem(LastHover);
+    if (LastHover >= 0) and (LastHover < FList.Count) then
+      InvalidateItem(LastHover);
     LastHover := -1;
   end;
   if Assigned(FOnHover)
@@ -1051,10 +1069,9 @@ begin
       BottomIndex := FList.Count-1;
       ScBottomVisible := False;
     end;
-    {$IFDEF FPC}
-    delta := Scale96ToFont(12);
-    {$ELSE}
     delta := 12;
+    {$IFDEF FPC}
+    delta := Scale96ToFont(delta);
     {$ENDIF}
     if (FAlignment = saRight) then
     begin
@@ -1068,14 +1085,34 @@ begin
   end;
 end;
 
+procedure TNiceSideBar.InvalidateItem(Index: Integer);
+var
+  Rc: TRect;
+  Info: PSBInfo;
+begin
+  if Index = -1 then
+    exit;
+
+  if Index = SCTOPINDEX then
+    Rc := ScTop
+  else
+  if Index = SCBOTTOMINDEX then
+    Rc := ScBottom
+  else
+  begin
+    Info := PSBInfo(FList[Index]);
+    Rc := Info^.Rc;
+    OffsetRect(Rc, 0, -DeltaY);
+  end;
+  InvalidateRect(Handle, @Rc, false);
+end;
+
 procedure TNiceSideBar.DoDrawItem(Index: Integer);
 var
   Info: PSBInfo;
   States: TSideBarStates;
   Rc, Tmp: TRect;
-
 begin
-
   if (Index = SCTOPINDEX) then
   begin
     if ScTopVisible then
@@ -1102,7 +1139,7 @@ begin
     then Exit;
 
   Info := PSBInfo(FList[Index]);
-  CopyRect(Rc, Info^.Rc);
+  Rc := Info^.Rc;
   OffsetRect(Rc, 0, -DeltaY);
 
   if (Index = HoverIndex)
@@ -1132,6 +1169,7 @@ begin
       else DrawItem(Canvas, Rc, Info^.Caption, States, FItems[Info^.ItemIndex].FImageIndex);
   end;
 
+  Tmp := Rect(0, 0, 0, 0);  // to silence the compiler
   if IntersectRect(Tmp, Rc, ScTop) and ScTopVisible then
   begin
     if Assigned(FOnCustomDrawScroller)
@@ -1161,7 +1199,7 @@ var
   ppi: Integer;
   {$ENDIF}
 begin
-  CopyRect(RcItem, Rc);
+  RcItem := Rc;
   with ACanvas do
   begin
     Brush.Style := bsSolid;
@@ -1243,6 +1281,10 @@ begin
       ImgWidth := Img.Width;
       ImgHeight := Img.Height;
       {$ENDIF}
+    end else
+    begin
+      ImgWidth := 0;
+      ImgHeight := 0;
     end;
 
     w := TextWidth(Str);
@@ -1288,9 +1330,9 @@ var
   x, y, w, h, i: Integer;
   Old: TColor;
 begin
-  CopyRect(RcItem, Rc);
-  CopyRect(Rc2, Rc);
-  Rc2.Bottom := Rc2.Bottom + 1;
+  RcItem := Rc;
+  Rc2 := Rc;
+  inc(Rc2.Bottom);
   case FAlignment of
     saLeft:
       begin
@@ -1563,6 +1605,7 @@ end;
 
 procedure TNiceSideBar.WMSize(var Msg: {$IFDEF FPC}TLMSize{$ELSE}TWMSize{$ENDIF});
 begin
+  Unused(Msg);
   TopIndex := 0;
   ListChange(False);
   Invalidate;
@@ -1570,6 +1613,7 @@ end;
 
 procedure TNiceSidebar.CMColorChanged(var Msg: {$IFDEF FPC}TLMessage{$ELSE}TMessage{$ENDIF});
 begin
+  Unused(Msg);
   Invalidate;
 end;
 
@@ -1622,7 +1666,7 @@ begin
       Break;
     end;
   end;
-  DoDrawItem(i);
+  InvalidateItem(i);
 end;
 
 procedure TNiceSideBar.UpdateItems;
@@ -1671,8 +1715,8 @@ begin
     begin
       if FItems[FItemIndex].FExpanded then
       begin
-        DoDrawItem(LastIndex);
-        DoDrawItem(LastSubIndex);
+        InvalidateItem(LastIndex);
+        InvalidateItem(LastSubIndex);
       end else
       begin
         FItems[FItemIndex].Expand;
@@ -1680,8 +1724,8 @@ begin
       end;
     end else
     begin
-      DoDrawItem(LastIndex);
-      DoDrawItem(LastSubIndex);
+      InvalidateItem(LastIndex);
+      InvalidateItem(LastSubIndex);
     end;
 
     if IsUpdating then
@@ -1701,8 +1745,8 @@ begin
         Break;
       end;
     end;
-    if Redraw
-      then DoDrawItem(LastIndex);
+    if Redraw then
+      InvalidateItem(LastIndex);
   end;
 end;
 
@@ -1735,10 +1779,10 @@ begin
         end;
       end;
     end;
-    DoDrawItem(LastSubIndex);
+    InvalidateItem(LastSubIndex);
     LastSubIndex := i;
-    if (i > -1)
-      then DoDrawItem(i);
+    if (i > -1) then
+      InvalidateItem(i);
   end;
 end;
 
@@ -1969,13 +2013,13 @@ begin
     begin
       LastHover := TopIndex;
       HoverIndex := TopIndex;
-      DoDrawItem(HoverIndex);
+      InvalidateItem(HoverIndex);
     end else
     begin
       HoverIndex := Min(FList.Count-1, HoverIndex + 1);
-      if (LastHover >= 0) and (LastHover < FList.Count)
-        then DoDrawItem(LastHover);
-      DoDrawItem(HoverIndex);
+      if (LastHover >= 0) and (LastHover < FList.Count) then
+        InvalidateItem(LastHover);
+      InvalidateItem(HoverIndex);
       LastHover := HoverIndex;
     end;
     if (HoverIndex >= BottomIndex-1) and ScBottomVisible then
@@ -1999,13 +2043,13 @@ begin
     begin
       LastHover := BottomIndex;
       HoverIndex := BottomIndex;
-      DoDrawItem(HoverIndex);
+      InvalidateItem(HoverIndex);
     end else
     begin
       HoverIndex := Max(0, HoverIndex - 1);
-      if (LastHover >= 0) and (LastHover < FList.Count)
-        then DoDrawItem(LastHover);
-      DoDrawItem(HoverIndex);
+      if (LastHover >= 0) and (LastHover < FList.Count) then
+        InvalidateItem(LastHover);
+      InvalidateItem(HoverIndex);
       LastHover := HoverIndex;
     end;
   end else
@@ -2014,7 +2058,7 @@ begin
     if (HoverIndex < TopIndex) or (HoverIndex > BottomIndex)
         or (HoverIndex < 0) or (HoverIndex >= FList.Count)
       then Exit;
-    CopyRect(Rc, PSBInfo(FList[HoverIndex])^.Rc);
+    Rc := PSBInfo(FList[HoverIndex])^.Rc;
     OffsetRect(Rc, 0, -DeltaY);
     MouseDown(mbLeft, [], Rc.Left + 1, Rc.Top + 1);
   end;

components/nicesidebar/source/NiceSideBarReg.pas

@@ -24,10 +24,10 @@ uses
 
 type
   TNiceSideBarEditor = class(TComponentEditor)
-  protected
+  public
+    procedure ExecuteVerb(Index: Integer); override;
     function GetVerbCount: Integer; override;
     function GetVerb(Index: Integer): string; override;
-    procedure ExecuteVerb(Index: Integer); override;
   end;
 
 
@@ -59,7 +59,7 @@ function TNiceSideBarEditor.GetVerb(Index: Integer): string;
 begin
   case Index of
     0: Result := 'Edit Items ...';
-    1: Result := 'About';
+    1: Result := 'About TNiceSideBar...';
   end;
 end;