selgoodscheckacceptfrm.pas

群星医药系统源码

end;

procedure TFmSelGoodsCheckAccept.GoodsCheckAcceptDtlReconcileError(
  DataSet: TCustomClientDataSet; E: EReconcileError;
  UpdateKind: TUpdateKind; var Action: TReconcileAction);
begin
  Messagebox(handle,Pchar(E.Message),'',16);
  Action:=RaAbort;
end;

procedure TFmSelGoodsCheckAccept.dbgGoodsCheckAcceptDtlEditButtonClick(
  Sender: TObject);
begin
  if FEditMode=0 then Exit;
  bBrowGoods := true;
  if LowerCase(dbgGoodsCheckAcceptDtl.SelectedField.FieldName)='goodsid' then begin
    BrowGoods;
  end;
  bBrowGoods := false;
end;

procedure TFmSelGoodsCheckAccept.BrowGoods;
var i: Integer;
    bAppend: Boolean;
begin
  bAppend := GoodsCheckAcceptDtl.State=dsInsert;
  if bAppend then
    i := GoodsCheckAcceptDtl.RecordCount;
  SelectGoods(GoodsCheckAcceptDtl, GoodsCheckAcceptDtlGoodsID, GoodsCheckAcceptDtlunit, true, bAppend, true);
  if bAppend then
    GoodsCheckAcceptDtl.RecNo := i+1;
end;

procedure TFmSelGoodsCheckAccept.GoodsCheckAcceptDtlgoodsidChange(
  Sender: TField);
Var
  LogText,Flag,sGoodsID,sSetFields:String;
Begin
  IF FEditMode=0 Then Exit;
  IF FlagGoodsID<>'' Then Begin
    FlagGoodsID:='';
    Exit;
  End;
//  If bBrowGoods then Exit;
  sGoodsID:=GoodsCheckAcceptDtlgoodsid.AsString;
  If sGoodsID='' Then Exit;
  if (BeforeGoodsID=sGoodsID) Then Exit;
  BeforeGoodsID:=sGoodsID;
  sSetFields:= 'Name,Specs,Unit';
  Flag:=GetGoodsInfo(GoodsCheckAcceptDtl,sGoodsID,sSetFields,LogText);
  If Flag<>'' Then Begin
    Messagebox(Handle,'无效药品编号','错误',16);
    Abort;
  End Else Begin
    FlagGoodsID:=LogText;
    If Copy(Trim(sGoodsID),1,1)='-' Then
      GoodsCheckAcceptDtl.FieldByName('GoodsID').AsString:=FlagGoodsID
    Else
      FlagGoodsID:='';
  End;
End;

procedure TFmSelGoodsCheckAccept.FormShow(Sender: TObject);
Var
  sTableNames:String;
begin
  LoadFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name, [dbgGoodsCheckAcceptDtl]);
  SetGressHint('初始化本地环境...');
  SysFieldXml(CdsFieldProPerty,sFieldProPerty,'TFmSelGoodsCheckAccept.Xml');
  sTableNames:='GoodsCheckAccept,Providers';
  SetFieldProperty(CdsFieldProPerty,GoodsCheckAccept,sTableNames);
  sTableNames:='GoodsCheckAcceptDtl,Goodses';
  SetFieldProperty(CdsFieldProPerty,GoodsCheckAcceptDtl,sTableNames);
  SetGressHint('读取历史单据...');
  GoodsCheckAccept.Open;
  FreeGressForm;
  inherited;
end;

procedure TFmSelGoodsCheckAccept.ActUpdateExecute(Sender: TObject);
begin
  If GoodsCheckAccept.IsEmpty Then Exit;
  If GoodsCheckAccepttransfer.Value  Then Begin
    Messagebox(Handle,Pchar('当前的销售退回质量验收单已审核，不能进行修改操作!'),'错误',16);
    Exit;
  End;
  inherited;
end;

procedure TFmSelGoodsCheckAccept.GoodsCheckAcceptprovnoChange(
  Sender: TField);
Var
  sCustNo,sCustName,LogText:String;
begin
  IF FEditMode=0 Then Exit;
  sCustNo:=GoodsCheckAcceptprovno.Value;
  If sCustNo='' Then Exit;
  if sCustNo=BeforeCustNo Then Exit;
  BeforeCustNo:=sCustNO;
  sCustName:=VarToStr(SvrCommon.AppServer.GetCustInfo(iClientID,sCustNo,1,'FullName',LogText));
  GoodsCheckAcceptFullname.Value:=sCustName;
  If LogText<>'' Then Begin
    Messagebox(Handle,Pchar(LogText),'错误',16);
    DBEdit8.SetFocus;
    Abort;
  End;
end;   

procedure TFmSelGoodsCheckAccept.GoodsCheckAcceptDtlcheckqtyChange(
  Sender: TField);
Var
  dCount,dPassCount:Double;
begin
  dCount:=GoodsCheckAcceptDtlcheckqty.value;
  dPassCount:=GoodsCheckAcceptDtleligibleqty.Value;
  If dCount<dPassCount Then Begin
    Messagebox(Handle,Pchar('合格品数量不能大于验收数量!'),'错误',16);
    Abort;
  End Else
    GoodsCheckAcceptDtlrejectqty.Value:=dCount-dPassCount;
end;

procedure TFmSelGoodsCheckAccept.GoodsCheckAcceptDtlBeforePost(
  DataSet: TDataSet);
begin
End;

procedure TFmSelGoodsCheckAccept.GoodsCheckAcceptDtlAfterPost(
  DataSet: TDataSet);
begin
  BeforeGoodsID:='';
end;

procedure TFmSelGoodsCheckAccept.GoodsCheckAcceptAfterScroll(
  DataSet: TDataSet);
begin
  RefreshNavState;
  If GoodsCheckAcceptTransfer.Value Then Begin
    ActAudit.Enabled:=False;
    ActRevert.Enabled:=True;
    Lab_State.Caption:='单据状态：已审核';
    Lab_State.Font.Color:=clRed;
  End Else Begin
    ActAudit.Enabled:=True;
    ActRevert.Enabled:=False;
    Lab_State.Caption:='单据状态：未审核';
    Lab_State.Font.Color:=clHotLight;
  End;
end;

procedure TFmSelGoodsCheckAccept.ActAuditExecute(Sender: TObject);
Var
  sUserID:String;
begin
  Try
    If GoodsCheckAccept.IsEmpty Then Exit;
    If FEditMode>0 then Exit;
    If Application.MessageBox('确实要审核当前数据吗？','提示',4+32)<>6 Then Exit;
    GoodsCheckAccept.Edit;
    GoodsCheckAcceptTransfer.Value:=True;
    sUserID := iFmMain.IFmMainEx.LogonInfo^.UserID;
    GoodsCheckAcceptAudit.Value := sUserID;
    try
      CdsGoodsCheckAccept.Post;
    Except
      CdsGoodsCheckAccept.Cancel;
      Raise;
    end;
    If GoodsCheckAccept.ApplyUpdates(0)>0 Then
      Messagebox(Handle,Pchar('复核数据不成功！'),'错误',16)
    Else Begin
      GoodsCheckAccept.RefreshRecord;
      ActAudit.Enabled:=False;
      ActRevert.Enabled:=True;
      Lab_State.Caption:='单据状态：已审核';
      Lab_State.Font.Color:=clRed;
    End;
  Except
    On E:Exception Do
      Messagebox(Handle,Pchar(E.Message),'错误',16);
  End;
End;

procedure TFmSelGoodsCheckAccept.ActRevertExecute(Sender: TObject);
begin
  Try
    If GoodsCheckAccept.IsEmpty Then Exit;
    If FEditMode>0 then Exit;
    If Application.MessageBox('确实要还原当前已审核过的数据吗？','提示',4+32)<>6 Then Exit;
    GoodsCheckAccept.Edit;
    GoodsCheckAcceptTransfer.Value:=False;
    GoodsCheckAcceptAudit.Value := '';
    try
      CdsGoodsCheckAccept.Post;
    Except
      CdsGoodsCheckAccept.Cancel;
      Raise;
    end;
    If GoodsCheckAccept.ApplyUpdates(0)>0 Then
      Messagebox(Handle,Pchar('还原数据不成功！'),'错误',16)
    Else Begin
      GoodsCheckAccept.RefreshRecord;
      ActAudit.Enabled:=True;
      ActRevert.Enabled:=False;
      Lab_State.Caption:='单据状态：未审核';
      Lab_State.Font.Color:=clHotLight;
    End;
  Except
    On E:Exception Do
      Messagebox(Handle,Pchar(E.Message),'错误',16);
  End;
End;

procedure TFmSelGoodsCheckAccept.ActFieldLayoutExecute(Sender: TObject);
begin
  SetFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name,
                  [dbgGoodsCheckAcceptDtl],'销售退回质量验收明细');
end;

procedure TFmSelGoodsCheckAccept.ActDataExportExecute(Sender: TObject);
begin
	ExportData([GoodsCheckAccept, GoodsCheckAcceptDtl],'销售退回质量验收;销售退回质量验收明细', '');
end;

function TFmSelGoodsCheckAccept.DoSome(cType: PChar;
  Values: Variant): Variant;
const
  cTypes = 'viewbill'#13'query';
  //       查看某单     查询
var sTypes: TStrings;
    i, k: integer;
    str, str2: String;
begin
  sTypes := TStringList.Create;
  sTypes.Text := cTypes;
  i := sTypes.IndexOf(cType);
  case i of
    0: begin//ViewBill
      if VarIsArray(Values) then begin
        str := Values[0];
        str2:= Values[1];
      end else begin
        str := Values;
        str2:= '';
      end;
      if str2='' then begin
        if sBillNoList.IndexOf(str)<0 then
          sBillNoList.Add(str);
      end else
        sBillNoList.Text := str2;
      self.BringToFront;
      SetCurrBillNo(str);
    end;
  end;
end;

procedure TFmSelGoodsCheckAccept.edCustNameButtonClick(Sender: TObject);
Var
  sProvNo,sProvName : String;
begin
  If FEditMode=0 Then Exit;
  sProvNo := GoodsCheckAcceptprovno.Value;
  sProvName := GoodsCheckAccept.fieldbyname('FullName').AsString;
  If SelectProv(sProvNo,sProvName) Then Begin
    GoodsCheckAcceptprovno.Value := sProvNo;
    GoodsCheckAcceptfullname.Value := sProvName;
    edCustName.Text := sProvName;
  End;
end;

Initialization
  RegisterClass(TFmSelGoodsCheckAccept);
Finalization
  UnRegisterClass(TFmSelGoodsCheckAccept);

end.