Companion of your development

User projects written in or related to FreeBASIC.
Tourist Trap
Posts: 2762
Joined: Jun 02, 2015 16:24

Companion of your development

Postby Tourist Trap » Jun 16, 2016 8:18

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
Posts: 645
Joined: May 05, 2015 5:35
Location: Germany

Re: Companion of your development

Postby grindstone » Jun 16, 2016 10:51

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
Posts: 2762
Joined: Jun 02, 2015 16:24

Re: Companion of your development

Postby Tourist Trap » Jun 16, 2016 12:18

grindstone wrote: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
Posts: 645
Joined: May 05, 2015 5:35
Location: Germany

Re: Companion of your development

Postby grindstone » Jun 17, 2016 7:31

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.
Last edited by grindstone on Jun 17, 2016 9:37, edited 1 time in total.
Tourist Trap
Posts: 2762
Joined: Jun 02, 2015 16:24

Re: Companion of your development

Postby Tourist Trap » Jun 17, 2016 9:23

grindstone wrote: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
Posts: 645
Joined: May 05, 2015 5:35
Location: Germany

Re: Companion of your development

Postby grindstone » Jun 17, 2016 9:57

Tourist Trap wrote:...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
Posts: 9126
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Companion of your development

Postby fxm » Jun 17, 2016 11:29

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
Posts: 645
Joined: May 05, 2015 5:35
Location: Germany

Re: Companion of your development

Postby grindstone » Jun 17, 2016 12:32

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
Posts: 9126
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Companion of your development

Postby fxm » Jun 17, 2016 13:44

Anecdotal (one program but several processes):

Code: Select all

' Code suppressed because considered too dangerous if modified.
Last edited by fxm on Jun 18, 2016 11:17, edited 5 times in total.
Tourist Trap
Posts: 2762
Joined: Jun 02, 2015 16:24

Re: Companion of your development

Postby Tourist Trap » Jun 17, 2016 14:23

fxm wrote: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
Posts: 9126
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Companion of your development

Postby fxm » Jun 17, 2016 14:27

Any program modified is at its peril.
Tourist Trap
Posts: 2762
Joined: Jun 02, 2015 16:24

Re: Companion of your development

Postby Tourist Trap » Jun 17, 2016 14:51

fxm wrote: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
Posts: 2762
Joined: Jun 02, 2015 16:24

Re: Companion of your development

Postby Tourist Trap » Jun 17, 2016 15:28

grindstone wrote: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 : viewtopic.php?p=214876#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
Posts: 268
Joined: May 09, 2014 21:19
Location: Argentina

Re: Companion of your development

Postby xlucas » Jun 18, 2016 23:30

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.

Return to “Projects”

Who is online

Users browsing this forum: Google [Bot] and 2 guests