oldarrearagefrm.pas

群星医药系统源码

    lbTransfer.Font.Color :=clBlue;
    with Node do begin
      ImageIndex :=23;
      SelectedIndex :=23;
      StateIndex :=-1;
    end;
  end;
  {str :=PString(Node.Data)^;
  str :='DepartId=' + str;}
  with cdsOldArrearage do begin
    if not Active then Open;
    Filtered :=false;
    Filter := str;
    Filtered := true;
    if IsEmpty then lbTransfer.Caption :='';
  end;
end;

procedure TFmOldArrearage.dbgOldArrearageEditButtonClick(Sender: TObject);
var sFieldName, sRet1, sRet2 : string;
begin
  if dbgOldArrearage.SelectedField = nil then exit;
  sFieldName := dbgOldArrearage.SelectedField.FieldName;
  if sFieldName = 'ProvNo' then begin
    if not SelectProv(sRet1,sRet2) then exit;
    with cdsOldArrearage do begin
      if (state <> dsInsert) and (state <> dsEdit) then Edit;
      FieldByName('ProvNo').AsString := sRet1;
      FieldByName('ProvName').AsString := sRet2;
    end;
  end else if sFieldName = 'GoodsID' then begin
    if not SelectGoodsID(sRet1,false) then exit;
    with cdsOldArrearage do begin
      if (state <> dsInsert) and (state <> dsEdit) then Edit;
      FieldByName('GoodsID').AsString := sRet1;
    end;
  end else if sFieldName = 'EmpNo' then begin
    if not SelectEmp(sRet1) then exit;
    with cdsOldArrearage do begin
      if (state <> dsInsert) and (state <> dsEdit) then Edit;
      FieldByName('EmpNo').AsString := sRet1;
    end;
  end;
end;

procedure TFmOldArrearage.ActNewExecute(Sender: TObject);
begin
  with cdsOldArrearage do
  if Active and (not (state in dsEditModes))  then Insert;
end;

procedure TFmOldArrearage.ActModifyExecute(Sender: TObject);
begin
  with cdsOldArrearage do
  if Active  and not ((state in dsEditModes)or(IsEmpty)) then Edit;
end;

procedure TFmOldArrearage.ActDeleteExecute(Sender: TObject);
begin
  with cdsOldArrearage do
  if Active and not ((state in dsEditModes)or(IsEmpty)) then Delete;
end;

procedure TFmOldArrearage.ActRefreshExecute(Sender: TObject);
begin
  with cdsOldArrearage do begin
    if (not Active) or IsEmpty then exit;
    if state in dsEditModes then Post;
    if ApplyUpdates(0)>0 then
      raise Exception.Create('提交数据出错!');
    Refresh;
  end;
end;

procedure TFmOldArrearage.edtProvNoButtonClick(Sender: TObject);
var sProvNo, sProvName : string;
begin
  with cdsOldArrearage do begin
    if not SelectProv(sProvNo,sProvName) then exit;
    edtProvNo.Text := sProvNo;
    lbProvName.Caption := sProvName;
    if (not Active) or IsEmpty then exit;
    Filtered :=false;
    Filter :='DepartID='+ IntToStr(Integer(tvDeparts.Selected.Data)) +
             ' AND ProvNo=' + QuotedStr(edtProvNo.Text);
    Filtered :=true;
  end;
end;

procedure TFmOldArrearage.BtnUnFilteredClick(Sender: TObject);
begin
  tvDepartsChange(tvDeparts, tvDeparts.Selected);
end;

procedure TFmOldArrearage.btnExitClick(Sender: TObject);
begin
  close;
end;

procedure TFmOldArrearage.BtnPopMenuClick(Sender: TObject);
var pt: TPoint;
begin
  pt.X :=BtnPopMenu.Left;
  pt.Y :=BtnPopMenu.Top + BtnPopMenu.Height;
  pt := BtnPopMenu.Parent.ClientToScreen(pt);
  TopPopMenu.Popup(pt.X,pt.Y);
end;

procedure TFmOldArrearage.cdsOldArrearageAfterInsert(DataSet: TDataSet);
var
  s1,s2 : string;
begin
  with DataSet do begin
    FieldByName('DepartID').AsInteger :=Integer(tvDeparts.Selected.Data);
    GetDepartNoAndName(tvDeparts.Selected.Text,s1,s2);
    FieldByName('DepartNo').AsString :=s1;
    FieldByName('DepartName').AsString :=s2;
    FieldByName('FDate').AsString := DateToStr(Now);
    if (not chkProvNo.Checked)or(edtProvNo.Text = '') then exit;
    FieldByName('ProvNo').AsString := edtProvNo.Text;
    FieldByName('ProvName').AsString := lbProvName.Caption ;
  end;
end;

procedure TFmOldArrearage.cdsOldArrearageAfterPost(DataSet: TDataSet);
begin
  if cdsOldArrearage.ApplyUpdates(0)>0 then
    MessageBox(Handle,'更新数据出错!',nil,MB_ICONHAND);
end;

procedure TFmOldArrearage.GetDepartNoAndName(sText: string; var sNo,
  sName: string);
begin
  sNo := Copy(sText,1,Pos('[',sText)-1);
  sName := Copy(sText,Pos('[',sText)+1,100);
  Delete(sName,Pos(']',sName),100);
end;

procedure TFmOldArrearage.tvDepartsCollapsing(Sender: TObject;
  Node: TTreeNode; var AllowCollapse: Boolean);
begin
  AllowCollapse := Node.Level>0;
end;

procedure TFmOldArrearage.cdsOldArrearageBeforePost(DataSet: TDataSet);
begin
  case DataSet.State of
  dsInsert :
    if not ActNew.Enabled then begin
      MessageBox(Handle,'你没有足够的权限新增数据。','警告',MB_ICONEXCLAMATION);
      abort;
    end;
  dsEdit :
    if not ActModify.Enabled then begin
      MessageBox(Handle,'你没有足够的权限修改数据。','警告',MB_ICONEXCLAMATION);
      abort;
    end;
  end;
end;

procedure TFmOldArrearage.ActFilterExecute(Sender: TObject);
begin
  with cdsOldArrearage do begin
    if (not Active) or IsEmpty then exit;
    Filtered := false;
    Filter := 'DepartID='+ IntToStr(Integer(tvDeparts.Selected.Data)) +
              ' AND ProvNo=' + QuotedStr(edtProvNo.Text);
    Filtered := true;
  end;
end;

procedure TFmOldArrearage.tvDepartsChanging(Sender: TObject;
  Node: TTreeNode; var AllowChange: Boolean);
begin
  if cdsOldArrearage.State in dsEditModes then begin
    AllowChange := false;
    MessageBox(Handle,'当前公司有编辑的数据未提交!','警告',MB_ICONEXCLAMATION);
  end;
end;

procedure TFmOldArrearage.btnPostClick(Sender: TObject);
begin
  with cdsOldArrearage do begin
    if (not Active) or IsEmpty then exit;
    if state in dsEditModes then post;
    if ApplyUpdates(0)>0 then
      MessageBox(Handle,'提交数据出错！',nil,MB_ICONHAND);
  end;
end;

procedure TFmOldArrearage.btnCancelClick(Sender: TObject);
begin
  with cdsOldArrearage do begin
    if (not Active) or IsEmpty then exit;
    if state in dsEditModes then Cancel;
    CancelUpdates;
  end;
end;

procedure TFmOldArrearage.cdsOldArrearagePaidUpChange(Sender: TField);
begin
  with cdsOldArrearage do begin
    FieldByName('UnPaid').AsFloat :=FieldByName('Amount').AsFloat - FieldByName('PaidUp').AsFloat;
    if FieldByName('UnPaid').AsFloat + FieldByName('PaidUp').AsFloat <> FieldByName('Amount').AsFloat then
      MessageBox(Handle,'应付金额与已付金额、欠款余额不匹配！',nil,MB_ICONHAND);
  end;
end;

procedure TFmOldArrearage.ActPrintExecute(Sender: TObject);
begin
  SelRepPrint(Self.Name,[cdsOldArrearage],'历史应付款',ActDesignReport.Enabled);
end;

procedure TFmOldArrearage.ActFieldLayoutExecute(Sender: TObject);
begin
  SetFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name, [dbgOldArrearage], '历史应付款');
end;

procedure TFmOldArrearage.ActDataExportExecute(Sender: TObject);
begin
  ExportData([cdsOldArrearage], '历史应付款', '');
end;

procedure TFmOldArrearage.ActRevertExecute(Sender: TObject);
var iDepartID: integer;
begin
  with cdsOldArrearage do if (not Active)or IsEmpty then exit;
  with tvDeparts do
  if Selected =nil then exit else if Selected.Data =nil then exit;
  iDepartID := Integer(tvDeparts.Selected.Data);
  with SvrArrearage do begin
    if not AppServer.IsAudited(iClientID,iDepartID,0) then
      raise Exception.Create('当前公司的历史应付款未审核过帐!');
    if AppServer.Revert(iClientID,iDepartID,0) then
      MessageBox(Handle,'历史应付款还原成功!','提示',MB_ICONINFORMATION)
    else
      MessageBox(Handle,'历史应付款还原失败!',nil,MB_ICONHAND);
  end;
end;

procedure TFmOldArrearage.ActAuditExecute(Sender: TObject);
var iDepartID,iBranchID,iMachineID: integer;
  sBranchMachine: String;
begin
  with cdsOldArrearage do if (not Active)or IsEmpty then exit;
  with tvDeparts do
  if Selected =nil then exit else if Selected.Data =nil then exit;
  iDepartID := Integer(tvDeparts.Selected.Data);
  with SvrArrearage do begin
    if AppServer.IsAudited(iClientID, iDepartID,0) then
      raise Exception.Create('当前公司的历史应付款已审核过帐!');
    iBranchID  := IFmMain.IFmMainEx.GetLocSetting^.BranchNo;
    iMachineId := IFmMain.IFmMainEx.GetLocSetting^.MachineNo;
    sBranchMachine := FormatFloat('000',iBranchID)+FormatFloat('00',iMachineID);
    if AppServer.Audit(iClientID, iDepartID,0,sBranchMachine) then
      MessageBox(Handle,'历史应付款审核成功!','提示',MB_ICONINFORMATION)
    else
      MessageBox(Handle,'历史应付款审核失败!',nil,MB_ICONHAND);
  end;
end;

procedure TFmOldArrearage.cdsOldArrearageBeforeInsert(DataSet: TDataSet);
var iDepartID: integer;
begin
  with tvDeparts do
  if Selected =nil then abort else if Selected.Data =nil then abort;
  iDepartID := Integer(tvDeparts.Selected.Data);
  with SvrArrearage do
  if AppServer.IsAudited(iClientID, iDepartID,0) then begin
    MessageBox(Handle,'当前公司的历史应付款已审核过帐!不能修改.','警告',MB_ICONEXCLAMATION);
    abort;
  end;
end;

initialization
  RegisterClass(TFmOldArrearage);

finalization
  UnRegisterClass(TFmOldArrearage);

end.