    27  

        

                
 Delphi    ,    . 
              
 Delphi.         .  , 
    ,     
  Delphi  Delphi Component Design.     
      .    . 
            
 .        
 . ,   ,      
 ,        . 
     ,  ""  Delphi  
  . ,   ,     
     ,  . 
           . 
      .  ,      
   . 
      TLiveQuery.  ,   ,  
  TQuery,    ,   . 
    Q   TDBNavSearch.   DBNavigator,   
 . 
    Q  TZoomDlg.  ,      
,    . 
              
"". ,  ,  TLiveQuery   
 ,       ,    
 . TDBNavSearch       TDBNavigator. 
TZoomDlg   ,      . 
        
 -     . 

         

        Delphi,    
 . 
    1.        New Component  Component   
,       Visual Component 
Library (VCL) Delphi. 

     27.     515 

    2.	  (  )     . 
    3.	  Register       
 Delphi. 
    4.	    . 
              
(Component Wizard) Delphi.   ,   
 Component^New Component.     
Component Wizard.  ,         
      . 

     
    ; ^nceslof type: JTTable 
    ; OassNamc    [ 
    BsWePage: I Dala Access 
     

              
,       .     
     . ,   
     Delphi 
    TStringGrid      DBGrid.  
,        ,    
   ,     .   
        . 
        ,   New 
Component   Component.      ,  
 Class Name      ,   Unit file 
name    ArrayTab. Pas,    Palette Page    
Data Access (. . 27.1).   ,    
Create Unit.    ,  "" 
    (.  27.1) 

    zl 
    : Unitffe name: JD ^Program Files'xBodanrADelpbi j\Lib\AnayTable pas       
  : ,;.J Search path:   j Files^BorlandVDelpbi 3Mmpotls,eVwotk \devguide\csd3\soutce 
    .. 
    Can! 
     

    . 27.1.      

     27.1.    ,   
 Delphi 

    unit ArrayTab; 
    interface 
    uses 
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
    Db, DBTables; type 
     = class (TTable) 
    private 
    { Private declarations } 
    protected 
    { Protected declarations } 
    public 
    { Public declarations } 
    published 
    {   Published  declarations   } 
    end; 
    procedure  Register; implementation procedure  Register; begin 
    RegisterComponents (' Data Access1,    []); end; end. 

        Register.      
  (        
),      Delphi,     
.         

516  IV.    

    Delphi,        
 Register.     ,     
       ,    
.         
 " ",  ,     
 . ,    Delphi 
      Lib. 
      TArrayTable        
Records.      ,   
          
     ,  . 
             
/  ,      
     ,    
         . 
   TArrayTable  . 

    TArrayTable  =  class(TTable) private 
    {            } 
    function  GetRecords(RecNum:   Longlnt):   TDataSet; protected 
    {               } public 
    {          } 
    property  Records[RecNum:   Longint]:   TDataSet   read  GetRecords; published 
    {          } end; 

     ,    ,    
,    , .  
,     GetRecords,     
 .      ,   
 Get    .     
  ,    Get   Set.  
     ,     . 
        . Records   ,  
      ,    .  
       Records   
GetRecords.          
read,          write. , 
     Records,    
  GetRecords,        . 
          Records  TDataSet.   
,  ,    TRecord.   ,   
 . 
    ,   ,     GetRecords.  
   ,         
Records.    Implementation    
 GetRecords: 

    Function  TArrayTable.GetRecords(RecNum   :   Logint)    :   TDataSet; begin 
    First; 
    MoveBy(RecNum); 
    Result:=Self; end; 

        ,   GetRecords. 
  Records,   ,    
  TDataSet. ?    Delphi TField  
     . ,   
Delphi     TRecord,      
   . ,   TField   
  DataSet    Fields.    
 .    Records     
    DataSet,   . 
       ,       
Records.     ,    
GetRecords,   . 

     27.     517 

    1.	    DataSet. 
    2.	      DataSet,   
 . 
    3.	      . 
            
 DataSet,          
  : 
    X:=ArrayTablel.Records[4].Fields[2].Value; 
       ?      
      ,     . 
    , ,  ,    .  
       27.2. 

     27.2.      

    { 
     . 
        ,  . 
         : 
    Records[RecNum].Fields[FieldNum].AsType 
       . 
    Copyright () 1995 by Ken Henderson. } unit ArrayTable; 
    interface 
    uses 
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
Db, DBTables; 
    type 
     = class (TTable) private 
    {    } 
    function GetRecords(RecNum: Longlnt): TDataSet; protected 
    {      } public 
    {    ) 
    property Records[RecNum: Longint]: TDataSet read GetRecords; published 
    {    } end; 
    procedure Register; implementation 
    function '. GetRecords (RecNum: Longint): TDataSet; begin 
    First; 
    MoveBy(RecNum); 
    Result := Self; end; 
    procedure Register; begin 
    RegisterComponents('Data Access', []); end; 
    end. 

    518	 IV.    

    ,   ,       
Delphi.  ,     Component  Install 
Components.     Install Component   
    ArrayTab. Pas,      Unit filename 
    .     
   .   Install Component   . 27.2. 

    ... Jnto exiting package | : Onft fife name: Search path; - Package ffe 
name: ; Package iJe$Cfip*iorL	inlo new package j                               
          "fTi "^1::1^^''!|||.|:\1::::^ 
    JDAProgram Files\Borland\Delphi 3\Lib\ArrayTab.pas                  
gfowse...    j 
    | D \Ptogram Files\BorlandVDelphi SSImpoits.e Wrk^devguideScsd3\source 
    JD VProgiam Files\Borland\Delphi 3\Lib\CSD3.dpk          _-^J       
Browse...    j 
    jOent/tarvfflt Devefoper*s Quide wtei DelpN 3 Examples |[  """1"""1|      
 Cancel     |                | 
    
    
    
    
    . 27.2.       Delphi  
  Install Components 

        OK, Delphi     ( 
  DCLUSR30).    Yes,   "  
    .       
 ,         
    .        Yes.  
        Delphi Package 
Manager.       Yes,     
   . 

         

     ,       Delphi,   
  .    File  New Application. 
    Data Access      
 .          , 
   Table.     .  
,    Object Inspector     ,    
Table.   ,       
 Table      (published) ,  
   Table. (  Object Inspector   
 .)        stringGrid. 
          . 

    procedure  TForml.ButtonClick(Sender   :   TObject); var 
    Rcount,   Fcount   :   Integer; begin 
    With_ArrayTablel,   StringGridl  do begin Colco'unt :=Succ(FieldCount); 
RowCount:=Succ(RecordCount); Cells [0,0] :=TableName; For   FCount:=0   to   
Pred(FieldCount)   do 
    Cells[Succ(FCount),0]:=Fields[FCount].FieldName; For  RCount:=l   to  
RecordCount  do 
    For   FCount:=0   to   Pred(FieldCount)   do Cells[Succ(FCount),RCount]:= 
    Records[RCount].Fields[FCount].asString; end; end; 

      ,      
StringGrid       DBGrid, 
   . 

     27.     519 

         .   
       . 

    ColCount:=Succ(FieldCount); RowCount:=Succ(RecordCount) ; 

    ColCount  RowCount    StringGrid.   
   FieldCount  RecordCount  , 
   ,        
.      Succ (FieldCount)  Succ 
(RecordCount).          
 . 

      

    Cells[0,0]:=TableName; 

            .   

    For  FCount:=0   to   Pred(FieldCount)   do 
    Cells[Succ(FCount),0]:=Fields[FCount].FieldName; 

        StringGrid,    
 .  ,       
    FieldName.    

    For  RCount:=l   to  RecordCount   do 
    For  FCount:=0   to   Pred(FieldCount)   do Cells[Succ(FCount),RCount]:= 
    Records[RCount].Fields[FCount].asString; 

              
 . 
              
  ,    stringGrid   
  goColsizing  goColMoving  True. 
    ,      OnClick  Button 
,      .   
          
DatabaseName  TableName ,       
   . ,      RENTMAN  
   " "  .    Active 
 ,    . ,    
   .    ,    . 27.3. 
       ,      ,  
  DBGrid,   Readonly   True. 
    . 27.3.       
StringGrid    DBGrid 

    TLiveQuery 

      TLiveQuery     
(live query) Delphi. ,  ,     
Delphi    RequestLive  Query   
True.    SQL   , 
 Delphi   .  LiveQuery   

    520  IV.    

    ,     SQL    
  ,    .   
   ,     
,   LiveQuery. 
     LiveQuery   ,   
SQL CREATE VIEW,       .  
,     TLiveQuery   ,   
dBASE  Paradox.      :   
 ,    , 
    TLiveQuery. 
     LiveQuery      
      , ,   ,  
  .       SQL   
-,        
  .       
 ,    .   
           
,     .     
   .       
,     .    
    ,   , 
        
 WHERE  HAVING.          
. -      SQL    . 
        ,  TLiveQuery,  
  .     DataAccess,    
.    Unit filename  ,     
  LiveQry.PAS      Create Unit.   
     Delphi. 
            
.          
    .       
  27.3. 

     27.3.    LiveQuery 

    TLiveQuery = class () private 
    { Private declarations } 
    FCreateViewSQL : String; 
    FDropViewSQL : String; 
    FTableNameFormat : TFileName; 
    FSQL : TStrings; 
    procedure SetQuery(Value: TStrings); protected 
    { Protected declarations } 
    procedure CreateTemporaryView; 
    procedure DropTemporaryView; 
    procedure DoBeforeOpen; override; 
    procedure DoAfterClose; override; public 
    { Public declarations } 
    constructor Create(AOwner: TComponent); override; 
    destructor Destroy; override; published 
    { Published declarations } 
    property CreateViewSQL : String read FCreateViewSQL write FCreateViewSQL; 
    property DropViewSQL : String read  FDropViewSQL write FDropViewSQL; 
    property SQL : TStrings read FSQL write SetQuery; 
    property TableNameFormat : 
    TFileName read FTableNameFormat write FTableNameFormat; end; 

          , 
 : 

    const 
    DEFAULTCREATIVEVIEWSQL = 'CREATE VIEW %s AS1; DEFAULTDROPVIEWSQL = 'DROP 
VIEW %s'; DEFAULTTABLENAMEFORMAT = 'TV%s'; 

     27.     521 

            
TLiveQuery,        
  Delphi      .  
,         
TableNameFormat  , ,   
    property TableNameFormat   :   TFileName   read  FTableNameFormat write   
FTableNameFormat   default   DEFAULTTABLENAMEFORMAT; 
            ,  Delphi   
         
.      Delphi   , 
        .   
      .   
       . 

     CreateViewSQL 

     CreateViewSQL      
CREATE VIEW,   .     
ANSI- .     %s   
DEFAULTCREATEVIEWSQL.     Format    
  . 

     DropViewSQL 

     DropViewSQL  ""  CreateViewSQL.   
    DROP VIEW,   .   
  ,   DEFAULTDROPVIEWSQL   
%s,    Format     
 . 

     TableNameFormat 

     TableNameFormat      
      .   
,         
-.        , 
   TableNameFormat    . 
           .   
 LiveQuery    27.4. 

     27.4.   LiveQuery 

    constructor TLiveQuery.Create(AOwner: TComponent); begin 
    inherited Create(AOwner); 
    FSQL := TStringList.Create; 
    FCreateViewSQL := DEFAULTCREATEVIEWSQL; 
    FDropViewSQL := DEFAULTDROPVIEWSQL; 
    FTableNameFormat := DEFAULTTABLENAMEFORMAT; end; 
    destructor TLiveQuery.Destroy; begin 
    if Active then begin Close; 
    DropTemporaryView; end; 
    SQL.Free; 
    inherited Destroy; end; 
    procedure TLiveQuery.SetQuery(Value: TStrings); begin 
    ChecklnActive; 
    SQL.Assign(Value); 

    522	 IV.    

    end; 
    procedure TLiveQuery.CreateTemporaryView; var 
    TemporaryDB : TDatabase; WorkSQL : TStrings; begin 
    WorkSQL := TStringList.Create; WorkSQL.AddStrings(SQL); 
    TableName:=Format(TableNameFormat, [FormatDateTime('yyromddhhnnss',Now)]); 
WorkSQL.Insert(0,Format(CreateViewSQL, [TableName])); 
TemporaryDB:=Session.OpenDatabase(DatabaseName); if (TemporaryDBOnil) then try 
    if (TemporaryDB.IsSQLBased) then begin 
    if (DbiQExecDirect(TemporaryDB.Handle, qrylangSQL, 
    " "	PChar(WorkSQL.Text),nil)<>DBIERR_NONE) then raise 
EDatabaseError.Create('Error creating temporary view'); end else 
    raise EDatabaseError.Create ( 
    'Cannot use this component with local tables'); finally 
    Session.CloseDatabase(TemporaryDB); WorkSQL.Free; end; end; 
    procedure TLiveQuery.DoBeforeOpen; begin 
    inherited DoBeforeOpen; 
    CreateTemporaryView; end; 
    procedure TLiveQuery.DropTemporaryView; var 
    TemporaryDB : TDatabase; WorkSQL : TStrings; begin 
    WorkSQL:=TStringList.Create; 
    WorkSQL.Add(Format(DropViewSQL, [TableName])); "" 
TemporaryDB:=Session.OpenDatabase(DatabaseName); if (TemporaryDBOnil) then 
begin try 
    if (TemporaryDB.IsSQLBased) then begin if 
(DbiQExecDirect(TemporaryDB.Handle,qrylangSQL, 
PChar(WorkSQL.Text),nil)<>DBIERR_NONE) then 
    raise EDatabaseError.Create('Error dropping temporary view'); end else 
    raise EDatabaseError.Create ('Cannot use this component with local tables' finally 
    Session.CloseDatabase(TemporaryDB); WorkSQL.Free; end; end; end; 
    procedure TLiveQuery.DoAfterClose; begin 
    DropTemporaryView; 
    inherited DoAfterClose; end; 
    procedure Register; begin 
    RegisterComponents('Data Access', [TLiveQuery]); end; 
    end. 

     27.     523 

     

              
 .       . 

    constructor  TLiveQuery.Create(AOwner   :   TComponent); begin 
    inherited  Create(AOwner); 
    FSQL   :=  TStringList.Create; 
    FCreateViewSQL   :=  DEFAULTCREATEVIEWSQL; 
    FDropViewSQL   :=   DEFAULTDROPVIEWSQL; 
    FTableNameFormat   :=   DEFAULTTABLENAMEFORMAT; end; 

    ,       Create  ,  
,     inherited       
 AOwner: 

    inherited Create(AOwner); 

     AOwner       TLiveQuery  
 . 
        TStringList,   
  FSQL.       
 SQL,        . 
            
 ,     . 
 ,   .      
  Default,      .  
 ,      Delphi 
 ,       .  
    .    
    Create . 

     

         LiveQuery   .  
  : 

    destructor  TLiveQuery.Destroy; begin 
    If Active  then begin Close; 
    DropTemporaryView; end; 
    SQL.Free; 
    inherited Destroy; end; 

       ,    . 
       ,     
,      .   
 ,    TStrings  SQL,   
   .     . 

     SetQuery 

          Set. ..,   
   SQL.   . 

    procedure  TLiveQuery.SetQuery(Value   :   TStrings); begin 
    ChecklnActive; 
    SQL.Assign(Value); end; 

    524	 IV.    

    ,   SetQuery,      
  ChecklnActive.  ,     
     ,      
 .        ,  
  ,      . 
         SetQuery    Assign 
 SQL.   . TStrings     
   .     ,   
   SQL      Delphi. 

     CreateTemporaryView 

         LiveQuery  
CreateTemporaryView.     ,   , 
   :     ,   
      LiveQuery.   
,         . 
    CreateTemporaryView. 

    procedure  TLiveQuery.CreateTemporaryView; var 
    TemporaryDB   :   TDataBase; WorkSQL   :   TStrings; begin 
    WorkSQL   :   TStringList.Create/Try 
    WorkSQL.AddStrings(SQL) ; TableName:=Format(TableNameFormat, 
    [FormatDateTime('yymmddhhnnss',Now)]); 
WorkSQL.Insert(0,Format(CreateViewSQL,[TableName])); 
TemporaryDB:=Session.OpenDatabase(DatabaseName); try 
    If   (TemporaryDBOnil)   then  begin If   (TemporaryDB.IsSQLBased)   then 
begin If   (DbiQExecDirect(TemporaryDB.Handle, grylangSQL,Pchar(WorkSQL.Text), 
nil)ODBIERR_NONE)    then raise  EDatabaseError.Create( 'Error   creating   
temporary  view1); end else 
    raise  EDatabaseError.Create ( 
    'Cannot  use   this   component  with  local   tables'); end; finally 
    Session.CloseDatabase(TemporaryDB); end; finally 
    WorkSQL.Free; end; end; 

        . -,  , 
  CreateTemporaryView    WorkSQL  
 ,    SQL.  WorkSQL 
   ,   Try. . .Finally   
   . 
    '   "",    Format  CreateTemporaryView 
      TableName 
     TableNameFormat,    
  .  ,   LiveQuery   
TableName  . ,     Table,  
      . ,   
TableName     LiveQuery,   
,  Delphi   ""   ,   
    .	^ 
        TableName    
Format         CreateViewSQL    
 SQL  CREATE VIEW.   

     27.     525 

       LiveQuery!      
SQL   CREATE VIEW,    
CaiU'peifiaef'1''"61%.'1!1 ,   
, -,     .  
     ,    SQL,  
. -,     ,  
    ( ),    
     SQL.   
           
,      BDE. 
      WorkSQL ,     .  
   Table,    
.   LiveQuery    Query,     
   ExecSQL.    . LiveQuery   
,      ,  BDE- 
DbiQExecDirrect.         
WorkSQL     . 
          DbiQExecDirect.   
    PChar,      
 Text  WorkSQL.  Delphi     
  . 
         isSQLBased  
 Database.   ,      
  ,    ,   dBASE 
 Paradox.  ,      
         . 
             
     .  ,  
      finally  try. . .finally.  
   finally,        , 
 ,     try,   . 

    5     f 

     DoBef oreOpen 

     DoBeforeOpen    :   
    DoBeforeOpen     
    Open.  CreateTemporaryView  
    TableName, ,  
        
 .  ,     DoBeforeOpen 
    DoBeforeOpen  .   
      ,  
   BeforeOpen. 

     DropTemporaryView 

         LiveQuery  DropTemporaryView. 
     ,   ,   
CreateTemporaryView.    CreateTemporaryView, 
DropTemporaryView         
 DbiExecDirect    SQL,  . 

     Do After Close 

     DoAfterClose       
 DropTemporaryView     . 
 ,  DoAfterClose    
,  ,     Af terClose. 
        . :   
  LiveQry.PAS,      Uses  
BDE,       API BDE.   
 LIVEQRY.PAS    TLiveQuery   
 Delphi.    ,       
TArrayTable.     TLiveQuery    27.5. 

    526	 IV.    

     27.5.    TLiveQuery 

     LiveQuery. 

            
    .    
 ,      , 
   ,    . 

       . 
    Copyright () 1995 by Ken Henderson. 

      . 

             
,    ,     . 
    1).    ,   ,  Sybase,   
 ,       
,       .  
       , ^   
       
.          
,     ,  
     Open  .. 
    2).           
 . 
    3).        , 
      dBASE  Paradox  .  
      . 
    1).    ,    
  . 
    2) .         . 
    3).   SELECT     WHERE  
HAVING.     ,    
SQL    ,        
 /.  ,     
   SQL,    
.       
,        . 

    } 
    unit Liveqry; 
    interface 
    uses 
    SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 
Forms, Dialogs, Db, DBTables, BDE; 
    const 
    DEFAULTCREATEVIEWSQL = 'CREATE VIEW %s AS '; DEFAULTDROPVIEWSQL = 'DROP 
VIEW %s'; DEFAULTTABLENAMEFORMAT = 'TV%s'; 
    type 
    TLiveQuery = class(TTable) private 
    { Private declarations } 
    FCreateViewSQL : String; 
    FDropViewSQL : String; 
    FTableNameFormat : TFileName; 
    FSQL : TStrings; 
    procedure SetQuery(Value: TStrings); protected 
    { Protected declarations } 

     27.     527 

    procedure CreateTemporaryView; 
    procedure DropTemporaryView; 
    procedure DoBeforeOpen; override; 
    procedure DoAfterClose; override; public 
    { Public declarations } 
    constructor Create(AOwner: TComponent); override; 
    destructor Destroy; override; published 
    { Published declarations } 
    property CreateViewSQL : String read FCreateViewSQL write FCreateViewSQL; 
    property DropViewSQL : String read  FDropViewSQL write FDropViewSQL; 
    property SQL : TStrings read FSQL write SetQuery; 
    property TableNameFormat : 
    TFileName read FTableNameFormat write FTableNameFormat; end; 
    procedure Register; implementation 
    constructor TLiveQuery.Create(AOwner: TComponent); begin 
    inherited Create(AOwner); 
    FSQL := TStringList.Create; 
    FCreateViewSQL := DEFAULTCREATEVIEWSQL; 
    FDropViewSQL := DEFAULTDROPVIEWSQL; 
    FTableNameFormat := DEFAULTTABLENAMEFORMAT; end; 
    destructor TLiveQuery.Destroy; begin 
    if Active then begin Close; 
    DropTemporaryView; end; 
    SQL.Free; 
    inherited Destroy; end; 
    procedure TLiveQuery.SetQuery(Value: TStrings); begin 
    ChecklnActive; 
    SQL.Assign(Value); end; 
    procedure TLiveQuery.CreateTemporaryView; var 
    TemporaryDB : TDatabase; WorkSQL : TStrings; begin 
    WorkSQL := TStringList.Create; WorkSQL.AddStrings(SQL) ; 
    TableName:=Format(TableNameFormat, 
[FormatDateTime('yyiranddhhnnss',Now)]); 
WorkSQL.Insert(0,Format(CreateViewSQL, [TableName])); 
TemporaryDB:=Session.OpenDatabase(DatabaseName); if (TemporaryDBonil) then try 
    if (TemporaryDB.IsSQLBased) then begin 
    if (DbiQExecDirect(TemporaryDB.Handle, qrylangSQL, 
    PChar(WorkSQL.Text),nil)<>DBIERR_NONE) then 
    raise EDatabaseError.Create ('Error creating temporary view'); end else 
    raise EDatabaseError.Create( 
    'Cannot use this component with local tables'); 

    528  IV.    

    finally 
    Session.CloseDatabase(TemporaryDB); WorkSQL.Free; end; end; 
    procedure TLiveQuery.DoBeforeOpen; begin 
    inherited DoBeforeOpen; 
    GreateTemporaryView;: end; 
    procedure TLiveQuery.DropTemporaryView; var 
    TemporaryDB : TDatabase; WorkSQL : TStrings; begin 
    WorkSQL:=TStringList.Create; 
    WorkSQL.Add(Format(DropViewSQL, [TableName])); 
TemporaryDB:=Session.OpenDatabase(DatabaseName); if (TemporaryDBOnil) then 
begin try 
    if (TemporaryDB.IsSQLBased) then begin if 
(DbiQExecDirect(TemporaryDB.Handle,qrylangSQL, 
PChar(WorkSQL.Text),nil)<>DBIERR_NONE) then 
    raise EDatabaseError.Create('Error dropping temporary view' end else 
    raise EDatabaseError.Create( 
    'Cannot use this component with local tables'); finally 
    Session. CloseDatabase(TemporaryDB); WorkSQL.Free; end; end; end; 
    procedure TLiveQuery.DoAfterClose; begin 
    DropTemporaryView; 
    inherited DoAfterClose; end; 
    procedure Register; begin 
    RegisterComponents('Data Access', [TLiveQuery]); end; 
    end. 

     TDBNavSearch 

     TDBNavSearch   ,    
(component template),      
 Delphi DBNavigator.      
  . ,    DBNavSearch  
,        DBNavigator.  
       .    
    ,  ,   ,   
    DBNavSearch. 
         ,      
 .         
    .     
   .       
  ,     . 

     27.     529 

       ?  1. 
    1.       ,      . 
    2.     Component^Create Component Template. 
    3.          Component,    
 Palette page,         . 
            Delphi   
  ,   . 
     ,      ,  
-   ,       ,  
   .        
 .  ,     
 ,      ,   
     ,    . 
           ,  
    DBNavigator  DBNavSearch. 
     DBNavigator     
. ,   ,      
Edit  Insert  DBNavigator   .   
?     OnClick  DBNavigator,  
,    Button (    Case), 
,     .      
 click. 
     DBNavSearch, ,      
 ,       Delphi,       
 OnClick.       
DBNavSearch -  , ,     
 ,      .  ,  
   Edit,     ;  
           
 ,     . ,  
 ,     Delphi. 
        DBNavigator      
  .        
  DBNavigator,     
VisibleButtons.        
,         .  
   ,   .  
     TDBNavigator      
.   ,       
.         . 
     DBNavSearch, ,   ,   
    .      Insert, Edit  Delete, 
    .         
,     Visible.  :  
     ,     Delphi. 
    ,       TDBNavSearch,  
,    .      . 
    1.         SpeedButton   
DataSource.        DataSource  DBNavigator. 
    2.        ,     
    DBNavigator . 
    3.    OnClick     ,   
,        DataSource. 
,  Edit      . 

    nsDataSource.DataSet.Edit; 

    4.       Search    .  
    ,     
 . 
    5.         SpeedButton  DataSource. 
    ComponentoCreate Component Template.  
    TDBNavSearch  ,     
    Data Controls. 

    530	 IV.    

    ,         
TDBNavSearch,    ,     ,  
    .      . 
    1.             
 -.     DBNavSearch. Pas. 
    2.       SpeedButton    DataSource. 
    3.     Component^Create Component Template. 
    4.         TDBNavSearch   
      Data Controls. 
    5.       DBNavSch.BMP    
   (        -). 
    6.          . 
    7.          ,   
    .      
,     . 
             ,    
        ,   
    .  ,    ,   
  ,    ,    
Left     ,      
.      ,      
 ,       . 
             DBNavSearch   
.      ,   
   .     
,   DB.NavSearch    . 
  DBNavSearch       
 . 
            DBSearch (   
 DBNavsearch)   ,  DBNavSearch,    
Uses    .     ,  
  File^Use Unit,       
 Uses   .     
DBNavSearch    27.6. 

     27.6.     DBNavSearch 

    { 
     DBNavSearch. 
            
 . 
     -  . 
    Copyright () 1997 by Ken Henderson. } unit DBNavSch; 
    interface 
    uses 
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
ExtCtrls, DBCtrls, Grids, DBGrids, Db, DBTables, Buttons; 
    type 
    TDBNavSchForm = class(TForm) sbFirst: TSpeedButton; sbPrior: TSpeedButton; 
sbNext: TSpeedButton; sbLast: TSpeedButton; sblnsert: TSpeedButton; sbDelete: 
TSpeedButton; sbEdit: TSpeedButton; sbPost: TSpeedButton; sbCancel: TSpeedButton; 

     27.     531 

    sbRefresh: TSpeedButton; 
    sbSearch: TSpeedButton; 
    nsDataSource: TDataSource; 
    procedure nsDataSourceStateChange(Sender: TObject); 
    procedure sbCancelClick(Sender: TObject); 
    procedure sbDeleteClick(Sender: TObject); 
    procedure sbEditClick(Sender: TObject); 
    procedure sbFirstClick(Sender: TObject); 
    procedure sblnsertClick(Sender: TObject); 
    procedure sbLastClick(Sender: TObject); 
    procedure sbNextClick(Sender: TObject); 
    procedure sbPostClick(Sender: TObject); 
    procedure sbPriorClick(Sender: TObject); 
    procedure sbRefreshClick(Sender: TObject); 
    procedure sbSearchClick(Sender: TObject); private 
    { Private declarations } public 
    { Public declarations } end; 
    var 
    DBNavSchForm: TDBNavSchForm; 
    implementation uses Dbsearch; {$R *.DFM} 
    procedure TDBNavSchForm.nsDataSourceStateChange(Sender: TObject); const 
    BROWSEBUTTONS = $FE; var 
     : integer; begin 
    if (nsDataSource.DataSet <> nil) then Case nsDataSource.DataSet.State of 
dsInActive : begin 
    for c:=0 to Pred(ComponentCount) do if (Components[c].Tag>=BROWSEBUTTONS) 
and (Components[c] is TSpeedButton) then 
TSpeedButton(Components[c]).Enabled:=False; end; dsBrowse :    begin 
    for c:=0 to Pred(ComponentCount) do if (Components[c].Tag>=BROWSEBUTTONS) 
and (Components[c] is TSpeedButton) then TSpeedButton(Components[c]).Enabled:= 
(Components[c].Tag=BROWSEBUTTONS); if nsDataSource.DataSet.Bof then begin 
sbFirst.Enabled:=False; sbPrior.Enabled:=False; end else begin 
    sbFirst.Enabled:=True; sbPrior.Enabled:=True; end; 
    if nsDataSource.DataSet.Eof then begin sbLast.Enabled:=False; 
sbNext.Enabled:=False; end else begin 
    sbLast.Enabled:=True; sbNext.Enabled:=True; end; 
    end; 

    532  IV.    

    dsEdit :    begin 
    sbEdit.Enabled:=False; 
    sbPost.Enabled:=True; 
    sbCancel.Enabled:=True; end; dslnsert :    begin 
    sbEdit.Enabled:=False; 
    sbPost.Enabled:=True; 
    sbCancel.Enabled:=True; end; 
    end; 
    end; 
    procedure TDBNavSchForm.sbCancelClick(Sender: TObject); begin 
    nsDataSource.DataSet.Cancel; 
    end; 
    procedure TDBNavSchForm.sbDeleteClick(Sender: TObject); begin 
    if (Application.MessageBox('Delete 
record?1,'Confirm',MB_OKCANCEL+MB_ICONQUESTION)= IDOK) then 
    nsDataSource.DataSet.Delete; end; 
    procedure TDBNavSchForm.sbEditClick(Sender: TObject); begin 
    nsDataSource.DataSet.Edit; end; 
    procedure TDBNavSchForm.sbFirstClick(Sender: TObject); begin 
    With nsDataSource.DataSet do begin First; if Bof then begin 
    sbFirst.Enabled:=False; sbPrior.Enabled:=False; end else begin 
    sbFirst.Enabled:=True; sbPrior.Enabled:=True; end; if Eof then begin 
    sbLast.Enabled:=False; sbNext.Enabled:=False; end else begin 
    sbLast.Enabled:=True; sbNext.Enabled:=True; end; end; end; 
    procedure TDBNavSchForm.sblnsertClick(Sender: TObject); begin 
    nsDataSource.DataSet.Insert; end; 
    procedure TDBNavSchForm.sbLastClick(Sender: TObject); begin 
    With nsDataSource.DataSet do begin Last; if Bof then begin 
    sbFirst.Enabled:=False; sbPrior.Enabled:=False; end else begin 
    sbFirst.Enabled:=True; sbPrior.Enabled:=True ; end; 
     

     27.     533 

    if Eof then begin 
    sbLast.Enabled:=False; sbNext.Enabled:=False; end else begin 
    sbLast.Enabled:=True; sbNext.Enabled:=True; end; end; end; 
    procedure TDBNavSchForm.sbNextClick(Sender: TObject); begin 
    With nsDataSource.DataSet do begin Next ; if Bof then begin 
    sbFirst.Enabled:=False; sbPrior.Enabled:=False; end else begin 
    sbFirst.Enabled:=True; sbPrior.Enabled:=True; end; if Eof then begin 
    sbLast.Enabled:=False; sbNext.Enabled:=False; end else begin 
    sbLast.Enabled:=True; sbNext.Enabled:=True; end; end; end; 
    procedure TDBNavSchForm.sbPostClick(Sender: TObject); begin 
    nsDataSource.DataSet. Post; end; 
    procedure TDBNavSchForm.sbPriorClick(Sender: TObject); begin 
    With nsDataSource.DataSet do begin Prior; if Bof then begin 
    sbFirst.Enabled:=False; sbPrior.Enabled:=False; end else begin 
    sbFirst.Enabled:=True ; sbPrior.Enabled:=True; end; if Eof then begin 
    sbLast.Enabled:=False; sbNext.Enabled:=False; end else begin 
    sbLast.Enabled:=True; sbNext.Enabled:=True; end; end; end; 
    procedure TDBNavSchForm.sbRefreshClick(Sender: TObject), begin 
    nsDataSource.DataSet.Refresh; end; 
    procedure TDBNavSchForm,sbSearchClick(Sender: TObject); const 
    FLDHEIGHT = 30; 
    LABELSTART = 2; var 

    534  IV.    

     : Byte; 
    LabelWidth, WidestLabelWidth : Byte; begin 
    WidestLabelWidth:=0; 
    SearchForm:=TSearchForm.Create(Self); try 
    With nsDataSource.DataSet as TTable do begin if IndexFieldCount>0 then begin 
    for c:=0 to IndexFieldCount-1 do begin 
    LabelWidth:=SearchForm.AddLabel(IndexFields[c].FieldName,LABELSTART+ 
    (c*FLDHEIGHT)); 
    If (LabelWidth>WidestLabelWidth) then WidestLabelWidth:=LabelWidth; end; 
    {Use two separate loops so that the widest label can be detected and 
allowed for.} for c:=0 to IndexFieldCount-1 do begin 
    SearchForm.AddDBControl(Self.nsDataSource,IndexFields[c], 
    LABELSTART+(c*FLDHEIGHT),WidestLabelWidth+5); end; SetKey; If 
(SearchForm.ShowModal=mrOK) then begin 
    {   ,   GotoKey,    
GotoNearest    ,    .} If 
SearchForm.AllowPartial.Checked then GotoKey else GotoNearest; end else 
Cancel; end; end; finally 
    SearchForm.Free; end; end; 
    end. 
      27.7      DBNavSch. 
     27.7.    DBNavSch 
    object DBNavSchForm: TDBNavSchForm Left = 200 Top = 108 Width = 544 Height 
= 375 
    Caption = 'DBNavSchForm1 Font.Charset = DEFAULT_CHARSET Font.Color = 
clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif Font.Style = [] 
PixelsPerlnch = 96 TextHeight = 13 object sbFirst: TSpeedButton 
    Tag = 254 
    Left = 80 
    Top = 296 
    Width = 25 
    Height = 25 
    Enabled = False 
    Glyph.Data = { 
    46010000424D460100000000000076000000280000001COOOOOOOD0000000100 
040000000000DO00000000000000000000001000000000000000000000000000 
80000080000000808000800000008000800080800000COCOC000808080000000 
FFO00OFFO000OOFFFFOOFFOO0000FFOOFFOOFFFFOOOOFFFFFF00333333333333 

     27.     535 

    3333333333333333000033333333333333333333333333330000333333333333 
3333FFF33333FFF30000330833333380333833F333FF33F30000330833338000 
333833F3FF3333F30000330833800000333833FF333333F30000330880000000 
33383333333333F3000033083380000033383338333333F30000330833338000 
333833F3883333F30000330833333380333833F3338833F30000333333333333 
3338883333338833000033333333333333333333333333330000333333333333 33333333333333330000} 
    NumGlyphs = 2 
    OnClick = sbFirstClick end object sbPrior: TSpeedButton 
    Tag = 254 
    Left = 106 
    Top = 296 
    Width = 25 
    Height = 25 
    Enabled = False 
    Glyph.Data = { 
    12010000424D1201000000000000760000002800000014OOOOOOOD0000000100 
0400000000009C00000000000000000000001000000000000000000000000000 8000008 
00000008 08000800000008 0008 0008 08 OOOOOCOCOC00080808 0000000 
FFOOOOFFOOOOOOFFFFOOFFOOOOOOFFOOFFOOFFFFOOOOFFFFFF00333333333333 
33333333000033333333333333333333000033333333333333333FFF00003333 
33380333333FF33F00003333380003333FF3333F000033380000033FF333333F 
00003800000003833333333F00003338000003388333333F0000333338000333 
3883333F00003333333803333338833F00003333333333333333388300003333 33333333333333330000333333333333333333330000} 
    NumGlyphs = 2 
    OnClick = sbPriorClick end object sbNext: TSpeedButton 
    Tag = 254 
    Left = 132 
    Top = 296 
    Width = 25 
    Height = 25 
    Enabled = False 
    Glyph.Data = { 
    12010000424D1201000000000000760000002800000014OOOOOOOD0000000100 
0400000000009C00000000000000000000001000000000000000000000000000 
80000080000000808000800000008000800080800000COCOC000808080000000 
FFOOOOFFOOOOOOFFFFOOFFOOOOOOFFOOFFOOFFFFOOOOFFFFFF00333333333333 
33333333000033333333333333333333000033333333333FF333333300003083 
333333833FF333330000300083333383333FF333000030000083338333333FF3 
00003000000083833333333F0000300000833383333338830000300083333383 
3338833300003083333333833883333300003333333333888333333300003333 33333333333333330000333333333333333333330000} 
    NumGlyphs = 2 
    OnClick = sbNextClick end object sbLast: TSpeedButton 
    Tag = 254 
    Left = 157 
    Top =296 
    Width = 25 
    Height = 25 
    Enabled = False 
    Glyph.Data = { 
    46010000424D460100000000000076000000280000001COOOOOOOD0000000100 
04OOOOOOOOOODOOOOOOOOOOOOOOOOOOOOOOO1000000000000000000000000000 
80000080000000808000800000008000800080800000COCOC000808080000000 
FFOOOOFFOOOOOOFFFFOOFFOOOOOOFFOOFFOOFFFFOOOOFFFFFF00333333333333 
3333333333333333000033333333333333333333333333330000333333333333 
3333FF333333FFF30000330833333380333833FF333833F30000330008333380 33383333FF3833F300003300000833803338333333F333F30000330000000880 

    536  IV.    

    33383333333333F3000033000008338033383333338833F30000330008333380 
33383333883833F3000033083333338033383388333833F30000333333333333 
3338883333388833000033333333333333333333333333330000333333333333 33333333333333330000} 
    NumGlyphs = 2 
    OnClick = sbLastClick end object sblnsert: TSpeedButton 
    Tag = 254 
    Left = 183 
    Top = 296 
    Width = 25 
    Height = 25 
    Enabled = False 
    Glyph.Data = { 
    46010000424D460100000000000076000000280000001COOOOOOOD0000000100 
040000000000DO00000000000000000000001000000000000000000000000000 
80000080000000808000800000008000800080800000COCOC000808080000000 
FFOO00FFOOOOOOFFFFOOFFOOOOOOFFOOFFOOFFFFOOOOFFFFFF00333333333333 
333333333333333300003333333333333333333FFFF333330000333330003333 
3333338333F3333300003333300033333333338333F333330000333330003333 
3333FF3333FFFF3300003300000000033338333333333F330000330000000003 
3338333333333F3300003300000000033338333333333F330000333330003333 
333888833338833300003333300033333333338333F333330000333330003333 
3333338333F33333000033333333333333333388883333330000333333333333 33333333333333330000} 
    NumGlyphs = 2 
    OnClick = sblnsertClick end object sbDelete: TSpeedButton 
    Tag = 254 
    Left = 209 
    Top = 296 
    Width = 25 
    Height = 25 
    Enabled = False 
    Glyph.Data = { 
    46010000424D460100000000000076000000280000001COOOOOOOD0000000100 
0400000000OODOOOOOOOOOO00000000000001000000000000000000000000000 
800000800000008080008000000080008000808OOOOOCOCOC000808080000000 
FFOOOOFFOOOOOOFFFFOOFFOOOOOOFFOOFFOOFFFFOOOOFFFFFF00333333333333 
3333333333333333000033333333333333333333333333330000333333333333 
3333333333333333000033333333333333333333333333330000333333333333 
3338FFFFFFFFFFF3000033000000000033383333333333F30000330000000000 
33383333333333F3000033000000000033383333333333F30000333333333333 
33388888888888F3000033333333333333333333333333330000333333333333 
3333333333333333000033333333333333333333333333330000333333333333 33333333333333330000} 
    NumGlyphs = 2 
    OnClick = sbDeleteClick end object sbEdit: TSpeedButton 
    Tag = 254 
    Left = 235 
    Top = 296 
    Width = 25 
    Height = 25 
    Enabled = False 
    Glyph.Data = { 
    46010000424D460100000000000076000000280000001COOOOOOOD0000000100 
040000000000D000000000000000000000001000000000000000000000000000 
8000G080000000808000800000008000800080800000COCOC000808080000000 
FFOOOOFFOOOOOOFFFFOOFFOOOOOOFFOOFFOOFFFFOOOOFFFFFFOO333333333333 
3333333333333333000033333333333333333333333333330000333333333333 333333333333333300003333333333333333FFFFFFFFFFF30000330000000000 

     27.     537 

    33383333333333F300003330000000033333833333333F330000333300000033 
333338333333F333000033333000033333333383333F33330000333333003333 
3333333833F33333000033333333333333333333883333330000333333333333 
3333333333333333000033333333333333333333333333330000333333333333 33333333333333330000} 
    NumGlyphs = 2 
    OnClick = sbEditClick end object sbPost: TSpeedButton 
    Tag = 255 
    Left = 260 
    Top = 296 
    Width = 25 
    Height = 25 
    Enabled = False 
    Glyph.Data = { 
    46010000424D460100000000000076000000280000001COOOOOOOD0000000100 04 
0000000 OOODOOOO 0000 0000 00000000000100 0000 0000000 0000 0000 0000 00 800 
0008 0000 000 8 08 00 08 00000008 00 08 00 080 8 OOOOOCOCOCOOO 8 08 08 00 
00000 FFOOOOFFOOOOOOFFFFOOFFOOOOOOFFOOFFOOFFFFOOOOFFFFFF00333333333333 
33333333333333330000333333333333333333F3333333330000333303333333 
33333F3F3333333300003330003333333333F333F33333330000330000033333 
333F33333F33333300003000300033333383333333F333330000300333000333 
338333F8333F33330000333333300033333888338333F3330000333333330003 
3333333338333F33000033333333300033333333338333F30000333333333300 
3333333333383383000033333333333333333333333388330000333333333333 33333333333333330000} 
    NumGlyphs = 2 
    OnClick = sbPostClick end object sbCancel: TSpeedButton 
    Tag = 255 
    Left = 286 
    Top = 296 
    Width =25 
    Height = 25 
    Enabled = False 
    Glyph.Data = { 
    46010000424D460100000000000076000000280000001COOOOOOODOOO0000100 
040000000000D000000000000000000000001000000000000000000000000000 
80000080000000808000800000008000800080800000COCOC000808080000000 
FFOOOOFFOOOOOOFFFFOOFFOOOOOOFFOOFFOOFFFFOOOOFFFFFF00333333333333 
3333333333333333000033333333333333333FF33333FF330000333003333300 
3333833F333833F3000033300033300033338333F38333F30000333300030003 
3333383338333F330000333330000033333333833333F3330000333333000333 
33333338333F33330000333330000033333333833333F3330000333300030003 
3333383338333F33000033300033300033338333F38333F30000333003333300 
3333833F333833F3000033333333333333333883333388330000333333333333 33333333333333330000} 
    NumGlyphs = 2 
    OnClick = sbCancelClick end object sbRefresh: TSpeedButton 
    Tag = 254 
    Left = 312 
    Top = 296 
    Width = 25 
    Height = 25 
    Enabled = False 
    Glyph.Data = { 
    46010000424D460100000000000076000000280000001COOOOOOOD0000000100 
040000000000D000000000000000000000001000000000000000000000000000 
80000080000000808000800000008000800080800000COCOC000808080000000 
FFOOOOFFOOOOOOFFFFOOFFOOOOOOFFOOFFOOFFFFOOOOFFFFFF00333333333333 3333333FFFFF3333000033333808333333333FF3338833330000333800833333 

    538  IV.    

    3333833338333333000033300833333333338333833333330000338083333333 
3338333F3333333300003300333333333338333F3FFFFFF30000330033300000 
3338333F833333F300003300833380003338333F383333F30000338008380000 
33383333F33333F3000033300000008033338333333383F30000333380008330 
33333833333883F3000033333333333333333388888338330000333333333333 33333333333333330000} 
    NumGlyphs = 2 
    OnClick = sbRefreshClick end object sbSearch: TSpeedButton 
    Tag = 254 
    Left = 338 
    Top = 296 
    Width = 25 
    Height = 25 
    Enabled = False 
    Glyph.Data = { 
    46010000424D460100000000000076000000280000001COOOOOOOD0000000100 
040000000000D000000000000000000000001000000000000000000000000000 
80000080000000808000800000008000800080800000COCOC000808080000000 
FFOOOOFFOOOOOOFFFFOOFFOOOOOOFFOOFFOOFFFFOOOOFFFFFF00700777777777 
77788777777777770000000077777777778888777777777700000FO007777777 
778F888777777777000070FO007777777778F888777777770000770FO0000087 
77778F888888877700007770F0087780777778F8887788770000777700877F78 
07777788877F788700007777087777F7887777887777F788000077770877777F 
7077778877777F7800007777087FF777707777887FF7777800007777888FF777 
887777888FF77788000077777088777807777778887778870000777777088880 77777777888888770000} 
    NumGlyphs = 2 
    OnClick = sbSearchClick end object nsDataSource: TDataSource 
    OnStateChange = nsDataSourceStateChange 
    Left = 364 
    Top = 293 end end 
      27.8     DBSearch. 
     27.8.     DBSearch 
    unit Dbsearch; interface 
    uses 
    SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 
Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, Mask, DBCtrls, Db, Math; 
    type 
    TSearchForm = class(TForm) 
    Panell: TPanel; 
    Panel2: TPanel; 
    ScrollBoxl: TScrollBox; 
    BitBtnl: TBitBtn; 
    BitBtn2: TBitBtn; 
    IgnoreCase: TCheckBox; 
    AllowPartial: TCheckBox; 
    DataSourcel: TDataSource; 
    Labell: TLabel; 
    DBCheckBoxl: TDBCheckBox; 
    DBEditl: TDBEdit; private 

     27.     539 

    { Private declarations } 
    public 
    { Public declarations } 
    function AddLabel (LabelCaption : String; LabelTop : Integer) : 
Integer/procedure AddDBControl(DBDataSource : TDataSource; SField : TField; 
DBTop, DBLeft Integer); 
    end; 
    var 
    SearchForm: TSearchForm; 
    implementation {$R *.DFM} 
    function TSearchForm.AddLabel(LabelCaption : String; LabelTop : Integer) : 
Integer; var 
    TL : TLabel; begin 
    TL:=TLabel.Create(ScrollBoxl) ; 
    TL.Parent:=ScrollBoxl; 
    TL.AutoSize:=True; 
    TL.Top:=LabelTop; 
    TL.Left:=2; 
    TL.Caption:=LabelCaption; 
    Result:=TL.Width; end; 
    procedure TSearchForm.AddDBControl(DBDataSource : TDataSource; SField : 
TField; DBTop, 
    DBLeft : Integer); 
    var 
    TDBE : TDBEdit; TDBC : TDBCheckBox; Ruler : String; begin 
    If (SField.DataType <> ftBoolean) then begin 
TDBE:=TDBEdit.Create(SearchForm.ScrollBoxl); 
TDBE.Parent:=SearchForm.ScrollBoxl; TDBE.DataSource:=DBDataSource; TDBE.DataField:=SField.FieldName; 
    SetLength(Ruler,SField.DisplayWidth+2); 
    FillChar(Ruler[1],SField.DisplayWidth+2,'M'); 
    TDBE.Width:=Canvas.TextWidth(Ruler); 
    TDBE.Top:=DBTop; 
    TDBE.Left:=DBLeft; 
    if (SField.DataType=ftString) 
    then TDBE.MaxLength:=MinIntValue([Pred(Width-DBLeft),SField.Size]); end 
else begin 
    TDBC:=TDBCheckBox.Create(SearchForm.ScrollBoxl); 
    TDBC.Parent:=SearchForm.ScrollBoxl; 
    TDBC.Caption:=''; 
    TDBC.DataSource:=DBDataSource; 
    TDBC.DataField:=SField.FieldName; 
    TDBC.Top:=DBTop; TDBC.Left:=DBLeft; end; end; 
    end. 

      27.9     DBSearch. 

    540  IV.    

     27.9,    DBSearch 

    object SearchForm: TSearchForm Left = 24 Top = 120 Width = 592 Height = 
300 Caption = 'Search' Font.Charset = DEFAULT_CHARSET Font.Color = clBlack 
Font.Height = -13 Font.Name = 'Courier New' Font.Style = [] Position = 
poScreenCenter PixelsPerlnch = 96 TextHeight = 16 object Panell: TPanel Left = 
0 Top = 0 Width = 584 Height = 232 Align = alClient Bevellnner = bvLowered 
TabOrder = 0 
    object ScrollBoxl: TScrollBox Left = 2 Top = 2 Width = 580 Height = 228 
Align = alClient Font.Charset = ANSI_CHARSET Font.Color = clBlack Font.Height 
= -13 Font.Name = 'Courier New' Font.Style = [] ParentFont = False TabOrder = 
0 object Labell: TLabel Left = 440 Top = 64 Width = 48 Height = 16 Caption = 
'Labell' Visible = False end 
    object DBCheckBoxl: TDBCheckBox Left = 440 Top = 96 Width = 97 Height = 17 
    Caption = 'DBCheckBoxl' TabOrder = 0 ValueChecked = 'True' ValueUnchecked 
= 'False' Visible = False end 
    object DBEditl: TDBEdit Left = 440 Top = 120 Width = 121 Height = 24 
MaxLength = 0 TabOrder = 1 Visible = False 

     27.     541 

    end '      "''' 
    end	' '            end 
    object Panel2: TPanel Left = 0 Top = 232 Width = 584 Height =41 Align = 
alBottom Bevellnner = bvLowered TabOrder = 1 object BitBtnl: TBitBtn 
    Left = 386 
    Top = 4 
    Width =89 
    Height = 33 
    Caption = '&OK' 
    TabOrder = 0 
    Kind = bkOK end object BitBtn2: TBitBtn 
    Left = 490 
    Top = 4 
    Width =89 
    Height = 33 
    Caption = 'SCancel' 
    TabOrder = 1 
    Kind = bkCancel end object IgnoreCase: TCheckBox 
    Left = 8 
    Top = 12 
    Width = 126 
    Height = 17 
    Caption = 'Slgnore case?' 
    TabOrder = 2 end object AllowPartial: TCheckBox 
    Left = 128 
    Top = 12 
    Width = 209 
    Height = 17 
    Caption = 'SAllow partial searches?' 
    State = cbChecked 
    TabOrder = 3 end end 
    object DataSourcel: TDataSource Left = 444 Top = 28 end end 

     ZoomDlg 

     ZoomDlg       
  !    .    
Delphi      :|   . 
,  ,   . 
      ZoomDlg       Execute, 
!     OnDblClick -  
    , ] DBEdit.     
Execute  ZoomDlg      -1 

    542  IV.    

.    ,  Execute   
 ,    ZoomDlg.      
 ZoomForm.        
    .        
  ,   ,  , 
        .    
  DBNavSearch,    ZoomDlg   
  .     ,   
   .     ZoomDlg 
   27.1027.12. 

     27.10.  ZoomDlg 

    {ZoomDlg.PAS  ZoomDlg. 
              
.    .  ,    
,    ,    Execute. 
     -'~  ,  
 .         
,   ,       
 . 
       . 
    Copyright () 1995-97 by Ken Henderson. 
    } 
    unit Zoomdlg; 
    interface 
    uses 
    SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 
Forms, Dialogs, ZoomForm, DBTables, Dsgnlntf, Typlnfo; 
    type 
    TZoomDialog = class(TComponent) private 
    { Private declarations } 
    FCaption : string; 
    FSourceTable : TTable; 
    FSourceField : string; protected 
    { Protected declarations } public 
    { Public declarations } published 
    { Published declarations } 
    procedure Execute(Sender : TObject); published 
    { Public declarations } 
    property Caption : string read FCaption write FCaption; 
    property SourceTable : TTable read FSourceTable write FSourceTable; 
    property SourceField : string read FSourceField write FSourceField; end; 
    procedure Register; implementation 
    procedure TZoomDialog.Execute(Sender : TObject); begin 
    fmZoom:=TfmZoom.Create(Self); 

     27.     543 

    try 
    fmZoom.ShowFormfSender,Caption, SourceTable,SourceField); finally 
    fmZoom.Free; end; end; 
    { TSourceFieldProperty } 
    type 
    TSourceFieldProperty = class(TStringProperty) public 
    function GetAttributes: TPropertyAttributes; override; 
    procedure GetValueList(List: TStrings); 
    procedure GetValues(Proc: TGetStrProc); override; 
    function GetTablePropName: string; virtual; end; 
    function TSourceFieldProperty.GetAttributes: TPropertyAttributes; begin 
    Result := [paValueList, paSortList, paMultiSelect] ; end; 
    function TSourceFieldProperty.GetTablePropName: string; begin 
    Result := 'SourceTable'; end; 
    procedure TSourceFieldProperty.GetValues(Proc: TGetStrProc); var 
    I: Integer; Values: TStringList; begin 
    Values := TStringList.Create; try 
    GetValueList(Values); 
    for I := 0 to Values.Count - 1 do Proc(Values[I]); finally 
    Values.Free; end; end; 
    procedure TSourceFieldProperty.GetValueList(List: TStrings); var 
    Instance: TComponent; 
    Proplnfo: PPropInfo; 
    SourceTable : TTable; begin 
    Instance := TComponent(GetComponent(0)); 
    Proplnfo := TypInfo.GetPropInfo(Instance.Classlnfo, GetTablePropName); 
    if (Proplnfo <> nil) and (Proplnfo'4..Kind = tkClass) then 
    begin 
    SourceTable := TObject(GetOrdProp(Instance, Proplnfo)) as TTable; if 
(SourceTable <> nil) then 
    SourceTable.GetFieldNames(List) ; 
    end; end; 
    procedure Register; begin 
    RegisterComponents('Dialogs', [TZoomDialog]); 
    RegisterPropertyEditor(Typelnfo(string), TZoomDialog, 'SourceField', 
TSourceFieldProperty) ; end; 
    end. 

    544	 IV.    

     27.11,     zoomForm  ZoomDig 

    unit ZoomForm; interface 
    uses 
    SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 
Forms, Dialogs, ExtCtrls, DBCtrls, StdCtrls, Buttons, DB, DBTables, Grids, 
DBGrids, Tabs, DBNavSearch; 
    type 
    TfmZoom = class(TForm) 
    dsZoom: TDataSource; 
    Panel1: Panel;: 
    Panel2: TPanel; 
    dgZoom: TDBGrid; 
    Panel3: TPanel; 
    bbOK: TBitBtn; 
    bbCancel: TBitBtn; 
    nsZoom: TDBNavigator; 
    procedure bbOKClick(Sender: TObject); 
    procedure FormClose(Sender: TObject; var Action: TCloseAction); 
    procedure FormShow(Sender: TObject);' private 
    { Private declarations } 
    FSourceTable : TTable; 
    FSourceField : string; public 
    { Public declarations } 
    Caller : TObject; 
    procedure ShowForm(Sender : TObject; Cap : String; SourceTab : TTable; 
SourceFld String); 
    property SourceTable : TTable read FSourceTable write FSourceTable; 
    property SourceField : string read FSourceField write FSourceField; end; 
    var 
    fmZoom: TfmZoom; 
    implementation ($R *.DFM} 
    procedure TfmZoom,ShowForm(Sender : TObject; Cap : String; SourceTab : TTable; 
    SourceFld: String); 
    begin 
    Caption:=Cap; 
    Caller:=Sender; 
    SourceTable:^SourceTab; 
    SourceField:=SourceFld; 
    dsZoom.DataSet:=SourceTable; 
    ShowModal; end; 
    procedure TfmZoom.bbOKClick(Sender: TObject); begin 
    If Caller is TDBEdit then begin 
    With Caller as TDBEdit do begin 
    If (not (DataSource.DataSet,State in [dslnsert, dsEdit])) then 
    DataSource.DataSet.Edit; DataSource.DataSet,FieldByName(DataField).AsString:= 
    dsZoom.DataSet.FieldByName(SourceField).AsString; end; 
    end else If Caller is TCustomEdit then begin With Caller as TCustomEd.it. 
do begin Clear; 

     27.     
    18 Delphi 3   / 545 

    Text:=dsZoom.DataSet.FieldByName(SourceField).AsString; end; 
    end else If Caller is TComboBox then begin With Caller as TComboBox do 
begin Clear; 
    Text:=dsZoom.DataSet.FieldByName(SourceField).AsString; end; 
    end else If Caller is TDBComboBox then begin With Caller as TDBComboBox do begin 
    If (not (DataSource.DataSet.State in [dslnsert, dsEdit])) then 
    DataSource.DataSet.Edit; DataSource.DataSet.FieldByName(DataField).AsString:= 
    dsZoom.DataSet.FieldByName(SourceField).AsString; end; end; 
    ModalResult := mrOK; end; 
    procedure TfmZoom.FormClose(Sender: TObject; var Action: TCloseAction); begin 
    with SourceTable do if Active then Close; end; 
    procedure TfmZoom.FormShow(Sender: TObject); begin 
    With SourceTable do 
    If not Active then Open; end; 
    end. 

 27.12.    ZoomForm 

    object fmZoom: TfmZoom Left = 89 Top = 96 Width = 652 Height = 460 Caption 
= 'fmZoom' Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText 
Font.Height = -13 Font.Name = 'System' Font.Style = [] Position = 
poScreenCenter OnClose = FormClose OnShow = FormShow PixelsPerlnch = 96 
TextHeight = 16 object Panell: TPanel Left = 0 Top = 388 Width = 644 Height = 
45 Align = alBottom Bevellnner = bvLowered TabOrder = 0 object Panels: TPanel 
Left = 451 Top = 2 Width = 191 Height = 41 Align = alRight BevelOuter = bvNone 
TabOrder = 0 object bbOK: TBitBtn 

    546	 IV.    

    Left = 5 Top = 4 Width = 89 Height = 33 Caption = 'SDK' TabOrder = 0 
OnClick = bbOKClick Kind = bkOK end 
    object bbCancel: TBitBtn Left = 97 Top = 4 Width = 89 Height = 33 Caption 
= 'scancel' TabOrder = 1 Kind = bkCancel end end 
    object nsZoom: TDBNavigator Left = 8 Top = 8 Width = 240 Height = 25 
DataSource = dsZoom TabOrder = 1 end end 
    object Panel2: TPanel Left = 0 Top = 0 Width = 644 Height = 388 Align = 
alClient TabOrder = 1 object dgZoom: TDBGrid Left = 1 Top = 1 Width = 642 
Height = 386 Align = alClient DataSource = dsZoom Font.Charset = 
DEFAULT_CHARSET Font.Color = clBlack Font.Height = -13 Font.Name = 'Arial' 
Font.Style = [] Options = [dgTitles, dglndicator, dgColumnResize, dgColLines, 
    dgRowLines, dgTabs, dgConfirmDelete, dgCancelOnExit] ParentFont = False 
Readonly = True TabOrder = 0 
    TitleFont.Charset = DEFAULT_CHARSET TitleFont.Color = clBlack 
TitleFont.Height = -13 TitleFont.Name = 'Arial' TitleFont.Style = [] end end 
    object dsZoom: TDataSource Left = 83 Top = 33 
end 
end 

     ZoomDlg    .  ,   
      Delphi    
Register,         SourceField. 
       ,   

     27.     547 

      SourceField   ,      
       VCL Delphi. , 
     ! ,    27.13. 

     27.13.     

    { TSourceFieldProperty } 
    type 
    'PSourceF'ield'Property = class (TStringProperty) 
    public 
    function GetAttributes: TPropertyAttributes; override; procedure 
GetValueList(List: TStrings); procedure GetValues (Proc: TGetStrProc) ; 
override/function GetTablePropName: string; virtual; 
    end; 
    function TSourceFieldPi?operty.GetAttributes: TPropertyAttributes; begin 
    Result := [paValueList, paSortList, paMultiSelect] ; end; 
    function TSourceFieldProperty.GetTablePropName: string; begin 
    Result := 'SourceTable'; end; 
    procedure TSourceFieldProperty.GetValues(Proc: TGetStrProc); var 
    I: Integer; Values: TStringList; begin 
    Values := TStringList. Create/try 
    GetValueList(Values); 
    for I := 0 to Values.Count - 1 do Proc(Values[I]); finally 
    Values.Free; end; end; 
    procedure TSourceFieldProperty.GetValueList(List: TStrings); var 
    Instance: TComponent; 
    Proplnfo: PPropInfo; 
    SourceTable : TTable; begin 
    Instance := TComponent(GetComponent(0)); 
    Proplnfo := TypInfo.GetPropInfo(Instance.Classlnfo, GetTablePropName); 
    if (Proplnfo <> nil) and (Proplnfo~..Kind = tkClass) then 
    begin 
    SourceTable := TObject(GetOrdProp(Instance, Proplnfo)) as TTable; if 
(SourceTable <> nil) then 
    SourceTable.GetFieldNames(List); 
    end; end; 
    procedure Register; begin 
    RegisterComponents('Dialogs', [TZoomDialog]); 
    RegisterPropertyEditor(Typelnfo(string), TZoomDialog, 'SourceField', 
TSourceFieldProperty) ; end; 

    548	 IV.    

        

         27.13   
      .    
   . 
    1.    -    ,   
 Dsgnlntf. 
    2.     ,       
   .      , 
      . 
    3.          
 ,   Object Inspector    . 
    4.       RegisterPropertyEditor   
 . 
      27.13   SourceFieldProperty   
 TStringProperty.    SourceField   
         
  . 
       ,     
   : ,    
stringProperty,  . 
    SourceFieldProperty  Object Inspector    
     GetAttributes  TStringProperty. 
     . 

    Result   :=   [paValueList,   paSortList,   paMultiSelect]; 

             
SourceFieldProperty.    ,     
           
.  , paSortList,  Object Inspector   
  Getvalues .       
     ,     
     .  , 
paMultiSelect, ,   SourceField     
    ,    .   
 (, , Name)     . 
    ,       RegisterPropertyEditor. 

    RegisterPropertyEditor(Typelnfo(string),   TZoomDlg, 'SourceField',   TSourceFieldProperty); 

       RegisterPropertyEditor     
 . 
    Q   ,    .    
   
    Typelnfo. 
    Q  ,      .    
   nil,       
,    . 
    Q    .       , 
      . 
    Q    ,    . 
        RegisterPropertyEditor   , 
,      ,     
    

    SourceField  ZoomDialog. 


       zoomDig 

       ZoomDig     OnClick 
   

    ZoomForm. 
    procedure TfmZoom.bbOKClick(Sender: TObject); begin 
    If Caller is TDBEdit then begin With Caller as TDBEdit do begin 
    If (not (DataSource.DataSet.State in [dslnsert, dsEdit])) then DataSource.DataSet.Edit; 

     27.     549 

    DataSource.DataSet.FieldByName(DataField).AsString:= 
    dsZoom.DataSet.FieldByName(SourceField).AsString; end; 
    end else If Caller is TCustomField then begin With Caller as TCustomEdit 
do begin Clear; 
    Text:=dsZoom.DataSet.FieldByName(SourceField).asStzing; end; 
    end else If Caller is TDBComboBox then begin With Caller as TDBComboBox do begin 
    If (not (DataSource.DataSet.State in [dslnsert, dsEdit])) then DataSource.DataSet.Edit; 
    DataSource.DataSet.FieldByName(DataField).AsString:= 
dsZoom.DataSet.FieldByName(SourceField).AsString; end; end; 
    ModaResult := mrOK; end; 

            
      (RTTI  RunTime Type 
Information).     RTTI. ,   , 
, , Delphi   ,   .  
.     ZoomForm  RTTI,  
  ,    ,     
 . 
         With. . .as   
  Caller.]    "",   
       .  
 ,   ,     
    .  With. . .as  
       . 
 ,   |  ,  . 

     

      ,       . 
,   -1       ,    
   . , ,]     
       .  -J 
   .          . 

      
      ,    ,  
   ,     TArrayTable.  
,    ,     
   -.   ,    
   .

     ... 

     28, "    Internet",    
   | /  Delphi    
Internet.    Web-, - j      
     Delphi    
  Internet. 

550  IV.    
