% *********************************************************************
%     VISG Generator for Pascal programming language under Win32 API.
%     (C) 2007, Alexander G. Karpov a.k.a. mrhx.
%     http://mrhx.clan.su/
%     Russia, Saint Petersburg.
%
%     v1: May 8, 2007
%     v2: June 19, 2007
%     v3: June 30, 2007
%     v4: July 03, 2007: modified tab notify message processing.
%     v5: July 25, 2007: use the name of a control instead of direct integer identifier.
%     v6: August 16-22, 2007: visg09, event handlers.
%     v7: Sep 11 2007: visg092
%     v8: Oct 07 2007: visg093
% *********************************************************************

%set type 	generator
%set lang 	Pascal
%set platform 	"Win32 API, Free Pascal"
%set icon 	"small/gen_pas.bmp"
%set big_icon 	"big/gen_pas.ico"

%set author "Alexander G. Karpov a.k.a. mrhx"
%set date "Oct 07 2007"
%set version 8
%set www "http://mrhx.clan.su/"

%include common/gen_init

%set gen:conv_cr 	"' + #13 + '"
%set gen:conv_nl 	"' + #10 + '"
%set gen:conv_tab 	"' + #09 + '"
%set gen:conv_apo	"''"
%set gen:conv_str	"'"
%set gen:conv_replace_0a  " + '''"
%set gen:conv_replace_0b  " + $''"
%set gen:conv_replace_1a  "''' + "
%set gen:conv_replace_1b  "''$ + "
%set gen:conv_replace_2a  " + ''"
%set gen:conv_replace_3a  "'' + "
%set gen:conv_replace_4a  " + $''"
%set gen:conv_replace_4b  " + '''"
%set gen:conv_replace_5a  "''$ + "
%set gen:conv_replace_5b  "''' + "
%set gen:conv_replace_6a  "#13 + #10"
%set gen:conv_replace_6b  "#13#10"
%set gen:conv_replace_7a  "#13#10 + #13#10"
%set gen:conv_replace_7b  "#13#10#13#10"
%set gen:comment_begin 	"{"
%set gen:comment_end	"}"
%set gen:tested_on	"Free Pascal 2.2.0"
%set gen:const		"%gen:tab%%name% = %value%;"
%set gen:name(NULL)	"nil"
%set gen:name(NULL_HWND) "0"
%set gen:name(TRUE)	"1"
%set gen:localvar	"%name%: %type%;"
%set gen:func0		"function %name%: %type%;"
%set gen:func1		"function %name%(%args%): %type%;"
%set gen:func_arg0	"%arg%: %type%"
%set gen:func_arg1	"%arg%: %type%; "
%set gen:func_end	"end;"
%set gen:func_begin0	"var"
%set gen:func_begin	"begin"
%set gen:proc0		"procedure %name%;"
%set gen:proc1		"procedure %name%(%args%);"
%set gen:proc_end	"end;"
%set gen:proc_begin0	"var"
%set gen:proc_begin	"begin"
%set gen:call0		"%name%"
%set gen:call1		"%name%(%args%)"
%set gen:call_arg0	"%arg%"
%set gen:call_arg1	"%arg%, "
%set gen:endl		";"
%set gen:hex_prefix	"$"
%set gen:return0	"exit"
%set gen:return1	"%current_function% := %value%"
%set gen:set		"%dest% := %src%"
%set gen:cast		"%type%(%value%)"
%set gen:dot		"%struct%.%field%"
%set gen:or		"%value1% or %value2%"
%set gen:strptr		"LPSTR(%str%)"
%set gen:adr		"@%name%"
%set gen:str 		"'"

%include common/gen_validate
%include common/winapi

%code
%include common/header

{$APPTYPE GUI}
program my_prog;

uses windows;
%if any_window_exists

const
%include common/winapi_clsnames
%include common/winapi_ids
%if class_exists SysTabControl32

{ needed types }
type
	nmhdr_t = record hwndFrom, idFrom, code: longint; end;
	nmhdr_p = ^nmhdr_t;
%end if
%if any_window_exists

{ function prototypes }
%end if
%for each window
function wnd_proc%w.index%(window: HWND; message: UINT; w_param: WPARAM; l_param: LPARAM): LRESULT; stdcall; forward; export;
function create_wnd%w.index%: HWND; forward;
procedure create_wnd_content%w.index%(parent: HWND); forward;
%end for

{ global data }
var instance: longint;  { HINSTANCE }
%if any_window_exists
    h_font: HFONT;
%end if

%for each window
%include common/scanctl %w.index%
%set need_wm_command no
%if ctlexist(button) == yes
%.	set need_wm_command yes
%end if
%if ctlexist(checkbox) == yes
%.	set need_wm_command yes
%end if
{ window procedure #%w.index% [%w.caption%] }
function wnd_proc%w.index%(window: HWND; message: UINT; w_param: WPARAM; l_param: LPARAM): LRESULT; stdcall; export;
%if child_class_exists SysTabControl32
var show: longint;
    ctl: HWND;
    p_nmhdr: nmhdr_p absolute l_param;
    tci: TC_ITEM;
%end if
begin
	case message of
%if need_wm_command == yes
	WM_COMMAND:
		begin
			case LOWORD(w_param) of
%end if
%for each control
%if c.alias == button
%include common/strconvsp c.caption
			%c.id%:    { button '%c.caption%' }
				begin
					MessageBox(window, 'the button %c.id% is clicked.', 'Event', MB_OK or MB_ICONINFORMATION);
				end;

%end if
%end for
%for each control
%if c.alias == check
%include common/strconvsp c.caption
			%c.id%:	   { checkbox '%c.caption%' }
				begin
					if IsDlgButtonChecked(window, %c.id%) = BST_CHECKED then
						begin
							MessageBox(window, 'the checkbox %c.id% is checked.', 'Event', MB_OK or MB_ICONINFORMATION);
						end
					else
						begin
							MessageBox(window, 'the checkbox %c.id% is unchecked.', 'Event', MB_OK or MB_ICONINFORMATION);
						end;
				end;

%end if
%end for
%if need_wm_command == yes
			end;
		end;

%end if
%if child_class_exists SysTabControl32
	WM_NOTIFY:
		if (p_nmhdr^.code = TCN_SELCHANGING) or (p_nmhdr^.code = TCN_SELCHANGE) then
			begin
				if p_nmhdr^.code = TCN_SELCHANGE then show := SW_SHOW else show := SW_HIDE;
				tci.mask := TCIF_PARAM;
				ctl := GetWindow(window, GW_CHILD);
				SendMessage(p_nmhdr^.hwndFrom, TCM_GETITEM, SendMessage(p_nmhdr^.hwndFrom, TCM_GETCURSEL, 0, 0), LPARAM(@tci));
				while ctl <> 0 do
					begin
						if GetWindowLong(ctl, GWL_USERDATA) = tci.lParam then ShowWindow(ctl, show);
						ctl := GetWindow(ctl, GW_HWNDNEXT);
					end;
			end;

%end if
	WM_CREATE:
		begin
			create_wnd_content%w.index%(window);
		end;

	WM_CLOSE:
		begin
			if IDYES = MessageBox(window, 'Quit?', 'Event', MB_YESNO or MB_ICONQUESTION) then DestroyWindow(window);
		end;

	WM_DESTROY:
		begin
			PostQuitMessage(0);	{ PostQuitMessage(return_code) quits the message loop }
		end;
	else
		begin
			wnd_proc%w.index% := DefWindowProc(window, message, w_param, l_param);
			exit;
		end;
	end;
	wnd_proc%w.index% := 0;
end;

%end for
%include common/winapi_createwnd
%include common/winapi_wndcontent
%if any_window_exists
procedure register_classes;
var wc: WNDCLASS;
begin
	wc.cbClsExtra    := 0;
	wc.cbWndExtra    := 0;
	wc.hbrBackground := HBRUSH(COLOR_3DFACE + 1);
	wc.hCursor       := LoadCursor(0, IDC_ARROW);
	wc.hIcon         := LoadIcon(0, IDI_APPLICATION);
	wc.hInstance     := instance;
	wc.lpszMenuName  := nil;
	wc.style         := CS_PARENTDC or CS_DBLCLKS;
%for each window

	wc.lpfnWndProc   := @wnd_proc%w.index%;
	wc.lpszClassName := WND_CLASS_NAME%w.index%;

	RegisterClass(@wc);
%end for
end;

{ message loop }
function message_loop: integer;
var message: MSG;
begin
	while GetMessage(@message, 0, 0, 0) do
		begin
			TranslateMessage(@message);
			DispatchMessage(@message);
		end;
	message_loop := message.wParam;
end;

%end if
BEGIN
	instance := GetModuleHandle(nil);
%if any_window_exists
	InitCommonControls;
%for each window
%for each control
%ifnot c.library == ""
%ifnot c.library in g_loaded_libraries
	LoadLibrary('%c.library%');
%setex g_loaded_libraries "%g_loaded_libraries%|%c.library%"
%end if
%end if
%end for
%end for
	register_classes;
	h_font := CreateFont(-%def_font.height%, 0, 0, 0, %def_font.weight%, %def_font.italic%,
				%def_font.underline%, 0, ANSI_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS,
				DEFAULT_QUALITY, DEFAULT_PITCH or FF_DONTCARE, '%def_font.name%');
%for each window
	create_wnd%w.index%;
%end for
	message_loop();
%end if
END.

{ End of file }
%nocode

% End of script.
