118
implementation
{ TfrmIp }
procedure TfrmIp.FormShow(Sender: TObject);
begin
DBGrid1.SetFocus;
end;
initialization
{$I ip.lrs}
end.
Login.pas
unit login;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls;
type
{ TfrmLogin }
TfrmLogin = class(TForm)
btnOk: TButton;
btnCancel: TButton;
edLogin: TEdit;
edPass: TEdit;
Label1: TLabel;
Label2: TLabel;
procedure btnCancelClick(Sender: TObject);
procedure btnOkClick(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
119
var
frmLogin: TfrmLogin;
implementation
{ TfrmLogin }
Uses dm, main;
procedure TfrmLogin.btnOkClick(Sender: TObject);
begin
dm1.qLogin.Close;
dm1.qLogin.Params.ParamByName('login').AsString:=edLogin.Text;
dm1.qLogin.Params.ParamByName('pass').AsString:=edPass.Text;
dm1.qLogin.Open;
If dm1.qLogin.RecordCount=0 Then
Begin
ShowMessage('Неверные имя пользователя или пароль! Завершение
программы...');
Application.Terminate;
End
Else
Begin
frmLogin.Visible:=False;
If dm1.qLogin.FieldByName('accesslvl').AsInteger>2 Then
frmMain.MainMenu.Items.Find('Справочники').Find('Сотрудники').Enabled:=False;
frmMain.Visible:=True;
End;
end;
procedure TfrmLogin.btnCancelClick(Sender: TObject);
begin
Application.Terminate;
end;
initialization
{$I login.lrs}
120
end.
Naryad.pas
unit naryad;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
ComCtrls, ExtCtrls, DBGrids, DbCtrls, db, StdCtrls;
type
{ TfrmNaryad }
TfrmNaryad = class(TForm)
btnOk: TButton;
btnCancel: TButton;
dsNaryad: TDatasource;
DBGrid1: TDBGrid;
DBMemo1: TDBMemo;
Panel1: TPanel;
Panel2: TPanel;
Panel3: TPanel;
StatusBar1: TStatusBar;
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift:
TShiftState);
procedure FormShow(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
frmNaryad: TfrmNaryad;
implementation
Uses dm, windows;
121
{ TfrmNaryad }
procedure TfrmNaryad.FormShow(Sender: TObject);
Var
i: integer;
begin
DBGrid1.SetFocus;
end;
procedure TfrmNaryad.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
If key=112 Then
ShellExecute(0, 'open', 'help\naryad.html', NIL,NIL, SW_SHOW);
end;
initialization
{$I naryad.lrs}
end.
Oplata.pas
unit oplata;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
ComCtrls, ExtCtrls, StdCtrls, DBGrids, db;
type
{ TfrmOplata }
TfrmOplata = class(TForm)
btnOk: TButton;
btnCancel: TButton;
dsOplata: TDatasource;
DBGrid1: TDBGrid;
Panel1: TPanel;
StatusBar1: TStatusBar;
122
procedure btnOkClick(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift:
TShiftState);
procedure FormShow(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
frmOplata: TfrmOplata;
implementation
Uses dm, windows;
{ TfrmOplata }
procedure TfrmOplata.FormShow(Sender: TObject);
Var
i: Integer;
metka: Variant;
begin
DBGrid1.SetFocus;
end;
procedure TfrmOplata.btnOkClick(Sender: TObject);
begin
end;
procedure TfrmOplata.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
If key=112 Then
ShellExecute(0, 'open', 'help\oplata.html', NIL,NIL, SW_SHOW);
end;
initialization
{$I oplata.lrs}
123
end.
Personal.pas
unit personal;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
ExtCtrls, ComCtrls, StdCtrls, DBGrids, db;
type
{ TfrmPersonal }
TfrmPersonal = class(TForm)
btnOk: TButton;
btnCancel: TButton;
dsPersonal: TDatasource;
DBGrid1: TDBGrid;
Panel1: TPanel;
StatusBar1: TStatusBar;
procedure btnOkClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
frmPersonal: TfrmPersonal;
implementation
Uses dm;
{ TfrmPersonal }
procedure TfrmPersonal.FormShow(Sender: TObject);
begin
124
DBGrid1.SetFocus;
end;
procedure TfrmPersonal.btnOkClick(Sender: TObject);
begin
end;
procedure TfrmPersonal.Button1Click(Sender: TObject);
begin
dm1.qPersonal.Append;
end;
initialization
{$I personal.lrs}
end.
Prints.pas
unit prints;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, dm, windows;
Procedure PrintZayavki;
Procedure PrintNaryadi;
Procedure PrintDolgi;
Procedure PrintDogovora;
Procedure PrintDogovor;
Procedure PrintTarif;
implementation
//Отчёт Заявки
Procedure PrintZayavki;
Var
st: TStringList;
i: integer;
m
dm1.qNaryad.Next;
125
End;
st.Add('</table>');
dm1.qNaryad.Locate('Naryad_code', metka, []);
st.SaveToFile('report\naryad.html');
ShellExecute(0, 'open', 'report\naryad.html', NIL, NIL, SW_SHOW);
st.Free;
End;
//Отчёт Должники
Procedure PrintDolgi;
Var
st: TStringList;
i: integer;
metka: variant;
Begin
st:=TStringList.Create;
st.Add('<html>');
st.Add('<head>');
st.Add(' <title>Список должников</title>');
st.Add(' <meta http-equiv="Content-Type" content="text/html"; charset="utf-
8" />');
st.Add(' <link href="/style.css" rel="stylesheet" type="text/css" />');
s>Счет, руб.');
dm1.qReport.Refresh;
For i:=0 To dm1.qReport.RecordCount-1 Do
Begin
st.Add('<tr><td>'+dm1.qReport.FieldByName('dogovor_code').AsString);
st.Add('<td>'+dm1.qReport.FieldByName('name').AsString);
st.Add('<td>'+dm1.qReport.FieldByName('schet').AsString);
dm1.qReport.Next;
End;
st.Add('</table>');
126
st.SaveToFile('report\dolgi.html');
ShellExecute(0, 'open', 'report\dolgi.html', NIL, NIL, SW_SHOW);
st.Free;
End;
//Отчёт Договора
Procedure PrintDogovora;
Var
st: TStringList;
i: integer;
metka: variant;
Begin
st:=TStringList.Create;
st.Add('<html>');
st.Add('<head>');
st.Add(' <title>Список договоров</title>');
st.Add(' <meta http-equiv="Content-Type" content="text/html"; charset="utf-
8" />');
st.Add(' <link href="/style.css" rel="stylesheet" type="text/css" />');
st.Add('</head>');
st.Add('<h2 align=center>Список текущих договоров</h2>');
st.Add('<center>'+DateToStr(Now)+'</center>');
st.Add('<table border=1 cellpadding=3 width=100%>');
st.Add('<tr>>№ договора<th>Дата заключения<th>Клиент<th>Тариф
интернет<th>Кабельное ТВ<th>Состояние счёта');
metka:=dm1.qDogovor.FieldByName('dogovor_code').Value;
dm1.qDogovor.First;
For i:=0 To dm1.qDogovor.RecordCount-1 Do
Begin
st.Add('<tr><td>'+dm1.qDogovor.FieldByName('dogovor_code').AsString);
st.Add('<td>'+dm1.qDogovor.FieldByName('date_zakl').AsString);
st.Add('<td>'+dm1.qDogovor.FieldByName('name').AsString);
st.Add('<td>'+dm1.qDogovor.FieldByName('tarif_inet').AsString);
127
st.Add('<td>'+dm1.qDogovor.FieldByName('tarif_tv').AsString);
st.Add('<td>'+dm1.qDogovor.FieldByName('schet').AsString);
dm1.qDogovor.Next;
End;
st.Add('</table>');
dm1.qDogovor.Locate('dogovor_code', metka, []);
st.SaveToFile('report\dogovora.html');
ShellExecute(0, 'open', 'report\dogovora.html', NIL, NIL, SW_SHOW);
st.Free;
End;
//Отчёт Тарифы и услуги
Procedure PrintTarif;
Var
st: TStringList;
i: integer;
metka: variant;
Begin
st:=TStringList.Create;
st.Add('<html>');
st.Add('<head>');
st.Add(' <title>Тарифы на услуги</title>');
st.Add(' <meta http-equiv="Content-Type" content="text/html"; charset="utf-
8" />');
st.Add(' <link href="/style.css" rel="stylesheet" type="text/css" />');
st.Add('</head>');
st.Add('<body>');
st.Add('<h2 align=center>Тарифы на услуги</h2>');
st.Add('<center>'+DateToStr(Now)+'</center>');
st.Add('<h3 align=center>Тарифы на интернет</h3>');
st.Add('<table border=1 cellpadding=3 width=100%>');
st.Add('<tr>');