⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 sz_txpdetjfx.pas

📁 省级集邮品管理ERP
💻 PAS
字号:
{*******************************************************}
{                                                       }
{                 通信票定额分析                        }
{                                                       }
{            中软金马公司版权所有。2002.12前            }
{                                                       }
{            编制:中软金马邮资票品项目开发组           }
{                                                       }
{                                                       }
{*******************************************************}
(*
仅本模块调用

*)
unit sz_txpdetjfx;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  TeEngine, Series, ExtCtrls, TeeProcs, Chart, RXCtrls, StdCtrls, Spin,
  Buttons, CheckComboBox, Db, DBTables, Grids, DBGrids;

type
  TFrmz_txdetjfx = class(TForm)
    Label1: TLabel;
    Panel1: TPanel;
    GroupBox1: TGroupBox;
    RB_DW: TRadioButton;
    RB_ND: TRadioButton;
    CB_ND: TCheckComboBox;
    GroupBox3: TGroupBox;
    RB_2D: TRadioButton;
    RB_3D: TRadioButton;
    BBt_Send: TBitBtn;
    BBt_Quit: TBitBtn;
    GroupBox4: TGroupBox;
    RB_Zhu: TRadioButton;
    RB_Bing: TRadioButton;
    RB_Zhe: TRadioButton;
    RB_Biao: TRadioButton;
    CB_DW: TCheckComboBox;
    ScrollBox1: TScrollBox;
    DBGrid1: TDBGrid;
    Panel_Tl: TPanel;
    Panel4: TPanel;
    Chart1: TChart;
    DataSource1: TDataSource;
    Query1: TQuery;
    RxLabel_Title: TRxLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure BBt_SendClick(Sender: TObject);
    procedure RB_NDClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    procedure DoOnGetMarkText(Sender: TChartSeries; ValueIndex: Longint; var MarkText: string);
  public
    { Public declarations }
  end;

var
  Frmz_txdetjfx: TFrmz_txdetjfx;

implementation

uses pub,sz_main, DataList;

{$R *.DFM}

const
  Spacing = 2;

procedure TFrmz_txdetjfx.FormCreate(Sender: TObject);
begin
  GetAllColWidth(Self);
  InitDataList(CB_DW.Items, Frmz_main.DB_GZ.DatabaseName,
    'select DWMC,DWDM from TGS_GXDWSJB where ZJXJ=''1'' order by DWDM ');
//2002-03-08 by jillshao
{  if CB_DW.Items.Count > 0 then
  begin
    CB_DW.Items.Insert( 0, '全部' );
  end;}
  InitDataList(CB_ND.Items, Frmz_main.DB_GZ.DatabaseName,
    'select distinct ND from TY_TXPDESJB order by ND');
//2002-03-08 by jillshao
{  if CB_ND.Items.Count > 0 then
  begin
    CB_ND.Items.Insert( 0, '全部' );
  end;}
end;

procedure TFrmz_txdetjfx.FormDestroy(Sender: TObject);
begin
  ClearDataList(CB_DW.Items);
  ClearDataList(CB_ND.Items);
end;

procedure TFrmz_txdetjfx.BBt_SendClick(Sender: TObject);

  function GetField: string;
  begin
    if RB_DW.Checked then
      Result := 'A.ND||''年'' 年度'
    else if RB_ND.Checked then
      Result := 'B.DWMC 单位名称'
    else
      Result := '';
  end;

  function GetGroupBy: string;
  begin
    if RB_DW.Checked then
      Result := 'group by A.ND'
    else if RB_ND.Checked then
      Result := 'group by B.DWMC'
    else
      Result := '';
  end;

  function GetCondND: string;
  var
    i: integer;
  begin
    Result := '';
    if not RB_ND.Checked then exit;
//2002-03-08 begin by jillshao
{    for i := 0 to CB_ND.Items.Count - 1 do
      if CB_ND.Checked[i] then
        if i > 0 then //第0个表示全部,所以不用处理这个条件
          if Result = '' then
            Result := Result + Format(' and (A.ND=''%s''', [string(PItemData(CB_ND.Items.Objects[i])^.Value)])
          else
            Result := Result + Format(' or A.ND=''%s''', [string(PItemData(CB_ND.Items.Objects[i])^.Value)])
        else
          exit;}
    for i := 0 to CB_ND.Items.Count - 1 do
      if CB_ND.Checked[i] then
      begin
        if Result = '' then
          Result := Result + Format(' and (A.ND=''%s''', [string(PItemData(CB_ND.Items.Objects[i])^.Value)])
        else
          Result := Result + Format(' or A.ND=''%s''', [string(PItemData(CB_ND.Items.Objects[i])^.Value)])
      end;
//2002-03-08 end
    if Result <> '' then
      Result := Result + ')';
  end;

  function GetCondDW: string;
  var
    i: integer;
  begin
    Result := '';
    if not RB_DW.Checked then exit;
//2002-03-08 begin by jillshao
{    for i := 0 to CB_DW.Items.Count - 1 do
      if CB_DW.Checked[i] then
         //第0个表示全部,所以不用处理这个条件
        if i > 0 then
          if Result = '' then
            Result := Result + Format(' and (A.DWDM=''%s''', [string(PItemData(CB_DW.Items.Objects[i])^.Value)])
          else
            Result := Result + Format(' or A.DWDM=''%s''', [string(PItemData(CB_DW.Items.Objects[i])^.Value)])
        else
          exit;}
    for i := 0 to CB_DW.Items.Count - 1 do
      if CB_DW.Checked[i] then
      begin
        if Result = '' then
          Result := Result + Format(' and (A.DWDM=''%s''', [string(PItemData(CB_DW.Items.Objects[i])^.Value)])
        else
          Result := Result + Format(' or A.DWDM=''%s''', [string(PItemData(CB_DW.Items.Objects[i])^.Value)])
      end;
//2002-03-08 end
    if Result <> '' then
      Result := Result + ')';
  end;

const
  QuerySQL = 'select %s,sum(nvl(A.DEY,0)) 定额元 from TY_TXPDESJB A,TGS_GXDWSJB B where A.DWDM=B.DWDM(+)';
var
  FChartSeries: TChartSeries;
  CondND: string;
  CondDW: string;
  GroupBy: string;
  Cap: string;
  i, X: integer;
begin
  //建立统计图类
  FChartSeries := nil;
  if RB_Zhu.Checked then
  begin
    FChartSeries := TBarSeries.Create(Self);
    with TBarSeries(FChartSeries) do
    begin
      BarWidthPercent := 100;
    end;
  end
  else if RB_Bing.Checked then
    FChartSeries := TPieSeries.Create(Self)
  else if RB_Zhe.Checked then
    FChartSeries := TLineSeries.Create(Self)
  else if RB_Biao.Checked then
  begin
    Chart1.Visible := false;
    DBGrid1.Visible := true;
  end;
  Panel_Tl.Visible := RB_Zhu.Checked;
  if FChartSeries <> nil then
  begin
    Chart1.Visible := true;
    DBGrid1.Visible := false;
    Chart1.SeriesList.Clear;
    if not RB_Bing.Checked then
      FChartSeries.OnGetMarkText := DoOnGetMarkText;
    Chart1.AxisVisible := true;
    Chart1.Title.Text.Clear;
    Chart1.AllowZoom := true;
    Chart1.AllowPanning := pmBoth;
    Chart1.View3DOptions.Orthogonal := true;
    Chart1.UndoZoom;
    if RB_2D.Checked then
      Chart1.View3D := false
    else
      Chart1.View3D := true;
    FChartSeries.ParentChart := Chart1;
    FChartSeries.Marks.Font.Name := '宋体';
    FChartSeries.Marks.Font.Size := 9;
  end;

  CondND := GetCondND;
  CondDW := GetCondDW;
  GroupBy := GetGroupBy;

  Query1.Close;
  Query1.SQL.Clear;
  Query1.SQL.Add(Format(QuerySQL, [GetField]));
  if CondND <> '' then
    Query1.SQL.Add(CondND);
  if CondDW <> '' then
    Query1.SQL.Add(CondDW);
  if GroupBy <> '' then
    Query1.SQL.Add(GroupBy);
  Query1.Open;

  //画统计图
  if FChartSeries <> nil then
  begin
    if RB_Zhe.Checked and (Query1.RecordCount < 2) then
    begin
      MessageBox(Handle, '现在的设置不适合做折线统计图,请用其它方式进行统计。', '统计分析', MB_ICONWARNING);
      exit;
    end;
    if RB_Bing.Checked then
      FChartSeries.ColorEachPoint := true;
    X := 0;
    while not Query1.Eof do
    begin
      for i := 1 to 1 do
      begin
        if i > 1 then
          Cap := ''
        else
          Cap := Query1.Fields[0].AsString;
        if RB_Bing.Checked then
          FChartSeries.AddXY(X, Query1.Fields[i].AsFloat, Cap)
        else
          FChartSeries.AddXY(X, Query1.Fields[i].AsFloat, Cap, clBlue);
        X := X + 1;
      end;
      //以柱状形势统计时,在各单位或年度之间留空列
      if RB_Zhu.Checked then
        X := X + Spacing;
      Query1.Next;
    end;
  end;
end;

procedure TFrmz_txdetjfx.DoOnGetMarkText(Sender: TChartSeries;
  ValueIndex: Integer; var MarkText: string);
begin
  MarkText := FormatFloat('#,##0.###', Sender.YValue[ValueIndex]);
end;

procedure TFrmz_txdetjfx.RB_NDClick(Sender: TObject);
begin
  CB_ND.Enabled := RB_ND.Checked;
  CB_DW.Enabled := RB_DW.Checked;
end;

procedure TFrmz_txdetjfx.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  SaveAllColWidth(Self);
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -