stockinfm.~pas
来自「群星医药系统源码」· ~PAS 代码 · 共 670 行 · 第 1/2 页
~PAS
670 行
unit StockInFm;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ceBaseBillFrm, Grids, DBGridEh, DbUtilsEh, EhLibCDS, xEhLibCtl, ActnList,
ModuleAction, ImgList, TB2Dock, ExtCtrls, RzPanel, TB2Item, TB2Toolbar,
StdCtrls, RzCmboBx, RzDBBnEd, ComCtrls, RzDTP, RzDBDTP, RzStatus,IMainFrm,
RzDBStat, Mask, RzEdit, RzDBEdit, DB, DBClient, MConnect, Buttons,
ckDBClient,DbFuncs, Menus, RzButton,ShowProGress,uDataTypes,ceGlobal,
ADODB,ComObj;
type
TFmStockIn = class(TceBaseBillForm)
dbgStockInDtl: TxDBGridEh;
Label11: TLabel;
Label22: TLabel;
RzDBEdit21: TRzDBEdit;
RzDBEdit10: TRzDBEdit;
Label3: TLabel;
Label1: TLabel;
Label2: TLabel;
Label7: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
edBillID: TRzDBEdit;
edDate: TRzDBDateTimePicker;
RzDBEdit1: TRzDBEdit;
edEmpID: TRzDBButtonEdit;
edDepot: TRzDBButtonEdit;
edDepart: TRzDBButtonEdit;
cbInOutKind: TRzComboBox;
RzDBEdit2: TRzDBEdit;
RzDBEdit3: TRzDBEdit;
Label9: TLabel;
RzDBEdit4: TRzDBEdit;
Lab_State: TLabel;
RzDBEdit5: TRzDBEdit;
CdsStockIn: TckClientDataSet;
DsStockIn: TDataSource;
DComConn: TDCOMConnection;
CdsStockInDtl: TckClientDataSet;
DsStockInDtl: TDataSource;
SpeedButton1: TSpeedButton;
CdsStockInBillNo: TStringField;
CdsStockInFDate: TDateTimeField;
CdsStockInDepotID: TIntegerField;
CdsStockInDepotNo: TStringField;
CdsStockInDepotName: TStringField;
CdsStockInProvNo: TStringField;
CdsStockInProvName: TStringField;
CdsStockInInOutKind: TIntegerField;
CdsStockInEmpNo: TStringField;
CdsStockInName: TStringField;
CdsStockInAudit: TStringField;
CdsStockInGoodsQty: TBCDField;
CdsStockInGoodsSum: TBCDField;
CdsStockInRemark: TStringField;
CdsStockInTransfer: TBooleanField;
CdsStockInAdsStockInDtl: TDataSetField;
CdsStockInDtlBillNo: TStringField;
CdsStockInDtlItemNo: TIntegerField;
CdsStockInDtlGoodsID: TStringField;
CdsStockInDtlName: TStringField;
CdsStockInDtlSpecs: TStringField;
CdsStockInDtlUnit: TStringField;
CdsStockInDtlQty: TBCDField;
CdsStockInDtlprice: TFloatField;
CdsStockInDtlAmount: TBCDField;
CdsStockInDtlBerthNo: TStringField;
CdsStockInDtlGroupNo: TIntegerField;
CdsStockInDtlBatchNo: TStringField;
CdsStockInDtlProdDate: TDateTimeField;
CdsStockInDtlValidDate: TDateTimeField;
CdsStockInDtlQuality: TStringField;
CdsStockInDtlPBillNo: TStringField;
CdsStockInDtlPItemNO: TIntegerField;
RzDBEdit6: TRzDBEdit;
Label8: TLabel;
CdsStockInPBillNO: TStringField;
CdsStockInCreater: TStringField;
CdsStockInMender: TStringField;
CdsStockInGrup: TIntegerField;
CdsStockInCreattime: TDateTimeField;
procedure CdsStockInDtlBeforeInsert(DataSet: TDataSet);
procedure CdsStockInDtlNewRecord(DataSet: TDataSet);
procedure ActSaveExecute(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure CdsStockInReconcileError(DataSet: TCustomClientDataSet;
E: EReconcileError; UpdateKind: TUpdateKind;
var Action: TReconcileAction);
procedure SpeedButton1Click(Sender: TObject);
procedure CdsStockInNewRecord(DataSet: TDataSet);
procedure ActAddSubItemExecute(Sender: TObject);
procedure ActDelSubItemExecute(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure ActDeleteExecute(Sender: TObject);
procedure CdsStockInProvNoChange(Sender: TField);
procedure CdsStockInEmpNoChange(Sender: TField);
procedure dbgStockInDtlEditButtonClick(Sender: TObject);
procedure CdsStockInDtlGoodsIDChange(Sender: TField);
procedure CdsStockInDtlAfterPost(DataSet: TDataSet);
procedure CdsStockInDtlQtyChange(Sender: TField);
procedure CdsStockInAfterScroll(DataSet: TDataSet);
procedure CdsStockInDepotNoChange(Sender: TField);
procedure ActUpdateExecute(Sender: TObject);
procedure ActAuditExecute(Sender: TObject);
procedure ActRevertExecute(Sender: TObject);
procedure ActFieldLayoutExecute(Sender: TObject);
procedure ActDataExportExecute(Sender: TObject);
procedure edDepotButtonClick(Sender: TObject);
procedure edEmpIDButtonClick(Sender: TObject);
procedure edDepartButtonClick(Sender: TObject);
procedure ActInsertExecute(Sender: TObject);
procedure ActQueryExecute(Sender: TObject);
private
{ Private declarations }
CdsFieldProPerty:TCkClientDataSet;
iClientID,iLastItemNo:Integer;
slInOutKinds:TStrings;
LocSetting: PLocSetting;
bBrowGoods,CanAudit, CanRevert:Boolean;
BeforeGoodsID,FlagGoodsID,BeforeProvNo,BeforeEmpNo,BeforeDepotNo:String;
SvrStockIn,SvrCommon:TDispatchConnection;
Procedure GetInOut;
procedure ParseGoodsInfo;
public
iAppendInOut:Integer; //iappendInOut 检测是否有新增入库方式>0表示有
protected
Function DoSome(cType: PChar; Values: Variant): Variant; override;
end;
Const
sInOutKind='Select KindId,KindName From InOutKind Where InOut=0 Order By KindId';
sFieldProPerty='Select * From SysFieldProPerty '+
' Where TableName in(''StockIn'', ''StockInDtl'', ''Goodses'')';
var
FmStockIn: TFmStockIn;
implementation
uses INOutKindFm,SelectGoodsFrm,FieldsLayoutFrm,DataExportFrm,ViewGoodsPriceFrm,SelectEmpFrm,SelectProvFrm,
SelectCustFrm,SelectDepartFrm,SelectDepotFrm,SelectBerthFrm;
{$R *.dfm}
procedure TFmStockIn.FormCreate(Sender: TObject);
begin
Inherited;
IFmMain.SetActionStatus(ActionList1, hInstance, self.ClassName);
iAppendInOut:=0;
CdsFieldProPerty:=TCKClientDataSet.Create(Self);
slInOutKinds:=TStringList.Create;
LocSetting := IFmMain.IFmMainEx.GetLocSetting;
SetGressHint('正在连接药品入库服务器...');
CanAudit := ActAudit.Enabled;
CanRevert:= ActCancel.Enabled;
iClientID:=IFmMain.IFmMainEx.ClientID;
SvrStockIn:=IFmMain.GetConnection(Handle,'','CkStockSvr.Stock');
sBillNoList.Text := SvrStockIn.AppServer.GetCurrMonthBills(iClientID, 'StockIn');
CdsStockIn.RemoteServer := SvrStockIn;
SetGressHint('正在连接到公用信息服务器...');
SvrCommon:=IFmMain.GetConnection(Handle,'','CommonSvr.CommonRDM');
CdsFieldProPerty.ProviderName := 'DspTemp';
CdsFieldProPerty.RemoteServer := SvrCommon;
SetGressHint('正在读取用户操作权限...');
SetLength(FDetailDataSets, 1);
FDetailDataSets[0] := CdsStockInDtl;
RepDataSetNames := '药品入库;药品入库明细';
sRepSection := '药品入库单';
MasterDataSet:=CdsStockIn;
end;
procedure TFmStockIn.FormShow(Sender: TObject);
var sTableNames:String;
begin
SetGressHint('初始化本地环境...');
SetGridEhColor(dbgStockInDtl);
SysFieldXml(CdsFieldProPerty,sFieldProPerty,'TFmStockIn.Xml');
SetFieldProperty(CdsFieldProPerty,CdsStockIn, 'StockIn');
SetFieldProperty(CdsFieldProPerty,CdsStockInDtl, 'StockInDtl,Goodses');
SetGressHint('读取历史单据...');
GetInOut;
SetCurrBillIdx(0);
inherited;
FreeGressForm;
end;
procedure TFmStockIn.CdsStockInDtlBeforeInsert(DataSet: TDataSet);
begin
iLastItemNO := GetFieldMaxInt(CdsStockInDtl, 'ItemNo')+1;
end;
procedure TFmStockIn.CdsStockInDtlNewRecord(DataSet: TDataSet);
begin
inherited;
BeforeGoodsID:='';
CdsStockInDtlItemNo.Value:=iLastItemNO;
CdsStockInDtlBillNo.Value:=CdsStockInBillNo.Value;
CdsStockInDtlProdDate.Value:=Date;
CdsStockInDtlValidDate.Value:=IncMonth(Date,12);
end;
procedure TFmStockIn.ActSaveExecute(Sender: TObject);
Var iIndex:Integer;
begin
Try
If FEditMode=0 Then Exit;
iIndex:=cbInOutKind.ItemIndex;
if iIndex<>-1 Then
CdsStockInInOutKind.Value:=StrToInt(slInOutKinds[iIndex]);
edDepart.SetFocus;
Inherited;
Except
On E:Exception Do
Messagebox(Handle,Pchar(E.Message),nil,16);
End;
End;
procedure TFmStockIn.CdsStockInReconcileError(
DataSet: TCustomClientDataSet; E: EReconcileError;
UpdateKind: TUpdateKind; var Action: TReconcileAction);
begin
MessageBox(Handle,Pchar(E.Message),'',16);
Action:=raAbort;
end;
procedure TFmStockIn.SpeedButton1Click(Sender: TObject);
Var
A,B:Integer;
begin
if FEditMode=0 then Exit;
If cbInOutKind.ItemIndex=-1 Then
A:=0
Else
A:=StrToInt(slInOutKinds[cbInOutKind.ItemIndex]);
B:=GetKindId(0,A,iAppendInOut);
If iAppendInOut>0 Then
Begin
GetInOut;
iAppendInOut:=0;
End;
cbInOutKind.ItemIndex:=slInOutKinds.IndexOf(IntToStr(B));
end;
procedure TFmStockIn.GetInOut;
Var
A:Variant;
I, k:Integer;
begin
//显示出入库方式
A:=SvrCommon.AppServer.GetNeedValue(iClientID,2,sInOutKind);
If (Not VarIsNull(A)) And (VarIsArray(A)) Then
Begin
cbInOutKind.Items.Clear;
slInOutKinds.Clear;
k := VarArrayHighBound(A,2);
for i:=VarArrayLowBound(A,2) to k do
Begin
slInOutKinds.Add(A[0,i]);
cbInOutKind.Items.Add('['+A[0,i]+']'+A[1,i]);
End;
End;
end;
procedure TFmStockIn.CdsStockInNewRecord(DataSet: TDataSet);
Var sBillNo:String;
begin
CdsStockInFDate.Value := Date;
sBillNo := BuildBillNo('StockIn');
CdsStockInBillNo.Value :=sBillNo;
end;
procedure TFmStockIn.ActAddSubItemExecute(Sender: TObject);
begin
If FEditMode=0 Then Exit;
IF Not(CdsStockIn.State In dsEditModes) Then Exit;
CdsStockInDtl.append;
end;
procedure TFmStockIn.ActDelSubItemExecute(Sender: TObject);
begin
If FEditMode=0 Then Exit;
If NOt(CdsStockIn.State In dsEditModes) Then Exit;
if CdsStockInDtl.IsEmpty then Exit;
CdsStockInDtl.Delete;
end;
procedure TFmStockIn.ActDeleteExecute(Sender: TObject);
begin
Try
If CdsStockInTransfer.Value Then Begin
Messagebox(Handle,Pchar('当前单据已[复核]，不能执行删除操作！'),'警告:',64);
Exit;
End;
inherited;
Except
On E:Exception Do
Messagebox(Handle,Pchar(E.Message),'',16);
End;
end;
procedure TFmStockIn.CdsStockInProvNoChange(Sender: TField);
Var
sProvNo,sProvName,LogText:String;
begin
IF FEditMode=0 Then Exit;
sProvNo:=CdsStockInProvNo.Value;
If sProvNo='' Then Exit;
if sProvNo=BeforeProvNo Then Exit;
BeforeProvNo:=sProvNO;
sProvName:=VarToStr(SvrCommon.AppServer.GetProvInfo(iClientID,sProvNo,1,'ProvName',LogText));
CdsStockInProvName.Value:=sProvName;
If LogText<>'' Then Begin
Messagebox(Handle,Pchar(LogText),nil,16);
RzDBEdit2.SetFocus;
Abort;
End;
end;
procedure TFmStockIn.CdsStockInEmpNoChange(Sender: TField);
Var
sEmpNo,sEmpName,LogText:String;
begin
IF FEditMode=0 Then Exit;
sEmpNo:=CdsStockInEmpNo.Value;
If sEmpNo='' Then Exit;
if sEmpNo=BeforeEmpNo Then Exit;
BeforeEmpNo:=sEmpNO;
sEmpName:=VarToStr(SvrCommon.AppServer.GetEmpInfo(iClientID,sEmpNo,1,'Name',LogText));
CdsStockInName.Value:=sEmpName;
If LogText<>'' Then Begin
Messagebox(Handle,Pchar(LogText),nil,16);
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?