Главная Случайная страница


Полезное:

Как сделать разговор полезным и приятным Как сделать объемную звезду своими руками Как сделать то, что делать не хочется? Как сделать погремушку Как сделать так чтобы женщины сами знакомились с вами Как сделать идею коммерческой Как сделать хорошую растяжку ног? Как сделать наш разум здоровым? Как сделать, чтобы люди обманывали меньше Вопрос 4. Как сделать так, чтобы вас уважали и ценили? Как сделать лучше себе и другим людям Как сделать свидание интересным?


Категории:

АрхитектураАстрономияБиологияГеографияГеологияИнформатикаИскусствоИсторияКулинарияКультураМаркетингМатематикаМедицинаМенеджментОхрана трудаПравоПроизводствоПсихологияРелигияСоциологияСпортТехникаФизикаФилософияХимияЭкологияЭкономикаЭлектроника






Текст программы (листинг)





unit UnGlav;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, DBCtrls, Grids, DBGrids, DB, ADODB, ExtCtrls, NiceGrid, StdCtrls,

ComCtrls, XPMan, jpeg, Menus;

type

TFrmGlav = class(TForm)

QMastera: TADOQuery;

NG: TNiceGrid;

QToTime: TADOQuery;

QActiveMaster: TADOQuery;

Panel1: TPanel;

Splitter1: TSplitter;

DBLookupComboBox1: TDBLookupComboBox;

DateTimePicker1: TDateTimePicker;

XPManifest1: TXPManifest;

StatusBar1: TStatusBar;

MainMenu1: TMainMenu;

N1: TMenuItem;

N2: TMenuItem;

N3: TMenuItem;

N4: TMenuItem;

N5: TMenuItem;

N6: TMenuItem;

N7: TMenuItem;

N8: TMenuItem;

N10: TMenuItem;

N11: TMenuItem;

N12: TMenuItem;

N13: TMenuItem;

N16: TMenuItem;

Image1: TImage;

Image2: TImage;

procedure DBLookupComboBox1Click(Sender: TObject);

procedure NGDblClick(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure N16Click(Sender: TObject);

procedure N2Click(Sender: TObject);

procedure N3Click(Sender: TObject);

procedure N6Click(Sender: TObject);

procedure N13Click(Sender: TObject);

procedure N11Click(Sender: TObject);

private

function AddKl():boolean;

{ Private declarations }

public

{ Public declarations }

end;

var

FrmGlav: TFrmGlav;

ss:String;

implementation

uses UnData, UnAdd, UnNewRabotnik, USotrudniki, UUslugi, UForm2, UPrays;

{$R *.dfm}

procedure TFrmGlav.DBLookupComboBox1Click(Sender: TObject);

var

i:integer;

bool:boolean;

begin

NG.RowCount:=1;

i:=1;

for i:=ng.ColCount downto 1 do

ng.Columns.Delete(i-1);

NG.Columns.Add;

NG.Columns[0].Title:='Время';

QMastera.Close;

QMastera.Parameters.ParamByName('pKateg').Value DMBase.TKateg.Fields.Fields[0].Value;

QMastera.Open;

if QMastera.RecordCount > 0 then

BEGIN

//Заполним фамилии мастеров

QMastera.First;

i:=1;

bool:=true;

while i < QMastera.RecordCount*2 do

begin

NG.Columns.Add;

NG.Columns[i].Title:=QMastera.Fields.Fields[1].Value + ' | C..';

NG.Columns[i].Color:= $00DFDFFF;

i:=i+1;

NG.Columns.Add;

NG.Columns[i].Title:=QMastera.Fields.Fields[1].Value + ' | До..';

i:=i+1;

if bool=true then

begin

bool:=false; NG.Columns[i-1].Color:= $00DFDFFF;

NG.Columns[i-2].Color:= $00DFDFFF; end

else

begin

bool:=true; NG.Columns[i-1].Color:= $00FFF1E1;

NG.Columns[i-2].Color:= $00FFF1E1; end;

QMastera.Next;

end;

END;

//Button1Click(sender);

AddKl();

end;

procedure TFrmGlav.NGDblClick(Sender: TObject);

var

s,sn:string;

i:integer;

begin

if ng.Cells[ng.Col, ng.Row ]='-' then BEGIN

s:=NG.Columns[ng.Col].Title;

sn:='';

i:=1;

Delete(s,pos('|',s)-1,7);

QActiveMaster.Close;

QActiveMaster.Parameters.ParamByName('pFam').Value:= s;

QActiveMaster.Open;

if (FrmGlav.NG.Col mod 2)<>0 then

begin

if NG.Row = 0 then

frmAdd.LbOt.Caption:= '8:00'

else

frmAdd.LbOt.Caption:= NG.Cells[NG.Col+1,NG.Row-1];

if NG.Cells[NG.Col,NG.Row]='-' then

frmAdd.LbDo.Caption:=NG.Columns[NG.Col].Footer

else

frmAdd.LbDo.Caption:= NG.Cells[NG.Col,NG.Row+1];

end

else

begin

if NG.Row = 0 then

frmAdd.LbOt.Caption:= '8:00'

else

frmAdd.LbOt.Caption:= FrmGlav.NG.Cells[NG.Col,NG.Row-1];

if NG.Cells[NG.Col-1,NG.Row+1]='' then

frmAdd.LbDo.Caption:=NG.Columns[NG.Col].Footer

else

frmAdd.LbDo.Caption:= FrmGlav.NG.Cells[NG.Col-1,NG.Row+1];

end;

if frmAdd.LbOt.Caption='С..' then

frmAdd.LbOt.Caption:='8:00:00';

frmAdd.ShowModal; END;

end;

function TFrmGlav.AddKl(): boolean;

var

tn,tk,tnPred,tkPred:TDateTime;

k,i,na,ko,j:integer;

begin

QMastera.First;

j:=-1;

WHILE NOT QMastera.Eof DO

BEGIN

with QToTime do

begin

Close;

Parameters.ParamByName('pDate').Value:=FormatDateTime('dd.mm.yyyy',DateTimePicker1.Date);

Parameters.ParamByName('pMaster').Value:=QMastera.Fields.Fields[0].Value;

Open;

j:=j+2;

end;

IF QToTime.RecordCount > 0 then begin

QToTime.First;

k:=0; na:=0;

while not (QToTime.Eof) do

begin

tn:=StrToTime(QToTime.Fields.FieldByName('Время_нач').Value);

tk:=StrToTime(QToTime.Fields.FieldByName('Время_кон').Value);

if (tn> tkPred) and (tn- tkPred >= StrToTime('00:05:00')) and (k<>0) then

begin

{ NG.Cells[1,k]:=TimeToStr(tkPred);

NG.Cells[2,k]:=TimeToStr(tn);}

if NG.RowCount < (k+1) then

NG.AddRow;

NG.Cells[j,k]:='-';

NG.Cells[j+1,k]:='-';

k:=k+1;

end;

//Условие ставит свободное время в первую строку, если сотрудник не занят с 8:05:00

if (tn> StrToTime('08:05:00')) and (tn< StrToTime('19:55:00')) and (k=0) then begin

if NG.RowCount < (k+1) then

NG.AddRow;

NG.Cells[j,k]:='-';

NG.Cells[j+1,k]:='-';

k:=k+1;

end;

if NG.RowCount < (k+1) then

NG.AddRow;

NG.Cells[j,k]:=FormatDateTime('hh:mm',tn);

NG.Cells[j+1,k]:=FormatDateTime('hh:mm',tk);

k:=k+1;

tnPred:=tn;

tkPred:=tk;

QToTime.Next;

end;

if tkPred <StrToTime('19:55:00') then

begin

NG.AddRow;

NG.Cells[j,k]:='-';

NG.Cells[j+1,k]:='-';

end;

end

else

begin

NG.Cells[j,0]:='-';

NG.Cells[j+1,0]:='-';

end;

QMastera.Next;

END;

For i:=1 to NG.ColCount-1 do

NG.Columns[i].Footer:='20:00';

end;

procedure TFrmGlav.FormCreate(Sender: TObject);

begin

StatusBar1.Panels[1].Text:=DAteToStr(date);

end;

procedure TFrmGlav.N16Click(Sender: TObject);

begin

Close;

end;

procedure TFrmGlav.N2Click(Sender: TObject);

begin

FrmNewRabotnik.ADOTable1.Append;

FrmNewRabotnik.Show;

end;

procedure TFrmGlav.N3Click(Sender: TObject);

begin

FrmSotrudniki.Show;

end;

procedure TFrmGlav.N6Click(Sender: TObject);

begin

FrmUslugi.Show;

end;

procedure TFrmGlav.N13Click(Sender: TObject);

begin

FrmBibl.Show;

end;

procedure TFrmGlav.N11Click(Sender: TObject);

begin

FrmPrays.Show;

end.


Даталогическая модель данных

Рис. 27 "Структура базы данных"


Date: 2015-06-11; view: 459; Нарушение авторских прав; Помощь в написании работы --> СЮДА...



mydocx.ru - 2015-2024 year. (0.006 sec.) Все материалы представленные на сайте исключительно с целью ознакомления читателями и не преследуют коммерческих целей или нарушение авторских прав - Пожаловаться на публикацию