urpt4.pas

是分布式粮库程序,是采用Delphi实现的

unit uRpt4;

interface
uses dbtables,Sysutils,Excel97,OleServer,ComObj;
const
  SYSLOGFILE = 'bs.hst';
  //---文件格式-----------
  // LastLogin  9Byte
  // Manager    13Byte
  // Clerk      13Byte
  //----------------------
  SUPERUSERID=0;

  GID_ADMINISTRATOR     =       0;
  GID_OPERATOR          =       1;
  GID_QUERYUSER         =       2;
  GID_FINANCE           =       3;
  GID_SHICAIZHENG       =       4;
  SUCCESS = 1;
       FAILED_CONNECTXLS  = -1;
       FAILED_ATTACH      = -2;
       FAILED_DISCONNECT  = -3;

type
  PFType = ^TFType;
  TFType = record
    FFID   : string;
    FName  : string;
    FSum   : single;
    iRow   : integer;
    next   : PFType;
  end;

  PAttribute = ^TAttribute;
  TAttribute = record
    AHashV : string;
    AName : string;
    FType : PFType;
    ASum  : single;
    ACount : integer;
    next  : PAttribute;
  end;

  procedure CreateReport_4;
  procedure FreeReport_4;

  procedure u4_Init_Attr;
  // 查询储备性质-品种分布
  procedure u4_GetAttr_Type;
  function u4_CalHash(s : string) : integer;
  procedure u4_ResortAttrList;
  procedure u4_DrawFrame;
  procedure u4_FillTable;
  function u4_FindAF(iA : string; it : string; var i : integer) : PFType;
  procedure u4_FillTable2;
  function LocateCol(iUID : integer) : integer;

    { 创建Excel OLE对象 }
    function XLS_Create     : integer;
    function XLS_Open(fName : string)     : integer;
    { 关闭Excel OLE对话 }
    function XLS_Close      : integer;
    { 显示Excel界面 }
    function XLS_Show       : integer;
    { 对Excel OLE对象的格子画边框 }
    function XLS_DrawBorder(X1,Y1,X2,Y2: integer) : integer;
    { 向Excel OLE对象的指定格子写入字符串 }
    function XLS_FillCell(X1,Y1 : integer ; Text :string;Align:integer) :integer;

    function XLS_ReadCell(X1,Y1 : integer) :string;

    { 向Excel OLE对象的格子范围写入字符串 }
    function XLS_FillRange(X1,Y1,X2,Y2 : integer ; Text :string) :integer;

    { 合并Excel OLE对象的指定范围格子 }
    function XLS_Merge(X1,Y1,X2,Y2 : integer) : integer;

    { 合并Excel OLE对象的指定范围格子，并指定文字是否自动换行 }
    function XLS_MergeEx(X1,Y1,X2,Y2 : integer; bWraped : boolean) : integer;

    { 把Excel OLE对象保存为.xls文件 }
    function XLS_SaveAs(PathName : string) : integer;

    { 设置列宽度 }
    function XLS_SetWidth(Column : integer; Width : integer) :integer;

    { 设置行高度 }
    function XLS_SetHeight(Row :integer;Height : integer) :integer;

    function XLS_Line(X1,Y1,X2,Y2 : integer):integer;

    function XLS_BorderLine(X1,Y1,X2,Y2 : integer):integer;

    function XLS_SetSize(X1,Y1,X2,Y2 : integer;wordsize : integer) : integer;

    function XLS_SetWorkSheetFontSize(wordname:string;wordsize:integer):integer;

    function XLS_SetRangeFontSize(X1,Y1,X2,Y2 : integer;wordname:string;wordsize:integer):integer;

    function XLS_CoordinateX(pos : integer) : string;

    function XLS_AddPageBreak(Row : integer; Col : integer) : integer;

var
  u4_db : TDatabase;
  u4_qryAF : TQuery;
  AttrHead : TAttribute;

  u4_AF_Lines : integer;
  u4_Unit_Count : integer;

  sf1,sf2,sft : array of real;

  Cols          : array of integer;
  DataLen : integer;
  GROUP_ID : integer;
  sgUnitName:string;
  XlsObject : OLEVariant;

implementation
 uses UnitDataModul;


procedure u4_Init_Attr;
var pa : PAttribute;
    s : string;
begin
  AttrHead.AHashV := '';
  AttrHead.AName := '';
  AttrHead.FType := nil;
  AttrHead.ASum := 0;
  AttrHead.next := nil;
  pa := @AttrHead;

  if GROUP_ID=GID_SHICAIZHENG then
        s := 'select distinct ATTRIBUTE from ENT_INSTACK where ATTRIBUTE<>''代储'' order by ATTRIBUTE'
  else
        s := 'select distinct ATTRIBUTE from ENT_INSTACK order by ATTRIBUTE';
  u4_qryAF.SQL.Clear;
  u4_qryAF.SQL.Add(s);
  u4_qryAF.Open;
  while not u4_qryAF.Eof do
  begin
        new(pa^.next);
        pa := pa^.next;
        pa^.AName := u4_qryAF.FieldByName('ATTRIBUTE').AsString;
        pa^.AHashV := (pa^.AName);
        pa^.FType := nil;
        pa^.ASum := 0;
        pa^.ACount := 0;
        pa^.next := nil;
        u4_qryAF.Next;
  end;

  // 查询储备性质-品种分布
  u4_GetAttr_Type;

  // 对储备性质列表进行用户自定义排序
  u4_ResortAttrList;

end;

procedure u4_GetAttr_Type;
var s: string;
    pa : PAttribute;
    pf : PFType;
    aCount : integer;
begin
  if GROUP_ID=GID_SHICAIZHENG then
 { s := 'select distinct ATTRIBUTE,FDSTK_FOODID,FOODTP_NAME'
      +' from ent_foodsstock,ent_foodtype'
      +' where FDSTK_FOODID=FOODTP_ID and ATTRIBUTE<>''代储'' ORDER BY ATTRIBUTE'
  else
  s := 'select distinct ATTRIBUTE,FDSTK_FOODID,FOODTP_NAME'
      +' from ent_foodsstock,ent_foodtype'
      +' where FDSTK_FOODID=FOODTP_ID ORDER BY ATTRIBUTE';   }

  s := 'select distinct ATTRIBUTE,IN_FOOD  from ENT_INSTACK  where  ATTRIBUTE<>''代储'' ORDER BY ATTRIBUTE '
  else
  s := 'select distinct ATTRIBUTE,IN_FOOD  from ENT_INSTACK  ORDER BY ATTRIBUTE ';

  u4_qryAF.SQL.Clear;
  u4_qryAF.SQL.Add(s);
  u4_qryAF.Open;

  pa := AttrHead.next;
  u4_AF_Lines := u4_qryAF.RecordCount;
  aCount := 1;
  while not u4_qryAF.Eof do
  begin
        s:=pa^.AHashV;
        if trim(pa^.AHashV) = trim(u4_qryAF.FieldByName('ATTRIBUTE').AsString) then
        begin
                if pa^.FType = nil then
                begin
                        new(pa^.FType);
                        pf := pa^.FType;
                end
                else
                begin
                        new(pf^.next);
                        pf := pf^.next;
                end;

                pf^.FFID := u4_qryAF.FieldByname('IN_FOOD').Asstring;
                pf^.FName := u4_qryAF.FieldByname('IN_FOOD').AsString;
                pf^.FSum := 0;
                pf^.iRow := 0;
                pf^.next := nil;

                Inc(aCount);
                u4_qryAF.Next;
        end
        else
        begin
                pa^.ACount := aCount;
                aCount := 1;
                pa := pa^.next;
        end;
  end;
  pa^.ACount := aCount;

end;

function u4_CalHash(s : string) : integer;
var i,l : integer;
    v : integer;
begin
        l := length(s);
        v := 0;
        for i:=1 to l do
        begin
                v :=v+ord(s[i]);
        end;
        Result := v;
end;

procedure u4_ResortAttrList;
begin

end;

procedure u4_DrawFrame;
var i,j : integer;
    pa : PAttribute;
    pf : PFType;
    s : string;
    y,m,d : word;
begin
  XLS_SetWidth(1,2);

  //  '储粮性质'位置
  XLS_FillCell(1,5,'储备性质',0);
  XLS_DrawBorder(1,3,1,7);
  XLS_MergeEx(1,3,1,7,True);


  //  '数量/单位/品种'位置
  XLS_DrawBorder(2,3,2,6);
  XLS_FillCell(2,3,'单位',1);
  XLS_FillCell(2,4,'数量',2);
  XLS_FillCell(2,6,'品种',2);

  // '合计'位置
  XLS_FillCell(3,5,'合计',0);
  XLS_DrawBorder(3,3,5,6);

  // '分公司合计'位置
  XLS_FillCell(4,5,'分公司',0);
  XLS_DrawBorder(4,4,4,6);

  // '代储单位合计'位置
  XLS_FillCell(5,5,'代储单位',0);
  XLS_DrawBorder(5,4,5,6);

  s := 'select * from ent_unit_info order by UNIT_ID';
  u4_qryAF.SQL.Clear;
  u4_qryAF.SQL.Add(s);
  u4_qryAF.Open;
  u4_Unit_Count := u4_qryAF.RecordCount;

  SetLength(Cols,u4_Unit_Count);
  for i:=6 to 6+u4_Unit_Count-1 do
  begin
        XLS_FillCell(i,3,u4_qryAF.FieldByName('UNIT_NAME').AsString,0);
        XLS_DrawBorder(i,3,i,6);
        XLS_MergeEx(i,3,i,6,True);
        Cols[i-6] := u4_qryAF.FieldByName('UNIT_ID').AsInteger;
        u4_qryAF.Next;
  end;

  XLS_FillCell(2,7,'库存合计',0);
  for i:=2 to 6+u4_Unit_Count-1 do
        XLS_DrawBorder(i,7,i,7);

  j := 8;
  pa := AttrHead.next;
  while pa<>nil do
  begin
        XLS_DrawBorder(1,j,1,j+pa^.ACount-1);
        XLS_FillCell(1,j,pa^.AName,0);
        XLS_MergeEx(1,j,1,j+pa^.ACount-1,True);

        // 小计
        for i:=2 to 6+u4_Unit_Count-1 do
                XLS_DrawBorder(i,j,i,j);
        XLS_FillCell(2,j,'小计',0);
        Inc(j);

        pf := pa^.FType;
        while pf<>nil do
        begin
                for i:=2 to 6+u4_Unit_Count-1 do
                        XLS_DrawBorder(i,j,i,j);
                XLS_FillCell(2,j,pf^.FName,0);
                pf^.iRow := j;
                Inc(j);
                pf := pf^.next;
        end;
        pa := pa^.next;
  end;

  XLS_Merge(1,1,u4_Unit_Count+5,1);
  XLS_FillRange(1,1,u4_Unit_Count+5,1,'杭州市区库存粮食汇总表');
  XLS_SetRangeFontSize(1,1,u4_Unit_Count+5,1,'黑体',20);

  DecodeDate(Date,y,m,d);
  XLS_Merge(1,2,u4_Unit_Count+5,2);
  XLS_FillRange(1,2,u4_Unit_Count+5,2,IntToStr(y)+'年'+IntToStr(m)+'月'+IntToStr(d)+'日');

  // j-8 实际数据, 1 按单位合计数据
  DataLen := j-8+1;
  SetLength(sft,DataLen);
  SetLength(sf1,DataLen);
  SetLength(sf2,DataLen);

end;

procedure u4_FillTable;
var s: string;
    iUID : integer;
    iAHash : string;
    iFID : string;
    i : integer;
    pf : PFType;
    Col : integer;
begin
  if GROUP_ID=GID_SHICAIZHENG then
 { s := 'select UI=substring(DEPOT_ID,1,4),ATTRIBUTE,FDSTK_FOODID,FS=sum(FDSTK_SUM)'
      +' from ent_foodsstock where ATTRIBUTE<>''代储'''
      +' group by substring(DEPOT_ID,1,4),ATTRIBUTE,FDSTK_FOODID'
      +' order by substring(DEPOT_ID,1,4),ATTRIBUTE,FDSTK_FOODID'
  else
  s := 'select UI=substring(DEPOT_ID,1,4),ATTRIBUTE,FDSTK_FOODID,FS=sum(FDSTK_SUM)'
      +' from ent_foodsstock'
      +' group by substring(DEPOT_ID,1,4),ATTRIBUTE,FDSTK_FOODID'
      +' order by substring(DEPOT_ID,1,4),ATTRIBUTE,FDSTK_FOODID';   }
   s := 'select UI=UNIT_ID,ATTRIBUTE,IN_FOOD,FS=sum(STORAGE)  from ENT_INSTACK where ATTRIBUTE<>''代储'''+
        ' group by UNIT_ID ,ATTRIBUTE,IN_FOOD  order by UNIT_ID,ATTRIBUTE,IN_FOOD'
  else
  s := 'select UI=UNIT_ID,ATTRIBUTE,IN_FOOD,FS=sum(STORAGE)  from ENT_INSTACK '+
        ' group by UNIT_ID ,ATTRIBUTE,IN_FOOD  order by UNIT_ID,ATTRIBUTE,IN_FOOD';



  u4_qryAF.SQL.Clear;
  u4_qryAF.SQL.Add(s);
  u4_qryAF.Open;
  iUID := u4_qryAF.FieldByname('UI').AsInteger;
  for i:=0 to DataLen-1 do
        sft[i] := 0;
 for i:=0 to DataLen-1 do
        sf1[i] := 0;
 for i:=0 to DataLen-1 do
        sf2[i] := 0;