uproviders.pas

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

procedure TFmProviders.CdsProvLinkmansNewRecord(DataSet: TDataSet);
begin
  inherited;
  CdsProvLinkmansProvNo.Value := CdsProvidersProvNo.Value;
  CdsProvLinkmansBirthday.Value := incMonth(date,-320);
end;

procedure TFmProviders.ActAddSubItemExecute(Sender: TObject);
begin
  if FEditMode=0 then Exit;
  if rzPage.Pages[0].CanFocus then
    begin
      CdsProvGoods.ReadOnly := False;
      CdsProvGoods.Append;
    end;
  if RzPage.Pages[1].CanFocus then
    begin
      CdsProvLinkmans.ReadOnly := False;
      CdsProvLinkmans.Append;
    end;
end;

procedure TFmProviders.ActDelSubItemExecute(Sender: TObject);
begin
  if rzPage.Pages[0].CanFocus then
    begin
      if CdsProvGoods.IsEmpty then Exit;
      CdsProvGoods.Delete;
    end;
  if RzPage.Pages[1].CanFocus then
    begin
      if CdsProvLinkmans.IsEmpty then Exit;
      CdsProvLinkmans.Delete;
    end;
end;

procedure TFmProviders.xDBGridEh1Columns0EditButtons0Click(Sender: TObject;
  var Handled: Boolean);
var Value: Variant;
begin
  inherited;
  if FEditMode=0 then Exit;
  Value := VarArrayCreate([0,2], VarOleStr);
  Value[0] := '选择药品编号';
  Value[1] := 'GoodsID';
  Value[2] := 'select * from Goodses';
  Value := IFmMain.CallClassDo('ckPublic.bpl;TFmPubSelect', 1, Value);
  if not VarIsNull(Value) then begin
    CdsProvGoods.Edit;
    CdsProvGoodsGoodsId.AsVariant := Value[0];
    CdsProvGoodsName.AsVariant := Value[1];
  end;
end;

procedure TFmProviders.CdsProvidersReconcileError(
  DataSet: TCustomClientDataSet; E: EReconcileError;
  UpdateKind: TUpdateKind; var Action: TReconcileAction);
begin
  inherited;
  Case UpdateKind of
    ukModify :MessageBox(Handle,'不能修改数据，有重复数据出现或引用数据无效！','提示',MB_ICONSTOP+MB_OK);
    ukInsert :MessageBox(Handle,'不能新增数据，有重复数据出现或引用数据无效！！','提示',MB_ICONSTOP+MB_OK);
    ukDelete :MessageBox(Handle,'不能删除数据，此表数据已被其它表使用！','提示',MB_ICONSTOP+MB_OK);
  end;
//  Action := HandleReconcileError(DataSet, UpdateKind, E);
  Action := raAbort;
end;

procedure TFmProviders.ActDeleteExecute(Sender: TObject);
begin
  if CdsProviders.IsEmpty then Exit;
  if MessageBox(handle,'你确认要删除吗？','严重警告',MB_ICONASTERISK+MB_YESNO)=IDNO	Then Exit;
  CdsProviders.Delete;
  if CdsProviders.ApplyUpdates(0)>0 then
    begin
      CdsProviders.CancelUpdates;
      MessageBox(handle,'您不能删除此表，有大量的数据正与此表相关！','出错啦',MB_OK);
    end;
end;

procedure TFmProviders.CheckFields(CFields:TclientDataSet;CdsDataSet:TClientDataSet;TableNameAndConDitions:String;var CheckMark:Boolean;TableState:Integer);
const FilterCondition='TableName=''%s'' and (Requisite or DispFormat=''TITLE'')';
var  DispTableName :String;
               Col :Integer;
           Errinfo :String;
             Occur :Integer;
       GetBookMark :TBookMark;
begin
(*
 CFields      字段属性字典数据集
 CdsDataSet   窗体命名数据集
 TableNameAndConDitions   数据集对应表名
 CheckMark    True 未填写必要数据  False  已填写必要数据
 TableState   主表还是从表，0表示主表（在当前编辑状态下只可能是一条），非0表示从表
              便于对主从进行必要字段检查。因为主从可能是大量的数据集，
              而从表不会是大量数据集
*)
  CFields.Filter := Format(FilterCondition,[TableNameAndConDitions]);
  CFields.Filtered := True;
  if CFields.Locate('DispFormat','TITLE',[loPartialKey]) then
    DispTableName := CFields.Fieldbyname('DispLabel').AsString;
  CFields.First;
  Errinfo := '';
  if (TableState>0) or (TableState<0) Then
    begin
      GetBookMark := CdsDataSet.GetBookmark;
      CdsDataSet.DisableControls;
      CdsDataSet.First;   //细表的处理
    end;
  While Not(CFields.Eof) do
    Begin
      if CFields.FieldByName('DispFormat').AsString='TITLE' then
        begin
          CFields.Next;
          Continue;
        end;
        if TableState=0 then  //对主表处理
          begin
            for Col:=0 to CdsDataSet.FieldCount-1 do
              begin
                if (Trim(CFields.FieldByName('FieldName').AsString) = Trim(CdsDataSet.Fields[col].FieldName)) and (CdsDataSet.Fields[col].IsNull or (TRim(Vartostr(CdsDataSet.Fields[col].Value))='')) then
                  begin
                    CheckMark := True;
                    Errinfo:=Errinfo+'['+CFields.FieldByName('DispLabel').AsString+']  不能为空.'+#13;
                  end;
              end;
            CFields.Next;
            Continue;
          end;
    CdsDataSet.First;Occur := 0;
    While Not(CdsDataSet.Eof) do
      begin
        for Col:=0 to CdsDataSet.FieldCount-1 do
        begin
          if (CFields.FieldByName('FieldName').AsString = CdsDataSet.Fields[col].FieldName) and (CdsDataSet.Fields[col].IsNull or (TRim(Vartostr(CdsDataSet.Fields[col].Value))='')) then
          begin
            Occur := Occur+1;
            if Occur>1 then Break;
            CheckMark := True;
            Errinfo:=Errinfo+'第'+inttostr(CdsDataSet.RecNo)+'行 , '+' ['+CFields.FieldByName('DispLabel').AsString+']  不能为空.'+#13;
            end;
         end;
      CdsDataSet.Next;
    end;
      CFields.Next;
    end;
  CFields.Filter := '';
  CFields.Filtered := True;
  if (TableState>0) or (TableState<0) Then
    begin
      CdsDataSet.GotoBookmark(GetBookMark);
      CdsDataSet.EnableControls;
    end;
  if Trim(Errinfo)='' Then Exit;
  Errinfo := '在 [   '+DispTableName+'   ] 表中:'+#13#13+Errinfo+#13;
  MessageBox(handle,Pchar(Errinfo),'警告',MB_ICONWARNING+MB_OK);
end;

procedure TFmProviders.ActRefershExecute(Sender: TObject);
begin
  CdsProviders.Active := False;
  CdsProviders.Active := True;
end;

procedure TFmProviders.xDBGridEh2ColExit(Sender: TObject);
var checkMark :Boolean;
begin
  if FEditMode=0 then Exit;
  CheckMark := False;
  if  xDBGridEh2.SelectedField.FieldName='LinkMan' Then
    CheckFields(CdsFields,CdsProvLinkmans,'ProvLinkmans',CheckMark,1);
end;

procedure TFmProviders.SetDbgReadOnly(ReadOnly: Boolean);
begin
  CdsProvGoods.ReadOnly := ReadOnly;
  CdsProvLinkmans.ReadOnly := ReadOnly;
end;

procedure TFmProviders.CdsProvGoodsBeforeApplyUpdates(Sender: TObject;
  var OwnerData: OleVariant);
begin
  With CdsProvGoods do
    begin
      First;
        While Not(Eof) do
          begin
            CdsProvGoodsProvNo.Value := CdsProvidersProvNo.value;
          end;
      Next;
    end;
end;

procedure TFmProviders.CdsProvLinkmansBeforeApplyUpdates(Sender: TObject;
  var OwnerData: OleVariant);
begin
  With CdsProvLinkmans do
    begin
      First;
        While Not(Eof) do
          begin
            CdsProvLinkmansProvNo.Value := CdsProvidersProvNo.value;
          end;
      Next;
    end;
end;

procedure TFmProviders.ActInsertExecute(Sender: TObject);
begin
  inherited;
  SetDbgReadOnly(False);
end;

procedure TFmProviders.CdsProvGoodsPrice1Change(Sender: TField);
begin
  inherited;
  if (CdsProvGoodsPrice1.Value <0) or (CdsProvGoodsPrice2.Value <0) Then
    begin
      MessageBox(handle,'输入数值为负数！','提示',MB_OK);
    end;
end;

procedure TFmProviders.xDBGridEh1ColExit(Sender: TObject);
var values     :OleVariant;
     Field     :Variant;
begin
  if FEditMode=0 then Exit;
  if CdsProvGoods.State in [dsEdit] then CdsProvGoods.Post;
//  if xDBGridEh1.SelectedField.FieldName<>'GoodsID' then Exit;
  Field := VarArrayCreate([0,3],varVariant);
  Field[0] := 'Goodsid';
  Field[1] := 'Name';
  Field[2] := 'Specs';
  Field[3] := CdsProvGoodsGoodsId.Value;
//  DCOMCNN.AppServer.GetGoodsIdAndName('Goodses',Field,Values);
  if VarIsNull(Values) Then
  begin
    MessageBox(handle,pchar(CdsProvGoodsGoodsid.DisplayLabel+'  =[ '+CdsProvGoodsGoodsid.Value+' ] ，该'+CdsProvGoodsGoodsid.DisplayLabel+'不存在！'),'提示',MB_OK);
    Exit;
  end;
  CdsProvGoods.Edit;
  CdsProvGoodsGoodsid.Value := Values[0];
  CdsProvGoodsname.ReadOnly := False;
  CdsProvGoodsname.Value := Values[1];
  CdsProvGoodsname.ReadOnly := True;
  CdsProvGoodsSpecs.ReadOnly := False;  
  CdsProvGoodsSpecs.Value := Values[2];
  CdsProvGoodsSpecs.ReadOnly := True;
end;

initialization
  RegisterClass(TFmProviders);

finalization
  UnRegisterClass(TFmProviders);

end.