cebasebillfrm.pas

来自「医药连锁经营管理系统源码」· PAS 代码 · 共 463 行

PAS
463
字号
unit ceBaseBillFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, xBaseFrm, ImgList, TB2Item, TB2Dock, TB2Toolbar, ExtCtrls, ActnList,
  RzCommon, RzPanel, ceGlobal, IMainFrm, ModuleAction, DB, DBClient, Menus,
  Buttons, RzButton, uDataTypes;

type
  TceBaseBillForm = class(TxBaseForm)
    TBDock1: TTBDock;
    TBDock2: TTBDock;
    TBDock3: TTBDock;
    TBDock4: TTBDock;
    TBBackground1: TTBBackground;
    Toolbar1: TTBToolbar;
    ImageList1: TImageList;
    ActionList1: TActionList;
    plBoard: TRzPanel;
    plHeader: TRzPanel;
    plBody: TRzPanel;
    plFooter: TRzPanel;
    ActInsert: TModlAction;
    ActUpdate: TModlAction;
    ActDelete: TModlAction;
    ActAudit: TModlAction;
    ActRevert: TModlAction;
    ActViewMoney: TModlAction;
    ActQuery: TModlAction;
    ActPrint: TModlAction;
    ActBillDetail: TModlAction;
    ActExport: TModlAction;
    ActImport: TModlAction;
    ActAddSubItem: TAction;
    ActDelSubItem: TAction;
    ActSave: TAction;
    ActCancel: TAction;
    ActExit: TAction;
    ActFirst: TAction;
    ActPrior: TAction;
    ActNext: TAction;
    ActLast: TAction;
    ActRefresh: TAction;
    TBItem1: TTBItem;
    TBItem2: TTBItem;
    TBItem3: TTBItem;
    TBItem4: TTBItem;
    TBSeparatorItem1: TTBSeparatorItem;
    TBItem5: TTBItem;
    TBItem6: TTBItem;
    TBSeparatorItem2: TTBSeparatorItem;
    TBItem7: TTBItem;
    TBItem8: TTBItem;
    TBItem9: TTBItem;
    TBSeparatorItem3: TTBSeparatorItem;
    TBItem10: TTBItem;
    TBItem11: TTBItem;
    TBSeparatorItem4: TTBSeparatorItem;
    TBItem12: TTBItem;
    TBControlItem1: TTBControlItem;
    RzMenuToolbarButton1: TRzMenuToolbarButton;
    pMenuOthers: TPopupMenu;
    ImgPopMenu: TImageList;
    ActDesignReport: TModlAction;
    ActFieldLayout: TModlAction;
    ActDataExport: TModlAction;
    L1: TMenuItem;
    X1: TMenuItem;
    R1: TMenuItem;
    TBItem17: TTBItem;
    ActBillTurn: TModlAction;
    procedure FormCreate(Sender: TObject);
    procedure ActExitExecute(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ActInsertExecute(Sender: TObject);
    procedure ActUpdateExecute(Sender: TObject);
    procedure ActDeleteExecute(Sender: TObject);
    procedure ActSaveExecute(Sender: TObject);
    procedure ActCancelExecute(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Toolbar1DockChanged(Sender: TObject);
    procedure ActFirstExecute(Sender: TObject);
    procedure ActPriorExecute(Sender: TObject);
    procedure ActNextExecute(Sender: TObject);
    procedure ActLastExecute(Sender: TObject);
    procedure ActRefreshExecute(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure pmAutoFetchDetailClick(Sender: TObject);
    procedure ActPrintExecute(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ActAuditExecute(Sender: TObject);
    procedure ActRevertExecute(Sender: TObject);
    procedure ActAddSubItemExecute(Sender: TObject);
    procedure ActDelSubItemExecute(Sender: TObject);
  private
    FMasterDataSet: TClientDataSet;
    procedure SetMasterDataSet(DataSet: TClientDataSet);
    procedure WMSysCommand(var Msg: TWMSysCommand);message WM_SYSCOMMAND;
  protected
    IFmMain: IMainForm;
    LogonInfo: PLogonInfo;
    sBillNoList: TStrings;
    BillNoField: TField;
    BillType, sRepSection, RepDataSetNames: String;
  	FEditMode : integer;//单据编辑状态0:正常浏览,1:新单,2:修改
    FDetailDataSets: Array of TClientDataSet;
    LocSetting: PLocSetting;
    procedure SetCurrBillNo(BillNo: String); virtual;
    procedure SetCurrBillIdx(BillIndex: Integer); virtual;
    procedure SetEditMode(nMode: Byte); virtual;
    procedure RefreshNavState;
    procedure CheckBillCanModify;
  public
    function IsEditing(CanCancel: Boolean=false): Boolean;
    property MasterDataSet: TClientDataSet read FMasterDataSet write SetMasterDataSet;
  end;

var
  ceBaseBillForm: TceBaseBillForm;

implementation

uses RepSelectFrm;

{$R *.dfm}

procedure TceBaseBillForm.FormCreate(Sender: TObject);
begin
  inherited;
  IFmMain := Application.MainForm as IMainForm;
  LogonInfo := IFmMain.IFmMainEx.LogonInfo;
  LocSetting := IFmMain.IFmMainEx.GetLocSetting;
  sBillNoList:= TStringList.Create;
  Color := FormBackColor;
  TbDock1.Color := FormBackColor;
  TbDock2.Color := FormBackColor;
  TbDock3.Color := FormBackColor;
  TbDock4.Color := FormBackColor;
  ToolBar1.Color := FormBackColor;
end;

procedure TceBaseBillForm.FormShow(Sender: TObject);
begin
  inherited;
  SetEditMode(0);
end;

procedure TceBaseBillForm.ActExitExecute(Sender: TObject);
begin
  Close;
end;

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

procedure TceBaseBillForm.FormDestroy(Sender: TObject);
begin
  inherited;
  sBillNoList.Free;
end;

procedure TceBaseBillForm.SetEditMode(nMode: Byte);
var bEdit: Boolean;
//    str: String;
begin
	FEditMode := nMode;
  if DefCaption<>'' then begin
    case FEditMode of
      0: Caption := DefCaption;
      1: Caption := DefCaption+' -- 新增';
      2: Caption := DefCaption+' -- 修改';
    end;
  end;
	bEdit := FEditMode>0;
  xSetAllReadOnly(plBoard, not bEdit, true);
  if ActBillDetail.Enabled then begin
    ActAddSubItem.Enabled := bEdit;
    ActDelSubItem.Enabled := bEdit;
  end;
end;

function TceBaseBillForm.IsEditing(CanCancel: Boolean): Boolean;
begin
	Result := FEditMode>0;
	if Result then begin
  	if CanCancel then begin
    	if (Application.MessageBox('当前正处于编辑状态,放弃对单据的修改吗?', '单据编辑', MB_YESNO+MB_ICONINFORMATION)=IDYES) then begin
	    	ActCancel.Execute;
  	    Result := FEditMode>0;
      end;
    end else
      Application.MessageBox('当前正处于编辑状态,请先保存或取消单据修改!', '单据编辑', MB_OK+MB_ICONWARNING);
  end;
end;

procedure TceBaseBillForm.ActInsertExecute(Sender: TObject);
begin
  if IsEditing then Exit;
  SetEditMode(1);
  FMasterDataSet.Append;
end;

procedure TceBaseBillForm.ActUpdateExecute(Sender: TObject);
begin
  if FMasterDataSet.IsEmpty or IsEditing then Exit;
  if FMasterDataSet.FieldByName('Transfer').AsBoolean then Begin
    Messagebox(Handle,Pchar('当前单据已[审核],不能执行修改操作!'),'警告',64);
    Exit;
  end;
  CheckBillCanModify;
  SetEditMode(2);          // 先设为读写状态是为了能使DBGRID的TabASEnter有效
  FMasterDataSet.Edit;     //
end;

procedure TceBaseBillForm.ActDeleteExecute(Sender: TObject);
var str: String;
    i: integer;
begin
  if IsEditing or FMasterDataSet.IsEmpty then Exit;
  if FMasterDataSet.FieldByName('Transfer').AsBoolean then Begin
    Messagebox(Handle,Pchar('当前单据已[审核],不能执行删除操作!'),'警告',64);
    Exit;
  end;
  CheckBillCanModify;
  if Application.MessageBox('确实要删除当前数据吗?','提示',4+32)<>6 then Exit;
  str := BillNoField.AsString;
  FMasterDataSet.Delete;
  If FMasterDataSet.ApplyUpdates(0)>0 Then
    Messagebox(Handle,'提交数据失败!','错误',16)
  else begin
    i := sBillNoList.IndexOf(str);
    if i>=0 then sBillNoList.Delete(i);
    SetCurrBillIdx(i);
  end;
  SetEditMode(0);
end;

procedure TceBaseBillForm.ActSaveExecute(Sender: TObject);
var str: String;
    b1: Boolean;
begin
  if FEditMode=0 then Exit;
  str := BillNoField.AsString;
  if FMasterDataSet.State in dsEditModes then
    FMasterDataSet.Post;
  If FMasterDataSet.ApplyUpdates(0)>0 then
  begin
    FMasterDataSet.Edit;
    Messagebox(Handle,'提交数据失败!',nil,16);
    Exit;
  end else begin
    b1 := FEditMode=1;
    SetEditMode(0);
    if b1 then begin//新增
      sBillNoList.Add(str);
      if FMasterDataSet.Params.Count>0 then
        FMasterDataSet.Params[0].Value := str;
      RefreshNavState;
    end;
    //FMasterDataSet.RefreshRecord;  使用此语句会出现“记录未找到或者被其它用户改变”的错误
  end;
end;

procedure TceBaseBillForm.ActCancelExecute(Sender: TObject);
begin
  if (FEditMode=0)or(MessageBox(Handle,'确实要取消当前的操作吗?','提示',4+32)<>6) Then
    Exit;
  FMasterDataSet.Cancel;
  FMasterDataSet.CancelUpdates;
  SetEditMode(0);
end;

procedure TceBaseBillForm.WMSysCommand(var Msg: TWMSysCommand);
begin
{  if (Msg.CmdType = SC_RESTORE) or
     (Msg.CmdType = SC_MAXIMIZE) then}
  Inherited;
end;

procedure TceBaseBillForm.Toolbar1DockChanged(Sender: TObject);
begin
  if Toolbar1.CurrentDock=TbDock2 then
    plBoard.BorderSides := plBoard.BorderSides+[sdBottom]
  else
    plBoard.BorderSides := plBoard.BorderSides-[sdBottom];
end;

procedure TceBaseBillForm.RefreshNavState;
var i, k: Integer;
begin
  if BillNoField=nil then
    BillNoField := FMasterDataSet.FindField('BillNo');
  if (FEditMode=0)and(FMasterDataSet<>nil) then begin
    k := sBillNoList.Count-1;
    i := sBillNoList.IndexOf(BillNoField.AsString);
    ActFirst.Enabled := i>0;
    ActPrior.Enabled := i>0;
    ActNext.Enabled  := i<k;
    ActLast.Enabled  := i<k;
  end;
end;

procedure TceBaseBillForm.ActFirstExecute(Sender: TObject);
begin
  if FEditMode=0 then begin
    if sBillNoList.Count>1 then
      SetCurrBillIdx(0)
    else if FMasterDataSet.RecordCount>1 then
      FMasterDataSet.First;
  end;
end;

procedure TceBaseBillForm.ActPriorExecute(Sender: TObject);
begin
  if FEditMode=0 then
    if sBillNoList.Count>1 then
      SetCurrBillIdx(sBillNoList.IndexOf(BillNoField.AsString)-1)
    else if FMasterDataSet.RecordCount>1 then
      FMasterDataSet.Prior;
end;

procedure TceBaseBillForm.ActNextExecute(Sender: TObject);
begin
  if FEditMode=0 then
    if sBillNoList.Count>1 then
      SetCurrBillIdx(sBillNoList.IndexOf(BillNoField.AsString)+1)
    else if FMasterDataSet.RecordCount>1 then
      FMasterDataSet.next;
end;

procedure TceBaseBillForm.ActLastExecute(Sender: TObject);
begin
  if FEditMode=0 then
    if sBillNoList.Count>1 then
      SetCurrBillIdx(sBillNoList.Count-1)
    else if FMasterDataSet.RecordCount>1 then
      FMasterDataSet.Last;
end;

procedure TceBaseBillForm.ActRefreshExecute(Sender: TObject);
begin
  if (FEditMode=0)and(FMasterDataSet<>nil) then begin
//    FMasterDataSet.Refresh;
    FMasterDataSet.Close;
    FMasterDataSet.Open;
  end;
end;

procedure TceBaseBillForm.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  CanClose := not IsEditing(true);
end;

procedure TceBaseBillForm.pmAutoFetchDetailClick(Sender: TObject);
begin
  if Sender is TMenuItem then
    TMenuItem(Sender).Checked := not TMenuItem(Sender).Checked;
end;

procedure TceBaseBillForm.SetMasterDataSet(DataSet: TClientDataSet);
begin
  FMasterDataSet := DataSet;
{  if not Assigned(DataSet.AfterScroll) then
    DataSet.AfterScroll := AfterMasterDataSetScroll;}
end;

procedure TceBaseBillForm.ActPrintExecute(Sender: TObject);
var DataSets:array of TDataSet;
    i, k: integer;
begin
  if sRepSection='' then
    sRepSection := self.Name;
  k := Length(FDetailDataSets)+1;
  SetLength(DataSets, k);
  DataSets[0] := FMasterDataSet;
  for i:=1 to k-1 do
    DataSets[i] := FDetailDataSets[i-1];
  SelRepPrint(sRepSection, DataSets, RepDataSetNames, ActDesignReport.Enabled);
end;

procedure TceBaseBillForm.SetCurrBillNo(BillNo: String);
begin
  if IsEditing(true) then Exit;
  with FMasterDataSet do begin
    if Active then
    begin
      //注意:如果这里不判断数据集是否激活每次都将数据集关闭再打开的话,如果用户在
      //数据集连接的DBGridEh上按了排序,那么关闭后再打开时将会出错。
      Params[0].Value := BillNo;
      Refresh;
      //但Refresh方法并不会触发数据集的AfterScroll事件,而是触发AfterRefresh事件,
      //所以要记住将数据集的AfterRefresh响应过程指向AfterScroll的函数
      if not Assigned(FMasterDataSet.AfterRefresh) then//如果没有指定则代为指定
        FMasterDataSet.AfterScroll(FMasterDataSet);
    end
    else
    begin
      Close;
      Params[0].Value := BillNo;
      Open;
    end;
  end;
  RefreshNavState;    
end;

procedure TceBaseBillForm.SetCurrBillIdx(BillIndex: Integer);
var k: integer;
    s: string;
begin
  k := sBillNoList.Count-1;
  if BillIndex>k then
    BillIndex := k;//这里k有可能是-1(当单号列表为空时),所以下面要再进一步判断
  if BillIndex<0 then
    s := ' '
  else
    s := sBillNoList[BillIndex];
  SetCurrBillNo(s);
end;

procedure TceBaseBillForm.ActAuditExecute(Sender: TObject);
begin
  CheckBillCanModify;
end;

procedure TceBaseBillForm.ActRevertExecute(Sender: TObject);
begin
  CheckBillCanModify;
end;

procedure TceBaseBillForm.CheckBillCanModify;
var Field1, Field2: TField;
begin
  if BillType<>'' then begin
    Field1 := FMasterDataSet.FindField('Creater');
    Field2 := FMasterDataSet.FindField('Grup');
    CheckDataCanModify(BillType, Field1.AsString, Field2.AsInteger);
  end;
end;

procedure TceBaseBillForm.ActAddSubItemExecute(Sender: TObject);
begin
  If FEditMode=0 Then Exit;
  IF Not(FMasterDataSet.State In dsEditModes) Then Exit;
  FDetailDataSets[0].append;
end;

procedure TceBaseBillForm.ActDelSubItemExecute(Sender: TObject);
begin
  If FEditMode=0 Then Exit;
  If not(FMasterDataSet.State In dsEditModes) Then Exit;
	if FDetailDataSets[0].IsEmpty then Exit;
  FDetailDataSets[0].Delete;
end;

end.

⌨️ 快捷键说明

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