nonVCL - Erstellung eines Tabsheet Controls

[semo]

so, nach den feiertagen mal ein kleines update,
wo ich wie gewünscht die tabsheets als windows implementiert und mit subcontrols versehen habe.
ist dies nun so ausreichend (@luckie)?

Delphi-Quellcode:

program TabsheetControlNonVCL;
{ this little project describes how to create a window with a tab control      }
{ without using any dialogs and resourcefiles                                  }

{$R 'resources.res' 'resources.RC'}

uses
  Windows,
  commctrl,
  Messages;

const
  const_CLASSNAME  = 'ClassNameForm1';
  const_WINDOWNAME = 'Tabsheet Control - nonVCL';

  IDC_TAB0WINDOW   = 1;
  IDC_TAB1WINDOW   = 2;
  IDC_TAB2WINDOW   = 3;
  IDC_MAINWINDOW   = 4;
  IDC_BUTTON1      = 5;
  IDC_BUTTON2      = 6;
  IDC_BUTTON3      = 7;

  constSpace       = 10;

  
////////////////////////////////////////////////////////////////////////////////
//
// some forward declarations
//

// window procedures
function WndProc_MainForm(wnd: HWND; uMsg: UINT; wp: WPARAM; lp: LPARAM): LRESULT; stdcall; forward;
function WndProc_Tab0(wnd: HWND; uMsg: UINT; wp: WPARAM; lp: LPARAM): LRESULT; stdcall; forward;
function WndProc_Tab1(wnd: HWND; uMsg: UINT; wp: WPARAM; lp: LPARAM): LRESULT; stdcall; forward;
function WndProc_Tab2(wnd: HWND; uMsg: UINT; wp: WPARAM; lp: LPARAM): LRESULT; stdcall; forward;

// font handling
procedure CreateGlobalFont(); forward;
procedure AssignFontToControl(aHwnd: HWND); forward;

// helper methods
procedure CreateTabsheetControl(wnd: HWND); forward;
function getHandleOfActiveTabsheet(): HWND; forward;

var
  g_hwnd_MainwWindow,
  g_hwnd_Font,
  g_hwnd_Tabcontrol,
  g_hwnd_Tab0Window,
  g_hwnd_Tab1Window,
  g_hwnd_Tab2Window,
  g_hwnd_Tab0Button1,
  g_hwnd_Tab1Button2,
  g_hwnd_Tab2Button3 : HWND;

  msg : TMsg;

  // structure of our main window class
  wc: TWndClassEx = (
    cbSize          : SizeOf(TWndClassEx);
    Style           : CS_HREDRAW or CS_VREDRAW;
    lpfnWndProc     : @WndProc_MainForm;
    cbClsExtra      : 0;
    cbWndExtra      : 0;
    lpszMenuName    : nil;
    hIconSm         : 0;
  );

  // structure of our tab0 window class
  wc_tab0: TWndClassEx = (
    cbSize          : SizeOf(TWndClassEx);
    Style           : CS_HREDRAW or CS_VREDRAW;
    lpfnWndProc     : @WndProc_Tab0;
    cbClsExtra      : 0;
    cbWndExtra      : 0;
    lpszMenuName    : nil;
    hIconSm         : 0;
  );

  // structure of our tab1 window class
  wc_tab1: TWndClassEx = (
    cbSize          : SizeOf(TWndClassEx);
    Style           : CS_HREDRAW or CS_VREDRAW;
    lpfnWndProc     : @WndProc_Tab1;
    cbClsExtra      : 0;
    cbWndExtra      : 0;
    lpszMenuName    : nil;
    hIconSm         : 0;
  );

  // structure of our tab1 window class
  wc_tab2: TWndClassEx = (
    cbSize          : SizeOf(TWndClassEx);
    Style           : CS_HREDRAW or CS_VREDRAW;
    lpfnWndProc     : @WndProc_Tab2;
    cbClsExtra      : 0;
    cbWndExtra      : 0;
    lpszMenuName    : nil;
    hIconSm         : 0;
  );


procedure CreateGlobalFont();
// =============================================================================
// create a font
// =============================================================================
begin
  g_hwnd_Font := CreateFont(  -11, 0, 0, 0, 0, 0, 0, 0,
                              ANSI_CHARSET,
                              OUT_DEFAULT_PRECIS,
                              CLIP_DEFAULT_PRECIS,
                              DEFAULT_QUALITY,
                              DEFAULT_PITCH,
                              'MS Sans Serif');
end;


procedure AssignFontToControl(aHwnd: HWND);
// =============================================================================
// Assign the system font to the specified control
// =============================================================================
begin
  if g_hwnd_Font <> 0 then
    SendMessage(aHwnd, WM_SETFONT, Integer(g_hwnd_Font), Integer(true));
end;


function getHandleOfActiveTabsheet(): HWND;
// -----------------------------------------------------------------------------
// returns the handle of the active sheet in tabcontrol
// -----------------------------------------------------------------------------
begin
  case SendMessage(g_hwnd_Tabcontrol, TCM_GETCURSEL, 0, 0) of
    0:   Result := g_hwnd_Tab0Window;
    1:   Result := g_hwnd_Tab1Window;
    else Result := g_hwnd_Tab2Window;
  end;
end;



procedure CreateTabsheetControl(wnd: HWND);
// =============================================================================
// creates a tabsheet control
// =============================================================================

  function AddTab(sCaption: string; iIndex: Integer; wnd: HWND): boolean;
  //----------------------------------------------------------------------------
  // insert a tabitem to the tabsheetcontrol
  //----------------------------------------------------------------------------
  var
    aTabItem : TC_ITEM;
  begin
    with aTabItem do
    begin
      mask    := TCIF_TEXT or TCIF_IMAGE;
      iImage  := -1;
      pszText := PAnsiChar(sCaption); { the caption of tabsheet  }
    end;

    // send the insert message to the tabcontrol
    Result := SendMessage(wnd, TCM_INSERTITEM, iIndex, Integer(@aTabItem)) <> -1;
  end;

var
  WindowRect : TRect;
  TabRect    : TRect;
begin
  // get the measures of the mainwindow
  GetClientRect(wnd, &WindowRect);

  // load the common controls DLL
  InitCommonControls();

  // calculate the measurements of the tabsheet control 
  SetRect( &TabRect,
           constSpace,
           constSpace,
           WindowRect.right-2*constSpace,
           WindowRect.bottom-2*constSpace);

  // create the tabsheet control
  g_hwnd_Tabcontrol := CreateWindow( WC_TABCONTROL, '',
                                     WS_CHILD or WS_CLIPSIBLINGS or WS_VISIBLE or TCS_TOOLTIPS,
                                     {left}TabRect.Left,
                                     {top}TabRect.Top,
                                     {right}TabRect.Right,
                                     {bottom}TabRect.Bottom,
                                     wnd,
                                     0,
                                     HInstance,
                                     nil );
  // add tabs
  if (g_hwnd_Tabcontrol <> 0) then
  begin
    AddTab('1. tabsheet',  0, g_hwnd_Tabcontrol);
    AddTab('and here is the second tab', 1, g_hwnd_Tabcontrol);
    AddTab('third tab', 2, g_hwnd_Tabcontrol);
  end;

  AssignFontToControl(g_hwnd_Tabcontrol);


  // tab0 ----------------------------------------------------------------------

  // fill structure with infos about our window
  with wc_tab0 do
  begin
    // set the cursor
    hCursor := LoadCursor(0, IDC_ARROW);

    // set the icon
    hIcon := LoadIcon(hInstance, IDI_INFORMATION);

    // set the background
    hbrBackground := GetSysColorBrush(COLOR_3DFACE);

    // the classname has to be unique in our process
    lpszClassName := PAnsiChar('tab0');
  end;
  wc_tab0.hInstance := hInstance;

  // register the window
  RegisterClassEx(wc_tab0);

  // create the window
  g_hwnd_Tab0Window := CreateWindowEx( 0,
                                       PAnsiChar('tab0'),
                                       PAnsiChar('no caption'),
                                       WS_VISIBLE or WS_CHILD,
                                       1,
                                       21,
                                       TabRect.Right-4,
                                       TabRect.Bottom-24,
                                       g_hwnd_Tabcontrol,
                                       IDC_TAB0WINDOW,
                                       hInstance,
                                       nil);

  // tab1 ----------------------------------------------------------------------

  // fill structure with infos about our window
  with wc_tab1 do
  begin
    // set the cursor
    hCursor := LoadCursor(0, IDC_ARROW);

    // set the icon
    hIcon := LoadIcon(hInstance, IDI_INFORMATION);

    // set the background
    hbrBackground := GetSysColorBrush(COLOR_3DFACE);

    // the classname has to be unique in our process
    lpszClassName := PAnsiChar('tab1');
  end;
  wc_tab1.hInstance := hInstance;

  // register the window
  RegisterClassEx(wc_tab1);

  // create the window
  g_hwnd_Tab1Window := CreateWindowEx( 0,
                                       PAnsiChar('tab1'),
                                       PAnsiChar('no caption'),
                                       WS_CHILD,
                                       1,
                                       21,
                                       TabRect.Right-4,
                                       TabRect.Bottom-24,
                                       g_hwnd_Tabcontrol,
                                       IDC_TAB1WINDOW,
                                       hInstance,
                                       nil);

  // tab2 ----------------------------------------------------------------------

  // fill structure with infos about our window
  with wc_tab2 do
  begin
    // set the cursor
    hCursor := LoadCursor(0, IDC_ARROW);

    // set the icon
    hIcon := LoadIcon(hInstance, IDI_INFORMATION);

    // set the background
    hbrBackground := GetSysColorBrush(COLOR_3DFACE);

    // the classname has to be unique in our process
    lpszClassName := PAnsiChar('tab2');
  end;
  wc_tab2.hInstance := hInstance;

  // register the window
  RegisterClassEx(wc_tab2);

  // create the window
  g_hwnd_Tab2Window := CreateWindowEx( 0,
                                       PAnsiChar('tab2'),
                                       PAnsiChar('no caption'),
                                       WS_CHILD,
                                       1,
                                       21,
                                       TabRect.Right-4,
                                       TabRect.Bottom-24,
                                       g_hwnd_Tabcontrol,
                                       IDC_TAB2WINDOW,
                                       hInstance,
                                       nil);
end;


function WndProc_MainForm(wnd: HWND; uMsg: UINT; wp: WPARAM; lp: LPARAM): LRESULT; stdcall;
// =============================================================================
// handle the messages of our main window
// =============================================================================
var
  TabRect    : TRect;
  WindowRect : TRect;
  nmptr      : PNMHdr;
begin
  Result := 0;
  case uMsg of
    // -------------------------------------------------------------------------
    // creating the window and its controls (= subwindows)
    WM_CREATE:
      begin
        // create the tabsheet control
        CreateTabsheetControl(wnd);
      end;
      

    // -------------------------------------------------------------------------
    // the resize event 
    WM_SIZE:
      begin
        // get the new measurements
        SetRect( &TabRect,
                 constSpace,
                 constSpace,
                 LOWORD(lp) - 2*constSpace,
                 HIWORD(lp) - 2*constSpace );

        // set the new position of the tabcontrol
        MoveWindow( g_hwnd_Tabcontrol,
                    {left}TabRect.Left,
                    {top}TabRect.Top,
                    {right}TabRect.Right,
                    {bottom}TabRect.Bottom,
                    true);

        // set the new position of the tabcontrol
        SetWindowPos( getHandleOfActiveTabsheet(),
                      0,
                      {left}TabRect.Left,
                      {top}TabRect.Top,
                      {right}TabRect.Right-4,
                      {bottom}TabRect.Bottom-24,
                      SWP_SHOWWINDOW or SWP_NOMOVE);
      end;


    // -------------------------------------------------------------------------
    // the actual tabsheet has changed
    WM_NOTIFY:
      begin
        nmptr := PNMHdr(lp);
        if (nmptr.code = TCN_SELCHANGE) then
        begin
          // get the measures of the mainwindow
          GetClientRect(wnd, &WindowRect);
          
          case TabCtrl_GetCurFocus(nmptr.hwndFrom) of
            0:
            begin
              // show the first tabsheet(-window)
              ShowWindow(g_hwnd_Tab0Window, SW_SHOW);
              
              // hide the second tabsheet(-window)
              ShowWindow(g_hwnd_Tab1Window, SW_HIDE);

              // hide the third tabsheet(-window)
              ShowWindow(g_hwnd_Tab2Window, SW_HIDE);
            end;

            1:
            begin
              // hide the first tabsheet(-window)
              ShowWindow(g_hwnd_Tab0Window, SW_HIDE);

              // show the second tabsheet(-window)
              ShowWindow(g_hwnd_Tab1Window, SW_SHOW);

              // hide the third tabsheet(-window)
              ShowWindow(g_hwnd_Tab2Window, SW_HIDE);
            end;

            2:
            begin
              // hide the first tabsheet(-window)
              ShowWindow(g_hwnd_Tab0Window, SW_HIDE);
              
              // hide the second tabsheet(-window)
              ShowWindow(g_hwnd_Tab1Window, SW_HIDE);

              // show the third tabsheet(-window)
              ShowWindow(g_hwnd_Tab2Window, SW_SHOW);    
            end;
          end;

          // resize the mainwindow -->
          // ensures, that the active tabsheet window fits the tabsheet control  
          SendMessage( g_hwnd_MainwWindow,
                       WM_SIZE,
                       0,
                       MAKELPARAM( WindowRect.Right-WindowRect.Left,
                                   WindowRect.Bottom-WindowRect.Top ) );
        end;
      end;

    // destroying the window ---------------------------------------------------
    WM_DESTROY: PostQuitMessage(0);
  else
    // ensures that we process every message
    Result := DefWindowProc(wnd,uMsg,wp,lp);
  end;
end;


function WndProc_Tab0(wnd: HWND; uMsg: UINT; wp: WPARAM; lp: LPARAM): LRESULT; stdcall;
// =============================================================================
// handle the messages of our tab0 window
// =============================================================================
var
  TabRect: TRect;
begin
  Result := 0;

  case uMsg of
    // -------------------------------------------------------------------------
    // creating the window and its controls (= subwindows)
    WM_CREATE:
      begin
        // create the button
        g_hwnd_Tab0Button1 := CreateWindowEx( 0,
                                              PAnsiChar('BUTTON'),
                                              PAnsiChar('this is a button an sheet 1'),
                                              WS_VISIBLE or WS_CHILD{ or BS_BITMAP},
                                              25,25,150,50,
                                              wnd,
                                              IDC_BUTTON1,
                                              hInstance,
                                              nil);

        // assign the font to the button
        AssignFontToControl(g_hwnd_Tab0Button1);
      end;

    // -------------------------------------------------------------------------
    WM_COMMAND:
      begin
        // a control was clicked
        if (hiword(wp) = BN_CLICKED) then
        begin
          case loword(wp) of
            IDC_BUTTON1: MessageBox( g_hwnd_MainwWindow,
                                     'you have clicked the button on the first tabsheet',
                                     'hint',
                                     MB_OK);
          end;
        end;
      end;

  else
    // ensures that we process every message
    Result := DefWindowProc(wnd,uMsg,wp,lp);
  end;
end;


function WndProc_Tab1(wnd: HWND; uMsg: UINT; wp: WPARAM; lp: LPARAM): LRESULT; stdcall;
var
  TabRect: TRect;
// =============================================================================
// handle the messages of our tab1 window
// =============================================================================
begin
  Result := 0;

  case uMsg of
    // -------------------------------------------------------------------------
    // creating the window and its controls (= subwindows)
    WM_CREATE:
      begin
        // create the button
        g_hwnd_Tab1Button2 := CreateWindowEx( 0,
                                              PAnsiChar('BUTTON'),
                                              PAnsiChar('this is a button an sheet 2'),
                                              WS_VISIBLE or WS_CHILD{ or BS_BITMAP},
                                              50,50,175,75,
                                              wnd,
                                              IDC_BUTTON2,
                                              hInstance,
                                              nil);

        // assign the font to the button
        AssignFontToControl(g_hwnd_Tab1Button2);
      end;

    // -------------------------------------------------------------------------
    WM_COMMAND:
      begin
        // a control was clicked
        if (hiword(wp) = BN_CLICKED) then
        begin
          case loword(wp) of
            IDC_BUTTON2: MessageBox( g_hwnd_MainwWindow,
                                     'you have clicked the button on the second tabsheet',
                                     'hint',
                                     MB_OK);
          end;
        end;
      end;

  else
    // ensures that we process every message
    Result := DefWindowProc(wnd,uMsg,wp,lp);
  end;
end;


function WndProc_Tab2(wnd: HWND; uMsg: UINT; wp: WPARAM; lp: LPARAM): LRESULT; stdcall;
var
  TabRect: TRect;
// =============================================================================
// handle the messages of our tab2 window
// =============================================================================
begin
  Result := 0;

  case uMsg of
    // -------------------------------------------------------------------------
    // creating the window and its controls (= subwindows)
    WM_CREATE:
      begin
        // create the button
        g_hwnd_Tab2Button3 := CreateWindowEx( 0,
                                              PAnsiChar('BUTTON'),
                                              PAnsiChar('this is a button an sheet 3'),
                                              WS_VISIBLE or WS_CHILD{ or BS_BITMAP},
                                              75,75,200,100,
                                              wnd,
                                              IDC_BUTTON3,
                                              hInstance,
                                              nil);

        // assign the font to the button
        AssignFontToControl(g_hwnd_Tab2Button3);
      end;

    // -------------------------------------------------------------------------
    WM_COMMAND:
      begin
        // a control was clicked
        if (hiword(wp) = BN_CLICKED) then
        begin
          case loword(wp) of
            IDC_BUTTON3: MessageBox( g_hwnd_MainwWindow,
                                     'you have clicked the button on the third tabsheet',
                                     'hint',
                                     MB_OK);
          end;
        end;
      end;

  else
    // ensures that we process every message
    Result := DefWindowProc(wnd,uMsg,wp,lp);
  end;
end;


// =============================================================================
// main method
// =============================================================================
begin
  // create a font 
  CreateGlobalFont();
  
  // fill structure with infos about our window
  with wc do
  begin
    // set the cursor
    hCursor := LoadCursor(0, IDC_ARROW);

    // set the icon
    hIcon := LoadIcon(hInstance, IDI_INFORMATION);

    // set the background
    hbrBackground := GetSysColorBrush(COLOR_3DFACE);

    // the classname has to be unique in our process
    lpszClassName := PAnsiChar(const_CLASSNAME);
  end;
  wc.hInstance := hInstance;

  // register the window
  RegisterClassEx(wc);

  // create the window
  // -----------------
  // hint:
  // style = WS_EX_COMPOSITED --> Paints all descendants of a window in
  // bottom-to-top painting order using double-buffering
  g_hwnd_MainwWindow := CreateWindowEx(
                        WS_EX_COMPOSITED,{ style }
                        PAnsiChar(const_CLASSNAME), { ClassName }
                        PAnsiChar(const_WINDOWNAME), { WindowName }
                        WS_VISIBLE or WS_OVERLAPPEDWINDOW,
                        10,
                        10,
                        700, 550, 0, 0,
                        hInstance,
                        nil);

  // message loop --------------------------------------------------------------
  while(GetMessage(msg,0,0,0)) do
  begin
    TranslateMessage(msg);
    DispatchMessage(msg);
  end;
end.