1. Терлецкая А.М. – лекции.
2. Т.Карпова – Базы данных: модели, разработка, реализация. Уч. пособие – СПб: Питер,2001.
Приложение А Листинг программы
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, DBGrids, DB, ADODB, ExtCtrls, ComCtrls, DBCtrls, Menus,
StdCtrls, Inifiles;
type
TForm1 = class(TForm)
ADOConnection1: TADOConnection;
ADOTable1: TADOTable;
DataSource1: TDataSource;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
Players: TDBGrid;
DBNavigator1: TDBNavigator;
ADOTable2: TADOTable;
ADOTable3: TADOTable;
DataSource2: TDataSource;
DataSource3: TDataSource;
Events: TDBGrid;
Clans: TDBGrid;
MyQuery1: TADOQuery;
DataSource4: TDataSource;
TabSheet4: TTabSheet;
ListBox1: TListBox;
DBGrid1: TDBGrid;
StatusBar1: TStatusBar;
Button1: TButton;
PopupMenu1: TPopupMenu;
NewQuery1: TMenuItem;
Deletequery1: TMenuItem;
EditQuery1: TMenuItem;
Label1: TLabel;
Edit1: TEdit;
Button2: TButton;
Label2: TLabel;
RichEdit1: TRichEdit;
CheckBox1: TCheckBox;
MyQuery2: TADOQuery;
DataSource5: TDataSource;
ADOTable1Nickname: TStringField;
ADOTable1Clan: TStringField;
ADOTable1GameRace: TStringField;
ADOTable1FullName: TStringField;
ADOTable1Age: TBCDField;
ADOTable1Country: TStringField;
ADOTable2Name: TStringField;
ADOTable2FullName: TStringField;
ADOTable2Owner: TStringField;
ADOTable2Players: TBCDField;
ADOTable2Sponsor: TStringField;
ADOTable2FoundationDate: TBCDField;
ADOTable3Name: TStringField;
ADOTable3Sponsor: TStringField;
ADOTable3Prize: TBCDField;
ADOTable3Clanwinner: TStringField;
ADOTable3Playerwinner: TStringField;
ADOTable3Date: TDateTimeField;
PopupMenu2: TPopupMenu;
Report1: TMenuItem;
Button3: TButton;
Button4: TButton;
Procedure NewEditDelete(i:integer);
procedure NewQuery(Name:string; Query : Trichedit;Dodelete:integer);
procedure PageControl1Change(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure NewQuery1Click(Sender: TObject);
procedure Deletequery1Click(Sender: TObject);
procedure EditQuery1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button2Click(Sender: TObject);
procedure ListBox1DblClick(Sender: TObject);
procedure RichEdit1Change(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
Procedure Normalize(Grid:TDBGrid; Source:TDatasource);
procedure Report1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
Name : string;
end;
var
Form1: TForm1;
ini :Tinifile;
implementation
uses Unit2;
{$R *.dfm}
Procedure TForm1.Normalize(Grid:TDBGrid; Source:TDatasource);
var
x:integer;
i:integer;
Begin
// ----------- Normalizing Column Width of DBGrid -----------
For x:=0 to grid.Columns.Count-1 do begin
i:=0;
source.DataSet.First;
repeat
if length(source.DataSet.Fields[x].Text)>i then i:=length(source.DataSet.Fields[x].Text);
source.DataSet.next;
until source.DataSet.Eof;
grid.Columns.Items[x].Width:= i+25;
end;
source.DataSet.First;
end;
Procedure TForm1.NewQuery(Name:string; Query :Trichedit; Dodelete : integer);
// DoDelete = 0 - Add or Edit
// DoDelete = 1 - Delete Query
Var
F : TextFile;
i : Integer;
x : Integer;
begin
AssignFile(F,Extractfilepath(Application.ExeName)+'QueryList.lst');
Rewrite(F);
case DoDelete of
0 : Begin
ini.WriteString(Name,'0',inttostr(richedit1.Lines.Count));
For i:=0 to query.Lines.Count-1 do begin
ini.WriteString(Name,inttostr(i+1),Query.Lines.Strings[i]);
end;
end;
1 : ini.EraseSection(Name);
end;
For x:=0 to Listbox1.Items.Count-1 do begin
Writeln(F,Listbox1.items.strings[x]);
end;
CloseFile(F);
end;
Procedure TForm1.NewEditDelete(i:integer);
// I = 1 - Add Query
// I = 2 - Edit Query
// I = 3 - Delete Query
var
Del:string;
x:integer;
Label 1;
begin
case i of
1 : begin
Listbox1.Items.Add(edit1.Text);
NewQuery(Edit1.Text,richedit1,0);
end;
2 : Begin
For x:=0 to listbox1.Items.Count-1 do begin
If Listbox1.Selected[x] then Listbox1.Items.Strings[x]:=Edit1.Text;
end;
NewQuery(Edit1.Text,richedit1,0);
end;
3 : Begin
For x:=0 to listbox1.Items.Count-1 do begin
If Listbox1.Selected[x] then begin
Del := Listbox1.items.Strings[x];
Listbox1.DeleteSelected;
Goto 1;
end;
end;
1: NewQuery(Del,richedit1,1);
end;
end;
end;
procedure TForm1.PageControl1Change(Sender: TObject);
begin
If Pagecontrol1.ActivePage=TabSheet1 then DBNavigator1.DataSource:=DataSource1;
If Pagecontrol1.ActivePage=TabSheet2 then DBNavigator1.DataSource:=DataSource2;
If Pagecontrol1.ActivePage=TabSheet3 then DBNavigator1.DataSource:=DataSource3;
If Pagecontrol1.ActivePage=TabSheet4 then DBNavigator1.DataSource:=DataSource4;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
F2:TextFile;
i,x:integer;
s:string;
begin
AdoTable1.Active:=true;
AdoTable2.Active:=true;
AdoTable3.Active:=true;
// ----------- Normalizing Column Width of DBGrid -----------
Normalize(players,datasource1);
Normalize(clans,datasource2);
Normalize(events,datasource3);
ini := TiniFile.Create(extractfilepath(application.ExeName)+'Queryes.ini');
AssignFile(F2,Extractfilepath(Application.ExeName)+'QueryList.lst');
reset(F2);
Repeat
Readln(F2,s);
Listbox1.Items.Add(s);
until EOF(F2);
closefile(F2);
If Pagecontrol1.ActivePage=TabSheet1 then DBNavigator1.DataSource:=DataSource1;
If Pagecontrol1.ActivePage=TabSheet2 then DBNavigator1.DataSource:=DataSource2;
If Pagecontrol1.ActivePage=TabSheet3 then DBNavigator1.DataSource:=DataSource3;
If Pagecontrol1.ActivePage=TabSheet4 then DBNavigator1.DataSource:=DataSource4;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
x :integer;
begin
statusbar1.SimpleText:='Adding new Query...';
Edit1.Text:='';
Richedit1.Text:='';
Button2.Caption:='Add';
for x:=125 to form1.Width+120 do begin
DBGrid1.Left:=DbGrid1.Left+1;
Application.ProcessMessages;
end;
end;
procedure TForm1.NewQuery1Click(Sender: TObject);
begin
Button1.Click;
end;
procedure TForm1.Deletequery1Click(Sender: TObject);
begin
NewEditDelete(3);
statusbar1.SimpleText:='Deleted...';
end;
procedure TForm1.EditQuery1Click(Sender: TObject);
var
x,i :integer;
begin
richedit1.Clear;
Button2.Caption:='Edit';
For x:=0 to listbox1.Items.Count-1 do begin
If listbox1.Selected[x] then begin
Edit1.Text:=Listbox1.Items.Strings[x];
statusbar1.SimpleText:='Modifying '+edit1.Text+' Query...';
For i:=0 to strtoint(ini.ReadString(Listbox1.Items.Strings[x],'0',''))-1 do
begin
richedit1.Lines.add(ini.ReadString(Listbox1.Items.Strings[x],inttostr(i+1),''));
end;
end;
end;
for x:=125 to form1.Width+120 do begin
DBGrid1.Left:=DbGrid1.Left+1;
Application.ProcessMessages;
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Ini.Free;
end;
procedure TForm1.Button2Click(Sender: TObject);
Var
x:integer;
begin
If Button2.Caption='Add' then
begin
for x:=0 to listbox1.Items.Count-1 do begin
if edit1.Text=listbox1.Items.Strings[x] then begin
messagedlg('Ïðîèçîøëà îøèáêà, íåâåðíî íàçâàíèå çàïðîñà',mtwarning,[mbok],0);
StatusBar1.SimpleText:='Error adding new Query...';
exit;
end;
end;
NewEditDelete(1);
StatusBar1.SimpleText:='Query '+Edit1.Text+' has been succesfully created...'
end;
If Button2.Caption='Edit' then begin
NewEditDelete(2);
statusbar1.SimpleText:='Query '+edit1.Text+' has been succesfully modifyed...'
end;
for x:=form1.Width+120 downto 125 do begin
DBGrid1.Left:=DbGrid1.Left-1;
Application.ProcessMessages;
end;
end;
procedure TForm1.ListBox1DblClick(Sender: TObject);
var
x,i:integer;
issecond : boolean;
begin
// ----- Organizing Query from selected in Listbox ----
MyQuery1.Active:=false;
MyQuery2.Active:=false;
MyQuery1.SQL.Clear;
MyQuery2.SQL.Clear;
issecond:=false;
For x:=0 to listbox1.Items.Count-1 do begin
If listbox1.Selected[x] then begin
Name:=Listbox1.Items.Strings[x];
For i:=0 to strtoint(ini.ReadString(Listbox1.Items.Strings[x],'0',''))-1 do
begin
if ini.ReadString(Listbox1.items.strings[x],inttostr(i+1),'') = 'Query2' then issecond:=true;
if not ((ini.ReadString(Listbox1.items.strings[x],inttostr(i+1),'') = 'Query2') or (issecond)) then MyQuery1.SQL.Add(ini.ReadString(Listbox1.Items.Strings[x],inttostr(i+1),''));
if not ((ini.ReadString(Listbox1.items.strings[x],inttostr(i+1),'') = 'Query2') or (issecond=false)) then MyQuery2.SQL.Add(ini.ReadString(Listbox1.Items.Strings[x],inttostr(i+1),''));
end;
end;
end;
MyQuery1.Active:=true;
If not (MyQuery2.SQL.text='') then begin
MyQuery2.Active:=true;
DBGrid1.DataSource:=Datasource5;
Normalize(DbGrid1,datasource5);
end
else Normalize(DbGrid1,datasource4);
StatusBar1.SimpleText:='Completed...';
Button4.Enabled:=true;
report1.enabled:=true;
end;
procedure TForm1.RichEdit1Change(Sender: TObject);
var
s,d:string;
x:integer;
Kur:TPoint;
begin
richedit1.SelAttributes.Color:=clblack;
//------------ Making Graphic Design -------------
kur:=Richedit1.CaretPos;
d:=Richedit1.Text;
d:=Lowercase(d);
For x:=1 to length(d) do begin
If (d[x]=' ') or (d[x]='(')or (d[x]=#10) or (ord(d[x])=13) then begin
If (s='from') or (s='where') or (s='group')
or (s='by') or (s='having') or (s='order')
or (s='select') or (s='as') or (s='like')
or (s='update') or (s='set') or (s='sum')
or (s='avg') or (s='max') or (s='min')
or (s='count') then
begin
richedit1.SelStart:=x-length(s)-1;
richedit1.SelLength:=length(s);
richedit1.SelAttributes.Color:=clNavy;
end;
s:='';
end else s:=s+d[x];
end;
Richedit1.CaretPos:=kur;
richedit1.SelAttributes.Color:=clblack
//------------------------------------------------
end;
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
If checkbox1.Checked then begin
Adotable1.Active:=false;
Adotable1.IndexFieldNames:='clan';
Adotable1.MasterFields:='Name';
Adotable1.Active:=true;
end
else begin
Adotable1.Active:=false;
Adotable1.IndexFieldNames:='';
Adotable1.MasterFields:='';
Adotable1.Active:=true;
end;
end;
procedure TForm1.Report1Click(Sender: TObject);
begin
Form2.Show;
end;
procedure TForm1.Button3Click(Sender: TObject);
var
s:string;
begin
if inputquery(‘Введите пароль','пароль',s) then
if s='asd' then begin
deletequery1.Enabled:=true;
editquery1.Enabled:=true;
end;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
form2.show;
end;
end.
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, QuickRpt, ExtCtrls, QRCtrls, StdCtrls;
type
TForm2 = class(TForm)
QuickRep1: TQuickRep;
ColumnHeaderBand1: TQRBand;
PageFooterBand1: TQRBand;
PageHeaderBand1: TQRBand;
DetailBand1: TQRBand;
TitleBand1: TQRBand;
Button1: TButton;
SummaryBand2: TQRBand;
Title: TQRLabel;
Button2: TButton;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
LabelMassive : array[0..100] of TQRLabel;
TextMassive : array[0..100] of TQRDBText;
implementation
uses Unit1;
{$R *.dfm}
procedure TForm2.Button1Click(Sender: TObject);
begin
quickrep1.preview;
end;
procedure TForm2.Button2Click(Sender: TObject);
var
x,y,i:integer;
begin
Title.Caption:=Form1.Name;
// Buildind Report
Form1.MyQuery1.First;
for x:=0 to Form1.DBGrid1.Columns.Count-1 do begin
LabelMassive[x]:=TQRLabel.Create(form2);
LabelMassive[x].Parent:=Columnheaderband1;
LabelMassive[x].Font.Style:=[fsbold];
LabelMassive[x].Caption:=Form1.DBGrid1.Columns[x].FieldName;
LabelMassive[x].Top:=trunc(columnheaderband1.Height/2);
labelmassive[x].AutoSize:=false;
labelmassive[x].Width:=Form1.DBGrid1.Columns[x].Width;
// labelmassive[x].Frame.DrawRight:=true;
if x>0 then LabelMassive[x].Left:=trunc(quickrep1.Width/(Form1.DBGrid1.Columns.Count+1))+LabelMassive[x-1].Left+labelmassive[x-1].width-LabelMassive[x].Width
else LabelMassive[x].Left:=trunc(quickrep1.Width/(Form1.DBGrid1.Columns.Count+1))-LabelMassive[x].Width;
LabelMassive[x].Show;
end;
for x:=0 to Form1.DBGrid1.Columns.Count-1 do begin
TextMassive[x]:=TQRDBtext.Create(form2);
TextMassive[x].Parent:=Detailband1;
TextMassive[x].DataSet:=Form1.MyQuery1;
TextMassive[x].DataField:=Form1.DBGrid1.Columns[x].FieldName;
TextMassive[x].Top:=trunc(detailband1.Height/2);
Textmassive[x].AutoSize:=false;
Textmassive[x].Width:=Form1.DBGrid1.Columns[x].Width;
// textmassive[x].Frame.DrawRight:=true;
if x>0 then textMassive[x].Left:=trunc(quickrep1.Width/(Form1.DBGrid1.Columns.Count+1))+textMassive[x-1].Left+textmassive[x-1].width-textMassive[x].Width
else textMassive[x].Left:=trunc(quickrep1.Width/(Form1.DBGrid1.Columns.Count+1))-textMassive[x].Width;
textMassive[x].Show;
end;
end;
procedure TForm2.Button3Click(Sender: TObject);
var
x:integer;
begin
for x:=0 to Form1.DBGrid1.Columns.Count-1 do begin
labelmassive[x].Free;
textmassive[x].Free;
end;
form2.hide;
end;
0 комментариев