coutallywform.~pas

来自「一个电力企业的后台管理程序」· ~PAS 代码 · 共 424 行

unit CoutAllYwForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  fcButton, fcImgBtn, fcShapeBtn, StdCtrls, ExtCtrls, Spin, DsFancyButton,
  ComCtrls,dbtables;

type
  TFrm_AllBusi = class(TForm)
    PC_Content: TPageControl;
    TabSheet1: TTabSheet;
    DsFancyButton1: TDsFancyButton;
    DsFancyButton2: TDsFancyButton;
    DsFancyButton3: TDsFancyButton;
    DsFancyButton4: TDsFancyButton;
    DsFancyButton7: TDsFancyButton;
    DsFancyButton8: TDsFancyButton;
    Panel2: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    SE_CurrYear: TSpinEdit;
    SE_AddUpYear: TSpinEdit;
    SE_CurrMon: TSpinEdit;
    SE_AddUpMon: TSpinEdit;
    Panel3: TPanel;
    Label5: TLabel;
    Bevel1: TBevel;
    RB_Normal: TRadioButton;
    RB_Word: TRadioButton;
    Panel4: TPanel;
    fcShapeBtn2: TfcShapeBtn;
    fcShapeBtn3: TfcShapeBtn;
    fcShapeBtn1: TfcShapeBtn;
    Cb_BusType: TComboBox;
    Label8: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure fcShapeBtn2Click(Sender: TObject);
    procedure fcShapeBtn3Click(Sender: TObject);
    procedure fcShapeBtn1Click(Sender: TObject);
  private
    { Private declarations }
    InsertQry: TQuery;
    IMon_Num,IAdd_Num,ILMon_Num,ILYMon_Num,ILY_Num,IMonAd_Num: Integer;
    LMonRation,LYearRation,LYaerAdRation,AllRation,MonStr,MonAdStr: String;
    ArrKeyStr,SubKeyStr,SubSubKeyStr,ThirdSubStr: Array of Array of String;
    procedure CountNum(Class_ID,Class_Type : String);
    procedure InsertTable(TableName,Class_ID,Class_Type : String);
    procedure GetKeyStr(Class_Id,Class_Type: String;IsSub: Boolean);
    procedure DoInsert(TableName,Class_NameStr : String);
    procedure GetSubKeyStr(Class_Id,Class_Type: String;IsSub: Boolean);
    function CalMonData(FOpID,FOpType,CurrMon: String): Integer;
    function CalTotalData(CurrDate,AdDate,FOpID,FOpType: String): Integer;
    function GetLastMon(Dt_Date: String): String;
    procedure CalRation;
    procedure CreateRep;
  public
    { Public declarations }
  end;
  const
   CompTitleStr = '分类,本月,累计,同比上月增长率,同比去年同期增长率,同比去年累计增长率,占总数百分比';
var
  Frm_AllBusi: TFrm_AllBusi;

implementation
uses SystemDM,pubReport,CommonFunc;
{$R *.DFM}

{ TForm4 }

function TFrm_AllBusi.CalMonData(FOpID,FOpType,CurrMon: String): Integer;
begin
 Result := 0;
 with TQuery.Create(nil) do
 try
  Close;
  DataBaseName := SysDM.DBMain.DatabaseName;
  Sql.Text := Format('SELECT ALL_NUM FROM STAT_MONTH_SERVICE_NUM WHERE '+
                     'SERV_CLASS_ID = ''%S'' AND SERV_CLASS_TYPE = ''%S'' AND MONTH_ID = ''%S''',[FOpID,FOpType,CurrMon]);
  //Sql.SaveToFile('C:\te.tec') ;
  Open;
  if RecordCount > 0 then
   Result := FieldByName('ALL_NUM').AsInteger
  else
   Result := 0;
 finally
  Free;
 end;

end;

procedure TFrm_AllBusi.CalRation;
begin
  if ILYMon_Num <> 0 then
   LYaerAdRation := Format('%F',[(IMonAd_Num - ILYMon_Num) / ILYMon_Num * 100])
  else
   LYaerAdRation := '去年没数据';
  if ILMon_Num <> 0 then
   LMonRation := Format('%F',[(IMon_Num - ILMon_Num) / ILMon_Num * 100])
  else
   LMonRation := '上月没数据';
  if ILYMon_Num <> 0 then
   LYearRation := Format('%F',[(IMon_Num - ILYMon_Num) / ILYMon_Num * 100])
  else
   LYearRation := '去年没数据';
  if ILY_Num <> 0 then
   AllRation := Format('%F',[IMon_Num / ILY_Num * 100])
  else
   AllRation := '累计没数据';

end;

function TFrm_AllBusi.CalTotalData(CurrDate, AdDate,FOpID,FOpType: String): Integer;
begin
 Result := 0;
 with TQuery.Create(nil) do
  Try
   Close;
   DataBaseName := SysDM.DBMain.DatabaseName;
   Sql.Text := Format('SELECT SUM(ALL_NUM) TALL_NUM FROM STAT_MONTH_SERVICE_NUM'+
                      ' WHERE MONTH_ID >= ''%S'' AND MONTH_ID <= ''%S'' '+
                      ' AND SERV_CLASS_ID = ''%S'' AND SERV_CLASS_TYPE = ''%S''',[AdDate,CurrDate,FOpID,FOpType]);
   Sql.SaveToFile('C:\sum.txt');
   Open;
   Last;
   if RecordCount > 0 then
    Result := FieldByName('TALL_NUM').AsInteger
   else
    Result := 0;
  finally
   Free;
  end;
end;

procedure TFrm_AllBusi.CountNum(Class_ID, Class_Type: String);
var
 LastYear,LastAdYear: String;
begin
 LastYear := IntToStr(StrToInt(Copy(MonStr,1,4)) - 1) + Copy(MonStr,5,2);
 LastAdYear := IntToStr(StrToInt(Copy(MonAdStr,1,4)) - 1) + Copy(MonAdStr,5,2);
 iMon_Num := CalMonData(Class_ID, Class_Type,MonStr);
 ILMon_Num := CalMonData(Class_ID, Class_Type,GetLastMon(MonStr));
 IMonAd_Num := CalTotalData(MonStr,MonAdStr,Class_ID, Class_Type);
 ILYMon_Num := CalMonData(Class_ID, Class_Type,LastYear);
 ILY_Num := CalTotalData(LastYear,LastAdYear,Class_ID, Class_Type);
 CalRation;
end;

procedure TFrm_AllBusi.DoInsert(TableName, Class_NameStr: String);
begin
// with TQuery.Create(nil)
 InsertQry.Close;
 InsertQry.Sql.Text := Format('Insert Into %s Values(''%s'',%d,%d,''%s'''+
                              ',''%s'',''%s'',''%s'')',[TableName,Class_NameStr,IMon_Num,
                              IMonAd_Num,LMonRation,LYearRation,LYaerAdRation,
                              AllRation]);
 //InsertQry.Sql.SaveToFile('C:\InsertQry.Txt');
 InsertQry.ExecSql;

end;

procedure TFrm_AllBusi.GetKeyStr(Class_Id, Class_Type: String;IsSub:Boolean);
var
 I: Integer;
begin
 with TQuery.Create(nil)do
 try
  Close;
  DataBaseName := SysDM.DBMain.DatabaseName;
{  if not IsSub then
   begin
   end
  else
    Sql.Text := Format('Select Class_Id,Class_Type,Class_Name From Class_Code Where'+
                     ' Parent_Class_ID = ''%s'' and Parent_Class_Type '+
                     ' = ''%s''',[Class_Id,Class_Type]);

  Open;}
  if Not IsSub then
   begin
    if Class_Id = '4' then
     Sql.Text := Format('Select Class_Id,Class_Type,Class_Name From Class_Code Where'+
                     ' Parent_Class_ID = ''%s'' and Parent_Class_Type '+
                     ' = ''%s'' and class_Type = ''E''',[Class_Id,Class_Type])
    else
     Sql.Text := Format('Select Class_Id,Class_Type,Class_Name From Class_Code Where'+
                     ' Parent_Class_ID = ''%s'' and Parent_Class_Type '+
                     ' = ''%s''',[Class_Id,Class_Type]);
   // Sql.SaveToFile('C:\keystr.txt');
    Open;
    SetLength(ArrKeyStr,RecordCount,3);
    for I := 0 to RecordCount - 1 do
     begin
      ArrKeyStr[I,0] := FieldByName('Class_Id').AsString;
      ArrKeyStr[I,1] := FieldByName('Class_Type').AsString;
      ArrKeyStr[I,2] := FieldByName('Class_Name').AsString;
      Next;
     end;
    end
   else
    begin
     Sql.Text := Format('Select Class_Id,Class_Type,Class_Name From Class_Code Where'+
                     ' Parent_Class_ID = ''%s'' and Parent_Class_Type '+
                     ' = ''%s''',[Class_Id,Class_Type]);
    OPen;
    SetLength(SubKeyStr,RecordCount,3);
    for I := 0 to RecordCount - 1 do
     begin
      SubKeyStr[I,0] := FieldByName('Class_Id').AsString;
      SubKeyStr[I,1] := FieldByName('Class_Type').AsString;
      SubKeyStr[I,2] := '*' + FieldByName('Class_Name').AsString;
      Next;
     end;
    end;
 finally
  Free;
 end;

end;

function TFrm_AllBusi.GetLastMon(Dt_Date: String): String;
var
 LastMon,Mon,SYear : String;
begin
 Result := '';
 LastMon := Dt_Date;//FormatDateTime('YYYYMM',Dt_Date);
 SYear := Copy(Dt_Date,1,4);//FormatDateTime('YYYY',Dt_Date);
 Mon := Copy(Dt_Date,5,2);//FormatDateTime('MM',Dt_Date);
 if StrToInt(Mon) - 1 = 0 then
  Result := IntToStr(StrToInt(SYear) - 1) + '12'
 else
  Result := IntToStr(StrToInt(LastMon) - 1)
end;

procedure TFrm_AllBusi.InsertTable(TableName, Class_ID, Class_Type: String);
var
 I,J,K,L :Integer;
begin
 with TQuery.Create(nil)do
 try
  Close;
  DataBaseName := SysDM.DBMain.DatabaseName;
  Sql.Text := Format('Truncate Table %s',[TableName]);
  ExecSql;
  GetKeyStr(Class_ID,Class_Type,False);
  for I := 0 to High(ArrKeyStr) do
   begin
    CountNum(ArrKeyStr[I,0],ArrKeyStr[I,1]);
    DoInsert(TableName,ArrKeyStr[I,2]);
    GetKeyStr(ArrKeyStr[I,0],ArrKeyStr[I,1],True);
    for J := 0 to High(SubKeyStr) do
     begin
      CountNum(SubKeyStr[J,0],SubKeyStr[J,1]);
      DoInsert(TableName,SubKeyStr[J,2]);
      if Class_ID = '1'then
       begin
        GetSubKeyStr(SubKeyStr[J,0],SubKeyStr[J,1],False);
        for K := 0 to High(SubSubKeyStr) do
         begin
          CountNum(SubSubKeyStr[K,0],SubSubKeyStr[K,1]);
          DoInsert(TableName,SubSubKeyStr[K,2]);
          GetSubKeyStr(SubSubKeyStr[K,0],SubSubKeyStr[K,1],True);
          for L := 0 to High(ThirdSubStr) do
           begin
            CountNum(ThirdSubStr[K,0],ThirdSubStr[K,1]);
            DoInsert(TableName,ThirdSubStr[K,2]);
           end;
         end;
       end;
     end;
   end;
 finally
  Free;
 end;
end;

procedure TFrm_AllBusi.FormCreate(Sender: TObject);
begin
 InsertQry := TQuery.Create(Self);
 InsertQry.DataBaseName := SysDM.DBMain.DatabaseName;
 Cb_BusType.ItemIndex := 0;
 Se_CurrYear.Value := StrToInt(FormatDateTime('YYYY',Date));
 Se_CurrMon.Value := StrToInt(FormatDateTime('M',Date));
 Se_AddUpYear.Value := StrToInt(FormatDateTime('YYYY',Date)) - 1;
 Se_AddUpMon.Value := StrToInt(FormatDateTime('M',Date));
 
 //showmessage(MonStr + ' ' + MonAdStr);
end;

procedure TFrm_AllBusi.FormDestroy(Sender: TObject);
begin
 InsertQry.Free;
end;

procedure TFrm_AllBusi.CreateRep;
var
 SqlStr,RepModeStr : String;
begin
 case Cb_BusType.ItemIndex of
  0:
   begin
    SqlStr := 'Select * From STAT_OPAMOUNT_GZBXCOMPARE_INFO';
    InsertTable('STAT_OPAMOUNT_GZBXCOMPARE_INFO','2','A');
    RepModeStr := 'GZBXCOMPARE';
   end;
  1:
   begin
    SqlStr := 'Select * From STAT_OPAMOUNT_YDSQCOMPARE_INFO';
    InsertTable('STAT_OPAMOUNT_YDSQCOMPARE_INFO','4','A');
    RepModeStr := 'YDSQCOMPARE';
   end;
  2:
   begin
    SqlStr := 'Select * From STAT_OPAMOUNT_TSJBCOMPARE_INFO';
    InsertTable('STAT_OPAMOUNT_TSJBCOMPARE_INFO','3','A');
    RepModeStr := 'TSJBCOMPARE';
   end;
  3:
   begin
    SqlStr := 'Select * From STAT_OPAMOUNT_ZXCXCOMPARE_INFO';
    InsertTable('STAT_OPAMOUNT_ZXCXCOMPARE_INFO','1','A');
    RepModeStr := 'ZXCXCOMPARE';
   end;

 end;
 if Rb_Normal.Checked then
  PreviewReport(RepModeStr,SqlStr,'','',Cb_BusType.Text + '报表');
 if Rb_Word.Checked then
  MakeWordReport(SysDm.WReport,SqlStr,CompTitleStr,Cb_BusType.Text + '报表');
end;

procedure TFrm_AllBusi.fcShapeBtn2Click(Sender: TObject);
begin
 if Length(IntToStr(Se_CurrMon.Value)) = 1 then
  MonStr := IntToStr(Se_CurrYear.Value) + '0' + IntToStr(Se_CurrMon.Value)
 else
  MonStr := IntToStr(Se_CurrYear.Value)  + IntToStr(Se_CurrMon.Value);
 if Length(IntToStr(Se_AddUpMon.Value)) = 1 then
  MonAdStr := IntToStr(Se_AddUpYear.Value) + '0' + IntToStr(Se_AddUpMon.Value)
 else
  MonAdStr := IntToStr(Se_AddUpYear.Value) + IntToStr(Se_AddUpMon.Value);
 CreateRep
end;

procedure TFrm_AllBusi.fcShapeBtn3Click(Sender: TObject);
begin
 Close;
end;

procedure TFrm_AllBusi.fcShapeBtn1Click(Sender: TObject);
var
 SqlStr,RepModeStr : String;
begin
 case Cb_BusType.ItemIndex of
  0:
   begin
    SqlStr := 'Select * From STAT_OPAMOUNT_GZBXCOMPARE_INFO';
    InsertTable('STAT_OPAMOUNT_GZBXCOMPARE_INFO','2','A');
    RepModeStr := 'GZBXCOMPARE';
   end;
  1:
   begin
    SqlStr := 'Select * From STAT_OPAMOUNT_YDSQCOMPARE_INFO';
    InsertTable('STAT_OPAMOUNT_YDSQCOMPARE_INFO','4','A');
    RepModeStr := 'YDSQCOMPARE';
   end;
  2:
   begin
    SqlStr := 'Select * From STAT_OPAMOUNT_TSJBCOMPARE_INFO';
    InsertTable('STAT_OPAMOUNT_TSJBCOMPARE_INFO','3','A');
    RepModeStr := 'TSJBCOMPARE';
   end;
 end;
 DesignReport(RepModeStr,SqlStr,'','',Cb_BusType.Text + '报表');
end;

procedure TFrm_AllBusi.GetSubKeyStr(Class_Id, Class_Type: String;
  IsSub: Boolean);
var
 I: Integer;
begin
 with TQuery.Create(nil) do
 try
  Close;
  DataBaseName := SysDM.DBMain.DatabaseName;
  Sql.Text := Format('Select Class_ID,Class_Type,Class_Name From '+
                     'Class_Code Where Parent_Class_Id = ''%s'' and '+
                     ' Parent_Class_Type = ''%s''',[Class_ID,Class_Type]);
  Open;
  if not IsSub then
   begin
    SetLength(SubSubKeyStr,RecordCount,3);
    for I := 0 to RecordCount - 1 do
     begin
      SubSubKeyStr[I,0] := FieldByName('Class_ID').AsString;
      SubSubKeyStr[I,1] := FieldByName('Class_Type').AsString;
      SubSubKeyStr[I,2] := '**' + FieldByName('Class_Name').AsString;
      Next;
     end;
   end
    else
     begin
      SetLength(ThirdSubStr,RecordCount,3);
      for I := 0 to RecordCount - 1 do
       begin
        ThirdSubStr[I,0] := FieldByName('Class_ID').AsString;
        ThirdSubStr[I,1] := FieldByName('Class_Type').AsString;
        ThirdSubStr[I,2] := '***' + FieldByName('Class_Name').AsString;
        Next;
       end;
     end;
 finally
  Free;
 end;
end;

end.