chaingspbasefrm.pas

来自「群星医药系统源码」· PAS 代码 · 共 450 行

unit ChainGSPBaseFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Menus, ActnList, ModuleAction, TB2Dock, ImgList, IMainFrm,
  Buttons, RzButton, TB2Item, TB2Toolbar, DB, DBClient, MConnect, xBaseFrm,
  ckDBClient, ceGlobal, uDataTypes, DbFuncs, DataExportFrm, RepSelectFrm,
  StdCtrls, Mask, RzEdit, RzDBEdit, ComCtrls, RzDTP, RzDBDTP, DBCtrls;

type
  TRecState = (rsAll, rsDoNothing, rsAudited, rsCompleted, rsDoNothingAndAudited, rsAuditedAndCompleted);
  TFmChainGSPBase = class(TxBaseForm)
    TBDock2: TTBDock;
    TBDock4: TTBDock;
    TBDock3: TTBDock;
    TBDock1: TTBDock;
    Toolbar1: TTBToolbar;
    TBControlItem1: TTBControlItem;
    TBSeparatorItem4: TTBSeparatorItem;
    TBItem4: TTBItem;
    TBItem3: TTBItem;
    TBItem2: TTBItem;
    TBItem9: TTBItem;
    TBItem8: TTBItem;
    TBSeparatorItem1: TTBSeparatorItem;
    TBItem1: TTBItem;
    TBItem5: TTBItem;
    TBItem17: TTBItem;
    TBSeparatorItem3: TTBSeparatorItem;
    TBItem11: TTBItem;
    TBItem10: TTBItem;
    TBSeparatorItem5: TTBSeparatorItem;
    TBItem16: TTBItem;
    TBItem15: TTBItem;
    TBItem14: TTBItem;
    TBItem13: TTBItem;
    TBSeparatorItem2: TTBSeparatorItem;
    TBItem6: TTBItem;
    TBItem7: TTBItem;
    TBItem12: TTBItem;
    RzMenuToolbarButton1: TRzMenuToolbarButton;
    ImageList1: TImageList;
    TBBackground1: TTBBackground;
    ActionList1: TActionList;
    ActInsert: TModlAction;
    ActUpdate: TModlAction;
    ActDelete: TModlAction;
    ActAudit: TModlAction;
    ActRevert: TModlAction;
    ActQuery: TModlAction;
    ActPrint: TModlAction;
    ActDesignReport: TModlAction;
    ActImport: TModlAction;
    ActExport: TModlAction;
    ActViewMoney: TModlAction;
    ActBillDetail: TModlAction;
    ActAddSubItem: TAction;
    ActDelSubItem: TAction;
    ActSave: TAction;
    ActCancel: TAction;
    ActExit: TAction;
    ActFirst: TAction;
    ActPrior: TAction;
    ActNext: TAction;
    ActLast: TAction;
    ActRefresh: TAction;
    ActFieldLayout: TModlAction;
    ActDataExport: TModlAction;
    ActBillTurn: TModlAction;
    pMenuOthers: TPopupMenu;
    R1: TMenuItem;
    X1: TMenuItem;
    ImgPopMenu: TImageList;
    plMain: TPanel;
    cdsMain: TckClientDataSet;
    DCOMConnection1: TDCOMConnection;
    dsMain: TDataSource;
    procedure ActInsertExecute(Sender: TObject);
    procedure ActUpdateExecute(Sender: TObject);
    procedure ActDeleteExecute(Sender: TObject);
    procedure cdsMainBeforeDelete(DataSet: TDataSet);
    procedure cdsMainBeforeInsert(DataSet: TDataSet);
    procedure cdsMainAfterOpen(DataSet: TDataSet);
    procedure cdsMainBeforeEdit(DataSet: TDataSet);
    procedure ActSaveExecute(Sender: TObject);
    procedure ActCancelExecute(Sender: TObject);
    procedure ActFirstExecute(Sender: TObject);
    procedure ActPriorExecute(Sender: TObject);
    procedure ActNextExecute(Sender: TObject);
    procedure ActLastExecute(Sender: TObject);
    procedure ActRefreshExecute(Sender: TObject);
    procedure ActQueryExecute(Sender: TObject);
    procedure ActPrintExecute(Sender: TObject);
    procedure ActDataExportExecute(Sender: TObject);
    procedure ActExitExecute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure cdsMainBeforeOpen(DataSet: TDataSet);
    procedure ActAuditExecute(Sender: TObject);
  private
    { Private declarations }
    FCanInsert,FCanEdit,
    FCanAudit,FCanRevert: boolean;
    FMasterDataSet: TClientDataSet;
    FRecState: TRecState;
    procedure SetMasterDataSet(const Value: TClientDataSet);
    procedure SetCaption;
    procedure SetRecState(const Value: TRecState);
  protected
    { Public declarations }
    iFmMain:IMainForm;
    iClientID :integer;
    LogonInfo: PLogonInfo;
    LocSetting: PLocSetting;
    CdsFieldProPerty :TckClientDataSet;
    procedure SetDataControlState;   //如果数据控件的Tag为-2表示ReadOnly且Color为背景色
  public
    svrMain, SvrCommon: TDispatchConnection;
    EditMode: integer;   //数据集状态：0：浏览  1：修改  2：插入
    property  MasterDataSet: TClientDataSet read FMasterDataSet write SetMasterDataSet;
    property  RecState: TRecState read FRecState write SetRecState;
    function  GetBillNo(BillType: string): string;
    procedure CheckAudit(Audited: boolean);
    procedure CheckApprove(Approved: boolean);
    procedure CheckEditMode;
  end;

var
  FmChainGSPBase: TFmChainGSPBase;

implementation
uses  ShowProgress;

{$R *.dfm}

procedure TFmChainGSPBase.FormCreate(Sender: TObject);
begin
  inherited;
  CdsFieldProPerty := TckClientDataSet.Create(self);
  SetGressHint('正在登录到GSP管理服务器...');
  iFmMain:=Application.mainForm as iMainForm;
  LogonInfo := IFmMain.IFmMainEx.LogonInfo;
  LocSetting := IFmMain.IFmMainEx.GetLocSetting;
  SvrCommon := iFmMain.GetConnection(Handle,'','CommonSvr.CommonRDM');
  CdsFieldProPerty.RemoteServer := SvrCommon;
  CdsFieldProPerty.ProviderName := 'dspTemp';
  SetGressHint('读取用户操作权限...');
  IFmMain.SetActionStatus(ActionList1, hInstance, self.ClassName);
  iClientID:=IFmMain.IFmMainEx.ClientID;
  //记下相关权限
  FCanInsert := ActInsert.Enabled;
  FCanEdit := ActUpdate.Enabled;
  FCanAudit := ActAudit.Enabled;
  FCanRevert := ActRevert.Enabled;

  DefCaption := Caption;
end;

procedure TFmChainGSPBase.FormShow(Sender: TObject);
begin
  inherited;
  Color := FormBackColor;
  TbDock1.Color := FormBackColor;
  TbDock2.Color := FormBackColor;
  TbDock3.Color := FormBackColor;
  TbDock4.Color := FormBackColor;
  Toolbar1.Color := Color;
  SetDataControlState;
end;

procedure TFmChainGSPBase.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Action := caFree;
end;

procedure TFmChainGSPBase.ActInsertExecute(Sender: TObject);
begin
  if (not cdsMain.Active) or (cdsMain.State in dsEditModes) then Abort;
  EditMode := 2;
  SetCaption;
  cdsMain.Insert;
end;

procedure TFmChainGSPBase.ActUpdateExecute(Sender: TObject);
begin
  if (not cdsMain.Active) or cdsMain.IsEmpty or (cdsMain.State in dsEditModes) then Abort;
  EditMode := 1;
  SetCaption;
  cdsMain.Edit;
end;

procedure TFmChainGSPBase.ActDeleteExecute(Sender: TObject);
begin
  if (not cdsMain.Active) or cdsMain.IsEmpty or (cdsMain.State in dsEditModes) then Abort;
  cdsMain.Delete;
  //不马上提交，让用户有机会选择保存或取消修改
  ActSave.Enabled := true;
  ActCancel.Enabled := true;
end;

procedure TFmChainGSPBase.cdsMainBeforeOpen(DataSet: TDataSet);
begin
  if not ActQuery.Enabled then Abort;
end;

procedure TFmChainGSPBase.cdsMainBeforeDelete(DataSet: TDataSet);
begin
  if MessageBox(Handle,'确定要删除当前记录吗？','提示',MB_ICONQUESTION or MB_YESNO or MB_DEFBUTTON2) = IDNO then
    Abort;
end;

procedure TFmChainGSPBase.cdsMainBeforeInsert(DataSet: TDataSet);
begin
  if (not FCanInsert) or (EditMode <> 2) then
    Abort;
  ActSave.Enabled := true;
  ActCancel.Enabled := true;
  ActInsert.Enabled := false;
  ActUpdate.Enabled := false;
end;

procedure TFmChainGSPBase.cdsMainBeforeEdit(DataSet: TDataSet);
begin
  if (not FCanEdit) or (EditMode <> 1) then
    Abort;
  ActSave.Enabled := true;
  ActCancel.Enabled := true;
  ActInsert.Enabled := false;
  ActUpdate.Enabled := false;
end;

procedure TFmChainGSPBase.cdsMainAfterOpen(DataSet: TDataSet);
begin
  EditMode := 0;
  SetCaption;
end;

procedure TFmChainGSPBase.ActSaveExecute(Sender: TObject);
begin
  if not cdsMain.Active then exit;
  if cdsMain.State in dsEditModes then
    cdsMain.Post;
  if cdsMain.ApplyUpdates(0)>0 then
  begin
    MessageBox(Handle,'保存数据失败！',nil,MB_ICONEXCLAMATION);
    EditMode := 1;
    cdsMain.Edit;
  end
  else
  begin
    EditMode := 0;
    SetCaption;
    ActSave.Enabled :=false;
    ActCancel.Enabled := false;
    ActInsert.Enabled := FCanInsert;
    ActUpdate.Enabled := FCanEdit;
  end;
end;

procedure TFmChainGSPBase.ActCancelExecute(Sender: TObject);
begin
  if not cdsMain.Active then exit;
  if cdsMain.ChangeCount > 0 then
    if MessageBox(Handle,PChar(Format('共有%d项未保存的修改，确定要取消吗？',[cdsMain.ChangeCount])),'提示',MB_ICONQUESTION or MB_YESNO or MB_DEFBUTTON2)=IDNO then
      exit;
  cdsMain.CancelUpdates;
  EditMode := 0;
  SetCaption;
  ActSave.Enabled :=false;
  ActCancel.Enabled := false;
  ActInsert.Enabled := FCanInsert;
  ActUpdate.Enabled := FCanEdit;
end;

procedure TFmChainGSPBase.ActFirstExecute(Sender: TObject);
begin
  if not cdsMain.Active then exit;
  CheckEditMode;
  cdsMain.First;
  ActFirst.Enabled := false;
  ActPrior.Enabled := ActFirst.Enabled;
  ActLast.Enabled := true;
  ActNext.Enabled := true;
end;

procedure TFmChainGSPBase.ActPriorExecute(Sender: TObject);
begin
  if not cdsMain.Active then exit;
  CheckEditMode;
  cdsMain.Prior;
  ActFirst.Enabled := (cdsMain.RecordCount>0) and (not cdsMain.Bof);
  ActPrior.Enabled := ActFirst.Enabled;
  ActLast.Enabled := true;
  ActNext.Enabled := true;
end;

procedure TFmChainGSPBase.ActNextExecute(Sender: TObject);
begin
  if not cdsMain.Active then exit;
  CheckEditMode;
  cdsMain.Next;
  ActLast.Enabled := (cdsMain.RecordCount>0) and (not cdsMain.Eof);
  ActNext.Enabled := ActLast.Enabled;
  ActFirst.Enabled := true;
  ActPrior.Enabled := true;
end;

procedure TFmChainGSPBase.ActLastExecute(Sender: TObject);
begin
  if not cdsMain.Active then exit;
  CheckEditMode;
  cdsMain.Last;
  ActLast.Enabled := false;
  ActNext.Enabled := false;
  ActFirst.Enabled := true;
  ActPrior.Enabled := true;
end;

procedure TFmChainGSPBase.ActRefreshExecute(Sender: TObject);
begin
  CheckEditMode;
  if not cdsMain.Active then exit;
  if cdsMain.State in dsEditModes then
    cdsMain.Post;
  if cdsMain.ChangeCount > 0 then
    MessageBox(Handle,PChar(Format('共有%d项未保存的修改，请保存或取消后再刷新数据！',[cdsMain.ChangeCount])),'警告',MB_ICONEXCLAMATION)
  else
    cdsMain.Refresh;
  //数据刷新之后重设记录移动按钮
  ActFirst.Enabled := (cdsMain.RecordCount>0) and (not cdsMain.Bof);
  ActPrior.Enabled := ActFirst.Enabled;
  ActLast.Enabled := (cdsMain.RecordCount>0) and (not cdsMain.Eof);
  ActNext.Enabled := ActLast.Enabled;
end;

procedure TFmChainGSPBase.ActQueryExecute(Sender: TObject);
begin
  //查询
end;

procedure TFmChainGSPBase.ActPrintExecute(Sender: TObject);
begin
  //报表
  SelRepPrint(Self.Name,[cdsMain],Self.Caption,ActDesignReport.Enabled);
end;

procedure TFmChainGSPBase.ActDataExportExecute(Sender: TObject);
begin
  //导出数据
  ExportData([cdsMain], self.Caption, '');
end;

procedure TFmChainGSPBase.ActExitExecute(Sender: TObject);
begin
  close;
end;

procedure TFmChainGSPBase.SetMasterDataSet(const Value: TClientDataSet);
begin
  FMasterDataSet := Value;
end;

procedure TFmChainGSPBase.SetCaption;
begin
  case EditMode of
  0: Caption := DefCaption;
  1: Caption := DefCaption + '--修改';
  2: Caption := DefCaption + '--新增';
  end;
end;

function TFmChainGSPBase.GetBillNo(BillType: string): string;
begin
  Result := BuildBillNo(BillType);
end;

procedure TFmChainGSPBase.SetRecState(const Value: TRecState);
begin
  FRecState := Value;
end;

procedure TFmChainGSPBase.ActAuditExecute(Sender: TObject);
begin
  if (not cdsMain.Active) or cdsMain.IsEmpty then Abort;
  CheckEditMode;
end;

procedure TFmChainGSPBase.CheckAudit(Audited: boolean);
begin
  if Audited then
  begin
    MessageBox(Handle,'当前数据已审核！不能再修改。','警告',MB_ICONEXCLAMATION);
    Abort;
  end;
end;

procedure TFmChainGSPBase.CheckApprove(Approved: boolean);
begin
  if Approved then
  begin
    MessageBox(Handle,'当前数据已审批！不能再修改。','警告',MB_ICONEXCLAMATION);
    Abort;
  end;
end;

procedure TFmChainGSPBase.CheckEditMode;
begin
  if not cdsMain.Active then Abort;
  if (EditMode >0) or (cdsMain.State in dsEditModes) then
  begin
    MessageBox(Handle,'正在编辑数据！请保存或取消后再试','警告',MB_ICONEXCLAMATION);
    Abort;
  end;
end;

procedure TFmChainGSPBase.SetDataControlState;
var
  cm: TComponent;
  i : integer;
begin
  for i :=0 to Self.ComponentCount-1 do
  begin
    cm := Self.Components[i];
    if cm.Tag = -2 then
    begin
      if cm is TRzDBEdit then
      begin
        TRzDBEdit(cm).Color := Self.Color;
        TRzDBEdit(cm).FocusColor := Self.Color;
      end
      else if cm is TRzDBMemo then
      begin
        TRzDBMemo(cm).Color := Self.Color;
        TRzDBMemo(cm).FocusColor := self.Color;
      end
      else if cm is TRzDBDateTimePicker then
      begin
        TRzDBDateTimePicker(cm).Color := Self.Color;
        TRzDBDateTimePicker(cm).FocusColor := Self.Color;
      end;
    end;
  end;
end;

end.