program TabsheetControlNonVCL;
{ this little project describes how to create a window with a tab control }
{ ============================================================================ }
uses
Windows,
commctrl,
Messages,
SysUtils;
const
const_CLASSNAME = '
ClassNameForm1';
const_WINDOWNAME = '
Tabsheet Control - nonVCL';
var
g_hwnd_MainwWindow : HWND;
g_hwnd_Tabcontrol : HWND;
function CreateTabsheetControl(wnd: HWND): 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);
end;
// send the insert message to the tabcontrol
Result := SendMessage(wnd, TCM_INSERTITEM, iIndex, Integer(@aTabItem)) <> -1;
end;
var
aRect : TRect;
myFont : HWND;
begin
// get the measures of the mainwindow
GetClientRect(wnd, &aRect);
// load the common controls DLL
InitCommonControls();
// create the tabsheet control
Result := CreateWindow( WC_TABCONTROL, '
',
WS_CHILD
or WS_CLIPSIBLINGS
or WS_VISIBLE,
0, 0, aRect.right, aRect.bottom,
wnd, 0, HInstance,
nil );
// add tabs
if (Result <> 0)
then
begin
AddTab('
first tab', 0, Result);
AddTab('
second tab', 1, Result);
AddTab('
third tab', 2, Result);
end;
// create a font for the captions of the tabsheets
MyFont := CreateFont( -11, 0, 0, 0, 0, 0, 0, 0,
ANSI_CHARSET,
OUT_DEFAULT_PRECIS,
CLIP_DEFAULT_PRECIS,
DEFAULT_QUALITY,
DEFAULT_PITCH,
'
MS Sans Serif');
// assign the font to the tabsheets
if MyFont <> 0
then
SendMessage(Result, WM_SETFONT, Integer(MyFont), Integer(true));
end;
function WndProc_MainForm(wnd: HWND; uMsg: UINT; wp: WPARAM; lp: LPARAM): LRESULT;
stdcall;
// =============================================================================
// handle the messages of our main window
// =============================================================================
var
aRec : TRect;
ahdwp : hdwp;
nmptr : PNMHdr;
iTabnumber : integer;
dc : HDC;
s :
string;
begin
Result := 0;
case uMsg
of
// -------------------------------------------------------------------------
// creating the window and its controls (= subwindows)
WM_CREATE:
begin
;
end;
// -------------------------------------------------------------------------
// the resize event --> assuming the tab control is the size of the client area
WM_SIZE:
begin
// calculate the display rectangle
SetRect( &aRec, 0, 0, LOWORD(lp), HIWORD(lp));
TabCtrl_AdjustRect(g_hwnd_Tabcontrol, FALSE, @aRec);
// size the tab control to fit the client area.
ahdwp := BeginDeferWindowPos(2);
DeferWindowPos( ahdwp, g_hwnd_Tabcontrol, 0, 0, 0,
LOWORD(lp), HIWORD(lp),
SWP_NOMOVE
or SWP_NOZORDER );
// Position and size the static control to fit the
// tab control's display area, and make sure the
// static control is in front of the tab control.
DeferWindowPos( ahdwp, g_hwnd_Tabcontrol, HWND_TOP,
aRec.left, aRec.top,
aRec.right - aRec.left, aRec.bottom - aRec.top, 0);
EndDeferWindowPos(ahdwp);
end;
// -------------------------------------------------------------------------
// react to changing the actual tabsheet
WM_NOTIFY:
begin
nmptr := PNMHdr(lp);
if (nmptr.code = TCN_SELCHANGE)
then
begin
iTabnumber := TabCtrl_GetCurFocus(nmptr.hwndFrom);
s := '
you are now on the';
case iTabnumber
of
0: s := s + '
first tabsheet';
1: s := s + '
second tabsheet';
2: s := s + '
third tabsheet';
end;
MessageBox(wnd, PAnsiChar(s), '
hint', MB_OK);
end;
end;
// destroying the window ---------------------------------------------------
WM_DESTROY: PostQuitMessage(0);
else
// ensures that we process every message
Result := DefWindowProc(wnd,uMsg,wp,lp);
end;
end;
// =============================================================================
// main method
// =============================================================================
var
msg : TMsg;
// structure of our window class
wc: TWndClassEx = (
cbSize : SizeOf(TWndClassEx);
Style : CS_HREDRAW
or CS_VREDRAW;
lpfnWndProc : @WndProc_MainForm;
cbClsExtra : 0;
cbWndExtra : 0;
lpszMenuName :
nil;
hIconSm : 0;
);
begin
// 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
g_hwnd_MainwWindow := CreateWindowEx( 0,
PAnsiChar(const_CLASSNAME),
{ ClassName }
PAnsiChar(const_WINDOWNAME),
{ WindowName }
WS_VISIBLE
or WS_OVERLAPPEDWINDOW,
CW_USEDEFAULT,
CW_USEDEFAULT,
700, 500, 0, 0,
hInstance,
nil);
// create the tabsheet control
g_hwnd_Tabcontrol := CreateTabsheetControl(g_hwnd_MainwWindow);
// message loop --------------------------------------------------------------
while(GetMessage(msg,0,0,0))
do
begin
TranslateMessage(msg);
DispatchMessage(msg);
end;
end.