untchoosereport.~pas

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

unit UntChooseReport;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, DBTables, StdCtrls,Excel97,OleServer,ComObj;

const  SUCCESS = 1;
       FAILED_CONNECTXLS  = -1;
       FAILED_ATTACH      = -2;
       FAILED_DISCONNECT  = -3;

type
  TfrmChooseReport = class(TForm)
    Label1: TLabel;
    cbxReportType: TComboBox;
    btnReport: TButton;
    btnExit: TButton;
    qryTmp: TQuery;
    Button1: TButton;
    procedure btnReportClick(Sender: TObject);
    procedure btnExitClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    sgUnitName:string;
    XlsObject : OLEVariant;
    { 创建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;

  end;

var
  frmChooseReport: TfrmChooseReport;

implementation
 uses UnitDataModul,uRpt4;

{$R *.dfm}

procedure TfrmChooseReport.btnReportClick(Sender: TObject);
var
  i,j,iLen:integer;
  sCellText,sStr1,sStr2,sValue:string;
begin
  XLS_Create;
  CopyFile(PChar(GetCurrentDir+'\报表\'+cbxReportType.Text+'.xls'),PChar(GetCurrentDir+'\报表\Temp.xls'),False);
  XLS_Open(GetCurrentDir+'\报表\Temp.xls');
  try
    for j:=3 to 100 do
    begin
      sStr1:=XLS_ReadCell(1,j);
      sStr2:=XLS_readCell(2,j);
      for i:=1 to 25 do
      begin
        sCellText:=XLS_ReadCell(i,j);
        if copy(sCellText,1,1)='_' then
        begin
          if sCellText='_UnitName' then
            XLS_FillCell(i,j,sgUnitName,-1)
          else if  sCellText='_DateTime' then
            XLS_FillCell(i,j,datetimetostr(now),-1);
        end
        else if copy(sCellText,1,1)='#' then
        begin
          iLen:=length(sCellText);
          sCellText:=copy(sCellText,2,iLen-1);
          qryTmp.Active := false;
          qryTmp.SQL.Clear;
          qryTmp.SQL.Add(sStr1+sCellText+sStr2);
          qryTmp.Active := true;
          svalue:=qryTmp.Fields[0].AsString;
          XLS_FillCell(i,j,svalue,0);
        end;

      end;
      SCELLTEXT:='';
    end;
  Except
     showmessage(inttostr(i)+'::::'+inttostr(j));
  end;
  XLS_Show;
end;

procedure TfrmChooseReport.btnExitClick(Sender: TObject);
begin
  close;
end;

procedure TfrmChooseReport.FormCreate(Sender: TObject);
begin
  sgUnitName:='南星桥分公司';
end;

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

function TfrmChooseReport.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 TfrmChooseReport.XLS_Close:Integer;
begin
  Result := SUCCESS;
  Try
    XlsObject.DisplayAlerts:=False;
    XlsObject.Quit;
  Except
    Result := FAILED_DISCONNECT;
    Exit;
  End;
end;

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

function TfrmChooseReport.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 TfrmChooseReport.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 TfrmChooseReport.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 TfrmChooseReport.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 TfrmChooseReport.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 TfrmChooseReport.XLS_SaveAs(PathName : string) : integer;
begin
  XlsObject.ActiveWorkbook.SaveAs(PathName);
end;

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

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

function TfrmChooseReport.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 TfrmChooseReport.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 TfrmChooseReport.XLS_SetWorkSheetFontSize(wordname:string;wordsize:integer):integer;
begin
  XlsObject.ActiveSheet.Cells.Font.Name:=wordname;
  XlsObject.ActiveSheet.Cells.Font.Size:=wordsize;
end;

function TfrmChooseReport.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 TfrmChooseReport.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 TfrmChooseReport.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 TfrmChooseReport.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 TfrmChooseReport.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;

procedure TfrmChooseReport.Button1Click(Sender: TObject);
begin
  showmessage(datetimetostr(now));
end;

end.