--PAGE_BREAK--
procedure N13Click(Sender: TObject);
procedure N14Click(Sender: TObject);
procedure N15Click(Sender: TObject);
procedure N16Click(Sender: TObject);
procedure ExitButtonClick(Sender: TObject);
procedure SearchButtonClick(Sender: TObject);
procedure HelpButtonClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
procedure CreatePopupFields;
procedure UpdateStatusBar;
procedure CalculateEditSize;
procedure SortMode (Sender: tObject);
procedure ReadIni;
procedure WriteIni; // Ini-file
public
end;
var
PhoneForm: TPhoneForm;
Inputs: array [0..4] of TEdit;
MyThread: DataThread;
bool: boolean;
ColumnIndex: integer;
const
SortName: array[0..2] of string =('поТелефону','поИмени','поУлице');
IndexName: array [0..2] of string =('ByNumTel','ByFamil','ByStreet');
COPY_TO_CLIPBOARD = 'Копировать';
PASTE_FROM_CLIPBOARD = 'Вставить';
function IndexOfItem(Item: string): integer;
implementation
uses IniFiles, DBITypes, DBIProcs, Graphics,ShellApi;
{$R *.dfm}
procedure TPhoneForm.FormCreate(Sender: TObject);
begin
Table1.TableName := sDataFile;
Table1.Open;
CreatePopupFields;
CalculateEditSize;
UpDateStatusBar;
ReadIni;
Application.onMessage := Aom;
Application.HelpFile := sHelpFile;
end;
procedure TPhoneForm.MyPopupHandler(Sender: TObject);
begin
if Sender is TMenuItem then with (Sender as TMenuItem) do
begin
case tag of
0..2: begin Table1.IndexName := IndexName[(Sender as TMenuItem).tag ];
SortMode(Sender);
end;
4: Clipboard.AsText := DBGrid1.SelectedField.DisplayText;
end;
UpdateStatusBar;
end;
end;
procedure TPhoneForm.CreatePopupFields;
var
i: integer;
MyPopupMenuItem: array [0..4] of TMenuItem;
MenuItem: TMenuItem;
begin
for i := 0 to 4 do
begin
Inputs[i] := TEdit.Create(self);
Inputs[i].Parent := GroupBox1;
Inputs[i].PopupMenu := PopupMenu2;
Inputs[i].OnContextPopup := MyEditPopup;
Inputs[i].Tag := i;
end;
for i := 0 to 4 do with PopupMenu1 do
begin
MyPopupMenuItem[i] := TMenuItem.Create(self);
if i
MyPopupMenuItem[i].Tag := i;
MyPopupMenuItem[i].OnClick := MyPopupHandler;
PopupMenu1.Items.add(MyPopupMenuItem[i]);
end;
MyPopupMenuItem[3].Caption := '-';
MyPopupMenuItem[4].Caption := COPY_TO_CLIPBOARD;
MyPopupMenuItem[4].ShortCut := ShortCut(Word('C'), [ssCtrl]);
PopupMenu1.Items[0].Checked := true;
MenuItem := TMenuItem.Create(self);
MenuItem.Caption := PASTE_FROM_CLIPBOARD;
MenuItem.OnClick := MyPopupHandler2;
PopupMenu2.Items.add(MenuItem);
MyEditPopup(nil, Point(0,0), bool);
end;
procedure TPhoneForm.CalculateEditSize;
var
i: integer;
OffSet: integer;
begin
offset :=13;
for i := 0 to 4 do
begin
Inputs[i].Left := Offset;
Offset := Offset + DbGrid1.Columns[i].width + 8;
Inputs[i].Width := DBGrid1.Columns[i].width;
Inputs[i].Top := 24;
Inputs[i].MaxLength :=Table1.Fields[i].Size;
end;
end;
procedure TPhoneForm.UpdateStatusBar;
var SortMode: string;
begin
statusBar1.Panels[0].Text := ' Найденоабонентов: '+ InttoStr(Table1.RecordCount);
Sortmode := SortName[0];
if PopupMenu1.Items[1].Checked then sortMode := SortName[1];
if PopupMenu1.Items[2].Checked then sortMode := SortName[2];
statusbar1.Panels[1].Text := ' Отсортировано: '+SortMode;
end;
procedure tPhoneForm.AOM(var Msg: tagMSG; var Handled: Boolean);
var key: word;
begin
handled := false;
if msg.message = Wm_keydown then
begin
key := msg.wParam;
handled := true;
case key of
vk_up: SendMessage(DBGrid1.Handle,wm_keydown, vk_up, 0);
vk_Down: SendMessage(DBGrid1.Handle,wm_keydown, vk_down, 0);
vk_Prior: SendMessage(DBGrid1.Handle,wm_keydown, vk_Prior, 0);
vk_Next: SendMessage(DBGrid1.Handle,wm_keydown, vk_Next, 0);
vk_return: Search.OnClick(Search);
vk_f1: Application.HelpCommand(HELP_CONTENTS, 0);
else handled := false;
end;
end;
end;
procedure TPhoneForm.SearchClick(Sender: TObject);
var
filters: string;
i: integer;
begin
filters := '';
for i:= 0 to 4 do
begin
if Inputs[i].Text ''
then filters := filters + '('+Table1.Fields[i].FieldName + '='+ QuotedStr(Inputs[i].Text + '*')+ ') and';
end;
if filters '' then
Filters := copy(Filters, 0, Length(filters)-4);
table1.Filter := filters;
UpdateStatusBar;
end;
procedure TPhoneForm.SortMode (Sender: tObject);
var
i: integer;
begin
for i := 0 to 2 do
PopupMenu1.Items[i].Checked := false;
(sender as TMenuItem).Checked := true;
end;
procedure TPhoneForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
application.OnMessage := MainForm.progressAom;
WriteIni;
postMessage(MainForm.Handle, WM_CLOSE, 0, 0);
end;
procedure TPhoneForm.ReadIni;
begin
with TIniFile.Create(ExtractFilePath(Application.exename)+sIniFile) do
begin
table1.IndexName := IndexName[ReadInteger('Defaults','SortIndex', 0)];
Left := ReadInteger('Position','left', 100);
top := ReadInteger('Position','top', 100);
Height := ReadInteger('Position','height', 50);
end;
end;
function IndexOfItem(Item: string): integer;
begin
if Item = SortName[1] then result := 1
else if Item = SortName[2] then result := 2
else result := 0;
end;
procedure TPhoneForm.WriteIni;
begin
with TIniFile.Create(ExtractFilePath(Application.exename)+sIniFile) do
begin
WriteInteger('Defaults','SortIndex', IndexOfItem(Table1.indexName));
WriteInteger('Position','left', PhoneForm.left);
WriteInteger('Position','top', PhoneForm.top);
WriteInteger('Position','height', PhoneForm.height);
end;
end;
procedure TPhoneForm.MInMaxSize(var Message: TMessage);
begin
with TwmGetMinMaxInfo(Message) do
begin
MinMaxInfo.ptMaxTrackSize.X := PhoneForm.Width;
MinMaxInfo.ptMaxTrackSize.y := Screen.Height- 100;
MinMaxInfo.ptMinTrackSize.X := PhoneForm.Width;
MinMaxInfo.ptMinTrackSize.y := 200;
end;
end;
procedure TPhoneForm.MyPopupHandler2(Sender: TObject);
begin
if Sender is TMenuItem then
if Clipboard.HasFormat(CF_TEXT) then
Inputs[PopupMenu2.Tag].Text := Clipboard.AsText;
end;
procedure TPhoneForm.MyEditPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean);
begin
PopupMenu2.Items[0].Enabled := Clipboard.HasFormat(CF_TEXT);
if Sender is TEdit then PopupMenu2.Tag := (Sender as TEdit).Tag
end;
procedure TPhoneForm.N20Click(Sender: TObject);
begin
Application.HelpCommand(HELP_WM_HELP ,0);
end;
procedure TPhoneForm.N13Click(Sender: TObject);
begin
Table1.First;
end;
procedure TPhoneForm.N14Click(Sender: TObject);
begin
Table1.Prior;
end;
procedure TPhoneForm.N15Click(Sender: TObject);
begin
Table1.Next;
end;
procedure TPhoneForm.N16Click(Sender: TObject);
begin
Table1.Last;
end;
procedure TPhoneForm.ExitButtonClick(Sender: TObject);
begin
Table1.Close;
PhoneForm.Close;
end;
procedure TPhoneForm.SearchButtonClick(Sender: TObject);
begin
Search.OnClick(Sender);
end;
procedure TPhoneForm.HelpButtonClick(Sender: TObject);
begin
PostMessage(PhoneForm.handle, WM_KEYDOWN, vk_f1, 0);
end;
procedure TPhoneForm.FormDestroy(Sender: TObject);
begin
Application.HelpCommand(HELP_QUIT,0);
end;
end.
Приложение2
unit Progress;
interface
uses
Windows, SysUtils, Classes, Forms, Dialogs, StdCtrls,
DB, DBTables, Controls, ComCtrls, Registry,ShellApi, Messages, Graphics,
ExtCtrls ;
const
MM_BASE = WM_USER;
MM_OKSTART = MM_BASE + $1;
MM_DATAERROR = MM_BASE + $2;
MM_KeyDown = MM_BASE + $3;
MM_ENDTHREAD = MM_BASE + $4;
type
TMainForm = class(TForm)
ProgressBar1: TProgressBar;
lbPersent: TLabel;
Table2: TTable;
Image1: TImage;
Table1: TTable;
Timer1: TTimer;
lbMessage: TLabel;
procedure FormCreate(Sender: TObject);
procedure ProgressAOM (var MSG: tagMSG; var Handled: boolean);
procedure RegApplication;
procedure DataError(var Message: TMessage); message MM_DATAERROR;
procedure Timer1Timer(Sender: TObject);
procedure EndThread(var Message:TMessage); message MM_ENDTHREAD;
private
IsCanStart: boolean;
FStartTime: cardinal;
function SearchFile(FileName: string): boolean;
public
{ Public declarations }
end;
type EPhoneException = class (Exception);
var
MainForm: TMainForm;
tick: cardinal;
IsFirst: boolean = true;
const
sDataFile = 'Data.dbf';
sIndexFile = 'Data.mdx';
sBuffFile = 'DataBuff.dbf';
sBuffFile2 = 'DataBuff2.dbf';
sShortappname = 'LutskPhone';
sIniFile = 'options.ini';
sHelpFile = 'help.hlp';
sDataFileError = 'Ошибка при работе с базой данных '
+#10#13+'Проверьте наличии файла базы!';
sBDEError = 'Ошибка работы с BDE';
implementation
uses TelDov, Thread, ActiveX, ComObj, ShlObj;
{$R *.dfm}
procedure TMainForm.FormCreate(Sender: TObject);
begin
try
IsCanStart := false;
// FStartTime := $FFFFFFFF;
// Application.HelpFile := sHelpFile;
Top := (Screen.Height — Height) div 2-200;
Left := (Screen.Width — Width) div 2;
Application.OnMessage := ProgressAOM ;
// RegApplication;
try
Table1.TableName := sBuffFile;// Check BDE
Table1.CreateTable;
Table1.Close;
// ShowMessage(DBIgetErrorString);
DeleteFile(ExtractFilePath(ParamStr(0))+'/'+sBuffFile);
except
raise EPhoneException.Create(sBDEError); // error BDE
end;
if not SearchFile(sDataFile)
then raise EPhoneException.Create(sDataFileError);
if not SearchFile(sIndexFile)
then DataThread.create(false)
else IsCanStart := true;
except
on E: Exception do
begin
MessageDlg(e.Message, mtError, [mbOk],0);
PostMessage(MainFOrm.Handle, MM_DATAERROR, 0, 0);
end;
end;
// FStartTime := GetTickCount;
Invalidate;
end;
procedure TMainForm.ProgressAOM (var MSG: tagMSG; var Handled: boolean);
begin
if MSG.message = MM_OKSTART then
begin
Timer1.Enabled := false;
Application.CreateForm(TPhoneForm, PhoneForm);
MainFOrm.Hide;
PhoneForm.Show;
Application.OnMessage := PhoneForm.AOM;
end;
end;
function TMainForm.SearchFile(FileName: string): boolean;
var
CurrFile: TSearchRec;
begin
if FindFirst(GetCurrentDir +'\'+FileName, faAnyFile, CurrFIle)=0
then Result := true
else Result := false;
end;
procedure TMainForm.RegApplication;
var
R: TRegIniFile;
IsRegister: boolean;
Directory: string;
MyObject: IUnknown;
MySLink: IShellLink;
MyPFile: IPersistFile;
WFileNAme: WideString;
begin
IsRegister := false;
R := TRegIniFile.Create('');
with R do
begin
RootKey := HKey_Current_User;
if Openkey('Software\RonyaSoft\'+ sShortappname, true)
then IsRegister := ReadBool('','Register',false);
if not(IsRegister)
then
begin
DeleteKey('','(Поумолчанию)');
WriteBool('','Register',true);
CloseKey;
MyObject := CreateComObject(CLSID_ShellLink); продолжение
--PAGE_BREAK--