syssettingfrm.pas

群星医药系统源码

begin
  try
    b1 := cdsSysSetting.ApplyUpdates(0)>0;
    b2 := cdsBillSetting.ApplyUpdates(0)>0;
  except
    if b1 or b2 then
      CanClose := Application.MessageBox('将数据提交到服务器时发生错误，数据更新失败！'#13'如果继续退出，未保存成功的数据将丢失！继续退出吗？', '警告', MB_YESNO+MB_ICONWARNING)=IDYES;
  end;
end;

procedure TFmSysSetting.edInDepotNameButtonClick(Sender: TObject);
var iID: Integer;
    sNo, sName: String;
begin
  iID := cdsSysSettingDefStockInDepot.Value;
  if SelectDepot(iID, sNo, sName) then begin
    cdsSysSetting.Edit;
    cdsSysSettingDefStockInDepot.Value := iID;
    cdsSysSettingInDepotName.Value := sName;
  end;
end;

procedure TFmSysSetting.edOutDepotNameButtonClick(Sender: TObject);
var iID: Integer;
    sNo, sName: String;
begin
  iID := cdsSysSettingDefStockOutDepot.Value;
  if SelectDepot(iID, sNo, sName) then begin
    cdsSysSetting.Edit;
    cdsSysSettingDefStockOutDepot.Value := iID;
    cdsSysSettingOutDepotName.Value := sName;
  end;
end;

procedure TFmSysSetting.edInDepotNameKeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
begin
  if (Key=vk_delete)and(Shift=[]) then begin
    cdsSysSettingDefStockInDepot.AsVariant := null;
    cdsSysSettingInDepotName.Value := '';
  end;
end;

procedure TFmSysSetting.edOutDepotNameKeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
begin
  if (Key=vk_delete)and(Shift=[]) then begin
    cdsSysSettingDefStockOutDepot.AsVariant := null;
    cdsSysSettingOutDepotName.Value := '';
  end;
end;

procedure TFmSysSetting.UpdPchPriceModeChange(Sender: TObject);
var Value: Variant;
    Ctrl: TRzComboBox;
    i: Integer;
begin
  Ctrl := Sender as TRzComboBox;
  i := Ctrl.ItemIndex-1;
  if i<0 then
    Value := null
  else
    Value := PriceModeNos[i];
  cdsSysSetting.Edit;
  cdsSysSetting.FieldByName(Ctrl.Name).AsVariant := Value;
end;

procedure TFmSysSetting.BtnStartClick(Sender: TObject);
begin
  if edStartDate.Date=0 then begin
    Application.MessageBox('请输入帐套启用日期！', '消息', MB_ICONINFORMATION);
    Exit;
  end;
  if (cdsSysSettingKindNoFormat.Value='') or (cdsSysSettingDepartNoFormat.Value='')
    or(cdsSysSettingDepotNoFormat.Value='') then begin
    Application.MessageBox('请先将启用参数填写完整！', '消息', MB_ICONINFORMATION);
    Exit;
  end;
  if Application.MessageBox('只有在启动帐套后才能进行单据处理，但启用帐套后，启动参数将不能再修改。'#13'确定继续吗？', '警告', MB_OKCANCEL+MB_ICONWARNING)=IDCANCEL then
    Exit;
  if Application.MessageBox('帐套启用是一个不可撤消的动作，你是否还需要再检查你的启动日期及参数设置是否正确？', '警告', MB_YESNO+MB_ICONQUESTION)=IDYES then
    Exit;
  with cdsSysSetting do begin
    Edit;
    cdsSysSettingStartDate.Value := edStartDate.Date;
    cdsSysSettingCurrMonth.Value := edStartDate.Date;
    Post;
    if ApplyUpdates(0)=0 then begin
      Application.MessageBox('帐套已成功启用，你可以开始进行单据处理！', '消息', MB_ICONINFORMATION);
      self.Close;
    end else
      Application.MessageBox('数据更新失败，帐套没有被启用！如果问题依然存在，请退出系统再试一次', '消息', MB_ICONERROR);
  end;
end;

procedure TFmSysSetting.FillPriceModes;
begin
  PriceModeNos.Clear;
  PriceModeNames.Clear;
  with cdsTemp do begin
    Close;
    CommandText := 'select ModeNo, ModeName from PriceModes';
    Open;
    First;
    while not Eof do begin
      PriceModeNos.Add(Fields[0].AsString);
      PriceModeNames.Add(Fields[1].AsString);
      Next;
    end;
  end;
  PchPriceMode.Items.Assign(PriceModeNames);
  SelPriceMode.Items.Assign(PriceModeNames);
  RtlPriceMode.Items.Assign(PriceModeNames);
  UpdPchPriceMode.Items.Assign(PriceModeNames);
  UpdSelPriceMode.Items.Assign(PriceModeNames);
  PchPriceMode.Items.Insert(0, '<无>');
  SelPriceMode.Items.Insert(0, '<无>');
  RtlPriceMode.Items.Insert(0, '<无>');
  UpdPchPriceMode.Items.Insert(0, '<无>');
  UpdSelPriceMode.Items.Insert(0, '<无>');
end;

procedure TFmSysSetting.cdsSysSettingAfterOpen(DataSet: TDataSet);
var b1: Boolean;
begin
  with DataSet do begin
    PchPriceMode.ItemIndex := PriceModeNos.IndexOf(FieldByName('PchPriceMode').AsString)+1;
    SelPriceMode.ItemIndex := PriceModeNos.IndexOf(FieldByName('SelPriceMode').AsString)+1;
    RtlPriceMode.ItemIndex := PriceModeNos.IndexOf(FieldByName('RtlPriceMode').AsString)+1;
    UpdPchPriceMode.ItemIndex := PriceModeNos.IndexOf(FieldByName('UpdPchPriceMode').AsString)+1;
    UpdSelPriceMode.ItemIndex := PriceModeNos.IndexOf(FieldByName('UpdSelPriceMode').AsString)+1;
  end;
  b1 := cdsSysSettingStartDate.IsNull;
  BtnStart.Enabled := b1;
  edStartDate.Enabled := b1;
  gbStartParam.Enabled := b1;
  if b1 then
    edStartDate.Date := Date
  else
    edStartDate.Date := cdsSysSettingStartDate.Value
end;

procedure TFmSysSetting.DataItemChanging(Sender: TObject;
  NewIndex: Integer; var AllowChange: Boolean);
const
  sTypes: Array[0..6] of string = ('Hypokind', 'Units', 'Dosetype', 'Departs', 'Dutys', 'Trades', 'Words');
var i, ErrNum, iClientID: integer;
    s: String;
    Value: Variant;
begin
  AllowChange := true;
  iClientID := IFmMain.IFmMainEx.ClientID;

  if cdsInfo.Active then
  begin
    if cdsInfo.State in dsEditModes then
      cdsInfo.Post;
    i := DataItem.Itemindex;
    s := sTypes[i];
    if cdsInfo.ChangeCount>0 then
    begin
      ErrNum := SvrSysManage.AppServer.UpdateInfoData(iClientID, s, cdsInfo.Delta);
      if ErrNum>0 then
      begin
        Application.MessageBox('数据提交错误！请检验数据！','警告',MB_OK+MB_ICONERROR);
        ErrNum := 0;
        exit;
      end;
    end;
    AllowChange := true;
    s := sTypes[NewIndex];
    SvrSysManage.AppServer.GetInfoData(iClientID, s, Value);
    if not VarIsNull(value) then
      cdsInfo.Data := Value;
  end;
end;

procedure TFmSysSetting.PageCtrlChange(Sender: TObject);
var
  b: Boolean;
begin
  if not Visible then Exit;
  if PageCtrl.ActivePage = TabSheet3 then
  begin
    b := true;
    if not cdsInfo.Active then
    begin
      DataItem.ItemIndex := 0;
      cdsInfo.CommandText := 'Select * from Hypokinds';
      cdsInfo.Open;
    end;
    DataItemChanging(Sender, DataItem.ItemIndex, b);
  end;
end;

procedure TFmSysSetting.RzPanel2Resize(Sender: TObject);
begin
  DataItem.Height := rzPanel2.Height-DataItem.Top*2;
end;

procedure TFmSysSetting.FormClose(Sender: TObject;
  var Action: TCloseAction);
var
  b: boolean;
begin
  b := true;
  DataItemChanging(Sender, DataItem.ItemIndex ,b);
  action := caFree;
end;

procedure TFmSysSetting.dbgBillSettingEditButtonClick(Sender: TObject);
begin
  if not (cdsBillSetting.Active) or cdsBillSetting.IsEmpty then exit;
  with dbgBillSetting do begin
    if SelectedField = nil then exit;
    with SelectedField do
    if (FieldName = 'InsTrackType')or(FieldName = 'UpdTrackType')or(FieldName = 'DelTrackType') then
    with TFmSelectTrackType.Create(nil) do
    try
      TrackTypes := AsString ;
      if ShowModal = mrOk then begin
        if not (cdsBillSetting.State in dsEditModes) then cdsBillSetting.Edit;
        AsString := TrackTypes;
      end;
    finally
      Free;
    end;
  end;
end;

procedure TFmSysSetting.dbgBillSettingKeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
begin
  if Key=VK_RETURN then dbgBillSettingEditButtonClick(nil)
end;

initialization
  RegisterClass(TFmSysSetting);

finalization
  UnRegisterClass(TFmSysSetting);

end.