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

📄 jm_ydqktjfx.pas

📁 省级集邮品管理ERP
💻 PAS
字号:
{*******************************************************}
{                                                       }
{                       预订情况分析                    }
{                                                       }
{            中软金马公司版权所有。2002.12前            }
{                                                       }
{            编制:中软金马邮资票品项目开发组           }
{                                                       }
{                                                       }
{*******************************************************}
(*
本模块在地市集邮票管理里面调用。

*)
unit JM_YDQKTJFX;

interface

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

type
  TFrm_YDQKTJFX = class(TForm)
    Panel1: TPanel;
    XttxTitle: TRxLabel;
    GroupBox1: TGroupBox;
    Label2: TLabel;
    Label3: TLabel;
    GroupBox3: TGroupBox;
    RB_2D: TRadioButton;
    RB_3D: TRadioButton;
    BBt_Send: TBitBtn;
    BBt_Quit: TBitBtn;
    GroupBox4: TGroupBox;
    RB_Zhu: TRadioButton;
    RB_Bing: TRadioButton;
    Label1: TLabel;
    CB_ND: TCheckComboBox;
    Label4: TLabel;
    RB_Zhe: TRadioButton;
    RB_Hzxx: TRadioButton;
    RB_Gbdw: TRadioButton;
    CB_DW: TCheckComboBox;
    ScrollBox1: TScrollBox;
    Chart1: TChart;
    Panel_Tl: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    Panel7: TPanel;
    Panel5: TPanel;
    Panel6: TPanel;
    RB_Biao: TRadioButton;
    Query1: TQuery;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    RG_Tjx: TRadioGroup;
    procedure FormCreate(Sender: TObject);
    procedure BBt_SendClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    procedure DoOnGetMarkText(Sender: TChartSeries; ValueIndex: Longint; var MarkText: string);
  public
    { Public declarations }
  end;

var
  Frm_YDQKTJFX: TFrm_YDQKTJFX;

implementation

uses
  datas,pub;

{$R *.DFM}

type
  TFieldData = record
    Title: string;
    Color: TColor;
  end;

const
  FieldNum = 5;
  Spacing = 2;
  FieldInfo: array[0..FieldNum - 1] of TFieldData =
    ((Title: '预定户数(户)'; Color: clRed),
    (Title: '邮票(张)'; Color: clBlue),
    (Title: '型张(套)'; Color: clGreen),
    (Title: '金箔张(套)'; Color: clYellow),
    (Title: '小本票(套)'; Color: clFuchsia)
    );

procedure TFrm_YDQKTJFX.FormCreate(Sender: TObject);
begin
  InitDataList(CB_DW.Items, data.DM.DatabaseName,
    'select DWMC,DWDM from TO_GXDWSJB order by DWDM');
  if CB_DW.Items.Count > 0 then
  begin
    CB_DW.Items.Insert(0, '全部');
  end;
  InitDataList(CB_ND.Items, data.DM.DatabaseName,
    'select distinct ND from TM_YDQKTJB order by ND');
  if CB_ND.Items.Count > 0 then
  begin
    CB_ND.Items.Insert(0, '全部');
  end;
  Caption := application.Title;
end;

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

procedure TFrm_YDQKTJFX.BBt_SendClick(Sender: TObject);

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

  function GetCondDW: string;
  var
    i: integer;
  begin
    Result := '';
    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;
    if Result <> '' then
      Result := Result + ')';
  end;

const
  //个别单位
  QuerySQL = 'select B.DWMC 单位名称,A.YDHS 预定户数,A.YPSL 邮票张数,A.XZSL 型张套数,A.JBSL 金箔张套数,A.XBSL 小本票套数 from TM_YDQKTJB A,TO_GXDWSJB B where A.DWDM=B.DWDM(+)';
  //汇总
  TotalSQL = 'select A.ND||''年'' 年度,sum(nvl(A.YDHS,0)) 预定户数,sum(nvl(A.YPSL,0)) 邮票张数,sum(nvl(A.XZSL,0)) 型张套数,sum(nvl(A.JBSL,0)) 金箔张套数,sum(nvl(A.XBSL,0)) 小本票套数 from TM_YDQKTJB A'#13#10 +
    'where 1=1';
  TotalGroupBy = 'group by A.ND';
var
  FChartSeries: TChartSeries;
  CondND: string;
  CondDW: string;
  Cap: string;
  i, X, FieldStart, FieldEnd: integer;
  OnlyOne: boolean;
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;
    if RB_Bing.Checked or RB_Zhe.Checked then
    begin
      FieldStart := RG_Tjx.ItemIndex + 1;
      FieldEnd := FieldStart;
    end else
    begin
      FieldStart := 1;
      FieldEnd := FieldNum;
    end;
    if RB_Bing.Checked then
      FChartSeries.ColorEachPoint := true;
  end;
  OnlyOne := false;
  CondND := GetCondND;
  CondDW := GetCondDW;
  Query1.Close;
  Query1.SQL.Clear;
  //一个年度
  if (CB_ND.CheckCount = 1) and (CB_ND.FirsrtSelectedIndex > 0) then
  begin
    if RB_Zhe.Checked then
    begin
      CHQMsgBox('现在的设置不适合做折线统计图,请用其它方式进行统计。');
      exit;
    end;
    //个别单位
    if RB_Gbdw.Checked then
    begin
      Query1.SQL.Add(QuerySQL);
      if CondND <> '' then
        Query1.SQL.Add(CondND);
      if CondDW <> '' then
        Query1.SQL.Add(CondDW);
      Query1.Open;
    end else
    //汇总信息
    begin
      Query1.SQL.Add(TotalSQL);
      if CondND <> '' then
        Query1.SQL.Add(CondND);
      if CondDW <> '' then
        Query1.SQL.Add(CondDW);
      Query1.SQL.Add(TotalGroupBy);
      Query1.Open;
    end;
    //如果只有一个年度并且一个单位,那么在饼图中不包含预定户数
    if (Query1.RecordCount = 1) and RB_Bing.Checked then
    begin
      FieldStart := 2;
      FieldEnd := FieldNum;
      OnlyOne := true;
    end;
  end else if CB_ND.CheckCount > 0 then
  //多个年度
  begin
{      //个别单位
        if RB_Gbdw.Checked then
        begin
        //一个单位
          if CB_DW.CheckCount = 1 then
          begin
          end else if CB_DW.CheckCount > 1 then
        //多个单位
          begin
          end
        end else}
      //汇总信息
    begin
      Query1.SQL.Add(TotalSQL);
      if CondND <> '' then
        Query1.SQL.Add(CondND);
      if CondDW <> '' then
        Query1.SQL.Add(CondDW);
      Query1.SQL.Add(TotalGroupBy);
      Query1.Open;
    end;
  end;
  //画统计图
  if FChartSeries <> nil then
  begin
    X := 0;
    while not Query1.Eof do
    begin
      for i := FieldStart to FieldEnd do
      begin
        if OnlyOne then Cap := FieldInfo[i - 1].Title
        else if i > FieldStart then Cap := ''
        else Cap := Query1.Fields[0].AsString;
        if RB_Bing.Checked and not OnlyOne then
          FChartSeries.AddXY(X, Query1.Fields[i].AsFloat, Cap)
        else
          FChartSeries.AddXY(X, Query1.Fields[i].AsFloat, Cap, FieldInfo[i - 1].Color);
        X := X + 1;
      end;
      //以柱状形势统计时,在各单位或年度之间留空列
      if RB_Zhu.Checked then
        X := X + Spacing;
      Query1.Next;
    end;
  end;
end;

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

end.

⌨️ 快捷键说明

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