selexportfrm.pas

群星医药系统源码

procedure TFmSelExport.edProvNameButtonClick(Sender: TObject);
Var
  sCustNo,sCustName,sEmpNo,sPayModeNo : String;
begin
  If FEditMode=0 then Exit;
  sCustNo := CdsSelExportCustNo.Value;
  If SelectCust(sCustNo,sCustName,sEmpNo,sPayModeNo) then begin
    CdsSelExportCustNo.Value := sCustNo;
    CdsSelExportCustName.Value := sCustName;
    CdsSelExportEmpNo.Value := sEmpNo;
    CdsSelExportPayModeNo.Value := sPayModeNo;
  end;
end;

procedure TFmSelExport.RzDBButtonEdit1ButtonClick(Sender: TObject);
Var sEmpNo,sEmpName:String;
begin
  If FEditMode=0 then Exit;
  sEmpNo := CdsSelExportEmpNo.Value;
  If SelectEmp(sEmpNo,sEmpName) then begin
    CdsSelExportEmpNo.Value := sEmpNo;
    CdsSelExportEmpName.Value := sEmpName;
  end;
end;

procedure TFmSelExport.ShowPayModes;
Var
  A:Variant;
  iClientID, I, k:Integer;
begin
  Try
    iClientID := IFmMain.IFmMainEx.ClientID;
    A:=SvrSelExport.AppServer.GetNeedValue(iClientID,3,sPayModes);
    If (not VarIsNull(A)) And (VarIsArray(A)) then
    begin
      slPayModes.Clear;
      cbPayModes.Items.Clear;
      k := VarArrayHighBound(A,2);
      for i:=VarArrayLowBound(A,2) to k do
      begin
        slPayModes.Add(A[0,i]);
        cbPayModes.Items.Add(A[0,i]+':'+A[1,i]+'('+A[2,i]+')');
      end;
    end;
  Except
    On E:Exception Do
      Messagebox(Handle,Pchar(E.Message),'',16);
  end;
end;

procedure TFmSelExport.CdsSelExportDtlOPriceChange(Sender: TField);
begin
  SumCount;
end;

procedure TFmSelExport.SumCount;
Var
  dUnTaxPrice,dQty,dAmount,D,E,T:Double;
begin
  D:=CdsSelExportDtlOPrice.AsFloat;             //标准售价
  If CdsSelExportDtlRebate.IsNull then
    E := 100
  else
    E:=CdsSelExportDtlRebate.AsFloat;             //折扣
  T:=CdsSelExportDtlTaxRate.AsFloat;            //税率
  dQty:=CdsSelExportDtlQty.AsFloat;             //数量
  CdsSelExportDtlPrice.AsFloat:=D*(E/100);      //实际售价             //实际售价
  dUnTaxPrice:=D*(E/100)/(1+T/100);             //未税单价
  CdsSelExportDtlUnTaxPrice.AsFloat:=dUnTaxPrice;
  CdsSelExportDtlGoodsSum.AsFloat:=dQty*dUnTaxPrice;     //货款;
  dAmount:=dQty*D*(E/100);                       //合计;
  CdsSelExportDtlAmount.AsFloat:=dAmount;
  CdsSelExportDtlTaxSum.AsFloat:=dAmount-dQty*dUnTaxPrice;  //税款
end;

procedure TFmSelExport.CdsSelExportDtlQtyChange(Sender: TField);
begin
  SumCount;
end;

procedure TFmSelExport.CdsSelExportDtlTaxRateChange(Sender: TField);
begin
  SumCount;
end;

procedure TFmSelExport.CdsSelExportEmpNoChange(Sender: TField);
Var
  sEmpNo,sEmpName,LogText:String;
begin
  IF FEditMode=0 then Exit;
  sEmpNo:=CdsSelExportEmpNo.Value;
  If sEmpNo='' then Exit;
  if sEmpNo=BeforeEmpNo then Exit;
  BeforeEmpNo:=sEmpNO;
  sEmpName:=VarToStr(SvrCommon.AppServer.GetEmpInfo(iClientID,sEmpNo,1,'Name',LogText));
  CdsSelExportEmpName.Value:=sEmpName;
  If LogText<>'' then begin
    Messagebox(Handle,Pchar(LogText),'错误',16);
    DBEdit6.SetFocus;
    Abort;
  end;
end;

procedure TFmSelExport.CdsSelExportCustNoChange(Sender: TField);
Var
  sCustNo,sCustName,LogText:String;
begin
  IF FEditMode=0 then Exit;
  sCustNo:=CdsSelExportCustNo.Value;
  If sCustNo='' then Exit;
  if sCustNo=BeforeCustNo then Exit;
  BeforeCustNo:=sCustNO;
  sCustName:=VarToStr(SvrCommon.AppServer.GetCustInfo(iClientID,sCustNo,1,'CustName',LogText));
  CdsSelExportCustName.Value:=sCustName;
  If LogText<>'' then begin
    Messagebox(Handle,Pchar(LogText),'错误',16);
    DBEdit8.SetFocus;
    Abort;
  end;
end;

procedure TFmSelExport.CdsSelExportDtlGoodsIDChange(Sender: TField);
//var LogText,Flag,sGoodsID,sSetFields,sCustNo:String;
begin
{  IF FEditMode=0 then Exit;
  IF FlagGoodsID<>'' then begin
    FlagGoodsID:='';
    Exit;
  end;
//  If bBrowGoods then Exit;
  sGoodsID:=CdsSelExportDtlGoodsID.AsString;
  If sGoodsID='' then Exit;
  if (BeforeGoodsID=sGoodsID) then Exit;
  BeforeGoodsID:=sGoodsID;
  sSetFields:= 'Name,Specs,Unit';
  sCustNo := CdsSelExportCustNo.Value;
  FlagGoodsID:=GetGoodsInfo(CdsSelExportDtl,'OPrice',sGoodsID,sSetFields,sCustNo,'S',1);
  If FlagGoodsID='' then begin
    Messagebox(Handle,'无效药品编号',nil,16);
    Abort;
  end else begin
    if sGoodsID<>FlagGoodsID then
      CdsSelExportDtl.FieldByName('GoodsID').AsString:=FlagGoodsID
    else
      FlagGoodsID:='';
  end;}
  ParseGoodsInfo;
end;

procedure TFmSelExport.dbgSelExportDtlEditButtonClick(Sender: TObject);
var sField:String;
    iDepotID: Integer;
    DepotNo,DepotName: string;
    dPrice: Double;
begin
  If FEditMode=0 then Exit;
  sField :='';
  sField := Trim(LowerCase(DbgSelExportDtl.SelectedField.FieldName));
  If sField='goodsid' then begin
    ParseGoodsInfo;
  end
  else if sField='oprice' then
  begin
    dPrice := ViewGoodsPrice(CdsSelExportDtlGoodsID.Value, CdsSelExportDtlUnit.Value);
    if dPrice>=0 then
    begin
      CdsSelExportDtl.Edit;
      CdsSelExportDtlOprice.Value := dPrice;
    end;
  end
  else if (sField='batchno')or(sField='qty') then
  begin
    bBrowGoods := true;
    try
      SelectGoodsBatch(cdsSelExportDtl, -1, '.');
    finally
      bBrowGoods := false;
    end;
  end
  else if sField='depotno' then
  begin
    iDepotID := CdsSelExportDtlDepotID.Value;
    if SelectDepot(iDepotID,DepotNo,DepotName) then
    begin
      CdsSelExportDtlDepotID.Value := iDepotID;
      CdsSelExportDtlDepotNo.Value := DepotNo;
      CdsSelExportDtlDepotName.Value := DepotName;
    end;
  end;
end;


procedure TFmSelExport.CdsSelExportDtlDepotNOChange(Sender: TField);
var sDepotNo, LogText:String;
    A:Variant;
begin
  Try
    IF FEditMode=0 then Exit;
    sDepotNo:=CdsSelExportDtlDepotNO.Value;
    If sDepotNo='' then Exit;
    if sDepotNo=BeforeDepotNo then Exit;
    BeforeDepotNo:=sDepotNo;
    A := SvrCommon.AppServer.GetDepotInfo(iClientID,sDepotNo,2,'DepotID,DepotName',LogText);
    CdsSelExportDtlDepotID.Value  := A[0];
    CdsSelExportDtlDepotName.Value:= A[1];
    If LogText<>'' then begin
      Messagebox(Handle,Pchar('无效的仓库编号...'),'错误',16);
      Abort;
    end;
  Except
    Messagebox(Handle,Pchar('无效的仓库编号...'),'错误',16);
    Abort;
  end;
end;

procedure TFmSelExport.ActAuditExecute(Sender: TObject);
var str, sBillNo, MatchBillNo,sBranchMachine: String;
    iBranchID,iMachineId: Integer;
begin
  Try
    If CdsSelExport.IsEmpty then Exit;
    If FEditMode>0 then Exit;
    Inherited;
    If Application.MessageBox('确实要审核当前数据吗？','提示',4+32)<>6 then Exit;
    if not CheckBillDateValid(cdsSelExportFDate.Value) then Exit;
    sBillNo := CdsSelExportBillNo.AsString;
    if sBillNo='' then Exit;
    iBranchID  := iFmMain.IFmMainEx.GetLocSetting^.BranchNo;
    iMachineId := IFmMain.IFmMainEx.GetLocSetting^.MachineNo;
    sBranchMachine := FormatFloat('000',iBranchID)+FormatFloat('00',iMachineID);
    If SvrSelExport.AppServer.BillTurn(iClientID, 'SelExport', 'StockOut', sBillNo, sBranchMachine, MatchBillNo) then
    begin
      ActAudit.Enabled:=False and CanAudit;
      ActRevert.Enabled:=True and CanRevert;
      Lab_State.Caption:='单据状态：已审核';
      Lab_State.Font.Color:=clRed;
      ActRefresh.Execute;
      str := sBillNo+'号销售开单已成功转出到['+MatchBillNo+']号出库单，要查看该单据吗？';
      if Application.MessageBox(PChar(str), '消息', MB_YESNO+MB_ICONINFORMATION)=IDYES then
        IFmMain.DoSome(ActAudit.ModuleFile, 'ViewBill', MatchBillNo);
    end else
      Messagebox(Handle,'审核数据不成功！','错误',16);
  Except
    On E:Exception Do
      Messagebox(Handle,Pchar(E.Message),'错误',16);
  end;
end;

procedure TFmSelExport.ActRevertExecute(Sender: TObject);
var BillNo, PBillNo : String;
begin
  try
    If CdsSelExport.IsEmpty then Exit;
    If FEditMode>0 then Exit;
    Inherited;
    if Application.MessageBox('确实要还原当前已审核过的数据吗？','提示',4+32)<>6 then Exit;
    BillNo  := CdsSelExportBillNo.Value ;
    PBillNo := CdsSelExportOrderNo.Value ;
    if not(SvrSelExport.AppServer.BillRevert(iClientID,'SelExport',BillNo,PBillNo)) then
    begin
      Messagebox(Handle,'还原数据不成功！','错误',16);
    end else
    begin
      ActAudit.Enabled  := True and CanAudit;
      ActRevert.Enabled := False and CanRevert;
      Lab_State.Caption := '单据状态：未审核';
      Lab_State.Font.Color := clHotLight;
      ActRefresh.Execute;
    end;
  except
    on E:Exception do
      Application.MessageBox(Pchar(E.Message),'错误',16);
  end;
end;

procedure TFmSelExport.ActFieldLayoutExecute(Sender: TObject);
begin
  SetFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name,
                  [dbgSelExportDtl,dbgSelExpense],'销售开单明细;销售开单费用');
end;

procedure TFmSelExport.ActDataExportExecute(Sender: TObject);
begin
	ExportData([CdsSelExport, CdsSelExportDtl,CdsSelExpense],'销售开单;销售开单明细,销售开单费用', '');
end;

function TFmSelExport.DoSome(cType: PChar; Values: Variant): Variant;
const
  cTypes = 'viewbill'#13'query';
  //       查看某单     查询
var sTypes: TStrings;
    i: 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 TFmSelExport.RzDBButtonEdit2ButtonClick(Sender: TObject);
Var
  sCustNo,sLinkMan : String;
begin
  If FEditMode=0 then Exit;
  If DBEdit8.Text='' then begin
    MessageBox(Handle,Pchar('请先指定客户单位!'),'错误:',16);
    Exit;
  end;
  sCustNo := CdsSelExportCustNo.Value;
  If SelectCustLinkMan(sCustNo,sLinkMan) then
    CdsSelExportLinkMan.Value := sLinkMan ;
end;

procedure TFmSelExport.dbgSelExportDtlKeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
var field: TField;
    col: TColumnEh;
begin
  if Key=13 then
  begin
    Field := dbgSelExportDtl.SelectedField;
    if Field=nil then Exit;
    col := dbgSelExportDtl.FieldColumns[Field.FieldName];
    //如果当前列为空且该列不允许为空或该列可通过对话框选值，则不跳到下一列
    if Field.IsNull and (Field.Required or (col.ButtonStyle=cbsEllipsis)) then
      dbgSelExportDtl.OptionsEh := dbgSelExportDtl.OptionsEh-[dghEnterAsTab]
    else
      dbgSelExportDtl.OptionsEh := dbgSelExportDtl.OptionsEh+[dghEnterAsTab];
  end;
end;

procedure TFmSelExport.ActQueryExecute(Sender: TObject);
begin
  IFmMain.OnAction(Sender);
end;

procedure TFmSelExport.cbPayModesChange(Sender: TObject);
Var iIndex : Integer;
begin
  iIndex:=cbPayModes.ItemIndex;
  if iIndex<>-1 then
    CdsSelExportPayModeNo.Value:=slPayModes[iIndex];
end;

procedure TFmSelExport.ParseGoodsInfo;
var sCustNo, sGoodsID, sUnit: String;
    dPrice: Double;
    b1: Boolean;
begin
  if FEditMode=0 then Exit;
  if bBrowGoods then Exit;
  bBrowGoods := true;
  try
    b1:=SelectGoods(CdsSelExportDtl, CdsSelExportDtlGoodsID, CdsSelExportDtlUnit, true, False, False);
    if not b1 then abort;
    sGoodsID := CdsSelExportDtlGoodsID.Value;
    sCustNo := CdsSelExportCustNo.Value;
    sUnit := CdsSelExportDtlUnit.Value;
    if (sGoodsID<>'') And (sUnit<>'') then begin
      dPrice := SvrCommon.AppServer.GetGoodsPrice(IClientID,'S',sCustNo,sGoodsID,sUnit);
      if dPrice<>0 then
        CdsSelExportDtlOprice.Value := dPrice;
    end;
  finally
    bBrowGoods := false;
  end;
end;

Initialization
  RegisterClass(TFmSelExport);
Finalization
  UnRegisterClass(TFmSelExport);

end.