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 TMainFrm.DBGridDateUpdateData(Sender: TObject; var Text: String; var Value: Variant; var UseText, Handled: Boolean); var TmpStr, YearStr, MonthStr, DayStr: string; i, Year, Month, Day: integer; begin try i := Pos(DateSeparator, Text); YearStr := Trim(Copy(Text, 1, i-1)); TmpStr := Copy(Text, i+1, Length(Text)-i); i := Pos(DateSeparator, TmpStr); MonthStr := Trim(Copy(TmpStr, 1, i-1)); DayStr := Trim(Copy(TmpStr, i+1, Length(TmpStr)-i));
if Trim(YearStr) = '' then YearStr := FormatDateTime('yyyy', Now()); if Trim(MonthStr) = '' then MonthStr := FormatDateTime('m', Now()); if Trim(DayStr) = '' then DayStr := FormatDateTime('d', Now());
Month := StrToInt(MonthStr); if Month < 1 then begin MonthStr := '1'; Month := 1; end else if Month > 12 then begin MonthStr := '12'; Month := 12; end;
Day := StrToInt(DayStr); if Day < 1 then begin DayStr := '1'; end else begin case Month of 1, 3, 5, 7, 8, 10, 12: if Day > 31 then DayStr := '31'; 4, 6, 9, 11: if Day > 30 then DayStr := '30'; 2: begin Year := StrToInt(YearStr); if Year mod 4 = 0 then begin if Year mod 100 = 0 then begin if Year mod 400 = 0 then begin if Day > 29 then DayStr := '29'; end else begin if Day > 28 then DayStr := '28'; end; end else begin if Day > 29 then DayStr := '29' end; end else begin if Day > 28 then DayStr := '28'; end; end; end; end; Text := YearStr + DateSeparator + MonthStr + DateSeparator + DayStr; except MessageBox(Self.Handle,PChar('日期{' + Text + '}输入错误,请与wangzhijun2005@hotmail.com联系'),'程序错误',MB_ICONERROR+MB_OK); Handled := True; Abort; end; end;
----------------------------------------------
-
关联表 主键 A a1 A a1 1 A a2 A a2 0 A a3 A a3 0 C a1 A a1 0 数据表 A a1 '8' A a2 '2005-11-11' A a3 '中国' C a1 '8' C c1 'HT20051111' C c2 '甲方:。。(具体内容)' ..... 字典表 B 组名 字段名 类型 长度 默认显示宽度 排序 中文显示 描述 是否为空 ... A a1 'varchar' 50 20 0 编号 个人编号 ... A a2 'datetime'8 8 1 出生日期 出生日期 A a3 'varchar' 50 20 2 国籍 国籍 如:中国、法国 C c1 'varchar' 50 20..........1.....合同编号..........
数据表应该加上分类 1 A a1 '8' 1 A a2 '2005-11-11' 1 A a3 '中国' 2 A a1 '9' 2 A a2 '2005-11-21' 2 A a3 '中国' 1 C a1 '8' 1 C c1 'HT20051111' 1 C c2 '甲方:。。(具体内容)' 2 C a1 '9' 2 C c1 'HT20051112' 2 C c2 '甲方:。。(具体内容)'
----------------------------------------------
血殇—灭倭寇!平四海!创中华大业! 真爱—经沧桑!历波澜!终一生守候!
procedure TFrmBase.EnToCnFields(DataSet: TDataSet); var
i: Integer; begin if qryEnToCn.IsEmpty then begin qryEnToCn.Connection := self.AdoConn; qryEnToCn.sql.Text := 'select * from EnToCnFields '; qryEnToCn.Open; end; for i := 0 to DataSet.FieldCount - 1 do begin if qryEnToCn.Locate('EN_FIELD', DataSet.Fields[i].FieldName, [loPartialKey]) then DataSet.Fields[i].DisplayLabel := FQFieldNameChEn.FieldByName('CN_FIELD').AsString; end; end;
----------------------------------------------
青云论坛
自已改了: 1.解决Dbgrideh还没有datasource 或datasource没有dataset,或dataset未active 出现的地址越界. {DBGridEh.pas 13375行左右} procedure TCustomDBGridEh.TitleClick(Column: TColumnEh); begin Screen.Cursor := crSQLWait; try //11-29 add agu if not exist datasource or dateset if not Assigned(DataSource) then Exit; if DataSource.DataSet= nil then Exit; if not DataSource.DataSet.Active then Exit; ...
2.解决了各列无法设置字体颜色以及行标栏叠影 {DBGridEh.pas 10611行左右} procedure TCustomDBGridEh.DrawColumnCell(const Rect: TRect; DataCol: Integer; //增加DataCol=0即行标栏的过滤 if (dgIndicator in Options) and FShowSerialNo and (DataCol=0) then ...
3.解决取消过滤后,SumList及时重算 {DBGridEh.pas 13100行左右} procedure TCustomDBGridEh.SwitchVisibleFilterCon; begin clrInnerFilter; //add agu 11-29 Cancel Filter must reCal; if STFilter.Visible then SumList.RecalcAll ; ...
再增加一个: 5.如果有设定事件OnApplyFilter,则过滤不能用。当成AfterFilter用了:) {DBGridEH.pas 16185行左右} {change if Assigned(FOnApplyFilter) then FOnApplyFilter(Self) else DefaultApplyFilter; /change} {to} DefaultApplyFilter; if Assigned(FOnApplyFilter) then FOnApplyFilter(Self) {/to}
2.解决了各列无法设置字体颜色以及行标栏叠影(补充上面第2个) {DBGridEh.pas 10611行左右} procedure TCustomDBGridEh.DrawColumnCell(const Rect: TRect; DataCol: Integer; var L: TBrushStyle; C: TColor; Str: string; //增加DataCol=0即第1栏的过滤 if (dgIndicator in Options) and FShowSerialNo and (DataCol=0) then L := Canvas.Brush.Style; C:=Canvas.Font.Color ;//颜色也要还原 ... //进行还原 Canvas.Brush.Style := L; Canvas.Font.Color :=C;;//颜色也要还原
----------------------------------------------
充电..........
2.解决了各列无法设置字体颜色以及行标栏叠影 {DBGridEh.pas 10611行左右} procedure TCustomDBGridEh.DrawColumnCell(const Rect: TRect; DataCol: Integer; //增加DataCol=0即行标栏的过滤 if (dgIndicator in Options) and FShowSerialNo and (DataCol=0) then ---------- -- 你加了一个DataCol=0 ,这个我开始做的时候也考虑过,但是当Grid里的字段 很多时,你把滚动条拉到靠右边的时候,就会发现 序号看不见了。
procedure TCustomDBGridEh.clrInnerFilter; begin if not Self.STFilter.Local then Exit; {add 这边也会越界} if not Assigned(DataSource) then Exit; if DataSource.DataSet= nil then Exit; if not DataSource.DataSet.Active then Exit; {/add} ClearFilter; SetExternFilter(FExternFilter); end;
----------------------------------------------
充电..........
另: procedure TCustomDBGridEh.ClearSort; var I: Integer; begin //应先判断是否为TADOQuery。 if Tadoquery(Self.DataSource.Dataset).Sort = '' then Exit; Tadoquery(Self.DataSource.Dataset).Sort := ''; for I := 0 to Self.Columns.Count - 1 do begin if Self.Columns[I].Title.SortMarker = smNoneEh then Continue; Self.Columns[I].Title.SortMarker := smNoneEh; end; //smUpEh end;
----------------------------------------------
充电..........
procedure TFrmBase.UnitePMenu(pMenuSrc, pMenuDec: TPopupMenu; bAddFist: Boolean); var AItme: TMenuItem; I, iCount: integer; begin iCount := pMenuDec.Items.Count; if not bAddFist then for I := 0 to iCount - 1 do begin AItme := pMenuDec.Items[0]; pMenuDec.Items.Delete(0); pMenuSrc.Items.Add(AItme); end else for I := 0 to iCount - 1 do begin AItme := pMenuDec.Items[0]; pMenuDec.Items.Delete(0); pMenuSrc.Items.Insert(I, AItme); end end;
----------------------------------------------
青云论坛
procedure TCustomDBGridEh.LinkActive(Value: Boolean); begin ... //在最后一行增加 {agu add} //如果第一列没被设定,自动设为记录总数, //前提FooterRowCount>0 且SumList的Active为True if (FooterRowCount >0) and (Columns.Count>0) and (Columns[0].Footer.ValueType=fvtNon) then Columns[0].Footer.ValueType :=fvtCount; end;
----------------------------------------------
充电..........
解决在数据集增加时行号不对的改进 procedure TCustomDBGridEh.DrawColumnCell(const Rect: TRect; DataCol: Integer; Column: TColumnEh; State: TGridDrawState); var L: TBrushStyle; C: TColor; Str: string; i,t: Integer; begin //add by cxg if (dgIndicator in Options) and FShowSerialNo then begin L := Canvas.Brush.Style; C:= Canvas.Font.Color ; Canvas.Brush.Style := bsClear; Canvas.Font.Color := clBlack; if Column.Field.Dataset.State = dsInsert then //append begin if DataSource.DataSet.RecordCount-datarowcount<0 then t:=0; if DataSource.DataSet.RecordCount-datarowcount=0 then t:=1; if DataSource.DataSet.RecordCount-datarowcount=1 then t:=2; if DataSource.DataSet.RecordCount-datarowcount>=2 then t:=DataSource.DataSet.RecordCount-datarowcount+1; i:=MouseCoord(Rect.Left + 1, Rect.Top + 1).Y+t; str := Format('%d', [i]); end else if (SumList.RecNo > 0) then Str := Format('%d', [SumList.RecNo]); Canvas.TextOut((ColWidths[0] - Canvas.TextWidth(Str) - IndicatorWidth) shr 1, Rect.Bottom - Canvas.TextHeight('0') - 2, Str);
Canvas.Brush.Style := L; Canvas.Font.Color:=C; end; //end by cxg
if Assigned(OnDrawColumnCell) then OnDrawColumnCell(Self, Rect, DataCol, Column, State); end;