98
Var
i: Integer;
begin
//Пиклисты для вспомогательных форм
dm1.qZayavka.First;
For i:=0 To dm1.qZayavka.RecordCount-1 Do
Begin
frmNaryad.DBGrid1.Columns.Items[1].PickList.Add(dm1.qZayavka.FieldByName('z
ayavka_code').AsString);
dm1.qZayavka.Next;
End;
dm1.qPersonal.Filtered:=True;
dm1.qPersonal.First;
For i:=0 To dm1.qPersonal.RecordCount-1 Do
Begin
frmNaryad.DBGrid1.Columns.Items[4].PickList.Add(dm1.qPersonal.FieldByName('fa
mily').AsString+' '+
dm1.qPersonal.FieldByName('name').AsString);
frmZayavka.DBGrid1.Columns.Items[2].PickList.Add(dm1.qPersonal.FieldByName('
family').AsString+' '+
dm1.qPersonal.FieldByName('name').AsString);
frmUchastok.DBGrid1.Columns.Items[1].PickList.Add(dm1.qPersonal.FieldByName(
'family').AsString+' '+
dm1.qPersonal.FieldByName('name').AsString);
dm1.qPersonal.Next;
End;
dm1.qPersonal.Filtered:=False;
dm1.qClients.First;
99
For i:=0 To dm1.qClients.RecordCount-1 Do
Begin
frmZayavka.DBGrid1.Columns.Items[3].PickList.Add(dm1.qClients.FieldByN
ame('family').AsString+' '+
dm1.qClients.FieldByName('name').AsString+' '+
dm1.qClients.FieldByName('name2').AsString);
dm1.qClients.Next;
End;
dm1.qDogovor.First;
For i:=0 To dm1.qDogovor.RecordCount-1 Do
Begin
frmOplata.DBGrid1.Columns.Items[1].PickList.Add(dm1.qDogovor.FieldByN
ame('dogovor_code').AsString);
dm1.qDogovor.Next;
End;
end;
procedure TfrmMain.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
If key=112 Then
ShellExecute(0, 'open', 'help\main.html', NIL,NIL, SW_SHOW);
end;
//Кнопка Новый договор
procedure TfrmMain.btnNewClick(Sender: TObject);
begin
dm1.qDogovor.Filtered:=False;
If frmClient.ShowModal=mrOk Then
Begin
dm1.ibc1.ExecuteDirect('INSERT INTO dogovor (client_code) VALUES ('+
dm1.qClients.FieldByName('client_code').AsString+')');
dm1.qDogovor.Refresh;
dm1.qDogovor.Last;
100
frmDogovor.Tag:=dm1.qDogovor.FieldByName('dogovor_code').AsInteger;
frmDogovor.Caption:='Новый договор №
'+dm1.qDogovor.FieldByName('dogovor_code').AsString;
frmDogovor.Show
End
Else
ShowMessage('Нужно выбрать или ввести нового клиента');
end;
procedure TfrmMain.btnDeleteClick(Sender: TObject);
begin
If MessageBox(0, PChar(UTF8ToAnsi('Хотите удалить договор №
'+dm1.qDogovor.FieldByName('dogovor_code').AsString+'?')),
PChar(UTF8ToAnsi('Удаление')),
MB_OKCANCEL+MB_ICONQUESTION)=IDOK Then
Begin
dm1.ibc1.ExecuteDirect('DELETE FROM dogovor WHERE
dogovor_code='+dm1.qDogovor.FieldByName('dogovor_code').AsString);
dm1.qDogovor.Refresh;
End;
end;
//Кнопка Показать договор
procedure TfrmMain.btnViewClick(Sender: TObject);
begin
If dm1.qDogovor.RecordCount>0 Then
Begin
dm1.qClients.Locate('client_code',dm1.qDogovor.FieldByName('client_code').Value,[
]);
dm1.qInet.Locate('tarif_code',dm1.qDogovor.FieldByName('tarif_internet_code').Valu
e,[]);
101
dm1.qTv.Locate('tarif_code',dm1.qDogovor.FieldByName('tarif_tv_code').Value,[]);
frmDogovor.Caption:='Договор №
'+dm1.qDogovor.FieldByName('dogovor_code').AsString;
frmDogovor.Show;
End;
end;
procedure TfrmMain.edFindFamKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
If Key=13 Then
Begin
dm1.qDogovor.Locate('name', VarArrayOf([edFindFam.Text]),
[loCaseInsensitive, loPartialKey]);
edFindNum.Text:='';
End;
end;
procedure TfrmMain.edFindNumKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
If Key=13 Then
Begin
dm1.qDogovor.Locate('dogovor_code', VarArrayOf([edFindNum.Text]), []);
edFindFam.Text:='';
End;
end;
procedure TfrmMain.FormShow(Sender: TObject);
begin
DBGrid1.SetFocus;
end;
//Меню Помощь - О программе
procedure TfrmMain.itAboutClick(Sender: TObject);
102
begin
frmAbout.ShowModal;
end;
//Меню Справочники - Клиенты
procedure TfrmMain.itClientClick(Sender: TObject);
begin
frmClient.ShowModal;
end;
procedure TfrmMain.itContentClick(Sender: TObject);
begin
ShellExecute(0, 'open', 'help\index.html', NIL,NIL, SW_SHOW);
end;
procedure TfrmMain.itDolgClick(Sender: TObject);
begin
PrintDolgi;
end;
//Меню Справочники - IP адреса
procedure TfrmMain.itIpClick(Sender: TObject);
begin
frmIp.ShowModal;
end;
procedure TfrmMain.itNaryadClick(Sender: TObject);
begin
frmNaryad.ShowModal;
end;
procedure TfrmMain.itOnaryadClick(Sender: TObject);
begin
PrintNaryadi;
end;
//Меню Файл - Оплата
procedure TfrmMain.itOplataClick(Sender: TObject);
begin
103
frmOplata.ShowModal;
end;
procedure TfrmMain.itOzayavClick(Sender: TObject);
begin
PrintZayavki;
end;
//Меню Справочники - Сотрудники
procedure TfrmMain.itPersonalClick(Sender: TObject);
begin
frmPersonal.ShowModal;
end;
procedure TfrmMain.itQuitClick(Sender: TObject);
begin
Application.Terminate;
end;
//Меню Отчёты - Тарифы и услуги
procedure TfrmMain.itReptarifClick(Sender: TObject);
begin
PrintTarif;
end;
//Меню Отчёты - Текущие договора
procedure TfrmMain.itSchetaClick(Sender: TObject);
begin
PrintDogovora;
end;
//Меню Справочники - Услуги и тарифы
procedure TfrmMain.itTarifClick(Sender: TObject);
begin
frmTarif.ShowModal;
end;
procedure TfrmMain.itUchastokClick(Sender: TObject);
begin
104
frmUchastok.ShowModal;
end;
procedure TfrmMain.itZayavkaClick(Sender: TObject);
begin
frmZayavka.ShowModal;
end;
procedure TfrmMain.rgTypeClick(Sender: TObject);
begin
dm1.qDogovor.Filtered:=False;
Case rgType.ItemIndex Of
0:Begin
End;
1:Begin
dm1.qDogovor.Filter:='tarif_internet_code>0';
dm1.qDogovor.Filtered:=True;
End;
2:Begin
dm1.qDogovor.Filter:='tarif_tv_code>0';
dm1.qDogovor.Filtered:=True;
End;
End;
end;
initialization
{$I main.lrs}
end.
about.pas
unit about;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
105
ExtCtrls, StdCtrls;
type
{ TfrmAbout }
TfrmAbout = class(TForm)
btnOk: TButton;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Panel1: TPanel;
private
{ private declarations }
public
{ public declarations }
end;
var
frmAbout: TfrmAbout;
implementation
initialization
{$I about.lrs}
end.
Client.pas
unit client;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
ComCtrls, ExtCtrls, StdCtrls, DBGrids, db;
type
{ TfrmClient }
TfrmClient = class(TForm)
btnOk: TButton;
106
btnCancel: TButton;
dsClients: TDatasource;
DBGrid1: TDBGrid;
Panel1: TPanel;
StatusBar1: TStatusBar;
procedure FormShow(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
frmClient: TfrmClient;
implementation
{ TfrmClient }
procedure TfrmClient.FormShow(Sender: TObject);
begin
DBGrid1.SetFocus;
end;
initialization
{$I client.lrs}
end.
Clientlogin.pas
unit clientlogin;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls;
type
{ TfrmClientlogin }
TfrmClientlogin = class(TForm)
107
btnOk: TButton;
btnCancel: TButton;
edLogin: TEdit;
edPass: TEdit;
Label1: TLabel;
Label2: TLabel;
private
{ private declarations }
public
{ public declarations }
end;
var
frmClientlogin: TfrmClientlogin;
implementation
initialization
{$I clientlogin.lrs}
end.
Createdb.pas
program test;
uses classes,sqlite3db, sysutils;
var
MySQL: TSQLite;
i: Integer;
a: TStringList;
begin
Writeln('Creating class');
MySQL := TSQLite.Create('rastrnet.db3');
MySQL.BusyTimeout := 1000;
writeln(MySQL.Version);
Writeln('Creating tables');
a:=TStringList.Create;
a.LoadFromFile('rastrnet1.sql');