PB Windows MDI template (API bloated)

BackupUser · Post by **BackupUser** » Tue Mar 12, 2002 1:36 am

Code updated for 5.20+

Restored from previous forum. Originally posted by El_Choni.

Hi,

At least I got a working MDI app, but as you see I had to use Franco's API-way Windows app template. That is, you can't use gadgets directly here. But you can try changing the MDIFrame window for OpenWindow and maybe set some Long_ data so it works with gadgets too (don't forget to use the hChild handle in CreateGadgetList). The RichEdit library can be used in combination with this template to create an MDI text editor (I've done it

.

UPDATED to work with 3.20.

Code: Select all

Procedure Error(errormessage.s, fatal.b)
  MessageRequester("Error", errormessage, 0)
  If fatal
    End
  EndIf
EndProcedure
Global MDIFrame, MDIClient, hToolbar, hStatus, ClassName.s, wc.WNDCLASSEX, WindowWidth, WindowHeight, hInstance, hChildMenu, hMainMenu, hMenuInitWindow, ChildNumber
#IDM_FIRSTCHILD = 50000
#IDMBASE = 25000
#IDM_FILE_NEW = #IDMBASE+0
#IDM_FILE_OPEN = #IDMBASE+1
#IDM_FILE_SAVE = #IDMBASE+2
#IDM_FILE_CLOSE = #IDMBASE+3
#IDM_FILE_CLOSEALL = #IDMBASE+4
#IDM_FILE_QUIT = #IDMBASE+5
#IDM_EDIT_COPY = #IDMBASE+6
#IDM_EDIT_PASTE = #IDMBASE+7
#IDM_WINDOW_TILEHORIZONTAL = #IDMBASE+8
#IDM_WINDOW_TILEVERTICAL = #IDMBASE+9
#IDM_WINDOW_CASCADE = #IDMBASE+10
#IDM_WINDOW_ARRANGE = #IDMBASE+11
#IDM_WINDOW_NEXT = #IDMBASE+12
Procedure CloseEnumProc(hWnd, lParam)
  If GetWindow_(hWnd, #GW_OWNER) ; Check for icon title
    ProcedureReturn #True
  EndIf
  GetParent_(hWnd)
  SendMessage_(GetParent_(hWnd), #WM_MDIRESTORE, hWnd, 0)
  If SendMessage_(hWnd, #WM_QUERYENDSESSION, 0, 0)=0
    ProcedureReturn #True
  EndIf
  SendMessage_(GetParent_(hWnd), #WM_MDIDESTROY, hWnd, 0)
  ProcedureReturn #True
  SubMenu = GetSubMenu_(hMainMenu, 0)
  If SubMenu
    SendMessage_(MDIClient, #WM_MDISETMENU, hMainMenu, SubMenu)
  EndIf
  DrawMenuBar_(MDIFrame)
EndProcedure
Procedure MDIChildProc(hWnd, uMsg, wParam, lParam)
  result = 0
  Select uMsg
    Case #WM_CREATE
      ChildNumber+1
      hChildMenu = CreateMenu(1, hWnd)
      If hChildMenu
        MenuTitle("&File")
          MenuItem(#IDM_FILE_NEW, "&New")
          MenuItem(#IDM_FILE_OPEN, "&Open")
          MenuItem(#IDM_FILE_SAVE, "&Save")
          MenuItem(#IDM_FILE_CLOSE, "&Close")
          MenuItem(#IDM_FILE_CLOSEALL, "Close all")
          MenuBar()
          MenuItem(#IDM_FILE_QUIT, "&Quit")
        MenuTitle("&Edit")
          MenuItem(#IDM_EDIT_COPY, "Copy")
          MenuItem(#IDM_EDIT_PASTE, "Paste")
        MenuTitle("&Windows")
          MenuItem(#IDM_WINDOW_TILEHORIZONTAL, "Tile horizontal")
          MenuItem(#IDM_WINDOW_TILEVERTICAL, "Tile vertical")
          MenuItem(#IDM_WINDOW_CASCADE, "Cascade")
          MenuItem(#IDM_WINDOW_ARRANGE, "Arrange icons")
          MenuItem(#IDM_WINDOW_NEXT, "Next")
      EndIf
      result = DefMDIChildProc_(hWnd, uMsg, wParam, lParam)
    Case #WM_KEYDOWN
      Select wParam
        Case #VK_F6
          SendMessage_(MDIClient, #WM_MDINEXT, #Null, 0)
      EndSelect
      result = DefMDIChildProc_(hWnd, uMsg, wParam, lParam)
    Case #WM_MDIACTIVATE
      If lParam = hWnd
        SubMenu = GetSubMenu_(hChildMenu, 2)
        If SubMenu
          SendMessage_(MDIClient, #WM_MDISETMENU, hChildMenu, SubMenu)
          DrawMenuBar_(MDIFrame)
        EndIf
        DrawMenuBar_(MDIFrame)
      Else
        result = DefMDIChildProc_(hWnd, uMsg, wParam, lParam)
      EndIf
    Case #WM_DROPFILES
      mem = AllocateMemory(256)
      hDrop = wParam
      DragQueryFile_(hDrop, 0, mem, 256)
      File.s = PeekS(mem)
      FreeMemory(0)
      DragFinish_(hDrop)
      MessageRequester("Dropped file in child window:", File, 0)
    Case #WM_QUERYENDSESSION
      SendMessage_(hWnd, #WM_CLOSE, 0, 0)
    Case #WM_CLOSE
      If MessageBox_(hWnd, "Are you sure you want to close this window?", "MDI Template", #MB_YESNO) = #IDYES
        SendMessage_(MDIClient, #WM_MDIDESTROY, hWnd, 0)
        ChildNumber-1
        If ChildNumber = 0
          SubMenu = GetSubMenu_(hMainMenu, 0)
          If SubMenu
            SendMessage_(MDIClient, #WM_MDISETMENU, hMainMenu, SubMenu)
          EndIf
          DrawMenuBar_(MDIFrame)
        EndIf
      EndIf
    Default
      result = DefMDIChildProc_(hWnd, uMsg, wParam, lParam)
  EndSelect
  ProcedureReturn result
EndProcedure
Procedure WndProc(hWnd, uMsg, wParam, lParam)
  result = 0
  Rct.RECT
  cs.CLIENTCREATESTRUCT
  Select uMsg
    Case #WM_COMMAND
      If lParam=0 Or lParam=hToolbar
        Select wParam & $ffff
          Case #IDM_FILE_NEW
            hChild = CreateWindowEx_(#WS_EX_MDICHILD, @ClassName, @"Untitled", #MDIS_ALLCHILDSTYLES, #CW_USEDEFAULT, #CW_USEDEFAULT, #CW_USEDEFAULT, #CW_USEDEFAULT, MDIClient, #Null, hInstance, #Null)
            ShowWindow_(hChild, #SW_SHOW)
            DragAcceptFiles_(hChild, #True)
          Case #IDM_FILE_OPEN
            MessageRequester("Item:","Open",0)
          Case #IDM_FILE_SAVE
            MessageRequester("Item:","Save",0)
          Case #IDM_FILE_CLOSE ; Close
            SendMessage_(SendMessage_(MDIClient, #WM_MDIGETACTIVE, 0, 0), #WM_CLOSE, 0, 0)
          Case #IDM_FILE_CLOSEALL ; Close all
            EnumChildWindows_(MDIClient, @CloseEnumProc(), 0)
          Case #IDM_FILE_QUIT ; Quit
            PostQuitMessage_(#Null)
          Case #IDM_EDIT_COPY
            MessageRequester("Item:","Copy",0)
          Case #IDM_EDIT_PASTE
            MessageRequester("Item:","Paste",0)
          Case #IDM_WINDOW_TILEHORIZONTAL ; Tile horizontal
            SendMessage_(MDIClient, #WM_MDITILE, #MDITILE_HORIZONTAL, 0)
          Case #IDM_WINDOW_TILEVERTICAL ; Tile vertical
            SendMessage_(MDIClient, #WM_MDITILE, #MDITILE_VERTICAL, 0)
          Case #IDM_WINDOW_CASCADE ; Cascade
            SendMessage_(MDIClient, #WM_MDICASCADE, #MDITILE_SKIPDISABLED, 0)
          Case #IDM_WINDOW_ARRANGE
            SendMessage_(MDIClient, #WM_MDIICONARRANGE, 0, 0)
          Case #IDM_WINDOW_NEXT
            SendMessage_(MDIClient, #WM_MDINEXT, #Null, 0)
          Default
            result = DefFrameProc_(hWnd, MDIClient, uMsg, wParam, lParam)
        EndSelect
      EndIf
    Case #WM_CREATE
      hToolbar = CreateToolBar(0, hWnd)
      If hToolbar
        ToolBarStandardButton(#IDM_FILE_NEW, #PB_ToolBarIcon_New)
        ToolBarStandardButton(#IDM_FILE_OPEN, #PB_ToolBarIcon_Open)
        ToolBarStandardButton(#IDM_FILE_SAVE, #PB_ToolBarIcon_Save)
        ToolBarSeparator()
        ToolBarStandardButton(#IDM_EDIT_COPY, #PB_ToolBarIcon_Copy)
        ToolBarStandardButton(#IDM_EDIT_PASTE, #PB_ToolBarIcon_Paste)
      EndIf
      wID = 200 ; doesn't matter, I think
      hStatus = CreateStatusWindow_(#WS_CHILD|#WS_VISIBLE|#SBS_SIZEGRIP, #Null, hWnd, wID)
      GetClientRect_(hWnd, @Rct)
      Structure StatusFields
        a.l
        b.l
        c.l
      EndStructure
      sbParts.StatusFields
      sbParts\a = (Rct\right-Rct\left)/3
      sbParts\b = sbParts\a*2
      sbParts\c = -1
      SendMessage_(hStatus, #SB_SETPARTS, SizeOf(StatusFields)/4, @sbParts)
      SendMessage_(hStatus, #SB_SETTEXT, #SBT_NOBORDERS, @"Size and depth")
      SendMessage_(hStatus, #SB_SETTEXT, #SBT_NOBORDERS+1, @"File format")
      SendMessage_(hStatus, #SB_SETTEXT, #SBT_NOBORDERS+2, @"Zoomed")
      ClassName = "mdi_child"
      wc\cbSize = SizeOf(WNDCLASSEX)
      wc\style = #CS_HREDRAW|#CS_VREDRAW|#CS_BYTEALIGNWINDOW
      wc\lpfnWndProc = @MDIChildProc()
      wc\cbClsExtra = 0
      wc\cbWndExtra = 0
      wc\hInstance = hInstance
      wc\hbrBackground = #COLOR_BTNFACE+1 ; Stops flickering
      wc\lpszMenuName = #Null
      wc\lpszClassName = @ClassName
      wc\hIcon = LoadIcon_(#Null, #IDI_APPLICATION)
      wc\hCursor = LoadCursor_(#Null, #IDC_ARROW)
      wc\hIconSm = 0
      ChildNumber = 0
      If RegisterClassEx_(@wc)
        hMainMenu = CreateMenu(0, hWnd)
        If hMainMenu
          MenuTitle("&File")
            MenuItem(#IDM_FILE_NEW, "&New")
            MenuItem(#IDM_FILE_OPEN, "&Open")
            MenuBar()
            MenuItem(#IDM_FILE_QUIT, "&Quit")
        EndIf
        cs\hWindowMenu = GetSubMenu_(hMainMenu, 0)
        cs\idFirstChild = #IDM_FIRSTCHILD
        MDIClient = CreateWindowEx_(#WS_EX_CLIENTEDGE, @"MDICLIENT", #Null, #WS_CHILD|#WS_CLIPCHILDREN|#WS_VISIBLE|#WS_VSCROLL|#WS_HSCROLL, 0, 0, 0, 0, hWnd, 0, hInstance, @cs)
        DragAcceptFiles_(hWnd, #True)
      Else
        Error("Failed to register the MDI Child window class.", 1)
      EndIf
    Case #WM_SIZE ;window has been sized
      WindowWidth = lParam ;get width of sized window
      WindowHeight = lParam >> 16 ;get height of sized window
      SendMessage_(hToolbar, #TB_AUTOSIZE, 0, 0)
      MoveWindow_(hStatus, 0, 0, 0, 0, #True)
      GetWindowRect_(hToolbar, @Rct)
      tbH = Rct\bottom-Rct\top
      GetWindowRect_(hStatus, @Rct)
      sbH = Rct\bottom-Rct\top
      GetClientRect_(hWnd, @Rct)
      sbH = Rct\bottom-tbH-sbH
      MoveWindow_(MDIClient, 0, tbH, Rct\right, sbH, #True)
    Case #WM_PAINT
      Ps.PAINTSTRUCT
      hDC = BeginPaint_(hWnd, @Ps)
      btn_hi = GetSysColor_(#COLOR_BTNHIGHLIGHT)
      btn_lo = GetSysColor_(#COLOR_BTNSHADOW)
      EndPaint_(hWnd, @Ps)
    Case #WM_DROPFILES
      mem = AllocateMemory(256)
      hDrop = wParam
      DragQueryFile_(hDrop, 0, mem, 256)
      File.s = PeekS(mem)
      FreeMemory(0)
      DragFinish_(hDrop)
      MessageRequester("Dropped file in main window:", File, 0)
    Case #WM_QUERYENDSESSION ; Attempt to close all children
      SendMessage_(hWnd, #WM_CLOSE, 0, 0)
    Case #WM_CLOSE ; Attempt to close all children
      SendMessage_(hWnd, #WM_COMMAND, #IDM_FILE_CLOSEALL, 0)
      If GetWindow_(MDIClient, #GW_CHILD)=0
        result = DefFrameProc_(hWnd, MDIClient, uMsg, wParam, lParam)
      EndIf
    Case #WM_DESTROY
      PostQuitMessage_(#Null)
    Default
      result = DefFrameProc_(hWnd, MDIClient, uMsg, wParam, lParam)
  EndSelect
ProcedureReturn result
EndProcedure
hInstance = GetModuleHandle_(0)
ClassName = "MDIFrame"
wc.WNDCLASSEX
wc\cbSize = SizeOf(WNDCLASSEX)
wc\style = #CS_HREDRAW|#CS_VREDRAW|#CS_BYTEALIGNWINDOW
wc\lpfnWndProc = @WndProc()
wc\cbClsExtra = 0
wc\cbWndExtra = 0
wc\hInstance = hInstance
wc\hbrBackground = #Null ; Stops flickering
wc\lpszMenuName = #Null
wc\lpszClassName = @ClassName
wc\hIcon = LoadIcon_(#Null, #IDI_APPLICATION)
wc\hCursor = LoadCursor_(#Null, #IDC_ARROW)
wc\hIconSm = 0
If RegisterClassEx_(@wc)
  MDIFrame = CreateWindowEx_(#Null, @ClassName, @"MDI Template", #WS_OVERLAPPEDWINDOW, #CW_USEDEFAULT, #CW_USEDEFAULT, #CW_USEDEFAULT, #CW_USEDEFAULT, #Null, 0, hInstance, #Null)
  If MDIFrame
    ShowWindow_(MDIFrame, #SW_SHOWNORMAL)
    UpdateWindow_(MDIFrame)
    msg.MSG
    While GetMessage_(@msg, 0, 0, 0)
      TranslateMessage_(@msg)
      DispatchMessage_(@msg)
    Wend
    DestroyMenu_(hChildMenu)
    DestroyAcceleratorTable_(hAccel)
    End
  Else
    Error("Failed to open the MDI Frame window", 1)
  EndIf
Else
  Error("Failed to register the MDI Frame window class", 1)
EndIf
End

Bye,

BackupUser · Post by **BackupUser** » Tue Mar 12, 2002 3:55 pm

Restored from previous forum. Originally posted by Franco.

Hi El_Choni, nice work but...
I downloaded the code yesterday at home and it didn't work (WinXP).
The background is transparent at the start, if I close another app the background changes to normal, NOT to a MDI-Frame . And if you want to add Child windows you can't see it. No error messages are coming up.

Now at work (Win98SE - 7:45am ) it seems to work fine (not really tested yet).
Have no time to play right now (at home with WinXP) but as soon I have time I dive into it.

Anyway, thanks for your contributed template.
It's very appreciated - keep up your good work

Have a nice day...
Franco

Sometimes you have to go a lonely way to accomplish genius things.

BackupUser · Post by **BackupUser** » Tue Mar 12, 2002 7:40 pm

Restored from previous forum. Originally posted by El_Choni.

Hmmm... I see, so the problem must be in the wc\hbrBackground member of the WNDCLASSEX structure of both the Frame and the Child windows (in Windows XP). Could you try changing those values? I don't have Windows XP, sorry.

Bye,

El_Choni

BackupUser · Post by **BackupUser** » Tue Mar 12, 2002 8:55 pm

Restored from previous forum. Originally posted by Franco.

Hmmm... I see, so the problem must be in the wc\hbrBackground member of the WNDCLASSEX structure of both the Frame and the Child windows (in Windows XP). Could you try changing those values? I don't have Windows XP, sorry.

Bye,

El_Choni

Yes sure I will do that, but not this evening - maybe tomorrow.

Have a nice day...
Franco

Sometimes you have to go a lonely way to accomplish genius things.

BackupUser · Post by **BackupUser** » Tue Mar 12, 2002 10:56 pm

Restored from previous forum. Originally posted by Danilo.

Same on Win2k:
- Background is f**ked up.
- Resize doesnt update the window
- Crash on App-Exit

cya,
...Danilo

(registered PureBasic user)

BackupUser · Post by **BackupUser** » Mon Mar 25, 2002 4:41 am

Restored from previous forum. Originally posted by Franco.

Hi El_Choni,
finally I had a bit time to search for the problem under WinXP.
After changing the background behavior the bug was still there.

But found out that if you change the following line:

Code: Select all

MDIClient = CreateWindowEx_(#WS_EX_MDICHILD|#WS_EX_CLIENTEDGE, @"MDICLIENT", #NULL, #WS_CHILD|#WS_CLIPCHILDREN|#WS_VISIBLE|#WS_VSCROLL|#WS_HSCROLL, 0, 0, 0, 0, hWnd, 0, hInstance, @cs)

to:

Code: Select all

MDIClient = CreateWindowEx_(#WS_EX_CLIENTEDGE, @"MDICLIENT", #NULL, #WS_CHILD|#WS_CLIPCHILDREN|#WS_VISIBLE|#WS_VSCROLL|#WS_HSCROLL, 0, 0, 0, 0, hWnd, 0, hInstance, @cs)

the whole code runs smoothly also under WinXP. (don't know about Win2000 yet - have to reinstall it, and tomorrow morning I can test the code with Win98SE at work)

It seems that WinXP doesn't like the #WS_EX_MDICHILD flag.

The only thing I have to say:
well done El_Choni - thanks for this snippet and hope all other goodies in this code work as well (not all tested yet).

BTW: Hope that your sleeping behavior is doing better and you are dreaming like a baby instead of coding all night...

Have a nice day...
Franco

Sometimes you have to go a lonely way to accomplish genius things.

Edited by - franco on 25 March 2002 04:42:56

BackupUser · Post by **BackupUser** » Mon Mar 25, 2002 4:21 pm

Restored from previous forum. Originally posted by El_Choni.

Hi!

Thanks a lot for your research. The problem, as you've found out, was that the MDICHILD flag is not to be used with the client window, but with the MDI child windows. Win 98 seems to be less picky with those things.

Sleeping is going fine now, thanks. My actual problem is that my phone line's been cut by Telefonica, I hope to have it back next week. In the meanwhile, I'm coding an MDI text editor and an MDI image tool. Everything is MDI for me now XD.

Haven't yet guessed why the app crashes when quitting with the debugger. Anyway, it quits OK with the usual commands.

I'll post what I got working when Internet comes back home.

Have a nice day,

El_Choni