xttxfs.pas

省级集邮品管理ERP

{*******************************************************}
{                                                       }
{                      通信设置                         }
{                                                       }
{            中软金马公司版权所有。2002.12前            }
{                                                       }
{            编制：中软金马邮资票品项目开发组           }
{                                                       }
{                                                       }
{*******************************************************}
(*
本模块在省级系统管理模块里面调用。

*)

unit xttxfs;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Db, DBTables, Grids, DBGrids, PostCommon, ActnList, StdCtrls, Mask,
  DBCtrls, ExtCtrls, RXCtrls, ImgList, Buttons,  CheckComboBox;

const
  //子系统代码
  Zxtdm: array[0..6] of string =
    (
    '', //全部
    'F', //发行
    'P', //印制局
    'Y', //计划
    'K', //库存
    'J', //结算
    'Q' //局长查询
    );
  DW_SEP = ',';

type
  PDwxx = ^TDwxx;
  TDwxx = record
    Dwdm: string;
    Dwmc: string;
  end;
  TxttxfsForm = class(TForm)
    Query1: TQuery;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    ActionList1: TActionList;
    Act_Save: TAction;
    Act_Cancel: TAction;
    Act_Exit: TAction;
    GroupBox1: TGroupBox;
    CB_JSDW: TCheckComboBox;
    CB_BMFSDW: TCheckComboBox;
    Label4: TLabel;
    Label5: TLabel;
    Panel1: TPanel;
    ImageList1: TImageList;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    Query1CSDM: TStringField;
    Query1ZXTDM: TStringField;
    Query1CSMC: TStringField;
    Query1JSDWDM: TMemoField;
    Query1JSDWMC: TMemoField;
    Query1BMFSDWDM: TMemoField;
    Query1BMFSDWMC: TMemoField;
    Label1: TLabel;
    DBEdit1: TDBEdit;
    Label3: TLabel;
    DBEdit2: TDBEdit;
    DCB_Zxtdm: TComboBox;
    Panel11: TPanel;
    RxLabel1: TRxLabel;
    DWMC: TLabel;
    Panel2: TPanel;
    Label2: TLabel;
    procedure Query1NewRecord(DataSet: TDataSet);
    procedure Act_SaveExecute(Sender: TObject);
    procedure Act_CancelExecute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure CB_JSDWClickOk(Sender: TObject);
    procedure Query1AfterScroll(DataSet: TDataSet);
    procedure CB_BMFSDWClickOk(Sender: TObject);
    procedure DCB_ZxtdmClick(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Act_ExitExecute(Sender: TObject);
    procedure Query1JSDWDMGetText(Sender: TField; var Text: string;
      DisplayText: Boolean);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure DBEdit1KeyPress(Sender: TObject; var Key: Char);
    procedure DBEdit2KeyPress(Sender: TObject; var Key: Char);
    procedure FormShow(Sender: TObject);
  private
    FDatabase: TDatabase;
    FDwxxList: TList;
    FDataChanged: boolean;
    procedure SetDataChanged(const Value: boolean);
    procedure ClearDwxxList;
    procedure InitDwxxList;
    procedure AssignDwmcTo(const AStrings: TStrings);
    function GetDwdm(const Dwmc: string): string;
    function GetDwmc(const Dwdm: string): string;
    function GetDwdms(const Dwmcs: string): string;
    function GetDwmcs(const Dwdms: string): string;
//    function GetZxtmc(const dm: string): string;
    function CheckChanged: boolean;
  public
    function xttxExecute(const ADB: TDatabase): boolean;

    property DataChanged: boolean read FDataChanged write SetDataChanged;
  end;

var
  xttxfsForm: TxttxfsForm;

implementation

uses datas, Pub;

{$R *.DFM}

procedure TxttxfsForm.SetDataChanged(const Value: boolean);
begin
  FDataChanged := Value;
  Act_Save.Enabled := Value;
  Act_Cancel.Enabled := Value;
end;

procedure TxttxfsForm.Query1NewRecord(DataSet: TDataSet);
begin
  DataSet.Cancel;
end;

procedure TxttxfsForm.Act_SaveExecute(Sender: TObject);
var
  vl_s_csdm: string;
begin
  vl_s_csdm := Query1.FieldByName('CSDM').AsString;
  if DBSave(FDatabase, [Query1]) then
  begin
    Query1.Close;
    Query1.Open;
    Query1.Locate('CSDM', vl_s_csdm, []);
    DataChanged := false
  end else
    CHQMsgBox('数据访问错误！');
end;

procedure TxttxfsForm.Act_CancelExecute(Sender: TObject);
begin
//  if AnswerYesOrNo('撤消', '真的要撤消上次保存之后所做的修改吗？') = atYes then
    if DBCancel(FDatabase, [Query1]) then
    begin
      Query1AfterScroll(Query1);
      DataChanged := false;
    end;
end;

procedure TxttxfsForm.FormCreate(Sender: TObject);
begin
  FDwxxList := TList.Create;
end;

function TxttxfsForm.xttxExecute(const ADB: TDatabase): boolean;
begin
  result := false;
  FDatabase := ADB;
  Caption := CYZPPTIT;
  DWMC.Caption := '使用单位：' + VG_UnitName;
  try
    InitDwxxList;
    Query1.Close;
    Query1.ParamByName('ZXTDM').AsString := '';
    Query1.DatabaseName := FDatabase.DatabaseName;
    Query1.Open;
    DCB_Zxtdm.ItemIndex := 0;
    DataChanged := false;
    result := true;
  except
    CHQMsgBox('不能打开 <系统通讯发送功能表> ！');
  end;
end;

procedure TxttxfsForm.FormDestroy(Sender: TObject);
begin
  ClearDwxxList;
  FDwxxList.Free;
end;

procedure TxttxfsForm.InitDwxxList;
const
  DwdmFieldName = 'DWDM';
  DwmcFieldName = 'DWJC';
  QuerySQL = 'SELECT DISTINCT DWDM, DWJC, PXM FROM TGS_GXDWSJB'#13#10 +
    'WHERE ZJXJ=''1'' ORDER BY PXM';   //   DWDM not like ''-%''
{  QuerySQL = 'SELECT DISTINCT DWDM, DWJC, PXM FROM TGS_GXDWSJB'#13#10 +
    'where DWDM not like ''-%'' ORDER BY PXM'; }
var
  DwxxData: PDwxx;
begin
  with TQuery.Create(nil) do
  try
    DatabaseName := FDatabase.DatabaseName;
    SQL.Add(QuerySQL);
    Open;
    First;
    ClearDwxxList;
    while not Eof do
    begin
      New(DwxxData);
      DwxxData^.Dwdm := FieldValues[DwdmFieldName];
      DwxxData^.Dwmc := FieldValues[DwmcFieldName];
      FDwxxList.Add(DwxxData);
      Next;
    end;
  finally
    Free;
  end;
  AssignDwmcTo(CB_JSDW.Items);
  AssignDwmcTo(CB_BMFSDW.Items);
end;

procedure TxttxfsForm.ClearDwxxList;
var
  i: integer;
begin
  for i := 0 to FDwxxList.Count - 1 do
    if Assigned(FDwxxList[i]) then Dispose(FDwxxList[i]);
//  FDwxxList.Clear;
end;

procedure TxttxfsForm.AssignDwmcTo(const AStrings: TStrings);
var
  i: integer;
begin
  AStrings.Clear;
  for i := 0 to FDwxxList.Count - 1 do
    if Assigned(FDwxxList[i]) then AStrings.Add(PDwxx(FDwxxList[i])^.Dwmc);
end;

function TxttxfsForm.GetDwdm(const Dwmc: string): string;
var
  i: integer;
begin
  if Assigned(FDwxxList) then
    for i := 0 to FDwxxList.Count - 1 do
      if Assigned(FDwxxList[i]) and (PDwxx(FDwxxList[i])^.Dwmc = Dwmc) then
      begin
        Result := PDwxx(FDwxxList[i])^.Dwdm;
        exit;
      end;
  Result := '';
end;

function TxttxfsForm.GetDwmc(const Dwdm: string): string;
var
  i: integer;
begin
  if Assigned(FDwxxList) then
    for i := 0 to FDwxxList.Count - 1 do
      if Assigned(FDwxxList[i]) and (PDwxx(FDwxxList[i])^.Dwdm = Dwdm) then
      begin
        Result := PDwxx(FDwxxList[i])^.Dwmc;
        exit;
      end;
  Result := '';
end;

function TxttxfsForm.GetDwdms(const Dwmcs: string): string;
var
  i: integer;
  DwmcList: TStringList;
  buf, Dm: string;
begin
  DwmcList := TStringList.Create;
  buf := '';
  try
    SplitStr(Dwmcs, DwmcList, DW_SEP);
    for i := 0 to DwmcList.Count - 1 do
    begin
      Dm := GetDwdm(DwmcList[i]);
      if Dm <> '' then
      begin
        buf := buf + Dm;
        if i < DwmcList.Count - 1 then buf := buf + DW_SEP;
      end;
    end;
    Result := buf;
  finally
    DwmcList.Free;
  end;
end;

function TxttxfsForm.GetDwmcs(const Dwdms: string): string;
var
  i: integer;
  DwdmList: TStringList;
  buf, Mc: string;
begin
  DwdmList := TStringList.Create;
  buf := '';
  try
    SplitStr(Dwdms, DwdmList, DW_SEP);
    for i := 0 to DwdmList.Count - 1 do
    begin
      Mc := GetDwmc(DwdmList[i]);
      if Mc <> '' then
      begin
        buf := buf + Mc;
        if i < DwdmList.Count - 1 then buf := buf + DW_SEP;
      end;
    end;
    Result := buf;
  finally
    DwdmList.Free;
  end;
end;

procedure TxttxfsForm.CB_JSDWClickOk(Sender: TObject);
var
  jsdwmc: string;
begin
  with Query1 do
  try
    Edit;
    jsdwmc := CB_JSDW.GetSelectedText(DW_SEP);
    FieldValues['JSDWDM'] := GetDwdms(jsdwmc);
    FieldValues['JSDWMC'] := jsdwmc;
    DataChanged := true;
  except
    CHQMsgBox('修改 <接收单位代码> 出错 ！');
  end;
end;

procedure TxttxfsForm.Query1AfterScroll(DataSet: TDataSet);
var
  Zxtdm, Jsdwdm, Bmfsdwdm: string;
begin
  try
    Zxtdm := DataSet['ZXTDM'];
  except
    Zxtdm := '';
  end;
  try
    Jsdwdm := DataSet['JSDWDM'];
  except
    Jsdwdm := '';
  end;
  try
    Bmfsdwdm := DataSet['BMFSDWDM'];
  except
    Bmfsdwdm := '';
  end;
  CB_JSDW.SetSelectedText(GetDwmcs(Jsdwdm), DW_SEP);
  CB_BMFSDW.SetSelectedText(GetDwmcs(Bmfsdwdm), DW_SEP);
end;

procedure TxttxfsForm.CB_BMFSDWClickOk(Sender: TObject);
var
  BMFSdwmc: string;
begin
  with Query1 do
  try
    Edit;
    BMFSdwmc := CB_BMFSDW.GetSelectedText(DW_SEP);
    FieldValues['BMFSDWDM'] := GetDwdms(BMFSdwmc);
    FieldValues['BMFSDWMC'] := BMFSdwmc;
    DataChanged := true;
  except
    CHQMsgBox('修改 <避免发送单位代码> 出错 ！');
  end;
end;

procedure TxttxfsForm.DCB_ZxtdmClick(Sender: TObject);
var
  i, Index: integer;
  dm: string;
begin
  try
    Index := -1;
    if DCB_Zxtdm.Text <> '' then
    begin
      for i := 0 to DCB_Zxtdm.Items.Count - 1 do
        if DCB_Zxtdm.Items[i] = DCB_Zxtdm.Text then
        begin
          Index := i;
          break;
        end;
    end;
  except
    Index := -1;
  end;
  if Index >= 0 then
  begin
    dm := Zxtdm[Index];
    with Query1 do
    begin
      Close;
      ParamByName('ZXTDM').AsString := dm;
      Open;
    end
  end else
    CHQMsgBox('没有这个子系统 ！');
end;

{function TxttxfsForm.GetZxtmc(const dm: string): string;
var
  i: integer;
  Found: boolean;
begin
  Found := false;
  for i := 0 to High(Zxtdm) do
    if Zxtdm[i] = dm then
    begin
      Found := true;
      break;
    end;
  if Found then
    Result := DCB_Zxtdm.Items[i];
end;
}
procedure TxttxfsForm.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key=VK_RETURN then
  begin
    if ((Sender as TCustomForm).activecontrol is TMEMO) THEN //or (self.activecontrol is TDBGRid) then
    else
    begin
      postmessage((Sender as TWinControl).handle,WM_KEYDOWN,9,0);
      postmessage((Sender as TWinControl).handle,WM_KEYUP,9,0);
    end;
  end;

end;

procedure TxttxfsForm.Act_ExitExecute(Sender: TObject);
begin
  Close;
end;

procedure TxttxfsForm.Query1JSDWDMGetText(Sender: TField; var Text: string;
  DisplayText: Boolean);
begin
  Text := Sender.AsString;
end;

function TxttxfsForm.CheckChanged: boolean;
var
  rt: TAnswerType;
begin
  Result := true;
  if DataChanged then
  begin
    rt := AnswerYesOrNo('保存', '是否保存所做的修改？');
    if rt = atYes then
      Act_SaveExecute(nil);
    Result := (rt <> atCancel);
  end;
end;

procedure TxttxfsForm.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  CanClose := CheckChanged;
end;

procedure TxttxfsForm.DBEdit1KeyPress(Sender: TObject; var Key: Char);
begin
  DataChanged := true;
end;

procedure TxttxfsForm.DBEdit2KeyPress(Sender: TObject; var Key: Char);
begin
  DataChanged := true;
end;

procedure TxttxfsForm.FormShow(Sender: TObject);
begin
  DBGrid1.SetFocus;
end;

end.