': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ': 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$, ppath, pfile 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] 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, 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 ("Tpad_FindReplace") 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(hEdit, SPACE$(80)) 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 parsepath(fname, ppath, pfile) SHELLEXECUTEINFO info info.cbSize = 15 * 4 info.fMask = SEE_MASK_INVOKEIDLIST info.hwnd = WIN.hwnd info.lpVerb = "properties" info.lpFile = fName info.lpParameters = NULL info.lpDirectory = ppath info.nShow = SW_SHOW info.hInstApp = NULL 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 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 iMsgFindReplace ': <- this is the message we registered MESSAGEBOX(win,"message received","Find", 0 | 80) lpPfr = LPARAM ': a few flags one can trap IF (#lpPfr.Flags = FR_DIALOGTERM) THEN Return 0 ': <- Find dialog is closed IF (#lpPfr.Flags = FR_FINDNEXT) ': <- Find next button is pressed txt = GETCONTROLTEXT WIN, EDIT_1 ': <- text to search in zt = #lpPfr.lpstrFindWhat ': <- text to search for #lpPfr.wFindWhatLen = LEN(#zt) pos = INSTR(txt, #zt, pos + 1) ': <- search IF pos ': <- if result 'SendMessage(WIN, EM_SETSEL, pos, pos + LEN(#zt), EDIT_1) CONTROLCMD(WIN, EDIT_1, @EDSETSELECTION, pos, pos + LEN(#zt)) pos = pos + LEN(#zt) ': <- for next search ELSE MESSAGEBOX(win,"No more occurrences !","Find", 0 | 80) ENDIF ENDIF 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 zTxt = sFindText fr.lStructSize = LEN(fr) fr.hWndOwner = hwndCaller fr.hInstance = NULL fr.Flags = FR_DOWN ': OR FR_FINDNEXT OR FR_SHOWHELP OR FR_FINDNEXT fr.lpstrFindWhat = zTxt fr.lpstrReplaceWith = NULL fr.wFindWhatLen = LEN(sFindText) fr.wReplaceWithLen = 0 fr.lCustData = 0 fr.lpfnHook = NULL fr.lpTemplateName = NULL FindText(fr) RETURN 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