procedure TMainForm.N6Click(Sender: TObject);
begin
TabelForm:=TTabelForm.Create(Application);
TabelForm.ShowModal;
end;

unit MainUnit;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, Menus,ADODB;

type
 TMainForm = class(TForm)
   MainMenu1: TMainMenu;
   N1: TMenuItem;
   N2: TMenuItem;
   N3: TMenuItem;
   N4: TMenuItem;
   N5: TMenuItem;
   N6: TMenuItem;
   procedure N5Click(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure N3Click(Sender: TObject);
   procedure N6Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 MainForm: TMainForm;
 myformat: TFormatSettings;

implementation

uses DMUnit,KadriUnit, HelpMyUnit, PrazdUnit, TabelUnit;

{$R *.dfm}

procedure TMainForm.N5Click(Sender: TObject);
begin
KadriForm.ShowModal;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
HelpMy.Free;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
myformat.ShortDateFormat:='yyyy-mm-dd';
myformat.DateSeparator:='-';
end;

procedure TMainForm.N3Click(Sender: TObject);
begin
PrazdForm:= TPrazdForm.Create(Application);
PrazdForm.ADODataSetPr.Connection:=DM.ADOConnection1;
PrazdForm.ADODataSetPr.CursorLocation:=clUseServer;
PrazdForm.ADODataSetPr.CursorType:=ctKeyset;
PrazdForm.ADODataSetPr.Active:=True;
PrazdForm.ShowModal;
end;

procedure TMainForm.N6Click(Sender: TObject);
begin
TabelForm:=TTabelForm(Application); // знаю что датасеты не инециализирвал
TabelForm.ShowModal;                // но что с ней(инициализацие) что без неё
end;                                // ошибка всеравно выскакивает

end.

unit TabelUnit;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, DB, ADODB, Grids, DBGrids, DateUtils, ComCtrls, math, StdCtrls;

type
 TTabelForm = class(TForm)
   DBGrid1: TDBGrid;
   DataSource1: TDataSource;
   ADODataSet1: TADODataSet;
   StringGrid1: TStringGrid;
   MonthCalendar1: TMonthCalendar;
   ADODataSet2: TADODataSet;
   DataSource2: TDataSource;
   DBGrid2: TDBGrid;
   ADODataSet3: TADODataSet;
   DataSource3: TDataSource;
   DBGrid3: TDBGrid;
   ADOCommTabel: TADOCommand;
   procedure FormCreate(Sender: TObject);
   procedure SetTabel;
   procedure MonthCalendar1Click(Sender: TObject);
   procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
     Rect: TRect; State: TGridDrawState);
   function DateNull(DateInput:Variant; zamena:TDateTime):TDateTime;
   procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
     var CanSelect: Boolean);
   procedure StringGrid1Exit(Sender: TObject);
   procedure StringGrid1KeyDown(Sender: TObject; var Key: Word;
     Shift: TShiftState);
   procedure StringGrid1GetEditText(Sender: TObject; ACol, ARow: Integer;
     var Value: String);
   function InsertTabel:Boolean;
   procedure UpDateDataSet1(var datefirst: String; var datelast: String);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 TabelForm: TTabelForm;
 StrEd: String;

implementation

uses DMUnit, MainUnit, HelpMyUnit;

{$R *.dfm}

procedure TTabelForm.SetTabel;
var
ColDaysNow,Year,Month,Day: Word;
i,m: Integer;
begin
StringGrid1.Visible:=False;
DecodeDate(MonthCalendar1.Date,Year,Month,Day);
StringGrid1.RowCount:=2;
StringGrid1.FixedRows:=1;
StringGrid1.FixedCols:=2;
ColDaysNow:=DaysInMonth(MonthCalendar1.Date);
StringGrid1.ColCount:=ColDaysNow+2;
for i:=0 to StringGrid1.ColCount-1 do begin
 if i=0 then StringGrid1.Cells[i,0]:='т\н';
 if i=1 then begin
     StringGrid1.Cells[i,0]:='Ф.И.О.';
     StringGrid1.ColWidths[i]:=100;
 end;
 if i>=2 then StringGrid1.Cells[i,0]:=IntToStr(i-1);
end;
with ADODataSet2 do begin
         First;
         for m:=1 to RecordCount do
         begin
             StringGrid1.Cells[0,m]:=FieldValues['id'];
             StringGrid1.Cells[1,m]:=FieldValues['fio'];
             Next;
             StringGrid1.RowCount:=StringGrid1.RowCount+1;
         end;
         StringGrid1.RowCount:=StringGrid1.RowCount-1;
end;
if ADODataSet1.RecordCount<>0 then begin
   for m:=1 to StringGrid1.RowCount-1 do
   begin
   ADODataSet1.First;
           For i:=1 to ADODataSet1.RecordCount do begin
                 if StrToInt(StringGrid1.Cells[0,m]) = ADODataSet1.FieldValues['idrab'] then begin
                     StringGrid1.Cells[StrToInt(Copy(ADODataSet1.FieldValues['dat'],9,10))+1,m]:=ADODataSet1.FieldValues['chasi'];
                     ADODataSet1.Next;
                 end
                     else ADODataSet1.Next;
           end;
   end;
end;
StringGrid1.Visible:=True;
end;

procedure TTabelForm.FormCreate(Sender: TObject);
var
Year,Month,Day: Word;
datefirst, datelast: string;
begin
DecodeDate(Date,Year,Month,Day);
datefirst:=DateToStr(EncodeDate(Year,Month,1),myformat);
datelast:= DateToStr(EncodeDate(Year,Month,DaysInMonth(Date)),myformat);
with ADODataSet2 do begin
   Close;
   with Parameters.AddParameter do begin
       name:='datefirst';
       DataType := ftString;
       Direction := pdInput;
       Value:=datefirst;
   end;
   with Parameters.AddParameter do begin
       name:='datelast';
       DataType := ftString;
       Direction := pdInput;
       Value:=datelast;
   end;
   CommandText:= 'select id, fio, datein, dateout from kadri where datein <= :datelast and (dateout>= :datefirst or dateout is null) order by id';
   Open;
   if RecordCount = 0 then
   begin
       SetTabel;
       StringGrid1.RowCount:=1;
       Application.MessageBox(PAnsiChar('Нет актуальных работников'),'Ошибка',MB_OK+MB_ICONWARNING);
       exit;
   end;
end;
with ADODataSet3 do begin
     Close;
     CommandText:='select * from prazdn where dat>= :datefirst and dat<= :datelast';
     Parameters.ParseSQL(CommandText,True);
     Parameters.ParamValues['datefirst']:= datefirst;
     Parameters.ParamValues['datelast']:= datelast;
     Open;
end;
UpDateDataSet1(datefirst,datelast);
MonthCalendar1.Date:=Date;
TabelForm.SetTabel;
end;

procedure TTabelForm.MonthCalendar1Click(Sender: TObject);
var
Year,Month,Day: Word;
i,j: integer;
datefirst, datelast: string;
begin
DecodeDate(MonthCalendar1.Date,Year,Month,Day);
datefirst:=DateToStr(EncodeDate(Year,Month,1),myformat);
datelast:= DateToStr(EncodeDate(Year,Month,DaysInMonth(MonthCalendar1.Date)),myformat);
with ADODataSet2 do begin
   Close;
   CommandText:= 'select id, fio, datein, dateout from kadri where datein <= :datelast and (dateout>= :datefirst or dateout is null) order by id';
   Parameters.ParseSQL(CommandText,True);
   Parameters.ParamValues['datefirst']:= datefirst;
   Parameters.ParamValues['datelast']:= datelast;
   Open;
   if RecordCount = 0 then
   begin
       SetTabel;
       StringGrid1.RowCount:=1;
       Application.MessageBox(PAnsiChar('Нет актуальных работников'),'Ошибка',MB_OK+MB_ICONWARNING);
       exit;
   end;
end;
with ADODataSet3 do begin
     Close;
     CommandText:='select * from prazdn where dat>= :datefirst and dat<= :datelast';
     Parameters.ParseSQL(CommandText,True);
     Parameters.ParamValues['datefirst']:= datefirst;
     Parameters.ParamValues['datelast']:= datelast;
     Open;
end;
UpDateDataSet1(datefirst,datelast);
for i:=0 to StringGrid1.RowCount-1 do begin
 for j:=0 to StringGrid1.ColCount-1 do
   StringGrid1.Cells[j,i]:='';
end;
TabelForm.SetTabel;
end;

procedure TTabelForm.StringGrid1DrawCell(Sender: TObject; ACol,
 ARow: Integer; Rect: TRect; State: TGridDrawState);
 var
Year,Month,Day: Word;
key: Integer;
Dateclac: TDateTime;
begin
DecodeDate(MonthCalendar1.Date,Year,Month,Day);
 if ACol>=2 then begin
       Dateclac:= EncodeDate(Year,Month,ACol-1);
       Case DayOfTheWeek(Dateclac)of
           1..5:Key:=1;
           6,7:Key:=2;
       end;
       if ADODataSet3.Locate('dat',DateToStr(Dateclac,myformat),[])then key := ADODataSet3.FieldValues['keys'];
       if key = 2 then
         begin
             StringGrid1.Canvas.FillRect(Rect);
             StringGrid1.Canvas.Font.Color:=clRed;
             StringGrid1.Canvas.TextOut(Rect.Left+5,Rect.Top+3,StringGrid1.Cells[ACol,ARow]);
             StringGrid1.Canvas.Font.Color:=clWindowText;
         end
       else if key = 1 then begin
       StringGrid1.Canvas.FillRect(Rect);
       StringGrid1.Canvas.TextOut(Rect.Left+5,Rect.Top+3,StringGrid1.Cells[ACol,ARow]);
       end;
       if ARow >=1 then begin
           ADODataSet2.Locate('id',StrToInt(StringGrid1.Cells[0,ARow]),[]);
           if InRange(EncodeDate(Year,Month,ACol-1),StrToDate(ADODataSet2.FieldValues['datein'],myformat),DateNull(ADODataSet2.Fi eldValues['dateout'],EncodeDate(Year,Month,DaysInMonth(MonthCalendar1.Date))))=F alse then begin
               StringGrid1.Canvas.Brush.Color:=clInactiveBorder;
               StringGrid1.Canvas.FillRect(Rect);
               StringGrid1.Canvas.TextOut(Rect.Left+5,Rect.Top+3,StringGrid1.Cells[ACol,ARow]);
               StringGrid1.Canvas.Brush.Color:=clBtnFace;
           end;
       end;
 end;
end;

function TTabelForm.DateNull(DateInput: Variant;
 zamena: TDateTime): TDateTime;
begin
if VarIsNull(DateInput) then result:=zamena
else result:= StrToDate(DateInput,myformat);
end;

procedure TTabelForm.StringGrid1SelectCell(Sender: TObject; ACol,
 ARow: Integer; var CanSelect: Boolean);
 var
 p: TPoint;
 Year,Month,Day: Word;
 datefirst, datelast: string;
begin
DecodeDate(MonthCalendar1.Date,Year,Month,Day);
datefirst:=DateToStr(EncodeDate(Year,Month,1),myformat);
datelast:= DateToStr(EncodeDate(Year,Month,DaysInMonth(MonthCalendar1.Date)),myformat);
   if (ACol>=2) and (ARow>=1) then
   begin
       p:= StringGrid1.CellRect(ACol,Arow).TopLeft;
       p.X:=p.X+1;
       p.Y:=p.Y+1;
       if StringGrid1.Canvas.Pixels[p.X,p.Y] = 13160660 then CanSelect:=False
       else CanSelect:=True;
       if StringGrid1.EditorMode = True and ((ARow <> StringGrid1.Row) or (ACol <> StringGrid1.Col)) then
         begin
             with StringGrid1 do begin
             if StrEd <> Cells[Col,Row] then begin
                   if InsertTabel then
                       begin
                         Cells[Col,Row]:=AnsiUpperCase(Cells[Col,Row]);
                         TabelForm.UpDateDataSet1(datefirst,datelast);
                         Application.MessageBox(PAnsiChar(IntToStr(Col)),'Опа-па',MB_OK+MB_ICONWARNING);
                       end
                   else
                       begin
                         exit;
                       end;
                 end
             else exit;
             end;
         end;
   end;
end;

procedure TTabelForm.StringGrid1Exit(Sender: TObject);
 var Year,Month,Day: Word;
 datefirst, datelast: string;
begin
DecodeDate(MonthCalendar1.Date,Year,Month,Day);
datefirst:=DateToStr(EncodeDate(Year,Month,1),myformat);
datelast:= DateToStr(EncodeDate(Year,Month,DaysInMonth(MonthCalendar1.Date)),myformat);
  if StringGrid1.EditorMode = True then
    begin
       with StringGrid1 do begin
             if StrEd <> Cells[Col,Row] then begin
                  if InsertTabel then
                       begin
                         Cells[Col,Row]:=AnsiUpperCase(Cells[Col,Row]);
                         TabelForm.UpDateDataSet1(datefirst,datelast);
                         Application.MessageBox(PAnsiChar(IntToStr(Col)),'Опа-па',MB_OK+MB_ICONWARNING);
                       end
                   else
                       begin
                         exit;
                       end;
                 end
             else exit;
             end;
    end;
end;

procedure TTabelForm.StringGrid1KeyDown(Sender: TObject; var Key: Word;
 Shift: TShiftState);
 var Year,Month,Day: Word;
 datefirst, datelast: string;
begin
DecodeDate(MonthCalendar1.Date,Year,Month,Day);
datefirst:=DateToStr(EncodeDate(Year,Month,1),myformat);
datelast:= DateToStr(EncodeDate(Year,Month,DaysInMonth(MonthCalendar1.Date)),myformat);
if  ((Key = VK_RETURN) and (StringGrid1.EditorMode = True))or((Key = VK_TAB) and (StringGrid1.EditorMode = True)) then begin
       with StringGrid1 do begin
             if StrEd <> Cells[Col,Row] then begin
                   if InsertTabel then
                       begin
                         Cells[Col,Row]:=AnsiUpperCase(Cells[Col,Row]);
                         TabelForm.UpDateDataSet1(datefirst,datelast);
                         Application.MessageBox(PAnsiChar(IntToStr(Col)),'Опа-па',MB_OK+MB_ICONWARNING);
                         if StringGrid1.Row < StringGrid1.RowCount-1 then  StringGrid1.Row:=StringGrid1.Row+1
                         else StringGrid1.SetFocus;
                       end
                   else
                       begin
                         exit;
                       end;
             end
             else exit;

       end;
   end;
end;

procedure TTabelForm.StringGrid1GetEditText(Sender: TObject; ACol,
 ARow: Integer; var Value: String);
 var Year,Month,Day: Word;
begin
 DecodeDate(MonthCalendar1.Date,Year,Month,Day);
 if ADODataSet1.Locate('dat;idrab',VarArrayOf([DateToStr(EncodeDate(Year,Month,Strin gGrid1.Col-1),myformat),StringGrid1.Cells[0,StringGrid1.Row]]),[]) then
     StrEd:=ADODataSet1.FieldValues['chasi']
 else
     StrEd:='';
end;

function TTabelForm.InsertTabel;
var
Year,Month,Day: Word;
Key: Smallint;
IdRab: Integer;
DateWork: TDateTime;
DateString: String;
Val: String;
begin
   DecodeDate(MonthCalendar1.Date,Year,Month,Day);
   DateWork:= EncodeDate(Year,Month,StringGrid1.Col-1);
   DateString:= DateToStr(EncodeDate(Year,Month,StringGrid1.Col-1),myformat);
   IdRab:=StrToInt(StringGrid1.Cells[0,StringGrid1.Row]);
   Val:= AnsiUpperCase(Trim(StringGrid1.Cells[StringGrid1.Col,StringGrid1.Row]));
   if Val<>'' then begin
   if (Val = 'Н')or(Val = 'О')or(Val = 'К')or(Val = 'Б')or(Val = 'П')or(Val = 'У')or(Val = 'ОБС')or(Val = 'ОЗ')or(HelpMy.ValCifr(Val))then begin
   Case DayOfTheWeek(DateWork)of
           1..5:Key:=1;
           6,7:Key:=2;
   end;
   if ADODataSet3.Locate('dat',DateString,[])then Key := ADODataSet3.FieldValues['keys'];
   with ADOCommTabel do
   begin
       with Parameters.AddParameter do begin
       name:='ifdat';
       DataType := ftString;
       Direction := pdInput;
       Value:=DateString;
       end;
       with Parameters.AddParameter do begin
       name:='ifidrab';
       DataType := ftInteger;
       Direction := pdInput;
       Value:=IdRab;
       end;
       with Parameters.AddParameter do begin
       name:='upchasi';
       DataType := ftString;
       Direction := pdInput;
       Value:=Val;
       end;
       with Parameters.AddParameter do begin
       name:='upkeys';
       DataType := ftSmallint;
       Direction := pdInput;
       Value:=Key;
       end;
       with Parameters.AddParameter do begin
       name:='updat';
       DataType := ftString;
       Direction := pdInput;
       Value:=DateString;
       end;
       with Parameters.AddParameter do begin
       name:='upidrab';
       DataType := ftInteger;
       Direction := pdInput;
       Value:=IdRab;
       end;
       with Parameters.AddParameter do begin
       name:='indat';
       DataType := ftString;
       Direction := pdInput;
       Value:=DateString;
       end;
       with Parameters.AddParameter do begin
       name:='inidrab';
       DataType := ftInteger;
       Direction := pdInput;
       Value:=IdRab;
       end;
       with Parameters.AddParameter do begin
       name:='inchasi';
       DataType := ftString;
       Direction := pdInput;
       Value:=Val;
       end;
       with Parameters.AddParameter do begin
       name:='inkey';
       DataType := ftSmallint;
       Direction := pdInput;
       Value:=Key;
       end;
       CommandText:='if exists(select * from tabel where dat=:ifdat and idrab=:ifidrab) update tabel set chasi=:upchasi, keys=:upkeys where dat=:updat and idrab=:upidrab else insert into tabel values(:indat, :inidrab, :inchasi, :inkey)';
       ADOCommTabel.Execute;
       Result:=True;
   end;
   end else begin
                 if MessageDlg ('Некорректные данные ', mtError, [mbOK, mbCancel], 0)= mrOK then begin
                   StringGrid1.EditorMode:=True;
                   Result:=False;
                   exit;
                 end
                 else begin with StringGrid1 do begin
                             Cells[Col,Row]:= StrEd;
                             EditorMode:=False;
                             Result:=False;
                             exit;
                             end;
                       end;
             end;
   end
   else
     begin
     with ADOCommTabel.Parameters.AddParameter do begin
     name:='ifdat';
     DataType := ftString;
     Direction := pdInput;
     Value:=DateString;
     end;
     with ADOCommTabel.Parameters.AddParameter do begin
     name:='ifidrab';
     DataType := ftInteger;
     Direction := pdInput;
     Value:=IdRab;
     end;
    ADOCommTabel.CommandText:='delete from tabel where dat=:ifdat and idrab=:ifidrab';
    ADOCommTabel.Execute;
    Result:=True;
    end;
end;

procedure TTabelForm.UpDateDataSet1(var datefirst, datelast: String);
begin
ADODataSet1.Close;
ADODataSet1.CommandText:= 'select * from tabel where dat between :datfirst and :datlast and idrab in (select kadri.id from kadri,tabel where datein <= :datlastn and (dateout>= :datfirstn or dateout is null)) order by tabel.idrab,tabel.dat';
ADODataSet1.Parameters.ParseSQL(ADODataSet1.CommandText,True);
ADODataSet1.Parameters.ParamValues['datfirst']:= datefirst;
ADODataSet1.Parameters.ParamValues['datfirstn']:= datefirst;
ADODataSet1.Parameters.ParamValues['datlast']:= datelast;
ADODataSet1.Parameters.ParamValues['datlastn']:= datelast;
ADODataSet1.Open;
end;

end.