I've been working on this "Gutter" custom control for the past two days.
It's a port from an IBpro snippet to IWBasic.
But i've ran into some trouble : on @IDSIze event, the "Gutter" is not updated. You have to use the
scrollbar to update the display in the custom control.
the same code does not cause any trouble in IBPro.
My question is : What does not work in the IWPro version of this snippet ?
Attached ZIP archive contains both the source code and the binaries for IBPro and IWBasic.
Updated version with a Common Controls API toolbar.
Still looking for a solution with the gutter display problem...
Looks like W1 insists on drawing the background color despite having @noautodraw flag. You can subclass W1, call DefSubclassProc to draw the background, and only then draw what you want.
$INCLUDE "windowssdk.inc"
$INCLUDE "Commctrl.inc"
AutoDefine "Off"
CONST SS_NOTIFY = 0x100
CONST DT_LEFT = 0x0
CONST DT_RIGHT = 0x2
CONST COLOR_GRAYTEXT = 17
CONST EC_LEFTMARGIN = 0x0001
CONST EM_SETMARGINS = 0xD3
Const SM_CXHSCROLL = 21
CONST SM_CYVSCROLL = 20
Const EM_SETRECTNP = 0xB4
CONST EM_FINDWORDBREAK = (0x400 + 76)
CONST EM_GETCHARFORMAT = (0x400 + 58)
CONST EN_MSGFILTER = 0x700
CONST WB_RIGHT = 1
CONST WB_NEXTBREAK = 7
CONST WB_MOVEWORDRIGHT = 5
CONST WB_MOVEWORDLEFT = 4
CONST SB_GETBORDERS = (WM_USER+7)
CONST SB_GETICON = (WM_USER+20)
CONST SB_GETRECT = (WM_USER+10)
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Pen Styles
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
CONST PS_SOLID = 0
CONST TRANSPARENT = 1
CONST OPAQUE = 2
Type WINRECT
Int LEFT
Int TOP
Int RIGHT
Int BOTTOM
EndType
TYPE FONTINFO
DEF NAME AS STRING
DEF SIZE AS INT
DEF WEIGHT AS INT
DEF FLAGS AS INT
DEF FORECOLOR AS INT
ENDTYPE
TYPE SIZESTRUCT
DEF X AS INT
DEF Y AS INT
ENDTYPE
TYPE MSGFILTER
DEF hwndFrom:INT
DEF idFrom:INT
DEF CODE:INT
DEF MSG:INT
DEF WPARAM:INT
DEF LPARAM:INT
ENDTYPE
TYPE CHARFORMAT
UINT cbSize
INT dwMask
INT dwEffects
INT yHeight
INT yOffset
INT crTextColor
CHAR bCharSet
CHAR bPitchAndFamily
ISTRING szFaceName[32]
ENDTYPE
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Api Declares
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'DECLARE IMPORT, _SaveDC ALIAS SaveDC(hdc AS INT),INT
'DECLARE IMPORT, _RestoreDC ALIAS RestoreDC(hdc AS INT,nSavedDC AS INT),INT
DECLARE IMPORT, _CreateFont ALIAS CreateFontA(H AS INT,W AS INT,E AS INT,O AS INT,W AS INT,I AS INT,U AS INT,S AS INT,C AS INT,OP AS INT,CP AS INT,Q AS INT,PAF AS INT,F AS STRING),INT
DECLARE IMPORT, _TextOut ALIAS TextOutA(HDC AS INT,X AS INT,Y AS INT,lpString AS STRING,nCount AS INT),INT
DECLARE IMPORT, _FillRect ALIAS FillRect(HDC AS INT,lpRect AS WINRECT,hBrush AS INT),INT
DECLARE IMPORT,GetScrollPosA Alias "GetScrollPos"(HWND:Int,nBar:Int),Int
WINDOW WIN, W1, TMP
STRING FONTNAME, CAPTION, ln, temp$
Int BBR, STATUS_HEIGHT, SCROLLPOS, ORIG, FTSIZE, FWEIGHT, FFLAGS, textW, textH
Int Gutter_hDC, hdcMem, hbmMem, oldBmp, oldBrush, OldFont, L, T, W, H
Uint hEdit, FSIZE
Istring fName[260], buffer[65532]
File fHdl
WINRECT BRECT
FONTNAME="Courier New"
FTSIZE=10
'FONTNAME = "FixedSys"
'FTSIZE = 9
FWEIGHT = 0
FFLAGS = 0
CONST EDIT_1 = 111
CONST STATUS_1 = 222
CAPTION="Tpad"
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Open main window
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
OPENWINDOW WIN,-9999,-9999,640,480,@Size|@MinBox|@MaxBox|@NOAUTODRAW|WS_CLIPCHILDREN, 0,"Tpad",NULL
SetWindowColor(WIN,RGB(224,220,224))
INT LEFT, TOP, WIDTH, HEIGHT
GetClientSize WIN, LEFT, TOP, WIDTH, HEIGHT
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Create Edit control
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
CONTROL WIN,@Edit,"",LEFT, TOP, WIDTH, (HEIGHT - 48),0x50B010C4, EDIT_1
ModifyExStyle(WIN, 0, @EXCLIENTEDGE|WS_BORDER, EDIT_1)
ReDrawFrame(WIN, EDIT_1)
CONTROLCMD win, EDIT_1, @EDSETLIMITTEXT, 65532
SetFont WIN,FONTNAME,FTSIZE,FWEIGHT,FFLAGS, EDIT_1
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Add a Statusbar
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
CONTROL win,@STATUS,"Ready...",0,0,0,0,0, STATUS_1
Int PARTS[2]
PARTS[0] = (WIDTH - 100)
PARTS[1] = -1
CONTROLCMD win, STATUS_1, @SWSETPANES, 2, PARTS
'StatusSetIcon(WIN,2,hIcon[3])
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Add a menu
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
BEGINMENU WIN
MENUTITLE "File"
MENUITEM "New",0,1
MENUITEM "Open",0,2
MENUITEM "Save as..",0,3
SEPARATOR
MENUITEM "Print",0,4
MENUITEM "Quit",0,5
MENUTITLE "Edit"
MENUITEM "Undo",0,10
SEPARATOR
MENUITEM "Cut",0,11
MENUITEM "Copy",0,12
MENUITEM "Paste",0,13
SEPARATOR
MENUITEM "Select All",0,14
SEPARATOR
MENUITEM "Find",0,15
MENUITEM "Replace",0,16
ENDMENU
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Create the Toolbar control
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Uint hToolBar, hInstance
hInstance = GetModuleHandleA(0)
hToolBar = CreateWindowExA(0x0,"toolbarwindow32","",WS_VISIBLE|WS_CHILD|CCS_TOP|TBSTYLE_FLAT|TBSTYLE_TOOLTIPS,0,0,440,16,win.hwnd,2000, hInstance,0)
SendMessage(hToolBar,TB_BUTTONSTRUCTSIZE,20,0)
ControlCMD WIN,hToolBar,@TBSETBitmapSIZE, 16, 16
TYPE _TBBUTTON
UINT iBitmap
UINT idCommand
CHAR fsState
CHAR fsStyle
CHAR bReserved[2]
UINT dwData
POINTER lpString ': pointer to string or string index
ENDTYPE
_TBBUTTON ttbb[12]
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
:' Send the TB_BUTTONSTRUCTSIZE message, for backward compatibility
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
SendMessage(hToolBar, TB_BUTTONSTRUCTSIZE, Len(ttbb), 0)
TYPE TBADDBITMAP
UINT hInst
UINT nId
ENDTYPE
TBADDBITMAP tbab
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Assign Image list to The toolbar
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
tbab.hInst = -1 ': Comctl32 bitmaps
tbab.nID = 0 ': 0=16x16, 1=32x32
SendMessage(hToolBar, 0x413, 12, tbab) ': TB_ADDBITMAP
ttbb[0].fsStyle = BTNS_SEP
ttbb[1].iBitmap = STD_FILENEW
ttbb[1].idCommand = 1
ttbb[1].fsState = TBSTATE_ENABLED
ttbb[1].fsStyle = BTNS_BUTTON
ttbb[1].dwData = 0
ttbb[1].lpString = -1
ttbb[2].iBitmap = STD_FILEOPEN
ttbb[2].idCommand = 2
ttbb[2].fsState = TBSTATE_ENABLED
ttbb[2].fsStyle = BTNS_BUTTON
ttbb[2].dwData = 0
ttbb[2].lpString = -1
ttbb[3].iBitmap = STD_FILESAVE
ttbb[3].idCommand = 3
ttbb[3].fsState = TBSTATE_ENABLED
ttbb[3].fsStyle = BTNS_BUTTON
ttbb[3].dwData = 0
ttbb[3].lpString = -1
ttbb[4].iBitmap = STD_CUT
ttbb[4].idCommand = 4
ttbb[4].fsState = TBSTATE_ENABLED
ttbb[4].fsStyle = BTNS_BUTTON
ttbb[4].dwData = 0
ttbb[4].lpString = -1
ttbb[5].iBitmap = STD_COPY
ttbb[5].idCommand = 5
ttbb[5].fsState = TBSTATE_ENABLED
ttbb[5].fsStyle = BTNS_BUTTON
ttbb[5].dwData = 0
ttbb[5].lpString = -1
ttbb[6].iBitmap = STD_PASTE
ttbb[6].idCommand = 6
ttbb[6].fsState = TBSTATE_ENABLED
ttbb[6].fsStyle = BTNS_BUTTON
ttbb[6].dwData = 0
ttbb[6].lpString = -1
ttbb[7].iBitmap = STD_UNDO
ttbb[7].idCommand = 7
ttbb[7].fsState = TBSTATE_ENABLED
ttbb[7].fsStyle = BTNS_BUTTON
ttbb[7].dwData = 0
ttbb[7].lpString = -1
ttbb[8].iBitmap = STD_PRINT
ttbb[8].idCommand = 8
ttbb[8].fsState = TBSTATE_ENABLED
ttbb[8].fsStyle = BTNS_BUTTON
ttbb[8].dwData = 0
ttbb[8].lpString = -1
ttbb[9].iBitmap = STD_FIND
ttbb[9].idCommand = 9
ttbb[9].fsState = TBSTATE_ENABLED
ttbb[9].fsStyle = BTNS_BUTTON
ttbb[9].dwData = 0
ttbb[9].lpString = -1
ttbb[10].iBitmap = STD_REPLACE
ttbb[10].idCommand = 10
ttbb[10].fsState = TBSTATE_ENABLED
ttbb[10].fsStyle = BTNS_BUTTON
ttbb[10].dwData = 0
ttbb[10].lpString = -1
ttbb[11].iBitmap = STD_PROPERTIES
ttbb[11].idCommand = 11
ttbb[11].fsState = TBSTATE_ENABLED
ttbb[11].fsStyle = BTNS_BUTTON
ttbb[11].dwData = 0
ttbb[11].lpString = -1
int tbb
For tbb = 0 to 11
SendMessage hToolBar, TB_ADDBUTTONS, 1, ttbb[tbb]
Next tbb
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Update the size of the toolbar
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
SendMessage hToolBar, TB_AUTOSIZE, 0, 0
InitGutter()
DoResize()
CENTERWINDOW WIN
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Main Loop
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
OnMessage win,@IDCLOSEWINDOW,&DoEndProgram
OnMessage win,@IDSIZE,&DoResize
Onmessage win, @IDPAINT,&DoPaint
OnMessage win,WM_ERASEBKGND,&EraseBG
OnMenuPick win,1,&FileNew
OnMenuPick win,2,&DoOpen
OnMenuPick win,3,&DoSave
OnMenuPick win,4,&DoPrint
OnMenuPick win,5,&DoEndProgram
OnMenuPick win,10,&Undo
OnMenuPick win,11,&Cut
OnMenuPick win,12,&Copy
OnMenuPick win,13,&Paste
OnMenuPick win,14,&Select_All
ONCONTROL win, 1,0,&FileNew
ONCONTROL win, 2,0,&DoOpen
ONCONTROL win, 3,0,&DoSave
ONCONTROL win, 4,0,&Cut
ONCONTROL win, 5,0,&Copy
ONCONTROL win, 6,0,&Paste
ONCONTROL win, 7,0,&Undo
ONCONTROL win, 8,0,&DoPrint
ONCONTROL win, 9,0,&WorkinProgress ': Todo -> Find routine
ONCONTROL win, 10,0,&WorkinProgress ': Todo -> Replace routine
ONCONTROL win, 11,0,&WorkinProgress ': Todo -> Properties routine
ONCONTROL win, 111,@ENCHANGE,&DoPaint
WaitUntil IsWindowClosed(win)
END
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Functions
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Sub WorkinProgress()
MESSAGEBOX(win,"Function not yet implemented","Work in progress",@MB_ICONINFORMATION | @MB_OK)
RETURN
ENDSUB
Sub FileNew()
SetControlText win, 1, ""
SETFOCUS WIN,EDIT_1
RETURN
ENDSUB
Sub EraseBG()
': Prevent flickering on WM_PAINT messages
Return 1
ENDSUB
Sub Undo()
CONTROLCMD WIN,1,@EDUNDO
RETURN
ENDSUB
Sub Cut()
CONTROLCMD WIN,EDIT_1,@EDCUT
RETURN
ENDSUB
Sub Copy()
CONTROLCMD WIN,EDIT_1,@EDCOPY
RETURN
ENDSUB
Sub Paste()
CONTROLCMD WIN,EDIT_1,@EDPASTE
RETURN
ENDSUB
Sub Select_All()
CONTROLCMD WIN,EDIT_1,@EDSETSELECTION,0,-1
RETURN
ENDSUB
Sub DoPrint()
CONTROLCMD WIN,EDIT_1,@RTPRINT
SETFOCUS WIN,EDIT_1
RETURN
ENDSUB
Sub DoPaint()
SCROLLPOS = GetScrollPosA(GetControlHandle(WIN,EDIT_1),SB_VERT)
UpdateGutter()
RETURN
EndSub
SUB DoOpen()
fName = FileRequest("Open File",WIN,1,"All Files (*.*)|*.*||","txt",0)
if(len(fName) > 0)
buffer = ""
if(openfile(fHdl,fName,"R") = 0)
do
if(read(fHdl,ln) = 0)
buffer = buffer + ln + chr$(13) + chr$(10)
endif
until eof(fHdl)
FSIZE = LEN(fHdl)
closefile fHdl
CONTROLCMD WIN, STATUS_1, @SWSETPANETEXT, 0, STR$(FSIZE) + " bytes"
setcontroltext win,EDIT_1,buffer
SETFOCUS WIN,EDIT_1
endif
endif
RETURN
endsub
SUB DoSave()
fName = filerequest("Save File",win,0)
if(len(fName) > 0)
if(openfile(fHdl,fName,"W") = 0)
buffer = getcontroltext(win,EDIT_1)
write fHdl,buffer
FSIZE = LEN(fHdl)
closefile fHdl
CONTROLCMD WIN, STATUS_1, @SWSETPANETEXT, 0, STR$(FSIZE) + " bytes written"
SETFOCUS WIN,EDIT_1
endif
endif
RETURN
endsub
Sub DoResize()
GetClientSize WIN, LEFT, TOP, WIDTH, HEIGHT
SENDMESSAGE(win, SB_GETRECT, 0, BRECT, STATUS_1)
STATUS_HEIGHT = BRECT.BOTTOM - BRECT.TOP
PARTS[0] = (WIDTH - 100)
CONTROLCMD win, STATUS_1, @SWSETPANES, 2, PARTS
CONTROLCMD win, STATUS_1, @SWRESIZE
GETSIZE WIN, l, t, w, h, 2000
SetSize WIN, LEFT, (TOP + h), WIDTH, (HEIGHT - STATUS_HEIGHT) - (h + 3), EDIT_1
Height- = GetSystemMetrics(SM_CXHSCROLL)
Width- = GetSystemMetrics(SM_CYVSCROLL)
WINRECT ERC
ERC.LEFT = 54 : ERC.TOP = 4 : ERC.RIGHT = WIDTH : ERC.BOTTOM = Height - (h + 4)
SendMessage WIN, EM_SETRECTNP, 0, ERC, EDIT_1
SetSize W1, 0, 0, 52, Height - (h + 4)
SCROLLPOS = GetScrollPosA(GetControlHandle(WIN,EDIT_1),SB_VERT)
UpdateGutter()
SetFocus WIN, 1
Return
EndSub
INT subclassID = 12345
Sub InitGutter()
hEdit = Getcontrolhandle (WIN, EDIT_1)
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Subclass edit control
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
ORIG = GetWindowLongA(hEdit,GWL_WNDPROC)
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Set the new address to the sub handler
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
SetWindowLongA(hEdit,GWL_WNDPROC,&EDIT)
OpenWindow W1, 0, 0, 0, 0, WS_CHILD | WS_VISIBLE | SS_NOTIFY | @NoCaption | @noautodraw | 0x4, hEdit, "", &LINECOUNT
SetWindowSubclass(W1.hwnd, &subclassProc, subclassID, 0)
SetFont W1,FONTNAME,FTSIZE,FWEIGHT,FFLAGS ': line count
GETTEXTSIZE(W1, "0", textW, textH) ': Find the desired text Height
SetWindowColor(W1,RGB(224,220,224)) ': line count back Color
FrontPen W1, RGB(64,64,64)
BackPen W1, RGB(224,220,224) ': line count text back Color
SendMessage WIN, WM_Size, 0, 0
SetFocus WIN, 1
' UpdateGutter()
Return
EndSub
SUB subclassProc(hWnd:INT,uMsg:INT,wParam:INT,lParam:INT,uIdSubclass:UINT_PTR,dwRefData:DWORD_PTR),INT
SELECT uMsg
CASE WM_PAINT
DefSubclassProc(hWnd, uMsg, wParam, lParam) ' call the default procedure first
SCROLLPOS = GetScrollPosA(GetControlHandle(WIN,EDIT_1),SB_VERT)
UpdateGutter() ' then draw what you want
RETURN 0
ENDSELECT
RETURN DefSubclassProc(hWnd, uMsg, wParam, lParam)
ENDSUB
Sub LINECOUNT()
Select @Class
Case @IDPaint
SCROLLPOS = GetScrollPosA(GetControlHandle(WIN,EDIT_1),SB_VERT)
UpdateGutter()
Case WM_ERASEBKGND
Return 1
EndSelect
Return
EndSub
Sub EDIT(HWND : Int,uMsg : Int,wParam : Int,lParam : Pointer),Int
Select uMsg
Case WM_PAINT
SCROLLPOS = GetScrollPosA(HWND,SB_VERT)
UpdateGutter()
Case WM_VSCROLL
Select (wParam & 0xFFFF)
Case SB_THUMBPOSITION
Case& SB_THUMBTRACK
SCROLLPOS = (wParam >> 16) & 0xFFFF
Default
SCROLLPOS = GetScrollPosA(HWND,SB_VERT)
EndSelect
UpdateGutter()
EndSelect
Return CallWindowProcA(ORIG,HWND,uMsg,wParam,lParam)
EndSub
Sub UpdateGutter()
GETCLIENTSIZE W1, L, T, W, H
H- = GetSystemMetrics(SM_CXHSCROLL)
Gutter_hDC = GetDC(W1.HWND)
' Gutter_hDC = GetDC(hEdit)
hdcMem = CreateCompatibleDC(0)
'saved = _SaveDC(Gutter_hDC)
hbmMem = CreateCompatibleBitmap(Gutter_hDC, W, H - 3)
oldBmp = SelectObject(hdcMem, hbmMem)
oldBrush = SelectObject(hdcMem, CreateSolidBrush(RGB(224,220,224))) ': lightgray Background
oldFont = SelectObject(hdcMem, _CreateFont(textH,0,0,0,FWEIGHT, 0,0,0,0,0,0,0,0, FONTNAME))
SetTextColor(hdcMem, RGB (0,0,0)) ': Black Text Color
SetBkMode(hdcMem, TRANSPARENT)
SetTextAlign(hdcMem,TA_BASELINE|TA_UPDATECP)
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Draw filled rectangle
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Rectangle(hdcMem, -1, -1, w, h)
Int count, x : count = scrollpos
For x = 0 To h Step textH
temp$ = LTrim$(Str$(count))
MoveToEx(hdcMem, 5, x , NULL)
_TextOut(hdcMem, 0, 0, temp$, len(temp$))
count++
Next x
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Transfer the off-screen DC to the screen
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
BitBlt(Gutter_hDC, 0, 0, w, h, hdcMem, 0, 0, SRCCOPY)
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Free-up the off-screen DC
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
DeleteObject(SelectObject(hdcMem, oldFont))
DeleteObject(SelectObject(hdcMem, oldBrush))
DeleteObject(SelectObject(hdcMem, oldBmp))
DeleteObject(hbmMem)
DeleteDC(hdcMem)
'_RestoreDC(Gutter_hDC, saved)
Return
EndSub
Sub DoEndProgram()
RemoveWindowSubclass(W1.hwnd, &subclassProc, subclassID)
SetWindowLongA(GetControlHandle(W1,EDIT_1),GWL_WNDPROC,ORIG)
ReleaseDC (hEdit, Gutter_hDC)
DestroyWindow(hToolBar)
CLOSEWINDOW W1
CLOSEWINDOW WIN
RETURN 0
ENDSUB
Thank you a thousand times, fasecero.
Your help is invaluable !
:)
I've made some progress and i'm now struggling to get the "Find & Replace" ComCtl API dialog to work
in my program. Problem is : the "Find & Replace dialog" pops up when the toolbar button is pressed, but
it disappears a few seconds later and the program crashes.
What's wrong with this code ?
- Line 330 : For sanity, i'm checking that the message for the find & replace common dialog is correctly registered . it seems it is.
- Line 353 : I've moved the aforementioned registered "iMsgFindReplace" from the subclassed Edit control handler to the program's main loop. But it didn't changed anything.
- Line 928 : I've checked the members of the "FINDREPLACE" type definition in the "SUB PopFindDlg" and they seem to be okay.
- Everything seems to be in place and logical. But still, the program is crashing. I'm confused.
/* EDIT
Well, after some more testing, it appears that the "iMsgFindReplace" message isn't processed whether i put
it in the main program loop (which is not right) OR in the subclassed Edit control handler (which IS right).
At least the program doesn't crash anymore.
Until i close the "Find" dialog and invoke it a second time...
EDIT */
See updated source as attachment.
Can't get it to crash the same as you, but it does crash when you click the "Properties" toolbar button.
Line 523 - ShellExecuteExA(info)
You are not passing enough parameters to "info" as far as I read it.
See this:
https://docs.microsoft.com/en-us/windows/win32/api/shellapi/nf-shellapi-shellexecutea
That's what I can spot (if I'm right?).
Andy.
This is strange, as the very same code doen't crash the program on my computer.
Which version of Windows are you running ?
Hacked the code to have a proper SHELLEXECUTEINFO structure.
Try updated source as attachment and tell me if it's still crashing ?
Yep, that sorts out the crash on "properties".
I'm using Win 7 32 bit.
Can you tell me where your crashing problem is? when I click (on the toolbar) "Find", the dialog box appears and looks okay.
Andy.
Type in something in the "Find" box, close it and click on the "Find" toolbar button...
* CRASH ! *
This is normal, as the "iMsgFindReplace" message is not processed.
It seems to be working fine after a few changes
- ES_NOHIDESEL style added to EDIT_1
- PopFindDlg modified
- RegisterWindowMessage needs FINDMSGSTRING
- global buffer for search text: ISTRING searchWhat[1000]
- iMsgFindReplace moved and processed inside subclassProc, some tweeks in there too
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Includes
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
$INCLUDE "windowssdk.inc"
$INCLUDE "Commctrl.inc"
'$INCLUDE "fletchie_ctl.inc"
AutoDefine "Off"
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Constants
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
CONST SS_NOTIFY = 0x100
CONST DT_LEFT = 0x0
CONST DT_RIGHT = 0x2
CONST COLOR_GRAYTEXT = 17
CONST EC_LEFTMARGIN = 0x0001
CONST EM_SETMARGINS = 0xD3
Const SM_CXHSCROLL = 21
CONST SM_CYVSCROLL = 20
Const EM_SETRECTNP = 0xB4
CONST EM_FINDWORDBREAK = (0x400 + 76)
CONST EM_GETCHARFORMAT = (0x400 + 58)
CONST EN_MSGFILTER = 0x700
CONST WB_RIGHT = 1
CONST WB_NEXTBREAK = 7
CONST WB_MOVEWORDRIGHT = 5
CONST WB_MOVEWORDLEFT = 4
CONST SB_GETBORDERS = (WM_USER+7)
CONST SB_GETICON = (WM_USER+20)
CONST SB_GETRECT = (WM_USER+10)
CONST PS_SOLID = 0 ':
CONST TRANSPARENT = 1 ': Pen Styles
CONST OPAQUE = 2 ':
CONST EM_FINDTEXT = (WM_USER + 56)
CONST EDIT_1 = 111
CONST STATUS_1 = 222
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Types definitions
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Type WINRECT
Int LEFT
Int TOP
Int RIGHT
Int BOTTOM
EndType
TYPE FONTINFO
DEF NAME AS STRING
DEF SIZE AS INT
DEF WEIGHT AS INT
DEF FLAGS AS INT
DEF FORECOLOR AS INT
ENDTYPE
TYPE SIZESTRUCT
DEF X AS INT
DEF Y AS INT
ENDTYPE
TYPE MSGFILTER
DEF hwndFrom:INT
DEF idFrom:INT
DEF CODE:INT
DEF MSG:INT
DEF WPARAM:INT
DEF LPARAM:INT
ENDTYPE
TYPE CHARFORMAT
UINT cbSize
INT dwMask
INT dwEffects
INT yHeight
INT yOffset
INT crTextColor
CHAR bCharSet
CHAR bPitchAndFamily
ISTRING szFaceName[32]
ENDTYPE
SetID "MOUSE_OVER_MENU",287
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Api Declares
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
DECLARE IMPORT, _CreateFont ALIAS CreateFontA(H AS INT,W AS INT,E AS INT,O AS INT,W AS INT,I AS INT,U AS INT,S AS INT,C AS INT,OP AS INT,CP AS INT,Q AS INT,PAF AS INT,F AS STRING),INT
DECLARE IMPORT, _TextOut ALIAS TextOutA(HDC AS INT,X AS INT,Y AS INT,lpString AS STRING,nCount AS INT),INT
DECLARE IMPORT, _FillRect ALIAS FillRect(HDC AS INT,lpRect AS WINRECT,hBrush AS INT),INT
DECLARE IMPORT, GetScrollPosA Alias "GetScrollPos"(HWND : Int, nBar : Int),Int
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Functions declares
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
DECLARE parsepath(pfull : STRING, ppath : STRING, pfile : STRING)
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Global variables
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
WINDOW WIN, W1, TMP
STRING FONTNAME, ln, temp$, Filter$
Int BBR, STATUS_HEIGHT, SCROLLPOS, ORIG, FTSIZE, FWEIGHT, FFLAGS, textW, textH, Answer
Int Gutter_hDC, hdcMem, hbmMem, oldBmp, oldBrush, OldFont, L, T, W, H, Save_As, RET, CancelAction
Uint hEdit, FSIZE
Istring fName[260], newName[260], buffer[65532]
File fHdl
Word lo
WINRECT BRECT
String MRU$[8]
MRU$ = "Empty", "Empty", "Empty", "Empty", "Empty"
INT MRUflag[8]
MRUflag = 0, 0, 0, 0, 0
Filter$ = "Text files|*.txt|All Files|*.*||"
'FONTNAME="Courier New"
'FTSIZE=10
FONTNAME = "FixedSys"
FTSIZE = 9
FWEIGHT = 0
FFLAGS = 0
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Variables & type for find & replace
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
FINDREPLACE fr
INT iMsgFindReplace
ISTRING txt[65532]
ISTRING searchWhat[1000]
POINTER lpPfr, zt, zTxt
INT pos
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Read configuration file
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
INIRead()
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Open main window
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
OPENWINDOW WIN,-9999,-9999,640,480,@Size|@MinBox|@MaxBox|@NOAUTODRAW|WS_CLIPCHILDREN, 0,"Tpad - [No Name]",&TpadHandler
'@MDIFRAME|
SetWindowColor(WIN,RGB(192,192,192))
INT LEFT, TOP, WIDTH, HEIGHT
GetClientSize WIN, LEFT, TOP, WIDTH, HEIGHT
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Create Edit control
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
CONTROL WIN,@Edit,"",LEFT, TOP, WIDTH, (HEIGHT - 48),0x50B010C4 | ES_NOHIDESEL, EDIT_1
SetControlColor WIN,EDIT_1,RGB(0,0,0),RGB(253,246,227)
ModifyExStyle(WIN, 0, @EXCLIENTEDGE|WS_BORDER, EDIT_1)
ReDrawFrame(WIN, EDIT_1)
CONTROLCMD win, EDIT_1, @EDSETLIMITTEXT, 65532
SetFont WIN,FONTNAME,FTSIZE,FWEIGHT,FFLAGS, EDIT_1
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Add a Statusbar
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
CONTROL win,@STATUS,"Ready...",0,0,0,0,0, STATUS_1
Int PARTS[2]
PARTS[0] = (WIDTH - 100)
PARTS[1] = -1
CONTROLCMD win, STATUS_1, @SWSETPANES, 2, PARTS
'StatusSetIcon(WIN,2,hIcon[3])
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Add a menu
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
BEGINMENU WIN
MENUTITLE "File"
MENUITEM "New",0,1
MENUITEM "Open",0,2
MENUITEM "Save as..",0,3
SEPARATOR
MENUITEM "Print",0,4
MENUITEM "Quit",0,5
MENUTITLE "Edit"
MENUITEM "Undo",0,10
SEPARATOR
MENUITEM "Cut",0,11
MENUITEM "Copy",0,12
MENUITEM "Paste",0,13
SEPARATOR
MENUITEM "Select All",0,14
SEPARATOR
MENUITEM "Find",0,15
MENUITEM "Replace",0,16
ENDMENU
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Create the Toolbar control
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Uint hToolBar, hInstance
hInstance = GetModuleHandleA(0)
hToolBar = CreateWindowExA(0x0,"toolbarwindow32","",WS_VISIBLE|WS_CHILD|CCS_TOP|TBSTYLE_FLAT|TBSTYLE_TOOLTIPS,0,0,440,16,win.hwnd,2000, hInstance,0)
SendMessage(hToolBar, TB_SETEXTENDEDSTYLE, 0, TBSTYLE_EX_DRAWDDARROWS) ': Set the extended class styles for the control
ControlCMD WIN,hToolBar,@TBSETBitmapSIZE, 16, 16
TYPE _TBBUTTON
UINT iBitmap
UINT idCommand
CHAR fsState
CHAR fsStyle
CHAR bReserved[2]
UINT dwData
POINTER lpString ': pointer to string or string index
ENDTYPE
_TBBUTTON ttbb[12]
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Send the TB_BUTTONSTRUCTSIZE message, for backward compatibility
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
SendMessage(hToolBar, TB_BUTTONSTRUCTSIZE, Len(ttbb), 0)
TYPE TBADDBITMAP
UINT hInst
UINT nId
ENDTYPE
TBADDBITMAP tbab
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Assign Image list to The toolbar
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
tbab.hInst = -1 ': Comctl32 bitmaps
tbab.nID = 0 ': 0=16x16, 1=32x32
SendMessage(hToolBar, 0x413, 12, tbab) ': TB_ADDBITMAP
ttbb[0].iBitmap = STD_FILENEW
ttbb[0].idCommand = 1
ttbb[0].fsState = TBSTATE_ENABLED
ttbb[0].fsStyle = BTNS_BUTTON
ttbb[0].dwData = 0
ttbb[0].lpString = -1
ttbb[1].iBitmap = STD_FILEOPEN
ttbb[1].idCommand = 2
ttbb[1].fsState = TBSTATE_ENABLED
ttbb[1].fsStyle = BTNS_DROPDOWN
ttbb[1].dwData = 0
ttbb[1].lpString = -1
ttbb[2].iBitmap = STD_FILESAVE
ttbb[2].idCommand = 3
ttbb[2].fsState = TBSTATE_ENABLED
ttbb[2].fsStyle = BTNS_BUTTON
ttbb[2].dwData = 0
ttbb[2].lpString = -1
ttbb[3].iBitmap = STD_CUT
ttbb[3].idCommand = 4
ttbb[3].fsState = TBSTATE_ENABLED
ttbb[3].fsStyle = BTNS_BUTTON
ttbb[3].dwData = 0
ttbb[3].lpString = -1
ttbb[4].iBitmap = STD_COPY
ttbb[4].idCommand = 5
ttbb[4].fsState = TBSTATE_ENABLED
ttbb[4].fsStyle = BTNS_BUTTON
ttbb[4].dwData = 0
ttbb[4].lpString = -1
ttbb[5].iBitmap = STD_PASTE
ttbb[5].idCommand = 6
ttbb[5].fsState = TBSTATE_ENABLED
ttbb[5].fsStyle = BTNS_BUTTON
ttbb[5].dwData = 0
ttbb[5].lpString = -1
ttbb[6].iBitmap = STD_UNDO
ttbb[6].idCommand = 7
ttbb[6].fsState = TBSTATE_ENABLED
ttbb[6].fsStyle = BTNS_BUTTON
ttbb[6].dwData = 0
ttbb[6].lpString = -1
ttbb[7].iBitmap = STD_PRINT
ttbb[7].idCommand = 8
ttbb[7].fsState = TBSTATE_ENABLED
ttbb[7].fsStyle = BTNS_BUTTON
ttbb[7].dwData = 0
ttbb[7].lpString = -1
ttbb[8].iBitmap = STD_FIND
ttbb[8].idCommand = 9
ttbb[8].fsState = TBSTATE_ENABLED
ttbb[8].fsStyle = BTNS_BUTTON
ttbb[8].dwData = 0
ttbb[8].lpString = -1
ttbb[9].iBitmap = STD_REPLACE
ttbb[9].idCommand = 10
ttbb[9].fsState = TBSTATE_ENABLED
ttbb[9].fsStyle = BTNS_BUTTON
ttbb[9].dwData = 0
ttbb[9].lpString = -1
ttbb[10].iBitmap = STD_PROPERTIES
ttbb[10].idCommand = 11
ttbb[10].fsState = TBSTATE_ENABLED
ttbb[10].fsStyle = BTNS_BUTTON
ttbb[10].dwData = 0
ttbb[10].lpString = -1
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Add buttons & set tooltips
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
STRING Tip[11]
Tip = "New", "Open", "Save", "Cut", "Copy", "Paste", "Undo", "Print", "Find", "Replace", "Properties"
int tbb
For tbb = 0 to 10
SendMessage hToolBar, TB_ADDBUTTONS, 1, ttbb[tbb]
ControlCMD win,2000,@TBSETTIP,tbb+1,Tip[tbb]
Next tbb
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Insert Spacers
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
ttbb.iBitmap=5 ': pixel width of separator
ttbb.idCommand=0
ttbb.fsStyle=BTNS_SEP ': fsStyle=1 (separator), fsState=4 (enabled)
SendMessage(hToolBar,0x415,0,ttbb)
SendMessage(hToolBar,0x415,4,ttbb)
SendMessage(hToolBar,0x415,9,ttbb)
SendMessage(hToolBar,0x415,13,ttbb)
SendMessage(hToolBar,0x415,15,ttbb)
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Update the size of the toolbar
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
SendMessage hToolBar, TB_AUTOSIZE, 0, 0
': Save button is disabled at first
ControlCMD WIN,2000,@TBENABLEBUTTON,3,0
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Initialise gutter custom control and resize/redraw the window
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
InitGutter()
DoResize()
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Register message for the find & replace common dialog
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
iMsgFindReplace = RegisterWindowMessage (FINDMSGSTRING)
If iMsgFindReplace = 0 THEN MESSAGEBOX(win,"Could not register window message !","Find", 0 | 80)
CENTERWINDOW WIN
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Main Loop
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Sub TpadHandler()
SELECT @MESSAGE
CASE @IDCLOSEWINDOW
CancelAction = FALSE
IsFileChanged()
If CancelAction = TRUE Then RETURN
INIWrite()
DoEndProgram()
CASE WM_SETFOCUS
SetFocus WIN, EDIT_1
CASE @IDSIZE
DoResize()
CASE @IDMENUPICK
SELECT @MENUNUM
CASE 1
CancelAction = FALSE
IsFileChanged()
If CancelAction = TRUE Then RETURN
FileNew()
CASE 2
IsFileChanged()
DoOpen("")
CASE 3
Save_As = 1
DoSave()
CASE 4
CONTROLCMD WIN,EDIT_1,@RTPRINT
SetFocus WIN, EDIT_1
CASE 5
CancelAction = FALSE
IsFileChanged()
If CancelAction = TRUE Then RETURN
INIWrite()
DoEndProgram()
CASE 10
CONTROLCMD WIN,EDIT_1,@EDUNDO
CASE 11
CONTROLCMD WIN,EDIT_1,@EDCUT
CASE 12
CONTROLCMD WIN,EDIT_1,@EDCOPY
CASE 13
CONTROLCMD WIN,1,@EDPASTE
CASE 14
CONTROLCMD WIN,EDIT_1,@EDSETSELECTION,0,-1
CASE 15 ': todo -> Find routine
CASE 16 ': todo -> Replace routine
CASE 100
fName = MRU$[0]
DoOpen(fName)
CASE 101
fName = MRU$[1]
DoOpen(fName)
CASE 102
fName = MRU$[2]
DoOpen(fName)
CASE 103
fName = MRU$[3]
DoOpen(fName)
CASE 104
fName = MRU$[4]
DoOpen(fName)
EndSelect
CASE @IDCONTROL
SELECT @CONTROLID
CASE 1
If @NotifyCode = 0
CancelAction = FALSE
IsFileChanged()
If CancelAction = TRUE Then RETURN
FileNew()
EndIf
CASE 2
If @NotifyCode = 0
InvalidateRect(hToolBar, 0, 0) : UpdateWindow(hToolBar)
IsFileChanged()
DoOpen("")
EndIf
CASE 3
If @NotifyCode = 0
InvalidateRect(hToolBar, 0, 0) : UpdateWindow(hToolBar)
if fName <> "" THEN Save_As = 0
DoSave()
EndIf
CASE 4
If @NotifyCode = 0
CONTROLCMD WIN,EDIT_1,@EDCUT
EndIf
CASE 5
If @NotifyCode = 0
CONTROLCMD WIN,EDIT_1,@EDCOPY
EndIf
CASE 6
If @NotifyCode = 0
CONTROLCMD WIN,EDIT_1,@EDPASTE
EndIf
CASE 7
If @NotifyCode = 0
CONTROLCMD WIN,EDIT_1,@EDUNDO
EndIf
CASE 8
If @NotifyCode = 0
InvalidateRect(hToolBar, 0, 0) : UpdateWindow(hToolBar)
CONTROLCMD WIN,EDIT_1,@RTPRINT
SetFocus WIN, EDIT_1
EndIf
CASE 9
': Todo -> Find routine
If @NotifyCode = 0
InvalidateRect(hToolBar, 0, 0) : UpdateWindow(hToolBar)
hEdit = Getcontrolhandle (WIN, EDIT_1)
PopFindDlg(W1.hwnd, "")
EndIf
CASE 10
': Todo -> Replace routine
If @NotifyCode = 0
InvalidateRect(hToolBar, 0, 0) : UpdateWindow(hToolBar)
EndIf
CASE 11
If @NotifyCode = 0
InvalidateRect(hToolBar, 0, 0) : UpdateWindow(hToolBar)
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Display system property sheet for this file
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
CONST SEE_MASK_INVOKEIDLIST = 0xC
SHELLEXECUTEINFO info
info.cbSize = 15 * 4
info.fMask = SEE_MASK_INVOKEIDLIST
info.lpVerb = "properties"
info.lpFile = fName
info.nShow = SW_SHOW
ShellExecuteExA(info)
SETFOCUS WIN,EDIT_1
EndIf
CASE EDIT_1 ': Edit control
SELECT @NOTIFYCODE
Case @ENChange
SENDMESSAGE WIN, EM_SETMODIFY, TRUE, 0, EDIT_1
IF fName <> ""
SETCAPTION WIN, "Tpad - [" + fName + " *]"
ELSE
Save_As = 1
SETCAPTION WIN, "Tpad - [No Name *]"
ENDIF
ControlCMD WIN,2000,@TBENABLEBUTTON,3,1
ENDSELECT
CASE 2000 ': Toolbar
SELECT @NOTIFYCODE
CASE TBN_DROPDOWN
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Drop down toolbar menu -> disable empty menu items
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
INT mc
FOR mc = 0 TO 4
IF MRU$[mc] = "Empty"
mruflag[mc] = @MENUDISABLE
ELSE
mruflag[mc] = 0
ENDIF
NEXT mc
ContextMenu WIN, 25, 25
MENUITEM MRU$[0],mruflag[0],100
MENUITEM MRU$[1],mruflag[1],101
MENUITEM MRU$[2],mruflag[2],102
MENUITEM MRU$[3],mruflag[3],103
MENUITEM MRU$[4],mruflag[4],104
ENDMENU
DEFAULT':Toolbar Button
ENDSELECT
EndSelect
Case @MOUSE_OVER_MENU
lo = (@Code& 0xFFFF)
'CONTROLCMD WIN, STATUS_1, @SWSETPANETEXT, 0, Tip[lo - 1]
ENDSELECT
Return 0
ENDSUB
WaitUntil IsWindowClosed(win)
END
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Functions
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Sub WorkinProgress()
MESSAGEBOX(win,"Function not yet implemented","Work in progress",@MB_ICONQUESTION | @MB_OK)
RETURN
ENDSUB
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Prevent flickering on WM_PAINT messages
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Sub EraseBG()
Return 1
ENDSUB
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Check if file needs to be saved.
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Sub IsFileChanged()
RET = SENDMESSAGE WIN, EM_GETMODIFY, 0, 0, EDIT_1
IF RET = TRUE
Answer = MESSAGEBOX(win,"File was modified. Save changes ?","Tpad",@MB_ICONQUESTION | @MB_YESNOCANCEL)
SELECT Answer
CASE @IDYES
If fName <> ""
Save_As = 0
DoSave()
ELSE
Save_As = 1
DoSave()
ENDIF
CASE @IDNO
CASE @IDCANCEL
CancelAction = TRUE
SETFOCUS WIN, EDIT_1
RETURN
ENDSELECT
ENDIF
RETURN
EndSub
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Clear edit control for a New File
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Sub FileNew()
ControlCMD WIN,2000,@TBENABLEBUTTON,3,0
SetControlText WIN, EDIT_1, ""
SENDMESSAGE WIN, EM_SETMODIFY, 0, 0, EDIT_1
fName = "" : Save_As = 1
SETCAPTION WIN, "Tpad - [No Name]"
SETFOCUS WIN, EDIT_1
RETURN
ENDSUB
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Open file
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
SUB DoOpen(fName:String)
IF fName = "" THEN fName = FileRequest("Open File",WIN,1,Filter$,"txt",0)
if(len(fName) > 0)
buffer = ""
if(openfile(fHdl,fName,"R") = 0)
do
if(read(fHdl,ln) = 0)
buffer = buffer + ln + chr$(13) + chr$(10)
endif
until eof(fHdl)
FSIZE = LEN(fHdl)
closefile fHdl
newname = fName : mruArray()
CONTROLCMD WIN, STATUS_1, @SWSETPANETEXT, 1, STR$(FSIZE) + " bytes"
SETCAPTION WIN, "Tpad - [" + fName + "]"
setcontroltext win,EDIT_1,buffer
SETFOCUS WIN,EDIT_1
endif
ELSE
RETURN
endif
RETURN
endsub
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Save file
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
SUB DoSave()
IF Save_As = 1 THEN fName = FileRequest("Save File",WIN,0,Filter$,"txt",0)
if(len(fName) > 0)
if(openfile(fHdl,fName,"W") = 0)
buffer = getcontroltext(win,EDIT_1)
write fHdl,buffer
FSIZE = LEN(fHdl)
closefile fHdl
CONTROLCMD WIN, STATUS_1, @SWSETPANETEXT, 1, STR$(FSIZE) + " bytes"
SENDMESSAGE WIN, EM_SETMODIFY, 0, 0, EDIT_1
ControlCMD WIN,2000,@TBENABLEBUTTON,3,0
Save_As = 0
SETFOCUS WIN,EDIT_1
endif
ELSE
RETURN
endif
IF fName <> ""
SETCAPTION WIN, "Tpad - [" + fName + "]"
ELSE
RET = SENDMESSAGE WIN, EM_GETMODIFY, 0, 0, EDIT_1
IF RET = TRUE
SETCAPTION WIN, "Tpad - [No Name *]"
ENDIF
ENDIF
RETURN
endsub
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Resize windows and controls
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Sub DoResize()
GetClientSize WIN, LEFT, TOP, WIDTH, HEIGHT
SENDMESSAGE(win, SB_GETRECT, 0, BRECT, STATUS_1)
STATUS_HEIGHT = BRECT.BOTTOM - BRECT.TOP
PARTS[0] = (WIDTH - 100)
CONTROLCMD win, STATUS_1, @SWSETPANES, 2, PARTS
CONTROLCMD win, STATUS_1, @SWRESIZE
GETSIZE WIN, l, t, w, h, 2000
SetSize WIN, LEFT, (TOP + h), WIDTH, (HEIGHT - STATUS_HEIGHT) - (h + 3), EDIT_1
Height- = GetSystemMetrics(SM_CXHSCROLL)
Width- = GetSystemMetrics(SM_CYVSCROLL)
WINRECT ERC
ERC.LEFT = 54 : ERC.TOP = 4 : ERC.RIGHT = WIDTH : ERC.BOTTOM = Height - (h + 4)
SendMessage WIN, EM_SETRECTNP, 0, ERC, EDIT_1
SetSize W1, 0, 0, 52, Height - (h + 4)
SCROLLPOS = GetScrollPosA(GetControlHandle(WIN,EDIT_1),SB_VERT)
UpdateGutter()
SetFocus WIN, EDIT_1
Return
EndSub
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Initialise the gutter custom control
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
INT subclassID = 12345
Sub InitGutter()
hEdit = Getcontrolhandle (WIN, EDIT_1)
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Subclass edit control
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
ORIG = GetWindowLongA(hEdit,GWL_WNDPROC)
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Set the new address to the sub handler for edit control
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
SetWindowLongA(hEdit,GWL_WNDPROC,&EDIT)
OpenWindow W1, 0, 0, 0, 0, WS_CHILD | WS_VISIBLE | SS_NOTIFY | @NoCaption | @noautodraw | 0x4, hEdit, "", &LINECOUNT
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Set the new address to the sub handler for gutter control
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
SetWindowSubclass(W1.hwnd, &subclassProc, subclassID, 0)
SetFont W1,FONTNAME,FTSIZE,FWEIGHT,FFLAGS ': line count
GETTEXTSIZE(W1, "0", textW, textH) ': Find the desired text Height
SetWindowColor(W1,RGB(224,220,224)) ': line count back Color
FrontPen W1, RGB(64,64,64)
BackPen W1, RGB(224,220,224) ': line count text back Color
SendMessage WIN, WM_Size, 0, 0
SetFocus WIN, 1
Return
EndSub
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Process events messages for the gutter custom control
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
SUB subclassProc(hWnd : INT, uMsg : INT, wParam : INT, lParam : INT, uIdSubclass : UINT_PTR, dwRefData : DWORD_PTR),INT
SELECT uMsg
CASE WM_PAINT
DefSubclassProc(hWnd, uMsg, wParam, lParam) ' call the default procedure first
SCROLLPOS = GetScrollPosA(GetControlHandle(WIN,EDIT_1),SB_VERT)
UpdateGutter() ' then draw what you want
RETURN 0
CASE iMsgFindReplace ': <- this is the message we registered
' MESSAGEBOX(win,"message received","Find", 0 | 80)
lpPfr = lParam + 0 ': a few flags one can trap
IF (#<FINDREPLACE>lpPfr.Flags & FR_DIALOGTERM) = FR_DIALOGTERM THEN Return 0 ': <- Find dialog is closed
IF (#<FINDREPLACE>lpPfr.Flags & FR_FINDNEXT) = FR_FINDNEXT THEN ': <- Find next button is pressed
txt = GETCONTROLTEXT WIN, EDIT_1 ': <- text to search in
zt = #<FINDREPLACE>lpPfr.lpstrFindWhat + 0 ': <- text to search for
pos = INSTR(txt, #<STRING>zt, pos + 1) ': <- search
IF pos ': <- if result
'SendMessage(WIN, EM_SETSEL, pos, pos + LEN(#<STRING>zt), EDIT_1)
CONTROLCMD(WIN, EDIT_1, @EDSETSELECTION, pos - 1, pos + LEN(#<STRING>zt) - 1)
pos = pos + LEN(#<STRING>zt) ': <- for next search
ELSE
MESSAGEBOX(win,"No more occurrences !","Find", 0 | 80)
ENDIF
ENDIF
'RETURN 0
ENDSELECT
RETURN DefSubclassProc(hWnd, uMsg, wParam, lParam)
ENDSUB
Sub LINECOUNT()
Select @Class
Case @IDPaint
SCROLLPOS = GetScrollPosA(GetControlHandle(WIN,EDIT_1),SB_VERT)
UpdateGutter()
Case WM_ERASEBKGND
Return 1
EndSelect
Return
EndSub
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Process events messages for the edit control
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Sub EDIT(HWND : Int, uMsg : Int, wParam : Int, lParam : Pointer),Int
Select uMsg
Case WM_PAINT
SCROLLPOS = GetScrollPosA(HWND,SB_VERT)
UpdateGutter()
Case WM_VSCROLL
Select (wParam & 0xFFFF)
Case SB_THUMBPOSITION
Case& SB_THUMBTRACK
SCROLLPOS = (wParam >> 16) & 0xFFFF
Default
SCROLLPOS = GetScrollPosA(HWND,SB_VERT)
EndSelect
UpdateGutter()
EndSelect
Return CallWindowProcA(ORIG,HWND,uMsg,wParam,lParam)
EndSub
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Repaint the gutter custom control
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Sub UpdateGutter()
GETCLIENTSIZE W1, L, T, W, H
H- = GetSystemMetrics(SM_CXHSCROLL)
Gutter_hDC = GetDC(W1.HWND)
hdcMem = CreateCompatibleDC(0)
hbmMem = CreateCompatibleBitmap(Gutter_hDC, W, H - 3)
oldBmp = SelectObject(hdcMem, hbmMem)
oldBrush = SelectObject(hdcMem, CreateSolidBrush(RGB(224,220,224))) ': lightgray Background
oldFont = SelectObject(hdcMem, _CreateFont(textH,0,0,0,FWEIGHT, 0,0,0,0,0,0,0,0, FONTNAME))
SetTextColor(hdcMem, RGB (0,0,0)) ': Black Text Color
SetBkMode(hdcMem, TRANSPARENT)
SetTextAlign(hdcMem,TA_BASELINE|TA_UPDATECP)
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Draw filled rectangle
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Rectangle(hdcMem, -1, -1, w, h)
Int count, x : count = scrollpos
For x = 0 To h Step textH
temp$ = LTrim$(Str$(count))
MoveToEx(hdcMem, 5, x , NULL)
_TextOut(hdcMem, 0, 0, temp$, len(temp$))
count++
Next x
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Transfer the off-screen DC to the screen
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
BitBlt(Gutter_hDC, 0, 0, w, h, hdcMem, 0, 0, SRCCOPY)
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': Free-up the off-screen DC
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
DeleteObject(SelectObject(hdcMem, oldFont))
DeleteObject(SelectObject(hdcMem, oldBrush))
DeleteObject(SelectObject(hdcMem, oldBmp))
DeleteObject(hbmMem)
DeleteDC(hdcMem)
Return
EndSub
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Manage MRU entries
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
SUB mruArray()
INT b, i, k
b=0 ': reset flag for file in list
FOR i=0 TO 5 ': If file is in list, move to top
IF MRU$[i]=newname
FOR k=i TO 1 STEP -1
MRU$[k]=MRU$[k-1]
NEXT k
MRU$[0]=newname
b=1:i=5 ': exit loop
ENDIF
NEXT i
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
': If file is not already in list, move everybody
': down one position and put new file on top
': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
IF b=0
FOR i=5 TO 1 STEP -1
MRU$[i]=MRU$[i-1]
NEXT i
MRU$[0]=newname
ENDIF
RETURN
ENDSUB
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
': Read ini file with API call, then fill names array
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
SUB INIRead()
STRING zbuffer, key
INT nret, nbuffer, i
FOR i = 0 TO 4
zbuffer = SPACE$(250)
nBuffer=LEN(zbuffer)
key="MRU"+LTRIM$(STR$(i))
nret=GetPrivateProfileStringA("Files",key,"...",zbuffer,nBuffer,GETSTARTPATH + "\\Tpad.ini")
zbuffer=LEFT$(zbuffer,nret)
IF zbuffer<>"..."
MRU$[i]=zbuffer
ENDIF
NEXT i
RETURN
ENDSUB
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
': Write ini file with api call
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
SUB INIWrite()
INT i
STRING key
FOR i = 0 TO 4
key="MRU"+LTRIM$(STR$(i))
WritePrivateProfileString("Files",key,MRU$[i],GETSTARTPATH + "\\Tpad.ini")
NEXT i
RETURN
ENDSUB
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Breaks longfilename to access path + file name
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
SUB parsepath(pfull : STRING, ppath : STRING, pfile : STRING)
INT done
done = 0
ppath = pfull
IF (INSTR(ppath,"\\")) | (INSTR(ppath,"/"))
WHILE done = 0
IF(RIGHT$(ppath,1) <> "\\") & (RIGHT$(ppath,1) <> "/")
ppath = LEFT$(ppath,LEN(ppath)-1)
ELSE
done = 1
ENDIF
ENDWHILE
pfile = MID$(pfull,LEN(ppath)+1)
ENDIF
RETURN
EndSub
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Call up the Find text dialog
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
SUB PopFindDlg(hwndCaller : INT, sFindText : STRING), INT
ZeroMemory(&fr, LEN(fr))
searchWhat = sFindText
fr.lStructSize = LEN(fr)
fr.hWndOwner = hwndCaller
fr.Flags = FR_DOWN ': OR FR_FINDNEXT OR FR_SHOWHELP OR FR_FINDNEXT
fr.lpstrFindWhat = &searchWhat
fr.wFindWhatLen = 1000 ' searchWhat capacity
FindText(&fr)
RETURN 0
EndSub
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Remove subclassing, release GDI DC, close windows & terminate program
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Sub DoEndProgram()
RemoveWindowSubclass(W1.hwnd, &subclassProc, subclassID)
SetWindowLongA(GetControlHandle(W1,EDIT_1),GWL_WNDPROC,ORIG)
ReleaseDC (hEdit, Gutter_hDC)
DestroyWindow(hToolBar)
CLOSEWINDOW W1
CLOSEWINDOW WIN
RETURN 0
ENDSUB
Fasecero, he knows the Tao of programming.
Thank you.
Took the liberty of having a tidy up and taking out some redundant code, BUT . . .
I can't get it to open a file at all
Brian
Hi Brian,
Maybe CoInitialize can fix this
http://www.ionicwind.com/forums/index.php?topic=5572.msg41196#msg41196
Fasecero,
CoInitialize doesn't work for me - will keep looking
Brian