providerfrm.pas

来自「医药连锁经营管理系统源码」· PAS 代码 · 共 617 行 · 第 1/2 页

    end;
    if  CdsPayModes.Locate('PayModeNo',CdsProvidersPayModeNo.value,[loPartialKey]) then
    begin
      CoKind.FindItem(CdsPayModesPayModeNo.Value+':'+CdsPayModesPayModeName.Value+':'+'['+CdsPayModesTimeLimit.AsString+'天]');
      CoKind.Items.Strings[CoKind.ItemIndex];
    end;
    If ShowModal<>mrOk then Begin
      CdsProviders.Cancel;
      CdsProviders.CancelUpdates;
    End;
  End;
End;

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

procedure TFmProvider.ActRefreshExecute(Sender: TObject);
Var iRecords,iTotal:Integer;
begin
  vOwnerData:=Null;
  iRecords:=PacketRcs;
  iTotal:=CdsProviders.RecordCount;
  PacketRcs:=iTotal;
  CdsProviders.Active:=False;
  CdsProviders.PacketRecords:=iTotal;
  CdsProviders.Active:=True;
  bTrueEof:=False;
  PacketRcs:=iRecords;
end;

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

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

procedure TFmProvider.CdsProvidersAfterOpen(DataSet: TDataSet);
begin
  with DataSet as TckClientDataSet do begin
    if VarIsNull(vOwnerData) then begin
      last;
      vOwnerData:=Fieldbyname('ProvNo').Value;
    end;
  end;
end;

procedure TFmProvider.CdsProvidersBeforeOpen(DataSet: TDataSet);
begin
  vOwnerData := null;
end;

procedure TFmProvider.BtnDelClick(Sender: TObject);
begin
  if CdsProviders.IsEmpty then Exit;
  if Application.MessageBox('确定删除当前供应商资料吗？', '消息', MB_YESNO+MB_ICONQUESTION+MB_DEFBUTTON2)=IDNO then
    Exit;
  Try
    CdsProviders.Delete;
    CdsProviders.ApplyUpdates(0); 
  Except
    MessageBox(handle,'删除数据错误，可能有其它表使用了此表的数据!','提示',MB_OK);
  end;
end;

procedure TFmProvider.CdsProvidersReconcileError(
  DataSet: TCustomClientDataSet; E: EReconcileError;
  UpdateKind: TUpdateKind; var Action: TReconcileAction);
begin
  MessageBox(handle,pchar(E.Message),'提示',MB_OK);
  Action := raAbort;
end;

procedure TFmProvider.CdsProvGoodsReconcileError(
  DataSet: TCustomClientDataSet; E: EReconcileError;
  UpdateKind: TUpdateKind; var Action: TReconcileAction);
begin
  Action := raAbort;
end;

procedure TFmProvider.CdsProvLinkmansReconcileError(
  DataSet: TCustomClientDataSet; E: EReconcileError;
  UpdateKind: TUpdateKind; var Action: TReconcileAction);
begin
  Action := raAbort;
end;

procedure TFmProvider.CdsProvGoodsNewRecord(DataSet: TDataSet);
begin
  CdsProvGoodsProvNo.value := CdsProvidersProvNo.Value;
  cdsProvGoodsDataUsable.Value := true; 
  CdsProvGoodsNearDate.Value := Date;
end;

procedure TFmProvider.CdsProvLinkmansNewRecord(DataSet: TDataSet);
begin
  CdsProvLinkmansProvNo.value := CdsProvidersProvNo.Value;
  CdsProvLinkmansBirthday.Value := incmonth(Date,-300);
end;

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

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

procedure TFmProvider.ActPrintExecute(Sender: TObject);
begin
  if not CdsProvLinkmans.Active then CdsProvLinkmans.Open;
  if not CdsProvGoods.Active then CdsProvGoods.Open;
  SelRepPrint(Name, [CdsProviders, cdsProvGoods, cdsProvLinkmans],
    '供应商资料;协议供应品种;供应商联系人',ActDesignReport.Enabled);
end;

procedure TFmProvider.ActNewLinkmanExecute(Sender: TObject);
begin
  if cdsProviders.IsEmpty then Exit;
  CdsProviders.Edit;
  CdsProvLinkmans.Append;
  with TFmProvLinkManEd.Create(self) do begin
    if ShowModal=mrOk then
      cdsProviders.ApplyUpdates(0)
    Else
      cdsProvLinkMans.CancelUpdates;
    Free;
  end;
end;

procedure TFmProvider.ActEdtLinkmanExecute(Sender: TObject);
begin
  if cdsProvLinkmans.IsEmpty then Exit;
  CdsProviders.Edit;
  with TFmProvLinkManEd.Create(self) do begin
    if ShowModal=mrOk then
      CdsProviders.ApplyUpdates(0)
    Else
      CdsProvLinkMans.CancelUpdates;
    Free;
  end;
end;

procedure TFmProvider.ActDelLinkmanExecute(Sender: TObject);
begin
  if cdsProvLinkmans.IsEmpty then Exit;
  if Application.MessageBox('确定删除当前供应商联系人资料吗？', '消息', MB_YESNO+MB_ICONQUESTION)=IDNO then
    Exit;
  CdsProviders.Edit;
  cdsProvLinkmans.Delete;
  cdsProviders.ApplyUpdates(0);
end;

procedure TFmProvider.ActEditProvGoodsExecute(Sender: TObject);
begin
  if CdsProvGoods.IsEmpty then Exit;
  CdsProviders.Edit;
  with TFmProvGoodsEd.Create(self) do begin
    if ShowModal=mrOk then
      CdsProviders.RefreshRecord;
    Free;
  end;
end;

procedure TFmProvider.ActNewProvGoodsExecute(Sender: TObject);
Var I:integer;
begin
  if cdsProviders.IsEmpty then Exit;
  with TFmProvGoodsEd.Create(self) do begin
    i:=CdsProvGoods.RecordCount;
    CdsProviders.Edit;
    CdsProvGoods.Append;
    If ShowModal=mrOk then Begin
      CdsProviders.RefreshRecord;
      CdsProvGoods.RecNo := i+1;
    End;
    Free;
  end;
end;

procedure TFmProvider.CdsProvidersAfterGetRecords(Sender: TObject;
  var OwnerData: OleVariant);
begin
  PublicMark:=CdsProviders.GetBookmark;
end;

procedure TFmProvider.CdsProvidersBeforeRefresh(DataSet: TDataSet);
begin
  vOwnerData := null;
end;

procedure TFmProvider.ActDelProvGoodsExecute(Sender: TObject);
begin
  if CdsProvGoods.IsEmpty then Exit;
  if Application.MessageBox('确定删除当前供应商品种管理资料吗？', '消息', MB_YESNO+MB_ICONQUESTION)=IDNO then
    Exit;
  CdsProviders.Edit;
  CdsProvGoods.Delete;
  cdsProviders.ApplyUpdates(0);
end;

procedure TFmProvider.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 TFmProvider.ActFieldsLayOutExecute(Sender: TObject);
begin
  SetFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name,
                  [dbgProviders,dbgProvGoods,dbgProvLinkmans],
                  '供应厂商资料;供应商品种管理;供应商联系人管理');
end;

procedure TFmProvider.ActDataExportExecute(Sender: TObject);
begin
	ExportData([cdsProviders, cdsProvGoods, cdsProvLinkmans],
             '厂商资料;供应商品种资料;供应商联系人', '');
end;

procedure TFmProvider.dbgProvidersDblClick(Sender: TObject);
begin
  ActModify.Execute;
end;

initialization
  RegisterClass(TFmProvider);
finalization
  UnRegisterClass(TFmProvider);

end.