     7 

       Win32 

      

           ,    
,  .       
     .    
   Windows 95,     
  ,    . 
              
  ,         
  . 

        

            
       . 

      TrackBar 

      ( )       
 TTrackBar,     , 
   .  Position  
  TTrackBar  * 

        

          ,   
       ,    
    .    Track Bar, 
Up-Down, Hot key  Progress Bar. 

       Delphi 3 

       ,      
 : TToolBar, TCoolBar, TDateTimePicker  TAnimate. 

        

            
,        
 .     status Bar, Header, 
Image List, Tab, Page, Rich Edit, List View  Tree View. 

     

     , ,     Windows, 
  Delphi.       
 TTabControl  TPageControl      
   . 


145


    (thumb)     . ,   
,    ,   Min, Max 
 Frequency. 
          ,   
TickStyle  tsManual    SetTick.     . 
    1.    ,   
File^New Application. 
    2.       TTrackBar  TUpDown   Win95 
 . 
    3.       TEdit  TButton   Standard 
 . 
    4.         TickStyle  
TrackBarl  tsManual. 
    5.      Object Inspector   Associate  
TUpDown  Editl (  TUpDown     
   ). 
    6.     Events      
 OnClick   TButton.      
. OnClick. 

    procedure  TForml.ButtonlClick(Sender:   TObject); begin 
    TrackBarl.SetTick(StrToInt(Editl.Text) ) ; end; 

        TTrackBar,    
SetTick        
;   TTrackBar    .  
   OnShowHint  TApplication,   
      TTrackB ar. 
         Holdings    
,      .  TTrackBar 
    ,     
   Position  TTrackBar. 
     . 7.1     TTrackBar   
   Shares ( ).  ,   
     .    
  TTrackBar       
     Shares. 

    . 7.1.    TTrackBar 

       ,   ?. 1,    
 Shares   By-Shares   Database Desktop   
 IndexName  Tablel   .  SETTKC2. PAS 
    . 

     7.1. \UDELPHI3\CHP7 \TRACRBAR\sETTCK2. PAS.    
 TrackBar Shares Selector 

    unit settck2; 
    interface 
    uses 
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
DB, DBTables, Grids, DBGrids, ComCtrls, StdCtrls; 
    type 
    TForml = class(TForm) DBGridl: TDBGrid; TrackBarl: TTrackBar; Tablel: 
TTable; DataSourcel: TDataSource; TablelSYMBOL: TStringField; 


    146  II.   


    TablelSHARES: TFloatField; 
    TablelPUR_PRICE: TFloatField; 
    procedure FormCreate(Sender: TObject); 
    procedure FormShow(Sender: TObject); 
    procedure TrackBarlChange(Sender: TObject); private 
    procedure AppShowHint(var HintStr: string; var CanShow: Boolean; 
    var Hintlnfo: THintlnfo); end; 
    var 
    Forml: TForml; 
    implementation {$R *.DFM} uses CommCtrl; 
    (* 
    TBM_GETTHUMBRECT 
    wParam = 0; 
    IParam = (LPARAM) (LPRECT) Iprc; 
     TBM_GETTHUMBRECT     
        TTrackBar. *) 
    //     . 
    procedure TForml.AppShowHint(var HintStr: string; var CanShow: Boolean; 
    var Hintlnfo: THintlnfo); var 
    TrackBarThumbRect: TRect; begin 
    SendMessage(TrackBarl.Handle, TBM_GETTHUMBRECT, 0, Longlnt(@TrackBarThumbRect)); 
    Hintlnfo.HintPos := 
TrackBarl.ClientToScreen(TrackBarThumbRect.BottomRight) ; end; 
    // : ,    
    //   , 
    //     
    // "table is busy" (" "). 
    procedure TForml.FormCreate(Sender: TObject); 
    begin 
    with Application do begin 
    OnShowHint := AppShowHint; HintPause := 0; HintShortPause := 0; end; end; 
    procedure TForml.FormShow(Sender: TObject); begin 
    with Tablel do begin Open; Last; 
    TrackBarl.Max := Tablel['Shares']; First; 
    TrackBarl.Min := Tablel['Shares ']; TrackBarl.LineSize := TrackBarl.Max 
div 20; TrackBarl.PageSize := TrackBarl.Max div 4; while not EOF do begin 
    TrackBarl.SetTick(Tablel['Shares']); 

     7.    Win32 147 


    Next; end; end; end; 
    procedure TForml.TrackBarlChange(Sender: TObject); begin 
    if Tablel.State in [dsBrowse] then begin 
    Tablel.FindNearest([TrackBarl.Position]); 
    TrackBarl.Hint := Tablel.FieldByName('Shares').AsString + ' shares'; end; end; 
    end. 


      UpDown 

     ,     TUpDown, 
     ,   
     . 

      
         TEdit     TRichEdit. 
 TUpDown     , , ,  
      . 
        UpDown     
,         
  Associate.   TUpDown    
   ,   ,     
AlignButton,   udLeft  u dRight.  ( 
Orientation)    udVertical  udHorizontal. 
      TUpDown,     
 .  -Click      
   ,       
 .     -   
 TUpDown,      (   
   TEdit,      ).  
 Associate  ( nil),     Onclick 
     (. 7.2). 
       OnClick  OnChanging   
 (     Allow-Change).  , 
 OnChanging   ,     btPrev 
()  btNext (). 
          ,  
     .  UDCAL1. PAS, 
   7.2,     . 

    . 7.2.    TUpDown    
TCalendar 

     7.2. \UDELPHI3\CH7\UPDOWN\UDCAL1. PAS.   TUpDown 
 TCalendar 

    unit UDCall; 
    interface 
    uses 
    Windows, Messages, SysUtils, Classes, Graphics, Controls,Forms, Dialogs, 
ExtCtrls, ComCtrls, StdCtrls, Grids, Calendar, Buttons, CommCtrl; 


    148  .   


    type 
    TfrmDate = class(TForm) 
    Calendar!: TCalendar; 
    StatusBarl: TStatusBar; 
    Panel2: TPanel; 
    Panel!: TPanel; 
    Editl: TEdit; 
    Edit2: TEdit; 
    UpDownl: TUpDown; 
    UpDown2: TUpDown; 
    cbAllowChange: TCheckBox; 
    BitBtnl: TBitBtn; 
    procedure FormCreate(Sender: TObject); 
    procedure UpDownlClick(Sender: TObject; Button: TUDBtnType); 
    procedure UpDown2Click(Sender: TObject; Button: TUDBtnType); 
    procedure CalendarIChange(Sender: TObject); 
    procedure UpDownlChanging(Sender: TObject; var AllowChange: Boolean); end; 
    const 
    Months: array [1..12] of ShortString = ( 
    'January', 'February', 'March', 'April', 'May', 'June', 'July', 'August', 'September', 
    'October', 'November', 'December' ); 
    var 
    frmDate: TfrmDate; 
    implementation {$R *.DFM} 
    procedure TfrmDate.FormCreate(Sender: TObject); begin 
    Editl.Readonly := True; 
    Editl.Text := Months[Calendarl.Month]; 
    Edit2.Readonly := True; 
    Edit2.Text := IntToStr(Calendarl.Year); 
    UpDownl.Position := Calendarl.Month; 
    with UpDown2 do 
    begin 
    Min := 1900; 
    Max := 3000; //     . 
    Position := Calendarl.Year; 
    Thousands := False; end; end; 
    procedure TfrmDate.UpDownlClick(Sender: TObject; Button: TUDBtnType); begin 
    with Calendarl do begin 
    if (Button = btNext) then        ,  ,,  ,v , . . 
    Month := Month + 1 
    else // Button = btPrev 
    Month := Month - 1; Editl.Text := Months[Month]; end; end; 
    procedure TfrmDate.UpDown2Click(Sender: TObject; Button: TUDBtnType); begin 
    Calendarl.Year := UpDown2.Position end; 


     7.    Win32  149 


    procedure TfrmDate.CalendarlChange(Sender: TObject}; begin 
    with Calendarl do 
    StatusBarl.SimpleText := Months[Month] + ' ' + 
    IntToStr(Day) + ', ' + IntToStr(Year); end; 
    procedure TfrmDate.UpDownlChanging(Sender: TObject; 
    var AllowChange: Boolean); begin 
    AllowChange := cbAllowChange.Checked; end; 
    end. 


      HotKey 

            
     ,    
 HotKey.  THotKey,    ,   
  TShortCut,       
ShortcutToText  TextToShortCut     . 
     ,  - (hkShift, hkCtrl, hkAlt  
hkExt)   ,      
  ,    Modifiers. ,  
 Modifiers   [hkCtrl, hkShif t]    
 <>,   THotKey    <Ctr!+Shift+A>. 
   ,    Modifiers. 
        ,    
       .    
 .   7.3   ,   TBitBtn 
 TMainMenu (        TPopupMenu). 
  ( 7.4)        
     .    
     TListView  THotKey.   
 TListVie       ,   
   ,     TListViev, 

    . 7.3.        

    . 7.4.       

           TBitBtn     
  TListView         
 .     ,   
TListView,        THotKey 
(. 7.3),    ,     
    List View (. 7.4).  HKEY1. PAS 
( 7.3)  HKEY2 . PAS ( 7.4)    
 . 


    150  II.   


     7.3. \UDELPHI3\CH7 \HOTKEYI . PAS. ,  Main Menu 
( ) 
    unit hkeyl; 
    interface 
    uses 
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
Menus, StdCtrls, Buttons; 
    type 
    TForml = class(TForm) 
    MainMenul: TMainMenu; 
    BitBtnl: TBitBtn; 
    Filel: TMenuItem; 
    Exit2: TMenuItem; 
    N3: TMenuItem; 
    PrintSetup2: TMenuItem; 
    Print2: TMenuItem; 
    N4: TMenuItem; 
    SaveAs2: TMenuItem; 
    Save2: TMenuItem; 
    Open2: TMenuItem; 
    New2: TMenuItem; 
    procedure BitBtnlClick(Sender: TObject); 
    procedure ExitlClick(Sender: TObject); end; 
    var 
    Forml: TForml; 
    implementation 
    {$R *.DFM} 
    uses ComCtrls, HKey2; 
    procedure TForml.BitBtnlClick(Sender: TObject); var 
    i: integer; Newltem : TListltem; ShortCutStr: string; begin 
    with TfrmDefineMenu.Create(self) do try 
    for i := 0 to Filel.Count - 1 do begin 
    Newltem := ListViewl.Items.Add; Newltem.Caption := Filel.Items[i].Caption; 
ShortCutStr := ShortCutToText(Filel.Items[i].Shortcut); 
Newltem.Subltems.Add(ShortCutStr); end; 
    ListViewl.Items[0].Selected := True; //    
 . ShowModal; for i := 0 to ListViewl.Items.Count - 1 do 
    Filel.Items[i].Shortcut := TextToShortCut(ListViewl.Items[i].Subltems[0]); 
finally Free; end; end; 


     7.    Win32 151 


    procedure TForml.ExitlClick(Sender: TObject); begin 
    Close; end; 
    end. 

     7.4. HKEY2. PAS. ,  THotKey unit  hkey2; 

    interface 
    uses 
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
StdCtrls, Buttons, ComCtrls; 
    type 
    TfrmDefineMenu = class(TForm) HotKeyl: THotKey; BitBtnl: TBitBtn; Labell: 
TLabel; ListViewl: TListView; 
    procedure ListViewlClick(Sender: TObject); procedure FormKeyPress(Sender: 
TObject; var Key: Char); procedure FormCreate(Sender: TObject); end; 
    var 
    frmDefineMenu: TfrmDefineMenu; 
    implementation {$R *.DFM} uses Menus; 
    procedure TfrmDefineMenu.ListViewlClick(Sender: TObject); begin 
    with ListViewl do 
    if (Assigned(Selected) and (Selected.Caption <> '-')) then 
    HotKeyl.HotKey := TextToShortCut (Listviewl.Selected.Subltems[0]); 
HotKeyl.SetFocus; end; 
    procedure TfrmDefineMenu.FormKeyPress(Sender: TObject; var Key: Char); begin 
    with ListViewl do begin 
    Selected.Subltems[0] := ShortCutToText(HotKeyl.HotKey); 
Updateltems(Selected.Index, Selected.Index); end; end; 
    procedure TfrmDefineMenu.FormCreate(Sender: TObject); var 
    NewColumn: TListColumn; begin 
    //       , 
    //      . 
    KeyPreview := True; 
    with ListViewl do 
    begin 
    Readonly := True; 


    152  II.   

    ViewStyle := vsReport; NewColumn := ListViewl.Columns.Add; 
NewColumn.Caption := 'Item1; NewColumn.Width := 100; NewColumn := 
ListViewl.Columns.Add; NewColumn.Caption := 'HotKey1; NewColumn.Width := 200; 
end; end; 
    end. 

      Progress Bar 

      Progress Bar (   ) 
  ,       
,       ,  
  (,  ).    
 TProgressBar,   Min  ,    
  Position    . 
             
.    ,   . 
    1.      File   New Application. 
    2.      File   NewOForms1^About Box. 
    3.      OK   AboutBox. 
    4.      TProgressBar   AboutBox    
 Align  alBottom. 
    5.      File   New Form.      
.       1-5 . 
    6.      View=> Project Source    
 ,     7.5 (     
 ). 

    !    7.5. \UDELPHI3\CH7\PROGRESSBAR\PRGBAR1\PROJECT1.DPR.   

    program Project!; 
    uses 
    Forms, Windows, 
    Forms, windows, 
    Unitl in 'Unitl.pas'                                       {Forml}, 
    Unit2 in 'Unit2.pas'                                       {AboutBox}, 
    Unit3 in 'Unit3.pas'                                       {Form3}, 
    Unit4 in 'Unit4.pas'                                      {Form4}, 
    Units in 'Units.pas'                                       {FormS}; 
    {$R *.RES} 
    const 
    //    Sleep API. NumberOfMilliseconds: Longlnt = 100; 
    begin 
    Application.Initialize; 
    with TAboutbox.Create(Application) do 
    try 
    Show; 
    Update; 
    Application.CreateFormfTForml, Forml); 
    ProgressBarl.Position := 25; 
    //  ,     
    //   ,    Sleep API. 
    // ,   Sleep, ,   
    //   . 


     7.    Win32 153 


    Sleep(NumberOfMilliseconds) ; 
    Application.CreateForm(TForm3, Form3); 
    ProgressBarl.Position := 50; 
    Sleep (NumberOfMilliseconds); 
    Application.CreateForm(TForm4, Form4); 
    ProgressBarl.Position := 75; 
    Sleep (NumberOfMilliseconds) ; 
    Application.CreateForm(TForm5, FormS); 
    ProgressBarl.Position := 100; finally 
    Free; end; 
    Application.Run; end. 

         Min, Max  Position,    
Step    Steplt.       
.         
      ,   StepBy. 
     . 7.5    7.6      
  .  Max, Min  Step   
   .  ,   
    TFileStream. CopyFrom,    .  
        
 .  .      TStatusBar 
   .      , 
      TProgressBar.  STSPRG1.PAS 
    . 

    . 7.5.         

     7.6. \UDELPHI3\CHP7\PROGRESSBAR\PRGBAR2\STSPRG1. PAS.   

    unit StsPrgl; interface 
    uses 
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
StdCtrls, ComCtrls; 
    type 
    TForml = class(TForm) Buttonl: TButton; Editl: TEdit; Edit2: TEdit; 
Label1: TLabel; Label2: TLabel; StatusBarl: TStatusBar; IblStep: TLabel; 
IblMin: TLabel; IblMax: TLabel; IblSize: TLabel; 
    procedure ButtonlClick(Sender: TObject); end; 
    var 
    Forml: TForml; 
    implementation {$R *.DFM} 


    154  II.   


    procedure TForml.ButtonlClick(Sender: TObject); var 
    FromStream, ToStream: TFileStream; BytesToCopy: Longlnt; begin 
    FromStream := TFileStream.Create(Editl.Text, fmOpenRead) ; 
    ToStream := TFileStream.Create(Edit2.Text, fmCreate or fmOpenWrite); 
    {    Statusbar. } 
    StatusBarl.SimplePanel := True; 
    StatusBarl.SizeGrip := False; 
    StatusBarl.SimpleText := 'Saving to ' + Edit2.Text; 
    StatusBarl.Refresh; // ,     . 
    try 
    with TProgressBar.Create(Self) do try 
    {      
     . }  :=  + 3; 
    Left := StatusBarl.Width - Width; Height := Height - 3; Parent := StatusBarl; 
    {      . } Step := 
FromStream.Size div 1000; Max := FromStream.Size; BytesToCopy := Step; { 
 . } 
    IblStep.Caption := 'Step: ' + InttoStr (Step); 
    IblSize.Caption := 'From Stream size: ' + InttoStr(FromStream.Size); 
IblMin.Caption := 'Min: ' + InttoStr(Min); IblMax.Caption := 'Max: ' + 
InttoStr(Max); {   . } 
    while (ToStream.Position + BytesToCopy <= FromStream.Size) do begin 
    ToStream.CopyFrom(FromStream, BytesToCopy); Steplt; 
    Application.ProcessMessages; end; 
    {   . } 
    ToStream.CopyFrom(FromStream, FromStream.Size - ToStream.Size); Position 
:= ToStream.Size; finally 
    StatusBarl.SimpleText := ''; Free; end; finally ToStream.Free; 
FromStream.Free; end; end; 
    end. 


       Delphi 3 

     Delphi 3      COMCTL32^;j^Ji  
   (Tool Bar)    Cool Bar, 
        . 

     7.    Win32 155 


      

    ,      TToolBar,   ,  
     .  TToolBar  
 ,     ,  
        .  
   TToolButtons    TControl,  
    Windows. TToolBar     
  ,  TEdit  TComboBox. 

      TToolBar    

      TToolButtons   ,    
       New Button  New Separator  
 .         
 .      ,  
      ,     
   . 
      TImageList,     
TToolButtons     Images.   
TImageList           
\Images\Buttons. ,      ,  
  ,      . 
,   Images      
   (. 7.6).   TToolButton 
    ImageList. TToolButton   
Imagelndex,         
      . 

    . 7.6.   TToolBar    

            MS Internet Explorer 
3,   Flat  True.      
        ,  
  TImageList     Hotlmages. 
       ,     ,   
 TToolBar,   Wra-pable   True,  
   .  ,  
 TToolButton   Wrap,     
  . 
    I 

      TToolBar   

       TToolButton      
,     TToolButton,    
 Parent. 

    with  TToolButton.Create(Self)   do Parent   :=  ToolBarl; 

        TToolButtons  ,  
 ClearButtons.     TToolButtons    
-   ,    . 
     ,  ^ 
 Windows TB_DELETEBUTTON.       
  ToolBarl (    ).

    procedure TForml.ButtonlClick(Sender:   TObject); var 
    Buttonlndex:   Longlnt; begin 
    Buttonlndex   :=   1; 
    SendMessage(ToolBarl.Handle,   TB_DELETEBUTTON,   Buttonlndex,   0); end; 

       Tool Box ( ),   
       . 
        ,     
,   .    ( ) 
   TToolBar,    
TToolButtcns    Image List.     
  ,     Ima 
    ge List       \Delphi 3. 
0\Images\Buttons,       . 
  DragMode   dmAutomatic   BorderStyle 
  TToolBar  bsSingle. 


    156  II.   

        ToolBox     
,     .    
  TToolBar  . 

    procedure  TfrmToolBar.CameraClick(Sender:   TObject); begin 
    MessageDlg(You  clicked on the  +   (Sender  as  TToolButton).Name  + '   
Button.',   mtlnformation,    [mbOk],    0);end; 

           TToolBar  , 
-       .   
Visible   True, ,    ,    
.          
,            
  Onclick. 
     USRDEF1. PAS  USRDEF2 . PAS ( 7.7)   
  . 

     7.7. \UDELPHI3\CH7\TOOLBAR\USRDEF\USRDEF2. PAS.  
   

    unit UsrDef2; 
    interface 
    uses 
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
ToolWin, ComCtrls, StdCtrls; 
    type 
    TfrmUserForm = class(TForm) tbUserDefined: TToolBar; Label1: TLabel; 
procedure tbUserDefinedDragOver(Sender, Source: TObject; X, Y: Integer; 
    State: TDragState; var Accept: ''ø;" 
    procedure tbUserDefinedDragDrop(Sender, Source: TObject; X, Y: Integer); end; 
    var 
    frmUserForm: TfrmUserForm; 
    implementation uses UsrDefl; {$R *.DFM} 
    procedure TfrmUserForm.tbUserDefinedDragOver(Sender, %>Source: TObject; X, 
Y: Integer; 
    State: TDragState; var Accept: Boolean); begin 
    Accept := ((Sender <> Source) and (Source is TToolButton)); end; 
    procedure TfrmUserForm.tbUserDefinedDragDrop(Sender, 
    4>Source: TObject; X, Y: Integer); 
    const 
    Count: Smalllnt = 0; begin 
    with TToolButton.Create(Self) do begin 
    //     . 
    Parent := tbUserDefined; 
    //   . 
    //       , 
    //   ,   TToolBar, a 
    //    Images  TToolBar. 
    tbUserDefined.Images := TToolBar((Source as TToolButton).Parent).Images; 
    Imagelndex := (Source as TToolButton).Imagelndex; 


     7.    Win32 157 


    //    . 
    Name := 'New' + (Source as TToolButton).Name + 
    IntToStr(Count); 
    //   OnClick. OnClick := (Source as 
TToolButton).OnClick; Inc(Count); end; end; 
    end. 


    "" ,      

     ,   Cool Bar,   :  , 
      MS Internet ExplorerS.   
TCoolBar    TCoolBands,   , 
          
 .  TCoolBar        
 ,  ""       
   TCoolBar.  ,  Images,   
 TImage,     TCoolBand   
 . 

     Cool Band    

         TCoolBar   ,    
,      ,     
 Cool Bar.     Bands ().  
      Bands,     
    Control ,      
  .         :  
     Cool Bar     
      Control . 

         

       TCoolBand   ,  
  TCollectionltem.   Add   TCoolBar,  
   TCollectionltem.    
TCollectionltem,      TCoolBand.     
   ,    ,    
     ( )     . 
    procedure TForml.ButtonlCl.ick (sender:   TObject); var 
    CoolBand:   TCollectionltem; begin 
    CoolBarl.Images   :=  ImageListl; CoolBand   := CoolBarl.Bands.Add; with 
CoolBand as  TCoolBand do begin 
    Control   :=  Editl; Text   := Editl.Text; Bitmap   :=  Imagel. Picture 
.Bitmap/end ; end; 


     TDateTimePicker 

    TDateTimePicker      .  
TDateTimePicker     ,     
,  .      
  ,        .   
  Kind  dtDate  dtTime,  TDa teTimePicker  
     .   
      TUpDown.  
,  ,      
Date  Time  TDate  TTime . 

    158  II.   

     TDateTimePicker     
  ,   - ,    
   .   ,   
Parselnput  True        
OnUserlnput.   OnUserlnput      
 ,      ,   PDateTime . 
 ,    ,  AllowChange  
False. -1         
   ,    DateMode 
 dmUpDown  dmComboBox. 

     TAnimate 

    TAnimate   (AVI-)   ,    
   (thread)  .    
 AVI-    FileName  ResourcelD,   
    .      
 BMP-,   AV I-.   
 AVI     ,   FileName  -iT 
  Active  True.    "Cannot Open 
AVI" ("  AVI"), , ' AVI-    .  
    TMediaPlayer    .   
      TAnimate   ,  
    -**  Next Frame  Previous Frame. 
 Repetitions    .  
   Repetitions  -1,      
 . 
        Open, Close, Play, Seek  Stop.  Play 
    (    ) 
,    .      
  ,       .  
 -1     ,     
  .  Seek     . 

        

          
.     :      
      .  
     ,    
    Add.   TTabControl  TPageC ontrol    
    Windows   ,  
    . TTabControl  ,  
 Tabs [ ]; TPageControl    TTabSheet  
 . 

      " " 

           : 
          , 
       .   
       ,    
    , ,     
  . 

     SimplePanel 

            , 
  SimplePanel  True     
SimpleText  . 

    StatusBarl.SimplePanel   := True; 
    StatusBarl.SimpleText   :=   'a  simple  example'; 

      ,    ,     
    -Hint   TStatusBar, 
     ',    
     -  . 
,    Hint      
 ,    OnHint    
 OnCreate   . 

    type TForml = class (TForm) private 


     7.    Win32 159 


    procedure StatusHint(Sender: TObject); end; 
    procedure TForml.StatusHint(Sender: TObject); begin 
    StatusBarl.SimpleText := Application.Hint; 
    end; 
    procedure TForml.FormCreate(Sender: TObject); begin 
    StatusBarl.SimplePanel := True; 
    Application. OnHint := StatusHint; end; 


      

        ,      
     .      
          . 

       

          ( TStatusBar,   
SimplePanel   False),   Add "" 
 TStatusBar.  ,        TSta-tusPanel, 
  Add,    . 

    Procedure MyProc; var 
    Panel: TStatusPanel; begin Panel := StatusBarl.Panels.Add; 
    with ""         """............" 
    begin 
    Text   :=   'New  Panel'; Bevel   :=  pbLowered; Alignment   :=  taCenter; 
Width   :=   100; end; end; 

      7.8      
Panels.   ,   . 7.7,   
,     ,   
,     TUpDown,    
,    TRa-dioGroup    
     Alignment  Bevel  TButton,    .  
 ,    7.8, STSBAR1. PAS,   
  . 

    . 7.7.    

    . 7.8.       


    160  II.   


     7.8. \UDELPHi3\CHP7\STATUSBAR\STSBARi\STSi. PAS.  
  

    unit Stsl; interface 
    uses 
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
ComCtrls, StdCtrls, ExtCtrls, Buttons; 
    type 
    TForml = class(TForm) StatusBarl: TStatusBar; Buttonl: TButton; GroupBoxl: 
TGroupBox; rgAlignment: TRadioGroup; edPanelText: TEdit; Label!: TLabel; 
rgBevel: TRadioGroup; edPanelWidth: TEdit; Label2: TLabel; UpDownl: TUpDown; 
    procedure ButtonlClick(Sender: TObject); end; 
    var 
    Form!: TForml; 
    implementation 
    {$R *.DFM} 
    //________________________________________________________________________ 
    //       . 
    //-----------------------------------------------------------------------
    procedure TForml.ButtonlClick(Sender: TObject); const 
    BevelSettings: array[0..2] of TStatusPanelBevel = (pbNone, pbLowered, 
pbRaised); AligranentSettings: array[0..2] of TAlignment = (taCenter, 
taLeftJustify, taRightJustify); var 
    Panel: TStatusPanel; begin 
    Panel := StatusBarl.Panels.Add; 
    with Panel do 
    begin 
    Text := edPanelText.Text; 
    Bevel := BevelSettings[rgBevel.Itemlndex]; Alignment := 
AlignmentSettings[rgAlignment.Itemlndex]; Width := 
StrToInt(edPanelWidth.Text); end; end; 
    end. 


       

    ,  ,   Style     
 .       .  
   psText.     psOwnerDraw,  
  OnDrawPanel   TStatusBar,   
    TStatusBar,       
  . 


     7.    Win32 161 
    6  Delphi 3.   


    ,   7.9 ,     , 
  ,      (. 
7.8).    7.9    STS2 . PAS  
  . 

    I  7.9. \UDELPHI3\CHPT7\STATUSBAR\STSBAR2\STS2. PAS.  
      j A 

    unit sts2; 
    interface 
    uses 
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, ComCtrls, 
ExtCtrls, StdCtrls, Buttons; 
    type 
    TTextStyle = (spTextRaised, spTextLowered); 
    TForml = class(TForm) 
    StatusBarl: TStatusBar; 
    edPanelText; TEdit; 
    Labell: TLabel; 
    rgTextStyle: TRadioGroup; 
    procedure StatusBarlDrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel; 
const Rect: TRect); 
    procedure FormCreate(Sender: TObject); 
    procedure edPanelTextChange(Sender: TObject); 
    procedure Draw3DText(Canvas: TCanvas; PanelRect: TRect; Text: String; 
    TextStyle: TTextStyle); end; 
    var 
    Forml: TForml; 
    implementation {$R *.DFM} 
    procedure TForml. Draw3DText(Canvas: TCanvas; PanelRect: TRect; Text: String; 
    TextStyle: TTextStyle); begin 
    with Canvas do begin 
    Brush.Style := bsClear;        //  ,   . Font.Color := clHighlightText; 
    DrawText(Handle, PChar(Text), -1, PanelRect, DT_VCENTER  and DT_SINGLELINE ); 
    if (TextStyle = spTextRaised) then begin 
    Inc(PanelRect.Left); Inc(PanelRect.Top); end else begin 
    Dec(PanelRect.Left); Dec(PanelRect.Top); end; 
    Font.Color := clWindowText; 
    DrawText(Handle, PChar(Text), -I, PanelRect, DT_VCENTER  and 
DT_SINGLELINE); end; end; 


    162  //.   


    procedure TForml.StatusBarlDrawPanel(StatusBar: TStatusBar; 
    Panel: TStatusPanel; const Rect: TRect); var 
    PanelRect: TRect; begin 
    Panel.Text := edPanelText.Text; PanelRect := Rect; with PanelRect do 
    Left := Left + Canvas.TextWidth('W); if rgTextStyle.Itemlndex = 0 then 
    Draw3DText(StatusBar.Canvas, PanelRect, Panel.Text, spTextRaised) else 
    Draw3DText(StatusBar.Canvas, PanelRect, Panel.Text, spTextLowered) end; 
    procedure TForml.FormCreate(Sender: TObject); var 
    Panel: TStatusPanel; begin 
    Panel := StatusBarl.Panels.Add; 
    Panel.Style := psOwnerDraw; end; 
    procedure TForml.edPanelTextChange(Sender: TObject); begin 
    StatusBarl.Refresh; end; 
    end. 

      OnDrawPanel,     
TStatusBar (   )   .     
 Canvas   TStatusBar     
        . 
           ,    
   . ,     
  TImage,   Picture  
       , 
     Windows 95. 
    ,   . 7.9,      
 ,        . 

    . 7.9.    


     7.    Win32 163 

            
( 7.10).        
  TStringList,       ImageList   
,     API Imagelist_AddIcon (COMMCTRL. 
PAS).   Im-agelist_Add!con    ImageList  
,       API,  Extractlcon 
(SHELLAPI. PAS).  Extractlcon   ,  
,  ,   : 

    Imagelist_AddIcon(Imagelist.Handle,   Extractlcon(Handle,   
PChar(ExeList[i]),   0}); 

     TImageList  TStringList     
Displaylconlmages      , 
    TImages.  Displaylconlmages   
  ImageList,     TImage   
.   TImage     ,     
   ,   Hint  
TStringList        
 Onclick,         
 . 
     "  "    ,  
     .   
       ,  
   ,    ,  
       .  
ACTBAR1. PAS     . 

        7.10. \UDELPHI3\CH7\STATUSBAR\ACTBAR1. PAS.   
  

    unit ActBarl; 
    interface 
    uses 
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
ComCtrls, ExtCtrls, StdCtrls, Buttons; 
    type 
    TForml = class(TForm) 
    StatusBarl: TStatusBar; 
    procedure FormCreate(Sender: TObject); private 
    procedure StatusIconClick(Sender: TObject); 
    procedure Displaylconlmages(ImageList: TImageList; ExeNameList: TStringList; 
    WinControl: TWinControl); end; 
    var 
    Forml: TForml; 
    implementation 
    {$R *.DFM} 
    uses ShellAPI, CommCtrl; 
    procedure TForml.StatusIconClick(Sender: TObject); begin 
    WinExec(PChar((Sender as TImage).Hint), SW_ShowNormal); end; 
    procedure TForml.Displaylconlmages(ImageList: TImageList; ExeNameList: TStringList; 
    WinControl: TWinControl); var 
    IconLeft: integer; 
    i: integer; begin 
    IconLeft := ImageList.Width div 2; 
    for i := 0 to ImageList.Count - 1 do with TImage.Create(Self) do 


    164  II.   


    begin 
    Parent : = ^[inCon^trol.^ 
    ffint~T= ExeNameList.Strings[i]; 
    ShowHint := True; 
    OnClick := StatusIconClick; 
    Top := (WinControl.Height - ImageList.Height) div 2; 
    Left := IconLeft; 
    Width := ImageList.Width; 
    Height := ImageList.Height; 
    IconLeft := IconLeft + Width + 5; 
    Canvas.Brush.color := StatusBarl.Brush.Color; 
    Canvas.FillRect(Canvas.ClipRect); 
    ImageList.Draw(Canvas, 0, 0, i) ; end; end; 
    procedure TForml.FormCreate(Sender: TObject); const 
    ExeList: array[0..9] of String = ( 
    1CALC.EXE', 
    'CLIPBRD.EXE1 , 
    'NOTEPAD.EXE', 
    'REGEDIT.EXE', 
    'PBRUSH.EXE', 
    1SYSMON.EXE', 
    'DEFRAG.EXE', 
    'EXPLORER.EXE', 
    1 TELNET.EXE', 
    1 TERMINAL.EXE' 
    ); 
    var 
    StringList: TStringList; ImageList: TImageList; i: integer; begin 
    StringList := TStringList.Create; ImageList := TImageList.Create(Self); try 
    for i := 0 to 9 do begin 
    Imagelist_AddIcon(ImageList.Handle, Extractlcon(Handle, PChar(ExeList[i]), 
0) StringList.Add(ExeList[i]); end; 
    Displaylconlmages(ImageList, StringList, StatusBarl); finally 
    StringList.Free; ImageList.Free; end; end; 
    end. 


      Header 

         ,   
  ,      ,   
TStatusBar.    ,     
   .    TStatusBar,  
THeaderControl   Sections  Panels.   ,  
  Sections,   OnSectionClick, OnSectionResize  
OnSectionTrack  THeaderControl. 
          ,    
    Sections     Add 
 .   THeaderSection   , 
       . 
       ,   Sections.Add  
   THeaderSection ( 7.11).  SECCRT1. PAS 
    . 


     7.    Win32 165 


     7.11. \UDELPHI3\CH7\HEADERCONTROL\SECTIONCREATE\SECCRT1.PAS. 
         

    unit' SecCrtl;................    ............................................................................................................" 
    interface 
    uses 
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls; 
    type 
    TForml = class(TForm) 
    HeaderControll: THeaderControl; 
    procedure FormCreate(Sender: TObject); private 
    {  . } public 
    {  . } end; 
    var 
    Forml: TForml; 
    implementation ($R *.DFM} 
    procedure CreateSections(HeaderControl: THeaderControl; SectionText: array 
of string); var 
    I: integer; 
    HS: THeaderSection; begin 
    for I := Low(SectionText) to High(SectionText) do 
    begin 
    HS := HeaderControl.Sections.Add; HS.Text := SectionText[I]; 
    end; end; 
    procedure TForml.FormCreate(Sender: TObject); begin 
    CreateSections(HeaderControll, ['one', 'two', 'three', 'four']); end; 
    end. 

          .    
Style  hsOwnerDraw  ,      
OnDrawSection. ,   . 7.10, ,   
   ImageList       ( 7.12). 
   ,    .  SECDRW1. PAS 
    . 

    . 7.10.  Owner Draw Header Control    


     7.12. \UDELPHi3\CHP7\HEADERCONTROL\ONSECTiONDRAW\ SECDRW1.PAS. 
    

    unit SecDrwl; 
    interface 
    uses 


    166  .   


    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls; 
    type 
    TForml = class(TForm) 
    HeaderControll: THeaderControl; 
    ImageListl: TImageList; 
    procedure HeaderControllDrawSection(HeaderControl: THeaderControl; 
    Section: THeaderSection; const Rect: TRect; Pressed: Boolean); end; 
    var 
    Forml: TForml; 
    implementation {$R *.DFM} 
    procedure TForml.HeaderControllDrawSection(HeaderControl: THeaderControl; 
    Section: THeaderSection; const Rect: TRect; Pressed: Boolean); begin 
    with HeaderControl.Canvas do if Pressed then begin 
    Font.Color := clRed; 
    ImageListl.Draw(HeaderControl.Canvas, Rect.Left + 2, Rect.Top + 2, 0); 
TextOut(Rect.Left + ImageListl.Width + 4, Rect.Top + 2, Section.Text); end 
else begin 
    Font.Color := clBlue; 
    TextOut(Rect.Left + ImageListl.Width + 4, Rect.Top + 2, Section.Text); 
end; end; 
    end. 

     THeaderControl    : OnSectionTrack  
OnSectionResize.  OnSectionTrack ,   
 .    ,  
 OnSectionResize.         
,       ,  
TListBoxes,     . 

      Image List 

    Image List    ,    
TComponent,     ,     
 .   Win95  TImageList  
 . 
              
 TImageList       
 ,   TTreeView, TListView, TToolBar  TCoolBar. 
, TListView    Smalllmages,    
Largelmages,     TImageList,    
      .  TImageList 
    ,      
          
 . 
          (Common Controls DLL 
(4.0)),    Internet Explorer 3.0,  
 Image List.  , , -      
    Header,   
    ,   
    . 

     7.    Win32 167 


    ImageList    

         ImageList,     
.        TTreeView. 
  Images  TTreeView  ImageListl.  
  Items      ,   
  TTreeView. 
       New Item     (. 7.11).  
   ,   .      
,    New Subltem   .   
   Image Index  1.   , 
         . 
         TlimageList,   
 ImageList.        
 ;       . 
   ,      
.    Add,   \DELPHI3\ 
    IMAGES\BUTTONS         ABORT.BMP. 
     ALARM. BMP.       
 ("separate into 2 separate bitmaps?" ("  2  
?"))    No.   Options   Crop. 
      ,    
 TTreeView,      (. 7.12).  
    ABORT. BMP,   
ALARM. BMP.        
   . 

    . 7.11.   TTreeView 

    . 7.12. TTreeView    

     TImageList    .     
    Win95,    Image List. 
   ,     TImageList   . 

        TImageList 

         16x16 ,   
     ,   ,  
 .   CreateSize      
,        
.   CreateSize   Get-Bitmap   
     ,     ,  
       (. 7.13). 

    . 7.13.    


    168  II.   

               
  Image List ,        , 
     .     
           
   TCanvas.       
 ,      . 

    type TForml   =  class    (TForm) 
     private 
    DeskTopCanvas:   TCanvas; end; 

     ,    OnCreate   , 
        . 

    //       , procedure  
TForml.FormCreate(Sender:   TObject); begin 
    DeskTopCanvas   :=  TCanvas.Create; 
    DeskTopCanvas.Handle   :=  GetDC(Hwnd_Desktop); end; 

    Hwnd_Desktop   ,    WINDOWS . PAS, 
   .  Hwnd_Desktop    
 ,       . 
    ,        TCanvas, 
     ,      TImageList. 
     ,   
            . 
    procedure  TForml.ButtonlClick(Sender:   TObject); begin 
    DeskTopCanvas.TextOut(0,0,'        howdy world'); end; 
      ,   ,       
  .       : 
                Image List; 
    *        Image List; 
            . 
          
  ,        . 
       ,     ,  
   ,    Align   alTop  
 BevelOuter   bvLowered.    
TImage      Align  alClient.   
  Speed Button    Image List, TEdit  TUpDown. 
  Associate  TUpDown  Editl,   
  .  VIDEO.BMP      Speed 
Button. 
          .  
     Image List   16x16 , 
  CreateSize,   Image List    
    .   ,     
    ;    OnCreate   
  . 

    procedure  TForml.FormCreate(Sender:   TObject); begin 
    //            . 
    DeskTopCanvas := TCanvas.Create; 


     7.    Win32 169 


    //     ImageList     . 
ImageListl.CreateSize(Screen.Width,   Screen.Height); end; 

         Image    
,        
.         
 . 

    procedure  TForml.Refreshlmage(X,   Y:   Smalllnt); begin 
    Image1.Canvas.FiliRect(Image1.Canvas.ClipRect); 
    ImageListl.Draw(Imagel.Canvas,   X,   ,   UpDownl.Position); 
    Imagel.Refresh-end; 

            ,  
   CopyRect  DeskTopCanvas.     
  Image List      
  TUpDown     , 
  Image List.  ,     
 Ref reshlmage. 

    procedure TForml.SpeedButtonlClick(Sender: TObject); begin 
    BitMap := TBitMap.Create; 
    DeskTopCanvas.Handle := GetDC(Hwnd_Desktop); 
    try 
    //       
    //        . 
    BitMap.Width := Screen.Width; 
    BitMap.Height := Screen.Height; 
    Bitmap.Canvas.CopyRect(Bitmap.Canvas.ClipRect, 
    DeskTopCanvas, DeskTopCanvas.ClipRect ) ; 
    //    Image List. 
    ImageListl.Add(BitMap, nil); 
    //     TUpDown. 
    UpDownl.Max := ImageListl. Count - 1; 
    UpDownl.Position := UpDownl.Max; 
    UpDownl.Invalidate; 
    //     Image List    Image. 
    Refreshlmage(0,0) ; 
    finally 
    ReleaseDC(Handle, Hwnd_Desktop); 
    BitMap.Free; 
    end; end; 

          :    OnClick 
  TUpDown,   Ref reshlmage,   
  DeskTopCanvas,   . 
         ,   
    ,     Mouse Is Down 
           
OnMouseMove.     ImgX  ImgY,    
            
  TImage. 
      TImage       
,     . 

    type TForml  =  class   (TForm) 
    private 
    DeskTopCanvas: TCanvas; 
    BitMap: TBitMap; 
    ImgX, ImgY: Smalllnt; 
    MouselsDown: Boolean; 
    procedure Refreshlmage(X, Y: Smalllnt); 


    170  II.   

    end; 
    implementation   {$R  *.DFM} const crHandOpen =  1   ; 

         OnCreate ,   
   ,  . 

    //        , 
    //   ,        . 
    Screen.Cursorstc[HandOpen]    :=  LoadCursorFromFile(   'HandFlat.cur'   ) 
  ; 
    Imagel.Cursor   :=  crHandOpen; 

        7.13    ,  
  ,       
.  SCRCAP1. PAS     . 

    |  7.13. \UDELPHI3\CHP7\IMAGELIST\SCRCAP\SCRCAP1.PAS.  
   imageList 

    unit ScrCapl; interface 
    uses 
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
ExtCtrls, StdCtrls, Buttons, ComCtrls; 
    type 
    TForml = class(TForm) 
    ImageListl: TImageList; 
    SpeedButtonl: TSpeedButton; 
    Editl: TEdit; 
    UpDownl: TUpDown; 
    Panell: TPanel; 
    Imagel: Image; 
    Labell: TLabel; 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
    procedure SpeedButtonlClick(Sender: TObject); 
    procedure UpDownlClick(Sender: TObject; Button: TUDBtnType); 
    procedure ImagelMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); 
    procedure ImagelMouseUp(Sender: TObject; Button: TMouseButton; Shift: 
TShiftState; X, Y: Integer); 
    procedure ImagelMouseDown(Sender: TObject; Button: TMouseButton; 
    Shift: TShiftState; X, Y: Integer); private 
    DeskTopCanvas: TCanvas; BitMap: TBitMap; 
    ImgX, ImgY: Smalllnt; 
    MouselsDown: Boolean; 
    procedure Refreshlmage(X, Y: Smalllnt); end; 
    var 
    Forml: TForml; 
    implementation {$R *.DFM} 
    const 
    crHandOpen = 1; 
    { 

      ,       Image 


     7.    Win32 171 

      . } 

    procedure TForml.Refreshlmage(X, Y: Smalllnt); begin 
    Imagel.Canvas.FillRect(Imagel.Canvas.ClipRect); 
    ImageListl.Draw(Imagel.Canvas, X, Y, UpDownl.Position); 
    Imagel.Refresh; end; 
    procedure TForml.FormCreate(Sender: TObject); begin 
    //      . DeskTopCanvas := TCanvas.Create; 
    //   ImageList   . 
ImageListl.CreateSize(Screen.Width, Screen.Height); 
    Screen.Cursors[crHandOpen] := LoadCursorFromFile('HandFlat.cur'); 
Imagel.Cursor := crHandOpen; end; 
    procedure TForml.FormDestroy(Sender: TObject); begin 
    DeskTopCanvas.Free; end; 
    procedure TForml.SpeedButtonlClick(Sender: TObject); begin 
    Visible : = False; BitMap := TBitMap.Create; 
    DeskTopCanvas.Handle := GetDC(Hwnd_Desktop); try 
    //         
    //     . 
    BitMap.Width := Screen.Width; 
    BitMap.Height := Screen.Height; 
    Bitmap.Canvas.CopyRect(Bitmap.Canvas.ClipRect, 
    DeskTopCanvas, DeskTopCanvas.ClipRect); //     Image 
List. ImageListl.Add(BitMap, nil); 
    //    Update,     . 
    UpDownl.Max := ImageListl.Count - 1; UpDownl.Position := UpDownl.Max; UpDownl.Invalidate; 
    //     Image List    Image. 
ImgX := 0; ImgY := 0; Refreshlmage(0, 0); finally 
    ReleaseDC(Handle, Hwnd_Desktop); BitMap.Free; Visible := True; end; end; 
    procedure TForml.UpDownlClick(Sender: TObject; Button: TUDBtnType); begin 
    Refreshlmage(0, 0); end; 
    procedure TForml.ImagelMouseMove(Sender: TObject; Shift: TShiftState; X, 
    Y: Integer); const 
    LastX: Smalllnt = 0; 
    LastY: Smalllnt = 0; 



    172  II.   


    begin 
    if MouselsDown and (ImageListl.Count > 0) then begin 
    if X > LastX then 
    ImgX := ImgX + (X - LastX) else if X < LastX then 
    ImgX := ImgX - (LastX - X); if Y > LastY then 
    ImgY := ImgY + (Y - LastY) else if Y < LastY then 
    ImgY := ImgY - (LastY - Y); Refreshlmage(ImgX, ImgY); end; 
    LastX := X; LastY := Y; end; 
    procedure TForml.ImagelMouseUp(Sender: TObject; Button: TMouseButton; 
    Shift: TShiftState; X, Y: Integer); begin 
    MouselsDown := False; end; 
    procedure TForml.ImagelMouseDown(Sender: TObject; Button: TMouseButton; 
    Shift: TShiftState; X, Y: Integer); begin 
    MouselsDown := True; end; 
    end. 

      Tab 

      Tab (),  TPageControl,   
TCustomTabControl. TTab-Control      
 ,      .  
  Tab,        , 
        ,   
  TPageControl.  TTabControl ,  TPageControl,  
TTabControl   ,      . 

      

          Tabs.    
   ,    Tabs.  
 Tabs   TStrings,  ,     
  .  Tablndex     . 

     

      Tabindex  -1 ,     
 ;   ,    "EList error... 
tab control access error." (" EList...     
 .").   ,      
,           
 . 
         Tabs,  
  (. 7.14).     TTabControl,  
 TEdit    Bit Buttons.    "Add", 
"Insert"  "Delete"    bbAdd, bblnsert  bbDelete.  
  Onclick        ,  
   7.14.  TCI. PAS    
 . 

     7.    Win32 173 


        

     TabWidth  TabHeight     
 .       ,  
TabHeight  TabWidth    ,  .    
TabWidth  TabHeight  ,   ,    . 
    MultiLine  ,    ,  
       Tab.  MultiLine 
 False,   ,    
 ,   ,    . 
 MultiLine  True,         
     Tab (. 7.15). 

    . 7.14. ,        

    . 7.15.   Tab    MultiLine, 
TabWidth  TabHeight 

     7.14. \UDELPHi3\CHP7\TABCONTROL\ADDiNSRT\TCl. PAS. , 
       

    unit TCI; interface 
    uses 
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
StdCtrls, Buttons, ComCtrls; 
    type 
    TForml = class(TForm) 
    Editl: TEdit; 
    bbAdd: TBitBtn; 
    bblnsert: TBitBtn; 
    bbDelete: TBitBtn; 
    TabControll: TTabControl; 
    procedure bbAddClick(Sender: TObject); 
    procedure bblnsertClick(Sender: TObject); 
    procedure bbDeleteClick(Sender: TObject}; end; 
    var 
    Forml: TForml; 
    implementation {$R *.DFM} 
    procedure TForml.bbAddClick(Sender: TObject); begin 
    TabControll.Tabs.Add(Editl.Text); end; 


    174  II.   

    procedure TForml.bblnsertClick(Sender: TObject); begin if 
(TabControll.Tablndex <> -1) then 
    TabControll.Tabs.Insert(TabControll.Tablndex, Editl.Text); end; 
    procedure TForml.bbDeleteClick(Sender: TObject); begin if 
(TabControll.Tablndex <> -1) then 
    TabControll.Tabs.Delete(TabControll.Tablndex) ; end; 
    end. 


       Tab 

      Tab    .    
OnChanging.  Allow-Change  OnChanging  ,  
          
. ,  ,      
    . 

    procedure  TForml.TabControllChanging(Sender:   TObject; 
    var AllowChange:   Boolean); begin 
    AllowChange   :=   (Editl.Text   <>   '    '); end; 

    ,   ,   OnChange.  
  ,   ,     
  ,      
Tablndex. 

         Tab 

             
   Tab.   ,  . 

           Tab 

      Tab   ,    
   ,   DisplayRect, , 
 , ,      ,     . 
  ,       ,    
 Tab  .   ,  ,   
 TImage    Tab     Canvas 
  TImage. 
     ,     . TTabControl  
 Handle,      GetDC. ,   
,    TCanvas   ,   
GetDC  Handle  Canvas ( 7.15).  TCDRAW1. PAS  
   . 

     7.15. \UDELPHI3\CHPT7\TABCONTROL\PAINT\TCDRAW1. PAS.   TabControl 

    unit  TCDrawl; 
    interface 
    uses 
    Windows,   Messages,   SysUtils,   Classes,   Graphics,   Controls,   
Forms,   Dialogs, ComCtrls,   ExtCtrls,   StdCtrls; 
    type 
    TForml = class(TForm) 
    TabControll: TTabControl; 
    procedure TabControllChange(Sender: TObject); private 
    {  . } 


     7.    Win32 175 


    public 
    {  . } end; 
    var 
    Forml: TForml; 
    implementation {$R *.DFM} 
    procedure TForml.TabControllChange(Sender: TObject); var 
    Canvas: TCanvas; begin 
    Canvas := TCanvas.Create; try 
    Canvas.Handle := GetDC((Sender as TTabControl).Handle) ; try 
    Canvas.Font.Color := clRed; 
    with (Sender as TTabControl), DisplayRect do 
    begin 
    Canvas.Brush.Color := clWhite; 
    Canvas.FillRect(DisplayRect); 
    Canvas.TextOut((Right - Canvas.TextWidth(Tabs[Tablndex])) 
    div 2, Bottom div 2, Tabs[Tablndex]) ; end; finally 
    ReleaseDC((Sender as TTabControl).Handle, Canvas.Handle) ; end; finally 
    Canvas.Free; end; end. 

           Tab  
   ,     OnDraw 
  Canvas  .  , ^    ,     
  ,      GetDC  
   Handle   

         

             TTabControl? 
,            
   .        ,   
 ,    .    
 BoundRect, Clien-tRect  DisplayRect.    TRect   
,     TTabControl  . 
    Delphi      ,    
    ,     
 .       Windows API TCM_GETITEMRECT 
     ,  
 .       
 : 

    SendMessage(TabControll.Handle,   TCM_GETITEMRECT,   Tablndex,   Longlnt(@TCRect)); 

     SendMessage      , 
  TCM_GETITEMRECT (  COMMCTRL. PAS),  
     TRect.      
?~"  ,       
    . 
        Tab,  
THilightTabControl,       
,    ( 7.17).  , 
    Windows WM_PAINT,   - 
,  OnChange.        
    ,       
  ,       .   
,    7.16 (HLTABC1. PAS),   
  . 

    176  IL   


     7.16. \UDELPHI3\CHPT7\TABCONTROL\HILITE\HLTABC1.PAS.  
    THilightTabControl 

    unit HLTabCl; interface 
    uses 
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls; 
    type 
    THilightTabControl = class(TTabControl) 
    private 
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;   { end; 
    procedure Register; implementation uses CommCtrl; 
    procedure THilightTabControl.WMPaint(var Message: TWMPaint); var 
    InnerRect, TCRect: TRect; Canvas: TCanvas; begin 
    Inherited; 
    SendMe~ssage (Handle, TCM_GETITEMRECT, Tablndex, Longlnt(@TCRect)); 
    Canvas := TCanvas.Create; 
    try 
    with TCRect do 
    InnerRect := RectfLeft + 6, Top + 2, Right - 6, Bottom - 2); Canvas.Handle 
:= GetDC(Handle); Canvas.Font.Color := clRed; Canvas.Brush.Color := clBtnFace; 
    Canvas.TextOut(InnerRect.Left, InnerRect.Top, Tabs[Tablndex]); finally 
    Canvas.Free; end; end; 
    procedure Register; begin 
    RegisterComponents('UDelphi3', [THilightTabControl]); end; 
    end. 


      Page 

     TPageControl  TTabControl     
TCustomTabControl        . 
MultiLine, TabHeight, TabWidth, OnChange  OnChanging     
 . TPageControl, ,    Tab 
Sheets,  ,   ,      
    ,      
 Tab. 

     7.    Win32 177 


          

      TPageControl  ,     
  ,        TTabControl. 
  ,  Tab Sheets ( Pages  ) , ,  
 ,       Page  
  PageControl  Tab Sheets.  
     Tab Sheets    Page    
   TTabSheet,    Pages.  ,  
   Page   Tab Sheet ( ), 
 PageCount . 
      Tab Sheet   ,     
  Page   New Page   .  
           . 

          

         Tab Sheet    Page, 
     TTabSheet,    
  PageControl. 

    //     5  Tab  Sheets    PageControll. procedure 
TForml.FormCreate(Sender:   TObject); var 
    i:   integer; begin 
    for  i   :=   0   to   4   do 
    with  TTabSheet.Create(Self)   do begin 
    PageControl   :=  PageControll; Caption   :=   'TabSheet'   +  
IntToStr(i); end; end; 

      7.17       , 
    (. 7.16).   ,  
  Page  Forml    Align  alClient. 
  File^New^Data Modules    CustomerData  
.     Forml    ,   
,    OnCreate. ,      
DB, DBTables  DBGrids   uses,         unit. 

    . 7.16.  Tab Sheet      

      Project^Options   CustomerData  ^ 
  Auto-Create,  Forml.     , 
     ~~  " , 
   . 

    178  II.   


    I  7.17. \UDELPHI3\CHP7\PAGECONTROL\PC1\PCART1. PAS.  Tab 
Sheet    

    unit PCCrtl; 
    interface 
    uses 
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls; 
    type 
    TForml = class(TForm) 
    PageControll: TPageControl; 
    procedure FormCreate(Sender: TObject); private 
    {  . } public 
    {  . } end; 
    var 
    Forml: TForml; 
    implementation ($R *.DFM} 
    uses 
    PCCrt2, //   CustomerData. DB, DBTables, DBGrids, DBCtrls, ExtCtrls; 
    procedure TForml.FormCreate(Sender: TObject); var 
    i: integer; 
    CurrentDataSrc: TDataSource; CurrentTab: TTabSheet; CurrentPanel: TPanel; 
CurrentCount: Longlnt; begin 
    //       . 
    CurrentCount := CustomerData.ComponentCount - 1; 
    //      -  . 
    for i := 0 to CurrentCount do 
    //    ,  . 
    if (CustomerData.Components[i] is TDataSource) then 
    begin 
    //     . CurrentDataSrc := 
TDataSource(CustomerData.Components[i]); with TTabSheet.Create(Self) do 
    //     Pages PageControl. 
    PageControl := PageControll; 
    //    . 
    CurrentTab := PageControll.Pages[PageControll.PageCount - 1] ; 
    //     TTable,     . 
    if (CurrentDataSrc.DataSet is TTable) then 
    CurrentTab.Caption := TTable(CurrentDataSrc.DataSet).TableName; with 
TPanel.Create(Self) do begin 
    Parent := CurrentTab; Align := alTop; Caption := ' ' ; 
    CurrentPanel := Forml.Components[Forml.ComponentCount - 1] as TPanel; with 
TDBNavigator.Create(Self) do begin 


     7.    Win32 179 


    Parent := CurrentPanel; DataSource := CurrentDataSrc; end; end; 
    //     , with TDBGrid.Create(Self) do begin 
    Parent := CurrentTab; Align := alClient; DataSource := CurrentDataSrc; 
CurrentDataSrc.DataSet.Open; end; 
    end; end; 
    end. 

      

    ,         
    .      ?  
       , 
 CurrentPanel.     ,  
  ,    ,     
  ,     . 

    CurrentPanel   :=  Forml.Components[Forml.ComponentCount   -   1]   as   TPanel; 
    with TDBNavigator.Create(Self)   do 
    begin 
    Parent   := CurrentPanel; 
    DataSource   :=  CurrentDataSrc; end; 

         , ,     
   ,  .     
  ,    ,   
 CurrentTab,      
Pages [ ]  PageControl. 

       

     ActivePage  TTabSheet      
 ,     . ActivePage  ,  
  TTabSheet.          
 ,   SelectNextPage.   
          
,   FindNextPage. 
      7.18     .   
,    Pagelndex, Tablndex  Visible (. 7.17).  
ACTPAG1. PAS     . 

    . 7.17.   


    180  II.   

    Pagelndex ,   TTabSheet   Pages [ ]. 
       ,    Visible  ,  
 !    ,    .  
 ,      ,      
Visible  TabVisible. Visible      
  Tab Sheet, TabVisible      Tab 
Sheet. Tablndex        Tab Sheets. 

    \    7.18. \UDELPHI3\CHP7\PAGECONTROL\ACTPAGE\ACTPAG1. PAS. 
  

    unit ActPagl; 
    interface 
    uses 
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
StdCtrls, Buttons, ComCtrls; 
    type 
    TForml = class(TForm) 
    Editl: TEdit; 
    UpDownl: TUpDown; 
    Label1: TLabel; 
    ListBoxl: TListBox; 
    Label2: TLabel; 
    BitBtnl: TBitBtn; 
    BitBtn2: TBitBtn; 
    Label4: TLabel; 
    PageControll: TPageControl; 
    CheckBoxl: TCheckBox; 
    CheckBox2: TCheckBox; 
    LabelS: TLabel; 
    IblTablndex: TLabel; 
    procedure PageControllChange(Sender: TObject); 
    procedure UpDownlClick(Sender: TObject; Button: TUDBtnType); 
    procedure FormCreate(Sender: TObject); 
    procedure ListBoxlClick(Sender: TObject); 
    procedure BitBtnlClick(Sender: TObject); 
    procedure BitBtn2Click(Sender: TObject); 
    procedure CheckBoxlClick(Sender: TObject); 
    procedure CheckBox2Click(Sender: TObject); end; 
    var 
    Forml: TForml; 
    implementation {$R *.DFM} Uses ExtCtrls; 
    procedure TForml.PageControllChange(Sender: TObject); begin 
    UpDownl.Position := PageControll.ActivePage.Pagelndex; 
    IblTablndex.Caption := IntToStr(PageControll.ActivePage.Tablndex); 
    CheckBoxl.Checked := PageControll.ActivePage.TabVisible; 
    CheckBox2.Checked := PageControll.ActivePage.Visible; end; 
    procedure TForml.UpDownlClick(Sender: TObject; Button: TUDBtnType); begin 
    PageControll.ActivePage.Pagelndex := UpDownl.Position; end; 
    procedure TForml.FormCreate(Sender: TObject); 


     7.    Win32 181 


    var 
    i: integer; begin 
    for i := 0 to 9 do 
    with TTabSheet.Create(Self) do begin 
    PageControl := PageControll; 
    TabVisible := i mod 2 = 0; 
    Name := 'TabSheet' + IntToStr(i); 
    Caption := 'Pagelndex = ' + IntToStr(Pagelndex) + 
    '  Tablndex := ' + IntToStr(Tablndex); with TPanel.Create(Self) do begin 
    Parent := PageControl.Pages[PageControl.PageCount - 1]; Align := alClient; 
    Caption := 'Setting Visible Off Hides This Panel1; end; end; 
    with PageControll do begin 
    UpDownl.Max := PageCount - 1; for i := 0 to PageCount - 1 do 
    ListBoxl.Items.AddObject(Pages[i].Name, TObject(Pages[i])); end; end; 
    procedure TForml.ListBoxlClick(Sender: TObject); begin 
    with ListBoxl do 
    if Itemlndex <> -1 then 
    PageControll.ActivePage := Items.Objects[Itemlndex] as TTabSheet; 
PageControllChange(Sender); end; 
    procedure TForml.BitBtnlClick(Sender: TObject); begin 
    PageControll.SelectNextPage(False); end; 
    procedure TForml.BitBtn2Click(Sender: TObject); begin 
    PageControll.SelectNextPage(True) end; 
    procedure TForml.CheckBoxlClick(Sender: TObject); begin 
    PageControll.ActivePage.TabVisible := CheckBoxl.Checked; 
    PageControllChange(Sender); end; 
    procedure TForml.CheckBox2Click(Sender: TObject); begin 
    PageControll.ActivePage.Visible := CheckBox2.Checked; 
    PageControllChange(Sender); end; 
    end. 


      drag-and-drop  Tab Sheet 

            Page,   
     .    
  ^.^^^^^ 
        ,  PageControl    
  DragOver,        
TTabSheet.    PageControl  ,   ,  . 

    182  II.   

       Tab Sheets,      
,        
OnMouseDown, OnDragOver  OnDragDrop.      
  Tab Sheet     ,   
         . 
         Tab Sheets,      
  PARTS. DB (. 7.18).    ,  
 ,  DataBaseName    DBDemos,  
 Table  PARTS . DB, a Active  True.  ,    
   TPageControl.       
    CreateDragTabSheet (  ). 

    procedure  TabSheetMouseDown   (Sender:   TObject;   Button:   TMouseButton; 
    Shift:   TShiftState;   X,   Y:   Integer); procedure 
TabSheetDragOver(Sender,   Source:   TObject;   X,   Y:   Integer; 
    State:   TDragState;   var Accept:   Boolean); 
    procedure  TabSheetDragDrop(Sender,   Source:   TObject;   X,   Y:   
Integer); function  CreateDragTabSheet(APageControl:   TPageControl):   TTabSheet; 

      OnCreate      ,  
     ( 7.19).  DRAG1. PAS 
    . 

    . 7.18.     

     7.19. \UDELPHI3\CHP7\PAGECONTROL\PC2\DRAG1. PAS.  Tab 
Sheets    Page 
    unit Dragl; interface 
    uses 
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
ComCtrls, StdCtrls, Mask, DBCtrls, Db, DBTables; 
    type 
    TForml = class(TForm) 
    PageControll: TPageControl; PageControl2: TPageControl; Tablel: TTable; 
TablelPartNo: TFloatField; TablelVendorNo: TFloatField; TableIDescription: 
TStringField; TablelOnHand: TFloatField; TablelOnOrder: TFloatField; 
TablelCost: TCurrencyField; TablelListPrice: TCurrencyField; procedure 
FormCreate(Sender: TObject); 


     7.    Win32 183 


    public 
    procedure TabSheetMouseDown(Sender: TObject; Button: TMouseButton; 
    Shift: TShiftState; X, : Integer); procedure TabSheetDragOver(Sender, 
Source: TObject; X, Y: Integer; 
    State: TDragState; var Accept: Boolean); 
    procedure TabSheetDragDrop(Sender, Source: TObject; X, Y: Integer); 
function CreateDragTabSheet(APageControl: TPageControl): TTabSheet; end; 
    var 
    Forml: TForml; 
    implementation ($R *.DFM} 
    // ,    . 
    //     TTabSheet, 
    //   -. 
    procedure TForml.TabSheetMouseDown(Sender: TObject; Button: TMouseButton; 
    Shift: TShiftState; X, Y: Integer); var 
    CurrentTab: TTabSheet; begin 
    if Button = mbLeft then begin 
    if (Sender is TTabSheet) then 
    CurrentTab := (Sender as TTabSheet) else 
    CurrentTab := (Sender as TLabel).Parent as TTabSheet; if 
CurrentTab.PageControl.PageCount > 1 then 
    CurrentTab.BeginDrag(True); end; end; 
    //    TTabSheet,  
    //  ,    
    //    . 
    procedure TForml.TabSheetDragOver(Sender, Source: TObject; X, Y: Integer; 
    State: TDragState; var Accept: Boolean); begin 
    Caption := 'Source: ' + (Source as TComponent).Name + 
    '  Drag Target: ' + (Sender as TComponent).Name; 
    if Sender <> Source then 
    Accept := true; end; 
    procedure TForml.TabSheetDragDrop(Sender, Source: TObject; X, Y: Integer); var 
    PCSource, PCTarget: TPageControl; 
    DraggedPage: TTabSheet; begin 
    //        
    //    . 
    if (Sender is TTabSheet) then 
    PCTarget := (Sender as TTabSheet).PageControl 
    else 
    PCTarget := ((Sender as TLabel).Parent as TTabSheet).PageControl; 
    DraggedPage := (Source as TTabSheet); 
    PCSource := DraggedPage.PageControl; 
    //    Tab Sheet. 
    DraggedPage.PageControl := PCTarget; 
    //       . 
    PCTarget.ActivePage := DraggedPage; 


    184  II.   


    PCSource.ActivePage := PCSource.Pages[0]; end; 
    function TForml.CreateDragTabSheet(APageControl: TPageControl): TTabSheet; begin 
    Result := TTabSheet.Create(Self); 
    with Result do 
    begin 
    PageControl := APageControl; OnMouseDown := TabSheetMouseDown; OnDragOver 
:= TabSheetDragOver; OnDragDrop := TabSheetDragDrop; end; end; 
    procedure TForml.FormCreate(Sender: TObject); var 
    Fids, Indent, i: integer; CurrentTab: TTabSheet; begin i := 0; 
    Indent := PageControll.Font.Size * 2; with Tablel do begin First; 
    while not EOF do begin 
    CurrentTab := CreateDragTabSheet(PageControll); CurrentTab.Name := 
'TabSheet1 + IntToStr(i); Inc(i); 
    CurrentTab.Caption := FieldByName('Description').AsString; for Fids := 0 
to FieldCount - 1 do with TLabel.Create(CurrentTab) do begin 
    Parent := CurrentTab; 
    Name := 'Label' + IntToStr(i) + IntToStr(Fids); 
    Caption := Fields[Fids].FieldName + ':  ' + Fields[Fids].AsString; Left := Indent; 
    Top := Indent + (Fids * Height * 2); OnMouseDown := TabSheetMouseDown; 
OnDragOver := TabSheetDragOver; OnDragDrop := TabSheetDragDrop; end; Next; 
end; end; 
    CurrentTab := CreateDragTabSheet(PageControl2); CurrentTab.Caption := 
'Drag Parts here...'; end; 
    end. 


    Rich Edit 

    '   Rich Text Format (RTF)  ,   
 ,     ASCII.    
     Rich Text Format,  
www.microsoft.com  www.wotsit.demon.co.uk,       
  -W W W          , 
 Rich Text Format.  TRichEdit    
   RTF,      . 

     7.    Win32 185 

          
       Delphi 2.0,   TRichEdit    
.     NT 4.0  Delphi 2.0   
 divide-by-zero (  );   .  
 Rich Edit      (64 )  Delphi 2.0 
-    .     , 
    . 

         Rich Edit   
 \Delphi  3 . 0\Demos\RichText,     Delphi. He 
    ,    -, 
    Rich Edit. 

      

    TRichEdit    ,   , 
  , , ,   ,     
     .  SelAttributes  
      SelStart  SelLength. 
       
DefAttributes.  SelAttributes,  DefAttributes    TTextAttributes. 
       7.20   . -,    
  RTF           
Rich Edit,     PlainText;    -1 
  "" . -,    
 TTextAttributes   . 
           ,   
 ,    ,    .  
      Rich Edit,   
,      Rich Text,    
 " " (. 7.19).  SELATR1.     
  . 

    . 7.19.      RTF 

     7.20. \UDELPHI3\CHPT7\RICHEDIT\SELATR\SELATR1. PAS.  
SelAttributes       I rich text 

    unit SelAtrl; interface 
    uses 
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
StdCtrls, ComCtrls, ExtCtrls, ToolWin; 
    type 
    TForml = class(TForm) RichEditl: TRichEdit; RichEdit2: TRichEdit; 
ToolBarl: TToolBar; ComboBoxl: TComboBox; 


    186  II.   


    StatusBarl: TStatusBar; Panell: TPanel; Panel2: TPanel; TrackBarl: 
TTrackBar; ToolButtonl: TToolButton; ColorDialogl: TColorDialog; ImageListl: TImageList; 
    procedure RichEditlChange(Sender: TObject); procedure FormCreate(Sender: 
TObject); procedure ComboBoxlClick(Sender: TObject); procedure 
RichEditlSelectionChange(Sender: TObject); procedure TrackBarlChange(Sender: 
TObject); procedure ToolButtonlClick(Sender: TObject); end; 
    var 
    Forml: TForml; 
    InStream: TMemoryStream; 
    implementation {$R *.DFM} 
    procedure TForml.RichEditlChange(Sender: TObject); begin 
    InStream.Clear; 
    RichEditl.Lines.SaveToStream(InStream); 
    InStream.Position := 0; 
    RichEdit2.Lines.LoadFromStream(InStream); end; 
    procedure TForml.FormCreate(Sender: TObject); var 
    I: integer; begin 
    RichEdit2.PlainText := True; Comboboxl.Items.Clear; with Screen do 
    for I := 0 to Fonts.Count - 1 do 
    if (Comboboxl.Items.IndexOf(Screen.Fonts[I]) = -1) then 
    ComboBoxl.Items.Add(Screen.Fonts[I]) ; ComboBoxl.Itemlndex := 0; end; 
    procedure TForml.ComboBoxlClick(Sender: TObject); begin 
    RichEditl.SelAttributes.Name := ComboBoxl.Items[ComboBoxl.Itemlndex]; end; 
    procedure TForml.RichEditlSelectionChange(Sender: TObject); begin 
    TrackBarl.Position := RichEditl.SelAttributes.Size; end; 
    procedure TForml.TrackBarlChange(Sender: TObject); begin 
    RichEditl.SelAttributes.Size := TrackBarl.Position; end; 
    procedure TForml.ToolButtonlClick(Sender: TObject); begin 
    ColorDialogl.Options := [cdSolidColor, cdPreventFullOpen]; 
    if ColorDialogl.Execute then 
    RichEditl.SelAttributes.Color := ColorDialogl.Color; end; 


     7.    Win32 187 

    initialization 
    InStream := TMemoryStream.Create; finalization 
    InStream.Free; end. 


      

     Paragraph  ,   . 
 Firstlndent, Leftlndent  Rightlndent    
,     .      
      TabCount.     
   Tab [ ].   ,   
  . 

    procedure  SetTabStops(RichEdit:   TRichEdit;   TabStops:   array  of   
integer); var 
    I:   integer; begin 
    with RichEdit.Paragraph do begin 
    TabCount   := High(TabStops)   +  1; for   I   :=   0   to  TabCount   do 
Tab[I]    :=  TabStops[I]; end; end; 

       Rich Edit   ,  
      ,   : 

    SetTabStops(RichEditl,    [20,   120,   200]); 

          Track Bar    
    SetTick,     
.   Header,     
,        , 
,    Paragraph. 

    . 7.20.    

       ,       
    ,    .  DataBase DeskTop, 
 Explorer DB, ,      .   
,        Rich Edit  
 Tab    

    188  II.   

    (. 7.20).   7.21 ,    
SelAttributes,        
  ,   Paragraph,   
   ("Indexes").  TBLPRT1. PAS   
  . 

     

       ,   ,    
TRichEdit,  .   ,   Delphi  
 ,      .   , 
  TRichEdit,   .  , ,  
 Paragraph  TRichEdit,   ,   
,        . 
  TTextAt-tributes        
 .       
   . 

    ;  7.21. \UDELPHI3\CHPT7\RICHEDIT\TABLEPRINT\TBLPRT1. . 
   

    "unit'Tblprtl;"'.............................." ........... 
.......................................      " 
    interface 
    uses 
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
StdCtrls, ComCtrls, ToolWin, DBTables, Db; 
    type 
    TForml = class(TForm) 
    StatusBarl: TStatusBar; 
    ToolBarl: TToolBar; 
    RichEditl: TRichEdit; 
    ToolButtonl: TToolButton; 
    ImageListl: TImageList; 
    cbDatabaseName: TCoraboBox; 
    cbTableName: TComboBox; 
    Tablel: TTable; 
    procedure FormCreate(Sender: TObject); 
    procedure cbDatabaseNameChange(Sender: TObject); 
    procedure cbTableNameChange(Sender: TObject); 
    procedure ToolButtonlClick(Sender: TObject); end; 
    const 
    FldTyps: array[ftUnknown..ftTypedBinary] of string = ( 
    'ftUnknown', 'ftString', 'ftSmallint', 'ftlnteger', 'ftWord', 'ftBoolean', 'ftFloat', 
    'ftCurrency', 'ftBCD', 'ftDate', 'ftTime', 'ftDateTime', 'ftBytes', 
'ftVarBytes', 'ftAutoInc', 'ftBlob', 'ftMemo', 'ftGraphic', 'ftFmtMemo', 
'ftParadoxOle', 'ftDBaseOle', 
    1ftTypedBinary1 ); TABCHAR = #9; 
    var 
    Forml: TForml; 
    implementation {$R *.DFM} 
    procedure SetTabStops(RichEdit: TRichEdit; TabStops: array of integer); var 
    I: integer; begin 
    with RichEdit.Paragraph do 
    begin 


     7.    Win32 189 


    TabCount := High(TabStops) + 1; for I := 0 to TabCount - 1 do 
    Tab[I] := TabStops[I]; end; end; 
    procedure WritelndexDescription(Table: TTable; RichEdit: TRichEdit) var 
    I: integer; begin 
    with Table do begin 
    SetTabStops(RichEdit, [80]); 
    IndexDefs.Update; 
    if IndexDefs.Count > 0 then 
    begin 
    with RichEdit, SelAttributes do begin 
    Paragraph.Alignment := taCenter; 
    Style := Style + [fsBold, fsltalic]; 
    Lines.Add(''); 
    Lines.Add('Indexes ' ); 
    Paragraph.Alignment := taLeftJustify; 
    Style := Style - [fsltalic] + [fsUnderline]; 
    Lines.Add('Index Name' + TABCHAR + 'Fields'); 
    Style := Style - [fsBold, fsUnderline]; 
    for I := 0 to IndexDefs.Count - 1 do 
    if ixPrimary in IndexDefs[I].Options then 
    Lines.Add('(Primary)' + TABCHAR + IndexDefs[I].Fields) else 
    Lines.Add(IndexDefs[I].Name + TABCHAR + IndexDefs[I].Fields) ; end; end; 
    end; 
    ( 
    end; 
    procedure WriteTableDescription(Table: TTable; RichEdit: TRichEdit); var 
    I: integer; begin 
    with Table, RichEdit, SelAttributes do begin 
    SetTabStops(RichEdit, [20, 120, 200]); Style := Style + [fsUnderLine, fsBold]; 
    Lines.Add('#' + TABCHAR + 'Label' + TABCHAR + 'Type' + TABCHAR + 'Size'); 
Style := Style - [fsUnderLine, fsBold]; for I := 0 to FieldCount - 1 do wi,th 
Fields [I] do 
    'Lines. AdddntToStr (FieldNo) + TABCHAR + DisplayLabel + TABCHAR + 1  
FldTyps[DataType] + TABCHAR + IntToStr(DataSize)); end; end; 
    procedure TForml.FormCreate(Sender: TObject); begin 
    Session.GetDatabaseNames(cbDatabaseName.Items); 
    cbDatabaseName.Itemlndex := cbDatabaseName.Items.IndexOf('DBDemos'); 
    cbDatabaseNameChange(Sender); end; 
    procedure TForml.cbDatabaseNameChange(Sender: TObject); begin 
    with cbDatabaseName do 
    Session.GetTableNames(Items[Itemlndex], '', True, False, cbTableName.Items); 
    cbTableName.Itemlndex := 0; 


    190  II.   


    cbTableNameChange(Sender) ; end; 
    procedure TForml.cbTableNameChange(Sender: TObject); begin 
    if cbTableName.Itemlndex <> -1 then begin 
    with Tablel do try 
    DatabaseName := cbDatabaseName.Items[cbDatabaseName.Itemlndex]; 
    TableName := cbTableName.Items[cbTableName.Itemlndex]; 
    Open; 
    RichEditl.Lines.Clear; 
    WriteTableDescription(Tablel, RichEditl); 
    WritelndexDescription(Tablel, RichEditl); 
    StatusBarl.Panels[0].Text := 'Field Listing for ' + TableName + 
    ' in ' + DatabaseName + '.'; 
    StatusBarl.Panels[1].Text := 'Fields: ' + IntToStr(FieldCount); 
StatusBarl.Panels[2].Text := 'Indexes: ' + IntToStr(IndexDefs.Count); finally 
Close; end; end; end; 
    procedure TForml.ToolButtonlClick(Sender: TObject); begin 
    RichEditl.Print(StatusBarl.Panels[0].Text); end; 
    end. 


        

      Rich Edit,  TEdit  TMemo,   
TCustomMemo,           
 "_",     VCL.  
  ,        . 
      OnSelectionChange   Rich Edit,  
       (. 7.21). 

    . 7.21.  "edit"    4,   10 

    procedure GetRTRowCol (RichEdit: TRichEdit;  var Row, Col: Longlnt; begin 
    with RichEdit do 
    begin 


     7.    Win32 191 

    Row := SendMessage(Handle, EM_LINEFROMCHAR, SelStart, 0); Col := SelStart 
- SendMessage(Handle, EM_LINEINDEX, Row, Ob-end; end; 
    procedure TForml.RichEditlSelectiOnChange(Sender: TObject); var 
    RTRow, RTCol: Longlnt; begin 
    GetRTRowAndColumn(RichEditl, RTRow, RTCol);  StatusBarl.Panels[0] .Text := 
'Ln IntToStr(RTRow) + 
    1 Col ' + IntToStr(RTCol); end; 
      
         RichEdit   
     TFindDialog    OnFind.  
  HideSelection  RichEdit  False ,    
  ,        
Rich Edit. 
    procedure  TForml.FormCreate(Sender:   TObject); begin 
    RichEditl.HideSelection   :=   False; end; 
      ,        , 
  Position  TFindDialog,   EM_POS 
FROMCHAR     .  ,  
       FindText  
  .     . 

    procedure  TForml.tbFindClick(Sender:   TObject); var 
    TempPoint:   TPoint; begin                                                 
    with  RichEditl,   FindDialogl   do begin 
    Perform(EM_POSFROMCHAR, Longlnt(@TempPoint), SelStart  +  SelLength +  2); 
    Position   :=  ClientToScreen   (TempPoint); 
    FindText   := Copy(Text,   SelStart  +  1,   SelLength); 
    Execute; end; end; 


     

     Microsoft,   DELPHI 2.0,   
   EM_POSFROMCHAR. -,  EM_POSFROMCHAR 
   RICHEDIT.PAS. ComCtrls   , 
      RICHEDIT.PAS   ,  
     RICHEDIT.. 
     ,  EM_POSFROMCHAR  EM_CHARFROMPOS  
.   (!)  wparam   
    .      
  : 

    SendMessage (Handle, EM_POS FROMCHAR, Longlnt (@RTPos), SelStart);  
RTPos    TPoint. 

         Find Next,   
 OnFind.     ,   , 
     .   Pos 
      .    
,   ,   SelStart  
SelLength,    .    . 


    procedure TForml.FindDialoglFind(Sender: TObject); var 
    SearchToken: string; 
    FoundAt: Longlnt; begin 
    if FindDialogl.FindText <> '' then 
    with RichEditl do 


    192  II.   


    begin 
    SearchToken   := Copy(Text,   SelStart  +  SelLength  +  1, 
    Length   (Text)   -  SelStart); FoundAt   :=  Pos(Uppercase(FindDialogl.FindText), 
    Uppercase(SearchToken)); if   (FoundAt  <>   0)   then begin 
    SelStart   :=   SelStart   +   SelLength  +   FoundAt   -   1; SelLength   
:= Length(FindDialogl.FindText); end; end; end; 

      SelStart  SelLength,   SelAttributes,  
      .   
       ,   
,   "http//",     Web-. 

      List View 

      List View       
.  , ,      
    ,  .   List View 
    Windows 95. ,    
 Explorer    List View. 

     List View    

     ,  ,  TListView  
  , . 
      Items,    TListltems,   
 TListltem,    .    
,          
: Caption, Imagelndex  Statelndex.  Imagelndex  Statelndex 
       
     Image List. 
        TListltem    TStrings,  Subltems.  
 List View   Details  Subltems  , 
      Caption. 
         ViewStyle,       
Windows Explorer Large Icons, Small Icons, List  Details.   
 vslcon, vsSmalllcon, vsList  vsReport. 
           ViewStyle  vsReport (Details),   
  TListColumn   Columns. 

      List View    

       List View   ,     
:   Add  ,     
 ,   '"""" 

    var 
    Listltem:   TListltem; begin 
    Listltem   :=  ListViewl.Items.Add; 
    Listltem.Caption   := Editl.Text; 

      ViewStyle  vsReport,   List View 
  ,   Items    
 (. 7.22).   Item    Subltems, 
 . 
         Subltems,   Columns  . 

    var 
    ListColumn: TListColumn; begin 
    ListColumn := ListViewl.Columns-Add; 
    ListColumn.Caption := Editl .Text; 
    ListColumn.Width := Length(Editl.Text) * Font.Size; 


     7.    Win32 193 
    7  Delphi 3.   

        Subltems   Items.  
Subltems    TStrings,       
 ,    . 

    ListViewl.Selected.Subltems.Add('This   sub  item displays  to  the  right 
of  the  selecteditem text.'); 


    . 7.22.   vsReport) 


    TListView   (  ViewStyle 


        7.22    List View 
    Items, Subltems  Columns.   
       Image List    
16x16 ,   Image List-   
 32x32;        
 (      CreateSize   
     16x16).     
 Add List Item  ,    
 ,    Image Index.  LVADD1. PAS 
     . 

     7.22. \UDELPHI3\CHPT7\LISTVIEW\ADDITEMS\LVADD1. PAS.   List 
View         ' 

    unitLVAddl; interface 
    uses 
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
StdCtrls, ComCtrls, ToolWin; 
    type 
    TfrmMain = class(TForm) ListViewl: TListView; ImageListl: TImageList; 
ToolBarl: TToolBar; ToolButtonl: TToolButton; ToolButton2: TToolButton; 
ToolButtonS: TToolButton; ToolButton4: TToolButton; tbAddListltem: 
TToolButton; ToolButton6: TToolButton; Editl: TEdit; ToolButton7: TToolButton; 
il!6: TImageList; i!32: TImageList; ComboBoxl: TComboBox; Too 
    lButtonS: TToolButton; tbAddColumn: TToolButton; tbAddSubltem: TToolButton; 
    procedure tbAddListltemClick(Sender: TObject); procedure 
ToolButtonlClick(Sender: TObject); procedure ToolButton2Click(Sender: 
TObject); procedure ToolButtonSClick(Sender: TObject); 


    194  II.   


    procedure ToolButton4Click(Sender: TObject); procedure FormCreate(Sender: 
TObject); procedure tbAddColumnClick(Sender: TObject); procedure 
tbAddSubltemClick(Sender: TObject); end; 
    var 
    frmMain: TfrmMain; 
    implementation 
    Uses CommCtrl, ShellAPI, LVAdd2; 
    {$R *.DFM} 
    procedure TfrmMain.tbAddListltemClick(Sender: TObject); var 
    Listltem: TListltem; begin 
    Listltem := ListViewl.Items.Add; 
    Listltem.Caption := Editl.Text; 
    Listltem.Imagelndex := Comboboxl.Itemlndex; end; 
    procedure TfrmMain.ToolButtonlClick(Sender: TObject); begin 
    ListViewl.ViewStyle := vslcon; end; 
    procedure TfrmMain.ToolButton2Click(Sender: TObject); begin 
    ListViewl.ViewStyle := vsSmalllcon; end; 
    procedure TfrmMain.ToolButtonSClick(Sender: TObject); begin 
    ListViewl.ViewStyle := vsList; end; 
    procedure TfrmMain.ToolButton4Click(Sender: TObject); begin 
    ListViewl.ViewStyle := vsReport; end; 
    procedure TfrmMain.FormCreate(Sender: TObject); const 
    DirPath = 'C:\Program Files\Borland\Delphi 3.0\Images\Icons\'; var 
    SearchRec: TSearchRec; begin      "*  ' i!32.CreateSize(32, 32); 
    if (FindFirst(DirPath + '*.BMP', faAnyFile, SearchRec) = 0) then begin try 
    while (FindNext(SearchRec) = 0) do 
    1116.FileLoad(rtBitmap, DirPath + SearchRec.Name, clNone); finally 
    FindClose(SearchRec); end; end; 
    if (FindFirst(DirPath + '*.ICO', faAnyFile, SearchRec) = 0) then begin try 
    while (FindNext(SearchRec) = 0) do 


     7.    Win32 195 

    begin 
    Imagelist_AddIcon(1132.Handle, Extractlcon(Handle, PChar(DirPath + 
SearchRec.Name) , 0)); 
    ComboBoxl.Items.Add(Copy(SearchRec.Name, 0, Pos ( '. ', SearchRec.Name) - 
1)); end; finally 
    FindClose(SearchRec); end; end; 
    ComboBoxl.Itemlndex := 0; end; 
    procedure TfrmMain,tbAddColumnClick(Sender: TObject); var 
    ListColumn: TListColumn; begin 
    ListColumn := ListViewl.Columns.Add; 
    ListColumn.Caption := Editl.Text; 
    ListColumn.Width := Length(Editl.Text) * Font.Size; 
    tbAddSubltem.Enabled := True; end; 
    procedure TfrmMain.tbAddSubltemClick(Sender: TObject); begin 
    if Assigned(ListViewl.Selected) then begin 
    frmAddSubltems.ShowModal; 
    ListViewl.Selected.Subltems.Assign(frmAddSubltems.Memol.Lines) ; end else 
    ShowMessage('To add Subltems, first select an item.'); end; 
    end. 


      Tree View 

      TTreeView  ,      
.       TTreeNode.      
TTreeNodes,   Items.    , 
  ,    Items. 
      TTreeView      , 
 ^    ,    . 

        -."__...................,,_________,,.1, 
    ,  Item    TTreeNode,   
    .  Items, , 
    Item,    TTreeNodes. 
 Items     TTreeNodes. 

          

    ,     TTreeView   ,  
      .      
   Image Lists,   TTreeView.    
   \Images\Buttons  ImageListl,     
 Itemlndex  Se-lectedlndex.  ImageList2    
  \Images\Buttons.   TImageList  Statelmages 
(        ). 
  Statelmages       
. ,         
 . 
      Object Inspector  ImageListl   Images  
 Tree View.   Statelmages  ImageList2. 

    196  II.   

         TTreeView   ,  
     Items  TTreeView,    
  TTreeView.    New Item    
    .   Image Index  ,  
   Selected Index,    1. 
        Statelndex  . 
    ,   
     .      
 ,    ..   Statelndex,  
  -1, ,       . 
        ,    
  ImageList2.      . 
          
OnDblClick TTreeView. 

    procedure TForml .TreeViewlDblClick (Sender: TObject) ;                    
    begin 
    TreeViewl.Selected.Statelndex   :=  1; 
    TreeViewl. Invalidate; 
    end; 

         ,     
Im-ageList2        (. 7.23). 
,      , 
    ImageListl,   Imagelndex. 
   ,     
  ImageListl,    Selectedlndex. 

    . 7.23.  TTreeView   


          

          TTreeView    
.   Add  

    TTreeNodes. 
    var 
    Node: TTreeNode; begin 
    Node := TreeViewl.Items.Add(TreeViewl.Selected, Editl.Text); 

            ,   ,  
  .    nil (),    
 .     . 
       ,     
 TTreeNodes.         . 
       ,    TTreeNodes    ,    
TTreeNode,    .     Add, 
AddFirst, Insert, InsertObject, AddObject  AddObject-First. 
        ,    TTreeNodes,    
   .   AddChild, AddChildFirst, AddChildObject  AddChildObjectFirst. 
    ,   ,  -,   
    4- .    
 Longlnt,     - (  
 4- ).  ,   4   , 
   . 

    :       

         Tree View     
While,      ;    
  Items .Add  . 

    Customers.Open; 
    while not Customers.EOF do 
    begin 


    Ha  


     7.    Win32 197 


    CustomerNode   :=  Items.Add(Nil,   Customers['Company']); Next; end; 

          "",  
     .   
 . 
      ,     It ems. Add. ,  
   CustomerNode     Items 
.Add. CustomerNode      . 
        Items .Add,      Next 
 ,     . ( 
    TQuery   .) 
       While         
    Next   .   
          
 .  Items. Add  Items .AddChild    
  TTreeNode   . 
          CustomerData,  
   .        
      ,    . 

    procedure TForml.ToolButtonlClick(Sender: TObject); var 
    CustomerNode: TTreeNode; begin 
    with Treeviewl, CustomerData do begin 
    Orders.Filtered := True; 
    //      TreeNodes. 
    while not Customers.EOF do 
    begin 
    CustomerNode   :=  Items .Add (Nil,   Customers ['Company']); 
    . .  '        //               
    TreeNodes. with Orders  do begin 
    Filter   :=   'CustNo  =   '   + 
    Customers.FieldByName('CustNo').Asstring; Refresh; 
    while  not  EOF  do begin 
    Items.AddChild(CustomerNode,    '#'   + 
    FieldByNamne('OrderNo').Asstring  +   '      '   + FieldByNamne(    
'SaleDate'    ).AsString); Next ; end; 
    end;   //  . Customers.Next; end; 
    //          Tree View. Items .GetFirstNode. 
Selected   :=  True/end;   //  TreeViewl,   CustomerData end; 

              :  
Customers  Orders  Line Items (. 7.24). ,   
 ItemTotal, ,   ,    
 ,   Image List   Statelmages, ,  
 ,  Statelndex  ,   
   Image List.  Progress Bar   
    .      
BeginUpdate  EndUpdate  TTreeNodes.  BeginUpdate 
    TTreeView,    EndUpdate 
( 7.23).  LOADTBL1 
    . PAS     . 


    198  II.   


    . 7.24.   TreeView     

     7.24. \UDELPHI3\CHP7 \TREEVIEW\LOADTABLE\LOADTBLI . PAS.  
 TreeView     

    unit loadtbll; interface 
    uses 
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
ComCtrls, ToolWin, StdCtrls; 
    type 
    TForml = class(TForm) 
    StatusBarl: TStatusBar; 
    ToolBarl: TToolBar; 
    TreeViewl: TTreeView; 
    ToolButtonl: TToolButton; 
    ImageListl: TImageList; 
    ProgressBarl: TProgressBar; 
    ImageList2: TImageList; 
    Editl: TEdit; 
    UpDownl: TUpDown; 
    Labell: TLabel; 
    procedure ToolButtonlClick(Sender: TObject); end; 
    var 
    Forml: TForml; 
    implementation uses OrderExp2; {$R *.DFM} 
    procedure TForml.ToolButtonlClick(Sender: TObject); var 
    LineltemsNode, OrdersNode, CustomerNode: TTreeNode; begin 
    with Treeviewl, CustomerData do 
    begin 


     7.    Win32 199 


    //  . 
    Lineltems.Filtered := True; 
    Lineltems.Open; 
    Orders.Filtered := True; 
    Orders.Open; 
    Customers.Close; 
    Customers.IndexName := 'ByCompany'; 
    Customers.Open; 
    //  Progress Bar   StatusBarl. 
    with ProgressBarl do 
    begin 
    Max := Customers.RecordCount; Parent := StatusBarl; StatusBarl.SimplePanel 
:= True; Left := StatusBarl.Canvas.TextWidth('W) * 4; Top := 4; 
    Height : = StatusBarl.Height - (StatusBarl.Height div 3); Visible := True; end; 
    Items.Clear; 
    //   TreeView   EndUpdate. Items.BeginUpdate; 
    //      TreeNodes. while not Customers.EOF do begin 
    CustomerNode := Items.Add(Nil, Customers['Company']); 
    //         TreeNodes. 
    with Orders do 
    begin 
    Filter := 'CustNo = ' + Customers.FieldByName('CustNo').AsString; 
    Refresh; 
    while not EOF do 
    begin 
    OrdersNode := Items.AddChild(CustomerNode, '#' + 
FieldByName('OrderNo'}.AsString + 
    1  ' + FieldByName('SaleDate').AsString); //     
 , if (FieldbyName('ItemsTotal').Aslnteger > (UpDownl.Position * 
1000)) then 
    CustomerNode.Statelndex := 1; 
    //         TreeNodes. with 
Lineltems do begin 
    Filter := 'OrderNo = ' + Orders.FieldByName('OrderNo').AsString; 
    Refresh; 
    while not EOF do 
    begin 
    LineltemsNode := Items.AddChild(OrdersNode, 
FieldByName('PartName').AsString + 
    1 (#' + FieldByName('PartNo').AsString + '), Qty ' + 
FieldByName('Qty').AsString 4 ', $' + FieldByName('Price').AsString) ; Next; end; 
    end; // Lineltems Next; end; 
    end; // Orders Customers.Next; //  . 
    ProgressBarl.Position := Customers.RecNo; 
    StatusBarl.SimpleText :='%'+ IntToStr((Customers.RecNo * 100) div 
Customers.RecordCount) ; 
    //       Progress Bar. 
Application.ProcessMessages; end; 


    200           .   


    //   Draw, //   TTreeView, //   
   . Items.EndUpdate; 
    //      Tree View. 
Items.GetFirstNode.Selected := True; ProgressBarl.Visible := False; 
StatusBarl.SimpleText := ''; end; // TreeViewl, CustomerData end; 
    end. 


        

             ? , 
       ,   
 ,   TForml,    ,  
    TObject.        
TTreeView,   TObject (. 7.25)? 
               
.     ,    
TClass;    Cls     TForml.    While 
   ClassName        
 Cls,  ClassParent.   ,  Cls 
 ClassParent  TObject. (TObject    , 
    ,   Cls    Nil.) 
    . 

    procedure TForml.FormCreate(Sender:   TObject); var 
    Cls:   TClass; begin 
    Cls   :=  TForml; 
    while Assigned(Cls)   do 
    begin 
    ListBoxl.Items.Add(Cls.ClassName) ; Cls := Cls.ClassParent; 
    end; 

    ,     ,    
,        
  Tree View  TObject       
   .   ,    
  Items.         
         ? 
  , ,     
Items.Add,   TTreeNode  Node.      
  ! 

    var 
    Node:   TTreeNode; begin 
    Node   :=  TreeViewl.Items.Add(TreeViewl.Selected,   Edit1.Text); 
            MoveTo  
TTreeNodes,    TTreeNode    . 
    procedure  TForml.FormCreate(Sender:   TObject); var 
    Cls:   TClass; Node:   TTreeNode; begin 
    Cls   :=  TForml; while Assigned(Cls)   do begin 
    with TreeViewl  do begin 
    Node   :=  Items.Add(Nil,   Cls.ClassName); if   (Node  <>   Items[0])   then 
    Items[0].MoveTo(Node,   naAddChild); 


     7.    Win32     201 


    end; 
    Cls   := Cls.ClassParent; end; 
    TreeViewl.FullExpand; end; 

    I        . 
    1.    Cls  TForml. 
    2.        ,  Cls   Nil (). 
    3.       ,   TForml. 
    4.      ,       , 
  Items [0]  Node    MoveTo  . 
    5.    Cls   ClassParent, TForm. 
    6.        TForm. 
    7.          TTreeView     TForm 
  Items [ 0 ],    TForml   Items [ 1 ],   
     TTreeView.      , 
     MoveTo   Items [ 0 ]   
     . 
    8.        ,  Cls   TOb j ect,  
        . 

      TTreeView 

      Tree View      , 
   .    ,  
    ,    TTreeNode. 
          TToolBar, 
  TTreeView    ,  TPageControl     
(. 7.26).   Tool Bar    TTreeView  
,       ,   
 ,          
  .  ,  Tool Bar   ,  
   . 

    . 7.25.   . TListBox  ,  
  TTreeView       

    . 7.26.  TTreeView 

       Page "Nodes"    
          .  
 "Hit Tests"   ,   
GetHitTestlinf oAt.   "Events"     
50   TTreeView. 

    202       II.   

    -         .  
   ,       
  .      
 ,   \UDELPHI3\CHP7 \TREEVIEW\TVPROPS\. 

     

     OnChange  TTreeView     
  "Nodes".    TTreeNode,    
 with Node do...       
  . 

    procedure  TForml.TreeViewlChange(Sender:   TObject;   Node:   TTreeNode); begin 
    with Node do begin 
    IblCount.Caption     :=   Format(    'Count:   %s',    [IntToStr(Count)]); 
Ibllndex.Caption     :=   Format(    'Index:   %s ' ,    [IntToStr(   Index)]); 


    . 7.27.  "Hit Tests" 

     GetFirstChild,  TTreeNode     
 .     ,    
    Tree View.      
  ( )   ,   
  . 

    Hit Test 

            GetHitTes-tlnf oAt (. 
7.27)     "Hit Tests". ,  GetHitTestlnfoAt 
     OnMouseDown   THitTests. 
function  GetHitTestlnfoAt(X,   Y:   Integer): THitTests; 

    THitTest =   (htAbove,   htBelow,   htNowhere, htOnltem,   htOnButton, 
    htOnlcon,   htOnlndent,   htOnLabel,   htOnRight, htOnStatelcon, 
    htToLeft,   htToRight); THitTests  =  set  of  THitTest; 

      ^ ^^^^/  Pascal,  
 '  Set ()  Pascal,   
  ,    ,  
  .   TListBox,   
,    . 

    const HTest:   array(htAbove..htToRight]   of  String 
    'htAbove', 
    'htBelow', 
    'htNowhere', 
    'htOnltem', 
    'htOnButton', 
    'htOnlcon   ', 
    'htOnlndenf, 
    'htOnLabel', 
    'htOnRighf, 
    'htOnStatelcon', 
    'htToLeff, 
    'htToRight' ); 
    = ( 


     7.    Win32    203 


             
     .        
 (  !) ,          ,5 
 ,      . 
       Htest,    ,  
IbHitTest  ListBox   . 

    var 
    :   THitTest; begin 
    for  HT   :=  htAbove  to  htToRight   do IbHitTest.Items.Add(HTest[HT]) ; 

         ,     
 THitTest         
 HTest (         ). 
        Tree View   OnMouseDown, 
   TList-,  .    
  Multiselect    True.    
 THitTest      TreeView   Selected 
 True,  GetHitTestinf oAt    
THitTest.     . 

    procedure  TForml.TreeViewlMouseDown(Sender:   TObject;   Button:   TMouseButton; 
    Shift:   TShiftState;   X,   Y:   Integer); var 
    HT:   THitTest; begin 
    for  HT   :=  htAbove   to  htToRight  do 
    //             ,          
 //       GetHitTestinfoAt. 
    IbHitTest.Selected[Ord(HT)]    :=  HT   in  TreeViewl.GetHitTestinfoAt(X,  
 Y) end; 


     

       Events   " ",   
   ,    ,   
     (. 7.28).     , 
  ,     TListBox,    
    ,      .   
     .    
    50,      
,       ,    . 

    procedure TForml.LogEvents(EventStr: 
    ShortString); 
    begin 
    //   , 
    //     .    if IbEvents. Items.Count > 50 
then IbEvents.Items.Delete(0); 
    IbEvents.Items.Add(EventStr); 
    //    . 
    IbEvents.Itemlndex := IbEvents.Items.Count - 1; end; 
    . 7.28.     TTreeView : 
    procedure TForml.TreeViewlCollapsed(Sender: TObject; Node: TTreeNode); begin 
    LogEvents('   OnCollapsed'   ); end; 


    204       II.   


     

               
   ,     ,     
    ,      Add  
  .  ,    
  API    Windo ws (   
   ). 
            

     . 7.1        
    . 

     7.1,       

    	-  	   

    TTabControl	Tabs []	TabControl 1 .Tabs.Add ('sample text'); 
    TPageControl	TTabSheet	MySheet := TTabSheet.Create(Self); 
    MySheetPageControl := PageControl 1 ; 
    MySheetCaption := 'sample text'; 
    TTreeView	TTreeNode	MyNode := TreeViewl.ItemsAdd (Nil, 'sample text'); 
    TListView	TListltem	Myltem := ListViewl. Items. Add; 
    Myltem. Caption := 'sample text'; 
    THeader Control	THeader Sect ion	MySection := HeaderControll.SectionsAdd; 
    MySection.Text := 'sample text'; 
    TRichEdit	Lines [ ]	RichEditl.LinesAdd ('sample text'); 
    TStatusBar	TStatusPanel	MyStatusPanel:= StatusBarl .Panels.Add; 
    MyPanel.Text := 'sample text'; 
    TToolBar	TToolButton	with TToolButton.Create(Self) do Parent := ToolBarl; 
    TCoolBar	TCollectionltem; TCoolBand	var CoolBand: Tcollectionltem; begin 
CoolBand :=CoolBarl. Bands. Add; with CoolBand as TCoolBand do Control 
:=Editl; end; 


       

             
API,     .  VCL   
,     ,    
.  ,        
    VCL.  , Delphi   
   ,    API 
  Windows. ,    ,   
       API. 

     7.    Win32       205 

       ,    
Delphi,        Windows  
 API    Windows API.      
      Tab (   
TCM_GETITEMRECT   Tab).    
,  ""   (, "" SB 
   SB_GETBORDERS  SB_SIMPLE).'""""** 
        ,    - Microsoft 
Developers Network (MSDN)     ,   
  Pascal. 
            
 ,     .   
    ,    COMMCTRL. PAS 
 COMMCTRLS . PAS,     . 
        COMMCTRL. PAS,    \source\rtl\win,  
  ,      Windows API, 
  comet 132 . dll. 
        COMTRLS. PAS,    \source\vcl,   
Delphi,     ,    COMMTRL. PAS. 

      Windows 

    ,   THilightTabControl, ,   
   TCS_HOTTRACK,    ,   
  .        
TTabControl,   TCS_BOTTOM, TCS_VERTICAL  TCS_RIGHT   CreateParams. 
    ,    Delphi 3,  TCustomTabControl   
  .       
    - DLL  Microsoft. He  
    DLL   , "    
-   ,    . 
         TCS_SCROLLOPPOSITE (. 7.29).  
-      ,   
       ? 
       ,   CreateParams. Delphi  
       Params  CreateParams.  
CreateParams       .   
  ,    ,  or 
(),     and (). 
    Params.Style  := Params.Style or TCS_HOTTRACK; . 7.29. 
   
      7.24      TCS_HOTTRACK  
TCS_SCROLLOPPOSITE.    IE31. PAS   
  . 

     7.24. \UDELPHI3\CHP7\TABCONTROL\IE3\IE31. PAS.  
  Tab 

    unit 1;.............~"    ............... 
    interface 
    uses 
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls; 
    type 
    THotTabControl = Class(TTabControl) private 
    procedure CreateParams(var Params: TCreateParams); override; 


    206     II.   


    end; 
    TForml = class(TForm) 
    procedure FormCreate(Sender: TObject); end; 
    var 
    Forml: TForml; 
    implementation <$R *.DFM} 
    const 
    TCS_SCROLLOPPOSITE =  $0001;   //    . 
    TCS_BOTTOM =  $0002; 
    TCS_RIGHT  =  $0002;   //   TCS_VERTICAL. 
    TCS_HOTTRACK   =  $0040; 
    TCS_VERTICAL =    $0080;   //        . 
    procedure THotTabControl.CreateParams(var Params: TCreateParams); begin 
    inherited CreateParams(Params); with Params do Style := Style or 
TCS_HOTTRACK or TCS_SCROLLOPPOSITE; end; 
    procedure TForml.FormCreate(Sender: TObject); var 
    i: integer; begin 
    with THotTabControl.Create(Self) do begin 
    Parent := Self; for i := 0 to 19 do 
    Tabs.Add('Tab ' + IntToStr(i)); end; end; 
    end. 

      7.25     ,  
  Tab.       
   (. 7.30).        
     Employee   
  TTabControl,       
.    TCI. PAS    
 . 

    . 7.30.   Tab    

     7.25. \UDELPHI3\CHP7 \TABCONTROL\PHONELIST\TCI . PAS.  
    Tab 

    unit TCI; interface 
    uses 
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
ExtCtrls, DBCtrls, Grids, DBGrids, DB, DBTables, ComCtrls, StdCtrls; 
    type 


     7.    Win32     207 

    THotTabControl = Class(TTabControl) private 
    procedure CreateParams(var Params: TCreateParams); override; end; 
    TForml = class(TForm) 
    procedure FormCreate(Sender: TObject); 
    procedure TabControllChange(Sender: TObject); 
    procedure QuerylFilterRecord(DataSet: TDataSet; var Accept: Boolean); 
    procedure QuerylAfterOpen(DataSet: TDataSet); public 
    Queryl: TQuery; 
    DataSourcel: TDataSource; 
    DBGridl: TDBGrid; 
    HotTabControll: THotTabControl; 
    StatusBarl: TStatusBar; end; 
    var 
    Forml: TForml; 
    implementation ($R *.DFM} 
    const 
    TCS_SCROLLOPPOSITE  =   $0001;   //    . 
    TCS_BOTTOM  =  $0002; 
    TCS_RIGHT  =   $0002;   //    TCS_VERTICAL. 
    TCS_HOTTRACK  =  $0040; 
    TCS_VERTICAL  =  $0080;   //      . 
    procedure THotTabControl.CreateParams(var Params: TCreateParams); begin 
    inherited CreateParams(Params); with Params do Style := Style or TCS_HOTTRACK or TCS_BOTTOM; 
    end; 
    procedure TForml.FormCreate(Sender: TObject); var 
    i: integer; begin 
    Queryl := TQuery.Create(Self); 
    with Queryl, SQL do 
    begin 
    OnFilterRecord := QuerylFilterRecord; AfterOpen := QuerylAfterOpen; 
DataBaseName := 'DBDEMOS'; Filtered := True; 
    Add('SELECT FIRSTNAME || " " || LASTNAME AS Name, '); Add('PHONEEXT as 
Ext, LASTNAME '); Add('FROM EMPLOYEE'); Add('ORDER BY LASTNAME'); end; 
    DataSourcel := TDataSource.Create(Self); DataSourcel.DataSet := Queryl; 
    StatusBarl := TStatusBar.Create(Self); StatusBarl.Parent := Self; 
StatusBarl.SimplePanel := True; 


    208            II.   


    HotTabControll := THotTabControl.Create(Self); 
    with HotTabControll do 
    begin 
    OnChange := TabControllChange; 
    Parent := Self; 
    Align := alClient; 
    Font.Style := [fsBold]; 
    TabWidth := Canvas.TextWidth('W) * 2; 
    TabHeight := Canvas.TextHeight('W} * 2; 
    MultiLine := True; 
    for i := Ord('A') to Ord('Z') do 
    Tabs.Add(Chr(i)); end; 
    DBGridl := TDBGrid.Create(Self); 
    with DBGridl do 
    begin 
    Parent := HotTabControll; 
    Align := alClient; 
    DataSource := DataSourcel; end; 
    TabControllChange(Self); end; 
    procedure TForml.TabControllChange(Sender: TObject); begin 
    Query1.Close; Queryl.Open; 
    { 
         "EInvalidOperation 
    'control 'Tabcontroll' has no parent window", 
         , 
            
    . } 
    if (Queryl.RecordCount = 0) then begin 
    Queryl.Close; 
    StatusBarl.SimpleText := 'No Records Selected.'; end else 
    StatusBarl.SimpleText := 'Records Selected: ' + 
IntToStr(Queryl.RecordCount) ; end; 
    //  ,     last name 
    // () 
    //    . 
    procedure TForml.QuerylFilterRecord(DataSet: TDataSet; 
    var Accept: Boolean); begin 
    with (DataSet as TQuery) do 
    Accept := (Copy(FieldByName('LASTNAME').AsString,1,1) = 
    HotTabControll.Tabs[HotTabControll.Tablndex]); end; 
    //         TField. 
procedure TForml.QuerylAfterOpen(DataSet: TDataSet); begin 
    with (DataSet as TQuery) do begin 
    FieldByName('LastName').Visible := false; FieldByName('Name1).DisplayWidth 
:= 30; FieldByName('Ext').DisplayWidth := 15; end; end; 
    end. 


     7.    Win32        209 


        TPageControl 

               
  .       ,   
     ?   VCL   
TWinControl,  RecreateWnd,     
  .         
 , ,  ,   HotTrack, ,  
   RecreateWnd        
CreateParams ( }^ 
      Tab  Page     Window, 
WC_TABCONTROL (    CreateParams    
TCustomTabControl),    ,    TTab
Control,    TPageControl. 
      (. 7.31   7.26)    
    TPageControl,   ]  
ScrollOpposite, HotTrack  TabAlign.   -1  
    .    , - j 
    . ^^^^^_1_^ 
,  Wmglo\ysJ?5  . TCTistomTabControTTripocTO 
  !,' ^1      
  . 

    I 

    . 7.31.    TPageControl 

       NEWTAB. PAS ( 7.26)   
  . 

     7.26. \UDELPHI3\CHP7\PAGECONTROL\IE3\NEWTAB. PAS. 
   Page 

    unit Newtab; 
    interface 
    uses 
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls; 
    const 
    TCS_SCROLLOPPOSITE   = $0001;   //    . 
    TCS_BOTTOM  = $0002; 
    TCS_RIGHT  = $0002;   //   TCS_VERTICAL. 
    TCS_HOTTRACK = $0040; 
    TCS VERTICAL = $0080;   //      . 
    type 
    TabAlignments = (pcaTop, pcaBottom, pcaLeft, pcaRight); 
    THotPageControl = class(TPageControl} private 
    FScrollOpposite: Boolean; 
    FHotTrack: Boolean; 
    FTabAlign: TabAlignments; 
    procedure CreateParams(var Params: TCreateParams); override; 
    procedure SetScrollOpposite(Value: Boolean); 
    procedure SetHotTrack(Value: Boolean); 
    procedure SetTabAlign(Value: TabAlignments); published 
    property ScrollOpposite: Boolean read FScrollOpposite write SetScrollOpposite; 


    210      II.   


    property HotTrack: Boolean 
    read FHotTrack 
    write SetHotTrack; property TabAlign: TabAlignments 
    read FTabAlign 
    write SetTabAlign; end; 
    procedure Register; implementation 
    procedure THotPageControl.CreateParams (var Params: TCreateParams); begin 
    inherited CreateParams(Params); 
    with Params do 
    begin 
    if FHotTrack then Style := Style or TCS_HOTTRACK; 
    if FScrollOpposite then Style := Style or TCS_SCROLLOPPOSITE; 
    case FTabAlign of 
    pcaBottom: Style := Style or TCS_BOTTOM; pcaLeft:   Style := Style or 
TCS_VERTICAL; pcaRight:  Style := Style or TCS_VERTICAL or TCS_RIGHT ; end; 
end; end; 
    procedure THotPageControl.SetScrollOpposite(Value: Boolean); begin 
    if (FScrollOpposite <> Value) then begin 
    FScrollOpposite := Value; 
    //  RecreateWnd   TWinControl; //    
   . RecreateWnd; end; end; 
    procedure THotPageControl.SetHotTrack(Value: Boolean); begin 
    if (FHotTrack <> Value) then begin 
    FHotTrack := Value; RecreateWnd; end; end; 
    procedure THotPageControl.SetTabAlign(Value: TabAlignments); begin 
    if (FTabAlign <> Value) then begin 
    FTabAlign := Value; RecreateWnd; end; end; 
    procedure Register; begin 
    RegisterComponents('UDELPHI3', [THotPageControl]); end; 
    end. 


     7.    Win32       211 

