3.5 Форма добавления разделов
Данная форма предназначена для редактирования разделов, т.е. дополнительной информации о книге. Информация о разделах сохраняется в отдельной базе - Raz.DB, Находящейся в папке с программой.
Рисунок 3.6 - Форма редактирования разделов
3.6 Форма просмотра базы данных
Форма предназначена для просмотра и редактирования базы данных (Рис. 3.8). На форме также использована система отображения подсказок и функция отображения Фомы «поверх всех окон», возможна сортировка информации и последовательный поиск записи. Также возможен запуск файла при двойном клике по записи файла или нажатии соответствующей кнопки. Для удобства в использовании максимальная высота и минимальная ширина формы ограничены (Рис. 3.7).
Рисунок 3.7 - Форма с измененными размерами
Рисунок 3.8 - Фома просмотра базы
3.7 Дополнительный модуль
Дабы не изобретать велосипед и не тратить всем драгоценное время, модуль был взят из примеров, поставляемых вмести с DELPHI. Данный модуль используется главной форой для копирования и перемещения файлов.
ЗАКЛЮЧЕНИЕ
В ходе данной работы были изучены основные цели и требования, предъявляемые к разработчикам баз данных:
1.Возможности поиска. Пользователь базы данных может обращаться к ней с различными вопросами по поводу хранимых данных. Возросшие требования к системам заключаются в обеспечении обработки таких запросов или формирования таких ответов, которые заранее не запланированы.
2.Безопасность и секретность. Изучены некоторые методы ограничения доступа к базам данных.
3.Простота использования. Интерфейс программного обеспечения максимально ориентирован на конечного пользователя и учитывает возможность того, что пользователь не имеет необходимой базы знаний.
Были проведены соответствующие исследования в интерфейсах других приложений для организации наиболее эргономичного управления программой.
Т.к. приложение рассчитано на локального пользователя, то был выбран навигационный способ доступа к базам данных. Достоинство навигационного способа доступа к базе данных — простота кодирования операций с набором данных.
Особую роль для хранения информации на компьютере играет объектно-ориентированное программирование. Общую ее цель можно сформулировать так: доступ и обработка информации осуществляется без определенных знаний и опыта работы с компьютером.
СПИСОК ЛИТЕРАТУРЫ
Тейксейра. Delphi 5. Руководство разработчика, том 1. Основные методы и техники программирования / Тейксейра, Стив, Пачеко, Ксавье – Издательский дом «Вильямс», 2001.- 780с.
Тейксейра. Delphi 5. Руководство разработчика, том 2. Разработка компонентов и программирование баз данных / Тейксейра, Стив, Пачеко, Ксавье – Издательский дом «Вильямс», 2001.- 821с.
Гофман, В.Э. Delphi / В.Э. Гофман.- СПб.: БХВ – Петербург, 2001.-800с.
Фаронов, В. Delphi 6: учебный курс / В. Фаронов – СПб.: Питер, 2002.-512с.
ПРИЛОЖЕНИЯ
ПРОГРАММА ДЛЯ СОРТИРОВКИ ЭЛЕКТРОННЫХ ФАЙЛОВ
//Текст файла проекта
program Project1;
uses
Forms,
dialogs,
controls,
sysUtils,
Unit1 in 'Unit1.pas' {Form1},
Modulepas in 'Modulepas.pas',
InsRec in 'InsRec.pas' {InsertRec},
UZastavka in 'UZastavka.pas' {FZastavka},
URazdel in 'URazdel.pas' {Razdel},
UBase in 'UBase.pas' {FBase};
{$R *.RES}
var
pas:string;
listBase:TextFile;
begin
if inputQuery('Вход','Введите пароль',pas) then
if pas='zybr' then begin
Application.Initialize;
Application.CreateForm(TFZastavka, FZastavka);
fZastavka.Show;
fzastavka.Update;
while fzastavka.Timer1.enabled do
application.processMessages;
Fzastavka.free;
Application.CreateForm(TForm1, Form1);
Application.CreateForm(TInsertRec, InsertRec);
Application.CreateForm(TRazdel, Razdel);
Application.CreateForm(TFBase, FBase);
if not FileExists(extractFilePath(application.exeName)+'Base\ListBase.txt') then begin
assignFile(ListBase, extractFilePath(application.exeName)+'Base\ListBase.txt');
rewrite(ListBase);
end;
end else MessageDlg('Не тот пароль !'+#13+'Проверь пароль!!', mtError,[mbOk],0);
Application.Run;
end.
//Текст файла заставки
unit UZastavka;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls;
type
TFZastavka = class(TForm)
Timer1: TTimer;
Image1: TImage;
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
FZastavka: TFZastavka;
implementation
{$R *.DFM}
procedure TFZastavka.Timer1Timer(Sender: TObject);
begin
timer1.Enabled:=false;
end;
end.
//Текст файла основной формы
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Buttons, StdCtrls, Menus, FileCtrl, ComCtrls, ToolWin, AppEvnts, Grids,
Outline, DirOutln, shellApi, ExtCtrls, jpeg, ImgList;
type
TForm1 = class(TForm)
StatusBar1: TStatusBar;
ToolBar1: TToolBar;
ScrollBox1: TScrollBox;
TBSBCopy: TSpeedButton;
TBSBMove: TSpeedButton;
SpeedButton3: TSpeedButton;
DriveComboBox1: TDriveComboBox;
DirectoryListBox1: TDirectoryListBox;
Dir1: TFileListBox;
FilterComboBox1: TFilterComboBox;
SBDir12: TSpeedButton;
SBDir21: TSpeedButton;
SBDir13: TSpeedButton;
SBDir31: TSpeedButton;
Dir2: TFileListBox;
Dir3: TFileListBox;
LabDir2: TLabel;
LabDir3: TLabel;
ApplicationEvents1: TApplicationEvents;
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
PopupMenu1: TPopupMenu;
MnCopy: TMenuItem;
MNMove: TMenuItem;
N5: TMenuItem;
PmRef: TMenuItem;
ToolButton5: TToolButton;
TBSBDelete: TSpeedButton;
MnOpenBase: TMenuItem;
MnExit: TMenuItem;
HeaderControl1: THeaderControl;
BbIns2: TBitBtn;
BbIns3: TBitBtn;
N3: TMenuItem;
BbDir2: TBitBtn;
BitBtn1: TBitBtn;
MnShutDown: TMenuItem;
MnReBoot: TMenuItem;
N8: TMenuItem;
Label1: TLabel;
CBOnTop: TCheckBox;
ToolButton1: TToolButton;
procedure PmRefClick(Sender: TObject);
procedure ApplicationEvents1Idle(Sender: TObject; var Done: Boolean);
procedure FormCreate(Sender: TObject);
procedure ButDir2Click(Sender: TObject);
procedure ButDir3Click(Sender: TObject);
procedure Dir3Change(Sender: TObject);
procedure AllDirDbl(Sender: TObject);
procedure MnCopyClick(Sender: TObject);
procedure MNMoveClick(Sender: TObject);
procedure ConfChange(const ACaption, FromFile, ToFile: string);
procedure SBDir12Click(Sender: TObject);
procedure SBDir21Click(Sender: TObject);
procedure SBDir13Click(Sender: TObject);
procedure SBDir31Click(Sender: TObject);
procedure Dir1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
procedure Dir2DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
procedure Dir3DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
procedure Dir2DragDrop(Sender, Source: TObject; X, Y: Integer);
procedure Dir3DragDrop(Sender, Source: TObject; X, Y: Integer);
procedure Dir1DragDrop(Sender, Source: TObject; X, Y: Integer);
procedure TBSBDeleteClick(Sender: TObject);
procedure MnExitClick(Sender: TObject);
procedure MnOpenBaseClick(Sender: TObject);
procedure BbIns2Click(Sender: TObject);
procedure BbIns3Click(Sender: TObject);
procedure BbDir2Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure Dir2Change(Sender: TObject);
procedure MnShutDownClick(Sender: TObject);
procedure MnReBootClick(Sender: TObject);
procedure N8Click(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure Dir1Enter(Sender: TObject);
procedure Dir2Enter(Sender: TObject);
procedure CBOnTopClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
aders:string;
implementation
uses modulepas, Insrec, UBase, URazdel;
{$R *.DFM}
procedure TForm1.PmRefClick(Sender: TObject);
begin
statusbar1.Panels[2].Text:=IntToStr(diskSize(3) div 1024000)+' Mb';
statusbar1.Panels[4].Text:=IntToStr(diskSize(4) div 1024000)+' Mb';
dir1.Update;
dir2.Update;
dir3.Update;
end;
procedure TForm1.ApplicationEvents1Idle(Sender: TObject;
var Done: Boolean);
begin
form1.Caption:=TimeTostr(time);
application.Title:=TimeToStr(Time);
statusBar1.Panels[5].Text:=application.Hint;
fbase.statusBar1.Panels[0].Text:=statusBar1.Panels[5].Text;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
statusbar1.Panels[2].Text:=IntToStr(diskSize(3) div 1024000)+' Mb';
statusbar1.Panels[4].Text:=IntToStr(diskSize(4) div 1024000)+' Mb';
MnCopy.Checked:=true;
TBsbCopy.Down:=true;
Form1.KeyPreview := True;
end;
procedure TForm1.Dir3Change(Sender: TObject);
begin
LabDir3.Caption:=dir3.Directory;
end;
procedure TForm1.Dir2Change(Sender: TObject);
begin
LabDir2.Caption:=dir2.Directory;
end;
procedure TForm1.AllDirDbl(Sender: TObject);
begin
ShellExecute(form1.Handle, nil, PChar((sender as tFileListBox).FileName), nil, nil, sw_ShowNormal);
end;
{////////////////////////////////////////////////////////////////////////////////////////}
procedure TForm1.MnCopyClick(Sender: TObject);
begin
if MnCopy.Checked then begin
MnCopy.Checked:=false;
TBSBCopy.Down:=false;
MnMove.Checked:=True;
TBsbMove.Down:=True;
end else begin
MnCopy.Checked:=true;
TBSBCopy.Down:=true;
MnMove.Checked:=False;
TBsbMove.Down:=False;
end;
end;
procedure TForm1.MNMoveClick(Sender: TObject);
begin
if MnMove.Checked then begin
MnMove.Checked:=false;
TBsbMove.Down:=false;
MnCopy.Checked:=True;
TBsbCopy.Down:=True;
end else begin
MnMove.Checked:=true;
TBsbMove.Down:=True;
MnCopy.Checked:=False;
TBsbCopy.Down:=false;
end;
end;
{////////////////////////////////////////////////////////////////////////////////////////}
procedure TForm1.ConfChange(const ACaption, FromFile, ToFile: string);
begin
if MessageDlg(Format('%s %s '+#13+'В %s?', ['Копировать', FromFile,ToFile]),
mtConfirmation,[mbYes, mbNo],0) = mrYes then begin
if ACaption = 'Copy' then CopyFile(FromFile, ToFile) else
if ACaption = 'Move' then MoveFile(FromFile, ToFile);
Dir1.Update;
Dir2.Update;
Dir3.Update;
end;
end;
{//////////////////////////////////////////////////////}
procedure TForm1.SBDir12Click(Sender: TObject);
var
CurrentDir,FromFileName,ToFileName,s:string;
begin
if TBsbCopy.Down then s:='Copy' else
if TBsbMove.Down then s:='Move' else Exit;
FromFileName:=dir1.FileName;
ToFileName:=dir2.Directory;
ConfChange(s, FromFileName, ToFileName);
end;
procedure TForm1.SBDir21Click(Sender: TObject);
var
CurrentDir,FromFileName,ToFileName,s:string;
begin
if TBsbCopy.Down then s:='Copy' else
if TBsbMove.Down then s:='Move' else Exit;
FromFileName:=dir2.FileName;
ToFileName:=Dir1.Directory;
ConfChange(s, FromFileName, ToFileName);
end;
{///////////////////////////////////////////////////}
procedure TForm1.SBDir13Click(Sender: TObject);
var
CurrentDir,FromFileName,ToFileName,s:string;
begin
if TBsbCopy.Down then s:='Copy' else
if TBsbMove.Down then s:='Move' else Exit;
FromFileName:=dir1.FileName;
ToFileName:=dir3.Directory;
ConfChange(s, FromFileName, ToFileName);
end;
procedure TForm1.SBDir31Click(Sender: TObject);
var
CurrentDir,FromFileName,ToFileName,s:string;
begin
if TBsbCopy.Down then s:='Copy' else
if TBsbMove.Down then s:='Move' else Exit;
FromFileName:=dir3.FileName;
ToFileName:=Dir1.Directory;
ConfChange(s, FromFileName, ToFileName);
end;
{////////////////////////////////////////////////////}
procedure TForm1.Dir1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
if (source=Dir2) or(source=dir3) then accept:=true else accept:=false;
end;
procedure TForm1.Dir2DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
if source=Dir1 then accept:=true else accept:=false;
end;
procedure TForm1.Dir3DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
if source=Dir1 then accept:=true else accept:=false;
end;
procedure TForm1.Dir2DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
SBDir12.Click;
end;
procedure TForm1.Dir3DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
SBDir13.Click;
end;
procedure TForm1.Dir1DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
if source=dir2 then SBDir21.Click else SBDir31.Click;
end;
{////////////////////////////////////////////////////////////////////////////////////////}
procedure TForm1.TBSBDeleteClick(Sender: TObject);
begin
if dir1.Focused then
with dir1 do
if MessageDlg('Delete ' + FileName + '?', mtConfirmation,
[mbYes, mbNo], 0) = mrYes then
if DeleteFile(FileName) then begin
Update;
dir2.Update;
dir3.Update;
end;
if dir2.Focused then
with dir2 do
if MessageDlg('Delete ' + FileName + '?', mtConfirmation,
[mbYes, mbNo], 0) = mrYes then
if DeleteFile(FileName) then begin
Update;
dir1.Update;
dir3.Update;
end;
if dir3.Focused then
with dir3 do
if MessageDlg('Delete ' + FileName + '?', mtConfirmation,
[mbYes, mbNo], 0) = mrYes then
if DeleteFile(FileName) then begin
update;
dir1.Update;
dir2.Update;
end;
end;
procedure TForm1.MnExitClick(Sender: TObject);
begin
Close;
end;
procedure TForm1.MnOpenBaseClick(Sender: TObject);
begin
FBase.showmodal;
end;
procedure TForm1.BbIns2Click(Sender: TObject);
begin
insertRec.Table1.Active:=true;
insertRec.Table2.Active:=true;
if insertrec.Table1.RecordCount<>0 then insertrec.table1.Last
else insertrec.Table1.First;
insertrec.Table1.Insert;
insertRec.Table1.FieldByName('Адрес').asString:=Dir2.FileName;
try
insertRec.ShowModal;
except
messagebeep(0);
showmessage('Обязательный ввод "Название" и "Раздел"');
end;
end;
procedure TForm1.BbIns3Click(Sender: TObject);
begin
insertRec.Table1.Active:=true;
insertRec.Table2.Active:=true;
if insertrec.Table1.RecordCount<>0 then insertrec.table1.Last
else insertrec.Table1.First;
insertrec.Table1.Insert;
insertRec.Table1.FieldByName('Адрес').asString:=Dir3.FileName;
insertRec.ShowModal;
end;
procedure TForm1.BbDir2Click(Sender: TObject);
var dir:string;
begin
if selectDirectory(dir,[sdAllowCreate, sdPerformCreate,sdPrompt],0) then Dir2.directory:=dir;
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
var dir:string;
begin
If selectDirectory(dir,[sdAllowCreate, sdPerformCreate,sdPrompt],0) then Dir3.directory:=dir;
end;
procedure TForm1.MnShutDownClick(Sender: TObject);
begin
win32Check(exitWindowsEx(ewx_ShutDown,0));
end;
procedure TForm1.MnReBootClick(Sender: TObject);
begin
win32Check(exitWindowsEx(ewx_ReBoot,0));
end;
procedure TForm1.N8Click(Sender: TObject);
begin
win32Check(exitWindows(0,0));
end;
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
if key = #27 then Close;
end;
procedure TForm1.Dir1Enter(Sender: TObject);
begin
{if (dir2.ItemIndex<>-1) then begin
dir2.Selected[dir2.ItemIndex]:=false;
dir1.Selected[dir1.ItemIndex]:=True;
end;}
end;
procedure TForm1.Dir2Enter(Sender: TObject);
begin
{if dir1.ItemIndex<>-1 then begin
dir1.Selected[dir1.ItemIndex]:=false;
dir2.Selected[dir2.ItemIndex]:=True;
end;}
end;
procedure TForm1.CBOnTopClick(Sender: TObject);
begin
if CBOnTop.Checked then form1.FormStyle:=fsStayOnTop
else form1.FormStyle:=fsNormal;
end;
end.
//Текст файла вставки записей
unit InsRec;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Db, DBTables, Mask, DBCtrls;
type
TInsertRec = class(TForm)
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Label6: TLabel;
DataSource1: TDataSource;
Table1: TTable;
DBEdit1: TDBEdit;
DBEdit2: TDBEdit;
DBEdit3: TDBEdit;
DBMemo1: TDBMemo;
DataSource2: TDataSource;
Table2: TTable;
DBLookupComboBox1: TDBLookupComboBox;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
InsertRec: TInsertRec;
implementation
uses Unit1,URazdel;
{$R *.DFM}
procedure TInsertRec.Button1Click(Sender: TObject);
Var Adres:String;
begin
if ((DBEdit1.Text<>'')and(DBLookupComboBox1.Text<>'')) then begin
try
table1.Active:=true;
table2.Active:=true;
table1.FieldByName('Название').asString:=DBedit1.Text;
table1.FieldByName('Автор').asString:=DBedit2.Text;
table1.FieldByName('Раздел').asString:=DBLookupComboBox1.Text;
table1.FieldByName('Описание').asString:=DBMemo1.Text;
table1.Post;
table1.Active:=false;
table2.Active:=false;
close;
except
beep;
ShowMessage('Возмлжно уже существует запись с такими полями.');
DBEdit1.Text:='';
DBEdit2.Text:='';
DBMemo1.Text:='';
end; end else begin
showmessage('Обязательный ввод "Название" и "Раздел"');
table1.cancel;
end;
end;
procedure TInsertRec.Button2Click(Sender: TObject);
begin
table1.cancel;
close;
end;
procedure TInsertRec.Button3Click(Sender: TObject);
begin
razdel.ShowModal;
end;
procedure TInsertRec.FormCreate(Sender: TObject);
begin
InsertRec.table1.dataBaseName:=extractFilePath(application.exeName)+'Base';
InsertRec.table2.dataBaseName:=extractFilePath(application.exeName)+'Base';
end;
end.
//Текст файла редактирования разделов
unit URazdel;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Grids, DBGrids, StdCtrls, Mask, DBCtrls, Db, DBTables;
type
TRazdel = class(TForm)
Table1: TTable;
DataSource1: TDataSource;
Button1: TButton;
Button2: TButton;
DBGrid1: TDBGrid;
Button3: TButton;
Edit1: TEdit;
procedure Button3Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Razdel: TRazdel;
implementation
{$R *.DFM}
procedure TRazdel.Button3Click(Sender: TObject);
begin
Close;
end;
procedure TRazdel.Button1Click(Sender: TObject);
begin
Razdel.table1.Active:=true;
Razdel.table1.Append;
Razdel.table1.FieldByName('Раздел').asString:=edit1.Text;
Razdel.table1.Refresh;
end;
procedure TRazdel.Button2Click(Sender: TObject);
begin
Razdel.table1.Delete;
end;
procedure TRazdel.FormActivate(Sender: TObject);
begin
if edit1.CanFocus then edit1.SetFocus;
end;
procedure TRazdel.FormCreate(Sender: TObject);
begin
Razdel.table1.dataBaseName:=extractFilePath(application.exeName)+'Base';
end;
end.
//Текст файла просмотра базы данных
unit UBase;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus, StdCtrls, ExtCtrls, DBCtrls, Grids, DBGrids, ComCtrls, Db,
DBTables, Buttons, shellApi, AppEvnts;
type
TFBase = class(TForm)
ScrollBox1: TScrollBox;
MainMenu1: TMainMenu;
MnFBTop: TMenuItem;
DBGrid1: TDBGrid;
DataSource1: TDataSource;
Table1: TTable;
DBMemo1: TDBMemo;
StatusBar1: TStatusBar;
ApplicationEvents1: TApplicationEvents;
ScrollBox2: TScrollBox;
RadioGroup1: TRadioGroup;
RadioGroup2: TRadioGroup;
GroupBox2: TGroupBox;
CheckBox1: TCheckBox;
Edit1: TEdit;
RadioGroup3: TRadioGroup;
DBNavigator5: TDBNavigator;
DBNavigator6: TDBNavigator;
BitBtn2: TBitBtn;
DBNavigator7: TDBNavigator;
DBNavigator8: TDBNavigator;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
Label10: TLabel;
Label11: TLabel;
OnTop1: TMenuItem;
procedure FormActivate(Sender: TObject);
procedure RadioGroup2Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure Edit1Change(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
procedure RadioGroup3Click(Sender: TObject);
procedure RadioGroup1Click(Sender: TObject);
procedure ApplicationEvents1Idle(Sender: TObject; var Done: Boolean);
procedure FormCreate(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure MnFBTopClick(Sender: TObject);
procedure OnTop1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
FBase: TFBase;
implementation
{$R *.DFM}
procedure TFBase.FormActivate(Sender: TObject);
begin
table1.Active:=true;
table1.Refresh;
DBGrid1.Columns[4].Visible:=false;
RadioGroup3.ItemIndex:=0;
end;
procedure TFBase.RadioGroup2Click(Sender: TObject);
begin
case radioGroup2.ItemIndex of
0: Table1.IndexDefs[table1.IndexDefs.IndexOf(table1.indexName)].Options:=
Table1.IndexDefs[table1.IndexDefs.IndexOf(table1.indexName)].Options+[ixDescending];
1: Table1.IndexDefs[table1.IndexDefs.IndexOf(table1.indexName)].Options:=
Table1.IndexDefs[table1.IndexDefs.IndexOf(table1.indexName)].Options-[ixDescending];
end;
end;
procedure TFBase.BitBtn1Click(Sender: TObject);
begin
ShellExecute(fBase.Handle, nil, PChar(table1.fieldbyname('Адрес').asString), nil, nil, sw_ShowNormal);
end;
procedure TFBase.Edit1Change(Sender: TObject);
var strField:string;
begin
if not checkbox1.Checked then exit;
case radiogroup3.ItemIndex of
0: strField:='Название';
1: strField:='Раздел';
2: strField:='Автор';
end;
table1.Locate(strField, edit1.text, [loCaseInsensitive, loPartialKey]);
end;
procedure TFBase.CheckBox1Click(Sender: TObject);
begin
Edit1Change(sender);
end;
procedure TFBase.RadioGroup3Click(Sender: TObject);
begin
Edit1Change(sender);
end;
procedure TFBase.RadioGroup1Click(Sender: TObject);
begin
case radioGroup1.ItemIndex of
0: table1.IndexName:='indNazv';
1: table1.IndexName:='indRaz';
else table1.IndexName:='';
end;
radiogroup2.OnClick(sender);
end;
procedure TFBase.ApplicationEvents1Idle(Sender: TObject;
var Done: Boolean);
begin
if radioGroup1.ItemIndex=-1 then radioGroup2.Enabled:=false else radioGroup2.Enabled:=True;
end;
procedure TFBase.FormCreate(Sender: TObject);
begin
FBase.KeyPreview := True;
Fbase.table1.dataBaseName:=extractFilePath(application.exeName)+'Base';
end;
procedure TFBase.FormKeyPress(Sender: TObject; var Key: Char);
begin
if key = #27 then Close;
end;
procedure TFBase.MnFBTopClick(Sender: TObject);
begin
MnFBTop.Checked:= not MnFBTop.Checked;
if MnFBTop.Checked then begin
fBase.FormStyle:=fsStayOnTop;
fBase.Caption:='Всегда наверху'end
else begin
fBase.FormStyle:=fsnormal;
fBase.Caption:='Base';
end;
end;
procedure TFBase.OnTop1Click(Sender: TObject);
begin
close;
end;
end.
//Текст файла дополнительного модуля
unit Modulepas;
interface
uses SysUtils, Windows, Classes, Consts;
type
EInvalidDest = class(EStreamError);
EFCantMove = class(EStreamError);
procedure CopyFile(const FileName, DestName: string);
procedure MoveFile(const FileName, DestName: string);
function GetFileSize(const FileName: string): LongInt;
function FileDateTime(const FileName: string): TDateTime;
function HasAttr(const FileName: string; Attr: Word): Boolean;
function ExecuteFile(const FileName, Params, DefaultDir: string;
ShowCmd: Integer): THandle;
implementation
uses Forms, ShellAPI;
const
SInvalidDest = 'Destination %s does not exist';
SFCantMove = 'Cannot move file %s';
procedure CopyFile(const FileName, DestName: string);
var
CopyBuffer: Pointer; { buffer for copying }
BytesCopied: Longint;
Source, Dest: Integer; { handles }
Len: Integer;
Destination: TFileName; { holder for expanded destination name }
const
ChunkSize: Longint = 8192; { copy in 8K chunks }
begin
Destination := ExpandFileName(DestName); { expand the destination path }
if HasAttr(Destination, faDirectory) then { if destination is a directory... }
begin
Len := Length(Destination);
if Destination[Len] = '\' then
Destination := Destination + ExtractFileName(FileName) { ...clone file name }
else
Destination := Destination + '\' + ExtractFileName(FileName); { ...clone file name }
end;
GetMem(CopyBuffer, ChunkSize); { allocate the buffer }
try
Source := FileOpen(FileName, fmShareDenyWrite); { open source file }
if Source < 0 then raise EFOpenError.CreateFmt(SFOpenError, [FileName]);
try
Dest := FileCreate(Destination); { create output file; overwrite existing }
if Dest < 0 then raise EFCreateError.CreateFmt(SFCreateError, [Destination]);
try
repeat
BytesCopied := FileRead(Source, CopyBuffer^, ChunkSize); { read chunk }
if BytesCopied > 0 then { if we read anything... }
FileWrite(Dest, CopyBuffer^, BytesCopied); { ...write chunk }
until BytesCopied < ChunkSize; { until we run out of chunks }
finally
FileClose(Dest); { close the destination file }
end;
finally
FileClose(Source); { close the source file }
end;
finally
FreeMem(CopyBuffer, ChunkSize); { free the buffer }
end;
end;
{ MoveFile procedure }
{ Moves the file passed in FileName to the directory specified in DestDir.
Tries to just rename the file. If that fails, try to copy the file and
delete the original.
Raises an exception if the source file is read-only, and therefore cannot
be deleted/moved.}
procedure MoveFile(const FileName, DestName: string);
var
Destination: string;
begin
Destination := ExpandFileName(DestName); { expand the destination path }
if not RenameFile(FileName, Destination) then { try just renaming }
begin
if HasAttr(FileName, faReadOnly) then { if it's read-only... }
raise EFCantMove.Create(Format(SFCantMove, [FileName])); { we wouldn't be able to delete it }
CopyFile(FileName, Destination); { copy it over to destination...}
DeleteFile(Pchar(FileName)); { ...and delete the original }
end;
end;
{ GetFileSize function }
{ Returns the size of the named file without opening the file. If the file
doesn't exist, returns -1.}
function GetFileSize(const FileName: string): LongInt;
var
SearchRec: TSearchRec;
begin
try
if FindFirst(ExpandFileName(FileName), faAnyFile, SearchRec) = 0 then
Result := SearchRec.Size
else Result := -1;
finally
SysUtils.FindClose(SearchRec);
end;
end;
function FileDateTime(const FileName: string): System.TDateTime;
begin
Result := FileDateToDateTime(FileAge(FileName));
end;
function HasAttr(const FileName: string; Attr: Word): Boolean;
var
FileAttr: Integer;
begin
FileAttr := FileGetAttr(FileName);
if FileAttr = -1 then FileAttr := 0;
Result := (FileAttr and Attr) = Attr;
end;
function ExecuteFile(const FileName, Params, DefaultDir: string;
ShowCmd: Integer): THandle;
var
zFileName, zParams, zDir: array[0..79] of Char;
begin
Result := ShellExecute(Application.MainForm.Handle, nil,
StrPCopy(zFileName, FileName), StrPCopy(zParams, Params),
StrPCopy(zDir, DefaultDir), ShowCmd);
end;
end.
Размещено на Allbest.ru