paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-12 14:29:36 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL, implements cbsColumnCheckbox in TDrawGrid/TStringGrid, issue #8682

Browse Source 
git-svn-id: trunk@17837 -
This commit is contained in:
jesus 2008-12-15 04:18:02 +00:00
parent 351862c47d
commit 2ad9a36af2
2 changed files with 240 additions and 168 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

186
lcl/dbgrids.pas
View File

@ -78,8 +78,6 @@ type
gsRemovingAutoColumns); gsRemovingAutoColumns);
TDbGridStatus = set of TDbGridStatusItem; TDbGridStatus = set of TDbGridStatusItem;
TDBGridCheckBoxState = (gcbpUnChecked, gcbpChecked, gcbpGrayed);
TDataSetScrolledEvent = TDataSetScrolledEvent =
procedure(DataSet: TDataSet; Distance: Integer) of object; procedure(DataSet: TDataSet; Distance: Integer) of object;
@ -97,10 +95,6 @@ type
procedure (Sender: TObject; const Field: TField; procedure (Sender: TObject; const Field: TField;
var Value: string) of object; var Value: string) of object;
TUserCheckBoxBitmapEvent =
procedure(Sender: TObject; const CheckedState: TDbGridCheckboxState;
ABitmap: TBitmap) of object;
TDbGridSelEditorEvent = TDbGridSelEditorEvent =
procedure(Sender: TObject; Column: TColumn; procedure(Sender: TObject; Column: TColumn;
var Editor: TWinControl) of object; var Editor: TWinControl) of object;
@ -214,39 +208,31 @@ type
FField: TField; FField: TField;
FIsAutomaticColumn: boolean; FIsAutomaticColumn: boolean;
FDesignIndex: Integer; FDesignIndex: Integer;
FValueChecked,FValueUnchecked: PChar;
procedure ApplyDisplayFormat; procedure ApplyDisplayFormat;
function GetDataSet: TDataSet; function GetDataSet: TDataSet;
function GetDisplayFormat: string; function GetDisplayFormat: string;
function GetField: TField; function GetField: TField;
function GetIsDesignColumn: boolean; function GetIsDesignColumn: boolean;
function GetValueChecked: string;
function GetValueUnchecked: string;
function IsDisplayFormatStored: boolean; function IsDisplayFormatStored: boolean;
function IsValueCheckedStored: boolean;
function IsValueUncheckedStored: boolean;
procedure SetDisplayFormat(const AValue: string); procedure SetDisplayFormat(const AValue: string);
procedure SetField(const AValue: TField); procedure SetField(const AValue: TField);
procedure SetFieldName(const AValue: String); procedure SetFieldName(const AValue: String);
procedure SetValueChecked(const AValue: string);
procedure SetValueUnchecked(const AValue: string);
protected protected
function CreateTitle: TGridColumnTitle; override; function CreateTitle: TGridColumnTitle; override;
function GetDefaultAlignment: TAlignment; override; function GetDefaultAlignment: TAlignment; override;
function GetDefaultDisplayFormat: string; function GetDefaultDisplayFormat: string;
function GetDefaultValueChecked: string; virtual; function GetDefaultValueChecked: string; override;
function GetDefaultValueUnchecked: string; virtual; function GetDefaultValueUnchecked: string; override;
function GetDefaultVisible: boolean; override; function GetDefaultVisible: boolean; override;
function GetDisplayName: string; override; function GetDisplayName: string; override;
function GetDefaultReadOnly: boolean; override; function GetDefaultReadOnly: boolean; override;
function GetDefaultWidth: Integer; override; function GetDefaultWidth: Integer; override;
function GetPickList: TStrings; override; function GetPickList: TStrings; override;
property IsAutomaticColumn: boolean read FIsAutomaticColumn; property IsAutomaticColumn: boolean read FIsAutomaticColumn;
property IsDesignColumn: boolean read GetIsDesignColumn; property IsDesignColumn: boolean read GetIsDesignColumn;
procedure LinkField; procedure LinkField;
public public
constructor Create(ACollection: TCollection); override; constructor Create(ACollection: TCollection); override;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override; procedure Assign(Source: TPersistent); override;
function IsDefault: boolean; override; function IsDefault: boolean; override;
property DesignIndex: integer read FDesignIndex; property DesignIndex: integer read FDesignIndex;
@ -255,10 +241,6 @@ type
property FieldName: String read FFieldName write SetFieldName; property FieldName: String read FFieldName write SetFieldName;
property DisplayFormat: string read GetDisplayFormat write SetDisplayFormat property DisplayFormat: string read GetDisplayFormat write SetDisplayFormat
stored IsDisplayFormatStored; stored IsDisplayFormatStored;
property ValueChecked: string read GetValueChecked write SetValueChecked
stored IsValueCheckedStored;
property ValueUnchecked: string read GetValueUnchecked write SetValueUnchecked
stored IsValueUncheckedStored;
end; end;
TColumnOrder = (coDesignOrder, coFieldIndexOrder); TColumnOrder = (coDesignOrder, coFieldIndexOrder);
@ -294,7 +276,6 @@ type
FOnDrawColumnCell: TDrawColumnCellEvent; FOnDrawColumnCell: TDrawColumnCellEvent;
FOnFieldEditMask: TGetDbEditMaskEvent; FOnFieldEditMask: TGetDbEditMaskEvent;
FOnTitleClick: TDBGridClickEvent; FOnTitleClick: TDBGridClickEvent;
FOnUserCheckboxBitmap: TUserCheckboxBitmapEvent;
FOnSelectEditor: TDbGridSelEditorEvent; FOnSelectEditor: TDbGridSelEditorEvent;
FOptions: TDBGridOptions; FOptions: TDBGridOptions;
FReadOnly: Boolean; FReadOnly: Boolean;
@ -309,7 +290,6 @@ type
FDefaultColWidths: boolean; FDefaultColWidths: boolean;
FGridStatus: TDBGridStatus; FGridStatus: TDBGridStatus;
FOldControlStyle: TControlStyle; FOldControlStyle: TControlStyle;
FCheckedBitmap, FUnCheckedBitmap, FGrayedBitmap: TBitmap;
FSelectedRows: TBookmarkList; FSelectedRows: TBookmarkList;
FOnPrepareCanvas: TPrepareDbGridCanvasEvent; FOnPrepareCanvas: TPrepareDbGridCanvasEvent;
FKeyBookmark: TBookmarkStr; FKeyBookmark: TBookmarkStr;
@ -360,12 +340,10 @@ type
procedure EndUpdating; procedure EndUpdating;
function UpdatingData: boolean; function UpdatingData: boolean;
procedure SwapCheckBox; procedure SwapCheckBox;
function ValueMatch(const BaseValue, TestValue: string): Boolean;
procedure ToggleSelectedRow; procedure ToggleSelectedRow;
procedure SelectRecord(AValue: boolean); procedure SelectRecord(AValue: boolean);
procedure GetScrollbarParams(out aRange, aPage, aPos: Integer); procedure GetScrollbarParams(out aRange, aPage, aPos: Integer);
procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK; procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
function LoadResBitmapImage(const ResName: string): TBitmap;
procedure ClearSelection(selCurrent:boolean=false); procedure ClearSelection(selCurrent:boolean=false);
protected protected
procedure AddAutomaticColumns; procedure AddAutomaticColumns;
@ -409,7 +387,6 @@ type
function GetEditText(aCol, aRow: Longint): string; override; function GetEditText(aCol, aRow: Longint): string; override;
function GetFieldFromGridColumn(Column: Integer): TField; function GetFieldFromGridColumn(Column: Integer): TField;
function GetGridColumnFromField(F: TField): Integer; function GetGridColumnFromField(F: TField): Integer;
function GetImageForCheckBox(CheckBoxView: TDBGridCheckBoxState): TBitmap;
function GetIsCellSelected(aCol, aRow: Integer): boolean; override; function GetIsCellSelected(aCol, aRow: Integer): boolean; override;
function GridCanModify: boolean; function GridCanModify: boolean;
procedure GetSBVisibility(out HsbVisible,VsbVisible:boolean);override; procedure GetSBVisibility(out HsbVisible,VsbVisible:boolean);override;
@ -457,7 +434,6 @@ type
property OnPrepareCanvas: TPrepareDbGridCanvasEvent read FOnPrepareCanvas write FOnPrepareCanvas; property OnPrepareCanvas: TPrepareDbGridCanvasEvent read FOnPrepareCanvas write FOnPrepareCanvas;
property OnSelectEditor: TDbGridSelEditorEvent read FOnSelectEditor write FOnSelectEditor; property OnSelectEditor: TDbGridSelEditorEvent read FOnSelectEditor write FOnSelectEditor;
property OnTitleClick: TDBGridClickEvent read FOnTitleClick write FOnTitleClick; property OnTitleClick: TDBGridClickEvent read FOnTitleClick write FOnTitleClick;
property OnUserCheckboxBitmap: TUserCheckboxBitmapEvent read FOnUserCheckboxBitmap write FOnUserCheckboxBitmap;
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
procedure InitiateAction; override; procedure InitiateAction; override;
@ -1484,7 +1460,7 @@ begin
SelField.AsBoolean := not SelField.AsBoolean SelField.AsBoolean := not SelField.AsBoolean
else else
begin begin
if ValueMatch(TempColumn.ValueChecked, SelField.AsString) then if TempColumn.ValueChecked=SelField.AsString then
SelField.AsString := TempColumn.ValueUnchecked SelField.AsString := TempColumn.ValueUnchecked
else else
SelField.AsString := TempColumn.ValueChecked; SelField.AsString := TempColumn.ValueChecked;
@ -1492,14 +1468,6 @@ begin
end; end;
end; end;
function TCustomDBGrid.ValueMatch(const BaseValue, TestValue: string): Boolean;
begin
if BaseValue=TestValue then
Result := True
else
Result := False;
end;
procedure TCustomDBGrid.ToggleSelectedRow; procedure TCustomDBGrid.ToggleSelectedRow;
begin begin
SelectRecord(not FSelectedRows.CurrentRowSelected); SelectRecord(not FSelectedRows.CurrentRowSelected);
@ -2300,19 +2268,6 @@ begin
end; end;
end; end;
function TCustomDBGrid.GetImageForCheckBox(CheckBoxView: TDBGridCheckBoxState): TBitmap;
begin
if CheckboxView=gcbpUnchecked then
Result := FUncheckedBitmap
else if CheckboxView=gcbpChecked then
Result := FCheckedBitmap
else
Result := FGrayedBitmap;
if Assigned(OnUserCheckboxBitmap) then
OnUserCheckboxBitmap(Self, CheckBoxView, Result);
end;
function TCustomDBGrid.GetIsCellSelected(aCol, aRow: Integer): boolean; function TCustomDBGrid.GetIsCellSelected(aCol, aRow: Integer): boolean;
begin begin
Result:=inherited GetIsCellSelected(aCol, aRow) or Result:=inherited GetIsCellSelected(aCol, aRow) or
@ -2463,15 +2418,8 @@ end;
procedure TCustomDBGrid.DrawCheckboxBitmaps(aCol: Integer; aRect: TRect; procedure TCustomDBGrid.DrawCheckboxBitmaps(aCol: Integer; aRect: TRect;
F: TField); F: TField);
const
arrtb:array[TDbGridCheckboxState] of TThemedButton =
(tbCheckBoxUncheckedNormal, tbCheckBoxCheckedNormal, tbCheckBoxMixedNormal);
var var
ChkBitmap: TBitmap; AState: TCheckboxState;
XPos,YPos,CSize: Integer;
AState: TDbGridCheckboxState;
details: TThemedElementDetails;
PaintRect: TRect;
begin begin
if (aCol=Col) and FDrawingActiveRecord then begin if (aCol=Col) and FDrawingActiveRecord then begin
// show checkbox only if overriden editor is hidden // show checkbox only if overriden editor is hidden
@ -2483,40 +2431,25 @@ begin
if (F<>nil) then if (F<>nil) then
if F.DataType=ftBoolean then if F.DataType=ftBoolean then
if F.IsNull then if F.IsNull then
AState := gcbpGrayed AState := cbGrayed
else else
if F.AsBoolean then if F.AsBoolean then
AState := gcbpChecked AState := cbChecked
else else
AState := gcbpUnChecked AState := cbUnChecked
else else
if ValueMatch(F.AsString, TColumn(ColumnFromGridColumn(aCol)).ValueChecked) then if F.AsString=ColumnFromGridColumn(aCol).ValueChecked then
AState := gcbpChecked AState := cbChecked
else else
if ValueMatch(F.AsString, TColumn(ColumnFromGridColumn(aCol)).ValueUnChecked) then
AState := gcbpUnChecked
else
AState := gcbpGrayed
else
AState := gcbpGrayed;
if (TitleStyle=tsNative) and not assigned(OnUserCheckboxBitmap) then begin if F.AsString=ColumnFromGridColumn(aCol).ValueUnChecked then
Details := ThemeServices.GetElementDetails(arrtb[AState]); AState := cbUnChecked
CSize:= ThemeServices.GetDetailSize(Details); else
with PaintRect do begin AState := cbGrayed
Left := Trunc((aRect.Left + aRect.Right - CSize)/2); else
Top := Trunc((aRect.Top + aRect.Bottom - CSize)/2); AState := cbGrayed;
PaintRect := Bounds(Left, Top, CSize, CSize);
end; DrawGridCheckboxBitmaps(ARect, AState);
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; end;
procedure TCustomDBGrid.DrawFixedText(aCol, aRow: Integer; aRect: TRect; procedure TCustomDBGrid.DrawFixedText(aCol, aRow: Integer; aRect: TRect;
@ -2712,11 +2645,6 @@ begin
// What a dilema!, we need ssAutoHorizontal and ssVertical!!! // What a dilema!, we need ssAutoHorizontal and ssVertical!!!
ScrollBars:=ssBoth; ScrollBars:=ssBoth;
// Default bitmaps for cbsCheckedColumn
FUnCheckedBitmap := LoadResBitmapImage('dbgriduncheckedcb');
FCheckedBitmap := LoadResBitmapImage('dbgridcheckedcb');
FGrayedBitmap := LoadResBitmapImage('dbgridgrayedcb');
end; end;
procedure TCustomDBGrid.InitiateAction; procedure TCustomDBGrid.InitiateAction;
@ -2821,19 +2749,6 @@ begin
Message.Result := PtrUInt(FDataLink); Message.Result := PtrUInt(FDataLink);
end; end;
function TCustomDBGrid.LoadResBitmapImage(const ResName: string): TBitmap;
var
C: TCustomBitmap;
begin
C := CreateBitmapFromLazarusResource(ResName);
if C<>nil then begin
Result := TBitmap.Create;
Result.Assign(C);
C.Free;
end else
Result:=nil;
end;
procedure TCustomDBGrid.ClearSelection(selCurrent:boolean=false); procedure TCustomDBGrid.ClearSelection(selCurrent:boolean=false);
begin begin
if [dgMultiSelect,dgPersistentMultiSelect]*Options=[dgMultiSelect] then begin if [dgMultiSelect,dgPersistentMultiSelect]*Options=[dgMultiSelect] then begin
@ -2847,9 +2762,6 @@ end;
destructor TCustomDBGrid.Destroy; destructor TCustomDBGrid.Destroy;
begin begin
FUncheckedBitmap.Free;
FCheckedBitmap.Free;
FGrayedBitmap.Free;
FSelectedRows.Free; FSelectedRows.Free;
FDataLink.OnDataSetChanged:=nil; FDataLink.OnDataSetChanged:=nil;
FDataLink.OnRecordChanged:=nil; FDataLink.OnRecordChanged:=nil;
@ -3176,22 +3088,6 @@ begin
end; end;
end; end;
function TColumn.GetValueChecked: string;
begin
if FValueChecked = nil then
Result := GetDefaultValueChecked
else
Result := FValueChecked;
end;
function TColumn.GetValueUnchecked: string;
begin
if FValueUnChecked = nil then
Result := GetDefaultValueUnChecked
else
Result := FValueUnChecked;
end;
procedure TColumn.ApplyDisplayFormat; procedure TColumn.ApplyDisplayFormat;
begin begin
if (FField <> nil) and FDisplayFormatChanged then begin if (FField <> nil) and FDisplayFormatChanged then begin
@ -3215,16 +3111,6 @@ begin
Result := FDisplayFormatChanged; Result := FDisplayFormatChanged;
end; end;
function TColumn.IsValueCheckedStored: boolean;
begin
result := FValueChecked <> nil;
end;
function TColumn.IsValueUncheckedStored: boolean;
begin
Result := FValueUnchecked <> nil;
end;
procedure TColumn.SetDisplayFormat(const AValue: string); procedure TColumn.SetDisplayFormat(const AValue: string);
begin begin
if (not FDisplayFormatChanged)or(CompareText(AValue, FDisplayFormat)<>0) then begin if (not FDisplayFormatChanged)or(CompareText(AValue, FDisplayFormat)<>0) then begin
@ -3263,32 +3149,6 @@ begin
result :=nil; result :=nil;
end; end;
procedure TColumn.SetValueChecked(const AValue: string);
begin
if (FValueChecked=nil)or(CompareText(AValue, FValueChecked)<>0) then begin
if FValueChecked<>nil then
StrDispose(FValueChecked)
else
if CompareText(AValue, GetDefaultValueChecked)=0 then
exit;
FValueChecked := StrNew(PChar(AValue));
Changed(False);
end;
end;
procedure TColumn.SetValueUnchecked(const AValue: string);
begin
if (FValueUnchecked=nil)or(CompareText(AValue, FValueUnchecked)<>0) then begin
if FValueUnchecked<>nil then
StrDispose(FValueUnchecked)
else
if CompareText(AValue, GetDefaultValueUnchecked)=0 then
exit;
FValueUnchecked := StrNew(PChar(AValue));
Changed(False);
end;
end;
procedure TColumn.Assign(Source: TPersistent); procedure TColumn.Assign(Source: TPersistent);
begin begin
if Source is TColumn then begin if Source is TColumn then begin
@ -3365,13 +3225,6 @@ begin
end; end;
end; end;
destructor TColumn.Destroy;
begin
if FValueChecked<>nil then StrDispose(FValueChecked);
if FValueUnchecked<>nil then StrDispose(FValueUnchecked);
inherited Destroy;
end;
function TColumn.IsDefault: boolean; function TColumn.IsDefault: boolean;
begin begin
result := not FDisplayFormatChanged and (inherited IsDefault()); result := not FDisplayFormatChanged and (inherited IsDefault());
@ -3593,7 +3446,4 @@ begin
result := CompareMemRange(@s1[1],@s2[1], Length(s1)); result := CompareMemRange(@s1[1],@s2[1], Length(s1));
end; end;
initialization
{$I lcl_dbgrid_images.lrs}
end. end.

222
lcl/grids.pas
View File

@ -305,6 +305,10 @@ type
procedure(sender: TObject; aCol, aRow: Integer; procedure(sender: TObject; aCol, aRow: Integer;
aState: TGridDrawState) of object; aState: TGridDrawState) of object;
TUserCheckBoxBitmapEvent =
procedure(Sender: TObject; const CheckedState: TCheckboxState;
ABitmap: TBitmap) of object;
{ TVirtualGrid } { TVirtualGrid }
TVirtualGrid=class TVirtualGrid=class
@ -417,6 +421,7 @@ type
FisDefaultFont: Boolean; FisDefaultFont: Boolean;
FPickList: TStrings; FPickList: TStrings;
FMinSize, FMaxSize, FSizePriority: ^Integer; FMinSize, FMaxSize, FSizePriority: ^Integer;
FValueChecked,FValueUnchecked: PChar;
procedure FontChanged(Sender: TObject); procedure FontChanged(Sender: TObject);
function GetAlignment: TAlignment; function GetAlignment: TAlignment;
@ -439,6 +444,8 @@ type
function IsMaxSizeStored: boolean; function IsMaxSizeStored: boolean;
function IsReadOnlyStored: boolean; function IsReadOnlyStored: boolean;
function IsSizePriorityStored: boolean; function IsSizePriorityStored: boolean;
function IsValueCheckedStored: boolean;
function IsValueUncheckedStored: boolean;
function IsVisibleStored: boolean; function IsVisibleStored: boolean;
function IsWidthStored: boolean; function IsWidthStored: boolean;
procedure SetAlignment(const AValue: TAlignment); procedure SetAlignment(const AValue: TAlignment);
@ -453,6 +460,8 @@ type
procedure SetReadOnly(const AValue: Boolean); procedure SetReadOnly(const AValue: Boolean);
procedure SetSizePriority(const AValue: Integer); procedure SetSizePriority(const AValue: Integer);
procedure SetTitle(const AValue: TGridColumnTitle); procedure SetTitle(const AValue: TGridColumnTitle);
procedure SetValueChecked(const AValue: string);
procedure SetValueUnchecked(const AValue: string);
procedure SetVisible(const AValue: Boolean); procedure SetVisible(const AValue: Boolean);
procedure SetWidth(const AValue: Integer); procedure SetWidth(const AValue: Integer);
protected protected
@ -465,8 +474,12 @@ type
function GetDefaultReadOnly: boolean; virtual; function GetDefaultReadOnly: boolean; virtual;
function GetDefaultSizePriority: Integer; function GetDefaultSizePriority: Integer;
function GetDefaultVisible: boolean; virtual; function GetDefaultVisible: boolean; virtual;
function GetDefaultValueChecked: string; virtual;
function GetDefaultValueUnchecked: string; virtual;
function GetDefaultWidth: Integer; virtual; function GetDefaultWidth: Integer; virtual;
function GetPickList: TStrings; virtual; function GetPickList: TStrings; virtual;
function GetValueChecked: string;
function GetValueUnchecked: string;
procedure ColumnChanged; virtual; procedure ColumnChanged; virtual;
procedure AllColumnsChange; procedure AllColumnsChange;
function CreateTitle: TGridColumnTitle; virtual; function CreateTitle: TGridColumnTitle; virtual;
@ -497,6 +510,11 @@ type
property Title: TGridColumnTitle read FTitle write SetTitle; property Title: TGridColumnTitle read FTitle write SetTitle;
property Width: Integer read GetWidth write SetWidth stored IsWidthStored default DEFCOLWIDTH; property Width: Integer read GetWidth write SetWidth stored IsWidthStored default DEFCOLWIDTH;
property Visible: Boolean read GetVisible write SetVisible stored IsVisibleStored default true; property Visible: Boolean read GetVisible write SetVisible stored IsVisibleStored default true;
property ValueChecked: string read GetValueChecked write SetValueChecked
stored IsValueCheckedStored;
property ValueUnchecked: string read GetValueUnchecked write SetValueUnchecked
stored IsValueUncheckedStored;
end; end;
TGridPropertyBackup=record TGridPropertyBackup=record
@ -591,6 +609,7 @@ type
FFastEditing: boolean; FFastEditing: boolean;
FAltColorStartNormal: boolean; FAltColorStartNormal: boolean;
FFlat: Boolean; FFlat: Boolean;
FOnUserCheckboxBitmap: TUserCheckboxBitmapEvent;
FSortOrder: TSortOrder; FSortOrder: TSortOrder;
FTitleImageList: TImageList; FTitleImageList: TImageList;
FTitleStyle: TTitleStyle; FTitleStyle: TTitleStyle;
@ -647,6 +666,7 @@ type
FAllowOutboundEvents: boolean; FAllowOutboundEvents: boolean;
FHeaderHotZones: TGridZoneSet; FHeaderHotZones: TGridZoneSet;
FHeaderPushZones: TGridZoneSet; FHeaderPushZones: TGridZoneSet;
FCheckedBitmap, FUnCheckedBitmap, FGrayedBitmap: TBitmap;
procedure AdjustCount(IsColumn:Boolean; OldValue, NewValue:Integer); procedure AdjustCount(IsColumn:Boolean; OldValue, NewValue:Integer);
procedure CacheVisibleGrid; procedure CacheVisibleGrid;
procedure CancelSelection; procedure CancelSelection;
@ -691,6 +711,7 @@ type
function GetColumns: TGridColumns; function GetColumns: TGridColumns;
function GetEditorBorderStyle: TBorderStyle; function GetEditorBorderStyle: TBorderStyle;
function GetBorderWidth: Integer; function GetBorderWidth: Integer;
function GetImageForCheckBox(CheckBoxView: TCheckBoxState): TBitmap;
function GetRowCount: Integer; function GetRowCount: Integer;
function GetRowHeights(Arow: Integer): Integer; function GetRowHeights(Arow: Integer): Integer;
function GetSelection: TGridRect; function GetSelection: TGridRect;
@ -707,6 +728,7 @@ type
function IsAltColorStored: boolean; function IsAltColorStored: boolean;
function IsColumnsStored: boolean; function IsColumnsStored: boolean;
function IsPushCellActive: boolean; function IsPushCellActive: boolean;
function LoadResBitmapImage(const ResName: string): TBitmap;
procedure OnTitleFontChanged(Sender: TObject); procedure OnTitleFontChanged(Sender: TObject);
procedure ReadColumns(Reader: TReader); procedure ReadColumns(Reader: TReader);
procedure ReadColWidths(Reader: TReader); procedure ReadColWidths(Reader: TReader);
@ -803,6 +825,7 @@ type
procedure DrawCell(aCol,aRow:Integer; aRect:TRect; aState:TGridDrawState); virtual; procedure DrawCell(aCol,aRow:Integer; aRect:TRect; aState:TGridDrawState); virtual;
procedure DrawCellGrid(aCol,aRow: Integer; aRect: TRect; aState: TGridDrawState); virtual; procedure DrawCellGrid(aCol,aRow: Integer; aRect: TRect; aState: TGridDrawState); virtual;
procedure DrawCellText(aCol,aRow: Integer; aRect: TRect; aState: TGridDrawState; aText: String); virtual; procedure DrawCellText(aCol,aRow: Integer; aRect: TRect; aState: TGridDrawState; aText: String); virtual;
procedure DrawGridCheckboxBitmaps(const aRect: TRect; const aState: TCheckboxState); virtual;
procedure DrawColRowMoving; procedure DrawColRowMoving;
procedure DrawColumnText(aCol,aRow: Integer; aRect: TRect; aState:TGridDrawState); virtual; procedure DrawColumnText(aCol,aRow: Integer; aRect: TRect; aState:TGridDrawState); virtual;
procedure DrawColumnTitleImage(var ARect: TRect; AColumnIndex: Integer); procedure DrawColumnTitleImage(var ARect: TRect; AColumnIndex: Integer);
@ -990,6 +1013,7 @@ type
property OnSelection: TOnSelectEvent read fOnSelection write fOnSelection; property OnSelection: TOnSelectEvent read fOnSelection write fOnSelection;
property OnSelectEditor: TSelectEditorEvent read FOnSelectEditor write FOnSelectEditor; property OnSelectEditor: TSelectEditorEvent read FOnSelectEditor write FOnSelectEditor;
property OnTopLeftChanged: TNotifyEvent read FOnTopLeftChanged write FOnTopLeftChanged; property OnTopLeftChanged: TNotifyEvent read FOnTopLeftChanged write FOnTopLeftChanged;
property OnUserCheckboxBitmap: TUserCheckboxBitmapEvent read FOnUserCheckboxBitmap write FOnUserCheckboxBitmap;
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
@ -1030,6 +1054,9 @@ type
TGetEditEvent = procedure (Sender: TObject; ACol, ARow: Integer; var Value: string) of object; TGetEditEvent = procedure (Sender: TObject; ACol, ARow: Integer; var Value: string) of object;
TSetEditEvent = procedure (Sender: TObject; ACol, ARow: Integer; const Value: string) of object; TSetEditEvent = procedure (Sender: TObject; ACol, ARow: Integer; const Value: string) of object;
TGetCheckboxStateEvent = procedure (Sender: TObject; ACol, ARow: Integer; var Value: TCheckboxState) of object;
TSetCheckboxStateEvent = procedure (Sender: TObject; ACol, ARow: Integer; const Value: TCheckboxState) of object;
{ TCustomDrawGrid } { TCustomDrawGrid }
@ -1039,11 +1066,15 @@ type
FOnColRowExchanged: TgridOperationEvent; FOnColRowExchanged: TgridOperationEvent;
FOnColRowInserted: TGridOperationEvent; FOnColRowInserted: TGridOperationEvent;
FOnColRowMoved: TgridOperationEvent; FOnColRowMoved: TgridOperationEvent;
FOnGetCheckboxState: TGetCheckboxStateEvent;
FOnGetEditMask: TGetEditEvent; FOnGetEditMask: TGetEditEvent;
FOnGetEditText: TGetEditEvent; FOnGetEditText: TGetEditEvent;
FOnHeaderClick, FOnHeaderSized: THdrEvent; FOnHeaderClick, FOnHeaderSized: THdrEvent;
FOnSelectCell: TOnSelectcellEvent; FOnSelectCell: TOnSelectcellEvent;
FOnSetCheckboxState: TSetCheckboxStateEvent;
FOnSetEditText: TSetEditEvent; FOnSetEditText: TSetEditEvent;
function CellNeedsCheckboxBitmaps(const aCol,aRow: Integer): boolean;
procedure DrawCellCheckboxBitmaps(const aCol,aRow: Integer; const aRect: TRect);
protected protected
FGrid: TVirtualGrid; FGrid: TVirtualGrid;
procedure CalcCellExtent(acol, aRow: Integer; var aRect: TRect); virtual; procedure CalcCellExtent(acol, aRow: Integer; var aRect: TRect); virtual;
@ -1055,6 +1086,7 @@ type
procedure DrawCell(aCol,aRow: Integer; aRect: TRect; aState:TGridDrawState); override; procedure DrawCell(aCol,aRow: Integer; aRect: TRect; aState:TGridDrawState); override;
procedure DrawCellAutonumbering(aCol,aRow: Integer; aRect: TRect; const aValue: string); virtual; procedure DrawCellAutonumbering(aCol,aRow: Integer; aRect: TRect; const aValue: string); virtual;
procedure DrawFocusRect(aCol,aRow: Integer; ARect: TRect); override; procedure DrawFocusRect(aCol,aRow: Integer; ARect: TRect); override;
procedure GetCheckBoxState(const aCol, aRow:Integer; var aState:TCheckboxState); virtual;
function GetEditMask(aCol, aRow: Longint): string; override; function GetEditMask(aCol, aRow: Longint): string; override;
function GetEditText(aCol, aRow: Longint): string; override; function GetEditText(aCol, aRow: Longint): string; override;
procedure HeaderClick(IsColumn: Boolean; index: Integer); override; procedure HeaderClick(IsColumn: Boolean; index: Integer); override;
@ -1065,6 +1097,11 @@ type
procedure SetEditText(ACol, ARow: Longint; const Value: string); override; procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
procedure SizeChanged(OldColCount, OldRowCount: Integer); override; procedure SizeChanged(OldColCount, OldRowCount: Integer); override;
property OnGetCheckboxState: TGetCheckboxStateEvent
read FOnGetCheckboxState write FOnGetCheckboxState;
property OnSetCheckboxState: TSetCheckboxStateEvent
read FOnSetCheckboxState write FOnSetCheckboxState;
public public
// to easy user call // to easy user call
@ -1351,6 +1388,7 @@ type
procedure DrawCellAutonumbering(aCol,aRow: Integer; aRect: TRect; const aValue: string); override; procedure DrawCellAutonumbering(aCol,aRow: Integer; aRect: TRect; const aValue: string); override;
//procedure EditordoGetValue; override; //procedure EditordoGetValue; override;
//procedure EditordoSetValue; override; //procedure EditordoSetValue; override;
procedure GetCheckBoxState(const aCol, aRow:Integer; var aState:TCheckboxState); override;
function GetEditText(aCol, aRow: Integer): string; override; function GetEditText(aCol, aRow: Integer): string; override;
procedure LoadContent(cfg: TXMLConfig; Version: Integer); override; procedure LoadContent(cfg: TXMLConfig; Version: Integer); override;
procedure Loaded; override; procedure Loaded; override;
@ -1984,6 +2022,19 @@ begin
result := (PushedCell.X<>-1) and (PushedCell.Y<>-1); result := (PushedCell.X<>-1) and (PushedCell.Y<>-1);
end; end;
function TCustomGrid.LoadResBitmapImage(const ResName: string): TBitmap;
var
C: TCustomBitmap;
begin
C := CreateBitmapFromLazarusResource(ResName);
if C<>nil then begin
Result := TBitmap.Create;
Result.Assign(C);
C.Free;
end else
Result:=nil;
end;
function TCustomGrid.IsTitleImageListStored: boolean; function TCustomGrid.IsTitleImageListStored: boolean;
begin begin
Result := FTitleImageList <> nil; Result := FTitleImageList <> nil;
@ -3408,6 +3459,36 @@ begin
end; end;
end; end;
procedure TCustomGrid.DrawGridCheckboxBitmaps(const aRect: TRect;
const aState: TCheckboxState);
const
arrtb:array[TCheckboxState] of TThemedButton =
(tbCheckBoxUncheckedNormal, tbCheckBoxCheckedNormal, tbCheckBoxMixedNormal);
var
ChkBitmap: TBitmap;
XPos,YPos,CSize: Integer;
details: TThemedElementDetails;
PaintRect: TRect;
begin
if (TitleStyle=tsNative) and not assigned(OnUserCheckboxBitmap) then begin
Details := ThemeServices.GetElementDetails(arrtb[AState]);
CSize:= ThemeServices.GetDetailSize(Details);
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 TCustomGrid.OnTitleFontChanged(Sender: TObject); procedure TCustomGrid.OnTitleFontChanged(Sender: TObject);
begin begin
FTitleFontIsDefault := False; FTitleFontIsDefault := False;
@ -4043,6 +4124,21 @@ begin
Result := 0 Result := 0
end; end;
function TCustomGrid.GetImageForCheckBox(CheckBoxView: TCheckBoxState
): TBitmap;
begin
if CheckboxView=cbUnchecked then
Result := FUncheckedBitmap
else if CheckboxView=cbChecked then
Result := FCheckedBitmap
else
Result := FGrayedBitmap;
if Assigned(OnUserCheckboxBitmap) then
OnUserCheckboxBitmap(Self, CheckBoxView, Result);
end;
function TCustomGrid.GetColumns: TGridColumns; function TCustomGrid.GetColumns: TGridColumns;
begin begin
result := FColumns; result := FColumns;
@ -7043,11 +7139,19 @@ begin
ResetHotCell; ResetHotCell;
ResetPushedCell; ResetPushedCell;
FSortOrder := soAscending; FSortOrder := soAscending;
// Default bitmaps for cbsCheckedColumn
FUnCheckedBitmap := LoadResBitmapImage('dbgriduncheckedcb');
FCheckedBitmap := LoadResBitmapImage('dbgridcheckedcb');
FGrayedBitmap := LoadResBitmapImage('dbgridgrayedcb');
end; end;
destructor TCustomGrid.Destroy; destructor TCustomGrid.Destroy;
begin begin
{$Ifdef DbgGrid}DebugLn('TCustomGrid.Destroy');{$Endif} {$Ifdef DbgGrid}DebugLn('TCustomGrid.Destroy');{$Endif}
FUncheckedBitmap.Free;
FCheckedBitmap.Free;
FGrayedBitmap.Free;
FreeThenNil(FButtonStringEditor); FreeThenNil(FButtonStringEditor);
FreeThenNil(FPickListEditor); FreeThenNil(FPickListEditor);
FreeThenNil(FStringEditor); FreeThenNil(FStringEditor);
@ -7724,6 +7828,26 @@ end;
{ TCustomDrawGrid } { TCustomDrawGrid }
function TCustomDrawGrid.CellNeedsCheckboxBitmaps(const aCol, aRow: Integer): boolean;
var
C: TGridColumn;
begin
Result := false;
if (aRow>=FixedRows) and Columns.Enabled then begin
C := ColumnFromGridColumn(aCol);
result := (C<>nil) and (C.ButtonStyle=cbsCheckboxColumn)
end;
end;
procedure TCustomDrawGrid.DrawCellCheckboxBitmaps(const aCol, aRow: Integer;
const aRect: TRect);
var
AState: TCheckboxState;
begin
AState := cbUnchecked;
GetCheckBoxState(aCol, aRow, aState);
DrawGridCheckboxBitmaps(aRect, aState);
end;
procedure TCustomDrawGrid.CalcCellExtent(acol, aRow: Integer; var aRect: TRect); procedure TCustomDrawGrid.CalcCellExtent(acol, aRow: Integer; var aRect: TRect);
begin begin
@ -7781,6 +7905,13 @@ begin
end; end;
end; end;
procedure TCustomDrawGrid.GetCheckBoxState(const aCol, aRow: Integer;
var aState: TCheckboxState);
begin
if assigned(FOnGetCheckboxState) then
OnGetCheckboxState(self, aCol, aRow, aState);
end;
procedure TCustomDrawGrid.ColRowExchanged(IsColumn:Boolean; index, WithIndex: Integer); procedure TCustomDrawGrid.ColRowExchanged(IsColumn:Boolean; index, WithIndex: Integer);
begin begin
if not IsColumn or not Columns.Enabled then if not IsColumn or not Columns.Enabled then
@ -7953,6 +8084,9 @@ begin
Canvas.FillRect(aRect); Canvas.FillRect(aRect);
if CellNeedsCheckboxBitmaps(aCol,aRow) then
DrawCellCheckboxBitmaps(aCol,aRow,aRect);
if FTitleStyle<>tsNative then if FTitleStyle<>tsNative then
DrawColumnText(aCol,aRow,aRect,aState); DrawColumnText(aCol,aRow,aRect,aState);
@ -8270,6 +8404,7 @@ begin
(aCol>=FixedCols) and (aRow=0) then (aCol>=FixedCols) and (aRow=0) then
//inherited already did //inherited already did
else else
if not CellNeedsCheckboxBitmaps(aCol, aRow) then
DrawCellText(aCol, aRow, aRect, aState, Cells[aCol,aRow]); DrawCellText(aCol, aRow, aRect, aState, Cells[aCol,aRow]);
end; end;
end; end;
@ -8281,6 +8416,25 @@ begin
inherited DrawCellAutoNumbering(aCol,aRow,aRect,aValue); inherited DrawCellAutoNumbering(aCol,aRow,aRect,aValue);
end; end;
procedure TCustomStringGrid.GetCheckBoxState(const aCol, aRow: Integer;
var aState: TCheckboxState);
var
s:string;
begin
if Assigned(OnGetCheckboxState) then
inherited GetCheckBoxState(aCol, aRow, aState)
else begin
s := Cells[ACol, ARow];
if s=ColumnFromGridColumn(aCol).ValueChecked then
aState := cbChecked
else
if s=ColumnFromGridColumn(aCol).ValueUnChecked then
aState := cbUnChecked
else
aState := cbGrayed;
end;
end;
function TCustomStringGrid.GetEditText(aCol, aRow: Integer): string; function TCustomStringGrid.GetEditText(aCol, aRow: Integer): string;
begin begin
Result:=Cells[aCol, aRow]; Result:=Cells[aCol, aRow];
@ -8775,6 +8929,22 @@ begin
result := FReadOnly^; result := FReadOnly^;
end; end;
function TGridColumn.GetValueChecked: string;
begin
if FValueChecked = nil then
Result := GetDefaultValueChecked
else
Result := FValueChecked;
end;
function TGridColumn.GetValueUnchecked: string;
begin
if FValueUnChecked = nil then
Result := GetDefaultValueUnChecked
else
Result := FValueUnChecked;
end;
function TGridColumn.GetVisible: Boolean; function TGridColumn.GetVisible: Boolean;
begin begin
if FVisible=nil then begin if FVisible=nil then begin
@ -8831,6 +9001,16 @@ begin
result := FSizePriority <> nil; result := FSizePriority <> nil;
end; end;
function TGridColumn.IsValueCheckedStored: boolean;
begin
result := FValueChecked <> nil;
end;
function TGridColumn.IsValueUncheckedStored: boolean;
begin
Result := FValueUnchecked <> nil;
end;
function TGridColumn.IsVisibleStored: boolean; function TGridColumn.IsVisibleStored: boolean;
begin begin
result := (FVisible<>nil) and not FVisible^; result := (FVisible<>nil) and not FVisible^;
@ -8956,6 +9136,32 @@ begin
FTitle.Assign(AValue); FTitle.Assign(AValue);
end; end;
procedure TGridColumn.SetValueChecked(const AValue: string);
begin
if (FValueChecked=nil)or(CompareText(AValue, FValueChecked)<>0) then begin
if FValueChecked<>nil then
StrDispose(FValueChecked)
else
if CompareText(AValue, GetDefaultValueChecked)=0 then
exit;
FValueChecked := StrNew(PChar(AValue));
Changed(False);
end;
end;
procedure TGridColumn.SetValueUnchecked(const AValue: string);
begin
if (FValueUnchecked=nil)or(CompareText(AValue, FValueUnchecked)<>0) then begin
if FValueUnchecked<>nil then
StrDispose(FValueUnchecked)
else
if CompareText(AValue, GetDefaultValueUnchecked)=0 then
exit;
FValueUnchecked := StrNew(PChar(AValue));
Changed(False);
end;
end;
procedure TGridColumn.SetVisible(const AValue: Boolean); procedure TGridColumn.SetVisible(const AValue: Boolean);
begin begin
if FVisible = nil then begin if FVisible = nil then begin
@ -8996,6 +9202,16 @@ begin
Result := True; Result := True;
end; end;
function TGridColumn.GetDefaultValueChecked: string;
begin
result := '1';
end;
function TGridColumn.GetDefaultValueUnchecked: string;
begin
result := '0';
end;
function TGridColumn.GetDefaultWidth: Integer; function TGridColumn.GetDefaultWidth: Integer;
var var
tmpGrid: TCustomGrid; tmpGrid: TCustomGrid;
@ -9119,6 +9335,9 @@ begin
if FMaxSize<>nil then Dispose(FMaxSize); if FMaxSize<>nil then Dispose(FMaxSize);
if FMinSize<>nil then Dispose(FMinSize); if FMinSize<>nil then Dispose(FMinSize);
if FSizePriority<>nil then Dispose(FSizePriority); if FSizePriority<>nil then Dispose(FSizePriority);
if FValueChecked<>nil then StrDispose(FValueChecked);
if FValueUnchecked<>nil then StrDispose(FValueUnchecked);
FreeThenNil(FPickList); FreeThenNil(FPickList);
FreeThenNil(FFont); FreeThenNil(FFont);
FreeThenNil(FTitle); FreeThenNil(FTitle);
@ -9718,4 +9937,7 @@ begin
FEditors[i].ActiveControl:=ActiveCtrl; FEditors[i].ActiveControl:=ActiveCtrl;
end; end;
initialization
{$I lcl_dbgrid_images.lrs}
end. end.