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 + -
显示快捷键?