mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-18 19:29:31 +02:00
LCL, implements cbsColumnCheckbox in TDrawGrid/TStringGrid, issue #8682
git-svn-id: trunk@17837 -
This commit is contained in:
jesus
parent
351862c47d
commit
2ad9a36af2
186
lcl/dbgrids.pas
186
lcl/dbgrids.pas
@ -78,8 +78,6 @@ type
|
||||
gsRemovingAutoColumns);
|
||||
TDbGridStatus = set of TDbGridStatusItem;
|
||||
|
||||
TDBGridCheckBoxState = (gcbpUnChecked, gcbpChecked, gcbpGrayed);
|
||||
|
||||
TDataSetScrolledEvent =
|
||||
procedure(DataSet: TDataSet; Distance: Integer) of object;
|
||||
|
||||
@ -97,10 +95,6 @@ type
|
||||
procedure (Sender: TObject; const Field: TField;
|
||||
var Value: string) of object;
|
||||
|
||||
TUserCheckBoxBitmapEvent =
|
||||
procedure(Sender: TObject; const CheckedState: TDbGridCheckboxState;
|
||||
ABitmap: TBitmap) of object;
|
||||
|
||||
TDbGridSelEditorEvent =
|
||||
procedure(Sender: TObject; Column: TColumn;
|
||||
var Editor: TWinControl) of object;
|
||||
@ -214,39 +208,31 @@ type
|
||||
FField: TField;
|
||||
FIsAutomaticColumn: boolean;
|
||||
FDesignIndex: Integer;
|
||||
FValueChecked,FValueUnchecked: PChar;
|
||||
procedure ApplyDisplayFormat;
|
||||
function GetDataSet: TDataSet;
|
||||
function GetDisplayFormat: string;
|
||||
function GetField: TField;
|
||||
function GetIsDesignColumn: boolean;
|
||||
function GetValueChecked: string;
|
||||
function GetValueUnchecked: string;
|
||||
function IsDisplayFormatStored: boolean;
|
||||
function IsValueCheckedStored: boolean;
|
||||
function IsValueUncheckedStored: boolean;
|
||||
procedure SetDisplayFormat(const AValue: string);
|
||||
procedure SetField(const AValue: TField);
|
||||
procedure SetFieldName(const AValue: String);
|
||||
procedure SetValueChecked(const AValue: string);
|
||||
procedure SetValueUnchecked(const AValue: string);
|
||||
protected
|
||||
function CreateTitle: TGridColumnTitle; override;
|
||||
function GetDefaultAlignment: TAlignment; override;
|
||||
function GetDefaultDisplayFormat: string;
|
||||
function GetDefaultValueChecked: string; virtual;
|
||||
function GetDefaultValueUnchecked: string; virtual;
|
||||
function GetDefaultValueChecked: string; override;
|
||||
function GetDefaultValueUnchecked: string; override;
|
||||
function GetDefaultVisible: boolean; override;
|
||||
function GetDisplayName: string; override;
|
||||
function GetDefaultReadOnly: boolean; override;
|
||||
function GetDefaultWidth: Integer; override;
|
||||
function GetPickList: TStrings; override;
|
||||
function GetPickList: TStrings; override;
|
||||
property IsAutomaticColumn: boolean read FIsAutomaticColumn;
|
||||
property IsDesignColumn: boolean read GetIsDesignColumn;
|
||||
procedure LinkField;
|
||||
public
|
||||
constructor Create(ACollection: TCollection); override;
|
||||
destructor Destroy; override;
|
||||
procedure Assign(Source: TPersistent); override;
|
||||
function IsDefault: boolean; override;
|
||||
property DesignIndex: integer read FDesignIndex;
|
||||
@ -255,10 +241,6 @@ type
|
||||
property FieldName: String read FFieldName write SetFieldName;
|
||||
property DisplayFormat: string read GetDisplayFormat write SetDisplayFormat
|
||||
stored IsDisplayFormatStored;
|
||||
property ValueChecked: string read GetValueChecked write SetValueChecked
|
||||
stored IsValueCheckedStored;
|
||||
property ValueUnchecked: string read GetValueUnchecked write SetValueUnchecked
|
||||
stored IsValueUncheckedStored;
|
||||
end;
|
||||
|
||||
TColumnOrder = (coDesignOrder, coFieldIndexOrder);
|
||||
@ -294,7 +276,6 @@ type
|
||||
FOnDrawColumnCell: TDrawColumnCellEvent;
|
||||
FOnFieldEditMask: TGetDbEditMaskEvent;
|
||||
FOnTitleClick: TDBGridClickEvent;
|
||||
FOnUserCheckboxBitmap: TUserCheckboxBitmapEvent;
|
||||
FOnSelectEditor: TDbGridSelEditorEvent;
|
||||
FOptions: TDBGridOptions;
|
||||
FReadOnly: Boolean;
|
||||
@ -309,7 +290,6 @@ type
|
||||
FDefaultColWidths: boolean;
|
||||
FGridStatus: TDBGridStatus;
|
||||
FOldControlStyle: TControlStyle;
|
||||
FCheckedBitmap, FUnCheckedBitmap, FGrayedBitmap: TBitmap;
|
||||
FSelectedRows: TBookmarkList;
|
||||
FOnPrepareCanvas: TPrepareDbGridCanvasEvent;
|
||||
FKeyBookmark: TBookmarkStr;
|
||||
@ -360,12 +340,10 @@ type
|
||||
procedure EndUpdating;
|
||||
function UpdatingData: boolean;
|
||||
procedure SwapCheckBox;
|
||||
function ValueMatch(const BaseValue, TestValue: string): Boolean;
|
||||
procedure ToggleSelectedRow;
|
||||
procedure SelectRecord(AValue: boolean);
|
||||
procedure GetScrollbarParams(out aRange, aPage, aPos: Integer);
|
||||
procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
|
||||
function LoadResBitmapImage(const ResName: string): TBitmap;
|
||||
procedure ClearSelection(selCurrent:boolean=false);
|
||||
protected
|
||||
procedure AddAutomaticColumns;
|
||||
@ -409,7 +387,6 @@ type
|
||||
function GetEditText(aCol, aRow: Longint): string; override;
|
||||
function GetFieldFromGridColumn(Column: Integer): TField;
|
||||
function GetGridColumnFromField(F: TField): Integer;
|
||||
function GetImageForCheckBox(CheckBoxView: TDBGridCheckBoxState): TBitmap;
|
||||
function GetIsCellSelected(aCol, aRow: Integer): boolean; override;
|
||||
function GridCanModify: boolean;
|
||||
procedure GetSBVisibility(out HsbVisible,VsbVisible:boolean);override;
|
||||
@ -457,7 +434,6 @@ type
|
||||
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;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
procedure InitiateAction; override;
|
||||
@ -1484,7 +1460,7 @@ begin
|
||||
SelField.AsBoolean := not SelField.AsBoolean
|
||||
else
|
||||
begin
|
||||
if ValueMatch(TempColumn.ValueChecked, SelField.AsString) then
|
||||
if TempColumn.ValueChecked=SelField.AsString then
|
||||
SelField.AsString := TempColumn.ValueUnchecked
|
||||
else
|
||||
SelField.AsString := TempColumn.ValueChecked;
|
||||
@ -1492,14 +1468,6 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCustomDBGrid.ValueMatch(const BaseValue, TestValue: string): Boolean;
|
||||
begin
|
||||
if BaseValue=TestValue then
|
||||
Result := True
|
||||
else
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
procedure TCustomDBGrid.ToggleSelectedRow;
|
||||
begin
|
||||
SelectRecord(not FSelectedRows.CurrentRowSelected);
|
||||
@ -2300,19 +2268,6 @@ begin
|
||||
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;
|
||||
begin
|
||||
Result:=inherited GetIsCellSelected(aCol, aRow) or
|
||||
@ -2463,15 +2418,8 @@ end;
|
||||
|
||||
procedure TCustomDBGrid.DrawCheckboxBitmaps(aCol: Integer; aRect: TRect;
|
||||
F: TField);
|
||||
const
|
||||
arrtb:array[TDbGridCheckboxState] of TThemedButton =
|
||||
(tbCheckBoxUncheckedNormal, tbCheckBoxCheckedNormal, tbCheckBoxMixedNormal);
|
||||
var
|
||||
ChkBitmap: TBitmap;
|
||||
XPos,YPos,CSize: Integer;
|
||||
AState: TDbGridCheckboxState;
|
||||
details: TThemedElementDetails;
|
||||
PaintRect: TRect;
|
||||
AState: TCheckboxState;
|
||||
begin
|
||||
if (aCol=Col) and FDrawingActiveRecord then begin
|
||||
// show checkbox only if overriden editor is hidden
|
||||
@ -2483,40 +2431,25 @@ begin
|
||||
if (F<>nil) then
|
||||
if F.DataType=ftBoolean then
|
||||
if F.IsNull then
|
||||
AState := gcbpGrayed
|
||||
AState := cbGrayed
|
||||
else
|
||||
if F.AsBoolean then
|
||||
AState := gcbpChecked
|
||||
AState := cbChecked
|
||||
else
|
||||
AState := gcbpUnChecked
|
||||
AState := cbUnChecked
|
||||
else
|
||||
if ValueMatch(F.AsString, TColumn(ColumnFromGridColumn(aCol)).ValueChecked) then
|
||||
AState := gcbpChecked
|
||||
if F.AsString=ColumnFromGridColumn(aCol).ValueChecked then
|
||||
AState := cbChecked
|
||||
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
|
||||
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;
|
||||
if F.AsString=ColumnFromGridColumn(aCol).ValueUnChecked then
|
||||
AState := cbUnChecked
|
||||
else
|
||||
AState := cbGrayed
|
||||
else
|
||||
AState := cbGrayed;
|
||||
|
||||
DrawGridCheckboxBitmaps(ARect, AState);
|
||||
end;
|
||||
|
||||
procedure TCustomDBGrid.DrawFixedText(aCol, aRow: Integer; aRect: TRect;
|
||||
@ -2712,11 +2645,6 @@ begin
|
||||
|
||||
// What a dilema!, we need ssAutoHorizontal and ssVertical!!!
|
||||
ScrollBars:=ssBoth;
|
||||
|
||||
// Default bitmaps for cbsCheckedColumn
|
||||
FUnCheckedBitmap := LoadResBitmapImage('dbgriduncheckedcb');
|
||||
FCheckedBitmap := LoadResBitmapImage('dbgridcheckedcb');
|
||||
FGrayedBitmap := LoadResBitmapImage('dbgridgrayedcb');
|
||||
end;
|
||||
|
||||
procedure TCustomDBGrid.InitiateAction;
|
||||
@ -2821,19 +2749,6 @@ begin
|
||||
Message.Result := PtrUInt(FDataLink);
|
||||
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);
|
||||
begin
|
||||
if [dgMultiSelect,dgPersistentMultiSelect]*Options=[dgMultiSelect] then begin
|
||||
@ -2847,9 +2762,6 @@ end;
|
||||
|
||||
destructor TCustomDBGrid.Destroy;
|
||||
begin
|
||||
FUncheckedBitmap.Free;
|
||||
FCheckedBitmap.Free;
|
||||
FGrayedBitmap.Free;
|
||||
FSelectedRows.Free;
|
||||
FDataLink.OnDataSetChanged:=nil;
|
||||
FDataLink.OnRecordChanged:=nil;
|
||||
@ -3176,22 +3088,6 @@ begin
|
||||
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;
|
||||
begin
|
||||
if (FField <> nil) and FDisplayFormatChanged then begin
|
||||
@ -3215,16 +3111,6 @@ begin
|
||||
Result := FDisplayFormatChanged;
|
||||
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);
|
||||
begin
|
||||
if (not FDisplayFormatChanged)or(CompareText(AValue, FDisplayFormat)<>0) then begin
|
||||
@ -3263,32 +3149,6 @@ begin
|
||||
result :=nil;
|
||||
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);
|
||||
begin
|
||||
if Source is TColumn then begin
|
||||
@ -3365,13 +3225,6 @@ begin
|
||||
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;
|
||||
begin
|
||||
result := not FDisplayFormatChanged and (inherited IsDefault());
|
||||
@ -3593,7 +3446,4 @@ begin
|
||||
result := CompareMemRange(@s1[1],@s2[1], Length(s1));
|
||||
end;
|
||||
|
||||
initialization
|
||||
{$I lcl_dbgrid_images.lrs}
|
||||
|
||||
end.
|
||||
|
||||
222
lcl/grids.pas
222
lcl/grids.pas
@ -305,6 +305,10 @@ type
|
||||
procedure(sender: TObject; aCol, aRow: Integer;
|
||||
aState: TGridDrawState) of object;
|
||||
|
||||
TUserCheckBoxBitmapEvent =
|
||||
procedure(Sender: TObject; const CheckedState: TCheckboxState;
|
||||
ABitmap: TBitmap) of object;
|
||||
|
||||
{ TVirtualGrid }
|
||||
|
||||
TVirtualGrid=class
|
||||
@ -417,6 +421,7 @@ type
|
||||
FisDefaultFont: Boolean;
|
||||
FPickList: TStrings;
|
||||
FMinSize, FMaxSize, FSizePriority: ^Integer;
|
||||
FValueChecked,FValueUnchecked: PChar;
|
||||
|
||||
procedure FontChanged(Sender: TObject);
|
||||
function GetAlignment: TAlignment;
|
||||
@ -439,6 +444,8 @@ type
|
||||
function IsMaxSizeStored: boolean;
|
||||
function IsReadOnlyStored: boolean;
|
||||
function IsSizePriorityStored: boolean;
|
||||
function IsValueCheckedStored: boolean;
|
||||
function IsValueUncheckedStored: boolean;
|
||||
function IsVisibleStored: boolean;
|
||||
function IsWidthStored: boolean;
|
||||
procedure SetAlignment(const AValue: TAlignment);
|
||||
@ -453,6 +460,8 @@ type
|
||||
procedure SetReadOnly(const AValue: Boolean);
|
||||
procedure SetSizePriority(const AValue: Integer);
|
||||
procedure SetTitle(const AValue: TGridColumnTitle);
|
||||
procedure SetValueChecked(const AValue: string);
|
||||
procedure SetValueUnchecked(const AValue: string);
|
||||
procedure SetVisible(const AValue: Boolean);
|
||||
procedure SetWidth(const AValue: Integer);
|
||||
protected
|
||||
@ -465,8 +474,12 @@ type
|
||||
function GetDefaultReadOnly: boolean; virtual;
|
||||
function GetDefaultSizePriority: Integer;
|
||||
function GetDefaultVisible: boolean; virtual;
|
||||
function GetDefaultValueChecked: string; virtual;
|
||||
function GetDefaultValueUnchecked: string; virtual;
|
||||
function GetDefaultWidth: Integer; virtual;
|
||||
function GetPickList: TStrings; virtual;
|
||||
function GetValueChecked: string;
|
||||
function GetValueUnchecked: string;
|
||||
procedure ColumnChanged; virtual;
|
||||
procedure AllColumnsChange;
|
||||
function CreateTitle: TGridColumnTitle; virtual;
|
||||
@ -497,6 +510,11 @@ type
|
||||
property Title: TGridColumnTitle read FTitle write SetTitle;
|
||||
property Width: Integer read GetWidth write SetWidth stored IsWidthStored default DEFCOLWIDTH;
|
||||
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;
|
||||
|
||||
TGridPropertyBackup=record
|
||||
@ -591,6 +609,7 @@ type
|
||||
FFastEditing: boolean;
|
||||
FAltColorStartNormal: boolean;
|
||||
FFlat: Boolean;
|
||||
FOnUserCheckboxBitmap: TUserCheckboxBitmapEvent;
|
||||
FSortOrder: TSortOrder;
|
||||
FTitleImageList: TImageList;
|
||||
FTitleStyle: TTitleStyle;
|
||||
@ -647,6 +666,7 @@ type
|
||||
FAllowOutboundEvents: boolean;
|
||||
FHeaderHotZones: TGridZoneSet;
|
||||
FHeaderPushZones: TGridZoneSet;
|
||||
FCheckedBitmap, FUnCheckedBitmap, FGrayedBitmap: TBitmap;
|
||||
procedure AdjustCount(IsColumn:Boolean; OldValue, NewValue:Integer);
|
||||
procedure CacheVisibleGrid;
|
||||
procedure CancelSelection;
|
||||
@ -691,6 +711,7 @@ type
|
||||
function GetColumns: TGridColumns;
|
||||
function GetEditorBorderStyle: TBorderStyle;
|
||||
function GetBorderWidth: Integer;
|
||||
function GetImageForCheckBox(CheckBoxView: TCheckBoxState): TBitmap;
|
||||
function GetRowCount: Integer;
|
||||
function GetRowHeights(Arow: Integer): Integer;
|
||||
function GetSelection: TGridRect;
|
||||
@ -707,6 +728,7 @@ type
|
||||
function IsAltColorStored: boolean;
|
||||
function IsColumnsStored: boolean;
|
||||
function IsPushCellActive: boolean;
|
||||
function LoadResBitmapImage(const ResName: string): TBitmap;
|
||||
procedure OnTitleFontChanged(Sender: TObject);
|
||||
procedure ReadColumns(Reader: TReader);
|
||||
procedure ReadColWidths(Reader: TReader);
|
||||
@ -803,6 +825,7 @@ type
|
||||
procedure DrawCell(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 DrawGridCheckboxBitmaps(const aRect: TRect; const aState: TCheckboxState); virtual;
|
||||
procedure DrawColRowMoving;
|
||||
procedure DrawColumnText(aCol,aRow: Integer; aRect: TRect; aState:TGridDrawState); virtual;
|
||||
procedure DrawColumnTitleImage(var ARect: TRect; AColumnIndex: Integer);
|
||||
@ -990,6 +1013,7 @@ type
|
||||
property OnSelection: TOnSelectEvent read fOnSelection write fOnSelection;
|
||||
property OnSelectEditor: TSelectEditorEvent read FOnSelectEditor write FOnSelectEditor;
|
||||
property OnTopLeftChanged: TNotifyEvent read FOnTopLeftChanged write FOnTopLeftChanged;
|
||||
property OnUserCheckboxBitmap: TUserCheckboxBitmapEvent read FOnUserCheckboxBitmap write FOnUserCheckboxBitmap;
|
||||
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
@ -1030,6 +1054,9 @@ type
|
||||
|
||||
TGetEditEvent = procedure (Sender: TObject; ACol, ARow: Integer; var 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 }
|
||||
|
||||
@ -1039,11 +1066,15 @@ type
|
||||
FOnColRowExchanged: TgridOperationEvent;
|
||||
FOnColRowInserted: TGridOperationEvent;
|
||||
FOnColRowMoved: TgridOperationEvent;
|
||||
FOnGetCheckboxState: TGetCheckboxStateEvent;
|
||||
FOnGetEditMask: TGetEditEvent;
|
||||
FOnGetEditText: TGetEditEvent;
|
||||
FOnHeaderClick, FOnHeaderSized: THdrEvent;
|
||||
FOnSelectCell: TOnSelectcellEvent;
|
||||
FOnSetCheckboxState: TSetCheckboxStateEvent;
|
||||
FOnSetEditText: TSetEditEvent;
|
||||
function CellNeedsCheckboxBitmaps(const aCol,aRow: Integer): boolean;
|
||||
procedure DrawCellCheckboxBitmaps(const aCol,aRow: Integer; const aRect: TRect);
|
||||
protected
|
||||
FGrid: TVirtualGrid;
|
||||
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 DrawCellAutonumbering(aCol,aRow: Integer; aRect: TRect; const aValue: string); virtual;
|
||||
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 GetEditText(aCol, aRow: Longint): string; override;
|
||||
procedure HeaderClick(IsColumn: Boolean; index: Integer); override;
|
||||
@ -1065,6 +1097,11 @@ type
|
||||
procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
|
||||
procedure SizeChanged(OldColCount, OldRowCount: Integer); override;
|
||||
|
||||
property OnGetCheckboxState: TGetCheckboxStateEvent
|
||||
read FOnGetCheckboxState write FOnGetCheckboxState;
|
||||
property OnSetCheckboxState: TSetCheckboxStateEvent
|
||||
read FOnSetCheckboxState write FOnSetCheckboxState;
|
||||
|
||||
public
|
||||
|
||||
// to easy user call
|
||||
@ -1351,6 +1388,7 @@ type
|
||||
procedure DrawCellAutonumbering(aCol,aRow: Integer; aRect: TRect; const aValue: string); override;
|
||||
//procedure EditordoGetValue; override;
|
||||
//procedure EditordoSetValue; override;
|
||||
procedure GetCheckBoxState(const aCol, aRow:Integer; var aState:TCheckboxState); override;
|
||||
function GetEditText(aCol, aRow: Integer): string; override;
|
||||
procedure LoadContent(cfg: TXMLConfig; Version: Integer); override;
|
||||
procedure Loaded; override;
|
||||
@ -1984,6 +2022,19 @@ begin
|
||||
result := (PushedCell.X<>-1) and (PushedCell.Y<>-1);
|
||||
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;
|
||||
begin
|
||||
Result := FTitleImageList <> nil;
|
||||
@ -3408,6 +3459,36 @@ begin
|
||||
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);
|
||||
begin
|
||||
FTitleFontIsDefault := False;
|
||||
@ -4043,6 +4124,21 @@ begin
|
||||
Result := 0
|
||||
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;
|
||||
begin
|
||||
result := FColumns;
|
||||
@ -7043,11 +7139,19 @@ begin
|
||||
ResetHotCell;
|
||||
ResetPushedCell;
|
||||
FSortOrder := soAscending;
|
||||
|
||||
// Default bitmaps for cbsCheckedColumn
|
||||
FUnCheckedBitmap := LoadResBitmapImage('dbgriduncheckedcb');
|
||||
FCheckedBitmap := LoadResBitmapImage('dbgridcheckedcb');
|
||||
FGrayedBitmap := LoadResBitmapImage('dbgridgrayedcb');
|
||||
end;
|
||||
|
||||
destructor TCustomGrid.Destroy;
|
||||
begin
|
||||
{$Ifdef DbgGrid}DebugLn('TCustomGrid.Destroy');{$Endif}
|
||||
FUncheckedBitmap.Free;
|
||||
FCheckedBitmap.Free;
|
||||
FGrayedBitmap.Free;
|
||||
FreeThenNil(FButtonStringEditor);
|
||||
FreeThenNil(FPickListEditor);
|
||||
FreeThenNil(FStringEditor);
|
||||
@ -7724,6 +7828,26 @@ end;
|
||||
|
||||
{ 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);
|
||||
begin
|
||||
@ -7781,6 +7905,13 @@ begin
|
||||
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);
|
||||
begin
|
||||
if not IsColumn or not Columns.Enabled then
|
||||
@ -7953,6 +8084,9 @@ begin
|
||||
|
||||
Canvas.FillRect(aRect);
|
||||
|
||||
if CellNeedsCheckboxBitmaps(aCol,aRow) then
|
||||
DrawCellCheckboxBitmaps(aCol,aRow,aRect);
|
||||
|
||||
if FTitleStyle<>tsNative then
|
||||
DrawColumnText(aCol,aRow,aRect,aState);
|
||||
|
||||
@ -8270,6 +8404,7 @@ begin
|
||||
(aCol>=FixedCols) and (aRow=0) then
|
||||
//inherited already did
|
||||
else
|
||||
if not CellNeedsCheckboxBitmaps(aCol, aRow) then
|
||||
DrawCellText(aCol, aRow, aRect, aState, Cells[aCol,aRow]);
|
||||
end;
|
||||
end;
|
||||
@ -8281,6 +8416,25 @@ begin
|
||||
inherited DrawCellAutoNumbering(aCol,aRow,aRect,aValue);
|
||||
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;
|
||||
begin
|
||||
Result:=Cells[aCol, aRow];
|
||||
@ -8775,6 +8929,22 @@ begin
|
||||
result := FReadOnly^;
|
||||
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;
|
||||
begin
|
||||
if FVisible=nil then begin
|
||||
@ -8831,6 +9001,16 @@ begin
|
||||
result := FSizePriority <> nil;
|
||||
end;
|
||||
|
||||
function TGridColumn.IsValueCheckedStored: boolean;
|
||||
begin
|
||||
result := FValueChecked <> nil;
|
||||
end;
|
||||
|
||||
function TGridColumn.IsValueUncheckedStored: boolean;
|
||||
begin
|
||||
Result := FValueUnchecked <> nil;
|
||||
end;
|
||||
|
||||
function TGridColumn.IsVisibleStored: boolean;
|
||||
begin
|
||||
result := (FVisible<>nil) and not FVisible^;
|
||||
@ -8956,6 +9136,32 @@ begin
|
||||
FTitle.Assign(AValue);
|
||||
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);
|
||||
begin
|
||||
if FVisible = nil then begin
|
||||
@ -8996,6 +9202,16 @@ begin
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
function TGridColumn.GetDefaultValueChecked: string;
|
||||
begin
|
||||
result := '1';
|
||||
end;
|
||||
|
||||
function TGridColumn.GetDefaultValueUnchecked: string;
|
||||
begin
|
||||
result := '0';
|
||||
end;
|
||||
|
||||
function TGridColumn.GetDefaultWidth: Integer;
|
||||
var
|
||||
tmpGrid: TCustomGrid;
|
||||
@ -9119,6 +9335,9 @@ begin
|
||||
if FMaxSize<>nil then Dispose(FMaxSize);
|
||||
if FMinSize<>nil then Dispose(FMinSize);
|
||||
if FSizePriority<>nil then Dispose(FSizePriority);
|
||||
if FValueChecked<>nil then StrDispose(FValueChecked);
|
||||
if FValueUnchecked<>nil then StrDispose(FValueUnchecked);
|
||||
|
||||
FreeThenNil(FPickList);
|
||||
FreeThenNil(FFont);
|
||||
FreeThenNil(FTitle);
|
||||
@ -9718,4 +9937,7 @@ begin
|
||||
FEditors[i].ActiveControl:=ActiveCtrl;
|
||||
end;
|
||||
|
||||
initialization
|
||||
{$I lcl_dbgrid_images.lrs}
|
||||
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user