Custom drawn MDI w/ toolbar interface.

[WayneA]

Over the weekend I got the idea that it would be fun to clone the mspaint interface without trying to use a real toolbar/mdi combination. It was rather simple to draw my own MDI w/ toolbars with rect and line commands, easier then I expected. The hard part was turning the buttons into toggling toolbar items. Like all of my subclassed controls I finally got it done with a dirty hack. I think they work pretty well considering how adhoc they are.

I've attached the bitmaps in a zip, they need to be in the executables path within a folder called wapaint_bmps.

Also the statusbar functions  recently wrote for general reuse are in there..

First the .inc (wapaint.inc)

Code Select Expand

Enum ToolButton
bDefault=0
bSelection,bErase,bFill,bDropper,bZoom
bPen,bBrush,bSpray,bText,bLine,bCurve
bRect,bPolygon,bEllipse,bRoundRect
nToolButtons=16
EndEnum

Enum Colors
cBevelOutter,cBevelInnerLeft,cBevelInnerBottom
cMDIBG,cPanelBG
EndEnum

Const sCanvas=nToolButtons+1

And the main file:

Code Select Expand

$Include "windows.inc"
$Include "wapaint.inc"
AutoDefine "Off"
Dim wndMain,Canvas As Window
Dim tbOrigProc[nToolButtons+1] As UInt
Dim tbPushState[nToolButtons],MinTrackWidth,MinTrackHeight As Int
OpenWindow wndMain,0,0,0,0,@Size|@MinBox|@MaxBox|@NoAutoDraw,0,"Untitled - Paint++",&wndMainProc
WaitUntil IsWindowClosed wndMain
End

Sub wndMainProc
Dim l,t,w,h As Int
Dim i As Int
Select @Message
Case @IDCreate
AttachMainMenu(wndMain)
SetClientSize(wndMain.hWnd,640,480,True)
GetSize wndMain,l,t,w,h
MinTrackWidth=w-(640-273)
MinTrackHeight=h-(480-364)
InitControls(wndMain)
CenterWindow wndMain
Case @IDControl
Case @IDPaint
Paint(wndMain)
Case @IDSize
GetClientSize wndMain,l,t,w,h
ResizeStatusBar(wndMain,w)
Paint(wndMain)
Case WM_GETMINMAXINFO
*<MINMAXINFO>@lParam.ptMinTrackSize.x=MinTrackWidth
*<MINMAXINFO>@lParam.ptMinTrackSize.y=MinTrackHeight
Case @IDCloseWindow
CloseWindow wndMain
EndSelect
EndSub

Sub InitControls(win As Window)
Control win,@Button,"",3,3,22,22,@CTLBTNBitmap,bSelection
SetControlText win,bSelection,GetStartPath+"wapaint_bmps\\selection.bmp"
tbOrigProc[bSelection]=_SetWindowLong(GetControlHandle(win,bSelection),GWL_WNDPROC,&ToolBtnProc)
Control win,@Button,"",25,3,22,22,@CTLBTNBitmap,bErase
SetControlText win,bErase,GetStartPath+"wapaint_bmps\\eraser.bmp"
tbOrigProc[bErase]=_SetWindowLong(GetControlHandle(win,bErase),GWL_WNDPROC,&ToolBtnProc)
Control win,@Button,"",3,25,22,22,@CTLBTNBitmap,bFill
SetControlText win,bFill,GetStartPath+"wapaint_bmps\\bucket.bmp"
tbOrigProc[bFill]=_SetWindowLong(GetControlHandle(win,bFill),GWL_WNDPROC,&ToolBtnProc)
Control win,@Button,"",25,25,22,22,@CTLBTNBitmap,bDropper
SetControlText win,bDropper,GetStartPath+"wapaint_bmps\\dropper.bmp"
tbOrigProc[bDropper]=_SetWindowLong(GetControlHandle(win,bDropper),GWL_WNDPROC,&ToolBtnProc)
Control win,@Button,"",3,47,22,22,@CTLBTNBitmap,bZoom
SetControlText win,bZoom,GetStartPath+"wapaint_bmps\\magnify.bmp"
tbOrigProc[bZoom]=_SetWindowLong(GetControlHandle(win,bZoom),GWL_WNDPROC,&ToolBtnProc)
Control win,@Button,"",25,47,22,22,@CTLBTNBitmap,bPen
SetControlText win,bPen,GetStartPath+"wapaint_bmps\\pencil.bmp"
tbOrigProc[bPen]=_SetWindowLong(GetControlHandle(win,bPen),GWL_WNDPROC,&ToolBtnProc)
Control win,@Button,"",3,69,22,22,@CTLBTNBitmap,bBrush
SetControlText win,bBrush,GetStartPath+"wapaint_bmps\\paintbrush.bmp"
tbOrigProc[bBrush]=_SetWindowLong(GetControlHandle(win,bBrush),GWL_WNDPROC,&ToolBtnProc)
Control win,@Button,"",25,69,22,22,@CTLBTNBitmap,bSpray
SetControlText win,bSpray,GetStartPath+"wapaint_bmps\\spraypaint.bmp"
tbOrigProc[bSpray]=_SetWindowLong(GetControlHandle(win,bSpray),GWL_WNDPROC,&ToolBtnProc)
Control win,@Button,"",3,92,22,22,@CTLBTNBitmap,bText
SetControlText win,bText,GetStartPath+"wapaint_bmps\\text.bmp"
tbOrigProc[bText]=_SetWindowLong(GetControlHandle(win,bText),GWL_WNDPROC,&ToolBtnProc)
Control win,@Button,"",25,92,22,22,@CTLBTNBitmap,bLine
SetControlText win,bLine,GetStartPath+"wapaint_bmps\\line.bmp"
tbOrigProc[bLine]=_SetWindowLong(GetControlHandle(win,bLine),GWL_WNDPROC,&ToolBtnProc)
Control win,@Button,"",3,115,22,22,@CTLBTNBitmap,bCurve
SetControlText win,bCurve,GetStartPath+"wapaint_bmps\\curve.bmp"
tbOrigProc[bCurve]=_SetWindowLong(GetControlHandle(win,bCurve),GWL_WNDPROC,&ToolBtnProc)
Control win,@Button,"",25,115,22,22,@CTLBTNBitmap,bRect
SetControlText win,bRect,GetStartPath+"wapaint_bmps\\rectangle.bmp"
tbOrigProc[bRect]=_SetWindowLong(GetControlHandle(win,bRect),GWL_WNDPROC,&ToolBtnProc)
Control win,@Button,"",3,137,22,22,@CTLBTNBitmap,bPolygon
SetControlText win,bPolygon,GetStartPath+"wapaint_bmps\\polygon.bmp"
tbOrigProc[bPolygon]=_SetWindowLong(GetControlHandle(win,bPolygon),GWL_WNDPROC,&ToolBtnProc)
Control win,@Button,"",25,137,22,22,@CTLBTNBitmap,bEllipse
SetControlText win,bEllipse,GetStartPath+"wapaint_bmps\\ellipse.bmp"
tbOrigProc[bEllipse]=_SetWindowLong(GetControlHandle(win,bEllipse),GWL_WNDPROC,&ToolBtnProc)
Control win,@Button,"",3,159,22,22,@CTLBTNBitmap,bRoundRect
SetControlText win,bRoundRect,GetStartPath+"wapaint_bmps\\roundrectangle.bmp"
tbOrigProc[bRoundRect]=_SetWindowLong(GetControlHandle(win,bRoundRect),GWL_WNDPROC,&ToolBtnProc)
' ControlEx win,"Edit","",56,2,50,50,0,0,sCanvas
' SetControlColor win,sCanvas,0x000000,0xFFFFFF
' tbOrigProc[sCanvas]=_SetWindowLong(GetControlHandle(win,sCanvas),GWL_WNDPROC,&CanvasProc)
AttachStatusBar(win,0)
EndSub

Sub CanvasProc(hWnd As Int,uMsg As Int,wParam As Int,lParam As UInt),Int
Dim cid As Int
Dim l,t,w,h,sh,nil As Int
cid=_GetWindowLong(hWnd,GWL_ID)
Select uMsg
Case WM_GETMINMAXINFO
GetClientSize wndMain,l,t,w,h
GetSize wndMain,nil,nil,nil,sh,99
Case WM_NCHITTEST
Return HitTest(hWnd,lParam)
Case WM_DESTROY
'Restore the original wndproc when the control is destroyed.
_SetWindowLong(hWnd,GWL_WNDPROC,tbOrigProc[cid])
EndSelect
Return _CallWindowProc(tbOrigProc[cid],hWnd,uMsg,wParam,lParam)
EndSub

Sub ToolBtnProc(hWnd As Int,uMsg As Int,wParam As Int,lParam As UInt),Int
Dim cid,i As Int
Dim dc,hBrush As UInt
Dim Body As WINRECT
cid=_GetWindowLong(hWnd,GWL_ID)
Select uMsg
Case WM_SETFOCUS
Case& WM_KILLFOCUS
'This prevents the focus ring from appearing, purely for cosmetic reasons..
'Also keeps the control from accepting the keyboard focus.
SetFocus wndMain
Return 0
Case WM_LBUTTONUP
'Let the control process the message first. Otherwise things get funky..
_CallWindowProc(tbOrigProc[cid],hWnd,uMsg,wParam,lParam)
'Toggle the state
tbPushState[cid]=(tbPushState[cid]=False)
If tbPushState[cid] Then
For i=1 to 16
If !(i=cid) And tbPushState[i] Then
tbPushState[i]=0
Body.Left=0:Body.Top=0:Body.Right=22:Body.Bottom=22
_RedrawWindow(GetControlHandle(wndMain,i),Body,null,RDW_INVALIDATE)
EndIf
Next i
EndIf
'We fall-through into the paint message
Case& WM_PAINT
'Call default procedure so itll paint itself first.. Everytime the button is clicked
'it will redraw itself now
If !(uMsg=WM_PAINT) Then
_CallWindowProc(tbOrigProc[cid],hWnd,WM_PAINT,0,0)
Else
_CallWindowProc(tbOrigProc[cid],hWnd,uMsg,wParam,lParam)
EndIf
If tbPushState[cid] Then
dc=IIf(wParam=0,_GetDC(hWnd),wParam)
If dc Then
hBrush=_CreateSolidBrush(PaletteLookUp(cPanelBG))
If hBrush Then
_SelectObject(dc,hBrush)
_ExtFloodFill(dc,3,3,0xFFFFFF,FLOODFILLSURFACE)
_DeleteObject(hBrush)
EndIf
Body.Left=0:Body.Top=0:Body.Right=22:Body.Bottom=22
_InvertRect(dc,Body)
_ReleaseDC(hWnd,dc)
EndIf
Return 0
Else
dc=IIf(wParam=0,_GetDC(hWnd),wParam)
If dc Then
hBrush=_CreateSolidBrush(PaletteLookUp(cPanelBG))
If hBrush Then
_SelectObject(dc,hBrush)
_ExtFloodFill(dc,3,3,0xFFFFFF,FLOODFILLSURFACE)
_DeleteObject(hBrush)
EndIf
_ReleaseDC(hWnd,dc)
EndIf
EndIf
Case WM_DESTROY
'Restore the original wndproc when the control is destroyed.
_SetWindowLong(hWnd,GWL_WNDPROC,tbOrigProc[cid])
EndSelect
Return _CallWindowProc(tbOrigProc[cid],hWnd,uMsg,wParam,lParam)
EndSub

Sub Paint(win As Window)
Dim l,t,w,h As Int
Dim x,sh As Int
GetClientSize wndMain,l,t,w,h
GetSize wndMain,x,x,x,sh,999
'MDIClient-like client area
Rect wndMain,55,0,w-55,h-50-sh,PaletteLookUp(cMDIBG),PaletteLookUp(cMDIBG)
Line wndMain,55,1,w-2,1,PaletteLookUp(cBevelOutter)
Line wndMain,w-2,1,w-2,h-sh,PaletteLookUp(cPanelBG)
Line wndMain,w-1,0,w-1,h-sh,PaletteLookUp(cBevelInnerBottom)
'Control Panel
Rect wndMain,0,0,55,h,PaletteLookUp(cPanelBG),PaletteLookUp(cPanelBG)
'Color Panel
Rect wndMain,53,h-50-sh,w-53,50+sh,PaletteLookUp(cPanelBG),PaletteLookUp(cPanelBG)
'Control Bevel
Line wndMain,54,0,54,h-50-sh,PaletteLookUp(cBevelOutter)
Line wndMain,53,0,53,h-50-sh,PaletteLookUp(cBevelInnerLeft)
Line wndMain,0,h-50-sh,54,h-50-sh,PaletteLookUp(cBevelInnerLeft)
'Color Bevel
'Line wndMain,54,h-50,w,h-50,PaletteLookUp(cBevelOutter)
Line wndMain,0,h-49-sh,w,h-49-sh,PaletteLookUp(cBevelInnerBottom)
EndSub

Sub AttachMainMenu(win As Window)
BeginMenu win
MenuTitle "&File"
EndMenu
EndSub

Sub AttachStatusBar(win As Window,Opt nPanes=0 As Int,...),Int
Dim i,iPanes[128] As Int
Dim pArgs As Pointer
Dim l,t,w,h As UInt
Control win,@Status,"",0,0,0,0,0,999
If nPanes Then
pArgs=VA_Start(nPanes)
nPanes=IIf(nPanes>128,128,nPanes)
For i=0 to nPanes-1
iPanes[i]=*<Int>(pArgs+(i*4))
Next i
ControlCMD(win,999,@SWSetPanes,nPanes,iPanes)
EndIf
ControlCMD(win,999,@SWResize)
GetSize win,l,t,w,h,999
Return h
EndSub

Sub ResizeStatusBar(win As Window,clientWidth As UInt,Opt nPanes=0 As Int,...),Int
Dim i,iPanes[128],tPane As Int
Dim pArgs As Pointer
Dim l,t,w,h As UInt
ControlCMD(win,999,@SWResize)
If nPanes Then
pArgs=VA_Start(nPanes)
nPanes=IIf(nPanes>128,128,nPanes)
For i=0 to nPanes-1
tPane=*<Int>(pArgs+(i*4))
iPanes[i]=IIf(tPane=-1,-1,clientWidth-tPane)
Next i
ControlCMD(win,999,@SWSetPanes,nPanes,iPanes)
EndIf
GetSize win,l,t,w,h,999
Return h
EndSub

Sub HitTest(hWnd As UInt,lParam As UInt),UInt
Dim rc As WINRECT
Dim pt As Point
pt.x=LOWORD(lParam)
pt.y=HIWORD(lParam)
_ScreenToClient(hWnd,pt)
_GetWindowRect(hWnd,rc)
_MapWindowPoints(HWND_DESKTOP,__GetParent(hWnd),&rc,2)
If pt.y >=(rc.bottom-rc.top-4) And pt.x>=(rc.right-rc.left-4) Then
Return HTBOTTOMRIGHT
ElseIf pt.x>=(rc.right-rc.left-4) Then
Return HTRIGHT
ElseIf pt.y>=(rc.bottom-rc.top-4) Then
Return HTBOTTOM
EndIf
Return 0
EndSub

Sub PaletteLookUp(nIndex As Int),UInt
'This is used instead of an array because the System Colors could change while the app is still running.
Select nIndex
Case cBevelOutter
Return 0x00404040
Case cBevelInnerLeft
Return 0x00808080
Case cBevelInnerBottom
Return 0x00FFFFFF
Case cMDIBG
Return _GetSysColor(16)
Case cPanelBG
Return _GetSysColor(15)
EndSelect
Return 0
EndSub

Sub IIf(cond As Int,IfTrue As Int,IfFalse As Int),Int
Dim ret As Int
'ret=ebp-4
'cond=ebp+8 | IfTrue=ebp+12 | IfFalse=ebp+16
_asm
cmp dword [ebp+8],0
je .false
mov dword eax,[ebp+12]
mov dword [ebp-4],eax
jmp .ret
.false:
mov dword eax,[ebp+16]
mov dword [ebp-4],eax
.ret:
_endasm
Return ret
EndSub

Sub SetClientSize(win As Int,w As Int,h As Int,Opt fmenu=0 As Int),Int
WINRECT rec
Int style,exstyle,err
style=0:exstyle=0:err=0
style=_GetWindowLong(win,GWL_STYLE)
If style
style=style & not(WS_OVERLAPPED)
exstyle=_GetWindowLong(win,GWL_EXSTYLE)
If style=0 | exstyle=0 Then Return 0
EndIf
err=_SetRect(rec,0,0,w,h)
If err
err=_AdjustWindowRectEx(rec,style,fmenu,exstyle)
If err
err=_SetWindowPos(win,0,0,0,rec.right+Int(ABS(rec.left)),rec.bottom+Int(ABS(rec.top)),SWP_NOMOVE)
EndIf
EndIf
Return err
EndSub

Sub WinErrMsg(x As Int),String
Dim buffer[64] As IString
_FormatMessage(0x1000,0,x,0,buffer,63,0)
If Len(buffer) Then
Return "Error"+Str$(x)+" = "+buffer
Else
Return "Unknown error code:"+Str$(x)
EndIf
EndSub

Sub LastErrMsg(),String
Return WinErrMsg(_GetLastError())
EndSub

Sub LOWORD(in As UInt),Word
Return in & 0xFFFF
EndSub

Sub HIWORD(in As UInt),Word
Return (in >> 16) & 0xFFFF
EndSub

Sub __GetParent(hWnd As UInt),UInt
Return _GetWindowLong(hWnd,GWL_HWNDPARENT)
EndSub

I have an image editing application in another language that I am considering porting to ebasic, so this may be developed further in that vein.

See wapaint_bmps.zip attached in later post.

[Guilect]

Over the weekend I got the idea that it would be fun to clone the mspaint interface without trying to use a real toolbar/mdi combination.

Gee, all I did was have a cookout and go to the beach. 

Thanks for sharing the code WayneA,

[RitchieF]

Thanks WayneA for sharing this code but I can't open the zip file of this thread.
Anybody has a working copy ?

Thanks

Richard

[LarryMc]

Thanks WayneA for sharing this code but I can't open the zip file of this thread.
Anybody has a working copy ?

Thanks

Richard

I don't think that zip was ever any good (based on my archive copies).

[Brian]

Here we go!

Brian

[LarryMc]

Way to go Brian!

[RitchieF]

Thanks for the upload Brian!

Richard