pchexclude.~pas
来自「医药连锁经营管理系统源码」· ~PAS 代码 · 共 516 行 · 第 1/2 页
~PAS
516 行
procedure TFmPchExclude.ActSaveExecute(Sender: TObject);
Var iIndex:Integer;
begin
If FEditMode=0 Then Exit;
If (CdsPchExcludeDtl.State In dsEditModes) Then
CdsPchExcludeDtl.Post;
Inherited;
end;
procedure TFmPchExclude.CdsPchExcludeReconcileError(
DataSet: TCustomClientDataSet; E: EReconcileError;
UpdateKind: TUpdateKind; var Action: TReconcileAction);
begin
Messagebox(Handle,Pchar(E.Message),'',16);
Action:=RaAbort;
end;
procedure TFmPchExclude.CdsPchExcludeEmpNOChange(Sender: TField);
Var
sEmpNo,sEmpName,LogText:String;
begin
IF FEditMode=0 Then Exit;
sEmpNo:=CdsPchExcludeEmpNo.Value;
If sEmpNo='' Then Exit;
if sEmpNo=BeforeEmpNo Then Exit;
BeforeEmpNo:=sEmpNO;
sEmpName:=VarToStr(SvrCommon.AppServer.GetEmpInfo(iClientID,sEmpNo,1,'Name',LogText));
CdsPchExcludeEmpName.Value:=sEmpName;
If LogText<>'' Then Begin
Messagebox(Handle,Pchar(LogText),nil,16);
Abort;
End;
end;
procedure TFmPchExclude.ActAuditExecute(Sender: TObject);
Var
sUserID,Str:String;
sSysInfo : Variant;
begin
Try
If CdsPchExclude.IsEmpty Then Exit;
If FEditMode>0 then Exit;
Inherited;
If Application.MessageBox('确实要审核当前数据吗?','提示',4+32)<>6 Then Exit;
str := 'CurrMonth';
sSysInfo := SvrCommon.AppServer.GetSysInfo(iClientID,Str,1);
If Not(VarIsNull(sSysInfo)) Then Begin
If CdsPchExcludeFDate.Value<VarToDateTime(sSysInfo) Then Begin
Messagebox(Handle,Pchar('单据日期不符,该月已完成月度结算...'),nil,16);
Exit;
End;
End Else Begin
Messagebox(Handle,Pchar('请先设置开帐日期...'),nil,16);
Exit;
End;
CdsPchExclude.Edit;
CdsPchExcludeTransfer.Value:=True;
sUserID := iFmMain.IFmMainEx.LogonInfo^.UserID;
CdsPchExcludeAudit.Value := sUserID;
try
CdsPchExclude.Post;
Except
CdsPchExclude.Cancel;
Raise;
end;
If CdsPchExclude.ApplyUpdates(0)>0 Then
Messagebox(Handle,Pchar('复核数据不成功!'),nil,16)
Else Begin
ActAudit.Enabled := False and CanAudit;
ActRevert.Enabled := True and CanRevert;
Lab_State.Caption:='单据状态:已审核';
Lab_State.Font.Color:=clRed;
ActRefreshExecute(NIl);
End;
Except
On E:Exception Do
Messagebox(Handle,Pchar(E.Message),nil,16);
End;
end;
procedure TFmPchExclude.ActRevertExecute(Sender: TObject);
Var BillNo: String;
begin
Try
If CdsPchExclude.IsEmpty Then Exit;
If FEditMode>0 then Exit;
Inherited;
If Application.MessageBox('确实要还原当前已审核过的单据吗?','提示',4+32)<>6 Then Exit;
CdsPchExclude.Edit;
CdsPchExcludeTransfer.Value:=False;
CdsPchExcludeAudit.Value := '';
try
CdsPchExclude.Post;
Except
CdsPchExclude.Cancel;
Raise;
end;
If CdsPchExclude.ApplyUpdates(0)>0 Then
Messagebox(Handle,Pchar('还原数据不成功!'),nil,16)
Else Begin
ActAudit.Enabled:=True and CanAudit;
ActRevert.Enabled:=False and CanRevert;
Lab_State.Caption:='单据状态:未审核';
Lab_State.Font.Color:=clHotLight;
ActRefreshExecute(Nil);
End;
Except
On E:Exception Do
Messagebox(Handle,Pchar(E.Message),nil,16);
End;
End;
procedure TFmPchExclude.ActFieldLayoutExecute(Sender: TObject);
begin
SetFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name,
[dbgPchOrderDtl],'来货拒收明细');
end;
procedure TFmPchExclude.ActDataExportExecute(Sender: TObject);
begin
ExportData([CdsPchExclude, CdsPchExcludeDtl],'来货拒收;来货拒收明细', '');
end;
function TFmPchExclude.DoSome(cType: PChar; Values: Variant): Variant;
const
cTypes = 'viewbill'#13'query';
// 查看某单 查询
var sTypes, sBillList: TStrings;
b1: Boolean;
i, k: integer;
str, str2: String;
begin
sBillList := TStringList.Create;
sTypes := TStringList.Create;
sTypes.Text := cTypes;
i := sTypes.IndexOf(cType);
case i of
0: begin//ViewBill
b1 := VarIsArray(Values);
if b1 then begin
str := Values[0];
str2:= Values[1];
end else begin
str := Values;
str2:= '';
end;
sBillList.Text := Str;
if not b1 then begin
if sBillNoList.IndexOf(sBillList[0])<0 then
sBillNoList.AddStrings(sBillList);
end else
sBillNoList.Text := str2;
SetCurrBillNo(sBillList[0]);
end;
end;
end;
procedure TFmPchExclude.edProvNameButtonClick(Sender: TObject);
Var sProvNo,sProvName,sEmpNo,sPayModeNo:String;
begin
If FEditMode=0 Then Exit;
sProvNo := CdsPchExcludeProvNO.Value;
If SelectProv(sProvNo,sProvName) Then Begin
CdsPchExcludeProvNO.Value := sProvNo;
CdsPchExcludeProvName.Value := sProvName;
End;
End;
procedure TFmPchExclude.RzDBButtonEdit2ButtonClick(Sender: TObject);
Var
sProvNo,sLinkMan : String;
begin
If FEditMode=0 Then Exit;
If RzDBEdit9.Text='' Then Begin
MessageBox(Handle,Pchar('请先指定供应厂商!'),nil,16);
Exit;
End;
sProvNo := CdsPchExcludeProvNo.Value;
If SelectProvLinkMan(sProvNo,sLinkMan) Then
CdsPchExcludeLinkMan.Value := sLinkMan ;
end;
procedure TFmPchExclude.ActQueryExecute(Sender: TObject);
begin
IFmMain.OnAction(Sender);
end;
procedure TFmPchExclude.dbgPchOrderDtlEditButtonClick(Sender: TObject);
Var
sField,sGoodsID,sProvNo,sUnit:String;
dPrice:Double;
Begin
If FEditMode=0 Then Exit;
sField :='';
sField := Trim(LowerCase(dbgPchOrderDtl.SelectedField.FieldName));
If sField='goodsid' Then Begin
ParseGoodsInfo;
End;
End;
procedure TFmPchExclude.CdsPchExcludeDtlGoodsIDChange(Sender: TField);
{Var
LogText,Flag,sGoodsID,sSetFields,sProvNo:String;
Begin
IF (FEditMode=0) or bBrowGoods Then Exit;
IF FlagGoodsID<>'' Then Begin
FlagGoodsID:='';
Exit;
End;
sGoodsID:=CdsPchExcludeDtlGoodsID.AsString;
If sGoodsID='' Then Exit;
if (BeforeGoodsID=sGoodsID) Then Exit;
BeforeGoodsID:=sGoodsID;
sSetFields:= 'Name,Specs,Unit';
FlagGoodsID:=GetGoodsInfo(CdsPchExcludeDtl,'',sGoodsID,sSetFields,'','P', 1);
If FlagGoodsID='' Then Begin
Messagebox(Handle,'无效药品编号',nil,16);
Abort;
End Else Begin
if sGoodsID<>FlagGoodsID then
CdsPchExcludeDtl.FieldByName('GoodsID').AsString:=FlagGoodsID
Else
FlagGoodsID:='';
End;}
begin
ParseGoodsInfo;
End;
procedure TFmPchExclude.ParseGoodsInfo;
var
B1:boolean;
begin
if FEditMode=0 then Exit;
if bBrowGoods then Exit;
bBrowGoods := true;
try
b1:=SelectGoods(CdsPchExcludeDtl, CdsPchExcludeDtlGoodsID, CdsPchExcludeDtlUnit, true, False, false);
if not b1 then abort;
finally
bBrowGoods := false;
end;
end;
procedure TFmPchExclude.CdsPchExcludeNewRecord(DataSet: TDataSet);
begin
CdsPchExcludeBillNo.Value := BuildBillNo('PchExclude');
CdsPchExcludeCreater.Value := LogonInfo^.UserID;
CdsPchExcludeGrup.Value := LogonInfo^.UserGrupID;
end;
initialization
RegisterClass(TFmPchExclude);
finalization
UnRegisterClass(TFmPchExclude);
end.
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?