': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ': Includes ': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ $INCLUDE "windowssdk.inc" $INCLUDE "commctrl.inc" $INCLUDE "ctl.inc" AutoDefine "Off" $MAIN CONST EDIT_1 = 111 CONST STATUS_1 = 222 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 STRING FONTNAME, ln, temp$, Filter$, ppath, pfile 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, hIcon[1] UINT64 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 hIcon[0] = LoadImage("24x24", @IMGICON) hIcon[1] = LoadImage("16x16", @IMGICON) 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[255] ISTRING replaceWith[255] POINTER lpPfr, zt, zu 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)) Vignette(WIN, 352, 0, 352, 24, RGB(255, 255, 255), 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, himl[2] hInstance = GetModuleHandleA(0) hToolBar = CreateWindowExA(0x0,"toolbarwindow32","",WS_VISIBLE|WS_CHILD|CCS_TOP|TBSTYLE_FLAT|TBSTYLE_TOOLTIPS,0,0,352,16,win.hwnd,2000, hInstance,0) SendMessage(hToolBar, TB_SETEXTENDEDSTYLE, 0, TBSTYLE_EX_DRAWDDARROWS | TBSTYLE_TRANSPARENT) ': Set the extended class styles for the control himl[0] = conLoadImages("Tpad_tb", 16, 0) himl[1] = conLoadImages("Tpad_tb_h", 16, 0) himl[2] = conLoadImages("Tpad_tb_d", 16, 0) SendMessage(hToolBar, TB_SETIMAGELIST, 2000, himl[0]) ': Assign Image list to The toolbar SendMessage(hToolBar, TB_SETHOTIMAGELIST, 2000, himl[1]) ': Assign Hot Image list to The toolbar SendMessage(hToolBar, TB_SETDISABLEDIMAGELIST, 2000, himl[2]) ': Assign Disabled Image list to The toolbar 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[13] ': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ': Send the TB_BUTTONSTRUCTSIZE message, for backward compatibility ': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ SendMessage(hToolBar, TB_BUTTONSTRUCTSIZE, Len(ttbb), 0) ttbb[0].iBitmap = 0 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 = 1 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 = 2 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 = 3 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 = 4 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 = 5 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 = 6 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 = 7 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 = 8 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 = 9 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 = 10 ttbb[10].idCommand = 11 ttbb[10].fsState = TBSTATE_ENABLED ttbb[10].fsStyle = BTNS_BUTTON ttbb[10].dwData = 0 ttbb[10].lpString = -1 /* ttbb[11].iBitmap = 11 ': wordwrap ttbb[11].idCommand = 12 ttbb[11].fsState = TBSTATE_ENABLED ttbb[11].fsStyle = TBSTYLE_CHECK ttbb[11].dwData = 0 ttbb[11].lpString = -1 */ ttbb[11].iBitmap = 12 ': font ttbb[11].idCommand = 13 ttbb[11].fsState = TBSTATE_ENABLED ttbb[11].fsStyle = BTNS_BUTTON ttbb[11].dwData = 0 ttbb[11].lpString = -1 ttbb[12].iBitmap = 13 ': ontop ttbb[12].idCommand = 14 ttbb[12].fsState = TBSTATE_ENABLED ttbb[12].fsStyle = TBSTYLE_CHECK ttbb[12].dwData = 0 ttbb[12].lpString = -1 ': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ': Add buttons & set tooltips ': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ STRING Tip[13] Tip = "New", "Open", "Save", "Cut", "Copy", "Paste", "Undo", "Print", "Find", "Replace", "Properties", "Font", "On Top" int tbb For tbb = 0 to 12 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 ': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ': stick an icon to our program's window ': set property for 16x16 caption and 24x24 taskbar icon ': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 'SETICON WIN, hIcon CONST ICON_SMALL = 0 CONST ICON_BIG = 1 SetProp(WIN.hwnd, "TpadIcon", hIcon[1]) :' Main app icon Sendmessage(WIN, WM_SETICON, ICON_BIG, hIcon[0]) Sendmessage(WIN, WM_SETICON, ICON_SMALL, hIcon[1]) ': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ': 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 WaitUntil IsWindowClosed(win) END ': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ': 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 WM_ERASEBKGND CASE @IDEraseBackground Vignette(WIN, 352, 0, 352, 24, RGB(255, 255, 255), RGB(192,192,192)) ' Return 1 ': Prevent flickering on WM_PAINT messages CASE @IDSIZE DoResize() CASE @IDMENUPICK SELECT @MENUNUM CASE 1 CancelAction = FALSE IsFileChanged() If CancelAction = TRUE Then RETURN 0 FileNew() CASE 2 CancelAction = FALSE IsFileChanged() If CancelAction = TRUE Then RETURN 0 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 PopFindDlg(W1.hwnd, "") CASE 16 ': todo -> Replace routine PopReplaceDlg(W1.hwnd, "", "") CASE 100 CancelAction = FALSE IsFileChanged() If CancelAction = TRUE Then RETURN 0 fName = MRU$[0] DoOpen(fName) CASE 101 CancelAction = FALSE IsFileChanged() If CancelAction = TRUE Then RETURN 0 fName = MRU$[1] DoOpen(fName) CASE 102 CancelAction = FALSE IsFileChanged() If CancelAction = TRUE Then RETURN 0 fName = MRU$[2] DoOpen(fName) CASE 103 CancelAction = FALSE IsFileChanged() If CancelAction = TRUE Then RETURN 0 fName = MRU$[3] DoOpen(fName) CASE 104 CancelAction = FALSE IsFileChanged() If CancelAction = TRUE Then RETURN 0 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) PopFindDlg(W1.hwnd, "") EndIf CASE 10 ': Todo -> Replace routine If @NotifyCode = 0 InvalidateRect(hToolBar, 0, 0) : UpdateWindow(hToolBar) PopReplaceDlg(W1.hwnd, "", "") 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) GetPathFile(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 12 ': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ': You can't enable/disable native wordwrap function in an edit control ': unless you write an EditWordBreakProc function. <- Todo ': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ If @NotifyCode = 0 If ControlCMD ( WIN,2000, @TBGETBUTTONSTATE, 12 )<>1 buffer = GETCONTROLTEXT WIN, EDIT_1 MODIFYSTYLE WIN, ES_AUTOHSCROLL, 0, EDIT_1 SETCONTROLTEXT WIN, EDIT_1, buffer Else buffer = GETCONTROLTEXT WIN, EDIT_1 MODIFYSTYLE WIN, 0, ES_AUTOHSCROLL, EDIT_1 SETCONTROLTEXT WIN, EDIT_1, buffer EndIf EndIf CASE 13 If @NotifyCode = 0 WorkinProgress() EndIf CASE 14 INT topflag If @NotifyCode = 0 If ControlCMD ( WIN,2000, @TBGETBUTTONSTATE, 14 )<>1 topflag = 0 Else topflag = 1 EndIf WindowOnTop(win.hwnd,topflag) 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 ': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ': Functions ': ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Sub WorkinProgress() MESSAGEBOX(win,"Function not yet implemented","Work in progress",@MB_ICONQUESTION | @MB_OK) RETURN 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 ENDSUB 'いいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいい ' Open file 'いいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいい SUB DoOpen(fName:String) IF fName = "" THEN fName = FileRequest("Open File",WIN,1,Filter$,"txt") MESSAGEBOX(win,fName,"File", 0 | 80) 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() INT fl IF Save_As = 1 THEN fName = FileRequest("Save File",WIN,0,Filter$,"txt",0) if(len(fName) > 0) If IsFileReadOnly(fName, fl) Select fl Case TRUE ChangeFileReadOnly(fName, 0) Case FALSE EndSelect EndIf 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 + 16) SendMessage WIN, EM_SETRECTNP, 0, ERC, EDIT_1 SetSize W1, 0, 0, 52, Height + (h + 16) 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 & find dialog 'いいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいい 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 lpPfr = lParam + 0 ': a few flags one can trap txt = GETCONTROLTEXT WIN, EDIT_1 ': text to search in zt = #lpPfr.lpstrFindWhat + 0 ': text to search for IF (#lpPfr.Flags & FR_DIALOGTERM) = FR_DIALOGTERM THEN Return 0 ': Find dialog is closed IF (#lpPfr.Flags & FR_FINDNEXT) = FR_FINDNEXT ': Find next button is pressed Search() IF pos ': if result CONTROLCMD(WIN, EDIT_1, @EDSETSELECTION, pos - 1, pos + LEN(#zt) - 1) pos = pos + LEN(#zt) ': for next search SendMessage(WIN, EM_SCROLLCARET, 0, 0, EDIT_1) ELSE MESSAGEBOX(win,"No more occurrences !","Find", 0 | 80) ENDIF ELSEIF (#lpPfr.Flags & FR_REPLACE) = FR_REPLACE': replace zu = #lpPfr.lpstrReplaceWith + 0 ': text to replace with IF pos ': if result CONTROLCMD(WIN, EDIT_1, @EDREPLACESEL, #zu) pos = pos + LEN(#zu) ': for next search SendMessage(WIN, EM_SCROLLCARET, 0, 0, EDIT_1) ELSE MESSAGEBOX(win,"No more occurrences !","Replace", 0 | 80) ENDIF ENDIF ENDSELECT RETURN DefSubclassProc(hWnd, uMsg, wParam, lParam) ENDSUB Sub Search() IF (#lpPfr.Flags & FR_DOWN) = FR_DOWN ': search down IF (#lpPfr.Flags & FR_MATCHCASE) = FR_MATCHCASE pos = INSTR(txt, #zt, pos + 1) ELSE pos = INSTR(UCASE$(txt), UCASE$(#zt), pos + 1) ENDIF ENDIF RETURN pos 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) ': This is slower WINRECT ETO SetBkColor(hdcMem, RGB(224,220,224)) ETO.LEFT = 0 : ETO.TOP = 0 : ETO.RIGHT = w : ETO.BOTTOM = h ExtTextOut(hdcMem, 0, 0, ETO_OPAQUE, ETO, "", 0, 0) ': This is faster 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 'いいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいい ' 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.hInstance = NULL fr.Flags = FR_DOWN | FR_HIDEUPDOWN '| FR_WHOLEWORD | FR_MATCHCASE fr.lpstrFindWhat = &searchWhat fr.wFindWhatLen = 255 ': searchWhat capacity FindText(&fr) RETURN 0 EndSub 'いいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいい ' Call up the Replace text dialog 'いいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいい SUB PopReplaceDlg(hwndCaller : INT, sFindText : STRING, sReplaceText : STRING), INT ZeroMemory(&fr, LEN(fr)) searchWhat = sFindText replaceWith = sReplaceText fr.lStructSize = LEN(fr) fr.hWndOwner = hwndCaller fr.hInstance = NULL fr.Flags = FR_DOWN | FR_HIDEUPDOWN '| FR_WHOLEWORD | FR_MATCHCASE fr.lpstrFindWhat = &searchWhat fr.lpstrReplaceWith = &replaceWith fr.wFindWhatLen = 255 ': searchWhat capacity fr.wReplaceWithLen = 255 ': replaceWith capacity ReplaceText(&fr) RETURN 0 EndSub 'いいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいい ' Produce a nice gradient background 'いいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいい Sub Vignette(wn as Window, xaxis as int, yaxis as int, wide as int, high as int, fc as Uint, bc as UInt) ': ': linear vignette from top to bottom, fc to bc ': float col[3],scol[3] int i,j ': ': Split the RGB Colour into its components ': col[0]=fc%256 ':Red col[1]=(fc%65536)/256 ':Green col[2]=fc/65536 ':Blue ': ': Work out the difference between the forecolour and the backcolour ': scol[0]=((bc%256)-col[0])/high ':Red scol[1]=(((bc%65536)/256)-col[1])/high ':Green scol[2]=((bc/65536)-col[2])/high ':Blue ': ': Do the vignette ': For i = 0 to high Line wn,xaxis+i,yaxis+i,0,i,RGB(int(col[0]),int(col[1]),int(col[2])) ': Adjust the base colour ': For j=0 to 2 col[j]+=scol[j] Next j Next i EndSub 'いいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいい ' Remove subclassing, release GDI DC, close windows & terminate program 'いいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいい Sub DoEndProgram() RemoveProp(WIN.hwnd, "TpadIcon") :' Main app icon RemoveWindowSubclass(W1.hwnd, &subclassProc, subclassID) SetWindowLongA(GetControlHandle(W1,EDIT_1),GWL_WNDPROC,ORIG) ReleaseDC (hEdit, Gutter_hDC) DestroyWindow(hToolBar) CLOSEWINDOW W1 CLOSEWINDOW WIN ENDSUB