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.