customerfrm.~pas

医药连锁经营管理系统源码

End;

procedure TFmCustomers.ActModifyExecute(Sender: TObject);
begin
  IF CdsCustomers.IsEmpty THEN
  begin
    MessageBox(handle,'请先新增数据!','提示',MB_OK);
    Exit;
  end;
	with TFmCustEd.Create(self) do begin
    SvrCustEd:=SvrCustomers;
    dsCustEd.DataSet := CdsCustomers;
    CdsCustomers.Edit;
    iModeNo:=CdsCustomers.fieldbyname('PriceMode').AsInteger;
    edCustNO.ReadOnly:=True;
    If (ShowModal<>mrOk) then Begin
      CdsCustomers.Cancel;
      CdsCustomers.CancelUpdates;
    End;
    Free;
  End;
end;


procedure TFmCustomers.ActDeleteExecute(Sender: TObject);
begin
  try
    If cdsCustomers.IsEmpty then exit;
    if Application.MessageBox('确定删除当前客户资料吗？', '删除', MB_YESNO+MB_ICONQUESTION)=IDYES then begin
      CdsCustomers.Delete;
      If CdsCustomers.ApplyUpdates(0)>0 Then Begin
        Messagebox(Handle,Pchar('提交数据失败!'),'错误',16);
        Exit;
      End;
    End;
  except
    MessageBox(handle,'删除数据错误，可能数据已被其它表大量引用！','提示',MB_ICONWARNING+MB_OK);
  end;
end;

procedure TFmCustomers.CdsCustomersBeforeGetRecords(Sender: TObject;
  var OwnerData: OleVariant);
var val: Variant;
begin
  val := OwnerData;
  OwnerData := VarArrayCreate([0,1], varVariant);
  OwnerData[0] := val;
  OwnerData[1] := vOwnerData;
end;

procedure TFmCustomers.ActMoreExecute(Sender: TObject);
Var
  abK:TBookMark;
begin
  Try
    If Packetrcs<0 Then
      CdsCustomers.PacketRecords:=-1
    Else
      CdsCustomers.PacketRecords:=Packetrcs;
    If (Not bTrueEof) Then
    Begin
      abK:=CdsCustomers.GetBookmark;
      if abk<>PublicMark Then
        Abk:=PublicMark;
      Try
        if (CdsCustomers.GetNextPacket<CdsCustomers.PacketRecords) Then
        Begin
          bTrueEof:=True;
          ActMore.Enabled:=False;
        End;
        CdsCustomers.Last;
        vOwnerData:=CdsCustomers.FieldByname('CustNo').Value;
        CdsCustomers.GotoBookmark(abK);
        CdsCustomers.Next;
      Finally
        CdsCustomers.FreeBookmark(abK);
      End;
    End;
  Except
    On E:exception Do
      Messagebox(Handle,Pchar(E.Message),'',16);
  End;
End;

procedure TFmCustomers.ActExitExecute(Sender: TObject);
begin
	Close;
end;

procedure TFmCustomers.CdsCustomersReconcileError(
  DataSet: TCustomClientDataSet; E: EReconcileError;
  UpdateKind: TUpdateKind; var Action: TReconcileAction);
begin
  Messagebox(Handle,Pchar(E.Message),'',16);
  Abort;
end;

procedure TFmCustomers.CdsCustGoodsNewRecord(DataSet: TDataSet);
begin
  CdsCustGoodsCustNo.Value := CdsCustomersCustNo.Value;
  cdsCustGoodsDataUsable.Value := true; 
  CdsCustGoodsNearDate.Value := Date;
end;

procedure TFmCustomers.CdsCustLinkmansNewRecord(DataSet: TDataSet);
begin
  CdsCustLinkmansCustNo.value := CdsCustomersCustNo.Value;
end;

procedure TFmCustomers.CdsCustGoodsGoodsidChange(Sender: TField);
Var
  LogText,Flag,sGoodsID,sSetFields:String;
Begin
  IF FlagGoodsID<>'' Then Begin
    FlagGoodsID:='';
    Exit;
  End;
  If bBrowGoods then Exit;
  sGoodsID:=CdsCustGoodsGoodsID.AsString;
  If sGoodsID='' Then Exit;
  if (BeforeGoodsID=sGoodsID) Then Exit;
  BeforeGoodsID:=sGoodsID;
  sSetFields:= 'Name,Specs,Unit1,Unit2';
  FlagGoodsID := GetGoodsInfo(CdsCustGoods,'OPrice',sGoodsID,sSetFields, '','S', 0);
  If FlagGoodsID='' Then Begin
    Messagebox(Handle,'无效药品编号','错误',16);
    Abort;
  End Else Begin
    if sGoodsID<>FlagGoodsID then
      CdsCustGoods.FieldByName('GoodsID').AsString:=FlagGoodsID
    Else
      FlagGoodsID:='';
  End;
End;

procedure TFmCustomers.ActNewLinkManExecute(Sender: TObject);
begin
  if cdsCustomers.IsEmpty then Exit;
  CdsCustomers.Edit;
  CdsCustLinkmans.Append;
  with TFmCustLinkMans.Create(self) do begin
    if ShowModal=mrOk then
      cdsCustomers.ApplyUpdates(0)
    Else
      CdsCustLinkMans.CancelUpdates;
    Free;
  end;
end;

procedure TFmCustomers.ActEditLinkManExecute(Sender: TObject);
begin
  if CdsCustLinkmans.IsEmpty then Exit;
  CdsCustomers.Edit;
  with TFmCustLinkMans.Create(self) do begin
    if ShowModal=mrOk then
      CdsCustomers.ApplyUpdates(0)
    Else
      CdsCustLinkMans.CancelUpdates;
    Free;
  end;
end;

procedure TFmCustomers.ActDelLinkManExecute(Sender: TObject);
begin
  if CdsCustLinkmans.IsEmpty then Exit;
  if Application.MessageBox('确定删除当前客户联系人资料吗？', '消息', MB_YESNO+MB_ICONQUESTION)=IDNO then
    Exit;
  CdsCustomers.Edit;    
  CdsCustLinkmans.Delete;
  CdsCustomers.ApplyUpdates(0);
end;

procedure TFmCustomers.ActNewCustGoodsExecute(Sender: TObject);
Var I:integer;
begin
  if cdsCustomers.IsEmpty then Exit;
  with TFmCustGoodsEd.Create(self) do begin
    i:=CdsCustGoods.RecordCount;
    CdsCustomers.Edit;
    CdsCustGoods.Append;
    if ShowModal=mrOk then Begin
      CdsCustomers.RefreshRecord;
      CdsCustGoods.RecNo := i+1;
    End;
    Free;
  end;
end;

procedure TFmCustomers.ActEditCustGoodsExecute(Sender: TObject);
begin
  if CdsCustGoods.IsEmpty then Exit;
  cdsCustGoods.Edit;
  with TFmCustGoodsEd.Create(self) do begin
    if ShowModal=mrOk then
      CdsCustomers.RefreshRecord;
    Free;
  end;
end;

procedure TFmCustomers.ActDelCustGoodsExecute(Sender: TObject);
begin
  if CdsCustGoods.IsEmpty then Exit;
  if Application.MessageBox('确定删除当前协议品种资料吗？', '消息', MB_YESNO+MB_ICONQUESTION)=IDNO then
    Exit;
  CdsCustomers.Edit;    
  CdsCustGoods.Delete;
  CdsCustomers.ApplyUpdates(0);
end;

procedure TFmCustomers.ActPrintExecute(Sender: TObject);
begin
  if not CdsCustGoods.Active then CdsCustGoods.Open;
  if not CdsCustLinkmans.Active then CdsCustLinkmans.Open;
  SelRepPrint(Name, [CdsCustomers, CdsCustGoods,CdsCustLinkmans], '客户基本资料;协议品种管理;客户联系管理', ActDesignReport.Enabled);
end;

procedure TFmCustomers.CdsCustomersAfterOpen(DataSet: TDataSet);
begin
  with DataSet as TckClientDataSet do begin
    if VarIsNull(vOwnerData) then begin
      last;
      vOwnerData:=Fieldbyname('CustNo').Value;
    end;
  end;
end;

procedure TFmCustomers.CdsCustomersBeforeRefresh(DataSet: TDataSet);
begin
  vOwnerData := null;
end;

procedure TFmCustomers.CdsCustomersBeforeOpen(DataSet: TDataSet);
begin
  vOwnerData := null;
end;

procedure TFmCustomers.CdsCustomersAfterGetRecords(Sender: TObject;
  var OwnerData: OleVariant);
begin
  PublicMark:=CdsCustomers.GetBookmark;
end;

procedure TFmCustomers.BtnPopMenuClick(Sender: TObject);
Var tp:TPoint;
begin
  tp.X:=BtnPopMenu.Left;
	tp.y:=BtnPopMenu.Top+BtnPopMenu.Height+1;
	tp:=ClientToScreen(tp);
	TopPopmenu.Popup(tp.x,tp.Y);
end;

procedure TFmCustomers.ActFieldsLayOutExecute(Sender: TObject);
begin
  SetFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name,
                  [dbgCustomers,dbgCustGoods,dbgCustLinkmans],
                  '客户资料;客户品种管理;客户联系人管理');
end;

procedure TFmCustomers.ActDataExportExecute(Sender: TObject);
begin
	ExportData([CdsCustomers, CdsCustGoods, CdsCustLinkmans],
             '客户资料;客户品种资料;客户联系人', '');
end;

initialization
 RegisterClass(TFmCustomers);
finalization
 UnRegisterClass(TFmCustomers);


end.