LCL, grids, improved dbgrid ownerdraw delphi compatibility, fixed dbgrid scroll issue (9219), improved and fixed dbgrid with native style

git-svn-id: trunk@11468 -

lcl/dbgrids.pas

@@ -45,7 +45,7 @@ interface
 
 uses
   Classes, LCLIntf, LCLProc, Graphics, SysUtils, LCLType, stdctrls, DB,
-  LMessages, Grids, Dialogs, Controls;
+  LMessages, Grids, Dialogs, Controls, Themes;
 
 type
   TCustomDbGrid = class;
@@ -109,7 +109,10 @@ type
   TDbGridSelEditorEvent =
     procedure(Sender: TObject; Column: TColumn;
               var Editor: TWinControl) of object;
-
+              
+  TPrepareDbGridCanvasEvent =
+    procedure(sender: TObject; DataCol: Integer;
+              Column: TColumn; AState: TGridDrawState) of object;
 
 type
 
@@ -312,6 +315,7 @@ type
     FCheckedBitmap, FUnCheckedBitmap, FGrayedBitmap: TBitmap;
     FNeedUpdateWidths: boolean;
     FSelectedRows: TBookmarkList;
+    FOnPrepareCanvas: TPrepareDbGridCanvasEvent;
     procedure EmptyGrid;
     procedure CheckWidths;
     function GetCurrentColumn: TColumn;
@@ -380,11 +384,13 @@ type
     function  DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
     function  DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
     procedure DoOnChangeBounds; override;
+    procedure DoPrepareCanvas(aCol,aRow:Integer; aState: TGridDrawState); override;
     procedure DrawAllRows; override;
     procedure DrawFocusRect(aCol,aRow:Integer; ARect:TRect); override;
     procedure DrawRow(ARow: Integer); override;
     procedure DrawCell(aCol,aRow: Integer; aRect: TRect; aState:TGridDrawState); override;
     procedure DrawCheckboxBitmaps(aCol: Integer; aRect: TRect; F: TField);
+    procedure DrawFixedText(aCol, aRow: Integer; aRect: TRect; aState: TGridDrawState);
     procedure EditingColumn(aCol: Integer; Ok: boolean);
     procedure EditorCancelEditing;
     procedure EditorDoGetValue; override;
@@ -442,6 +448,7 @@ type
     property OnColumnSized: TNotifyEvent read FOnColumnSized write FOnColumnSized;
     property OnDrawColumnCell: TDrawColumnCellEvent read FOnDrawColumnCell write FOnDrawColumnCell;
     property OnFieldEditMask: TGetDbEditMaskEvent read FOnFieldEditMask write FOnFieldEditMask;
+    property OnPrepareCanvas: TPrepareDbGridCanvasEvent read FOnPrepareCanvas write FOnPrepareCanvas;
     property OnSelectEditor: TDbGridSelEditorEvent read FOnSelectEditor write FOnSelectEditor;
     property OnTitleClick: TDBGridClickEvent read FOnTitleClick write FOnTitleClick;
     property OnUserCheckboxBitmap: TUserCheckboxBitmapEvent read FOnUserCheckboxBitmap write FOnUserCheckboxBitmap;
@@ -1692,31 +1699,16 @@ end;
 
 procedure TCustomDBGrid.DefaultDrawCell(aCol, aRow: Integer; aRect: TRect;
   aState: TGridDrawState);
-
+  
-  function GetDatasetState: TDataSetState;
-  begin
-    if FDatalink.Active then
-      result := FDataLink.DataSet.State
-    else
-      result := dsInactive;
-  end;
-
 var
   S: string;
   F: TField;
 begin
+
   if gdFixed in aState then begin
-    if (ACol=0) and FDrawingActiveRecord then begin
+
-      DrawIndicator(Canvas, aRect, GetDataSetState, FDrawingMultiSelRecord);
-      {$ifdef dbgGridPaint}
-      dbgOut('>');
-      {$endif}
-    end else
-    if (ACol=0) and FDrawingMultiSelRecord then
-      DrawIndicator(Canvas, aRect, dsCurValue{dummy}, True)
-    else
     if TitleStyle<>tsNative then
-      DrawColumnText(aCol, aRow, aRect, aState);
+      DrawFixedText(aCol, aRow, aRect, aState);
 
   end else
   if not FDrawingEmptyDataset then begin
@@ -1757,6 +1749,18 @@ begin
   EndUpdate(False);
 end;
 
+procedure TCustomDBGrid.DoPrepareCanvas(aCol, aRow: Integer;
+  aState: TGridDrawState);
+var
+  DataCol: Integer;
+begin
+  if (ARow>=FixedRows) and Assigned(OnPrepareCanvas) then begin
+    DataCol := ColumnIndexFromGridColumn(aCol);
+    if DataCol>=0 then
+      OnPrepareCanvas(Self, DataCol, TColumn(Columns[DataCol]), aState);
+  end;
+end;
+
 procedure TCustomDBGrid.BeforeMoveSelection(const DCol,DRow: Integer);
 begin
   if FSelectionLock then
@@ -2399,7 +2403,7 @@ procedure TCustomDBGrid.DrawFocusRect(aCol, aRow: Integer; ARect: TRect);
 begin
   // Draw focused cell if we have the focus
   if Self.Focused and (dgAlwaysShowSelection in Options) and
-    FDatalink.Active then
+    FDatalink.Active and DefaultDrawing then
   begin
     CalcFocusRect(aRect);
     DrawRubberRect(Canvas, aRect, FocusColor);
@@ -2430,30 +2434,53 @@ end;
 
 procedure TCustomDBGrid.DrawCell(aCol, aRow: Integer; aRect: TRect;
   aState: TGridDrawState);
+var
+  DataCol: Integer;
 begin
   PrepareCanvas(aCol, aRow, aState);
-  if DefaultDrawing then
+  
+  if (gdFixed in aState) or DefaultDrawing then
     Canvas.FillRect(aRect);
+
   {$ifdef dbgGridPaint}
   DbgOut(' ',IntToStr(aCol));
   if gdSelected in aState then DbgOut('S');
   if gdFocused in aState then DbgOut('*');
   if gdFixed in aState then DbgOut('F');
   {$endif dbgGridPaint}
-  if Assigned(OnDrawColumnCell) and not(CsDesigning in ComponentState) then
+
-    OnDrawColumnCell(Self, aRect, aCol, TColumn(ColumnFromGridColumn(aCol)), aState)
+  if (gdFixed in aState) or DefaultDrawing then
-  else
     DefaultDrawCell(aCol, aRow, aRect, aState);
+  
+  if (ARow>=FixedRows) and Assigned(OnDrawColumnCell) and
+     not (csDesigning in ComponentState) then begin
+     
+    DataCol := ColumnIndexFromGridColumn(aCol);
+    if DataCol>=0 then
+      OnDrawColumnCell(Self, aRect, DataCol, TColumn(Columns[DataCol]), aState);
+  end;
+
   DrawCellGrid(aCol, aRow, aRect, aState);
-  if TitleStyle=tsNative then
+
-    DrawColumnText(aCol,aRow,aRect,aState);
+  if TitleStyle=tsNative then begin
+    if gdFixed in aState then
+      DrawFixedText(aCol,aRow,aRect,aState)
+    else
+      DrawColumnText(aCol,aRow,aRect,aState);
+  end;
 end;
 
 procedure TCustomDBGrid.DrawCheckboxBitmaps(aCol: Integer; aRect: TRect;
   F: TField);
+const
+  arrtb:array[TDbGridCheckboxState] of TThemedButton =
+    (tbCheckBoxUncheckedNormal, tbCheckBoxCheckedNormal, tbCheckBoxMixedNormal);
 var
   ChkBitmap: TBitmap;
-  XPos,YPos: Integer;
+  XPos,YPos,CSize: Integer;
+  AState: TDbGridCheckboxState;
+  details: TThemedElementDetails;
+  PaintRect: TRect;
 begin
   if (aCol=Col) and FDrawingActiveRecord then begin
     // show checkbox only if overriden editor is hidden
@@ -2462,33 +2489,69 @@ begin
   end;
 
   // by SSY
-	if (F<>nil) then
+  if (F<>nil) then
-  	if F.DataType=ftBoolean then
+    if F.DataType=ftBoolean then
       if F.IsNull then
-    		ChkBitmap := GetImageForCheckBox(gcbpGrayed)
+    	  AState := gcbpGrayed
       else
-        if F.AsBoolean then
+      if F.AsBoolean then
-          ChkBitmap := GetImageForCheckBox(gcbpChecked)
+        AState := gcbpChecked
-        else
+      else
-        	ChkBitmap := GetImageForCheckBox(gcbpUnChecked)
+        AState := gcbpUnChecked
     else
       if ValueMatch(F.AsString, TColumn(ColumnFromGridColumn(aCol)).ValueChecked) then
-        ChkBitmap := GetImageForCheckBox(gcbpChecked)
+        AState := gcbpChecked
       else
-      	if ValueMatch(F.AsString, TColumn(ColumnFromGridColumn(aCol)).ValueUnChecked) then
+      if ValueMatch(F.AsString, TColumn(ColumnFromGridColumn(aCol)).ValueUnChecked) then
-      		ChkBitmap := GetImageForCheckBox(gcbpUnChecked)
+        AState := gcbpUnChecked
-        else
+      else
-          ChkBitmap := GetImageForCheckBox(gcbpGrayed)
+        AState := gcbpGrayed
   else
-    ChkBitmap := GetImageForCheckBox(gcbpGrayed);
+    AState := gcbpGrayed;
-
+    
-  if ChkBitmap<>nil then begin
+  if (TitleStyle=tsNative) and not assigned(OnUserCheckboxBitmap) then begin
-    XPos := Trunc((aRect.Left+aRect.Right-ChkBitmap.Width)/2);
+    Details := ThemeServices.GetElementDetails(arrtb[AState]);
-    YPos := Trunc((aRect.Top+aRect.Bottom-ChkBitmap.Height)/2);
+    CSize:= ThemeServices.GetDetailSize(Details);
-    Canvas.Draw(XPos, YPos, ChkBitmap);
+    with PaintRect do begin
+      Left := Trunc((aRect.Left + aRect.Right - CSize)/2);
+      Top  := Trunc((aRect.Top + aRect.Bottom - CSize)/2);
+      PaintRect := Bounds(Left, Top, CSize, CSize);
+    end;
+    ThemeServices.DrawElement(Canvas.Handle, Details, PaintRect, nil);
+  end else begin
+    ChkBitmap := GetImageForCheckBox(AState);
+    if ChkBitmap<>nil then begin
+      XPos := Trunc((aRect.Left+aRect.Right-ChkBitmap.Width)/2);
+      YPos := Trunc((aRect.Top+aRect.Bottom-ChkBitmap.Height)/2);
+      Canvas.Draw(XPos, YPos, ChkBitmap);
+    end;
   end;
 end;
 
+procedure TCustomDBGrid.DrawFixedText(aCol, aRow: Integer; aRect: TRect;
+  aState: TGridDrawState);
+
+  function GetDatasetState: TDataSetState;
+  begin
+    if FDatalink.Active then
+      result := FDataLink.DataSet.State
+    else
+      result := dsInactive;
+  end;
+
+begin
+  if (ACol=0) and FDrawingActiveRecord then begin
+    DrawIndicator(Canvas, aRect, GetDataSetState, FDrawingMultiSelRecord);
+    {$ifdef dbgGridPaint}
+    dbgOut('>');
+    {$endif}
+  end else
+  if (ACol=0) and FDrawingMultiSelRecord then
+    DrawIndicator(Canvas, aRect, dsCurValue{dummy}, True)
+  else
+    DrawColumnText(aCol, aRow, aRect, aState);
+end;
+
 function TCustomDBGrid.EditorCanAcceptKey(const ch: Char): boolean;
 var
   aField: TField;
@@ -2689,33 +2752,21 @@ end;
 
 procedure TCustomDBGrid.DefaultDrawColumnCell(const Rect: TRect;
   DataCol: Integer; Column: TColumn; State: TGridDrawState);
-
-  function GetDatasetState: TDataSetState;
-  begin
-    if FDatalink.Active then
-      result := FDataLink.DataSet.State
-    else
-      result := dsInactive;
-  end;
-  
 var
   S: string;
   F: TField;
 begin
-  if gdFixed in State then begin
+
-    if (DataCol=0) and FDrawingActiveRecord then
+  F := Column.Field;
-      DrawIndicator(Canvas, Rect, GetDataSetState, FDrawingMultiSelRecord)
+  
-    else
+  DataCol := GridColumnFromColumnIndex(DataCol);
-    if (DataCol=0) and FDrawingMultiSelRecord then
+
-      DrawIndicator(Canvas, Rect, dsCurValue{dummy}, True)
+  if DataCol>=FixedCols then
-    else
-    if (DataCol>=FixedCols) then
-      DrawCellText(0{dummy}, DataCol{dummy}, Rect, State,GetColumnTitle(DataCol));
-  end else begin
-    F := GetFieldFromGridColumn(DataCol);
     case ColumnEditorStyle(DataCol, F) of
+
       cbsCheckBoxColumn:
         DrawCheckBoxBitmaps(DataCol, Rect, F);
+
       else begin
         if F<>nil then begin
           if F.dataType <> ftBlob then
@@ -2726,8 +2777,8 @@ begin
           S := '';
         DrawCellText(0, DataCol, Rect, State, S);
       end;
+
     end;
-  end;
 end;
 
 function TCustomDBGrid.EditorByStyle(Style: TColumnButtonStyle): TWinControl;

lcl/grids.pas

@@ -475,6 +475,7 @@ type
     function IndexOf(Column: TGridColumn): Integer;
     function IsDefault: boolean;
     function HasIndex(Index: Integer): boolean;
+    function VisibleIndex(Index: Integer): Integer;
     property Grid: TCustomGrid read FGrid;
     property Items[Index: Integer]: TGridColumn read GetColumn write SetColumn; default;
     property VisibleCount: Integer read GetVisibleCount;
@@ -731,6 +732,7 @@ type
     procedure DoOPInsertColRow(IsColumn: boolean; index: integer);
     procedure DoOPMoveColRow(IsColumn: Boolean; FromIndex, ToIndex: Integer);
     procedure DoPasteFromClipboard; virtual;
+    procedure DoPrepareCanvas(aCol,aRow:Integer; aState: TGridDrawState); virtual;
     procedure DoSetBounds(ALeft, ATop, AWidth, AHeight: integer); override;
     procedure DrawBorder;
     procedure DrawAllRows; virtual;
@@ -775,6 +777,7 @@ type
     function  GetEditText(ACol, ARow: Longint): string; dynamic;
     function  GetFixedcolor: TColor; virtual;
     function  GetSelectedColor: TColor; virtual;
+    function  GridColumnFromColumnIndex(ColumnIndex: Integer): Integer;
 
     procedure HeaderClick(IsColumn: Boolean; index: Integer); dynamic;
     procedure HeaderSized(IsColumn: Boolean; index: Integer); dynamic;
@@ -2269,9 +2272,6 @@ var
       FGCache.AccumWidth[i]:=Pointer(PtrInt(FGCache.GridWidth));
       FGCache.GridWidth:=FGCache.GridWidth + GetColWidths(i);
       if i<FixedCols then FGCache.FixedWidth:=FGCache.GridWidth;
-      {$IfDef dbgVisualChange}
-      //DebugLn('FGCache.AccumWidth[',dbgs(i),']=',dbgs(Integer(FGCache.AccumWidth[i])));
-      {$Endif}
     end;
     FGCache.Gridheight:=0;
     FGCache.FixedHeight:=0;
@@ -2279,9 +2279,6 @@ var
       FGCache.AccumHeight[i]:=Pointer(PtrInt(FGCache.Gridheight));
       FGCache.Gridheight:=FGCache.Gridheight+GetRowHeights(i);
       if i<FixedRows then FGCache.FixedHeight:=FGCache.GridHeight;
-      {$IfDef dbgVisualChange}
-      //DebugLn('FGCache.AccumHeight[',dbgs(i),']=',dbgs(Integer(FGCache.AccumHeight[i])));
-      {$Endif}
     end;
   end;
   procedure CalcScrollbarsVisibility;
@@ -2721,8 +2718,8 @@ begin
     Canvas.Brush.Color := clWindow;
     Canvas.Font.Color := clWindowText;
   end;
-  if Assigned(OnPrepareCanvas) then
+  
-    OnPrepareCanvas(Self, aCol, aRow, aState);
+  DoPrepareCanvas(aCol, aRow, aState);
 end;
 
 procedure TCustomGrid.ResetHotCell;
@@ -4816,9 +4813,40 @@ begin
 end;
 
 procedure TCustomGrid.DoOnChangeBounds;
+var
+  PrevSpace: Integer;
+  NewTopLeft, AvailSpace: TPoint;
 begin
   inherited DoOnChangeBounds;
-  VisualChange;
+
+  AVailSpace.x := ClientWidth - FGCache.MaxClientXY.x;
+  AVailSpace.y := ClientHeight - FGCache.MaxClientXY.y;
+  NewTopLeft := FTopLeft;
+  
+  while (AvailSpace.x>0) and (NewTopLeft.x>FixedCols) do begin
+    PrevSpace := GetColWidths(NewTopLeft.x-1);
+    if AvailSpace.x>(PrevSpace-FGCache.TLColOff) then
+      Dec(NewTopLeft.x, 1);
+    Dec(AvailSpace.x, PrevSpace);
+  end;
+  
+  while (AvailSpace.y>0) and (NewTopLeft.y>FixedRows) do begin
+    PrevSpace := GetRowHeights(NewTopLeft.y-1);
+    if AvailSpace.y>PrevSpace then
+      Dec(NewTopLeft.y, 1);
+    Dec(AvailSpace.y, PrevSpace);
+  end;
+
+  if not PointIgual(FTopleft,NewTopLeft) then begin
+    FTopLeft := NewTopleft;
+    FGCache.TLColOff := 0;
+    FGCache.TLRowOff := 0;
+    if goSmoothScroll in options then begin
+      // TODO: adjust new TLColOff and TLRowOff
+    end;
+    DoTopLeftChange(True);
+  end else
+    VisualChange;
 end;
 
 procedure TCustomGrid.DoPasteFromClipboard;
@@ -4826,6 +4854,12 @@ begin
   //
 end;
 
+procedure TCustomGrid.DoPrepareCanvas(aCol,aRow:Integer; aState: TGridDrawState);
+begin
+  if Assigned(OnPrepareCanvas) then
+    OnPrepareCanvas(Self, aCol, aRow, aState);
+end;
+
 procedure TCustomGrid.DoSetBounds(ALeft, ATop, AWidth, AHeight: integer);
 begin
   FLastWidth := ClientWidth;
@@ -5908,6 +5942,13 @@ begin
   Result:=FSelectedColor;
 end;
 
+function TCustomGrid.GridColumnFromColumnIndex(ColumnIndex: Integer): Integer;
+begin
+  result := Columns.VisibleIndex(ColumnIndex);
+  if result>=0 then
+    result := result + FixedCols;
+end;
+
 function TCustomGrid.GetEditMask(ACol, ARow: Longint): string;
 begin
   result:='';
@@ -8542,6 +8583,17 @@ begin
   result := (index>-1)and(index<count);
 end;
 
+function TGridColumns.VisibleIndex(Index: Integer): Integer;
+var
+  i: Integer;
+begin
+  result := -1;
+  if HasIndex(Index) and Items[Index].Visible then
+    for i:=0 to Index do
+      if Items[i].Visible then
+        inc(result);
+end;
+
 { TButtonCellEditor }
 
 procedure TButtonCellEditor.msg_SetGrid(var Msg: TGridMessage);