var i:integer; begin if gdSelected in State then Exit; //隔行改变网格背景色: if adoQuery1.RecNo mod 2 = 0 then (Sender as TDBGrid).Canvas.Brush.Color := clinfobk //定义背景颜色 else (Sender as TDBGrid).Canvas.Brush.Color := RGB(191, 255, 223); //定义背景颜色
//定义网格线的颜色: DBGrid1.DefaultDrawColumnCell(Rect,DataCol,Column,State); with (Sender as TDBGrid).Canvas do //画 cell 的边框 begin Pen.Color := $00ff0000; //定义画笔颜色(蓝色) MoveTo(Rect.Left, Rect.Bottom); //画笔定位 LineTo(Rect.Right, Rect.Bottom); //画蓝色的横线 Pen.Color := clbtnface; //定义画笔颜色(兰色) MoveTo(Rect.Right, Rect.Top); //画笔定位 LineTo(Rect.Right, Rect.Bottom); //画绿色 end; end;
procedure TForm1.DBGrid1DrawDataCell(Sender: TObject; const Rect: TRect; Field: TField; State: TGridDrawState); begin if (gdFocused in State) then begin if (Field.FieldName = DBComboBox1.DataField ) then begin DBComboBox1.Left := Rect.Left + DBGrid1.Left; DBComboBox1.Top := Rect.Top + DBGrid1.top; DBComboBox1.Width := Rect.Right - Rect.Left; DBComboBox1.Height := Rect.Bottom - Rect.Top; DBComboBox1.Visible := True; end; end; end;
5、DBGrid指定单元格未获得焦点时不显示DBComboBox,设置DBGrid1的OnColExit事件如下: procedure TForm1.DBGrid1ColExit(Sender: TObject); begin If DBGrid1.SelectedField.FieldName = DBComboBox1.DataField then begin DBComboBox1.Visible := false; end; end;
6、当DBGrid指定列获得焦点时DrawDataCell事件只是绘制单元格,并显示DBComboBox,但是DBComboBox并没有获得焦点,数据的输入还是在单元格上进行。在DBGrid1的KeyPress事件中调用SendMessage这个 Windows API函数将数据输入传输到DBComboBox上,从而达到在DBComboBox上进行数据输入。因此还要设置KeyPress事件如下:
procedure TForm1.DBGrid1KeyPress(Sender: TObject; var Key: Char); begin if (key < > chr(9)) then begin if (DBGrid1.SelectedField.FieldName =DBComboBox1.DataField) then begin DBComboBox1.SetFocus; SendMessage(DBComboBox1.Handle,WM_Char,word(Key),0); end; end; end;
begin if TableField.AsInteger < 0 then DBGrid.Canvas.Font.Color := clRed else DBGrid.Canvas.Font.Color := clBlack; DBGrid.DefaultDrawColumnCell(...); end;
Case DataCol Mod 2 = 0 of True: DbGrid1.Canvas.Brush.Color:= clBlue; file://偶数列用蓝色 False: DbGrid1.Canvas.Brush.Color:= clAqua; file://奇数列用浅绿色 End; DbGrid1.Canvas.Pen.Mode:=pmMask; DbGrid1.DefaultDrawColumnCell (Rect DataCol Column State);
2. 纵向斑马线,同时以红色突出显示当前单元格效果:以突出显示当前选中的字段。
file://将上述代码修改为: Case DataCol Mod 2 = 0 of True: DbGrid1.Canvas.Brush.Color:= clBlue; file://偶数列用蓝色 False: DbGrid1.Canvas.Brush.Color:= clAqua; file://奇数列用浅绿色 End; If ((State = [gdSelected]) or (State=[gdSelectedgdFocused])) then If Not DbGrid1.SelectedRows.CurrentRowSelected then DbGrid1.Canvas.Brush.Color:=clRed; file://当前选中单元格显示红色 DbGrid1.Canvas.Pen.Mode:=pmMask; DbGrid1.DefaultDrawColumnCell (Rect DataCol Column State);
if ((State = [gdSelected]) or (State=[gdSelected gdFocused])) then DbGrid1.Canvas.Brush.color:=clRed; file://当前行以红色显示,其它行使用背景的浅绿色 DbGrid1.Canvas.pen.mode:=pmmask; DbGrid1.DefaultDrawColumnCell (Rect DataCol Column State);
4.行突显的斑马线效果:既突出当前行,又区分不同的列(字段)。
file://其它属性设置同3,将上述代码修改为: if ((State = [gdSelected]) or (State=[gdSelectedgdFocused])) then begin Case DataCol Mod 2 = 0 of True : DbGrid1.Canvas.Brush.color:=clRed; file://当前选中行的偶数列显示红色 False: DbGrid1.Canvas.Brush.color:=clblue; file://当前选中行的奇数列显示蓝色 end; DbGrid1.Canvas.pen.mode:=pmmask; DbGrid1.DefaultDrawColumnCell (Rect DataCol Column State); end;
5.横向斑马线, 同时以红色突显当前行效果。
file://其它属性设置同3,将上述代码修改为: Case Table1.RecNo mod 2 = 0 of file://根据数据集的记录号进行判断 True : DbGrid1.Canvas.Brush.color:=clAqua; file://偶数行用浅绿色显示 False: DbGrid1.Canvas.Brush.color:=clblue; file://奇数行用蓝色表示 end; if ((State = [gdSelected]) or (State=[gdSelectedgdFocused])) then file://选中行用红色显示 DbGrid1.Canvas.Brush.color:=clRed; DbGrid1.Canvas.pen.mode:=pmMask; DbGrid1.DefaultDrawColumnCell (Rect DataCol Column State);
6.双向斑马线效果:即行间用不同色区分,同时,选中行以纵向斑马线效果区分不同的列。
file://其它属性设置同3,将上述代码修改为: Case Table1.RecNo mod 2 = 0 of file://根据数据集的记录号进行判断 True : DbGrid1.Canvas.Brush.color:=clAqua; file://偶数行用浅绿色显示 False: DbGrid1.Canvas.Brush.color:= clblue; file://奇数行用蓝色表示 end; If ((State = [gdSelected]) or (State=[gdSelectedgdFocused])) then Case DataCol mod 2 = 0 of True : DbGrid1.Canvas.Brush.color:=clRed; file://当前选中行的偶数列用红色 False: DbGrid1.Canvas.Brush.color:= clGreen; file://当前选中行的奇数列用绿色表示 end; DbGrid1.Canvas.pen.mode:=pmMask; DbGrid1.DefaultDrawColumnCell (Rect DataCol Column State);
欲实现点击DBGrid的Title对查询结果排序,想作一个通用程序,不是一事一议,例如不能在SQL语句中增加Order by ...,因为SQL可能原来已经包含Order by ...,而且点击另一个Title时又要另外排序,目的是想作到象资源管理器那样随心所欲。
procedure TFHkdata.SortQuery(Column:TColumn); var SqlStr,myFieldName,TempStr: string; OrderPos: integer; SavedParams: TParams; begin if not (Column.Field.FieldKind in [fkData,fkLookup]) then exit; if Column.Field.FieldKind =fkData then myFieldName := UpperCase(Column.Field.FieldName) else myFieldName := UpperCase(Column.Field.KeyFields); while Pos(myFieldName,';')<>0 do myFieldName := copy(myFieldName,1,Pos(myFieldName,';')-1)+ ',' + copy(myFieldName,Pos(myFieldName,';')+1,100); with TQuery(TDBGrid(Column.Grid).DataSource.DataSet) do begin SqlStr := UpperCase(Sql.Text); // if pos(myFieldName,SqlStr)=0 then exit; if ParamCount>0 then begin SavedParams := TParams.Create; SavedParams.Assign(Params); end; OrderPos := pos('ORDER',SqlStr); if (OrderPos=0) or (pos(myFieldName,copy(SqlStr,OrderPos,100))=0) then TempStr := ' Order By ' + myFieldName + ' Asc' else if pos('ASC',SqlStr)=0 then TempStr := ' Order By ' + myFieldName + ' Asc' else TempStr := ' Order By ' + myFieldName + ' Desc'; if OrderPos<>0 then SqlStr := Copy(SqlStr,1,OrderPos-1); SqlStr := SqlStr + TempStr; Active := False; Sql.Clear; Sql.Text := SqlStr; if ParamCount>0 then begin Params.AssignValues(SavedParams); SavedParams.Free; end; Prepare; Open; end; end;
2003-11-13 11:13:57 去掉DbGrid的自动添加功能 关键词:DbGrid
移动到最后一条记录时再按一下“下”就会追加一条记录,如果去掉这项功能 procedure TForm1.DataSource1Change(Sender: TObject; Field: TField); begin if TDataSource(Sender).DataSet.Eof then TDataSource(Sender).DataSet.Cancel; end;
procedure TForm1.NewGridWnd(var Message: TMessage); var IsNeg : Boolean; begin if Message.Msg = WM_MOUSEWHEEL then begin IsNeg := Short(Message.WParamHi) < 0; if IsNeg then DBGrid1.DataSource.DataSet.MoveBy(1) else DBGrid1.DataSource.DataSet.MoveBy(-1) end else OldGridWnd(Message); end;
if (GetWindowlong(Stringgrid1.Handle, GWL_STYLE) and WS_VSCROLL) <> 0 then ShowMessage('Vertical scrollbar is visible!'); if (GetWindowlong(Stringgrid1.Handle, GWL_STYLE) and WS_HSCROLL) <> 0 then ShowMessage('Horizontal scrollbar is visible!');
procedure Register; begin RegisterComponents('Samples', [TSyncStringGrid]); end;
procedure TSyncStringGrid.WMVScroll(var Msg: TMessage); begin if not FInSync and Assigned(FSyncGrid) and (FSyncKind in [skBoth, skVScroll]) then FSyncGrid.DoSync(WM_VSCROLL, Msg.wParam, Msg.lParam); inherited; end;
procedure TSyncStringGrid.WMHScroll(var Msg: TMessage); begin if not FInSync and Assigned(FSyncGrid) and (FSyncKind in [skBoth, skHScroll]) then FSyncGrid.DoSync(WM_HSCROLL, Msg.wParam, Msg.lParam); inherited; end;
begin OldGridProc1(Message); if ((Message.Msg = WM_VSCROLL) or (Message.Msg = WM_HSCROLL) or Message.msg = WM_Mousewheel)) then begin OldGridProc2(Message); end; end;
procedure TForm1.Grid2WindowProc(var Message: TMessage); begin OldGridProc2(Message); if ((Message.Msg = WM_VSCROLL) or (Message.Msg = WM_HSCROLL) or (Message.msg = WM_Mousewheel)) then begin OldGridProc1(Message); end; end;
procedure TClientForm.MemberGridDrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); var oldcolor:tcolor; oldpm:tpenmode; begin if DM.ProjectTEAM_LEADER.Value = DM.Emp_ProjEMP_NO.Value then {设定变色的行的条件} MemberGrid.Canvas.Font.Style := [fsBold]; MemberGrid.DefaultDrawColumnCell(Rect, DataCol, Column, State); {上面是演示程序的原内容,以下是增加部分} if DM.ProjectTEAM_LEADER.Value =DM.Emp_ProjEMP_NO.Value then {设定变色的行的条件} begin oldpm:= MemberGrid.Canvas.pen.mode; oldcolor:= MemberGrid.Canvas.Brush.color; MemberGrid.Canvas.Brush.color:=clyellow; MemberGrid.Canvas.pen.mode:=pmmask; MemberGrid.DefaultDrawColumnCell(Rect, DataCol, Column, State); MemberGrid.Canvas.Brush.color:=oldcolor; MemberGrid.Canvas.pen.mode:=oldpm; end; end; 感觉上这个方法和前面的几个颜色控制方法的原理是一样的,都是通过ONDrawColumnCell事件来实现变色醒目美化的功能。:)
2003-11-19 9:43:56 如何在DBGrid中能支持多项记录的选择 这份文档来自国外,粗略看了一下,很有用,推荐给大家学习使用。 【Question】: How to do multi-selecting records in TDBGrid? When you add [dgMultiSelect] to the Options property of a DBGrid, you give yourself the ability to select multiple records within the grid. The records you select are represented as bookmarks and are stored in the SelectedRows property. The SelectedRows property is an object of type TBookmarkList. The properties and methods are described below.
// TBookmarkList = class // public {* The Clear method will free all the selected records within the DBGrid *} // procedure Clear; {* The Delete method will delete all the selected rows from the dataset *} // procedure Delete; {* The Find method determines whether a bookmark is in the selected list. *} // function Find(const Item: TBookmarkStr; // var Index: Integer): Boolean; {* The IndexOf method returns the index of the bookmark within the Items property. *} // function IndexOf(const Item: TBookmarkStr): Integer; {* The Refresh method returns a boolean value to notify whether any orphans were dropped (deleted) during the time the record has been selected in the grid. The refresh method can be used to update the selected list to minimize the possibility of accessing a deleted record. *} // function Refresh: Boolean; True = orphans found {* The Count property returns the number of currently selected items in the DBGrid *} // property Count: Integer read GetCount; {* The CurrentRowSelected property returns a boolean value and determines whether the current row is selected or not. *} // property CurrentRowSelected: Boolean // read GetCurrentRowSelected // write SetCurrentRowSelected; {* The Items property is a TStringList of TBookmarkStr *} // property Items[Index: Integer]: TBookmarkStr // read GetItem; default; // end;
var Form1: TForm1; Bookmark1: TBookmark; z: Integer;
implementation
{$R *.DFM}
//Example of the Count property procedure TForm1.CountClick(Sender: TObject); begin if DBgrid1.SelectedRows.Count > 0 then begin showmessage(inttostr(DBgrid1.SelectedRows.Count)); end; end;
//Example of the CurrentRowSelected property procedure TForm1.SelectedClick(Sender: TObject); begin if DBgrid1.SelectedRows.CurrentRowSelected then showmessage('Selected'); end;
//Example of the Clear Method procedure TForm1.ClearClick(Sender: TObject); begin dbgrid1.SelectedRows.Clear; end;
//Example of the Delete Method procedure TForm1.DeleteClick(Sender: TObject); begin DBgrid1.SelectedRows.Delete; end;
{* This example iterates through the selected rows of the grid and displays the second field of the dataset. The Method DisableControls is used so that the DBGrid will not update when the dataset is changed. The last position of the dataset is saved as a TBookmark. The IndexOf method is called to check whether or not the bookmark is still existent. The decision of using the IndexOf method rather than the Refresh method should be determined by the specific application. *}
procedure TForm1.SelectClick(Sender: TObject); var x: word; TempBookmark: TBookMark; begin DBGrid1.Datasource.Dataset.DisableControls; with DBgrid1.SelectedRows do if Count > 0 then begin TempBookmark:= DBGrid1.Datasource.Dataset.GetBookmark; for x:= 0 to Count - 1 do begin if IndexOf(Items[x]) > -1 then begin DBGrid1.Datasource.Dataset.Bookmark:= Items[x]; showmessage(DBGrid1.Datasource.Dataset.Fields[1].AsString); end; end; end; DBGrid1.Datasource.Dataset.GotoBookmark(TempBookmark); DBGrid1.Datasource.Dataset.FreeBookmark(TempBookmark); DBGrid1.Datasource.Dataset.EnableControls; end;
{* This example allows you to set a bookmark and and then search for the bookmarked record within selected a record(s) within the DBGrid. *}
//Sets a bookmark procedure TForm1.GetBookMarkClick(Sender: TObject); begin Bookmark1:= DBGrid1.Datasource.Dataset.GetBookmark; end;
//Frees the bookmark procedure TForm1.FreeBookmarkClick(Sender: TObject); begin if assigned(Bookmark1) then begin DBGrid1.Datasource.Dataset.FreeBookmark(Bookmark1); Bookmark1:= nil; end; end;
//Uses the Find method to locate the position of the bookmarked record within the selected list in the DBGrid procedure TForm1.FindClick(Sender: TObject); begin if assigned(Bookmark1) then begin if DBGrid1.SelectedRows.Find(TBookMarkStr(Bookmark1),z) then showmessage(inttostr(z)); end; end;
procedure TForm1.ColoredDBGrid1 DRawColoredDBGrid (Sender: TObject; Field: TField; var Color: TColor; var Font: TFont); Var p : Integer; begin p := Table1.FindField('wage').AsInteger; //取得当前记录的Wage字段的值。 if (p < 500) then begin //程序将根据wage值设置各行的颜色。 Color := clGreen; Font.Style := [fsItalic]; //不仅可以改变颜色,还可以改变字体 end; if(p >= 500) And (p < 800) then Color := clRed; if(p >=800) then begin Color := clMaroon; Font.Style := [fsBold]; end; end; //用‘退出’按钮结束程序运行。 procedure TForm1.Button1Click(Sender: TObject); begin Close; end;
if Key = #13 then if ActiveControl = DBGrid1 then begin TDBGrid(ActiveControl).SelectedIndex := TDBGrid(ActiveControl).SelectedIndex + 1; Key := #0; end;
2003-11-19 10:25:07 从 DBGrid 中复制记录procedure TForm1.DBGrid1DblClick(Sender: TObject); var x : integer ; HadToOpen : boolean ; begin with Sender as TDBGrid do begin HadToOpen := not tTarget.Active ; if HadToOpen then tTarget.Active := True ; tTarget.Append ; for x := 0 to FieldCount - 1 do case Fields[x].DataType of ftBoolean : tTarget.FieldByName(Fields[x].FieldName).AsBoolean := Fields[x].AsBoolean ftString : tTarget.FieldByName(Fields[x].FieldName).AsString := Fields[x].AsString ftFloat : tTarget.FieldByName(Fields[x].FieldName).AsFloat := Fields[x].AsFloat ftInteger : tTarget.FieldByName(Fields[x].FieldName).AsInteger := Fields[x].AsInteger ftDate : tTarget.FieldByName(Fields[x].FieldName).AsDateTime := Fields[x].AsDateTime ; end ; tTarget.Post ; if HadToOpen then tTarget.Active := False ; end ; end;
2003-11-19 10:27:58 使用 DBGrid 的复选项(请参考如何在DBGrid中能支持多项记录的选择)procedure TForm1.SelectClick(Sender: TObject); var x: word; TempBookmark: TBookMark; begin DBGrid1.Datasource.Dataset.DisableControls; with DBgrid1.SelectedRows do if Count <> 0 then begin TempBookmark:= DBGrid1.Datasource.Dataset.GetBookmark; for x:= 0 to Count - 1 do begin if IndexOf(Items[x]) > -1 then begin DBGrid1.Datasource.Dataset.Bookmark:= Items[x]; showmessage(DBGrid1.Datasource.Dataset.Fields[1].AsString); end; end; end; DBGrid1.Datasource.Dataset.GotoBookmark(TempBookmark); DBGrid1.Datasource.Dataset.FreeBookmark(TempBookmark); DBGrid1.Datasource.Dataset.EnableControls; end;
procedure TForm1.DBGrid1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin accept:=true; end;
5) 在Dbgrid的DragDrop事件中增加如下代码: 让它能够自动跳到光标所指定的记录上
procedure TForm1.DBGrid1DragDrop(Sender, Source: TObject; X, Y: Integer); begin if Source<>Edit1 then exit; with Sender as TDbGrid do begin Perform(wm_LButtonDown,0,MakeLong(x,y)); PerForm(WM_LButtonUp, 0,MakeLong(x,y)); SelectedField.Dataset.edit; SelectedField.AsString:=Edit1.text; end; end;
TMyCustomDBGrid(DBGrid1).MouseDown(...) 或 DBGrid1 as TMyCustomDBGrid).MouseDown(...)即可。
2003-11-19 10:56:11 在dbgrid表格中如何设置按回车键相当于单click?【例程】: 在窗体form1中放入table1,datasource1,dbgrid1,设好联连关系,使 dbgrid1 中能正确显示出table1的数据。然后: procedure TForm1.DBGrid1KeyPress(Sender: TObject; var Key: Char); begin with DBGrid1 do if Key=#13 then DBGrid1CellClick(Columns[SelectedIndex]); end;
procedure TForm1.DBGrid1CellClick(Column: TColumn); begin with DBGrid1 do showmessage(format('row=%d',[SelectedIndex])); end;
procedure TNewDBGrid.AutoDestroy; begin {在这里释放自己添加参数等占用的系统资源} end;
procedure TNewDBGrid.SetWZebra(Value: Boolean); begin FWZebra := Value; Refresh; end;
function TNewDBGrid.GetWZebra: Boolean; begin Result := FWZebra; end;
function TNewDBGrid.GetWFirstColor: TColor; begin Result := FWFirstColor; end;
procedure TNewDBGrid.SetWFirstColor(Value: TColor); begin FWFirstColor := Value; Refresh; end;
function TNewDBGrid.GetWSecondColor: TColor; begin Result := FWSecondColor; end;
procedure TNewDBGrid.SetWSecondColor(Value: TColor); begin FWSecondColor := Value; Refresh; end;
constructor TNewDBGrid.Create(AOwner: TComponent); begin inherited Create(AOwner); AutoInitialize; end;
destructor TNewDBGrid.Destroy; begin AutoDestroy; inherited Destroy; end; //实现斑马效果
procedure TNewDBGrid.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); var OldActive: Integer; Highlight: Boolean; Value: string; DrawColumn: Tcolumn; cl: TColor; fn: TFont; begin {如果处于控件装载状态,则直接填充颜色后退出} if csLoading in ComponentState then begin Canvas.Brush.Color := Color; Canvas.FillRect(ARect); Exit; end; if (gdFixed in AState) and (ACol - IndicatorOffset < 0) then begin inherited DrawCell(ACol, ARow, ARect, AState); Exit; end; {对于列标题,不用任何修饰} if (dgTitles in Options) and (ARow = 0) then begin inherited DrawCell(ACol, ARow, ARect, AState); Exit; end; if (dgTitles in Options) then Dec(ARow); Dec(ACol, IndicatorOffset); if (gdFixed in AState) and ([dgRowLines, dgColLines] * Options = [dgRowLines, dgColLines]) then begin {缩减ARect,以便填写数据} InflateRect(ARect, -1, -1); end else with Canvas do begin DrawColumn := Columns[ACol]; Font := DrawColumn.Font; Brush.Color := DrawColumn.Color; Font.Color := DrawColumn.Font.Color; if FWZebra then //如果属性WZebra为True则显示斑马纹 if Odd(ARow) then Brush.Color := FWSecondColor else Brush.Color := FWFirstColor; if (DataLink = nil) or not DataLink.Active then FillRect(ARect) else begin Value := ''; OldActive := DataLink.ActiveRecord; try DataLink.ActiveRecord := ARow; if Assigned(DrawColumn.Field) then begin Value := DrawColumn.Field.DisplayText; if Assigned(FDrawFieldCellEvent) then begin cl := Brush.Color; fn := Font; FDrawFieldCellEvent(self, DrawColumn.Field, cl, fn, ARow); Brush.Color := cl; Font := fn; end; end; Highlight := HighlightCell(ACol, ARow, Value, AState); if Highlight and (not FWZebra) then begin Brush.Color := clHighlight; Font.Color := clHighlightText; end; if DefaultDrawing then DefaultDrawColumnCell(ARect, ACol, DrawColumn, AState); if Columns.State = csDefault then DrawDataCell(ARect, DrawColumn.Field, AState); DrawColumnCell(ARect, ACol, DrawColumn, AState); finally DataLink.Activerecord := OldActive; end; if DefaultDrawing and (gdSelected in AState) and ((dgAlwaysShowSelection in Options) or Focused) and not (csDesigning in Componentstate) and not (dgRowSelect in Options) and (ValidParentForm(self).ActiveControl = self) then begin //显示当前光标处为蓝底黄字,同时加粗显示 Windows.DrawFocusRect(Handle, ARect); Canvas.Brush.COlor := clBlue; Canvas.FillRect(ARect); Canvas.Font.Color := clYellow; Canvas.Font.Style := [fsBold]; DefaultDrawColumnCell(ARect, ACol, DrawColumn, AState); end; end; end; if (gdFixed in AState) and ([dgRowLines, dgColLines] * Options = [dgRowLines, dgColLines]) then begin InflateRect(ARect, -2, -2); DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_BOTTOMRIGHT); DrawEdge(Canvas.Handle, ARect, BDR_SUNKENINNER, BF_TOPLEFT); end; end; //如果移动光标等,则需要刷新显示DBGrid
procedure TNewDBGrid.Scroll(Distance: Integer); begin inherited Scroll(Distance); refresh; end;
end.
以上程序在Win98 + Delphi 5下调试通过。
2003-11-19 11:27:19 在DBGrid控件中显示图形 如果在数据库中设置了一个为BLOB类型的字段用于保存图形,在使用DBGrid控件显示时,在表格中显示的是BLOB,而无法显示出图形,当然,有一些第三方控件可以显示出图形,但是要去找第三方控件不是一件容易的事,而且有些好用的都需要付费。能不能在DBGrid中显示图形呢?答案是肯定的。 在DBGrid的OnDrawCell事件中加入如下代码即可在DBGrid控件中显示图形。 var Bmp: TBitmap; begin if (Column.Field.DataTyp = ftBLOB) or (Column.Field.DataTyp = ftGraphic) then begin Bmp:=TBitmap.Create; try Bmp.Assign(Column.Field); DBGrid1.Canvas.StretchDraw(Rect,Bmp); Bmp.Free; Except Bmp.Free; end; end; end; 按照类似的方法,就可以在DBGrid中显示Memo类型的字段内容。 另外,在往数据库中保存图形时,建议使用EMF图元文件,这样数据库文件的大小不会变的十分惊人,我试过了,同样是一幅400*300的图形,如果用位图,保存100多幅时,数据库文件大小会达到近20MB,而使用EMF矢量图形保存,保存800多幅时才260多KB,保存EMF矢量图形的方法与保存位图是差不多的,在DBGrid中显示也差不多,只不过BLOB型字段内容不能直接Assign给EMF文件,要用MemoryStream来中转。
procedure TForm1.DataSource1DataChange(Sender: TObject; Field: TField); begin if DataSource1.State = dsBrowse then DBGrid1ColEnter(Sender); end;
2003-11-19 11:39:38 用DbGrid制作edit录入时的下拉提示框在Delphi语言中提拱了不少数据输入的方法,如可从数据库中选择或人工输入的控件有:DBListBox、DBComboBox、DBLookupListBox、DBLookupComboBox等。但对于这样一个例子:数据库名为dm.db,其中有两个字段: 代码:Code 名称:Name 要求根据用户输入的代码,去获取该代码对应的名称。 一般的用户并不知道代码和名称的对应关系,如让用户输入代码,选出对应的名称,由于上述的控件不能使操作人员看到代码和名称的对应关系,如让用户根据代码用下拉框去查找到对应的该条纪录的名称,将很难操作。 根据这种情况,我编制了下面程序,把DBGrid做为Edit的下拉列表框辅助操作,在DBGrid中直观地显示出代码和名称的对应关系,并且能够根据用户录入代码的变化情况,随时更新DBGrid中的记录指针,使用户可以直观方便地点取所需要的名字,而且DBGrid是依据用户在Edit中输入代码时才显现,跳出Edit框即消失。这种方法既为用户录入提供了方便,又不影响界面的整体美观,效果不错。现把该程序提供给大家,你们可根据自己的需要,对程序进行加工处理,应用于程序开发中,希望起到抛砖引玉的作用。 【问题】:做这样一个小程序:让用户输入代码,然后将名称显示在窗体上。 1、首先我们可以建立一个Form,在此Form中增加控件: Table : Table1,设置其属性对应代码库dm.db,并将Active置为True DataSource : DataSource1, 设置其属性DataSet为Table1 Edit : CodeEdit,NameEdit分别对应代码输入框和名称显示框 DBGrid : DBGrid1, 设置其属性DataSource为DataSource1 并把CodeEdit的属性Text的值置空,NameEdit的属性Text的值置空。 2、对照以下语句,修改CodeEdit的OnEnter、OnExit、OnKeyDown、OnKeyUp事件: 在CodeEdit的OnEnter事件如下: procedure TForm1.CodeEditEnter(Sender: TObject); begin if CodeEdit.text<>'' then begin CodeEdit.SelStart:=length(CodeEdit.text); Table1.locate('code', CodeEdit.text,[lopartialkey]); End; end; CodeEdit的OnExit事件如下: procedure TForm1.CodeEditExit(Sender: TObject); begin if activecontrol<>dbgrid1 then begin dbgrid1.Visible:=false; Table1.Locate('code',codeedit.text,[lopartialkey]); if Table1.Eof then begin dbgrid1.Visible:=true; exit; end; if not Table1.Eof then begin codeedit.Text:=Table1.fieldbyname('code').asstring; NameEdit.Text := Table1.fieldbyname('name').asstring; end; end; end; CodeEdit的OnKeyDown事件如下: Procedure Tform1.CodeEditKeyDown(Sender: TObject;var Key: Word;Shift: TShiftState); var i:integer; begin if (Table1.RecordCount>0) then begin case key of 48..57: begin dbgrid1.Visible:=true; Table1.Locate('code',CodeEdit.text,[lopartialkey]); end; vk_next: if dbgrid1.Visible then begin i:=0; while (not Table1.Eof) and (i<11) do begin Table1.Next; i:=i+1; end; CodeEdit.Text:=Table1.fieldbyname('code').asstring; End; vk_prior: if dbgrid1.Visible then begin i:=0; while (not Table1.Bof) and (i<11) do begin Table1.prior; i:=i+1; end; CodeEdit.Text:=Table1.fieldbyname('code').asstring; end; vk_down: if dbgrid1.Visible then begin if not Table1.Eof then begin Table1.Next; CodeEdit.Text:=Table1.fieldbyname('code').asstring; end; end; vk_up: if dbgrid1.Visible then begin if not Table1.Bof then begin Table1.Prior; CodeEdit.Text:=Table1.fieldbyname('code').asstring; end; end; end; end else dbgrid1.Visible:=false; CodeEdit.SelStart:=length(CodeEdit.text); end; CodeEdit的OnKeyUp事件如下: procedure Tform1.CodeEditKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); begin if (Table1.RecordCount>0) then begin if ((key>=48) and (key<=57)) then Table1.Locate('code',codeedit.text,[lopartialkey]); if (key=VK_back) and (codeedit.text<>'') then Table1.Locate('code',codeedit.text,[lopartialkey]); if (key=VK_BACK) and (codeedit.text='') then Table1.First; if (key=vk_down) or (key=vk_up) or (key=vk_prior) or (key=vk_next) then if dbgrid1.Visible then codeedit.Text:=Table1.fieldbyname('code').asstring; end else dbgrid1.Visible:=false; codeedit.SelStart:=length(codeedit.text); end; 本程序在Windows98+Delphi4.0、5.0下均调试通过。
begin with DBGrid0.DataSource.DataSet as TTable do //Table0 begin //检测当前工作表是否已打开 if not Active then begin MessageBeep(0); Application.MessageBox('工作表尚未打开!','停止',MB_OK+MB_ICONSTOP); Abort end;
//检测当前字段是否“能排序”。以下字段类型不能排序 case Column.Field.DataType of ftBoolean, ftBytes, ftBlob, //Binary ftMemo, ftGraphic, ftFmtMemo, //Formatted memo ftParadoxOle: //OLE begin MessageBeep(0); Application.MessageBox(Pchar('项目"'+Column.FieldName+'"'+'不能排序!'),'停止',MB_OK+MB_ICONSTOP); Abort end; end; //case mode:='0'; iCol:=Column.Field.FieldNo-1; try ColName:=Column.fieldname; if psIndexName=Column.fieldname then begin //与原来同列 if plAscend //升序 then begin mode:='2'; IndexName:=ColName+'2'; //应“降序” end else begin mode:='1'; IndexName:=ColName+'1'; //应“升序” end; plAscend:=not plAscend; end else begin //新列 IndexName:=ColName+'2'; plAscend:=false; psIndexName:=ColName; end; except on EDatabaseError do //若未有索引,则重新建立 begin Messagebeep(0); //以下新建索引 IndexName:=''; Close; Exclusive:=true; if mode='1' then AddIndex(ColName+'1',ColName,[ixCaseInsensitive],'')// else //包括'0' AddIndex(ColName+'2',ColName,[ixDescending,ixCaseInsensitive],''); Exclusive:=false; Open; try //try 1 if mode<>'1' then begin mode:='2';//转换 plAscend:=false; end else plAscend:=true; IndexName:=ColName+mode; psIndexName:=ColName; except on EDBEngineError do IndexName:=''; end //try 2 end end; First; end; //with DBGrid0.SelectedIndex:=iCol; end;//End of MySort
2003-11-19 12:16:05 将 DBGrid 中的内容输出至 Excel 或 ClipBoard //注意:下面的方法必须包含 ComObj, Excel97 单元 //----------------------------------------------------------- // if toExcel = false, export dbgrid contents to the Clipboard // if toExcel = true, export dbgrid to Microsoft Excel procedure ExportDBGrid(toExcel: Boolean); var bm: TBookmark; col, row: Integer; sline: String; mem: TMemo; ExcelApp: Variant; begin Screen.Cursor := crHourglass; DBGrid1.DataSource.DataSet.DisableControls; bm := DBGrid1.DataSource.DataSet.GetBookmark; DBGrid1.DataSource.DataSet.First; // create the Excel object if toExcel then begin ExcelApp := CreateOleObject('Excel.Application'); ExcelApp.WorkBooks.Add(xlWBatWorkSheet); ExcelApp.WorkBooks[1].WorkSheets[1].Name := 'Grid Data'; end; // First we send the data to a memo // works faster than doing it directly to Excel mem := TMemo.Create(Self); mem.Visible := false; mem.Parent := MainForm; mem.Clear; sline := ''; // add the info for the column names for col := 0 to DBGrid1.FieldCount-1 do sline := sline + DBGrid1.Fields[col].DisplayLabel + #9; mem.Lines.Add(sline); // get the data into the memo for row := 0 to DBGrid1.DataSource.DataSet.RecordCount-1 do begin sline := ''; for col := 0 to DBGrid1.FieldCount-1 do sline := sline + DBGrid1.Fields[col].AsString + #9; mem.Lines.Add(sline); DBGrid1.DataSource.DataSet.Next; end; // we copy the data to the clipboard mem.SelectAll; mem.CopyToClipboard; // if needed, send it to Excel // if not, we already have it in the clipboard if toExcel then begin ExcelApp.Workbooks[1].WorkSheets['Grid Data'].Paste; ExcelApp.Visible := true; end; FreeAndNil(mem); // FreeAndNil(ExcelApp); DBGrid1.DataSource.DataSet.GotoBookmark(bm); DBGrid1.DataSource.DataSet.FreeBookmark(bm); DBGrid1.DataSource.DataSet.EnableControls; Screen.Cursor := crDefault; end;
var X_Pos Y_Pos:integer;//鼠标在窗体的位置 Col_Pos Row_Pos:integer;//单元位置
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject); var i:integer; begin Application.HintPause:=100; Font.Size :=10; Caption:='STring岩石程序'; StringGrid1.ShowHint :=True; StringGrid1.ColCount :=8; StringGrid1.RowCount :=12; StringGrid1.Cells[0 0]:='第18周'; for i:=1 to StringGrid1.ColCount -1 do StringGrid1.Cells[i 0]:=WeekDayName[i]; for i:=1 to StringGrid1.RowCount -1 do StringGrid1.Cells[0 i]:=InttoStr(i+7)+':00'; StringGrid1.Options :=StringGrid1.Options+[goTabs goROwSizing goColSizing]-[goEditing]; end;
procedure TForm1.StringGrid1DblClick(Sender: TObject); var SchemeItem:String; begin StringGrid1.MouseToCell(X_Pos Y_Pos Col_Pos Row_Pos) ; //转换到单位位置 if (Col_Pos<0 )or (Row_Pos<0 ) then Exit; if (StringGrid1.Cells[Col_Pos Row_Pos]<>'' ) then //取消计划概要 begin StringGrid1.Cells[Col_Pos Row_Pos]:=''; Exit; end; SchemeItem:=InputBox('提示' '请输入计划概要:' '会议'); StringGrid1.Cells[Col_Pos Row_Pos]:=SchemeItem; End;
procedure TForm1.StringGrid1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X Y: Integer); begin X_Pos:=x; Y_Pos:=y; end;
以下是有关的程序代码: procedure TUnitDetail.DBGrid1ColEnter(Sender:TObject); begin case DBGrid1.SelectedIndex of 0:DBEdit1.DataField:='UnitNum'; 1:DBEdit1.DataField:='UnitName'; 2:DBEdit1.DataField:='Header'; 3:DBEdit1.DataField:='Address'; 4:DBEdit1.DataField:='Tel'; end; end;
procedure TUnitDetail.SBCopyClick(Sender:TObject); begin DBEdit1.CopyToClipboard; end;
procedureTUnitDetail.SBPasteClick(Sender:TObject); begin DBEdit1.PasteFromClipboard; DBGrid1.SelectedField.AsString:=DBEdit1.text; end;
2003-11-19 13:34:33 禁止在DBGrid中按delete删除记录procedure TForm1.DBGrid1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if (ssctrl in shift) and (key=vk_delete) then key:=0; end;
public { Public declarations } property QueryStatement: string read FQueryStatement; procedure FloatOnKeyPress(Sender: TObject; var Key: Char); end;
var TFm_Main: TTFm_Main;
implementation
{$R *.DFM}
procedure TTFm_Main.dbg_DataTitleClick(Column: TColumn); var vi_Counter: Integer; vs_Field: string; begin with dbg_Data do begin
//First, deselect all the Grid Columns for vi_Counter := 0 to Columns.Count - 1 do Columns[vi_Counter].Color := clWindow;
//Next "Select" the column the user has Clicked on Column.Color := clTeal;
//Get the FieldName of the Selected Column vs_Field := Column.FieldName;
//Order the Grid Data by the Selected column with qry_Data do begin DisableControls; Close; SQL.Clear; SQL.Text := QueryStatement + ' ORDER BY ' + vs_Field; Open; EnableControls; end; //Get the DataType of the selected Field and change the Edit event
//OnKeyPress to the proper method Pointer case Column.Field.DataType of ftFloat: Ed_Search.OnKeyPress := FloatOnKeyPress; else Ed_Search.OnKeyPress := FALphaNumericKeyPress; end; end; end;
procedure TTFm_Main.FloatOnKeyPress(Sender: TObject; var Key: Char); begin if not (Key in ['0'..'9', #13, #8, #10, #46]) then Key := #0; end;
procedure TTFm_Main.FormCreate(Sender: TObject); begin
//Keep a pointer for the default event Handler FALphaNumericKeyPress := Ed_Search.OnKeyPress;
//Set the original Query SQL Statement FQueryStatement := 'SELECT * FROM your_table_name';
//Select the first Grid Column dbg_DataTitleClick(dbg_Data.Columns[0]); end;
procedure TTFm_Main.Ed_SearchChange(Sender: TObject); var vi_counter: Integer; vs_Field: string; begin try with dbg_Data do begin
//First determine wich is the Selected Column for vi_Counter := 0 to Columns.Count - 1 do if Columns[vi_Counter].Color = clTeal then begin vs_Field := Columns[vi_Counter].FieldName; Break; end;
//Locate the Value in the Query with qry_Data do case Columns[vi_Counter].Field.DataType of ftFloat: Locate(vs_Field, StrToFloat(Ed_Search.Text), [loCaseInsensitive, loPartialKey]); else Locate(vs_Field, Ed_Search.Text, [loCaseInsensitive, loPartialKey]); end; end; except end; end;
end.
2003-11-19 13:53:23 数据网格自动适应宽度///源代码开始 uses Math;
function DBGridRecordSize(mColumn: TColumn): Boolean; { 返回记录数据网格列显示最大宽度是否成功 } begin Result := False; if not Assigned(mColumn.Field) then Exit; mColumn.Field.Tag := Max(mColumn.Field.Tag, TDBGrid(mColumn.Grid).Canvas.TextWidth(mColumn.Field.DisplayText)); Result := True; end; { DBGridRecordSize }
function DBGridAutoSize(mDBGrid: TDBGrid; mOffset: Integer = 5): Boolean; { 返回数据网格自动适应宽度是否成功 } var I: Integer; begin Result := False; if not Assigned(mDBGrid) then Exit; if not Assigned(mDBGrid.DataSource) then Exit; if not Assigned(mDBGrid.DataSource.DataSet) then Exit; if not mDBGrid.DataSource.DataSet.Active then Exit; for I := 0 to mDBGrid.Columns.Count - 1 do begin if not mDBGrid.Columns[I].Visible then Continue; if Assigned(mDBGrid.Columns[I].Field) then mDBGrid.Columns[I].Width := Max(mDBGrid.Columns[I].Field.Tag, mDBGrid.Canvas.TextWidth(mDBGrid.Columns[I].Title.Caption)) + mOffset else mDBGrid.Columns[I].Width := mDBGrid.Canvas.TextWidth(mDBGrid.Columns[I].Title.Caption) + mOffset; mDBGrid.Refresh; end; Result := True; end; { DBGridAutoSize } ///源代码结束
procedure TDBGrid.NewGridWnd(var Message: TMessage); var IsNeg : Boolean; begin
if Message.Msg = WM_MOUSEWHEEL then begin IsNeg := Short(Message.WParamHi) < 0; if IsNeg then self.DataSource.DataSet.MoveBy(1) else self.DataSource.DataSet.MoveBy(-1) end else Self.FOldGridWnd(Message);
2003-12-10 14:44:11 用 dbgrid 或 dbgrideh 如何让所显示数据自动滚动?procedure TForm1.Timer1Timer(Sender: TObject); var m:tmessage; begin m.Msg:=WM_VSCROLL; m.WParamLo:=SB_LINEDOWN; m.WParamHi:=1 ; m.LParam:=0; postmessage(self.DBGrid1.Handle,m.Msg,m.WParam,m.LParam);
end;
procedure TForm1.Button1Click(Sender: TObject); begin self.Timer1.Enabled:=true; end;
如果需要让他自动不断地从头到尾滚动,添加如下代码 if table1.Eof then table1.First;
2003-12-10 14:58:31 DBGrid 对非布尔字段的栏中如何出现 CheckBox 选择输入可将dbgrid关联的dataset中需显示特殊内容字段设为显式字段,并在OnGetText事件中写如下代码: 以table举例: procedure TForm1.Table1Myfield1GetText(Sender: TField; var Text: String; DisplayText: Boolean); var Pd:string; begin inherited; pd:=table1.fieldbyname('myfield1').asstring; if pd='1' then Text:='□' else if pd='2' then text:='▲' else Text:='√'; end;
2、 然后按Ctrl+Shift+C组合键,定义的过程会在实现部分出现。 Procedure FrmStock.ViewTitle(Sender:TObject;DbgColumns:TDBGrid); begin With (Sender as TMenuItem) do begin Checked:=not Checked; DbgColumns.Columns[Tag].Visible:=Checked; end; end;
type TMyDBGrid=class(TDBGrid); // //DBGrid1.Options->dgEditing=True //DBGrid1.Options->dgRowSelect=False procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); begin with TMyDBGrid(Sender) do begin if DataLink.ActiveRecord=Row-1 then begin Canvas.Font.Color:=clWhite; Canvas.Brush.Color:=$00800040; end else begin Canvas.Brush.Color:=Color; Canvas.Font.Color:=Font.Color; end; DefaultDrawColumnCell(Rect,DataCol,Column,State); end; end;
{tmygrid} constructor tmygrid.create(AOwner:TComponent); begin inherited create(Owner); RowCount:=ROWCNT; end;
destructor tmygrid.destroy; begin inherited; end;
procedure tmygrid.Paint; begin RowCount:=ROWCNT; if dgIndicator in options then ColWidths[0]:=30; inherited; end;
procedure tmygrid.DrawCell(ACol:Integer;ARow:Integer;ARect:TRect;AState:TGridDrawState); begin inherited; if (ARow>=1) and (ACol=0) then Canvas.TextRect(ARect,ARect.Left,ARect.Top,IntToSTr(ARow)); end;
procedure CopyDbDataToExcel(Args: array of const); var iCount, jCount: Integer; XLApp: Variant; Sheet: Variant; I: Integer; begin Screen.Cursor := crHourGlass; if not VarIsEmpty(XLApp) then begin XLApp.DisplayAlerts := False; XLApp.Quit; VarClear(XLApp); end;
for I := Low(Args) to High(Args) do begin XLApp.WorkBooks[1].WorkSheets[I+1].Name := TDBGrid(Args[I].VObject).Name; Sheet := XLApp.Workbooks[1].WorkSheets[TDBGrid(Args[I].VObject).Name];
if not TDBGrid(Args[I].VObject).DataSource.DataSet.Active then begin Screen.Cursor := crDefault; Exit; end;
TDBGrid(Args[I].VObject).DataSource.DataSet.first; for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do Sheet.Cells[1, iCount + 1] := TDBGrid(Args[I].VObject).Columns.Items[iCount].Title.Caption;
jCount := 1; while not TDBGrid(Args[I].VObject).DataSource.DataSet.Eof do begin for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do Sheet.Cells[jCount + 1, iCount + 1] := TDBGrid(Args[I].VObject).Columns.Items[iCount].Field.AsString;
procedure TFrmOrderPost.DbgOrderPostMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var CurPost:TPoint; begin GetCursorPos(CurPost);//获得鼠标当前坐标 if (y<=17) and (x<=vCurRect.Right) then begin if button=mbright then begin PmTitle.Popup(CurPost.x,CurPost.y); end; end; end; //vCurRect该变量在DbGrid的DrawColumnCell事件中获得 {procedure TFrmOrderPost.DbgOrderPostDrawColumnCell(Sender: TObject;const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); begin vCurRect:=Rect;//vCurRect在实现部分定义 end;}
procedure TFrmOrderPost.DbgOrderPostMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var CurPost:TPoint; begin GetCursorPos(CurPost);//获得鼠标当前坐标 if (y<=17) and (x<=vCurRect.Right) then begin if button=mbright then begin PmTitle.Popup(CurPost.x,CurPost.y); end; end; end; //vCurRect该变量在DbGrid的DrawColumnCell事件中获得 {procedure TFrmOrderPost.DbgOrderPostDrawColumnCell(Sender: TObject;const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); begin vCurRect:=Rect;//vCurRect在实现部分定义 end;}
2003-12-22 10:14:26 把DBGrid输出到Excel表格(支持多Sheet){ 功能描述:把DBGrid输出到Excel表格(支持多Sheet) 调用格式:CopyDbDataToExcel([DBGrid1, DBGrid2]); } procedure CopyDbDataToExcel(Args: array of const); var iCount, jCount: Integer; XLApp: Variant; Sheet: Variant; I: Integer; begin Screen.Cursor := crHourGlass; if not VarIsEmpty(XLApp) then begin XLApp.DisplayAlerts := False; XLApp.Quit; VarClear(XLApp); end;
for I := Low(Args) to High(Args) do begin XLApp.WorkBooks[1].WorkSheets[I+1].Name := TDBGrid(Args[I].VObject).Name; Sheet := XLApp.Workbooks[1].WorkSheets[TDBGrid(Args[I].VObject).Name];
if not TDBGrid(Args[I].VObject).DataSource.DataSet.Active then begin Screen.Cursor := crDefault; Exit; end;
TDBGrid(Args[I].VObject).DataSource.DataSet.first; for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do Sheet.Cells[1, iCount + 1] := TDBGrid(Args[I].VObject).Columns.Items[iCount].Title.Caption;
jCount := 1; while not TDBGrid(Args[I].VObject).DataSource.DataSet.Eof do begin for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do Sheet.Cells[jCount + 1, iCount + 1] := TDBGrid(Args[I].VObject).Columns.Items[iCount].Field.AsString;
type TCurCell = Record {当前焦点Cell的位置} X : integer; {有焦点Cell的ColumnIndex} Y : integer; {有焦点Cell所在的纪录的纪录号} tag : integer; {最近进入该Cell后是否弹出了下拉列表} r : TRect; {没有使用} end;
function TDBGridPro.CreateEditor: TInplaceEdit; begin result := inherited CreateEditor; hInPlaceEditorWndProc := result.WindowProc; result.WindowProc := InPlaceEditorWndProcHook; end;
procedure TDBGridPro.DefaultDrawColumnCell(const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); begin {如果要画焦点,就让DBGrid进入编辑状态} if (gdFocused in State) then begin EditorMode := true; AddBox; {如果是进入一个新的Cell,全选其中的字符} if (curCell.X <> DataCol) or (curCell.Y <> DataSource.DataSet.RecNo) then begin curCell.X := DataCol; curCell.Y := DataSource.DataSet.RecNo; curCell.tag := 0; GetWindowRect(InPlaceEditor.Handle,curCell.r); SendMessage(InPlaceEditor.Handle,EM_SETSEL,0,1000); end; end else {正常显示状态的Cell} TCustomDBGrid(Self).DefaultDrawColumnCell(Rect,DataCol,Column,State); end;
destructor TDBGridPro.Destroy; begin FPan.Free; inherited; end;
procedure TDBGridPro.DoKeyUped(Sender: TObject; var Key: Word; Shift: TShiftState); var cl : TColumn; begin cl := Columns[SelectedIndex]; case Key of VK_RETURN: begin {一个Column为下拉类型,如果: 1 该Column的按钮类型为自动类型 2 该Column的PickList非空,或者其对应的字段是lookup类型} if (cl.ButtonStyle=cbsAuto) and ((cl.PickList.Count>0) or (cl.Field.FieldKind=fkLookup)) and (curCell.tag = 0) and not (ssShift in Shift) then begin {把回车转换成Alt+向下弹出下拉列表} Key := 0; Shift := [ ]; keybd_event(VK_MENU,0,0,0); keybd_event(VK_DOWN,0,0,0); keybd_event(VK_DOWN,0,KEYEVENTF_KEYUP,0); keybd_event(VK_MENU,0,KEYEVENTF_KEYUP,0); curCell.tag := 1; exit; end; {否则转换成Tab} Key := 0; keybd_event(VK_TAB,0,0,0); keybd_event(VK_TAB,0,KEYEVENTF_KEYUP,0); end; VK_RIGHT : begin {获得编辑框中的文字长度} i := GetWindowTextLength(InPlaceEditor.Handle); {获得编辑框中的光标位置} GetCaretPos(p); p.x := p.X + p.Y shr 16; j := SendMessage(InPlaceEditor.Handle,EM_CHARFROMPOS,0,p.X); if (i=j) then {行末位置} begin Key := 0; keybd_event(VK_TAB,0,0,0); keybd_event(VK_TAB,0,KEYEVENTF_KEYUP,0); end; end; VK_LEFT: begin GetCaretPos(p); p.x := p.X + p.Y shr 16; if SendMessage(InPlaceEditor.Handle,EM_CHARFROMPOS,0,p.X)=0 then begin {行首位置} Key := 0; keybd_event(VK_SHIFT,0,0,0); keybd_event(VK_TAB,0,0,0); keybd_event(VK_TAB,0,KEYEVENTF_KEYUP,0); keybd_event(VK_SHIFT,0,KEYEVENTF_KEYUP,0); end; end; else begin {记录用户是否作了修改} if (Columns[SelectedIndex].PickList.Count>0) and (curCell.tag = 0) then if SendMessage(InPlaceEditor.Handle,EM_GETMODIFY,0,0)=1 then curCell.tag := 1; end; end; end;
procedure TDBGridPro.DoOwnDrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); begin if FOwnDraw=false then DefaultDrawColumnCell(Rect,DataCol,Column,State); if @OnOwnDrawColumnCell<>nil then OnOwnDrawColumnCell(Sender,Rect,DataCol, Column,State); end;
procedure TDBGridPro.InPlaceEditorWndProcHook(var msg: TMessage); var m : integer; begin m := msg.Msg; {=inherited} hInplaceEditorWndProc(msg); {如果是改变位置和大小,重新加框} if m=WM_WINDOWPOSCHANGED then AddBox; end;
procedure TDBGridPro.KeyUp(var Key: Word; Shift: TShiftState); begin inherited; DoKeyUped(Self,Key,Shift); end;
end.
{以上代码在Windows2000,Delphi6上测试通过}
2004-3-20 14:34:24 打印 TDBGrid内容 procedure PrintDbGrid(DataSet:TDataSet;DbGrid:TDbGrid;Title:String); var PointX,PointY:integer; ScreenX:integer; i,lx,ly:integer; px1,py1,px2,py2:integer; RowPerPage,RowPrinted:integer; ScaleX:Real; THeight:integer; TitleWidth:integer; SumWidth:integer; PageCount:integer; SpaceX,SpaceY:integer; RowCount:integer; begin PointX:=Round(GetDeviceCaps(printer.Handle,LOGPIXELSX)/2.54); PointY:=Round(GetDeviceCaps(printer.Handle,LOGPIXELSY)/2.54); ScreenX:=Round(Screen.PixelsPerInch/2.54); ScaleX:=PointX/ScreenX; RowPrinted:=0; SumWidth:=0; printer.BeginDoc; With Printer.Canvas do begin DataSet.DisableControls; DataSet.First ; THeight:=Round(TextHeight('我')*1.5);//设定每行高度为字符高的1.5倍 SpaceY:= Round(TextHeight('我')/4); SpaceX:=Round(TextWidth('我')/4); RowPerpage:=Round((printer.PageHeight-5*PointY)/THeight); //上下边缘各2厘米 ly:=2*PointY; PageCount:=0; while not DataSet.Eof do begin if (RowPrinted=RowPerPage) or (RowPrinted=0) then begin if RowPrinted<>0 then Printer.NewPage; RowPrinted:=0; PageCount:=PageCount+1; Font.Name:='宋体'; Font.size:=16; Font.Style:=Font.Style+[fsBold]; lx:=Round((Printer.PageWidth-TextWidth(Title))/2); ly:=2*PointY; TextOut(lx,ly,Title); Font.Size:=11; Font.Style:=Font.Style-[fsBold]; lx:=Printer.PageWidth-5*PointX; ly:=Round(2*PointY+0.2*PointY); if RowPerPage*PageCount>DataSet.RecordCount then RowCount:=DataSet.RecordCount else RowCount:=RowPerPage*PageCount; TextOut(lx,ly,'第'+IntToStr(RowPerPage*(PageCount-1)+1)+'-'+IntToStr(RowCount)+'条,共'+IntToStr(DataSet.RecordCount)+'条'); lx:=2*PointX; ly:=ly+THeight*2; py1:=ly-SpaceY; if RowCount=DataSet.RecordCount then py2:=py1+THeight*(RowCount-RowPerPage*(PageCount-1)+1) else py2:=py1+THeight*(RowPerPage+1); SumWidth:=lx; for i:=0 to DBGrid.Columns.Count-1 do begin px1:=SumWidth-SpaceX; px2:=SumWidth; MoveTo(px1,py1); LineTo(px2,py2); TitleWidth:=TextWidth(DBGrid.Columns[i].Title.Caption); lx:=Round(SumWidth+(DBGrid.Columns[i].width*scaleX-titleWidth)/2); TextOut(lx,ly,DBGrid.Columns[i].Title.Caption); SumWidth:=Round(SumWidth+DBGrid.Columns[i].width*scaleX)+SpaceX*2; end; px1:=SumWidth; //画最后一条竖线 px2:=SumWidth; MoveTo(px1,py1); LineTo(px2,py2); px1:=2*PointX; //画第一条横线 px2:=SumWidth; py1:=ly-SpaceY; py2:=ly-SpaceY; MoveTo(px1,py1); LineTo(px2,py2); py1:=py1+THeight; py2:=py2+THeight; MoveTo(px1,py1); LineTo(px2,py2); end; lx:=2*PointX; ly:=ly+THeight; px1:=lx; px2:=SumWidth; py1:=ly-SpaceY+THeight; py2:=ly-SpaceY+THeight; MoveTo(px1,py1); LineTo(px2,py2); for i:=0 to DBGrid.Columns.Count-1 do begin TextOut(lx,ly,DataSet.FieldByname(DBGrid.Columns[i].Fieldname).AsString); lx:=Round(lx+DBGrid.Columns[i].width*ScaleX+SpaceX*2); end; RowPrinted:=RowPrinted+1; DataSet.next; end; DataSet.first; DataSet.EnableControls; end; printer.EndDoc; end;
Printer.Canvas.Font.Style := []; For i := 1 To Pred( Grid.RowCount ) Do For k := 0 To Pred( Grid.ColCount ) Do Begin w:= Printer.Canvas.TextWidth( Grid.Cells[ k, i ] ); If w > Integer( Cols[ k ] ) Then Cols[ k ] := Pointer( w ); End; { For }
w := 2 * Printer.Canvas.Font.PixelsPerInch div 3; margins := Rect( w, w, Printer.PageWidth-w, Printer.PageHeight - w ); spacing := Printer.Canvas.Font.PixelsPerInch div 10;
w := 0; For i := 0 To Pred(cols.Count) Do w := w + Integer( cols[ i ] ) + spacing; w := w - spacing; If w > (margins.right-margins.left ) Then Begin w := w - (margins.right-margins.left ); cols[ cols.Count-2 ] := Pointer( Integer( cols[ cols.Count-2 ] ) - w ); End; { If }
w:= 0; For i := 0 To Pred(cols.Count) Do w := w + Integer( cols[ i ] ) + spacing; margins.right := w - spacing + margins.left; End; { SetColumnWidth }
Procedure DoPrint; Var i: Integer; y: Integer; Procedure DoLine(lineno: Integer); Var x, n: Integer; r: TRect; th: Integer; Begin If Length(Grid.Cells[0,lineno]) = 0 Then Exit;
x:= margins.left; With Printer.Canvas Do Begin th := TextHeight( '膟' ); For n := 0 To Pred( Cols.Count ) Do Begin r := Rect( 0, 0, Integer(Cols[ n ]), th); OffsetRect( r, x, y ); TextRect( r, x, y, Grid.Cells[ n, lineno ] ); x := r.right + spacing; End; { For } End; { With } y := y + th; End; { DoLine } Procedure DoHeader; Begin y:= margins.top; With Printer.Canvas Do Begin Font.Style := [ fsBold ]; DoLine( 0 ); Pen.Width := Font.PixelsPerInch div 72; Pen.Color := clBlack; MoveTo( margins.left, y ); LineTo( margins.right, y ); Inc( y, 2 * Pen.Width ); Font.Style := [ ]; End; { With } End; { DoHeader } Begin y:= 0; For i := 1 To Pred( Grid.RowCount ) Do Begin Dlg.Progress( i ); Application.ProcessMessages; If FPrintAborted Then Exit;
If y = 0 Then DoHeader; DoLine( i ); If y >= margins.bottom Then Begin Printer.NewPage; y:= 0; End; { If } End; { For } End; { DoPrint }
Begin FPrintAborted := False; Dlg := TPrintProgressDlg.Create( Application ); With Dlg Do try OnAbort := PrintAborted; Display( cPrintPreparation ); SetProgressRange( 0, Grid.RowCount ); Show; Application.ProcessMessages; Printer.Orientation := poLandscape;
procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); const // 这个整数值将按照布尔值返回,并送入数组 CtrlState : array[Boolean] of Integer = (DFCS_BUTTONCHECK,DFCS_BUTTONCHECK or DFCS_CHECKED); begin //确保只有在逻辑字段才能插入组件 if Column.Field.DataType = ftBoolean then begin DBGrid1.Canvas.FillRect(Rect); DrawFrameControl(DBGrid1.Canvas.Handle, Rect, DFC_BUTTON, CtrlState[Column.Field.AsBoolean]); end; end;
procedure TForm1.DBGrid1ColEnter(Sender: TObject); begin // 确保该栏是逻辑字段 if DBGrid1.SelectedField.DataType = ftBoolean then begin OriginalOptions := DBGrid1.Options; DBGrid1.Options := DBGrid1.Options - [dgEditing]; end; end;
procedure TForm1.DBGrid1ColExit(Sender: TObject); begin //确保该栏是逻辑字段 if DBGrid1.SelectedField.DataType = ftBoolean then DBGrid1.Options := OriginalOptions; end;
procedure TForm1.DBGrid1CellClick(Column: TColumn); begin //确保该栏是逻辑字段 if DBGrid1.SelectedField.DataType = ftBoolean then SaveBoolean(); end;
procedure TForm1.DBGrid1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin //确保该栏是逻辑字段和空格键在键盘中被敲击 if ( Key = VK_SPACE ) and ( DBGrid1.SelectedField.DataType = ftBoolean ) then SaveBoolean(); end;
procedure TForm1.SaveBoolean; begin DBGrid1.SelectedField.Dataset.Edit; DBGrid1.SelectedField.AsBoolean :=not DBGrid1.SelectedField.AsBoolean; DBGrid1.SelectedField.Dataset.Post; end;