Companion of your development

[Tourist Trap]

Hi,

the project initiated here is useful for me in order to get a debug window running simultaneously with a project of GUI development. This wont be a too much active project right now for I've not enough time for it, but as it, it is sufficiently powerful as a concept to be worth testing for anyone in search of a solution for multiwindowing with no need of API calls. The second window here, where should lie for me the secondary debugging informations, is created according to the funny fact that a dll loaded dynamically can create its own standalone window.

Ok here is my current demonstration, and base for some future work on a gui I hope. As usual, I cant predict if it will compile and run without trouble for other plateforms than mine (xp win32), so any remarks and testing are very welcome.

The project here can't be melted into one file. This is basically a multifile project, with at least a main project and a dll for the companion. Note that this is an API free project, all is done with standard functions of the language itself.

Instruction at runtime:
Just drag the main window by the title bar and close the application with the button when done.

MAIN GUI PROGRAM

Code: Select all

'compiled and run ok on XP win32 - please test and report

'example of a simple fb graphical user interface                            
'-----------------------------------------------                            
'++ having its main window shaped by hand with a buffer as main display area
'++ having its debugger companion background screen                         
'>thanks go here to xlucas and sancho2 for the main windows moving mechanism
'>see freebasic forum for more about this topic... oops link                

':todo notes for my concern:                                                                            
'1-                                                                                
'get the companion be drawn each time the main window gets focus after he'd lost it
'will require screen events trapped for focus event trapping                       
'2-                                                                                
'maybe some main window resizing would be welcome                                  
'3-                                                                                
'develop convenient wrappers for displaying stuff on the main buffer               
'4-                                                                                
'improve the main window moving method when drag starts close to window's borders  
'X-                                                                                
'no more pending for now !                                                         


#include once "fbgfx.bi"
#include once "mainwnd.bas"


'=======================================================COMP.INIT._START
'>start the companion....................................
'1 -> loading of the dynamic lib_________________________
dim as any ptr	dylib	=> dyLibLoad("companion.dll")

'2 -> load dll (exportable) symbols _____________________
dim shared as sub()		_initCompanionScreen
	_initCompanionScreen => dyLibSymbol(dylib ,"InitCompanionScreen")

dim shared as sub(byval as integer, byval as integer)		_sendTopLeftCornerWindowCoordinates
	_sendTopLeftCornerWindowCoordinates => dyLibSymbol(dylib ,"SendTopLeftCornerWindowCoordinates")

dim shared as sub(byval as integer, byval as integer)		_sendTopLeftCornerWindowDimensions
	_sendTopLeftCornerWindowDimensions => dyLibSymbol(dylib ,"SendTopLeftCornerWindowDimensions")

'3 -> initialize companion
_initCompanionScreen()
'========================================================COMP.INIT._END


'========================================================MAIN_START
'>start the main application.............................
'INITIALIZATION__________________________________________
MAINWND.InitMainWnd(300, 150)
MAINWND.DrawMainWnd()


'MAINLOOP________________________________________________
dim as boolean	endSignal
'
var loopCounter	=> 0
do
	'.......................................[Drawing]
	'------------------------------------------------body
	'draw things on the app. window body buffer
	'there is no need to screenlock anything here, 
	'the drawings are done on an temporary image
	loopCounter += 1
	MAINWND.ClearMainWndBody()
	'draw something moving depending on the loopCounter variable
	draw string MAINWND.bodyImageBuffer._bodyImageBuffer, _ 
				(200 + 250*cos(loopCounter/100), 100), _ 
				"move the app. window by dragging the titlebar"
	draw string MAINWND.bodyImageBuffer._bodyImageBuffer, _ 
				(200 + 250*cos((loopCounter + 100)/100), 200), _ 
				"click exit_button to leave"
	'------------------------------------------------whole
	'draw the whole application widow content
	'whole app. = framework + buffer
	screenLock
		if not MAINWND.hasQuitButtonClicked then 
			cls
			MAINWND.DrawMainWnd()
		else
			screenUnlock
			endSignal = TRUE
			sleep 400
		end if
	screenUnlock	
	'
	'.......................................[Control]
	'---------------------------------------app.wnd.
	'here after section is for the application window management
	MainWindowMoveControl()
	'---------------------------------------companion
	'here after section is for the companion window
	'send to companion coordinates
	dim as integer	scGetX, scGetY
	screenControl	fb.GET_WINDOW_POS, scGetX, scGetY
	_sendTopLeftCornerWindowCoordinates(scGetX, scGetY)
	'send to companion dimensions
	dim as integer	mainWndScrW
	dim as integer	mainWndScrH
	MAINWND.GetScreenSize(mainWndScrW, mainWndScrH)
	_sendTopLeftCornerWindowDimensions(mainWndScrW, mainWndScrH)
	'
	'.......................................[Loop control]
	'main loop other details
	'if chr(27)=inkey() then endSignal = TRUE
	sleep 5
loop until endSignal=TRUE


'TERMINATION_____________________________________________
'free the main window ressources
MAINWND.CleanUpMainWnd()

'should free the library ressources just below
'					                    !todo!
'========================================================MAIN_END

'(eof)

BAS FILE FOR MAIN WINDOW MANAGEMENT (MAIN PROGRAM FILE 2)

Code: Select all

'part of the program that hold tools making a kind of GUI
'to be saved in the program directory as >> "mainwnd.bas"
#include once "fbgfx.bi"

'-----------------------------------------------------------------------------------
type BODYBUFFER extends OBJECT
	declare constructor()
	declare constructor(byval as integer, byval as integer)
	declare destructor()
	declare sub InitImagePointer()
	declare sub DrawBodyBuffer(byval as integer=0, byval as integer=0)
		as integer			_tlcX
		as integer			_tlcY
		as integer			_bodyW
		as integer			_bodyH
		as fb.IMAGE ptr		_bodyImageBuffer
end type
constructor BODYBUFFER()
	dim as integer scrW, scrH
		screenInfo scrW, scrH
	THIS._bodyW		=> scrW - 4
	THIS._bodyH		=> scrH - 4
	THIS.InitImagePointer()
end constructor
constructor BODYBUFFER(byval BodyW as integer, byval BodyH as integer)
	THIS._bodyW		=> BodyW
	THIS._bodyH		=> BodyH
	THIS.InitImagePointer()
end constructor
destructor BODYBUFFER()
	imageDestroy(THIS._bodyImageBuffer)
End Destructor
sub BODYBUFFER.InitImagePointer()
	if screenPtr()<>0 then
		THIS._bodyImageBuffer => _ 
		imageCreate(THIS._bodyW, THIS._bodyH, rgb(100,080,080), 32)
	end if
end sub
sub BODYBUFFER.DrawBodyBuffer(byval TLCPosX as integer=0, byval TLCPosY as integer=0)
	THIS._tlcX	= TLCPosX
	THIS._tlcY	= TLCPosY
	if THIS._bodyImageBuffer=0 then
		THIS.InitImagePointer()
		if THIS._bodyImageBuffer<>0 then
			put (TLCPosX, TLCPosY), THIS._bodyImageBuffer, PSET
		else
			if screenPtr()<>0 then
				line (TLCPosX, TLCPosY)- _ 
					 (TLCPosX + THIS._bodyW, TLCPosY + THIS._bodyH), _ 
					 rgb(240,180,180), _ 
					 B
			else
				'nothing to draw
				? "No screen to put image (wireframe) on"
			end if
		end if
	else
	if screenPtr()<>0 then
			put (TLCPosX, TLCPosY), THIS._bodyImageBuffer, PSET
		else
			'nothing to draw
			? "No screen to put image buffer on"
		end if
	end if
end sub

'-----------------------------------------------------------------------------------
type MAINWND extends OBJECT
	declare static sub GetDesktopSize()
	declare static sub GetScreenSize(byref as integer, byref as integer)
	declare static sub ChangeMainWndWidth(byref as integer)
	declare static sub ChangeMainWndHeight(byref as integer)
	declare static sub InitMainWnd(byval as integer=480, byval as integer=360)
	declare static sub ClearMainWndBody()
	declare static sub CleanUpMainWnd()
	declare static sub TestQuitButton()
	declare static sub DrawTitleBarBackground()
	declare static sub DrawTitleBarTitle()
	declare static sub DrawTitleBarQuitButton()
	declare static sub DrawMainWnd()
	static as integer		desktopWid, desktopHei
	static as integer		taskbarWid, taskbarHei
	static as integer		minWid, minHei
	static as integer		maxWid, maxHei
	static as integer		scrWid
	static as integer		scrHei
	static as boolean		hasQuitButtonEntered
	static as boolean		hasQuitButtonClicked
	static as string		topbarTitle
	static as BODYBUFFER	bodyImageBuffer
end type
dim as integer			MAINWND.desktopWid		=>	540
dim as integer			MAINWND.desktopHei		=>	400
dim as integer			MAINWND.taskbarWid		=>	068
dim as integer			MAINWND.taskbarHei		=>	068
dim as integer			MAINWND.minWid			=>	048
dim as integer			MAINWND.minHei			=>	036
dim as integer			MAINWND.maxWid			=>	048
dim as integer			MAINWND.maxHei			=>	036
dim as integer			MAINWND.scrWid			=>	480
dim as integer			MAINWND.scrHei			=>	360
dim as boolean			MAINWND.hasQuitButtonEntered
dim as boolean			MAINWND.hasQuitButtonClicked
dim as string			MAINWND.topbarTitle
MAINWND.topbarTitle	=>	"TEST TITLE"
dim as BODYBUFFER		MAINWND.bodyImageBuffer	=> _ 
		BODYBUFFER(MAINWND.scrWid - 14 , MAINWND.scrHei - 36)
sub MAINWND.GetDesktopSize()
	if screenPtr()=0 then
		screenInfo	MAINWND.desktopWid, MAINWND.desktopHei
	else
		dim as integer	scrW, scrH
			screenInfo	scrW, scrH
		screen 0
		screenInfo	MAINWND.desktopWid, MAINWND.desktopHei
		screenRes	ScrW, ScrH, 32, 1, _ 
					fb.GFX_NO_FRAME + fb.GFX_SHAPED_WINDOW
	end if
end sub
sub MAINWND.GetScreenSize(byref ScrW as integer, _ 
						  byref ScrH as integer)
	screenInfo ScrW, ScrH
end sub
sub MAINWND.ChangeMainWndWidth(byref ScrW as integer)
	if ScrW<MAINWND.minWid then ScrW = MAINWND.minWid
	if ScrW>MAINWND.maxWid then ScrW = MAINWND.maxWid - MAINWND.taskbarWid
	'
	MAINWND.scrWid = ScrW
	'change body buffer size
	imageDestroy(MAINWND.bodyImageBuffer._bodyImageBuffer)
	MAINWND.bodyImageBuffer	=> _ 
	BODYBUFFER(MAINWND.scrW - 14 , MAINWND.scrHei - 36)
end sub
sub MAINWND.ChangeMainWndHeight(byref ScrH as integer)
	if ScrH<MAINWND.minHei then ScrH = MAINWND.minHei
	if ScrH>MAINWND.maxHei then ScrH = MAINWND.maxHei - MAINWND.taskbarHei
	'
	MAINWND.scrHei = ScrH	
	'change body buffer size
	imageDestroy(MAINWND.bodyImageBuffer._bodyImageBuffer)
	MAINWND.bodyImageBuffer	=> _ 
	BODYBUFFER(MAINWND.scrWid - 14 , MAINWND.scrH - 36)
end sub
sub MAINWND.InitMainWnd(byval ScrW as integer=480, _ 
						byval ScrH as integer=360)
	MAINWND.GetDesktopSize()
	MAINWND.maxWid = MAINWND.desktopWid
	MAINWND.maxHei = MAINWND.desktopHei
	'
	MAINWND.scrWid = ScrW
	MAINWND.scrHei = ScrH	
	MAINWND.ChangeMainWndWidth(ScrW)
	MAINWND.ChangeMainWndHeight(ScrH)
	'
	screenRes	ScrW, ScrH, 32, 1, _ 
				fb.GFX_NO_FRAME + fb.GFX_SHAPED_WINDOW
end sub
sub MAINWND.TestQuitButton()
	dim as integer gmX, gmY, gmBtn
		getMouse gmX, gmY, , gmBtn
	'
	if gmX>=MAINWND.scrWid - 44		andAlso _
	   gmX<=MAINWND.scrWid - 16		andAlso _
	   gmY>=10						andAlso _ 
	   gmY<=22						then
		if not MAINWND.hasQuitButtonEntered then MAINWND.hasQuitButtonEntered = TRUE
		if gmBtn=+1 then
			if not MAINWND.hasQuitButtonClicked then MAINWND.hasQuitButtonClicked = TRUE
		else
			if MAINWND.hasQuitButtonClicked then MAINWND.hasQuitButtonClicked = FALSE
		end if
	else
		if MAINWND.hasQuitButtonEntered then MAINWND.hasQuitButtonEntered = FALSE
		if MAINWND.hasQuitButtonClicked then MAINWND.hasQuitButtonClicked = FALSE
	end if	
end sub
sub MAINWND.ClearMainWndBody()
	imageDestroy(MAINWND.bodyImageBuffer._bodyImageBuffer)
	MAINWND.bodyImageBuffer.InitImagePointer()
end sub
sub MAINWND.CleanUpMainWnd()
	MAINWND.bodyImageBuffer.Destructor()
end sub
sub MAINWND.DrawTitleBarBackground()
	Line (6, 4)- _ 
		 (MAINWND.scrWid - 6, 30), _ 
		 rgb(200,100,100), _ 
		 BF
end sub
sub MAINWND.DrawTitleBarTitle()
	draw string (12, 20), MAINWND.topbarTitle
end sub
sub MAINWND.DrawTitleBarQuitButton()
	MAINWND.TestQuitButton()
	'
	dim as integer	offset		=> 0
	dim as ulong	btnColor	=> rgb(100,190,100)
	if MAINWND.hasQuitButtonClicked then
		btnColor	=> rgb(220,120,120)
	elseIf MAINWND.hasQuitButtonEntered then
		btnColor	=> rgb(200,100,100)
		offset		=> 10
	else
		'no state change
	end if
	'
	Line (MAINWND.scrWid - 44, 10)- _ 
		 (MAINWND.scrWid - 16, 22), _ 
		 rgb(100,190,100), _ 
		 BF
	Line (MAINWND.scrWid - 44 + offset, 10 + offset\3)- _ 
		 (MAINWND.scrWid - 16 - offset, 22 - offset\3), _ 
		 btnColor, _ 
		 BF
end sub
sub MAINWND.DrawMainWnd()
	dim as integer	scrW, scrH
	MAINWND.GetScreenSize(scrW, scrH)
	MAINWND.scrWid	= scrW
	MAINWND.scrHei	= scrH
	'
	line (0, 0)-(4, scrH - 4), rgb(255,0,255), BF
	line (0, 0)-(scrW - 4, scrH - 4), rgb(255,0,255), BF
	line (scrW, scrH)-(scrW - 4, 0), rgb(255,0,255), BF
	line (scrW, scrH)-(0, scrH - 4), rgb(255,0,255), BF
	'
	circle (4, 4),					10, rgb(150,200,200), , , , F
	circle (scrW - 4, 4),			10, rgb(150,200,200), , , , F
	circle (4, scrH - 4),			10, rgb(150,200,200), , , , F
	circle (scrW - 4, scrH - 4),	10, rgb(150,200,200), , , , F
	'
	line (4, 4)-(scrW - 4, scrH - 4), rgb(150,200,200), BF
	'
	MAINWND.DrawTitleBarBackground()
	MAINWND.DrawTitleBarTitle()
	MAINWND.DrawTitleBarQuitButton()
	'
	MAINWND.bodyImageBuffer.DrawBodyBuffer(08, 30)
end sub

'-----------------------------------------------------------------------------------
sub MainWindowMoveControl()
	static as boolean	buttonLocked
	static as integer	gmX, gmY, gmBtn
	static as integer	lastX, lastY
	static as integer	scGetX, scGetY
	'
	getMouse gmX, gmY, , gmBtn
	'
	if gmBtn=0 then
		setMouse , , 1, 0
		if buttonLocked=TRUE then buttonLocked = FALSE
	elseIf gmBtn=+1 then
		if buttonLocked then
			if gmX<>-1 andAlso gmY<>-1 then 
				if lastX<>gmX orElse lastY<>gmY then
					screenControl 0, scGetX, scGetY
					screenControl 100, scGetX + gmX - lastX, scGetY + gmY - lastY
					getMouse gmX, gmY
	            	setMouse gmX, gmY, 1, 1
	            	sleep 5
				end if
			else
				buttonLocked = FALSE
			end if
		else
			If gmX>=4								andAlso _ 
			   gmX<MAINWND.scrWid - 4				andAlso _ 
			   gmY>=4								andAlso _ 
			   gmY<30								andAlso _ 
			   not MAINWND.hasQuitButtonEntered		then
				buttonLocked = TRUE
				lastX = gmX
				lastY = gmY
			end if
		end if
	end if
end sub


'(eof)

DLL FOR THE COMPANION PROGRAM

Code: Select all

'companion screen DLL source file                    
'used for debug purpose, among every possible usage  
'to be compiled as <fbc -dll -export "companion.dll">
'to be placed in the caller program directory        


#include once "fbgfx.bi"


dim shared as integer	callerTlcX
dim shared as integer	callerTlcY
dim shared as boolean	hasChangedcallerTlcXY
dim shared as integer	callerWidth
dim shared as integer	callerHeight
dim shared as boolean	hasChangedcallerWidHei


'------------
function HatchFillBox(byval ImageBuffer				as fb.IMAGE ptr, _
					  byval BoxTopLeftCornerX		as integer,	_ 
					  byval BoxTopLeftCornerY		as integer,	_ 
					  byval BoxBottomRightCornerX	as integer,	_ 
					  byval BoxBottomRightCornerY	as integer,	_ 
					  byval HatchColor				as ulong,	_ 
					  byval HatchStep				as integer,	_ 
					  byval HatchStartPointOffset	as integer,	_ 
					  byval HatchOddity				as integer=0)	_ 
					  as integer 'HatchReducedOffset
	'--------------------------------------------------------------
	'todo! deal with oddity alternance (strips alernance)

	'shorten some of the input variables names---------------------
	dim as integer	xi => BoxTopLeftCornerX
	dim as integer	yi => BoxTopLeftCornerY
	dim as integer	xf => BoxBottomRightCornerX
	dim as integer	yf => BoxBottomRightCornerY

	if xi>xf then swap xi, xf
	if yi>yf then swap yi, yf

	'reduce start offset to equivalent positive min. value---------
	if HatchStep<=0 then 
		if HatchStep=0 then
			HatchStep = 1
		else
			HatchStep = -HatchStep
		end if
	end if
	'if HatchStartPointOffset<0 then HatchStartPointOffset = -HatchStartPointOffset
	HatchStartPointOffset	=> HatchStartPointOffset mod HatchStep

	'hatch edgelines tracing---------------------------------------
	dim as integer  x
	dim as integer  y
	dim as integer  e
	dim as integer  f
	dim as integer  h
	dim as integer  v
	dim as integer  n
	dim as integer  m
	dim as integer maxBound => (xf - (xi + HatchStartPointOffset) + yf - yi)\HatchStep
	if maxBound<=0 then
		'---->
		return HatchStartPointOffset
	end if
	redim as integer	xup(0 to maxBound)
	redim as integer	yup(0 to maxBound)
	redim as integer	xdw(0 to maxBound)
	redim as integer	ydw(0 to maxBound)
    '
    n	=> 0
    x	=> xi + HatchStartPointOffset
xxf_____________:
	while (x<=xf)
		xup(n) = x
		yup(n) = yi
		if n>0 andAlso (n mod 2)<>0 then
			line ImageBuffer, _ 
				 (xup(n - 1), yup(n - 1))-(xup(n), yup(n)), HatchColor
		end if
		n += 1
		'circle (x, yi), 4
		'draw string (x, yi), str(n)
		x += HatchStep
	wend
	if n>0 andAlso (n mod 2)<>0 then
		line ImageBuffer, _ 
			 (xup(n - 1), yup(n - 1))-(xf, yi), HatchColor
	end if
	h => yi + HatchStep - (xf - xi - HatchStartPointOffset) mod HatchStep
hyf_____________:
	while (h<=yf)
		xup(n) = xf
		yup(n) = h
		if (n mod 2)<>0 then
			line ImageBuffer, _ 
				 (xf, yup(n - 1))-(xup(n), yup(n)), HatchColor
		end if
		n += 1
		'circle (xf, h), 4
		'draw string (xf, h), str(n)
		h += HatchStep
	wend
	if n>0 andAlso (n mod 2)<>0 then
		line ImageBuffer, _ 
			 (xf, yup(n - 1))-(xf, yf), HatchColor
	end if
	n -= 1
	'
	m	=> 0
	y	=> yi + HatchStartPointOffset
yyf_____________:
	while (y<=yf)
		xdw(m) = xi
		ydw(m) = y
		if m>0 andAlso (m mod 2)<>0 then
			line ImageBuffer, _ 
				 (xdw(m - 1), ydw(m - 1))-(xdw(m), ydw(m)), HatchColor
		end if
		m += 1
		'circle (xi, y), 4, rgb(255,100,200)
		'draw string (xi, y), str(m)
		y += HatchStep
	wend
	if m>0 andAlso (m mod 2)<>0 then
		line ImageBuffer, _ 
			 (xdw(m - 1), ydw(m - 1))-(xi, yf), HatchColor
	end if
	v => xi + HatchStep - (yf - yi - HatchStartPointOffset) mod HatchStep
vxf_____________:
	while (v<=xf)
		xdw(m) = v
		ydw(m) = yf
		if (m mod 2)<>0 then
			line ImageBuffer, _ 
				 (xdw(m - 1), yf)-(xdw(m), ydw(m)), HatchColor
		end if
		m += 1
		'circle (v, yf), 4, rgb(255,100,200)
		'draw string (v, yf), str(m)
		v += HatchStep
	wend
	if m>0 andAlso (m mod 2)<>0 then
		line ImageBuffer, _ 
			 (xdw(m - 1), yf)-(xf, yf), HatchColor
	end if
	m -= 1
	'painting stripes
	for i as integer = 0 to m
		line ImageBuffer, _ 
			 (xup(i), yup(i))-(xdw(i), ydw(i)), HatchColor
	next i
	for i as integer = 0 to m
		if xup(i)>=xi and (i mod 2)=0 then
			if xup(i)<xf then
				paint ImageBuffer, _ 
					  (xup(i) + 1, yi + 1), HatchColor, HatchColor
			else
				if yup(i)<(yf - 2) then
					if ((HatchStep - 1)=HatchStartPointOffset) then
						paint ImageBuffer, _ 
							  (xf - 1, yi + 2), HatchColor, HatchColor
					end if
					paint ImageBuffer, _ 
						  (xf - 1, yup(i) + 2), HatchColor, HatchColor
				end if 
			end if
		end if
	next i
	'---->
	return HatchStartPointOffset
end function

'--EXPORTABLE
sub ReceiveTopLeftCornerCallerWindowCoordinates _ 
						alias "SendTopLeftCornerWindowCoordinates" _ 
						(byval TLCX as integer, byval TLCY as integer) _ 
						EXPORT
	dim as boolean	hasChangercallerTlcX
	dim as boolean	hasChangercallerTlcY
	'
	if callerTlcX<>TLCX	then
		hasChangercallerTlcX	= TRUE
		callerTlcX				= TLCX
	end if
	if callerTlcY<>TLCY	then
		hasChangercallerTlcY	= TRUE
		callerTlcY				= TLCY
	end if
	if hasChangercallerTlcX 	andAlso _
	   hasChangercallerTlcY then
		if hasChangedcallerTlcXY=FALSE then hasChangedcallerTlcXY	= TRUE
	else
		if hasChangedcallerTlcXY=TRUE then hasChangedcallerTlcXY = FALSE
	end if
end sub

'--EXPORTABLE
sub ReceiveTopLeftCornerCallerWindowDimensions _ 
						alias "SendTopLeftCornerWindowDimensions" _ 
						(byval W as integer, byval H as integer) _ 
						EXPORT
	dim as boolean	hasChangedcallerWidth
	dim as boolean	hasChangedcallerHeight
	if callerWidth<>W then
		hasChangedcallerWidth	= TRUE
		callerWidth				= W
	end if
	if callerHeight<>H then
		hasChangedcallerHeight	= TRUE
		callerHeight			= H
	end if
	if hasChangedcallerWidth	andAlso _
	   hasChangedcallerHeight then
		if hasChangedcallerWidHei=FALSE then hasChangedcallerWidHei	= TRUE
	else
		if hasChangedcallerWidHei=TRUE then hasChangedcallerWidHei = FALSE
	end if
end sub

'------------
function HatchedExtendedBox(byval ImgW as integer=0, _ 
							byval ImgH as integer=0, _ 
							byval DestroyOnly as boolean=FALSE) _ 
							as fb.IMAGE ptr
	static as fb.IMAGE ptr		imageBufferResult
	imageDestroy(imageBufferResult)
	if DestroyOnly then
		'---->
		return 0
	end if
	imageBufferResult	=> imageCreate(ImgW, ImgH, rgb(255,200,255), 32)
	HatchFillBox(imageBufferResult, _
				 0,	_ 
				 0,	_ 
				 ImgW,	_ 
				 ImgH,	_ 
				 rgb(205,100,155),	_ 
				 40,	_ 
				 0,	_ 
				 0)
	'---->
	return imageBufferResult
end function

'------------
function CallerBoundaryBox(byval ImgW as integer=0, _ 
						   byval ImgH as integer=0, _ 
						   byval DestroyOnly as boolean=FALSE) _ 
						   as fb.IMAGE ptr
	static as fb.IMAGE ptr		imageBufferResult
	imageDestroy(imageBufferResult)
	if DestroyOnly then
		'---->
		return 0
	end if
	imageBufferResult	=> imageCreate(ImgW, ImgH, rgb(255,000,255), 32)
	'---->
	return imageBufferResult
end function

'------------
sub CompanionWindowDrawingThread()
	static as integer	extendedBoxOffset => 40
	color , rgb(255,0,255)
	do
		screenLock
			cls
			line (80,80)-(800,120), rgb(220,090,220), bf
			draw string (100, 100), _ 
				"A SIMPLE GUI DEVELOPMENT COMPANION WINDOW UTILITY v0.1	timer=" & str(TIMER)
			if hasChangedcallerTlcXY	orElse _
			   hasChangedcallerWidHei then
				'main is moving
				put (callerTlcX - extendedBoxOffset, callerTlcY - extendedBoxOffset), _ 
					HatchedExtendedBox(callerWidth + 2*extendedBoxOffset, callerHeight + 2*extendedBoxOffset), _ 
					PSET
				draw string (callerTlcX - extendedBoxOffset, callerTlcY - extendedBoxOffset), _ 
							"MAINWND MOVING___" & str(callerTlcX) &".."& str(callerTlcY)
				put (callerTlcX, callerTlcY), CallerBoundaryBox(callerWidth, callerHeight), PSET
			else
				'main is stable
				put (callerTlcX - extendedBoxOffset, callerTlcY - extendedBoxOffset), _ 
					HatchedExtendedBox(callerWidth + 2*extendedBoxOffset, callerHeight + 2*extendedBoxOffset), _ 
					PSET
				draw string (callerTlcX - extendedBoxOffset, callerTlcY - extendedBoxOffset), _ 
							"MAINWND STABLE___" & str(callerTlcX) &".."& str(callerTlcY)
				put (callerTlcX, callerTlcY), CallerBoundaryBox(callerWidth, callerHeight), PSET
			end if
		screenUnlock
		'
		sleep 10
	loop until inkey()=chr(27)
end sub

'------------
sub SetCompanionScreenDimension(byval W as integer, byval H as integer)
	screenRes W, H, 32, 1, fb.GFX_NO_FRAME + fb.GFX_SHAPED_WINDOW
end sub

'--EXPORTABLE
sub InitCompanionScreen alias "InitCompanionScreen" () EXPORT
	'get the desktop size to set the companion's dimension accordingly
	dim as integer	desktopW, desktopH
		screenInfo	desktopW, desktopH
	'
	SetCompanionScreenDimension(desktopW, desktopH)
	'
	color , rgb(255,000,255)
	threadCreate(@CompanionWindowDrawingThread)
end sub


'(eof)

[grindstone]

Amazing, I didn't know that a dll can create its own window. Some years ago I wrote a helper program for assembling music CDs, where I needed a transparent window to be attached to the Winamp playlist window showing the remaining CD time at each track. That was a similar problem, and I solved it a complete different way (with WinAPI). Only for curiosity I'll try to recode it using the dll method. :-)

BTW: Your code works.

[Tourist Trap]

BTW: Your code works.

Hi grindstone, thanks for testing!

Good to hear that it worked. Yes this trick is funny. I had left a screenres instruction in a part of code that shouldn't and was also surprised to get a second window opened.

This looks then a rather portable way without the api overhead. The only difficulty I can see would be the multithreading. This can start being delicate when the program grows (i dont use any mutex right now). Whatever, for just displaying informations in the background, I'm very confident that it's not too much overhead - so then as a helper for debugging . The demo already shows here the main program sending its coordinates to the companion with no disturbance (even if this is not coupled at lightspeed of course).

[grindstone]

It would be interesting to find out if you could open multiple windows with multiple dlls. That would open up some new possibilities.

Furthermore one should ascertain if the extra window is a feature or a side effect. If it's a side effect, it could be that it doesn't work with future versions of FB.

EDIT:

GREAT! It works! Multiple dlls can open multiple windows, and every dll prints to its own window:

Save this code twice, as dll1.bas and as dll2.bas, to the same directory as main.bas. Then compile them both as .dll

Code: Select all

Sub openWindow Alias "ow" (W As Integer, H As Integer) Export
   ScreenRes W, H
   Print "Window OK"
End Sub

Sub print2window Alias "pw" (text As String) Export
	Print "W> ";text
End Sub

Afterwards compile and run this:
main.bas

Code: Select all

Dim As Any Ptr lib1 = DylibLoad("dll1b")
Dim ow1 As Sub(w As Integer, h As Integer) = DylibSymbol(lib1,"ow")
Dim p1 As Sub(text As String) = DylibSymbol(lib1,"pw")

Dim As Any Ptr lib2 = DylibLoad("dll2b")
Dim ow2 As Sub(w As Integer, h As Integer) = DylibSymbol(lib2,"ow")
Dim p2 As Sub(text As String) = DylibSymbol(lib2,"pw")

ow1(200,200) 'create window 1
ow2(300,300) 'create window 2

p1("to window 1") 'print to window 1
p2("to window 2") 'print to window 2

Sleep

The dlls may contain the same code, but they have to be two seperate files.

EDIT 2:
It also works with more than 2 windows. And my "Process Hacker" tells me, that every window runs in an own thread. But I don't know if the accesses to the windows are threadsave. Maybe that's a question to the experts in this forum.

[Tourist Trap]

Furthermore one should ascertain if the extra window is a feature or a side effect. If it's a side effect, it could be that it doesn't work with future versions of FB.

If it is not a feature, this should be consolidated to be sure it will be in the future. This is a great additional comfort to get so easily a multiple window application. I think it's however due to a second process created and dedicated to the dll.

But I remember a detail a little weird. I have not tried to reproduce, but when first I wanted to use windowtitle to name the main window, the title was applyed also to the dll window.

As you've said, the dll may contain the same code. This is exactly the point of this project. I want to use the companion to help me develop a gui that in turn will add features to companion and so on! For instance, if I develop buttons, I will be able to have buttons in both places. And it seems to me that this is a way to handle a growing project that can be incremental and efficient.

[grindstone]

...when first I wanted to use windowtitle to name the main window, the title was applyed also to the dll window.

I can't confirm that. Save and compile this thrice:

Code: Select all

Sub openWindow Alias "ow" (W As Integer, H As Integer) Export
   ScreenRes W, H
   Print "Window OK"
End Sub

Sub print2window Alias "pw" (text As String) Export
	Print "W> ";text
End Sub

Sub title Alias "wt" (text As String) Export
	WindowTitle text
End Sub

Then run this main prog:

Code: Select all

Dim As Any Ptr lib1 = DylibLoad("dll1")
Dim ow1 As Sub(w As Integer, h As Integer) = DylibSymbol(lib1,"ow")
Dim p1 As Sub(text As String) = DylibSymbol(lib1,"pw")
Dim t1 As Sub(text As String) = DylibSymbol(lib1,"wt")

Dim As Any Ptr lib2 = DylibLoad("dll2")
Dim ow2 As Sub(w As Integer, h As Integer) = DylibSymbol(lib2,"ow")
Dim p2 As Sub(text As String) = DylibSymbol(lib2,"pw")
Dim t2 As Sub(text As String) = DylibSymbol(lib2,"wt")

Dim As Any Ptr lib3 = DylibLoad("dll3")
Dim ow3 As Sub(w As Integer, h As Integer) = DylibSymbol(lib3,"ow")
Dim p3 As Sub(text As String) = DylibSymbol(lib3,"pw")
Dim t3 As Sub(text As String) = DylibSymbol(lib3,"wt")

ow1(200,200) 'create window 1
ow2(300,300) 'create window 2
ow3(300,400) 'create window 3

p1("to window 1") 'print to window 1
p2("to window 2") 'print to window 2
p3("to window 3") 'print to window 3

t1("window 1")
t2("window 2")
t3("window 3")

Sleep

Every child window has its own title (at least on my computer).

And (look at the "EDIT 2" above) every window runs in an own thread, not in an own process.

[fxm]

In 2009, I tested the behavior of a main program (with its main graphic window), and with in addition secondary graphic windows (associated each to one dll).
I found some important restrictions on the secondary windows usage:
- The keyboard input (Inkey) was received only by the main program.
- The behavior of the mouse parameters (GetMouse), received only by the main program, was a little bit surprising, according to the geometrical configuration of graphic windows on the screen, the main with regard to the others (if overlap).

My conclusion was:
- A secondary window may be used only for output.
- In order to never disrupt the mouse parameters (relating to the main window), the main window must always stay over any secondary window (flag GFX_ALWAYS_ON_TOP), or at least must be non-overlapped by a secondary window.

I do not think that these behaviors have changed since.

[grindstone]

From this one can conclude that it's not a feature. Just for curiosity: Is there an other way to open multiple windows within the same process without using any API?

[fxm]

Anecdotal (one program but several processes):

Code: Select all

' Code suppressed because considered too dangerous if modified.

[Tourist Trap]

Anecdotal (one program but several processes):

Please fxm, don't throw this kind of program without any explanation. If you remove the select case, it keeps creating windows ad infinitum and it's really messy to get this all closed.

In any case, how does this work? It's weird (and as said it is dangerous).

[fxm]

Any program modified is at its peril.

[Tourist Trap]

Any program modified is at its peril.

fxm, it's not logical. If you post a program without any explanation this means you want people to play with it to discover the trick. Otherwise, you should have said not to modify it for what or what reason. I've lost a whole session of FBIDE. Fortunately just garbage, but who knows, someone may loose valuable work. Add to this that without explanations, this program is not only dangerous but of no use.

So we can't play with it, and you don't say how it works, why posting it? -> not logical.

So this would be really nice to tell how it works now you've posted it.

[Tourist Trap]

From this one can conclude that it's not a feature. Just for curiosity: Is there an other way to open multiple windows within the same process without using any API?

In this project I have been trying to make some fake gui independant windows sliding all over a unique transparent main background : http://www.freebasic.net/forum/viewtopi ... 76#p214876.

It was a little tedious and I've left this for the moment, but it works quite well without any need of an api call. But yes as said, it requires a lot of development.

[xlucas]

Tourist Trap.... I hereby confirm that this does work in Linux. I actually get the control on the shared object window, not on the primary one. This is what I found:

- I create a shared object file (equivalent of dynamic library) that has functions and also module level code. In the module level code, I use ScreenRes to create a window and I can draw on it. I also create a main program file that loads it with DyLibLoad and declares some subs or functions from the shared object. This causes the module-level code to be executed and the window pops up.
- If I use DyLibLoad before running ScreenRes on the main program, the main program window never populates. On the other hand, if I first use ScreenRes and then call DyLibLoad, both windows are shown and the keyboard responds only on the shared object window.