.#stockmovefm.pas.1.26

来自「群星医药系统源码」· 26 代码 · 共 648 行 · 第 1/2 页

Begin
  IF FEditMode=0 Then Exit;
  IF FlagGoodsID<>'' Then Begin
    FlagGoodsID:='';
    Exit;
  End;
  If bBrowGoods then Exit;
  sGoodsID:=CdsStockMoveDtlGoodsID.AsString;
  If sGoodsID='' Then Exit;
  if (BeforeGoodsID=sGoodsID) Then Exit;
  BeforeGoodsID:=sGoodsID;
  sSetFields:= 'Name,Specs,Unit';
  FlagGoodsID:=GetGoodsInfo(CdsStockMoveDtl,'Price',sGoodsID,sSetFields,'','S',1);
  If FlagGoodsID='' Then Begin //原为FlagGoodsID<>''，药品有效时反而报错
    Messagebox(Handle,'无效药品编号','错误',16);
    Abort;
  End Else Begin
    If sGoodsID<>FlagGoodsID then
      CdsStockMoveDtl.FieldByName('GoodsID').AsString:=FlagGoodsID
    Else
      FlagGoodsID:='';
  End;}
begin
  ParseGoodsInfo;
End;

procedure TFmStockMove.CdsStockMoveAfterScroll(DataSet: TDataSet);
begin
  If CdsStockMoveTransfer.Value Then Begin
    ActAudit.Enabled:=False and CanAudit;
    ActRevert.Enabled:=True and CanRevert;
    Lab_State.Caption:='单据状态：已审核';
    Lab_State.Font.Color:=clRed;
  End Else Begin
    ActAudit.Enabled:=True and CanAudit;
    ActRevert.Enabled:=False and CanRevert;
    Lab_State.Caption:='单据状态：未审核';
    Lab_State.Font.Color:=clHotLight;
    ActRefreshExecute(NIl);
  End;
end;

procedure TFmStockMove.CdsStockMoveNewRecord(DataSet: TDataSet);
begin
  CdsStockMoveCreater.Value := LogonInfo^.UserID;
  CdsStockMoveGrup.Value := LogonInfo^.UserGrupID;
  CdsStockMoveFDate.Value:=Date;
  CdsStockMoveBillNo.Value := BuildBillNo('StockMove');
end;

procedure TFmStockMove.CdsStockMoveReconcileError(
  DataSet: TCustomClientDataSet; E: EReconcileError;
  UpdateKind: TUpdateKind; var Action: TReconcileAction);
begin
  MessageBox(Handle,Pchar(E.Message),'',16);
  Action:=raAbort;
end;

procedure TFmStockMove.CdsStockMoveDtlBeforeInsert(DataSet: TDataSet);
begin
  iLastItemNO := GetFieldMaxInt(CdsStockMoveDtl, 'ItemNo')+1;
end;

procedure TFmStockMove.CdsStockMoveDtlNewRecord(DataSet: TDataSet);
begin
  inherited;
  BeforeGoodsID:='';
  CdsStockMoveDtlItemNo.Value:=iLastItemNO;
  CdsStockMoveDtlBillNo.Value:=CdsStockMoveBillNo.Value;
  CdsStockMoveDtlValidDate.Value:=IncMonth(Date,12);
end;

procedure TFmStockMove.CdsStockMoveDtlAfterPost(DataSet: TDataSet);
Var
  D,dAmount:Double;
  Abk:TBookMark;
begin
  BeforeGoodsID:='';
  With CdsStockMoveDtl Do Begin
    D:=0;
    dAmount:=0;
    Try
      Abk:=GetBookmark;
      DisableControls;
      First;
      while Not Eof Do Begin
        D:=D+CdsStockMoveDtlQty.Value;
        dAmount:=dAmount+CdsStockMoveDtlAmount.Value;
        Next;
      End;
      CdsStockMoveNumCount.Value:=D;
      CdsStockMoveTotal.Value:=dAmount;
    Finally
      GotoBookmark(Abk);
      FreeBookmark(Abk);
      EnableControls;
    End;
  End;
End;

procedure TFmStockMove.CdsStockMoveDtlQtyChange(Sender: TField);
Var dQty,dPrice:Double;
begin
  dQty:=CdsStockMoveDtlQty.Value;
  dPrice:=CdsStockMoveDtlPrice.Value;
  CdsStockMoveDtlAmount.Value:=dQty*dPrice;
end;

procedure TFmStockMove.ActRevertExecute(Sender: TObject);
begin
  Try
    If CdsStockMove.IsEmpty Then Exit;
    If FEditMode>0 then Exit;
    If Application.MessageBox('确实要还原当前已审核过的数据吗？','提示：',4+32)<>6 Then Exit;
    CdsStockMove.Edit;
    CdsStockMoveTransfer.Value:=False;
    CdsStockMoveAudit.Value := '';
    try
      CdsStockMove.Post;
    Except
      CdsStockMove.Cancel;
      Raise;
    end;
    If CdsStockMove.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 TFmStockMove.ActFieldLayoutExecute(Sender: TObject);
begin
  SetFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name,
                  [dbgStockInDtl],'药品调拨明细');
end;

procedure TFmStockMove.ActDataExportExecute(Sender: TObject);
begin
	ExportData([CdsStockMove, CdsStockMoveDtl],'药品调拨单;药品调拨明细', '');
end;

procedure TFmStockMove.ActAddSubItemExecute(Sender: TObject);
begin
  If FEditMode=0 Then Exit;
  IF Not(CdsStockMove.State In dsEditModes) Then Exit;
  CdsStockMoveDtl.append;
end;

procedure TFmStockMove.ActDelSubItemExecute(Sender: TObject);
begin
  If FEditMode=0 Then Exit;
  If NOt(CdsStockMove.State In dsEditModes) Then Exit;
	if CdsStockMoveDtl.IsEmpty then Exit;
  CdsStockMoveDtl.Delete;
end;

procedure TFmStockMove.dbgStockInDtlEditButtonClick(Sender: TObject);
Var
  sField: String;
  dPrice: Double;
  iDepotID: Integer;
  sBerthNo: String;
Begin
  If FEditMode=0 Then Exit;
  sField :='';
  sField := Trim(LowerCase(dbgStockInDtl.SelectedField.FieldName));
  If sField='goodsid' Then
    ParseGoodsInfo
  Else If sField='price' Then
  Begin
    dPrice := ViewGoodsPrice(CdsStockMoveDtlGoodsID.Value, CdsStockmoveDtlUnit.Value);
    If dPrice>=0 Then Begin
      CdsStockMoveDtl.Edit;
      CdsStockMoveDtlprice.Value := dPrice;
    End;
  End
  else if sField='berth' then
  begin
    If CdsStockMoveDepotID.IsNull Then
    Begin
      Application.MessageBox('请先指定调出仓库!','提示',MB_OK+MB_ICONINFORMATION);
      Exit;
    End;
    iDepotID := CdsStockMoveDepotID.Value;
    If SelectBerth(iDepotID,sBerthNo) Then
    begin
      CdsStockMoveDtl.Edit;
      CdsStockMoveDtlBerth.Value := sBerthNO;
    end;
  end
  else if sField='' then
  begin
    If CdsStockMoveToDepotID.IsNull Then
    Begin
      MessageBox(Handle,Pchar('请先指定调入仓库!'),'错误:',16);
      Exit;
    End;
    iDepotID := CdsStockMoveToDepotID.Value;
    If SelectBerth(iDepotID,sBerthNo) Then
      CdsStockMoveDtlToBerth.Value := sBerthNO;
  end;
End;


procedure TFmStockMove.RzDBButtonEdit2ButtonClick(Sender: TObject);
Var sEmpNo,sEmpName:String;
begin
  If FEditMode=0 Then Exit;
  sEmpNo := CdsStockMoveEmpNo.Value;
  If SelectEmp(sEmpNo,sEmpName) Then begin
    CdsStockMoveEmpNo.Value := sEmpNo;
    CdsStockMoveName.Value := sEmpName;
  End;
end;

procedure TFmStockMove.edEmpIDButtonClick(Sender: TObject);
Var sEmpNo,sEmpName:String;
begin
  If FEditMode=0 Then Exit;
  sEmpNo := CdsStockMoveShipper.Value;
  If SelectEmp(sEmpNo,sEmpName) Then begin
    CdsStockMoveShipper.Value := sEmpNo;
    CdsStockMoveShipperName.Value := sEmpName;
  End;
end;

procedure TFmStockMove.RzDBButtonEdit1ButtonClick(Sender: TObject);
var iDepotID: Integer;
    DepotNo,DepotName: string;
begin
  If FEditMode=0 Then Exit;
  iDepotID := CdsStockMoveDepotID.Value;
  If SelectDepot(iDepotID,DepotNo,DepotName) Then Begin
    CdsStockMoveDepotID.Value := iDepotID;
    CdsStockMoveDepotNo.Value := DepotNo;
    CdsStockMoveDepotName.Value := DepotName;
  End;
end;

procedure TFmStockMove.edDepotButtonClick(Sender: TObject);
var iToDepotID: Integer;
    ToDepotNo,ToDepotName: string;
begin
  If FEditMode=0 Then Exit;
  iToDepotID := CdsStockMoveToDepotID.Value;
  If SelectDepot(iToDepotID,ToDepotNo,ToDepotName) Then Begin
    CdsStockMoveToDepotID.Value := iToDepotID;
    CdsStockMoveToDepotNo.Value := ToDepotNo;
    CdsStockMoveToDepotName.Value := ToDepotName;
  End;
end;

function TFmStockMove.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;
      SetCurrBillNo(str);
    end;
  end;
end;

procedure TFmStockMove.ActInsertExecute(Sender: TObject);
begin
  inherited;
  cdsStockMove.Append;
  edDate.Date := now;
  BeforeDepotNo := '';
  BeforeToDepotNo:='';
end;

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

procedure TFmStockMove.ParseGoodsInfo;
begin
  if FEditMode=0 then Exit;
  if bBrowGoods then Exit;
  bBrowGoods := true;
  try
    SelectGoods(CdsStockMoveDtl, CdsStockMoveDtlGoodsID, CdsStockMoveDtlUnit, true, False, False);
  finally
    bBrowGoods := false;
  end;
end;

initialization
  RegisterClass(TFmStockMove);
finalization
  UnRegisterClass(TFmStockMove);


end.