': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ': Includes ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ $INCLUDE "windowssdk.inc" $INCLUDE "commctrl.inc" '$INCLUDE "fletchie_ctl.inc" AutoDefine "Off" DECLARE IMPORT,GetScrollPosA ALIAS "GetScrollPos"(HWND:Int,nBar:Int),Int ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' Constants ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ CONST EDIT_1 = 111 CONST STATUS_1 = 222 SetID "MOUSE_OVER_MENU",287 ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' Functions declares ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 'DECLARE parsepath(pfull : STRING, ppath : STRING, pfile : STRING) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' Global variables ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ WINDOW WIN, W1 STRING FONTNAME, ln, temp$, Filter$ Int 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 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 ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Int PARTS[2] PARTS[0] = (WIDTH - 150) PARTS[1] = -1 CONTROL win,@STATUS,"",0,0,0,0,0,STATUS_1 CONTROLCMD win, STATUS_1,@SWSETPANES, 2, PARTS CONTROLCMD win,STATUS_1,@SWSETPANETEXT,0,"Ready..." CONTROLCMD win,STATUS_1,@SWSETPANETEXT,1,"Tpad" ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' 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,32,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,32,32 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 = 1 ' 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(),INT SELECT @MESSAGE CASE @IDCLOSEWINDOW CancelAction = FALSE IsFileChanged() If CancelAction = TRUE Then RETURN 0 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 0 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 0 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 0 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 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 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 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 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 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 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 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 (#lpPfr.Flags & FR_DIALOGTERM) = FR_DIALOGTERM THEN Return 0 ' <- Find dialog is closed IF (#lpPfr.Flags & FR_FINDNEXT) = FR_FINDNEXT THEN ' <- Find next button is pressed txt = GETCONTROLTEXT WIN, EDIT_1 ' <- text to search in zt = #lpPfr.lpstrFindWhat + 0 ' <- text to search for 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 - 1, pos + LEN(#zt) - 1) pos = pos + LEN(#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(),INT Select @Class Case @IDPaint SCROLLPOS = GetScrollPosA(GetControlHandle(WIN,EDIT_1),SB_VERT) UpdateGutter() Case WM_ERASEBKGND Return 1 EndSelect Return 0 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) 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 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 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 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 ENDSUB