comdj.pas

delphi作得信息业进销存源码.功能全面,运行稳定.

  aExit.ShortCut := VK_ESCAPE;
  screen.Cursor := crDefault;
end;

//aExit.Execute
procedure TfrmComDj.aExitExecute(Sender: TObject);
begin
  Close;
end;

//aNew.Execute
procedure TfrmComDj.aNewExecute(Sender: TObject);
begin
  if (CanSave) and (dsZb.State in [dsInsert]) then
    SaveQuery;
  dsZb.Insert;
  strState := 'A';
  DBEdit1.SetFocus;
end;

//aDel.Execute
procedure TfrmComDj.aDelExecute(Sender: TObject);
begin
  if dsZb.State in [Dsinsert] then
  begin
    if Application.MessageBox( '确定要删除此张单吗?',
      '资料删除', MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 ) = IDYES then
      aCancel.Execute
  end else
  begin
    If HaveDetail(dsZb, strZbDetailTables, strZbDetailWheres) Then
      Application.MessageBox('已有明细资料,不能删除!', '资料删除', MB_OK + MB_ICONWARNING)
    else
    begin
      if Application.MessageBox( '确定要删除此张单吗?',
        '资料删除', MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 ) = IDYES then
      begin
        CanSave := false;
        dsZb.Delete;
        dsZb.ApplyUpdates(0);
      end;
    end;
  end;
end;

//aInsert.Execute
procedure TfrmComDj.aInsertExecute(Sender: TObject);
begin
  dsMx.Insert;
  DBGrid1.SetFocus;
end;

//aDelete.Execute
procedure TfrmComDj.aDeleteExecute(Sender: TObject);
begin
  If HaveDetail(dsMx, strMxDetailTables, strMxDetailWheres) Then
    Application.MessageBox('已有明细资料,不能删除!', '资料删除', MB_OK + MB_ICONWARNING)
  else
  begin
    if Application.MessageBox( '确定要删除此项资料吗?',
      '资料删除', MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 ) = IDYES then
    dsMx.delete;
  end;
end;

//aSetColumn.Execute
procedure TfrmComDj.aSetColumnExecute(Sender: TObject);
begin
  frmSetColumn.strFormName := self.Name;
  if not (Screen.ActiveControl is TDBGrid) then
    frmSetColumn.dbgSC := DBGrid1
  else
    frmSetColumn.dbgSC := TDBGrid(Screen.ActiveControl);
  frmSetColumn.ShowModal;
end;

//aFirst.Execute
procedure TfrmComDj.aFirstExecute(Sender: TObject);
begin
  dsZb.First;
end;

//aPrior.Execute
procedure TfrmComDj.aPriorExecute(Sender: TObject);
begin
  dsZb.Prior;
end;

//aNext.Execute
procedure TfrmComDj.aNextExecute(Sender: TObject);
begin
  dsZb.Next;
end;

//aLast.Execute
procedure TfrmComDj.aLastExecute(Sender: TObject);
begin
  dsZb.Last;
end;

//aCalendar.Execute
procedure TfrmComDj.aCalendarExecute(Sender: TObject);
begin
  if frmWnl = nil then
    frmWnl := TfrmWnl.Create(self);
  frmWnl.MonthCalendar1.Date := Date();
  frmWnl.Show;
end;

//aCalculator.Execute
procedure TfrmComDj.aCalculatorExecute(Sender: TObject);
begin
  WinExec( 'Calc.exe', SW_SHOWDEFAULT );
end;

{*****自定义过程*****}

//Inirecord
procedure TfrmComDj.Inirecord;
var
  SaveCursor: TCursor;
  i: integer;
begin
  SaveCursor := screen.Cursor;
  screen.Cursor := crHourGlass;
  dsMx.Close;
  dsMx.Open;
  dsMx.First;
  for i := 0 to DbGrid1.Columns.Count - 1 do
    if DbGrid1.Columns[i].Visible and not (DbGrid1.Columns[i].ReadOnly) then
      Break;
  if i > DbGrid1.Columns.Count - 1 then
    i := 0;
  DbGrid1.SelectedIndex := i;
  SetButton;
  screen.Cursor := SaveCursor;
end;

//SaveQuery
function TfrmComDj.SaveQuery: boolean;
begin
  result := true;
  case Application.MessageBox('是否保存对当前资料的修改?', '资料保存',
    MB_YESNOCANCEL + MB_ICONQUESTION + MB_DEFBUTTON1 ) of
    IDYES: aSave.Execute;
    IDNO: aCancel.Execute;
  else
    begin
      result := false;
      abort;
    end;
  end;
end;

//SetButton
procedure TfrmComDj.SetButton;
begin
  aPrint.Enabled := aPrint.Tag = 0;
  aPreview.Enabled := aPrint.Enabled;
  aNew.Enabled := aNew.Tag = 0;
  aDel.Enabled := (aDel.Tag = 0) and not (dsZb.IsEmpty);
  aInsert.Enabled := (aInsert.Tag = 0) and not (dsZb.IsEmpty) and not(DBGrid1.ReadOnly);
  aDelete.Enabled := (aDelete.Tag = 0) and not (dsMx.IsEmpty) and not(DBGrid1.ReadOnly);
  aFirst.Enabled := not blnStopScroll and (dsZb <> nil) and not(dsZb.Bof) and not (dsZb.IsEmpty);
  aPrior.Enabled := not blnStopScroll and (dsZb <> nil) and not(dsZb.Bof) and not (dsZb.IsEmpty);
  aNext.Enabled := not blnStopScroll and (dsZb <> nil) and not(dsZb.Eof) and not (dsZb.IsEmpty);
  aLast.Enabled := not blnStopScroll and (dsZb <> nil) and not(dsZb.Eof) and not (dsZb.IsEmpty);
end;

//SetCanSave
procedure TfrmComDj.SetCanSave(Can:Boolean);
begin
  CanSave1 := Can;
  aSave.Enabled := Can;
  aCancel.Enabled := aSave.Enabled;
  aPreview.Enabled := not(Can) and not (dsZb.IsEmpty) ;
  aPrint.Enabled := aPreview.Enabled;
end;

//LoadPrintForm
procedure TfrmComDj.LoadPrintForm;
begin
  //ComPrint
  if frmSetPrint = nil then
    frmSetPrint := TfrmSetPrint.Create(application);
  with frmSetPrint do
  begin
    AForm := TfrmComDj(self);
    AGrid := DBGrid1;
    ADataSet := TClientDataSet(DBGrid1.DataSource.DataSet);
    blnPreview := self.blnPreview;
    ShowModal;
    self.ReportName := ReportName;
    Free;
  end;
  frmSetPrint := nil;
end;

//TotalField
procedure TfrmComDj.TotalField(Kind:char; Field:TField);
begin
//
end;

//sMxDataChange
procedure TfrmComDj.sMxDataChange(Sender: TObject; Field: TField);
begin
  if CanDataChange and ( Field <> nil ) then
    if TDataSource(Sender).State In [dsEdit, dsInsert] then
      TotalField('E', Field);
end;

//MxBeforeInsert
procedure TfrmComDj.MxBeforeInsert(DataSet: TDataSet);
begin
  CanDataChange := false;
end;

//MxOnNewRecord
procedure TfrmComDj.MxOnNewRecord(DataSet: TDataSet);
var
  i : integer;
  intDef: integer;
  strS: TStringList;
begin
  DBGrid1.SelectedIndex := 0;
  for i := 0 to dsMx.FieldCount - 1 do
    if (dsMx.Fields[i] is TNumericField) then
      dsMx.Fields[i].Value := 0;
  for i := 0 to DBGrid1.Columns.Count - 1 do
  begin
    if pblnLoadAppSelect then
      if DBGrid1.Columns[i].Field.DataType in [ftString,ftWideString] then
      begin
        Data.AppSelect.Close;
        Data.AppSelect.CommandText := 'select * from AppSelect where DataSet = ''' +
          DataSet.Name + ''' and FieldName = ''' +
          DBGrid1.Columns[i].FieldName + '''';
        Data.AppSelect.Open;
        intdef := Data.AppSelect.FieldByName('DefaultRow').AsInteger;
        if intDef > 0 then
        begin
          strS := TStringList.Create;
          strS.Text := Data.AppSelect.FieldByName('DataSelect').Value;
          if intDef <= strS.Count then
            DBGrid1.Columns[i].Field.AsString := strS[intDef-1];
        end;
        Data.AppSelect.CLose;
      end;
    if DBGrid1.Columns[i].Field.DataType in [ftDate, ftDateTime] then
      with CurDs do
      begin
        CommandText := 'select * from AppDate where uId = ' + IntToStr(pintUserId) + ' and ' +
          'DATASET = ''' + DataSet.Name + ''' and ' +
          'FIELDNAME = ''' + DBGrid1.Columns[i].FieldName + '''';
        Open;
        if not IsEmpty then
          if FieldByName('DEFAULDATE').AsInteger = 1 then
            DBGrid1.Columns[i].Field.AsDateTime := Date
          else
            DBGrid1.Columns[i].Field.AsDateTime := FieldByName('SETDATE').AsDateTime;
        Close;
      end;
  end;
end;

//MxAfterInsert
procedure TfrmComDj.MxAfterInsert(DataSet: TDataSet);
var
  i : integer;
begin
  for i := 0 to dsMx.FieldCount - 1 do
  begin
    arrMx[i] := dsMx.Fields[i].Value;
    if (arrMx[i] = null) and (dsMx.Fields[i] is TNumericField) then
      arrMx[i] := 0;
  end;
  CanDataChange := true;
end;

//MxBeforeEdit
procedure TfrmComDj.MxBeforeEdit(DataSet: TDataSet);
var
  i : integer;
begin
  for i := 0 to dsMx.FieldCount - 1 do
  begin
    arrMx[i] := dsMx.Fields[i].Value;
    if (arrMx[i] = null) and (dsMx.Fields[i] is TNumericField) then
      arrMx[i] := 0;
  end;
  CanDataChange := true;
end;

//MxBeforePost
procedure TfrmComDj.MxBeforePost(DataSet: TDataSet);
var
  i, j : integer;
begin
  for i := 0 to dsMx.FieldCount - 1 do
  begin
//处理数值字段
    if (dsMx.Fields[i] is TNumericField) and not (dsMx.Fields[i] is TAutoIncField) then
      if dsMx.Fields[i].Value = null then
        dsMx.Fields[i].Value := 0
      else if TNumericField(dsMx.Fields[i]).DisplayFormat <> '' then
        dsMx.Fields[i].AsString := FormatFloat(StringReplace(TNumericField(dsMx.Fields[i]).DisplayFormat, ',', '', [rfReplaceAll]), dsMx.Fields[i].Value);
//处理必填字段
    if (strMxKeyFields <> '') and (Pos(UpperCase(dsMx.Fields[i].FieldName) + ';', strMxKeyFields) <> 0) then
      if (dsMx.Fields[i] is TStringField) and (dsMx.Fields[i].AsString = '')
        or (dsMx.Fields[i] is TNumericField) and (dsMx.Fields[i].AsFloat = 0)
        or (dsMx.Fields[i] is TDateTimeField) and (dsMx.Fields[i].value = null) then
      begin
        Application.MessageBox(Pchar('''' + dsMx.Fields[i].DisplayLabel + '''未录入, 请继续录入!'), '录入错误', MB_OK + MB_ICONWARNING);
        for j := 0 to DBGrid1.Columns.Count - 1 do
          if DBGrid1.Columns[j].Field = dsMx.Fields[i] then
          begin
            DBGrid1.SelectedIndex := j;
            break;
          end;
        abort;
      end;
  end;
end;

//MxAfterPost
procedure TfrmComDj.MxAfterPost(DataSet: TDataSet);
var
  i, intIndex: integer;
  strS: TStringList;
begin
  CanSave := true;
  SetButton;
  for i := 0 to DBGrid1.Columns.Count - 1 do
  begin
    if pblnSaveAppSelect then
      if (DBGrid1.Columns[i].Field.DataType in [ftString,ftWideString]) and
         (DBGrid1.Columns[i].Field.AsString <> '') then
      begin
        Data.AppSelect.Close;
        Data.AppSelect.CommandText := 'select * from AppSelect where DataSet = ''' +
          DataSet.Name + ''' and FieldName = ''' +
          DBGrid1.Columns[i].FieldName + '''';
        Data.AppSelect.Open;
        if Data.AppSelect.FieldByName('DataSet').AsString <> '' then
        begin
          if Data.AppSelect.FieldByName('AutoUpdate').AsBoolean then
          begin
            strS := TStringList.Create;
            strS.Text := Data.AppSelect.FieldByName('DataSelect').Value;
            intIndex := strS.IndexOf(DBGrid1.Columns[i].Field.AsString);
            if intIndex <> -1 then
              strS.Delete(intIndex);
            for intIndex := 19 to strS.Count - 1 do
              strS.Delete(intIndex);
            strS.Insert(0, DBGrid1.Columns[i].Field.AsString);
            SqlExec('update AppSelect set DataSelect = ''' + strS.Text +
              ''' where DataSet = ''' +
              DataSet.Name + ''' and FieldName = ''' +
              DBGrid1.Columns[i].FieldName + '''');
          end;
        end else
          SqlExec('insert into AppSelect (DataSet,FieldName,DataSelect,AutoUpdate) values ' +
          '(''' + DataSet.Name + ''',''' +
            DBGrid1.Columns[i].FieldName + ''',''' + DBGrid1.Columns[i].Field.AsString + ''',1)' );
        Data.AppSelect.CLose;
      end;
    if (DBGrid1.Columns[i].Field.DataType in [ftDate, ftDateTime]) and
       (DBGrid1.Columns[i].Field.AsString <> '') then
      if pDataBaseType = 'SERVER' then
        SqlExec('update AppDate set SETDATE = ''' + DBGrid1.Columns[i].Field.AsString + ''' ' +
          'where uId = ' + IntToStr(pintUserId) + ' and ' +
          'DATASET = ''' + DataSet.Name + ''' and ' +
          'FIELDNAME = ''' + DBGrid1.Columns[i].FieldName + ''' and ' +
          'DEFAULDATE = 2')
      else
        SqlExec('update AppDate set SETDATE = #' + DBGrid1.Columns[i].Field.AsString + '# ' +
          'where uId = ' + IntToStr(pintUserId) + ' and ' +