********************
* C4W2NTK TUTORIAL
********************
* This is a NTK emulation of the original C4W sample named:
* \CLIP4WIN\SOURCE\DEM4MOLD.PRG
*
*
* The NTK make procedure is:
* MKRAD DEM4MOLD
*
*
* I can't believe it's Clip4Win!
* Powered by NTK - http://www.ntkproject.com
********************





////////////////////////////
//
//	Clip-4-Win demo 4  (multi-window version)
//
//	Copyright (C) 1992 Skelton Software, Kendal Cottage, Hillam, Leeds, UK.
//	All Rights Reserved.
//
//
//	Compile:	dem4m /n /w
//	Link:		/se:600 dem4m,,,clip4win,clip4win.def
//
////////////////////////////


// NTK: C4W/Clipper deprecated
/*
#define	WIN_WANT_CLIPBOARD
#include "windows.ch"
#include "font.ch"
*/


// jnd: just add that for NTK
#include "windows.ch"
#include "ntkmsg.ch"     // Window messages def.
#include "ntkmenus.ch"   // NTK menu def.
#include "ntkgdi.ch"     // NTK Gdi & font def.
#include "ntkimg.ch"     // NTK bmp & image def.
#include "ntkcmd.ch"     // NTK rad msg and cmd def. (i.e. @...Say )

#include "c4w2ntk.ch"    // C4W msg def and NTK translations


#define	CR	chr(13)


static	cAppName := "Clip-4-Win"
static	hWnd, hInst, hPrevInst, nCmdShow
static	cText := ""
static	aWnd := {}, aAction := {}	// for event handlers


function main()
local	hMenu, nEvent

REQUEST HB_GT_GUI_DEFAULT // for [xHarbour] version > 0.99.7. We want to hear tone()
// PRIVATE	aWnd := {}, aAction := {}	// Default declaration when using C4W2NTK_EVENTHANDLER and/or WE_DONTWANT_C4W2NTK_CHECKEVENT

hWnd = WinSetup(cAppName, "Clip-4-Win demo 4 (multi-window)")
hMenu = MenuSetup()
HideCaret(hWnd)
AddHandler(hWnd, {|nEvent| MainEvent(nEvent)})

do while .t.
	do while (nEvent := ChkEvent()) == EVENT_NONE
		// some "background" processing could go here
	enddo
	HandleEvent(nEvent)
	do case
	case nEvent == EVENT_QUIT
		DoExit()
	endcase
enddo

return 0


procedure MainEvent(nEvent)
local	hOldWnd
do case
case nEvent == EVENT_REDRAW
	hOldWnd = SelectWindow(hWnd)
	@ 10, 10 say "(This window intentionally left blank.)"
	SelectWindow(hOldWnd)
endcase
return


procedure DoAbout()
MessageBox( , "Demo written by John Skelton and Greg Lief"+chr(13)+"Powered by NTK - http://www.ntkproject.com", "Info", MB_OK)
return


procedure DoExit()
MessageBox(0, "Thanks for running this Clip-4-Win demo"+chr(13)+"Powered by NTK - http://www.ntkproject.com", "Clip-4-Win Demo Exiting", MB_OK)
quit
return


procedure DoAudio()
local   hLib, cSound, i

// NTK: Too old and not Win32 compliant.
/*
hLib = LoadLibrary("MMSYSTEM.DLL")	// Windows 3.1 Multimedia library
cSound = GetProcAddress(hLib, "SndPlaySound", "Pascal", "Int", "string, int")
*/


// NTK: Better use this for win32 environements:
hLib   := LoadLibrary("WINMM.DLL")
cSound := GetProcAddress(hLib, "sndPlaySoundA", "Pascal", "INT", "string, int")


// second parameter: 1 == return instantly, 0 == wait until .WAV file
// finishes playing before returning
i = CallDLL(cSound, "C:\WINDOWS\TADA.WAV", 0)
if i != 0	// was played ok... do some more
	CallDLL(cSound, "C:\WINDOWS\CHIMES.WAV", 0)
	CallDLL(cSound, "C:\WINDOWS\DING.WAV", 0)
	CallDLL(cSound, "C:\WINDOWS\CHORD.WAV", 0)
else
	MessageBox( , "No audio hardware" + CR + "Or other error", MB_OK)
endif
return


procedure DoColour()
static	nX := 20, nY := 50
local	nColour := ChooseColor(), hWnd
if nColour >= 0		// else user chose cancel/close or hit Esc
	hWnd = WinNew(cAppName, "Colour", nX, nY += 60, 150, 100)
	AddHandler(hWnd, {|nEvent| ColourEvent(nEvent, hWnd, nColour)})
endif
return


procedure ColourEvent(nEvent, hWnd, nColour)
local	hDC, hBrush
do case
case nEvent == EVENT_REDRAW
	hDC = GetDC(hWnd)
	hBrush = CreateSolidBrush(nColour)
	FillRect(hDC, 0, 0, 100, 50, hBrush)
	DeleteObject(hBrush)
	ReleaseDC(hWnd, hDC)
endcase
return


procedure DoCutCopy(c)
static	nX := 200, nY := 200
local	hWnd
if OpenClipboard(hWnd)
	EmptyClipboard()
	SetClipboardData(CF_TEXT, "From Clip-4-Win" + CR + cText)
	if c == "cut"			// else "copy"
		cText = ""
	endif
	CloseClipboard()
	hWnd = WinNew(cAppName, c, nX, nY += 60, 150, 100)
	AddHandler(hWnd, {|nEvent| ClipbEvent(nEvent, hWnd, cText)})
else
	MessageBox( , "Clipboard not available", "Info", MB_OK)
endif
return


// You can put text into the clipboard in many ways, e.g. using the
// standard Windows notepad editor.
procedure DoPaste()
static	nX := 400, nY := 200
local	hWnd
if OpenClipboard(hWnd)
	cText = GetClipboardData(CF_TEXT)	// this gets the text
	CloseClipboard()
	if empty(cText)
		MessageBox( , "Clipboard is empty", "Info", MB_OK)
		cText = ""
	endif
	hWnd = WinNew(cAppName, "Paste", nX, nY += 60, 150, 100)
	AddHandler(hWnd, {|nEvent| ClipbEvent(nEvent, hWnd, cText)})
else
	MessageBox( , "Clipboard not available", "Info", MB_OK)
endif
return


procedure ClipbEvent(nEvent, hWnd, cText)
local	hDC
do case
case nEvent == EVENT_REDRAW
	hDC = GetDC(hWnd)
	DrawText(hDC, cText, GetClientRect(hWnd))
	ReleaseDC(hWnd, hDC)
endcase
return


procedure DoDLL()
static	nX := 20, nY := 200
local	hLib, cRectangle, hWnd

// NTK: Too old and not Win32 compliant.
/*
hLib = LoadLibrary("GDI.EXE")
cRectangle = GetProcAddress(hLib, "Rectangle", "Pascal", "Int", "int, int, int, int, int")
*/

hLib = LoadLibrary("GDI32.DLL")
cRectangle = GetProcAddress(hLib, "Rectangle", "Pascal", "Int", "handle, int, int, int, int")
hWnd = WinNew(cAppName, "DLL", nX, nY += 60, 200, 100)
AddHandler(hWnd, {|nEvent| DLLEvent(nEvent, hWnd, cRectangle)})
return


procedure DLLEvent(nEvent, hWnd, cRectangle)
local	hDC, cText
do case
case nEvent == EVENT_REDRAW
	hDC = GetDC(hWnd)
	cText = "CallDLL(Rectangle, ...) --> " + nstr(CallDLL(cRectangle, hDC, 10, 30, 100, 50))
	DrawText(hDC, cText, GetClientRect(hWnd))
	ReleaseDC(hWnd, hDC)
case nEvent == EVENT_LCLICK .or. nEvent == EVENT_RCLICK
	InvalidateRect(hWnd)
endcase
return


procedure DoFont()
static	nX := 200, nY := 50
local	aFont := {40, 40, 450, 0, 400, .t., .f., .f., 1, 0, 0, 0, 0, "Arial"}
local	hWnd, nColour := RGB(0, 255, 0)	// default to green
aFont := ChooseFont(aFont, , , @nColour)
if aFont != nil		// else user chose cancel/close or hit Esc
	hWnd = WinNew(cAppName, "Font", nX, nY += 60, 150, 100)
	AddHandler(hWnd, {|nEvent| FontEvent(nEvent, hWnd, aFont, nColour)})
   InvalidateRect(hWnd)
endif
return


procedure FontEvent(nEvent, hWnd, aFont, nColour)
local	hDC, hFont, hOldFont, i
local   aShow := { {200, 200, 300},	;	// these are {x, y, angle}
		   {100, 20, 0},	;
		   {150, 400, 1350},	;
		   {400, 200, 2700},	;
		   {10, 200, 800},	;
		   {0,  350, 1800},	;
		   {400, 20, 3150} }
do case
case nEvent == EVENT_REDRAW
	hDC = GetDC(hWnd)
	SetTextColor(hDC, nColour)
	for i = 1 to len(aShow)
		aFont[LF_Escapement] = aShow[i, 3]
		hFont = CreateFont(aFont)
		hOldFont = SelectObject(hDC, hFont)
		TextOut(hDC, aShow[i, 1], aShow[i, 2], "Clip-4-Win")
		SelectObject(hDC, hOldFont)
		DeleteObject(hFont)
	next i
	ReleaseDC(hWnd, hDC)
endcase
return


procedure DoPie()
static	nX := 400, nY := 50
local	hWnd, nColour := RGB(255, 0, 0)
	hWnd = WinNew(cAppName, "Pie", nX, nY += 60, 100, 100)
	AddHandler(hWnd, {|nEvent| PieEvent(nEvent, hWnd, nColour)})
return


procedure PieEvent(nEvent, hWnd, nColor)
local hDC, hBrush1, hBrush2, hBrush3, hOldbrush, aRect
do case
case nEvent == EVENT_REDRAW
	hBrush1 := CreateHatchBrush(HS_BDIAGONAL, nColor)
	aRect := GetClientRect(hWnd)
	hDC := GetDC(hWnd)
	hOldbrush := SelectObject(hDC, hBrush1)
	pie(hDC, 0, 0, aRect[3], aRect[4], aRect[3] / 2, 0, aRect[3], aRect[4] / 2)
	hBrush2 := CreateHatchBrush(HS_FDIAGONAL, RGB(0, 0, 255))
	SelectObject(hDC, hBrush2)
	pie(hDC, 0, 0, aRect[3], aRect[4], aRect[3], aRect[4] / 2, aRect[3] * .75, aRect[4] * .25)
	hBrush3 := CreateHatchBrush(HS_CROSS, RGB(0, 255, 0))
	SelectObject(hDC, hBrush3)
	pie(hDC, 0, 0, aRect[3], aRect[4], aRect[3] * .75, aRect[4] * .25, aRect[3] / 2, 0)
	SelectObject(hDC, hOldbrush)
	DeleteObject(hBrush1)
	DeleteObject(hBrush2)
	DeleteObject(hBrush3)
	ReleaseDC(hWnd, hDC)
endcase
return


procedure DoPrint()
local	hPrintDC, hIcon, hBrush, hOldBrush, hCursor, hOldCursor
local	nBlack := RGB(0, 0, 0)
local	i, nWidth, nHeight

// display printer dialog box, so the user can choose the settings
hPrintDC = GetPrintDC()
if empty(hPrintDC)
	// cancelled by the user
	return
endif

// print a test page

hCursor = LoadCursor( , IDC_WAIT)
hOldCursor = SetCursor(hCursor)

nWidth = GetDeviceCaps(hPrintDC, HORZRES)
nHeight = GetDeviceCaps(hPrintDC, VERTRES)

StartDoc(hPrintDC, "TestOutput")
StartPage(hPrintDC)

TextOut(hPrintDC, 100, 50, "Clip-4-Win Printer Test Page")
Rectangle(hPrintDC, 0, 0, nWidth, nHeight)
MoveTo(hPrintDC, 0, 0)
LineTo(hPrintDC, nWidth, nHeight)
MoveTo(hPrintDC, nWidth, 0)
LineTo(hPrintDC, 0, nHeight)

Arc(hPrintDC,   1000, 1000,   1300, 1200,   1250, 1190,   1100, 1100)

hBrush = CreateHatchBrush(HS_HORIZONTAL, nBlack)
hOldBrush = SelectObject(hPrintDC, hBrush)
Chord(hPrintDC, 1500, 1200,   2000, 1350,   1550, 1340,   1400, 1200)
SelectObject(hPrintDC, hOldBrush)
DeleteObject(hBrush)

hBrush = CreateHatchBrush(HS_BDIAGONAL, nBlack)
hOldBrush = SelectObject(hPrintDC, hBrush)
Pie(hPrintDC,   100, 1200,   700, 1500,   650, 1490,   120, 1280)
SelectObject(hPrintDC, hOldBrush)
DeleteObject(hBrush)

hBrush = CreateHatchBrush(HS_FDIAGONAL, nBlack)
hOldBrush = SelectObject(hPrintDC, hBrush)
Polygon(hPrintDC, { {1000, 250}, {1600, 500}, {1800, 100} })
SelectObject(hPrintDC, hOldBrush)
DeleteObject(hBrush)

PolyLine(hPrintDC, { {300, 700}, {100, 900}, {500, 1000} })


for i = 100 to 500 step 100
	TextOut(hPrintDC, i + 400, i + 100, nstr(i))
next i

EndPage(hPrintDC)
EndDoc(hPrintDC)

DeleteDC(hPrintDC)

SetCursor(hOldCursor)
return



procedure DoTimer()
static	nX := 500, nY := 50
static	lTimer := .F., nTicks, cText, hWnd
if !lTimer
	hWnd = WinNew(cAppName, "Timer", nX, nY, 100, 300)
	SetTimer(hWnd, 1, 1000)		// every 1000 millisecs (= every sec)
	lTimer = .T.
	nTicks = 0
	cText = ""
	AddHandler(hWnd, {|nEvent| TimerEvent(nEvent, hWnd, @nTicks, @lTimer, @cText)})
endif
return


procedure TimerEvent(nEvent, hWnd, nTicks, lTimer, cText)
local	hDC
do case
case nEvent == EVENT_TIMER
	if ++nTicks <= 10
		cText += CR + iif((nTicks % 2) == 1, "Tick", "Tock")
		InvalidateRect(hWnd)
	else
		KillTimer(hWnd, 1)
		lTimer = .F.
		DestroyWindow(hWnd)
	endif
case nEvent == EVENT_REDRAW
	hDC = GetDC(hWnd)
	DrawText(hDC, cText, GetClientRect(hWnd))
	ReleaseDC(hWnd, hDC)
endcase
return



function nstr(n)
return alltrim(str(n)) + " "



function asString(x)
local	v := valtype(x)

do case
case v == "C"
case v == "N"
	return nstr(x)
case v == "L"
	if x
		return ".T."
	else
		return ".F."
	endif
case v == "D"
	return "date"
case v == "U"
	return "NIL"
case v $ "AOB"
	return ""
otherwise
	return ""
end case

return x



function MenuSetup()
local	hWnd := SelectWindow(), hMenu, hPopupMenu

if (hMenu := GetMenu(hWnd)) != nil
	DestroyMenu(hMenu)
endif

// NTK: Beware to menu declarations
/*
// do new one (forget old value)
hMenu = CreateMenu()
hPopupMenu = CreatePopupMenu()
AppendMenu(hMenu, "file", MF_ENABLED + MF_POPUP, "&File", hPopupMenu)
AppendMenu(hPopupMenu, "new", MF_GRAYED + MF_STRING, "&New", {|| qout("new")})
AppendMenu(hPopupMenu, "open", MF_GRAYED + MF_STRING, "&Open", {|| qout("open")})
AppendMenu(hPopupMenu, "save", MF_GRAYED + MF_STRING, "&Save", {|| qout("save")})
AppendMenu(hPopupMenu, "saveas", MF_GRAYED + MF_STRING, "Save &As", {|| qout("save as")})
AppendMenu(hPopupMenu, "", MF_SEPARATOR)
AppendMenu(hPopupMenu, "print", MF_ENABLED + MF_STRING, "&Print", {|| DoPrint()})
AppendMenu(hPopupMenu, "", MF_SEPARATOR)
AppendMenu(hPopupMenu, "exit", MF_ENABLED + MF_STRING, "E&xit", {|| DoExit()})
hPopupMenu = CreatePopupMenu()
AppendMenu(hMenu, "edit", MF_ENABLED + MF_POPUP, "&Edit", hPopupMenu)
AppendMenu(hPopupMenu, "cut", MF_ENABLED + MF_STRING, "Cu&t", {|c| DoCutCopy(c)})
AppendMenu(hPopupMenu, "copy", MF_ENABLED + MF_STRING, "&Copy", {|c| DoCutCopy(c)})
AppendMenu(hPopupMenu, "paste", MF_ENABLED + MF_STRING, "&Paste", {|| DoPaste()})
AppendMenu(hPopupMenu, "", MF_SEPARATOR)
AppendMenu(hPopupMenu, "find", MF_GRAYED + MF_STRING, "&Find", {|c| qout(c)})
AppendMenu(hPopupMenu, "replace", MF_GRAYED + MF_STRING, "&Replace", {|c| qout(c)})
hPopupMenu = CreatePopupMenu()
AppendMenu(hMenu, "demo", MF_ENABLED + MF_POPUP, "&Demo", hPopupMenu)
AppendMenu(hPopupMenu, "audio", MF_ENABLED + MF_STRING, "&Audio", {|c| DoAudio()})
AppendMenu(hPopupMenu, "colour", MF_ENABLED + MF_STRING, "&Colour", {|c| DoColour()})
AppendMenu(hPopupMenu, "dll", MF_ENABLED + MF_STRING, "&DLL", {|c| DoDLL()})
AppendMenu(hPopupMenu, "font", MF_ENABLED + MF_STRING, "&Font", {|c| DoFont()})
AppendMenu(hPopupMenu, "pie chart", MF_ENABLED + MF_STRING, "P&ie Chart", {|c| DoPie()})
AppendMenu(hPopupMenu, "printer", MF_ENABLED + MF_STRING, "&Printer", {|c| DoPrint()})
AppendMenu(hPopupMenu, "timer", MF_ENABLED + MF_STRING, "&Timer", {|c| DoTimer()})
hPopupMenu = CreatePopupMenu()
AppendMenu(hMenu, "help", MF_ENABLED + MF_POPUP, "&Help", hPopupMenu)
AppendMenu(hPopupMenu, "about", MF_ENABLED + MF_STRING, "&About", {|| DoAbout()})
SetMenu(hWnd, hMenu)
*/


hMenu = CreateMenu()
hPopupMenu = CreatePopupMenu()
// NTK: AppendMenu(hMenu, "file", MF_ENABLED + MF_POPUP, "&File", hPopupMenu)
AppendMenu(hPopupMenu, "new", MF_GRAYED + MF_STRING, "&New", {|| qout("new")})
AppendMenu(hPopupMenu, "open", MF_GRAYED + MF_STRING, "&Open", {|| qout("open")})
AppendMenu(hPopupMenu, "save", MF_GRAYED + MF_STRING, "&Save", {|| qout("save")})
AppendMenu(hPopupMenu, "saveas", MF_GRAYED + MF_STRING, "Save &As", {|| qout("save as")})
AppendMenu(hPopupMenu, "", MF_SEPARATOR)
AppendMenu(hPopupMenu, "print", MF_ENABLED + MF_STRING, "&Print", {|| DoPrint()})
AppendMenu(hPopupMenu, "", MF_SEPARATOR)
AppendMenu(hPopupMenu, "exit", MF_ENABLED + MF_STRING, "E&xit", {|| DoExit()})
AppendMenu(hMenu, "file", MF_ENABLED + MF_POPUP, "&File", hPopupMenu)

hPopupMenu = CreatePopupMenu()
// NTK: AppendMenu(hMenu, "edit", MF_ENABLED + MF_POPUP, "&Edit", hPopupMenu)
AppendMenu(hPopupMenu, "cut", MF_ENABLED + MF_STRING, "Cu&t", {|c| DoCutCopy(c)})
AppendMenu(hPopupMenu, "copy", MF_ENABLED + MF_STRING, "&Copy", {|c| DoCutCopy(c)})
AppendMenu(hPopupMenu, "paste", MF_ENABLED + MF_STRING, "&Paste", {|| DoPaste()})
AppendMenu(hPopupMenu, "", MF_SEPARATOR)
AppendMenu(hPopupMenu, "find", MF_GRAYED + MF_STRING, "&Find", {|c| qout(c)})
AppendMenu(hPopupMenu, "replace", MF_GRAYED + MF_STRING, "&Replace", {|c| qout(c)})
AppendMenu(hMenu, "edit", MF_ENABLED + MF_POPUP, "&Edit", hPopupMenu)

hPopupMenu = CreatePopupMenu()
// NTK: AppendMenu(hMenu, "demo", MF_ENABLED + MF_POPUP, "&Demo", hPopupMenu)
AppendMenu(hPopupMenu, "audio", MF_ENABLED + MF_STRING, "&Audio", {|c| DoAudio()})
AppendMenu(hPopupMenu, "colour", MF_ENABLED + MF_STRING, "&Colour", {|c| DoColour()})
AppendMenu(hPopupMenu, "dll", MF_ENABLED + MF_STRING, "&DLL", {|c| DoDLL()})
AppendMenu(hPopupMenu, "font", MF_ENABLED + MF_STRING, "&Font", {|c| DoFont()})
AppendMenu(hPopupMenu, "pie chart", MF_ENABLED + MF_STRING, "P&ie Chart", {|c| DoPie()})
AppendMenu(hPopupMenu, "printer", MF_ENABLED + MF_STRING, "&Printer", {|c| DoPrint()})
AppendMenu(hPopupMenu, "timer", MF_ENABLED + MF_STRING, "&Timer", {|c| DoTimer()})
AppendMenu(hMenu, "demo", MF_ENABLED + MF_POPUP, "&Demo", hPopupMenu)

hPopupMenu = CreatePopupMenu()
//NTK: AppendMenu(hMenu, "help", MF_ENABLED + MF_POPUP, "&Help", hPopupMenu)
AppendMenu(hPopupMenu, "about", MF_ENABLED + MF_STRING, "&About", {|| DoAbout()})
AppendMenu(hMenu, "help", MF_ENABLED + MF_POPUP, "&Help", hPopupMenu)

SetMenu(hWnd, hMenu)


return hMenu


// NTK: *** DEPRECATED ***
// NTK: Those three function are now part of NTK since July 2009. See source code in \WNTK4HRB\NTKLIB\RADEX\rNTKC4W.prg

        function AddHandler(hWnd, bAction)	// --> nId  (for use with DelHandler)
        aadd(aWnd, hWnd)
        aadd(aAction, bAction)
        return len(aWnd)


        procedure DelHandler(nId)
        adel(aWnd, nId)
        asize(aWnd, len(aWnd) - 1)
        adel(aAction, nId)
        asize(aAction, len(aAction) - 1)
        return


        procedure HandleEvent(nEvent)
        local	hWnd := _LasthWnd(),  i := 0
        do while (i := ascan(aWnd, hWnd, ++i)) != 0
        	eval(aAction[i], nEvent)
        enddo
        if nEvent == EVENT_DESTROY
        	// clean up, so the event handler needn't bother
        	do while (i := ascan(aWnd, hWnd)) != 0
        		DelHandler(i)
        	enddo
        endif
        return


function WinNew(cAppName, cTitle, nX, nY, nWidth, nHeight)
local	hWin, hInst, nCmdShow

hInst = _GetInstance()
// NTK: no equivalent yet! nCmdShow = _GetnCmdShow()
nCmdShow = SW_SHOW

hWin = CreateWindow(cAppName,		;	// window class
		    cTitle, 		;	// caption for title bar
		    WS_OVERLAPPEDWINDOW,;	// window style
		    nX,			;	// x co-ordinate
		    nY,			;	// y co-ordinate
		    nWidth,		;	// width
		    nHeight,		;	// height
		    hWnd,		;	// hWnd of parent
		    0,			;	// hMenu of menu (none yet)
		    hInst)			// our own app instance

if hWin == 0
	// probably out of resources
	MessageBox( , "Can't create window", "Error", MB_OK)
	return nil
endif

HideCaret(hWin)

// make sure it's displayed ...
ShowWindow(hWin, nCmdShow)

// ... and up to date
UpdateWindow(hWin)

return hWin