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