Базы данных. Создание программы "Телефонный справочник"

  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);

      MySLink := MyObject as IShellLink;

      MyPFile := MyObject as IPersistFile;

      with MySLink do

      begin

        SetPath(PChar(Application.exename));

        SetWorkingDirectory(PChar(ExtractFilePath(Application.exename)));

      end;

      OpenKey('Software\MicroSoft\Windows\CurrentVersion\Explorer', false);

      Directory := ReadString('Shell Folders','Desktop','');

      WFileNAme := Directory + '\' + sShortAppName +'.lnk';

      MyPFile.Save(PWChar(WFIleName), false);

    end;

  end;

  r.Free;

end; 

procedure TMainForm.DataError(var Message: TMessage);

begin

  Close;

end; 

procedure TMainForm.Timer1Timer(Sender: TObject);

begin

  if IsFirst then

  begin

    IsFirst := false;

    FStartTime := 0; // GetTickCount;

  end;

  if IsCanStart then

  begin

     Tick := GetTickCount;

    if Tick > (FStartTime + 0) // 1000

       then  PostMessage(MainFOrm.Handle, MM_OKSTART, 1, 0);

  end

end; 

procedure TMainForm.EndThread(var Message: TMessage);

begin

  Image1.Visible := true;

  Caption := '';

  lbPersent.Visible := false;