2013-06-19 07:59

'====================== MDIApp by Psyclops ================================
' Be sure to read the readme file and run SimpleMDI.bas first to get a
' "feel" for the code here.

     $INCLUDE "MDI_API.INC"
'$INCLUDE "WIN32API.INC"

     DEFLNG hClient, ChildCount, hChild(1024), hEdit, hFile, UntitledCount, ActiveChild
     DEFSTR Buffer, ShortName, ClassName = "MDIChild", FullPath(1024)
     DECLARE SUB mnuNew_Click
     DECLARE SUB mnuOpen_Click
     DECLARE SUB mnuClose_Click
     DECLARE SUB mnuCloseAll_Click
     DECLARE SUB mnuCascade_Click
     DECLARE SUB mnuTileHorz_Click
     DECLARE SUB mnuTileVert_Click
     DECLARE SUB mnuArrange_Click
     DECLARE SUB mnuMinAll_Click(SENDER AS QMENUITEM)
     DECLARE SUB mnuMaxAll_Click(SENDER AS QMENUITEM)
     DECLARE SUB mnuRestAll_Click(SENDER AS QMENUITEM)
     DECLARE FUNCTION CreateChild(Title AS STRING) AS LONG
     DECLARE FUNCTION ChildProc (hWnd AS LONG, uMsg AS LONG, wParam AS LONG, lParam AS LONG) AS LONG
     DECLARE FUNCTION EnumCallback(hWnd AS LONG, lParam AS LONG) AS LONG


     CREATE Form AS QFORM
      CAPTION = "MDI Parent"
      Center
      FormStyle = 2
      Width = Screen.Width/2*1.5
      Height = Screen.Height/2*1.5
      COLOR = -2147483636 ' clAppWorkspace
      CREATE mnuMain AS QMAINMENU
       CREATE mnuFile AS QMENUITEM
        CAPTION  ="&File"
        CREATE mnuNew AS QMENUITEM
         CAPTION = "&New"
         OnClick = mnuNew_Click
        END CREATE
        CREATE mnuOpen AS QMENUITEM
         CAPTION = "&Open"
         OnClick = mnuOpen_Click
        END CREATE
        CREATE mnuClose AS QMENUITEM
         CAPTION = "&Close"
         OnClick = mnuClose_Click
        END CREATE
        CREATE mnuCloseAll AS QMENUITEM
         CAPTION = "Close &All"
         OnClick = mnuCloseAll_Click
        END CREATE
       END CREATE
       CREATE mnuWindows AS QMENUITEM
        CAPTION = "&Windows"
        CREATE mnuCascade AS QMENUITEM
         CAPTION = "&Cascade"
         OnClick = mnuCascade_Click
        END CREATE
        CREATE mnuTileHorz AS QMENUITEM
         CAPTION = "Tile &Horizontally"
         OnClick = mnuTileHorz_Click
        END CREATE
        CREATE mnuTileVert AS QMENUITEM
         CAPTION = "Tile &Vertically"
         OnClick = mnuTileVert_Click
        END CREATE
        CREATE mnuArrange AS QMENUITEM
         CAPTION = "&Arrange Icons"
         OnClick = mnuArrange_Click
        END CREATE
        CREATE mnuMinAll AS QMENUITEM
         CAPTION = "&Minimize All"
         OnClick = mnuMinAll_Click
         Tag = 1
        END CREATE
        CREATE mnuMaxAll AS QMENUITEM
         CAPTION = "Ma&ximixe All"
         OnClick = mnuMaxAll_Click
        END CREATE
       END CREATE
      END CREATE
      CREATE StatusBar AS QSTATUSBAR
      END CREATE
     END CREATE

     DIM ChildClass AS WNDCLASSEX
     WITH ChildClass
      .cbSize = SIZEOF(ChildClass)
      .lpfnWndProc = CODEPTR(ChildProc)
      .hbrBackground = 0
      .lpszClassName = VARPTR(ClassName)
     END WITH
     RegisterClassEx(ChildClass)

     EnumChildWindows(Form.Handle, CODEPTR(EnumCallback), 0)
     SetWindowLong(Form.Handle, GWL_HWNDPARENT, 0)
     SetWindowLong(Application.Handle, GWL_HWNDPARENT, Form.Handle)

     Form.SHOWMODAL

     SUB mnuNew_Click
      CreateChild("Untitled "+STR$(UntitledCount+1))
      UntitledCount++
     END SUB

     SUB mnuOpen_Click
      DIM OD AS QOPENDIALOG
      IF OD.EXECUTE THEN
       FOR X = 0 TO ChildCount
        DEFSTR Title = VARPTR$(GetProp(hChild(X), "FullPath"))
        IF Title = OD.FileName THEN
         SendMessage(hClient, WM_MDIACTIVATE, hChild(X), 0)
         EXIT SUB
        END IF
       NEXT X
       hFile = CreateFile(OD.FileName, GENERIC_READ, FILE_SHARE_READ, 0, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
       ShortName = RIGHT$(OD.FileName, LEN(OD.FileName)-RINSTR(OD.FileName, "\"))
       DEFLNG NewChild = CreateChild(ShortName)
       FullPath(ChildCount) = OD.FileName
       SetProp(NewChild, "FullPath", VARPTR(FullPath(ChildCount)))
       SetProp(NewChild, "FileHandle", hFile)
       StatusBar.SimpleText = OD.FileName
       Buffer = SPACE$(65535)
       DEFLNG BytesRead, ReadResult
       ReadFile(hFile, VARPTR(Buffer), 65535, VARPTR(BytesRead), 0)
       CloseHandle(hFile)
       Buffer = LEFT$(Buffer, BytesRead)
       SendMessage(GetProp(NewChild, "EditHandle"), WM_SETTEXT, 0, VARPTR(Buffer))
      END IF
     END SUB

     SUB mnuClose_Click
      SendMessage(hClient, WM_MDIDESTROY, ActiveChild, 0)
     END SUB

     SUB mnuCloseAll_Click
      FOR X = 0 TO ChildCount-1
       SendMessage(hClient, WM_MDIDESTROY, hChild(X), 0)
      NEXT X
     END SUB

     SUB mnuCascade_Click
      SendMessage(hClient, WM_MDICASCADE, 0, 0)
     END SUB

     SUB mnuTileHorz_Click
      SendMessage(hClient, WM_MDITILE, MDITILE_HORIZONTAL, 0)
     END SUB

     SUB mnuTileVert_Click
      SendMessage(hClient, WM_MDITILE, MDITILE_VERTICAL, 0)
     END SUB

     SUB mnuArrange_Click
      SendMessage(hClient, WM_MDIICONARRANGE, 0, 0)
     END SUB

     SUB mnuMinAll_Click
      FOR X = 0 TO ChildCount-1
       SendMessage(hChild(X), WM_SYSCOMMAND, SC_MINIMIZE, 0)
      NEXT X
      Sender.CAPTION = "&Restore All"
      Sender.OnClick = mnuRestAll_Click
     END SUB

     SUB mnuMaxAll_Click
      FOR X = 0 TO ChildCount-1
       SendMessage(hClient, WM_MDIMAXIMIZE, hChild(X), 0)
      NEXT X
      Sender.CAPTION = "&Restore All"
      Sender.OnClick = mnuRestAll_Click
     END SUB

     SUB mnuRestAll_Click
      FOR X = 0 TO ChildCount-1
       SendMessage(hClient, WM_MDIRESTORE, hChild(X), 0)
      NEXT X
      IF Sender.Tag = 1 THEN
       Sender.CAPTION = "&Minimize All"
       Sender.OnClick = mnuMinAll_Click
      ELSE
       Sender.CAPTION = "Ma&ximize All"
       Sender.OnClick = mnuMaxAll_Click
      END IF
     END SUB

     FUNCTION CreateChild
      hChild(ChildCount) = CreateWindowEx(WS_EX_MDICHILD, @ClassName, Title, WS_CHILD OR WS_VISIBLE OR WS_OVERLAPPEDWINDOW, _
       CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, hClient, 0, 0, 0)
      Result = hChild(ChildCount-1)
     END FUNCTION

     FUNCTION EnumCallback
      Buffer = SPACE$(255)
      GetClassName(hWnd, @Buffer, 255)
      IF INSTR(UCASE$(Buffer), "MDICLIENT") THEN hClient = hWnd
      Result = 1
     END FUNCTION

     FUNCTION ChildProc
      SELECT CASE uMsg
      CASE WM_CREATE
       hEdit = CreateWindowEx(WS_EX_CLIENTEDGE, "edit", "", WS_CHILD OR WS_VISIBLE OR _
        ES_MULTILINE OR ES_AUTOHSCROLL OR ES_AUTOVSCROLL OR _
        WS_HSCROLL OR WS_VSCROLL, 0, 0, 0, 0, hWnd, 0, 0, 0)
       SetProp(hWnd, "EditHandle", hEdit)
       ChildCount++
       SendMessage(hClient, WM_MDISETMENU, 0, mnuWindows.Handle)
      CASE WM_SIZE
       hEdit = GetProp(hWnd, "EditHandle")
       DIM R AS QRECT
       GetClientRect(hWnd, R)
       MoveWindow(hEdit, 0, 0, R.Right, R.Bottom, 1)
       SELECT CASE wParam
       CASE SIZE_MAXIMIZED
        SetWindowLong(hEdit, GWL_EXSTYLE, WS_EX_CLIENTEDGE)
       CASE SIZE_RESTORED
        SetWindowLong(hEdit, GWL_EXSTYLE, WS_EX_CLIENTEDGE)
       CASE ELSE
        SetWindowLong(hEdit, GWL_EXSTYLE, 0)
       END SELECT
      CASE WM_MDIACTIVATE
       ActiveChild = hWnd
       StatusBar.SimpleText = VARPTR$(GetProp(lParam, "FullPath"))
       SetFocus(GetProp(lParam, "EditHandle"))
      CASE WM_DESTROY
       ChildCount--
       Buffer = SPACE$(255)
       GetWindowText(hWnd, @Buffer, 255)
       IF INSTR(Buffer, "Untitled") THEN UntitledCount--
      END SELECT
      Result = DefMDIChildProc(hWnd, uMsg, wParam, lParam)
     END FUNCTION

2013-06-19 07:59