转至繁体中文版     | 网站首页 | 图文教程 | 资源下载 | 站长博客 | 图片素材 | 武汉seo | 武汉网站优化 | 
最新公告:     敏韬网|教学资源学习资料永久免费分享站!  [mintao  2008年9月2日]        
您现在的位置: 学习笔记 >> 图文教程 >> 软件开发 >> Delphi程序 >> 正文
在Delphi中自己建立交叉表         ★★★★

在Delphi中自己建立交叉表

作者:闵涛 文章来源:闵涛的学习笔记 点击数:555 更新时间:2009/4/23 18:37:35

    经常在CSDN上查阅名位大侠的文章,得益不少,近期因做一个项目,需要用到交叉表,报表上倒是有,但客户要求在Grid上能操作,没有办法,只好自己写了一段代码用于普通查询到交叉表的实现,不敢独享,故上传,望能抛砖引玉,请名位大侠不吝指教。


function CreateTmptab(const AFieldDefs:TFieldDefs):TDataSet;
var
TempTable:TatClientDataSet;
begin
TempTable:=nil;
Result:=nil;
if AFieldDefs<>nil then
begin
    try
        TempTable:=TatClientDataSet.Create(Application);
        TempTable.FieldDefs.Assign(AFieldDefs);
        TempTable.CreateDataSet;
        Result:=(TempTable as TDataSet);
    Except
    if TempTable<>nil then
        TempTable.Free;
        Result:=nil;
        raise;
    end
end;
end;
{
SouDataset源数据集
ColField交叉表动态列字段
RowField交叉表行字段
DataField数据字段
}
function GenCrossTable(SouDataset:tdataset;ColField,RowField,DataField:string):tdataset;
var
Vdataset:tdataset;
tmpdataset:tatclientdataset;
DataSource:tdatasource;
tmpstrs:tstrings;
rowval,colval,dataval:string;
i,j:integer;
datatype:TFieldType;
DataSize:integer;
begin
result:=nil;
if (ColField='''''''') or(RowField='''''''')or(DataField='''''''') then
  showmessage(''''All Field not be NULL!'''')
else
begin
  if (ColField=RowField)
      or(ColField=DataField)
      or(RowField=DataField) then
    showmessage(''''All Field not be Equ!'''')
  else
  if (self.SouDataSet.FieldByName(ColField).DataType=ftString)
    or (self.SouDataSet.FieldByName(ColField).DataType<>ftWideString)
    or (self.SouDataSet.FieldByName(ColField).DataType<>ftFixedChar)
    or (self.SouDataSet.FieldByName(ColField).DataType<>ftMemo)
    or (self.SouDataSet.FieldByName(ColField).DataType<>ftFmtMemo)  then
  begin
  try
    tmpstrs:=tstringlist.Create;
    Vdataset:=SouDataSet;
    Vdataset.First;
    for i:=0 to Vdataset.RecordCount-1 do
    begin
      if (varisnull(SouDataSet.FieldValues[colfield])=false) and (SouDataSet.FieldValues[colfield]<>'''''''') then
        if tmpstrs.IndexOf(SouDataSet.FieldValues[colfield])=-1 then
        begin
          tmpstrs.Add(SouDataSet.FieldValues[colfield]);
        end;
      Vdataset.Next;
    end;
    //生成动态列标题
    tmpdataset:=TClientDataSet.Create(Self);
    tmpdataset.FieldDefs.Add(rowfield,ftstring,50,False);
    for i:=0 to tmpstrs.Count-1 do
    begin
      with tmpdataset.FieldDefs do
      begin
        Add(tmpstrs.Strings[i],ftInteger,0,False);
      end;
    end;
    tmpdataset.FieldDefs.Add(''''Sum'''',ftInteger,0,False);
    DataSource:=tdatasource.Create(self);
    DataSource.DataSet:=tmpdataset;
    with DataSource do
    begin
      dataset:=Createtmptab(tmpdataset.FieldDefs);
      dataset.Open;
    end;
    //建立临时表
    Vdataset.First;
    for i:=0 to Vdataset.RecordCount-1 do
    begin
      rowval:=SouDataSet.fieldbyname(rowfield).AsString;
      colval:=SouDataSet.fieldbyname(colfield).AsString;
      dataval:=SouDataSet.fieldbyname(datafield).AsString;
      if dataval='''''''' then dataval:=''''0'''';
      if DataSource.DataSet.Locate(rowfield,rowval,[loPartialKey]) then
      begin
        DataSource.DataSet.Edit;
        DataSource.DataSet.FieldByName(colval).AsString:=dataval;
        DataSource.DataSet.FieldByName(''''Sum'''').AsInteger:=
          DataSource.DataSet.FieldByName(''''Sum'''').AsInteger+strtoint(dataval);
        DataSource.DataSet.Post;
      end
      else
      begin
        DataSource.DataSet.Append;
        DataSource.DataSet.FieldByName(rowfield).AsString:=rowval;
        for j:=1 to DataSource.DataSet.Fields.Count-1 do
          DataSource.DataSet.Fields[j].AsCurrency:=0;
        DataSource.DataSet.FieldByName(colval).AsString:=dataval;
        DataSource.DataSet.FieldByName(''''Sum'''').AsString:=dataval;
        DataSource.DataSet.Post;
      end;
      Vdataset.Next;
    end;
    result:=DataSource.DataSet;
    //生成交叉表数据集
    tmpstrs.Free;
  except
  end;
  end
  else
    showmessage(''''ColField Must be of Type String!'''') ;
end;
end;

以上代码在D7和SQL Server 7.0/2000测试通过


没有相关教程
教程录入:mintao    责任编辑:mintao 
  • 上一篇教程:

  • 下一篇教程:
  • 【字体: 】【发表评论】【加入收藏】【告诉好友】【打印此文】【关闭窗口
      注:本站部分文章源于互联网,版权归原作者所有!如有侵权,请原作者与本站联系,本站将立即删除! 本站文章除特别注明外均可转载,但需注明出处! [MinTao学以致用网]
      网友评论:(只显示最新10条。评论内容只代表网友观点,与本站立场无关!)

    同类栏目
    · C语言系列  · VB.NET程序
    · JAVA开发  · Delphi程序
    · 脚本语言
    更多内容
    热门推荐 更多内容
  • 没有教程
  • 赞助链接
    更多内容
    闵涛博文 更多关于武汉SEO的内容
    500 - 内部服务器错误。

    500 - 内部服务器错误。

    您查找的资源存在问题,因而无法显示。

    | 设为首页 |加入收藏 | 联系站长 | 友情链接 | 版权申明 | 广告服务
    MinTao学以致用网

    Copyright @ 2007-2012 敏韬网(敏而好学,文韬武略--MinTao.Net)(学习笔记) Inc All Rights Reserved.
    闵涛 投放广告、内容合作请Q我! E_mail:admin@mintao.net(欢迎提供学习资源)

    站长:MinTao ICP备案号:鄂ICP备11006601号-18

    闵涛站盟:医药大全-武穴网A打造BCD……
    咸宁网络警察报警平台