.#pchinretfrm.pas.1.38
来自「医药连锁经营管理系统源码」· 38 代码 · 共 765 行 · 第 1/2 页
38
765 行
unit PchInRetFrm;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ceBaseBillFrm, ActnList, ModuleAction, ImgList, TB2Dock,
ExtCtrls, RzPanel, TB2Item, TB2Toolbar, DB, DBClient, MConnect, StdCtrls,
RzCmboBx, RzDBBnEd, RzButton, RzRadChk, RzDBChk, ComCtrls, RzDTP,
RzDBDTP, Mask, RzEdit, RzDBEdit, Grids, DBGridEh, DbUtilsEh, EhLibCDS, xEhLibCtl, RzTabs,
RzDBCmbo,dbFuncs, Menus, Buttons, ckDBClient,ShowProGress,uDataTypes,
ceGlobal,SelectProvFrm,SelectEmpFrm,SelectDepotFrm, RzDBLbl, RzLabel,
SelectProvLinkManFrm;
type
TFmPchInRet = class(TceBaseBillForm)
DComConn: TDCOMConnection;
CdsPchInRet: TckClientDataSet;
DsPchInRet: TDataSource;
Label1: TLabel;
Label2: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label14: TLabel;
Label15: TLabel;
DBEdit1: TRzDBEdit;
DBEdit4: TRzDBEdit;
DBEdit5: TRzDBEdit;
DBEdit6: TRzDBEdit;
DBEdit7: TRzDBEdit;
DBEdit2: TRzDBDateTimePicker;
DBEdit15: TRzDBDateTimePicker;
DBCheckBox1: TRzDBCheckBox;
Label17: TLabel;
RzDBEdit1: TRzDBEdit;
Label18: TLabel;
RzDBEdit2: TRzDBEdit;
Label12: TLabel;
DBEdit12: TRzDBEdit;
Label13: TLabel;
DBEdit13: TRzDBEdit;
Label16: TLabel;
DBEdit16: TRzDBEdit;
Label19: TLabel;
RzDBEdit3: TRzDBEdit;
Lab_State: TLabel;
edProvName: TRzDBButtonEdit;
DsPchInRetDtl: TDataSource;
CdsPchInRetDtl: TckClientDataSet;
CdsPchInRetExpense: TckClientDataSet;
DsPchInRetExpense: TDataSource;
PgC1: TRzPageControl;
TabSelExportDtl: TRzTabSheet;
TabSelExpense: TRzTabSheet;
dbgPchInRetExpense: TxDBGridEh;
dbgPchInRetDtl: TxDBGridEh;
cbPayModes: TRzComboBox;
RzDBButtonEdit1: TRzDBButtonEdit;
CdsPchInRetBillNo: TStringField;
CdsPchInRetFDate: TDateTimeField;
CdsPchInRetRefBillNo: TStringField;
CdsPchInRetEmpNo: TStringField;
CdsPchInRetName: TStringField;
CdsPchInRetAudit: TStringField;
CdsPchInRetProvNo: TStringField;
CdsPchInRetProvName: TStringField;
CdsPchInRetLinkMan: TStringField;
CdsPchInRetGoodsQty: TBCDField;
CdsPchInRetGoodsSum: TBCDField;
CdsPchInRetTaxRate: TBCDField;
CdsPchInRetTaxSum: TBCDField;
CdsPchInRetAmount: TBCDField;
CdsPchInRetPayModeNo: TStringField;
CdsPchInRetPayDate: TDateTimeField;
CdsPchInRetRemark: TStringField;
CdsPchInRetFungible: TBooleanField;
CdsPchInRetTransfer: TBooleanField;
CdsPchInRetGrup: TIntegerField;
CdsPchInRetInOutKind: TSmallintField;
CdsPchInRetDtlBillNo: TStringField;
CdsPchInRetDtlItemNo: TIntegerField;
CdsPchInRetDtlGoodsID: TStringField;
CdsPchInRetDtlName: TStringField;
CdsPchInRetDtlSpecs: TStringField;
CdsPchInRetDtlUnit: TStringField;
CdsPchInRetDtlQty: TBCDField;
CdsPchInRetDtlprice: TFloatField;
CdsPchInRetDtlTaxRate: TBCDField;
CdsPchInRetDtlUnTaxprice: TFloatField;
CdsPchInRetDtlGoodsSum: TBCDField;
CdsPchInRetDtlTaxSum: TBCDField;
CdsPchInRetDtlAmount: TBCDField;
CdsPchInRetDtlBatchNo: TStringField;
CdsPchInRetDtlProdDate: TDateTimeField;
CdsPchInRetDtlValidDate: TDateTimeField;
CdsPchInRetDtlDepotID: TIntegerField;
CdsPchInRetDtlPBillNo: TStringField;
CdsPchInRetDtlPItemNo: TIntegerField;
CdsPchInRetDtlPaidUp: TBCDField;
CdsPchInRetDtlProvGoodsID: TStringField;
CdsPchInRetExpenseBillNo: TStringField;
CdsPchInRetExpenseExpenseType: TStringField;
CdsPchInRetExpenseAmount: TBCDField;
CdsPchInRetExpenseRemark: TStringField;
CdsPchInRetAdsPchInRetExpense: TDataSetField;
CdsPchInRetAdsPchInRetDtl: TDataSetField;
CdsPchInRetDtlDepotNo: TStringField;
CdsPchInRetDtlDepotName: TStringField;
RzLabel7: TRzLabel;
RzDBLabel1: TRzDBLabel;
RzLabel16: TRzLabel;
RzDBLabel2: TRzDBLabel;
CdsPchInRetCreater: TStringField;
CdsPchInRetCreatTime: TDateTimeField;
RzDBButtonEdit2: TRzDBButtonEdit;
procedure ActInsertExecute(Sender: TObject);
procedure ActUpdateExecute(Sender: TObject);
procedure ActDeleteExecute(Sender: TObject);
procedure ActSaveExecute(Sender: TObject);
procedure ActAddSubItemExecute(Sender: TObject);
procedure ActDelSubItemExecute(Sender: TObject);
procedure CdsPchInRetAfterScroll(DataSet: TDataSet);
procedure FormCreate(Sender: TObject);
procedure CdsPchInRetNewRecord(DataSet: TDataSet);
procedure CdsPchInRetDtlNewRecord(DataSet: TDataSet);
procedure CdsPchInRetDtlBeforeInsert(DataSet: TDataSet);
procedure CdsPchInRetExpenseNewRecord(DataSet: TDataSet);
procedure CdsPchInRetReconcileError(DataSet: TCustomClientDataSet;
E: EReconcileError; UpdateKind: TUpdateKind;
var Action: TReconcileAction);
procedure CdsPchInRetDtlQtyChange(Sender: TField);
procedure CdsPchInRetDtlAfterPost(DataSet: TDataSet);
procedure edProvNameButtonClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure RzDBButtonEdit1ButtonClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure CdsPchInRetDtlGoodsIDChange(Sender: TField);
procedure CdsPchInRetDtlBeforeEdit(DataSet: TDataSet);
procedure CdsPchInRetEmpNoChange(Sender: TField);
procedure CdsPchInRetProvNoChange(Sender: TField);
procedure dbgPchInRetDtlEditButtonClick(Sender: TObject);
procedure CdsPchInRetDtlDepotNoChange(Sender: TField);
procedure ActAuditExecute(Sender: TObject);
procedure ActRevertExecute(Sender: TObject);
procedure ActFieldLayoutExecute(Sender: TObject);
procedure ActDataExportExecute(Sender: TObject);
procedure RzDBButtonEdit2ButtonClick(Sender: TObject);
procedure CdsPchInRetDtlUnTaxpriceChange(Sender: TField);
procedure CdsPchInRetDtlAfterOpen(DataSet: TDataSet);
procedure CdsPchInRetDtlpriceChange(Sender: TField);
procedure CdsPchInRetDtlTaxRateChange(Sender: TField);
private
iLastItemNO,iClientID:Integer;
slPayModes:TStrings;
LocSetting: PLocSetting;
BeforeDepotNo, BeforeGoodsID, BeforeEmpNo, BeforeProvNo:String;
SvrPchReceive,SvrCommon:TDispatchConnection;
CdsFieldProPerty:TCKClientDataSet;
bBrowGoods, CanAudit, CanRevert:Boolean;
Procedure ShowPayModes; //显示结算方式
procedure ParseGoodsInfo;
public
{ Public declarations }
protected
Function DoSome(cType: PChar; Values: Variant): Variant; override;
end;
Const
sPayModes='Select PayModeNo,PayModename,TimeLimit From PayModes order By PayModeNO';
sFieldProPerty='Select * From SysFieldProPerty '+
' Where TableName In (''PchReceiveDtl'', ''Goodses'',''PchExpense'')';
sFilter=' TableName =''%s'' and Requisite ';
var
FmPchInRet: TFmPchInRet;
implementation
uses SelectGoodsFrm,FieldsLayoutFrm,DataExportFrm,ViewGoodsPriceFrm;
{$R *.dfm}
procedure TFmPchInRet.FormCreate(Sender: TObject);
begin
inherited;
CdsFieldProPerty:=TCKClientDataSet.Create(Self);
slPayModes:=TStringList.Create;
LocSetting := IFmMain.IFmMainEx.GetLocSetting;
SetGressHint('正在登录到药品购进退回服务器...');
CanAudit := ActAudit.Enabled;
CanRevert:= ActCancel.Enabled;
iClientID:=LogonInfo^.ClientID;
CdsFieldProPerty.ProviderName:='DspTemp';
SvrPchReceive:=IFmMain.GetConnection(Handle,'','CKPurchInBase.PurchInRDM');
sBillNoList.Text := SvrPchReceive.AppServer.GetCurrMonthBills(iClientID, 'PchInRet');
CdsPchInRet.RemoteServer:=SvrPchReceive;
SetGressHint('正在连接到公用信息服务器...');
SvrCommon:=IFmMain.GetConnection(Handle,'','CommonSvr.CommonRDM');
CdsFieldProPerty.RemoteServer:=SvrCommon;
SetGressHint('读取用户操作权限...');
IFmMain.SetActionStatus(ActionList1, hInstance, self.ClassName);
SetLength(FDetailDataSets, 2);
FDetailDataSets[0] := CdsPchInRetDtl;
FDetailDataSets[1] := CdsPchInRetExpense;
BillType := 'PchInRet';
RepDataSetNames := '药品购进退回;药品购进退回明细;药品购进退回费用';
sRepSection := '药品购进退回';
MasterDataSet:=CdsPchInRet;
dbgPchInRetDtl.SetAutoSort('');
dbgPchInRetExpense.SetAutoSort('');
end;
procedure TFmPchInRet.FormShow(Sender: TObject);
Var
sTableNames:String;
Begin
inherited;
LoadFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name, [dbgPchInRetDtl,dbgPchInRetExpense]);
SetGressHint('初始化本地环境...');
SysFieldXml(CdsFieldProPerty,sFieldProPerty,'TFmPchReceive.Xml');
sTableNames:='PchReceiveDtl';
SetFieldProperty(CdsFieldProPerty,CdsPchInRetDtl,sTableNames);
sTableNames:='PchExpense';
SetFieldProperty(CdsFieldProPerty,CdsPchInRetExpense,sTableNames);
SetGressHint('读取历史单据...');
ShowPayModes;
SetCurrBillIdx(0);
FreeGressForm;
End;
procedure TFmPchInRet.ActInsertExecute(Sender: TObject);
begin
inherited;
BeforeEmpNo :='';
BeforeProvNo:='';
end;
procedure TFmPchInRet.ActUpdateExecute(Sender: TObject);
begin
If CdsPchInRet.IsEmpty Then Exit;
If CdsPchInRetTransfer.Value Then Begin
Messagebox(Handle,Pchar('当前单据已[审核],不能进行修改操作!'),'错误:',16);
Exit;
End;
inherited;
BeforeEmpNo :='';
BeforeProvNo:='';
end;
procedure TFmPchInRet.ActDeleteExecute(Sender: TObject);
begin
If CdsPchInRetTransfer.Value Then Begin
Messagebox(Handle,Pchar('当前单据已[复核],不能执行删除操作!'),'警告:',64);
Exit;
End;
inherited;
End;
procedure TFmPchInRet.ActSaveExecute(Sender: TObject);
Var iIndex:Integer;
begin
If FEditMode=0 Then Exit;
iIndex:=cbPayModes.ItemIndex;
if iIndex<>-1 Then
Begin
CdsPchInRetPayModeNo.Value:=slPayModes[iIndex];
End;
IF CdsPchInRetDtl.State In dsEditModes Then
CdsPchInRetDtl.Post;
If CdsPchInRetExpense.State in dsEditModes Then
CdsPchInRetExpense.Post;
Inherited;
End;
procedure TFmPchInRet.ActAddSubItemExecute(Sender: TObject);
begin
If FEditMode=0 Then Exit;
If Not(CdsPchInRet.State In dsEditModes) Then Exit;
If Pgc1.ActivePageIndex=0 Then
CdsPchInRetDtl.Append
Else
CdsPchInRetExpense.Append;
end;
procedure TFmPchInRet.ActDelSubItemExecute(Sender: TObject);
begin
If FEditMode=0 Then Exit;
IF PgC1.ActivePageIndex=0 Then Begin
if CdsPchInRetDtl.IsEmpty then Exit;
CdsPchInRetDtl.Delete;
End Else Begin
if CdsPchInRetExpense.IsEmpty then Exit;
CdsPchInRetExpense.Delete;
End;
end;
procedure TFmPchInRet.CdsPchInRetAfterScroll(DataSet: TDataSet);
Var sModeNo:String;
iIndex:Integer;
begin
sModeNo:=CdsPchInRetPayModeNo.Value;
iIndex:=slPayModes.IndexOf(sModeNO);
cbPayModes.ItemIndex:=iIndex;
If CdsPchInRetTransfer.Value Then Begin
ActAudit.Enabled:=False and CanAudit;
ActRevert.Enabled:=True and CanRevert;
Lab_State.Caption:='单据状态:已审核';
Lab_State.Font.Color:=clRed;
End Else Begin
ActAudit.Enabled:=True and CanAudit;
ActRevert.Enabled:=False and CanRevert;
Lab_State.Caption:='单据状态:未审核';
Lab_State.Font.Color:=clHotLight;
End;
end;
procedure TFmPchInRet.CdsPchInRetNewRecord(DataSet: TDataSet);
begin
edProvName.Button.Click;
CdsPchInRetBillNo.Value := BuildBillNo('PchInRet');
CdsPchInRetCreater.Value := LogonInfo^.UserID;
CdsPchInRetGrup.Value := LogonInfo^.UserGrupID;
CdsPchInRetInOutKind.Value:=1;
CdsPchInRetFDate.Value:=Date;
CdsPchInRetPayDate.Value:=Date;
CdsPchInRetGoodsQty.Value := 0;
CdsPchInRetGoodsSum.Value := 0;
CdsPchInRetTaxRate.Value := 0;
CdsPchInRetTaxSum.Value := 0;
CdsPchInRetAmount.Value := 0;
end;
procedure TFmPchInRet.CdsPchInRetDtlNewRecord(DataSet: TDataSet);
begin
BeforeGoodsID:='';
CdsPchInRetDtlBILLNO.Value:=CdsPchInRetBillNO.Value;
CdsPchInRetDtlItemNO.Value:=iLastItemNO+1;
end;
procedure TFmPchInRet.CdsPchInRetDtlBeforeInsert(DataSet: TDataSet);
begin
iLastItemNO:=GetFieldMaxInt(CdsPchInRetDtl,'ItemNO');
end;
procedure TFmPchInRet.CdsPchInRetExpenseNewRecord(DataSet: TDataSet);
begin
CdsPchInRetExpenseBillNo.Value:=CdsPchInRetBillNo.Value;
end;
Procedure TFmPchInRet.CdsPchInRetReconcileError(
DataSet: TCustomClientDataSet; E: EReconcileError;
UpdateKind: TUpdateKind; var Action: TReconcileAction);
begin
Messagebox(Handle,Pchar(E.Message),'',16);
Action:=RaAbort;
end;
procedure TFmPchInRet.CdsPchInRetDtlQtyChange(Sender: TField);
var str: String;
begin
//实际单价 = 单价 * 折扣
str := LowerCase(dbgPchInRetDtl.SelectedField.FieldName);
if str='goodsid' then
CdsPchInRetDtlUnTaxprice.AsFloat := CdsPchInRetDtlprice.AsFloat / (1 + cdsPchInRetDtlTaxRate.AsFloat/ 100);
//货款 = 数量 * 未税单价 合计 = 数量 * 单价 税款 = 合计 - 货款
CdsPchInRetDtlGoodsSum.AsFloat := CdsPchInRetDtlQty.AsFloat * CdsPchInRetDtlUnTaxPrice.AsFloat;
CdsPchInRetDtlAmount.AsFloat := CdsPchInRetDtlQty.AsFloat * CdsPchInRetDtlPrice.AsFloat;
CdsPchInRetDtlTaxSum.AsFloat := CdsPchInRetDtlAmount.AsFloat - CdsPchInRetDtlGoodsSum.AsFloat;
End;
procedure TFmPchInRet.CdsPchInRetDtlUnTaxpriceChange(Sender: TField);
begin
if dbgPchInRetDtl.SelectedField.FieldName = Sender.FieldName then
begin;
CdsPchInRetDtlPrice.AsFloat := Sender.AsFloat * ( 1 + CdsPchInRetDtlTaxRate.AsFloat / 100 );
CdsPchInRetDtlGoodsSum.AsFloat:= cdsPchInRetDtlQty.AsFloat * CdsPchInRetDtlUnTaxPrice.AsFloat;
CdsPchInRetDtlAmount.AsFloat := cdsPchInRetDtlQty.AsFloat*cdsPchInRetDtlPrice.AsFloat;
CdsPchInRetDtlTaxSum.AsFloat := CdsPchInRetDtlAmount.AsFloat - CdsPchInRetDtlGoodsSum.AsFloat;
end;
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?