104
procedure TblCardTypesdiscountGetText(Sender: TField; var Text:
String;
DisplayText: Boolean);
procedure TblCardTypesdiscountSetText(Sender: TField;
const Text: String);
procedure TblCardTypesDayLimitedGetText(Sender: TField;
var Text: String; DisplayText: Boolean);
procedure TblCardTypesDayLimitedSetText(Sender: TField;
const Text: String);
procedure TblCardTypesDayLimitGetText(Sender: TField; var Text:
String;
DisplayText: Boolean);
procedure TblCardTypesDayLimitSetText(Sender: TField;
const Text: String);
procedure TblcardslockedGetText(Sender: TField; var Text: String;
DisplayText: Boolean);
procedure TblcardslockedSetText(Sender: TField; const Text: String);
procedure TblcardsNewRecord(DataSet: TDataSet);
procedure TblAdminspasswordGetText(Sender: TField; var Text:
String;
DisplayText: Boolean);
procedure TblUsedMatNewRecord(DataSet: TDataSet);
private
{ Private declarations }
public
function Skidka(clientid,servid:integer; var tp,inf:string;var
card:integer):double;
procedure ClearCardHistory(id:integer);
procedure FixedPos(cardid,servid:Integer);
105
procedure ProcessEndTimeCards;
procedure SaveChart(ch:TChart;str:string='');
function ToDayBurned:string;
{ Public declarations }
end;
var
dm: Tdm;
Admin:boolean=true;
adminid:integer=1;
super:Boolean = False;
user,passw:string;
implementation
uses sqlAdoTools,rusdlg;
{$R *.dfm}
function Tdm.ToDayBurned:string;
var dt:TDateTime;
y,m,d:Word;
y2,m2,d2:Word;
begin
Result:='';
DecodeDate(Date,y,m,d);
with MakeCursor('SELECT Client.Client_ID, [Surname]+" "+[Name]+"
"+[Patronymic] AS FIO, dtburn FROM Client') do
begin
while not eof do
106
begin
dt:=Fields[2].AsDateTime;
DecodeDate(dt,y2,m2,d2);
if (m=m2) and(d=d2) then
Result:=Format('%s%s. Исполнилось :
%d'#10#13,[Result,Fields[1].AsString,y-y2]);
Next;
end;
Free;
end;
end;
procedure Tdm.SaveChart(ch:TChart;str:string);
begin
if str<>'' then SavePictureDialog1.Title := str;
SavePictureDialog1.FileName := str;
if not SavePictureDialog1.Execute then Exit;
if UpperCase(ExtractFileExt(SavePictureDialog1.FileName))='.BMP'
then
ch.SaveToBitmapFile(SavePictureDialog1.FileName);
if UpperCase(ExtractFileExt(SavePictureDialog1.FileName))='.WMF'
then
ch.SaveToMetafile(SavePictureDialog1.FileName);
if UpperCase(ExtractFileExt(SavePictureDialog1.FileName))='.EMF'
then
ch.SaveToMetafileEnh(SavePictureDialog1.FileName);
end;
107
procedure Tdm.ProcessEndTimeCards;
begin
// with MakeCursor('select * from cards a, cardtypes b where
a.type=b.id') do
with MakeCursor('select * from cards ') do
begin
while not eof do
begin
if not FieldByName('dtend').IsNull and
(FieldByName('dtend').AsDateTime<Date) then
begin
RunSql('UPDATE cards SET cards.[end] = 1 WHERE
cards.card_id= %d',[FieldByName('card_id').AsInteger]);
end;
Next;
end;
Free;
end;
end;
procedure Tdm.ClearCardHistory(id:integer);
begin
RunSQL('Delete from UsedService where card_id=%d',[id]);
end;
procedure Tdm.FixedPos(cardid,servid:Integer);
begin
if calculateint('select count(*) from UsedService where card_id=%d and
Service=%d',[cardid,servid]) =0 then
108
RunSql('insert into UsedService (Card_id,Service,cnt) values
(%d,%d,1)',[cardid,servid])
else
RunSql('update UsedService set cnt=cnt+1 where Card_id=%d and
Service=%d',[cardid,servid]);
end;
function Tdm.Skidka(clientid,servid:integer; var tp,inf:string;var
card:integer):double;
var i,j,day,db,de,allcnt,ucnt:integer;
dend:tDateTime;
disc:double;
loc,abon:boolean;
begin
result:=0;
inf:=''; tp:='Нет карты';
card:=-1;
i:=CalculateInt('select card_id from cards where client = %d',[clientid]);
if i=0 then exit;
card:=i;
with MakeCursor('select a.dtend,b.discount,b.id, a.locked, b.name as tp ,
b.AbonType from cards a, cardtypes b where b.id=a.type and
card_id='+IntToStr(i)) do
begin
dend:=FieldByName('dtend').AsDateTime;
disc:=FieldByName('discount').AsFloat;
j:=FieldByName('id').AsInteger;
loc:=FieldByName('locked').AsBoolean;
abon:=FieldByName('abontype').AsBoolean;
109
tp:='№'+IntToStr(i)+' '+FieldByName('tp').AsString;
free;
end;
if loc then begin inf:='Карта блокирована'; exit; end;
if abon then
begin
allcnt := calculateInt('select cnt from ServiseOnCard where
fortype=%d and Service=%d',[j,servid]);
if allcnt=0 then
begin
inf:='Скидка на эту услугу не предусмотрена';
Exit;
end;
ucnt := calculateInt('select cnt from UsedService where card_id=%d
and Service=%d',[i,servid]);
if ucnt>=allcnt then begin inf:='Все оплаченные разы уже
использованы'; exit; end;
inf := Format('По карте использовано %d из %d',[ucnt,allcnt]);
Result:=1;
Exit;
end;
if (dend<date) and (dend>0) then begin inf:='У карты истек срок
действия'; exit; end;
day:=DayOfWeek(Date);
if day = 1 then day:=7 else dec(day);
db:=-1;
110
with MakeCursor(format('select fromhour,tohour from TimeForCards
where fortype=%d and day=%d',[j,day])) do
begin
if not IsEmpty then
begin
db:=FieldByName('fromhour').AsInteger;
de:=FieldByName('tohour').AsInteger;
end;
free;
end;
if db=-1 then begin inf:='Для типа карт не определено время
действия'; exit; end;;
if (time<EncodeTime(db,0,0,0)) or (time>EncodeTime(de,0,0,0)) then
begin
inf:='Данный тип карты в это время не работает'; exit; end;
result:=disc;
inf:='Карта активна';
end;
procedure Tdm.QryClientNewRecord(DataSet: TDataSet);
begin
QryClientadmin_id.Value := adminid;
end;
procedure Tdm.ADOSpecNewRecord(DataSet: TDataSet);
begin
ADOSpecSpeciality_ID.Value := GetId('Speciality_ID','Speciality');
end;
111
procedure Tdm.DataModuleCreate(Sender: TObject);
var ini:tIniFile; //объект INI-файл
s:string;
begin
Database.Close;
ini:=tIniFile.Create(ChangeFileExt(paramstr(0),'.ini')); //создаем
s:=ini.ReadString('main','db','db2.mdb'); //чтение строки пути к данным
// while true do
if not FileExists(s) then //если файла данных нет
begin
if not OpenDialog.Execute then //показать диалог открытия файла
begin
rusdlg.Error('Программа заканчивает свою работу'); //если отмена,
то выход
halt;
end;
//Затем сохраняем строку в ini-файл
s:=OpenDialog.FileName;
ini.WriteString('main','db',OpenDialog.FileName);
end;
//строим строку подключения
Database.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data
Source='+s+';Persist Security Info=False';
ini.Free; //освобождение памяти.
randomize;// инициализация генератора случайных чисел
//открывается база из текущей директории
Database.Open;
112
dbCon:=Database;
if CalculateInt('select id from admins where
Name=%s',[QuotedStr(SADM)])=0 then
begin
RunSQL('Insert into admins (Name, [password]) values
(%s,%s)',[QuotedStr(SADM),QuotedStr('1')]);
Notify('В систему был добавлен супер администратор %s с паролем
%s',[QuotedStr(SADM),QuotedStr('1')]);
TblAdmins.Close;
TblAdmins.Open;
end;
ProcessEndTimeCards;
end;
procedure Tdm.TblTimeForCardsNewRecord(DataSet: TDataSet);
begin
TblTimeForCardsday.Value:=1;
TblTimeForCardsfromhour.Value:=0;
TblTimeForCardstohour.Value:=23;
TblTimeForCardsfortype.Value := TblTimeForCards.Tag;
end;
procedure Tdm.TblCardTypesNewRecord(DataSet: TDataSet);
begin
TblCardTypesdiscount.Value:=0.05;
TblCardTypescost.Value:=0;
113
TblCardTypesDayLimited.Value:=true;
TblCardTypesDayLimit.Value:=31;
TblCardTypesAbonType.Value:=true;
end;
procedure Tdm.TblCardTypesdiscountGetText(Sender: TField; var Text:
String;
DisplayText: Boolean);
begin
If sender.IsNull then exit;
if TblCardTypesAbonType.Value then text:='-' else
Text:=format('%1.2f%%',[sender.asfloat*100]);
end;
procedure Tdm.TblCardTypesdiscountSetText(Sender: TField;
const Text: String);
var f:double;
s:string;
begin
if text='' then begin sender.clear;exit;end;
s:=text;
if s[length(s)]='%' then delete(s,length(s),1);
if TryStrToFloat(s,f) then
begin
if (f>=0) and (f<=100) then
sender.AsFloat:=f/100
else
begin