urpt4.~pas

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

  Col := 6;
  while not u4_qryAF.Eof do
  begin
        // 同一储备单位
        if iUID=u4_qryAF.FieldByname('UI').AsInteger then
        begin
               // iAHash := u4_CalHash(u4_qryAF.FieldByname('ATTRIBUTE').AsString);
                iAHash := (u4_qryAF.FieldByname('ATTRIBUTE').AsString);
                iFID := u4_qryAF.FieldByname('IN_FOOD').Asstring;
                // i是一个返回参数,记录该品种在数组中按储备性质合计的位置
                pf := u4_FindAF(iAHash,iFID,i);
                sft[pf^.iRow-7] := u4_qryAF.FieldByName('FS').AsFloat;
                sft[i] := sft[i]+sft[pf^.iRow-7];
                sft[0] := sft[0]+sft[pf^.iRow-7];

                u4_qryAF.Next;
        end
        else
        begin
                if (iUID div 100)=1 then
                // 代管单位
                begin
                        for i:=0 to DataLen-1 do
                                sf2[i] := sf2[i]+sft[i]
                end
                else
                // 分公司
                begin
                        for i:=0 to DataLen-1 do
                                sf1[i] := sf1[i]+sft[i]
                end;

                Col := LocateCol(iUID);
                for i:=0 to DataLen-1 do
                        if sft[i]>0 then
                                XLS_FillCell(Col,7+i,FloatToStr(sft[i]),1);
                //Inc(Col);

                for i:=0 to DataLen-1 do
                        sft[i] := 0;

                iUID := u4_qryAF.FieldByname('UI').AsInteger;
        end;

  end;

  if (iUID div 100)=1 then
  // 代管单位
  begin
          for i:=0 to DataLen-1 do
                  sf2[i] := sf2[i]+sft[i]
  end
  else
  // 分公司
  begin
          for i:=0 to DataLen-1 do
                  sf1[i] := sf1[i]+sft[i]
  end;
  
  Col := LocateCol(iUID);
  for i:=0 to DataLen-1 do
          if sft[i]>0 then
                  XLS_FillCell(Col,7+i,FloatToStr(sft[i]),1);

  for i:=0 to DataLen-1 do
  begin
          if (sf2[i]+sf1[i])>0 then
                  XLS_FillCell(3,7+i,FloatToStr(sf2[i]+sf1[i]),1);
          if sf1[i]>0 then
                  XLS_FillCell(4,7+i,FloatToStr(sf1[i]),1);
          if sf2[i]>0 then
                  XLS_FillCell(5,7+i,FloatToStr(sf2[i]),1);
  end;
end;

function u4_FindAF(iA : string; it : string; var i : integer) : PFType;var pa : PAttribute;
    pf : PFType;
begin
        pa := AttrHead.next;
        while pa<>nil do
        begin
                if trim(pa^.AHashV) = trim(iA) then
                begin
                        pf := pa^.FType;
                        i := pf^.iRow-8;
                        while pf<>nil do
                        begin
                                if trim(pf^.FFID) = trim(it) then
                                begin
                                        Result := pf;
                                        Exit;;
                                end;
                                pf := pf^.next;
                        end;
                end;
                pa := pa^.next;
        end;
        Result := nil;
end;

procedure u4_FillTable2;
var s: string;
    fC : integer;
    i : integer;
    fs : real;
begin
  {s := 'select FOODTP_NAME,FS'
      +' from ent_foodtype,'
      +' (select FDSTK_FOODID,FS=sum(FDSTK_SUM)'
      +' from ent_foodsstock'
      +' group by FDSTK_FOODID) t2'
      +' where FOODTP_ID=FDSTK_FOODID'
      +' order by FOODTP_ID';     }
  s := ' select  IN_FOOD,FS=sum(STORAGE)  from ENT_INSTACK   group by IN_FOOD  order by IN_FOOD ';

  u4_qryAF.SQL.Clear;
  u4_qryAF.SQL.Add(s);
  u4_qryAF.Open;
  fc := u4_qryAF.RecordCount;

  XLS_DrawBorder(1,DataLen+8,2+fc,DataLen+10);

  // 分品种
  XLS_FillCell(1,DataLen+9,'分品种',0);
  XLS_DrawBorder(1,DataLen+8,1,DataLen+10);
  XLS_MergeEx(1,DataLen+8,1,DataLen+10,True);

  // 库存总计
  XLS_FillCell(2,DataLen+8,'库存总计',0);

  fs := 0;
  for i:=1 to fc do
  begin
          XLS_FillCell(2+i,DataLen+9,u4_qryAF.FieldByName('IN_FOOD').AsString,0);
          XLS_DrawBorder(2+i,DataLen+9,2+i,DataLen+9);
          XLS_FillCell(2+i,DataLen+10,u4_qryAF.FieldByName('FS').AsString,0);
          XLS_DrawBorder(2+i,DataLen+10,2+i,DataLen+10);
          fs := fs+u4_qryAF.FieldByName('FS').AsFloat;
          u4_qryAF.Next;
  end;
  XLS_FillCell(2,DataLen+10,FloatToStr(fs),0);
  XLS_DrawBorder(2,DataLen+10,2,DataLen+10);

end;

function LocateCol(iUID : integer) : integer;
var i : integer;
begin
        for i:=0 to u4_Unit_Count-1 do
        begin
                if Cols[i]=iUID then Break;
        end;
        Result := i+6;
end;

procedure CreateReport_4;
begin
  u4_qryAF := TQuery.Create(nil);
  u4_qryAF.DatabaseName := 'LYDB';

  u4_Init_Attr;

  XLS_Create;
  XLS_SetWorkSheetFontSize('宋体',10);
  XLS_Line(2,5,2,6);
  XLS_Line(2,3,2,6);
  u4_DrawFrame;

  u4_FillTable;

  u4_FillTable2;
  XLS_SetWidth(7,9);
  XLS_SetWidth(8,9);
  XLS_Show;

end;

procedure FreeReport_4;
begin
  u4_qryAF.Destroy;;
end;




function XLS_Create : integer;
begin
  Result := SUCCESS;
  Try
    XlsObject := CreateOLEObject('Excel.Application');
  Except
    Result :=FAILED_CONNECTXLS;
    Exit;
  End;
  XlsObject.WorkBooks.Add;
end;

function XLS_Open(fName : string)     : integer;
begin
  Result := SUCCESS;
  Try
    XlsObject := CreateOLEObject('Excel.Application');
  Except
    Result :=FAILED_CONNECTXLS;
    Exit;
  End;
  XlsObject.WorkBooks.Open(fName);
end;

function XLS_Close:Integer;
begin
  Result := SUCCESS;
  Try
    XlsObject.DisplayAlerts:=False;
    XlsObject.Quit;
  Except
    Result := FAILED_DISCONNECT;
    Exit;
  End;
end;

function XLS_Show       : integer;
begin
  XlsObject.Visible := True;
end;

function XLS_DrawBorder(X1,Y1,X2,Y2: integer) : integer;
var sP1,sP2 :string;
begin
  sP1 :=XLS_CoordinateX(X1)+InttoStr(Y1);
  sP2 :=XLS_CoordinateX(X2)+InttoStr(Y2);
  XlsObject.ActiveSheet.Range[sP1+':'+sP2].BorderAround(1,xlThin,0);
end;

function XLS_FillCell(X1,Y1 :integer;Text :string;Align:integer):integer;
var sp1:string;
begin
  sP1 :=XLS_CoordinateX(X1)+InttoStr(Y1);
  XlsObject.ActiveSheet.Range[sP1].Value :=Text;
  case Align of
  0:
  begin
    XlsObject.ActiveSheet.Range[sP1].HorizontalAlignment :=xlHAlignCenter ;
    XlsObject.ActiveSheet.Range[sP1].VerticalAlignment   :=xlVAlignCenter ;
  end;
  -1:
  begin
    XlsObject.ActiveSheet.Range[sP1].HorizontalAlignment :=xlHAlignLeft ;
    XlsObject.ActiveSheet.Range[sP1].VerticalAlignment   :=xlVAlignCenter ;
  end;
  1:
  begin
    XlsObject.ActiveSheet.Range[sP1].HorizontalAlignment :=xlHAlignRight ;
    XlsObject.ActiveSheet.Range[sP1].VerticalAlignment   :=xlVAlignCenter ;
  end;
  end;
end;

function XLS_FillRange(X1,Y1,X2,Y2 : integer ; Text :string) :integer;
var sp1,sP2,s:string;
begin
  sP1 :=XLS_CoordinateX(X1)+InttoStr(Y1);
  sP2 :=XLS_CoordinateX(X2)+InttoStr(Y2);
  s :=sP1+':'+sP2;
  XlsObject.ActiveSheet.Range[s].Value :=Text;
  XlsObject.ActiveSheet.Range[s].HorizontalAlignment :=xlHAlignCenter ;
  XlsObject.ActiveSheet.Range[s].VerticalAlignment   :=xlVAlignCenter ;
end;

function XLS_Merge(X1,Y1,X2,Y2 : integer) : integer;
var sP1,sP2 :string;
begin
  sP1 :=XLS_CoordinateX(X1)+InttoStr(Y1);
  sP2 :=XLS_CoordinateX(X2)+InttoStr(Y2);
  XlsObject.ActiveSheet.Range[sP1+':'+sP2].Merge;
end;

function XLS_MergeEx(X1,Y1,X2,Y2 : integer; bWraped : boolean) : integer;
var sP1,sP2 :string;
begin
  sP1 :=XLS_CoordinateX(X1)+InttoStr(Y1);
  sP2 :=XLS_CoordinateX(X2)+InttoStr(Y2);
  XlsObject.ActiveSheet.Range[sP1+':'+sP2].Merge;
  XlsObject.ActiveSheet.Range[sP1+':'+sP2].WrapText := bWraped;
end;


function XLS_SaveAs(PathName : string) : integer;
begin
  XlsObject.ActiveWorkbook.SaveAs(PathName);
end;

function XLS_SetWidth(Column :integer;Width : integer) :integer;
begin
  XlsObject.ActiveSheet.Columns[Column].ColumnWidth :=Width;
end;

function XLS_SetHeight(Row :integer;Height : integer) :integer;
begin
  XlsObject.ActiveSheet.Rows[Row].RowHeight :=Height;
end;

function XLS_Line(X1,Y1,X2,Y2 : integer):integer;
var BeginX,BeginY,EndX,EndY:Single;
begin
  BeginX:=(X1-1)*(XlsObject.ActiveSheet.Range['A1'].Width);
  BeginY:=(Y1-1)*(XlsObject.ActiveSheet.Range['A1'].Height);
  EndX:=X2*(XlsObject.ActiveSheet.Range['A1'].Width);
  EndY:=Y2*(XlsObject.ActiveSheet.Range['A1'].Height);
  XlsObject.ActiveSheet.Shapes.AddLine(BeginX,BeginY,EndX,EndY);
end;

function XLS_SetSize(X1,Y1,X2,Y2 : integer;wordsize : integer):integer;
var sp1,sp2:string;
begin
  sP1 :=XLS_CoordinateX(X1)+InttoStr(Y1);
  sP2 :=XLS_CoordinateX(X2)+InttoStr(Y2);
  XlsObject.ActiveSheet.Range[sP1+':'+sP2].Font.Size:=wordsize;
end;

function XLS_SetWorkSheetFontSize(wordname:string;wordsize:integer):integer;
begin
  XlsObject.ActiveSheet.Cells.Font.Name:=wordname;
  XlsObject.ActiveSheet.Cells.Font.Size:=wordsize;
end;

function XLS_BorderLine(X1,Y1,X2,Y2 : integer):integer;
var sp1,sp2:string;
begin
  sP1 :=XLS_CoordinateX(X1)+InttoStr(Y1);
  sP2 :=XLS_CoordinateX(X2)+InttoStr(Y2);
  XlsObject.ActiveSheet.Range[sP1+':'+sP2].Borders.LineStyle:=XLContinuous;
end;

function XLS_CoordinateX(pos : integer) : string;
begin
        if pos > 26 then
        begin
                Result := Chr((pos div 26)+Ord('A')-1)+Chr((pos mod 26)+Ord('A')-1)
        end
        else
                Result := Chr(pos+Ord('A')-1)
end;

function XLS_ReadCell(X1,Y1 : integer) :string;
var sP1: string;
begin
  try
    sP1 :=XLS_CoordinateX(X1)+InttoStr(Y1);
    Result := XlsObject.ActiveSheet.Range[sP1];
  except
    Result :='';
  end;
end;

function XLS_SetRangeFontSize(X1,Y1,X2,Y2 : integer;wordname:string;wordsize:integer):integer;
var sP1,sP2 : string;
begin
  sP1 :=XLS_CoordinateX(X1)+InttoStr(Y1);
  sP2 :=XLS_CoordinateX(X2)+InttoStr(Y2);

  XlsObject.ActiveSheet.Range[sP1+':'+sP2].Font.Size := wordsize;
  XlsObject.ActiveSheet.Range[sP1+':'+sP2].Font.Name := wordname;
end;

function XLS_AddPageBreak(Row : integer; Col : integer) : integer;
var sp1,sp2 : string;
begin
  sP1 :=XLS_CoordinateX(1)+InttoStr(Row);
  sP2 :=XLS_CoordinateX(Col)+InttoStr(Row);
  XlsObject.ActiveSheet.Range[sP1+':'+sP2].PageBreak := 1;
end;

end.