March 28, 2024, 09:36:02 AM

News:

Own IWBasic 2.x ? -----> Get your free upgrade to 3.x now.........


Custom control : Gutter

Started by h3kt0r, January 28, 2020, 06:23:28 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

h3kt0r

January 28, 2020, 06:23:28 PM Last Edit: January 28, 2020, 06:28:53 PM by h3kt0r Reason: Update
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.

h3kt0r

Updated version with a Common Controls API toolbar.
Still looking for a solution with the gutter display problem...

fasecero

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


h3kt0r

Thank you a thousand times, fasecero.
Your help is invaluable !
:)

h3kt0r

February 02, 2020, 09:38:11 AM #4 Last Edit: February 02, 2020, 11:39:29 PM by h3kt0r Reason: Update
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.

Andy

February 02, 2020, 11:24:22 PM #5 Last Edit: February 02, 2020, 11:26:34 PM by Andy
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.
Day after day, day after day, we struck nor breath nor motion, as idle as a painted ship upon a painted ocean.

h3kt0r

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 ?

Andy

February 03, 2020, 12:03:11 AM #7 Last Edit: February 03, 2020, 12:26:38 AM by Andy
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.
Day after day, day after day, we struck nor breath nor motion, as idle as a painted ship upon a painted ocean.

h3kt0r

February 03, 2020, 01:42:10 AM #8 Last Edit: February 03, 2020, 01:51:40 AM by h3kt0r
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.

fasecero

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

h3kt0r

Fasecero, he knows the Tao of programming.
Thank you.

Brian

February 04, 2020, 11:56:39 AM #11 Last Edit: February 04, 2020, 11:58:11 AM by Brian
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

fasecero


Brian

Fasecero,

CoInitialize doesn't work for me - will keep looking

Brian