From 49823c14e4097a7ed8b0314f15c62fd2098537ca Mon Sep 17 00:00:00 2001 From: mattias Date: Sat, 11 Jun 2005 09:30:24 +0000 Subject: [PATCH] added checkboxes to TDBGrid from Sergey Smirnov git-svn-id: trunk@7233 - --- components/codetools/codetoolsstrconsts.pas | 1 + components/codetools/definetemplates.pas | 46 +- components/codetools/finddeclarationtool.pas | 2 +- lcl/dbgrids.pas | 473 ++++++++++++++++--- lcl/grids.pas | 8 +- lcl/lclproc.pas | 37 ++ 6 files changed, 480 insertions(+), 87 deletions(-) diff --git a/components/codetools/codetoolsstrconsts.pas b/components/codetools/codetoolsstrconsts.pas index 339c1f23b9..0b7e8b94ba 100644 --- a/components/codetools/codetoolsstrconsts.pas +++ b/components/codetools/codetoolsstrconsts.pas @@ -207,6 +207,7 @@ ResourceString ctsComponentsDirectory = 'Components Directory'; ctsCustomComponentsDirectory = 'Custom Components Directory'; ctsToolsDirectory = 'Tools Directory'; + ctsInstallDirectory = 'Install Directory'; ctsDesignerDirectory = 'Designer Directory'; ctsIDEIntfDirectory = 'IDEIntf Directory'; ctsJITFormDirectory = 'JITForm Directory'; diff --git a/components/codetools/definetemplates.pas b/components/codetools/definetemplates.pas index 4bed452725..b58afcca1e 100644 --- a/components/codetools/definetemplates.pas +++ b/components/codetools/definetemplates.pas @@ -3023,9 +3023,10 @@ var procedure BrowseDirectory(ADirPath: string); const - IgnoreDirs: array[1..12] of shortstring =( - '.', '..', 'CVS', 'examples', 'example', 'tests', 'fake', 'ide', - 'demo', 'docs', 'template', 'fakertl' + IgnoreDirs: array[1..16] of shortstring =( + '.', '..', 'CVS', '.svn', 'examples', 'example', 'tests', 'fake', + 'ide', 'demo', 'docs', 'template', 'fakertl', 'install', 'installer', + 'compiler' ); var AFilename, Ext, UnitName, MacroFileName: string; @@ -3524,6 +3525,7 @@ var ElseTemplate: TDefineTemplate; LCLWidgetSetDir: TDefineTemplate; IDEIntfDir: TDefineTemplate; + ToolsInstallDirTempl: TDefineTemplate; begin Result:=nil; if (LazarusSrcDir='') or (WidgetType='') then exit; @@ -3913,28 +3915,6 @@ begin ,da_DefineRecurse)); DirTempl.AddChild(SubDirTempl); - // /components/htmllite - SubDirTempl:=TDefineTemplate.Create('HTMLLite', - 'HTMLLite', - '','htmllite',da_Directory); - SubDirTempl.AddChild(TDefineTemplate.Create('HL_LAZARUS', - 'Define HL_LAZARUS','HL_LAZARUS','',da_DefineRecurse)); - DirTempl.AddChild(SubDirTempl); - - // /components/turbopower_ipro - SubDirTempl:=TDefineTemplate.Create('TurboPower InternetPro', - 'TurboPower InternetPro components', - '','turbopower_ipro',da_Directory); - SubDirTempl.AddChild(TDefineTemplate.Create('IP_LAZARUS', - 'Define IP_LAZARUS','IP_LAZARUS','',da_DefineRecurse)); - SubDirTempl.AddChild(TDefineTemplate.Create('codetools', - Format(ctsAddsDirToSourcePath,['../codetools']), - ExternalMacroStart+'SrcPath', - d('../codetools' - +';'+SrcPath) - ,da_DefineRecurse)); - DirTempl.AddChild(SubDirTempl); - // /components/custom SubDirTempl:=TDefineTemplate.Create('Custom Components', ctsCustomComponentsDirectory, @@ -3949,8 +3929,7 @@ begin // /tools DirTempl:=TDefineTemplate.Create('Tools', - ctsToolsDirectory, - '','tools',da_Directory); + ctsToolsDirectory,'','tools',da_Directory); DirTempl.AddChild(TDefineTemplate.Create('LCL path addition', Format(ctsAddsDirToSourcePath,['lcl']), ExternalMacroStart+'SrcPath', @@ -3958,8 +3937,19 @@ begin +';../components/codetools') +';'+SrcPath ,da_Define)); + // /tools/install + ToolsInstallDirTempl:=TDefineTemplate.Create('Install', + ctsInstallDirectory,'','install',da_Directory); + DirTempl.AddChild(ToolsInstallDirTempl); + ToolsInstallDirTempl.AddChild(TDefineTemplate.Create('LCL path addition', + Format(ctsAddsDirToSourcePath,['lcl']), + ExternalMacroStart+'SrcPath', + d('../../lcl;../../lcl/interfaces/'+WidgetType + +';../../components/codetools') + +';'+SrcPath + ,da_Define)); MainDir.AddChild(DirTempl); - + // extra options SubTempl:=CreateFPCCommandLineDefines(StdDefTemplLazarusBuildOpts, ExtraOptions,true,Owner); diff --git a/components/codetools/finddeclarationtool.pas b/components/codetools/finddeclarationtool.pas index e1b5ad80c6..4c84cc91f8 100644 --- a/components/codetools/finddeclarationtool.pas +++ b/components/codetools/finddeclarationtool.pas @@ -1276,7 +1276,7 @@ var CurDir, CompiledSrcExt: string; function LoadFile(const AFilename: string; - var NewCode: TCodeBuffer): boolean; + out NewCode: TCodeBuffer): boolean; begin {$IFDEF ShowTriedFiles} DebugLn('TFindDeclarationTool.FindUnitSource.LoadFile ',AFilename); diff --git a/lcl/dbgrids.pas b/lcl/dbgrids.pas index 9da33b923d..5b7958c5b2 100644 --- a/lcl/dbgrids.pas +++ b/lcl/dbgrids.pas @@ -43,14 +43,7 @@ uses type TCustomDbGrid = class; TColumn = class; - TDataSetScrolledEvent = procedure(DataSet: TDataSet; Distance: Integer) of object; - TDBGridClickEvent = procedure(Column: TColumn) of object; - TMovedEvent = procedure(Sender: TObject; FromIndex, ToIndex: Integer) of object; - TDrawColumnCellEvent = procedure(Sender: TObject; const Rect: TRect; - DataCol: Integer; Column: TColumn; State: TGridDrawState) of object; - TGetDbEditMaskEvent = - procedure (Sender: TObject; const Field: TField; var Value: string) of object; - + TDBGridOption = ( dgEditing, // Ya dgTitles, // Ya @@ -67,8 +60,27 @@ type dgMultiselect ); TDbGridOptions = set of TDbGridOption; + + TDbGridExtraOption = ( + dgeAutoColumns, // if uncustomized columns, add them anyway? + dgeCheckboxColumn // enable the use of checkbox in columns + ); + TDbGridExtraOptions = set of TDbGridExtraOption; + TDbGridStatusItem = (gsVisibleMove, gsUpdatingData); TDbGridStatus = set of TDbGridStatusItem; + + TDBGridCheckBoxState = (gcbpUnChecked, gcbpChecked, gcbpGrayed); + + TDataSetScrolledEvent = procedure(DataSet: TDataSet; Distance: Integer) of object; + TDBGridClickEvent = procedure(Column: TColumn) of object; + TMovedEvent = procedure(Sender: TObject; FromIndex, ToIndex: Integer) of object; + TDrawColumnCellEvent = procedure(Sender: TObject; const Rect: TRect; + DataCol: Integer; Column: TColumn; State: TGridDrawState) of object; + TGetDbEditMaskEvent = + procedure (Sender: TObject; const Field: TField; var Value: string) of object; + TUserCheckBoxBitmapEvent = procedure(Sender: TObject; + const CheckedState: TDbGridCheckboxState; ABitmap: TBitmap) of object; type @@ -143,29 +155,39 @@ 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); - function GetDataSet: TDataSet; + procedure SetValueChecked(const AValue: string); + procedure SetValueUnchecked(const AValue: string); protected - procedure LinkField; - function GetDefaultDisplayFormat: string; - function GetDisplayName: string; override; + function CreateTitle: TGridColumnTitle; override; // FPC 1.0 has TAlignment in the DB unit too function GetDefaultAlignment: {$IFDEF VER1_0}Classes.{$ENDIF}TAlignment; override; - function InternalDefaultReadOnly: boolean; override; + function GetDefaultDisplayFormat: string; + function GetDefaultValueChecked: string; virtual; + function GetDefaultValueUnchecked: string; virtual; function GetDefaultVisible: boolean; override; + function GetDisplayName: string; override; + function InternalDefaultReadOnly: boolean; override; function InternalDefaultWidth: Integer; override; - function CreateTitle: TGridColumnTitle; override; property IsAutomaticColumn: boolean read FIsAutomaticColumn; property IsDesignColumn: boolean read GetIsDesignColumn; + procedure LinkField; public constructor Create(ACollection: TCollection); override; + destructor Destroy; override; function IsDefault: boolean; override; property DesignIndex: integer read FDesignIndex; property Field: TField read GetField write SetField; @@ -173,6 +195,10 @@ 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); @@ -187,7 +213,7 @@ type function ColumnFromField(Field: TField): TColumn; function HasAutomaticColumns: boolean; function HasDesignColumns: boolean; - procedure RemoveAutomaticColumns; + procedure RemoveAutoColumns; public constructor Create(AGrid: TCustomDBGrid); function Add: TColumn; @@ -201,17 +227,20 @@ type TCustomDbGrid=class(TCustomGrid) private FDataLink: TComponentDataLink; + FExtraOptions: TDbgridExtraOptions; FOnCellClick: TDBGridClickEvent; FOnColEnter,FOnColExit: TNotifyEvent; FOnColumnMoved: TMovedEvent; FOnDrawColumnCell: TDrawColumnCellEvent; FOnFieldEditMask: TGetDbEditMaskEvent; FOnTitleClick: TDBGridClickEvent; + FOnUserCheckboxBitmap: TUserCheckboxBitmapEvent; FOptions: TDbGridOptions; FReadOnly: Boolean; FColEnterPending: Boolean; FLayoutChangedCount: integer; - FUseAutoColumns: boolean; + //FUseAutoColumns: boolean; + //FUseCheckBoxColumn: boolean; FVisualChangeCount: Integer; FSelectionLock: Boolean; FTempText : string; @@ -221,6 +250,8 @@ type FDefaultColWidths: boolean; FGridStatus: TDbGridStatus; FOldControlStyle: TControlStyle; + FIsEditingCheckBox: Boolean; // For checkbox column editing emulation (by SSY) + FCheckedBitmap, FUnCheckedBitmap, FGrayedBitmap: TBitmap; procedure EmptyGrid; function GetCurrentField: TField; function GetDataSource: TDataSource; @@ -241,9 +272,9 @@ type //procedure SetColumns(const AValue: TDBGridColumns); procedure SetCurrentField(const AValue: TField); procedure SetDataSource(const AValue: TDataSource); + procedure SetExtraOptions(const AValue: TDbgridExtraOptions); procedure SetOptions(const AValue: TDbGridOptions); procedure SetThumbTracking(const AValue: boolean); - procedure SetUseAutoColumns(const AValue: boolean); procedure UpdateBufferCount; procedure UpdateData; @@ -270,6 +301,8 @@ type procedure StartUpdating; procedure EndUpdating; function UpdatingData: boolean; + procedure SwapCheckBox; + function ValueMatch(const BaseValue, TestValue: string): Boolean; protected {$ifdef ver1_0} property FixedColor; @@ -280,6 +313,7 @@ type procedure CellClick(const aCol,aRow: Integer); override; procedure ChangeBounds(ALeft, ATop, AWidth, AHeight: integer); override; procedure ColRowMoved(IsColumn: Boolean; FromIndex,ToIndex: Integer); override; + function ColumnEditorStyle(aCol: Integer; F: TField): TColumnButtonStyle; function CreateColumns: TGridColumns; override; procedure CreateWnd; override; procedure DefineProperties(Filer: TFiler); override; @@ -292,6 +326,7 @@ type 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 EditingColumn(aCol: Integer; Ok: boolean); procedure EditorCancelEditing; procedure EditorDoGetValue; override; @@ -306,6 +341,8 @@ type function GetEditMask(aCol, aRow: Longint): string; override; function GetEditText(aCol, aRow: Longint): string; override; + function GetImageForCheckBox(CheckBoxView: TDBGridCheckBoxState): TBitmap; + function GridCanModify: boolean; procedure HeaderClick(IsColumn: Boolean; index: Integer); override; procedure HeaderSized(IsColumn: Boolean; Index: Integer); override; @@ -316,6 +353,7 @@ type procedure MoveSelection; override; procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override; procedure PrepareCanvas(aCol,aRow: Integer; aState:TGridDrawState); override; + procedure RemoveAutomaticColumns; procedure SelectEditor; override; procedure SetEditText(ACol, ARow: Longint; const Value: string); override; function ScrollBarAutomatic(Which: TScrollStyle): boolean; override; @@ -329,9 +367,9 @@ type property DataSource: TDataSource read GetDataSource write SetDataSource; property Options: TDbGridOptions read FOptions write SetOptions; + property OptionsExtra: TDbgridExtraOptions read FExtraOptions write SetExtraOptions; property ReadOnly: Boolean read FReadOnly write FReadOnly default false; - property UseAutoColumns: boolean read FUseAutoColumns write SetUseAutoColumns; - + property OnCellClick: TDBGridClickEvent read FOnCellClick write FOnCellClick; property OnColEnter: TNotifyEvent read FOnColEnter write FOnColEnter; property OnColExit: TNotifyEvent read FOnColExit write FOnColExit; @@ -339,10 +377,12 @@ type property OnDrawColumnCell: TDrawColumnCellEvent read FOnDrawColumnCell write FOnDrawColumnCell; property OnFieldEditMask: TGetDbEditMaskEvent read FOnFieldEditMask write FOnFieldEditMask; property OnTitleClick: TDBGridClickEvent read FOnTitleClick write FOnTitleClick; + property OnUserCheckboxBitmap: TUserCheckboxBitmapEvent read FOnUserCheckboxBitmap write FOnUserCheckboxBitmap; public constructor Create(AOwner: TComponent); override; procedure InitiateAction; override; procedure DefaultDrawColumnCell(const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); + function EditorByStyle(Style: TColumnButtonStyle): TWinControl; override; procedure ResetColWidths; destructor Destroy; override; property SelectedField: TField read GetCurrentField write SetCurrentField; @@ -362,7 +402,6 @@ type property GridLineColor; property GridLineStyle; property SelectedColor; - property UseAutoColumns; //property SelectedRows; published property Align; @@ -388,6 +427,7 @@ type //property ImeMode; //property ImeName; property Options; + property OptionsExtra; //property ParentBiDiMode; property ParentColor; //property ParentCtl3D; @@ -426,10 +466,86 @@ type //property OnStartDock; //property OnStartDrag; property OnTitleClick; + property OnUserCheckboxBitmap; end; + PCharArray = Array[0..6+13] of PChar; + +const + IMGDBGrayedBox : PCharArray = + ( + '13 13 6 1', + ' c None', + '. c #808080', + '+ c #FFFFFF', + '@ c #404040', + '# c #D4D0C8', + '$ c #000000', + + '############+', + '#..........#+', + '#.##########+', + '#.#######.##+', + '#.######..##+', + '#.#.###...##+', + '#.#..#...###+', + '#.#.....####+', + '#.##...#####+', + '#.###.######+', + '#.##########+', + '############+', + '+++++++++++++'); + + IMGDBCheckedBox : PCharArray = + ( + '13 13 6 1', + ' c None', + '. c #808080', + '+ c #FFFFFF', + '@ c #404040', + '# c #D4D0C8', + '$ c #000000', + + '............+', + '.@@@@@@@@@@#+', + '.@+++++++++#+', + '.@+++++++$+#+', + '.@++++++$$+#+', + '.@+$+++$$$+#+', + '.@+$$+$$$++#+', + '.@+$$$$$+++#+', + '.@++$$$++++#+', + '.@+++$+++++#+', + '.@+++++++++#+', + '.###########+', + '+++++++++++++'); + + IMGDBUnCheckedBox : PCharArray = + ( + '13 13 6 1', + ' c None', + '. c #808080', + '+ c #FFFFFF', + '@ c #404040', + '# c #D4D0C8', + '$ c #000000', + + '............+', + '.@@@@@@@@@@#+', + '.@+++++++++#+', + '.@+++++++++#+', + '.@+++++++++#+', + '.@+++++++++#+', + '.@+++++++++#+', + '.@+++++++++#+', + '.@+++++++++#+', + '.@+++++++++#+', + '.@+++++++++#+', + '.###########+', + '+++++++++++++'); + procedure Register; - + implementation procedure Register; @@ -664,6 +780,34 @@ begin UpdateActive; end; +procedure TCustomDbGrid.SetExtraOptions(const AValue: TDbgridExtraOptions); +var + OldOptions: TDbGridExtraOptions; + + function IsOptionChanged(Op: TDbgridExtraOption): boolean; + begin + result := ((op in OldOptions) and not (op in AValue)) or + (not (op in OldOptions) and (op in AValue)); + end; + +begin + if FExtraOptions=AValue then exit; + OldOptions := FExtraOptions; + FExtraOptions := AValue; + + if IsOptionChanged(dgeCheckboxColumn) then + Invalidate; + + if IsOptionChanged(dgeAutoColumns) then begin + if dgeAutoColumns in aValue then + AddAutomaticColumns + else if TDbGridColumns(Columns).HasAutomaticColumns then + RemoveAutomaticColumns; + UpdateActive; + end; + +end; + procedure TCustomDbGrid.SetOptions(const AValue: TDbGridOptions); var OldOptions: TGridOptions; @@ -728,18 +872,6 @@ begin EndUpdate(uoNone); end; -procedure TCustomDbGrid.SetUseAutoColumns(const AValue: boolean); -begin - if AValue <> FUseAutoColumns then begin - FUseAutoColumns := AValue; - if AValue then - AddAutomaticColumns - else if TDbGridColumns(Columns).HasAutomaticColumns then - TDbgridColumns(Columns).RemoveAutomaticColumns; - UpdateActive; - end; -end; - procedure TCustomDbGrid.UpdateBufferCount; var BuffCount: Integer; @@ -1183,10 +1315,46 @@ begin TDbGridColumns(Columns).ResetColumnsOrder(coFieldIndexOrder); end; +procedure TCustomDbGrid.SwapCheckBox; +var + TempColumn: TColumn; + SelField: TField; +begin + if not GridCanModify then + exit; // raise exception? + + SelField := SelectedField; + + if SelField.DataType=ftBoolean then + begin + SelField.Dataset.Edit; + SelField.AsBoolean := not SelField.AsBoolean + end else + begin + TempColumn := TColumn(ColumnFromGridColumn(Col)); + if not TempColumn.ReadOnly then + begin + SelField.Dataset.Edit; + if ValueMatch(TempColumn.ValueChecked, SelField.AsString) then + SelField.AsString := TempColumn.ValueUnchecked + else + SelField.AsString := TempColumn.ValueChecked; + end; + end; +end; + +function TCustomDbGrid.ValueMatch(const BaseValue, TestValue: string): Boolean; +begin + if BaseValue=TestValue then + Result := True + else + Result := False; +end; + procedure TCustomDbGrid.LinkActive(Value: Boolean); begin if not Value then - TDbGridColumns(Columns).RemoveAutoMaticColumns; + RemoveAutomaticColumns; LayoutChanged; end; @@ -1263,6 +1431,21 @@ begin end; end; +function TCustomDbGrid.ColumnEditorStyle(aCol: Integer; F: TField): TColumnButtonStyle; +begin + Result := cbsAuto; + if Columns.Enabled then + Result := ColumnFromGridColumn(aCol).ButtonStyle; + + if (Result=cbsAuto) and (F<>nil) then + case F.DataType of + ftBoolean: Result := cbsCheckboxColumn; + end; + + if (result = cbsCheckBoxColumn) and not (dgeCheckboxColumn in FExtraOptions) then + Result := cbsAuto; +end; + function TCustomDbGrid.CreateColumns: TGridColumns; begin result := TDbGridColumns.Create(Self); @@ -1331,19 +1514,25 @@ begin end else if (aRow=0)and(ACol>=FixedCols) then begin FixRectangle; - Canvas.TextRect(ARect,ARect.Left,ARect.Top,GeTGridColumnTitle(aCol)); + Canvas.TextRect(ARect,ARect.Left,ARect.Top,GetGridColumnTitle(aCol)); end; end else begin F := GetFieldFromGridColumn(aCol); - if F<>nil then begin - if F.dataType <> ftBlob then - S := F.DisplayText - else - S := '(blob)'; - end else - S := ''; - FixRectangle; - Canvas.TextRect(Arect,ARect.Left,ARect.Top, S); + case ColumnEditorStyle(aCol, F) of + cbsCheckBoxColumn: + DrawCheckBoxBitmaps(aCol, aRect, F); + else begin + if F<>nil then begin + if F.dataType <> ftBlob then + S := F.DisplayText + else + S := '(blob)'; + end else + S := ''; + FixRectangle; + Canvas.TextRect(Arect,ARect.Left,ARect.Top, S); + end; + end; end; end; @@ -1522,6 +1711,14 @@ begin end; Key:=0; end; + + VK_SPACE: + begin + if ColumnEditorStyle(Col, SelectedField) = cbsCheckboxColumn then begin + SwapCheckBox; + Key:=0; + end; + end; else inherited KeyDown(Key, Shift); @@ -1619,6 +1816,12 @@ begin Canvas.Brush.Color := Self.Color; end; +procedure TCustomDbGrid.RemoveAutomaticColumns; +begin + if not (csDesigning in ComponentState) then + TDbgridColumns(Columns).RemoveAutoColumns; +end; + procedure TCustomDbGrid.SelectEditor; begin if FDatalink.Active then @@ -1683,6 +1886,11 @@ end; procedure TCustomDbGrid.CellClick(const aCol, aRow: Integer); begin + if ColumnEditorStyle(ACol, SelectedField) = cbsCheckboxColumn then + if FIsEditingCheckBox then + SwapCheckBox + else + FIsEditingCheckBox := True; if Assigned(OnCellClick) then OnCellClick(TColumn(ColumnFromGridColumn(aCol))); end; @@ -1810,6 +2018,19 @@ 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.GridCanModify: boolean; begin result := not ReadOnly and (dgEditing in Options) and not FDataLink.ReadOnly @@ -1820,6 +2041,7 @@ procedure TCustomDbGrid.MoveSelection; begin if FSelectionLock then exit; + FIsEditingCheckBox := False; {$ifdef dbgdbgrid}DebugLn('DbGrid.MoveSelection INIT');{$Endif} inherited MoveSelection; if FColEnterPending and Assigned(OnColEnter) then begin @@ -1890,6 +2112,40 @@ begin DefaultDrawCell(aCol, aRow, aRect, aState); end; +procedure TCustomDbGrid.DrawCheckboxBitmaps(aCol: Integer; aRect: TRect; + F: TField); +var + ChkBitmap: TBitmap; + XPos,YPos: Integer; +begin + // by SSY + if (F<>nil) then + if F.DataType=ftBoolean then + if F.IsNull then + ChkBitmap := GetImageForCheckBox(gcbpGrayed) + else + if F.AsBoolean then + ChkBitmap := GetImageForCheckBox(gcbpChecked) + else + ChkBitmap := GetImageForCheckBox(gcbpUnChecked) + else + if ValueMatch(F.AsString, TColumn(ColumnFromGridColumn(aCol)).ValueChecked) then + ChkBitmap := GetImageForCheckBox(gcbpChecked) + else + if ValueMatch(F.AsString, TColumn(ColumnFromGridColumn(aCol)).ValueUnChecked) then + ChkBitmap := GetImageForCheckBox(gcbpUnChecked) + else + ChkBitmap := GetImageForCheckBox(gcbpGrayed) + else + ChkBitmap := GetImageForCheckBox(gcbpGrayed); + + 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; + function TCustomDbGrid.EditorCanAcceptKey(const ch: Char): boolean; var aField: TField; @@ -2024,12 +2280,24 @@ begin goSmoothScroll, goColMoving, goTabs, goEditing, goDrawFocusSelected, goColSizing ]; + FExtraOptions := [dgeAutoColumns, dgeCheckboxColumn]; // What a dilema!, we need ssAutoHorizontal and ssVertical!!! ScrolLBars:=ssBoth; DefaultTextStyle.Wordbreak := False; DefaultRowHeight := 18; + + // Default bitmaps for cbsCheckedColumn + FUnCheckedBitmap := TBitmap.Create; + FUnCheckedBitmap.Handle := CreatePixmapIndirect(@IMGDBUnCheckedBox[0], + GetSysColor(COLOR_BTNFACE)); + FCheckedBitmap := TBitmap.Create; + FCheckedBitmap.Handle := CreatePixmapIndirect(@IMGDBCheckedBox[0], + GetSysColor(COLOR_BTNFACE)); + FGrayedBitmap := TBitmap.Create; + FGrayedBitmap.Handle := CreatePixmapIndirect(@IMGDBGrayedBox[0], + GetSysColor(COLOR_BTNFACE)); end; procedure TCustomDbGrid.InitiateAction; @@ -2084,18 +2352,34 @@ begin end; end else begin F := GetFieldFromGridColumn(DataCol); - if F<>nil then begin - if F.dataType <> ftBlob then - S := F.DisplayText - else - S := '(blob)'; - end else - S := ''; - R := FixRectangle(); - Canvas.TextRect(R,R.Left,R.Top,S); + case ColumnEditorStyle(DataCol, F) of + cbsCheckBoxColumn: + DrawCheckBoxBitmaps(DataCol, Rect, F); + else begin + if F<>nil then begin + if F.dataType <> ftBlob then + S := F.DisplayText + else + S := '(blob)'; + end else + S := ''; + FixRectangle(); + Canvas.TextRect(rect,Rect.Left,Rect.Top, S); + end; + end; end; end; +function TCustomDbGrid.EditorByStyle(Style: TColumnButtonStyle): TWinControl; +begin + // we want override the editor style if it is cbsAuto because + // field.datatype might be ftBoolean or some other cases + if Style=cbsAuto then + Style := ColumnEditorStyle(Col, SelectedField); + + Result:=inherited EditorByStyle(Style); +end; + procedure TCustomDbGrid.ResetColWidths; begin if not FDefaultColWidths then begin @@ -2106,6 +2390,9 @@ end; destructor TCustomDbGrid.Destroy; begin + FUncheckedBitmap.Free; + FCheckedBitmap.Free; + FGrayedBitmap.Free; FDataLink.OnDataSetChanged:=nil; FDataLink.OnRecordChanged:=nil; FDataLink.Free; @@ -2307,7 +2594,7 @@ begin end; end; -procedure TDbGridColumns.RemoveAutomaticColumns; +procedure TDbGridColumns.RemoveAutoColumns; var i: Integer; begin @@ -2404,6 +2691,22 @@ begin result := (DesignIndex>=0) and (DesignIndex<10000); 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 @@ -2427,6 +2730,16 @@ begin Result := FDisplayFormatChanged; end; +function TColumn.IsValueCheckedStored: boolean; +begin + result := ValueChecked <> GetDefaultValueChecked; +end; + +function TColumn.IsValueUncheckedStored: boolean; +begin + Result := ValueUnchecked <> GetDefaultValueUnchecked; +end; + procedure TColumn.SetDisplayFormat(const AValue: string); begin if (not FDisplayFormatChanged)or(CompareText(AValue, FDisplayFormat)<>0) then begin @@ -2465,6 +2778,32 @@ 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; + function TColumn.InternalDefaultWidth: Integer; var AGrid: TCustomDbGrid; @@ -2495,6 +2834,13 @@ begin end; end; +destructor TColumn.Destroy; +begin + if FValueChecked<>nil then StrDispose(FValueUnchecked); + if FValueUnchecked<>nil then StrDispose(FValueUnchecked); + inherited Destroy; +end; + function TColumn.IsDefault: boolean; begin result := not FDisplayFormatChanged and (inherited IsDefault()); @@ -2523,6 +2869,22 @@ begin end; end; +function TColumn.GetDefaultValueChecked: string; +begin + if (FField<>nil) and (FField.Datatype=ftBoolean) then + Result := BoolToStr(True) + else + Result := '1'; +end; + +function TColumn.GetDefaultValueUnchecked: string; +begin + if (FField<>nil) and (FField.DataType=ftBoolean) then + Result := BoolToStr(False) + else + Result := '0'; +end; + function TColumn.InternalDefaultReadOnly: boolean; var AGrid: TCustomDBGrid; @@ -2574,6 +2936,9 @@ end. { $Log$ + Revision 1.43 2005/06/11 09:30:24 mattias + added checkboxes to TDBGrid from Sergey Smirnov + Revision 1.42 2005/06/07 19:29:24 vincents fixes for bugs 922,924 and updating <10 recs. Automatic Columns, picklist implementation from Jesus diff --git a/lcl/grids.pas b/lcl/grids.pas index 7f0136b194..fc0504f475 100644 --- a/lcl/grids.pas +++ b/lcl/grids.pas @@ -124,7 +124,7 @@ type TItemType = (itNormal,itCell,itColumn,itRow,itFixed,itFixedColumn,itFixedRow,itSelected); - TColumnButtonStyle = (cbsAuto, cbsEllipsis, cbsNone, cbsPickList); + TColumnButtonStyle = (cbsAuto, cbsEllipsis, cbsNone, cbsPickList, cbsCheckboxColumn); //SSY TCleanOptions = set of TGridZone; TTitleStyle = (tsLazarus, tsStandard, tsNative); @@ -836,7 +836,7 @@ type function CellRect(ACol, ARow: Integer): TRect; procedure Clear; - function EditorByStyle(Style: TColumnButtonStyle): TWinControl; + function EditorByStyle(Style: TColumnButtonStyle): TWinControl; virtual; procedure EditorExit(Sender: TObject); procedure EditorKeyDown(Sender: TObject; var Key:Word; Shift:TShiftState); procedure EditorKeyPress(Sender: TObject; var Key: Char); @@ -3901,7 +3901,7 @@ end; function TCustomGrid.EditorByStyle(Style: TColumnButtonStyle): TWinControl; begin case Style of - cbsNone: + cbsNone, cbsCheckboxColumn: //SSY Result := nil; cbsEllipsis: Result := FButtonEditor; @@ -7491,7 +7491,7 @@ begin TransMsg('PicklistEditor: ', TheMessage); {$Endif} if TheMessage.msg=LM_KILLFOCUS then begin - if TheMessage.WParamLo = Handle then begin + if (TheMessage.WParam and $FFFF) = Handle then begin // what a weird thing, we are losing the focus // and giving it to ourselves TheMessage.Result := 0; // doesn't allow such thing diff --git a/lcl/lclproc.pas b/lcl/lclproc.pas index 92e089e98e..ddbaf9037c 100644 --- a/lcl/lclproc.pas +++ b/lcl/lclproc.pas @@ -190,6 +190,7 @@ function UTF8FindNearestCharStart(UTF8Str: PChar; Len: integer; BytePos: integer): integer; // find the n-th UTF8 character, ignoring BIDI function UTF8CharStart(UTF8Str: PChar; Len, Index: integer): PChar; +procedure UTF8FixBroken(P: PChar); // ====================================================================== @@ -1580,6 +1581,42 @@ begin end; end; +procedure UTF8FixBroken(P: PChar); +// fix any broken UTF8 sequences with spaces +begin + if p=nil then exit; + while p^<>#0 do begin + if ord(p^)<%11000000 then begin + // regular single byte character + inc(p); + end + else if ((ord(p^) and %11100000) = %11000000) then begin + // should be 2 byte character + if (ord(p[1]) and %11000000) = %10000000 then + inc(p,2) + else if p[1]<>#0 then + p^:=' '; + end + else if ((ord(p^) and %11110000) = %11100000) then begin + // should be 3 byte character + if ((ord(p[1]) and %11000000) = %10000000) + and ((ord(p[2]) and %11000000) = %10000000) then + inc(p,3) + else + p^:=' '; + end + else if ((ord(p^) and %11111000) = %11110000) then begin + // should be 4 byte character + if ((ord(p[1]) and %11000000) = %10000000) + and ((ord(p[2]) and %11000000) = %10000000) + and ((ord(p[3]) and %11000000) = %10000000) then + inc(p,4) + else + p^:=' '; + end + end; +end; + //============================================================================== // Endian utils //==============================================================================