stockteardownfrm.pas

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

procedure TFmStockTeardown.cdsStockTeardownQtyChange(Sender: TField);
var
  dAmount: Double;
begin
  dAmount := cdsStockTeardownQty.Value;
  dAmount := dAmount * cdsStockTeardownPrice.Value;
  cdsStockTeardownAmount.Value := dAmount;
end;

procedure TFmStockTeardown.cdsStockTeardownDtlGoodsIDChange(Sender: TField);
Var
  LogText,Flag,sGoodsID,sSetFields:String;
Begin
  if FEditMode=0 then Exit;
  sGoodsID:=cdsStockTeardownDtlGoodsID.AsString;
  if sGoodsID='' then Exit;
  sSetFields:= 'Name,Specs,Unit,Maker,PdcAddr';
  Flag:=GetGoodsInfo(cdsStockTeardownDtl,'Price',sGoodsID,sSetFields,'','S',1);
  if Flag='' then
  begin
    Messagebox(Handle,'无效药品编号','错误',16);
    Abort;
  end;
end;

procedure TFmStockTeardown.cdsStockTeardownGoodsIDChange(Sender: TField);
Var
  LogText,Flag,sGoodsID,sSetFields:String;
Begin
  if FEditMode=0 then Exit;
  sGoodsID:=cdsStockTeardownGoodsID.AsString;
  if sGoodsID='' then Exit;
  sSetFields:= 'Name,Unit';
  Flag:=GetGoodsInfo(cdsStockTeardown,'Price',sGoodsID,sSetFields,'','S',1);
  if Flag='' then
  begin
    Messagebox(Handle,'无效药品编号','错误',16);
    Abort;
  end;
end;

procedure TFmStockTeardown.dbgStockTeardownDtlEditButtonClick(
  Sender: TObject);
var
  Field: TField;
  s1,s2: string;
  iDepotID: integer;
begin
  if (cdsStockTeardown.State in dsEditModes)and(not (cdsStockTeardownDtl.State in dsEditModes)) then
    cdsStockTeardownDtl.Edit;
  if not (cdsStockTeardownDtl.State in dsEditModes) then exit;
  Field := dbgStockTeardownDtl.SelectedField;
  if Field = nil then exit;
  if LowerCase(Field.FieldName)='goodsid' then
  begin
    SelectGoods(cdsStockTeardownDtl,Field,cdsStockTeardownDtlUnit,true,false,false);
  end
  else if LowerCase(Field.FieldName)='berthno' then
  begin
    s1 := Field.AsString;
    iDepotID := cdsStockTeardownDepotID.Value;
    if SelectBerth(iDepotID,s1) then
      Field.AsString := s1;
  end;
end;

procedure TFmStockTeardown.edDepotNoButtonClick(Sender: TObject);
var
  iDepotID: integer;
  sDepotNo,sDepotName: string;
begin
  if FEditMode = 0 then exit;
  iDepotID := cdsStockTeardownDepotID.Value;
  if SelectDepot(iDepotID,sDepotNo,sDepotName) then
  begin
    edDepotNo.Field.AsString := sDepotNo;
    edDepotName.Field.AsString := sDepotName;
    edDepotNo.Tag := iDepotID;
    cdsStockTeardownDepotID.Value := iDepotID;
  end;
end;

procedure TFmStockTeardown.edDepotNoKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key=13)and(ssCtrl in Shift) then
    edDepotNoButtonClick(nil);
end;

procedure TFmStockTeardown.edBatchNoButtonClick(Sender: TObject);
var s: String;
begin
  if not (edBatchNo.Field.DataSet.State in dsEditModes) then exit;
  s := edBerthNo.Text;
  if s='' then s:='.';
  if ViewGoodsBatch(edDepotNo.Tag, edGoodsID.Text, edUnit.Text, s) then
    edBatchNo.Field.AsString := FmSelectBatchNo.cdsStock.FieldByName('BatchNo').AsString;
end;

procedure TFmStockTeardown.edUnitKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (key=13)and(ssCtrl in Shift) then
    edBatchNoButtonClick(nil);
end;

procedure TFmStockTeardown.edBatchNoKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (key=13)and(ssCtrl in Shift) then
    edBatchNoButtonClick(nil);
end;

procedure TFmStockTeardown.edGoodsIDButtonClick(Sender: TObject);
var
  sGoodsID: string;
begin
  if FEditMode=0 then exit;
  sGoodsID := edGoodsID.Text;
  if SelectGoodsID(sGoodsID,false) then
    edGoodsID.Text := sGoodsID;
end;

procedure TFmStockTeardown.edGoodsIDKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (key=13)and(ssCtrl in Shift) then
    edGoodsIDButtonClick(nil);
end;

procedure TFmStockTeardown.edBerthNoButtonClick(Sender: TObject);
var
  iDepotID: integer;
  sBerthNo: string;
begin
  if FEditMode=0 then exit;
  iDepotID := cdsStockTeardownDepotID.Value;
  if iDepotID = 0 then exit;
  if SelectBerth(iDepotID,sBerthNo) then
    edBerthNo.Text := sBerthNo;
end;

procedure TFmStockTeardown.edBerthNoKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (key=13)and(ssCtrl in Shift) then
    edBerthNoButtonClick(nil);
end;

procedure TFmStockTeardown.edProvNoButtonClick(Sender: TObject);
var
  sProvName,sProvNo: string;
begin
  if FEditMode=0 then exit;
  sProvNo := edProvNo.Text;
  if SelectProv(sProvNo,sProvName) then
  begin
    edProvNo.Text := sProvNo;
    edProvName.Text := sProvName;
  end;
end;

procedure TFmStockTeardown.edProvNoKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (key=13)and(ssCtrl in Shift) then
    edProvNoButtonClick(nil);
end;

procedure TFmStockTeardown.edEmpNoButtonClick(Sender: TObject);
var
  sEmpNo,sEmpName: string;
begin
  if FEditMode=0 then exit;
  sEmpNo := edEmpNo.Text;
  if SelectEmp(sEmpNo,sEmpName) then
  begin
    edEmpNo.Field.AsString := sEmpNo;
    edEmpName.Field.AsString := sEmpName;
  end;
end;

procedure TFmStockTeardown.edEmpNoKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (key=13)and(ssCtrl in Shift) then
    edEmpNoButtonClick(nil); 
end;

procedure TFmStockTeardown.ActAuditExecute(Sender: TObject);
var
  Str:string;
  sSysInfo : Variant;
begin
  if (FEditMode <> 0)or cdsStockTeardown.IsEmpty then Exit;
  inherited;
  if cdsStockTeardownTransfer.Value then
  begin
    MessageBox(Handle,'该单据已审核！','警告',MB_ICONEXCLAMATION);
    exit;
  end;
  if MessageBox(Handle,'单据审核后将不允许修改，确实要审核当前单据吗？','提示',MB_YESNO or MB_ICONEXCLAMATION)=IDNO then Exit;
  str := 'CurrMonth';
  sSysInfo := SvrCommon.AppServer.GetSysInfo(iClientID,Str,1);
  if not(VarIsNull(sSysInfo)) then begin
    If cdsStockTeardownFDate.Value<VarToDateTime(sSysInfo) then
    begin
      Messagebox(Handle,'该月已结算，不能操作已月结的单据！',nil,16);
      Exit;
    end;
  end
  else
  begin
    Messagebox(Handle, '请先设置开帐日期！' ,nil,16);
    Exit;
  end;
  if not SvrStockTeardown.AppServer.BillAudit(iClientID, 'StockTeardown', cdsStockTeardownBillNo.Value) then
    Messagebox(Handle,Pchar('审核单据失败！'),nil,16)
  else
  begin
    ActRefreshExecute(nil);
    ActAudit.Enabled := not cdsStockTeardownTransfer.Value ;
    ActRevert.Enabled := cdsStockTeardownTransfer.Value;
    lbStatus.Font.Color := clBlue;
  end;
end;

procedure TFmStockTeardown.ActRevertExecute(Sender: TObject);
var
  Str:string;
  sSysInfo : Variant;
begin
  if (FEditMode <> 0)or cdsStockTeardown.IsEmpty then Exit;
  inherited;
  if not cdsStockTeardownTransfer.Value then
  begin
    MessageBox(Handle,'该单据未审核！','警告',MB_ICONEXCLAMATION);
    exit; 
  end;
  str := 'CurrMonth';
  sSysInfo := SvrCommon.AppServer.GetSysInfo(iClientID,Str,1);
  if not(VarIsNull(sSysInfo)) then begin
    If cdsStockTeardownFDate.Value<VarToDateTime(sSysInfo) then begin
      Messagebox(Handle,'不能操作已月结的单据！',nil,16);
      Exit;
    end;
  end
  else
  begin
    Messagebox(Handle, '请先设置开帐日期！' ,nil,16);
    Exit;
  end;
  if not SvrStockTeardown.AppServer.BillRevert(iClientID,'StockTeardown', cdsStockTeardownBillNo.Value) then
    Messagebox(Handle,Pchar('还原单据失败！'),nil,16)
  else
  begin
    ActRefreshExecute(nil);
    ActAudit.Enabled := not cdsStockTeardownTransfer.Value ;
    ActRevert.Enabled := cdsStockTeardownTransfer.Value;
    lbStatus.Font.Color := clRed;
  end;
end;

procedure TFmStockTeardown.ActFieldLayoutExecute(Sender: TObject);
begin
  SetFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name,
                  [dbgStockTeardownDtl],'药品拆卸加工明细');
end;

procedure TFmStockTeardown.ActDataExportExecute(Sender: TObject);
begin
	ExportData([cdsStockTeardown, cdsStockTeardownDtl],'药品拆卸加工;药品拆卸加工', '');
end;

procedure TFmStockTeardown.ActUpdateExecute(Sender: TObject);
begin
  inherited;
  cdsStockTeardownDtl.Edit;
end;

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

initialization
  RegisterClass(TFmStockTeardown);

finalization
  UnRegisterClass(TFmStockTeardown);

end.