A useful PB IDE enhacement - see comments.
Data file - feel free to modify, thanks to Colin Schmidt, Semen Matusovsky and others... If you add some useful snippets, maybe post them here. No error checking - please observe file format while editing.
Save as "PBSnippets.txt".
Code:
'------------------------------------------------------------------------------ ' PBSnippets - an easy way to manage your favorite pieces of code ' ' It's a usual practice that when starting a new program, you look through your existing ' applications, copy pieces of code and paste them to a new one. I do it for years...:-) ' This simple program can help you to manage this task and save a lot of time. Put your ' favorite (often used) code pieces as named blocks to plain text file and then you need ' only 3 mouse clicks to paste them into your program text: ' First start PBSnippets - it runs minimized on the taskbar. Click it (1) - it's ' maximized, find and click (2) the name of your block - program hides again on the ' taskbar, focus returns to your editor and you have to click (3) "paste" to insert ' the whole block of code to the current place of caret. ' BTW, PB Staff: it's a very simple idea, so besides Program Templates, you can embed ' into PB IDE a possibility to write User-defined Code Templates (Tools --> User Code). ' IMHO it can make IDE more user-friendly and powerful. Meanwhile try this small app... ' ' * Required data file see in the next post, its structure - below in the text. ' * Notice that you can launch this app with different files in COMMAND$, by default ' PBSnippets.txt is used. ' PUBLIC DOMAIN - FEEL FREE TO USE, MODIFY AND APPEND DATA FILE ' Alex Art, 12.12.2007 #COMPILE EXE "PBSnippets.exe" '------------------------------------------------------------------------------ #INCLUDE "WIN32API.INC" %IDD_DIALOG1 = 101 %IDC_LISTBOX1 = 1001 %IDC_LABEL1 = 1002 %IDC_BUTTON1 = 1003 '------------------------------------------------------------------------------ GLOBAL Arr$() GLOBAL Count& GLOBAL hFont AS DWORD GLOBAL hFont1 AS DWORD GLOBAL MaxLen& '------------------------------------------------------------------------------ ' ** Declarations ** '------------------------------------------------------------------------------ DECLARE CALLBACK FUNCTION ShowDIALOG1Proc() DECLARE FUNCTION FillListBox(BYVAL hDlg AS DWORD, BYVAL lID AS LONG) AS LONG DECLARE FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG DECLARE FUNCTION ReadDataFile(DatFil AS STRING) AS LONG '------------------------------------------------------------------------------ ' MACROS: '--------------------------------------------------------------------------------- ' A piece of PBForms.inc MACRO FUNCTION PBFormsMakeFont(sFntName, fFntSize, lWeight, lUnderlined, lItalic, lStrike, lCharSet) MACROTEMP lf MACROTEMP hDC MACROTEMP lCyPixels DIM lf AS LOGFONT DIM hDC AS DWORD DIM lCyPixels AS LONG hDC = GetDC(%HWND_DESKTOP) lCyPixels = GetDeviceCaps(hDC, %LOGPIXELSY) ReleaseDC %HWND_DESKTOP, hDC lf.lfHeight = -(fFntSize * lCyPixels) \ 72 lf.lfFaceName = sFntName lf.lfPitchAndFamily = %FF_DONTCARE IF lWeight = %FW_DONTCARE THEN lf.lfWeight = %FW_NORMAL ELSE lf.lfWeight = lWeight END IF lf.lfUnderline = lUnderlined lf.lfItalic = lItalic lf.lfStrikeOut = lStrike lf.lfCharSet = lCharSet END MACRO = CreateFontIndirect(lf) '------- SUBCLASSING MACROS - Colin's Schmidt code ----------------------- ' can be used for any number of controls MACRO SubClass_Set(phDlg, phCtl, pProc) SetWindowLong GetDlgItem(phDlg, phCtl), %GWL_USERDATA, _ SetWindowLong(GetDlgItem(phDlg, phCtl), %GWL_WNDPROC, CODEPTR(pProc)) END MACRO MACRO SubClass_Kill(phCtl) SetWindowLong(GetDlgItem(CBHNDL, phCtl), %GWL_WNDPROC, GetWindowLong(CBHNDL, %GWL_USERDATA)) END MACRO MACRO SubClass_OrgProc FUNCTION = CallWindowProc(GetWindowLong(hWnd, %GWL_USERDATA), hWnd, wMsg, wParam, lParam) END MACRO 'End subclassing '------------------------------------------------------------------------------ FUNCTION PBMAIN() Fil$=TRIM$(COMMAND$) IF Fil$="" THEN ' No command string => Use default data file LOCAL buffer AS ASCIIZ * %MAX_PATH GetModuleFileName %NULL, Buffer, SIZEOF(Buffer) ' Who am I? Fil$=TRIM$(Buffer) ' REPLACE ".exe" WITH ".txt" IN Fil$ ' My default file END IF IF ReadDataFile(Fil$)=0 THEN EXIT FUNCTION ShowDIALOG1 %HWND_DESKTOP END FUNCTION '------------------------------------------------------------------------------ ' Read & parse data file ' Structure: plain text file with block Names in square brackets. You click the ' Name and get corresponding block of code (body) to clipboard ' [Name-1] ' ........ ' body = any your text ' ........ ' [Name-2] ' ........ ' etc.... ' If "body" is empty - the first Name is Section Header - to make navigation ' more easy : ' [Sect.Header] ' [Header-1] ' ........ ' See "PBSnippets.txt" in the next post as an example '------------------------------------------------------------------------------ FUNCTION ReadDataFile (DatFil$) AS LONG IF DIR$(DatFil$)="" THEN FUNCTION=0: EXIT FUNCTION nf&=FREEFILE OPEN DatFil$ FOR BINARY AS #nf& GET$ #nf&,LOF(1),St$ CLOSE #nf& Rec&=PARSECOUNT(St$,"[") REDIM Arr$(1, Rec&) Num&=PARSECOUNT(St$,$CRLF)-1 Count&=0 MaxLen&=0 FOR i&=1 TO Num& a$=PARSE$(St$,$CRLF,i&) IF INSTR(1,a$,"[")<>0 THEN INCR Count& a$=REMOVE$(a$, ANY "[]") Arr$(0,Count&)=a$ : La&=LEN(a$) IF La&>MaxLen& THEN MaxLen&=La& ELSE Arr$(1,Count&)=Arr$(1,Count&)+a$+$CRLF END IF NEXT i& ''''''' Center section headers FOR i&=1 TO Count& IF Arr$(1,i&)="" THEN Zg$=SPACE$(MaxLen&+4) : CSET Zg$=Arr$(0,i&) Arr$(0,i&)=Zg$ END IF NEXT i& FUNCTION=1 END FUNCTION '------------------------------------------------------------------------------ SUB SetClipboard (Txt$) LOCAL lpMem AS ASCIIZ PTR LOCAL hMem AS DWORD Txt$=Txt$+CHR$(0) hMem = GlobalAlloc(%GHND, LEN(Txt$) + 1) lpMem = GlobalLock(hMem) @lpMem = Txt$ GlobalUnlock hMem OpenClipboard 0 EmptyClipboard SetClipboardData %CF_TEXT , hMem CloseClipboard END SUB '------------------------------------------------------------------------------ ' LISTBOX subclassing, based on Borje Hagsten's code '------------------------------------------------------------------------------ FUNCTION ListBoxProc(BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, _ BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG SELECT CASE wMsg CASE %WM_DRAWITEM LOCAL hBrush AS LONG, hBrushOld AS LONG, rct AS RECT LOCAL lpdis AS DRAWITEMSTRUCT PTR, zTxt AS ASCIIZ * 64 lpdis = lParam IF @lpdis.itemID = -1 THEN EXIT FUNCTION It&[email protected]+1 SELECT CASE @lpdis.itemAction CASE %ODA_DRAWENTIRE 'CLEAR BACKGROUND hBrush = CreateSolidBrush(GetSysColor(%COLOR_WINDOW)) 'Create a background brush hBrushOld = SelectObject(@lpdis.hDC, hBrush) 'Select brush into device context CALL FillRect(@lpdis.hDC, @lpdis.rcItem, hBrush) 'Paint background color rectangle CALL SelectObject(@lpdis.hDC, hBrushOld) 'Select old brush back CALL DeleteObject(hBrush) 'Delete brush 'DRAW TEXT IF Arr$(1, It&)="" THEN Fg&=RGB(0,0,220) : Bg&=RGB(255,255,200): Fnt&=hFont1 ELSE Fg&=0 : Bg&=%WHITE : Fnt&=hFont END IF CALL SetBkColor(@lpdis.hDC, Bg&) 'Set text Background CALL SetTextColor(@lpdis.hDC, Fg&) 'Set text color CALL SendMessage(hWnd, %LB_GETTEXT, @lpdis.itemID, VARPTR(zTxt)) 'Get text CALL SelectObject(@lpdis.hDC, Fnt&) 'Select font CALL TextOut(@lpdis.hDC, 2, @lpdis.rcItem.ntop + 2, zTxt, LEN(zTxt)) 'Draw text CASE %ODA_FOCUS CALL DrawFocusRect(@lpdis.hDC, @lpdis.rcItem) 'draw focus rectangle END SELECT END SELECT SubClass_OrgProc END FUNCTION '------------------------------------------------------------------------------ ' ** CallBacks ** '------------------------------------------------------------------------------ CALLBACK FUNCTION ShowDIALOG1Proc() SELECT CASE AS LONG CBMSG CASE %WM_INITDIALOG ' Initialization handler DIALOG SHOW STATE CBHNDL, %SW_MINIMIZE CASE %WM_DESTROY DeleteObject hFont DeleteObject hFont1 SubClass_Kill(%IDC_LISTBOX1) CASE %WM_NCACTIVATE STATIC hWndSaveFocus AS DWORD IF ISFALSE CBWPARAM THEN ' Save control focus hWndSaveFocus = GetFocus() ELSEIF hWndSaveFocus THEN ' Restore control focus SetFocus(hWndSaveFocus) hWndSaveFocus = 0 END IF CASE %WM_COMMAND ' Process control notifications SELECT CASE AS LONG CBCTL CASE %IDC_LISTBOX1 IF CBCTLMSG = %LBN_SELCHANGE OR CBCTLMSG = 1 THEN CONTROL SEND CBHNDL, %IDC_LISTBOX1, %LB_GETCURSEL,0,0 TO Sel& INCR Sel& IF Arr$(1,Sel&)="" THEN EXIT SELECT CALL SetClipboard (Arr$(1,Sel&)) DIALOG SHOW STATE CBHNDL, %SW_MINIMIZE END IF CASE %IDC_BUTTON1 IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN DIALOG END CBHNDL END IF END SELECT CASE %WM_DRAWITEM , %WM_MEASUREITEM ' To make listbox nice looking IF CBWPARAM = %IDC_LISTBOX1 THEN ListBoxProc GetDlgItem(CBHNDL, %IDC_LISTBOX1), CBMSG, CBWPARAM, CBLPARAM FUNCTION = 0: EXIT FUNCTION END IF END SELECT END FUNCTION '------------------------------------------------------------------------------ FUNCTION FillListBox(BYVAL hDlg AS DWORD, BYVAL lID AS LONG) AS LONG FOR i& = 1 TO Count& LISTBOX ADD hDlg, lID, Arr$(0,i&) NEXT i& END FUNCTION '------------------------------------------------------------------------------ FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG LOCAL lRslt AS LONG LOCAL hDlg AS DWORD LOCAL hList AS LONG DIALOG NEW hParent, "PB Snippets", 209,90 , MaxLen&*6+10, 195, %WS_POPUP OR _ ' %WS_CAPTION OR %WS_SYSMENU OR %WS_MINIMIZEBOX OR %WS_VISIBLE OR _ %DS_CENTER OR %DS_3DLOOK, %WS_EX_LEFT OR %WS_EX_RIGHTSCROLLBAR, TO hDlg DIALOG SET COLOR hDlg, -1,RGB(120,120,220) CONTROL ADD LISTBOX, hDlg, %IDC_LISTBOX1, , 3, 2, MaxLen&*6+4, 182, _ %WS_CHILD OR %LBS_OWNERDRAWFIXED OR %LBS_HASSTRINGS OR _ %WS_TABSTOP OR %LBS_DISABLENOSCROLL OR %WS_VSCROLL, %WS_EX_CLIENTEDGE CONTROL ADD LABEL, hDlg, %IDC_LABEL1, "PB Snippets: Click-n-Paste", 10, 184, 145, 10 CONTROL SET COLOR hDlg, %IDC_LABEL1, %WHITE,-2 CONTROL ADD BUTTON, hDlg, %IDC_BUTTON1, "X", MaxLen&*6-5, 184, 12, 10 hFont = PBFormsMakeFont("Courier New", 10, %FW_NORMAL, %FALSE, %FALSE, %FALSE, %DEFAULT_CHARSET) hFont1 = PBFormsMakeFont("Courier New", 10, %FW_BOLD, %FALSE, %FALSE, %FALSE, %DEFAULT_CHARSET) CONTROL SEND hDlg, %IDC_LISTBOX1, %WM_SETFONT, hFont, 0 CONTROL SEND hDlg, %IDC_LABEL1, %WM_SETFONT, hFont1, 0 FillListBox hDlg, %IDC_LISTBOX1 '''' Subclass listbox SubClass_Set(hDlg, %IDC_LISTBOX1, ListBoxProc) DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt FUNCTION = lRslt END FUNCTION '------------------------------------------------------------------------------
Save as "PBSnippets.txt".
Code:
[GENERAL] [FOR:NEXT - 1] FOR i&=1 to Num& ''' Names to edit: i&, Num& NEXT i& [FOR:NEXT - 2] FOR i&=1 to Num1& ''' Names to edit: i&, Num1& FOR j&=1 to Num2& ''' Names to edit: j&, Num2& NEXT j& NEXT i& [FOR:NEXT - 3] FOR i&=1 to Num1& ''' Names to edit: i&, Num1& FOR j&=1 to Num2& ''' Names to edit: j&, Num2& FOR k&=1 to Num3& ''' Names to edit: k&, Num3& NEXT k& NEXT j& NEXT i& [IF:THEN:ELSE] IF THEN ELSE END IF [SELECT:CASE] SELECT CASE CASE CASE CASE ELSE END SELECT [FILE R/W] [File-to-String] ''''' Reading file into string buffer ''' FilNam$="" ''' Delete or write filename nf&=FREEFILE OPEN FilNam$ FOR BINARY AS #nf& GET$ #nf&,LOF(1),Buff$ ''' Name to edit: Buff$ CLOSE #nf& [File-to-String_Array] ''''' Reading file into string Array ''' FilNam$="" ''' Delete or write filename nf&=FREEFILE OPEN FilNam$ FOR BINARY AS #nf& GET$ #nf&,LOF(1),Buff$ CLOSE #nf& Num&=PARSECOUNT(Buff$,$CRLF)-1 ''' Name to edit: Num& REDIM Arr$(1 TO Num&) PARSE Buff$,Arr$(),$CRLF ''' Name to edit: Arr$() Buff$="" ''' Delete if you still need Buff$ [String-to-File] ''''' Print string buffer Buff$ to file''' FilNam$="" ''' Delete or write filename IF DIR$(FilNam$)<>"" then KILL FilNam$ nf&=FREEFILE OPEN FilNam$ FOR BINARY AS #nf& PUT$ #nf&,Buff$ ''' Name to edit: Buff$ CLOSE #nf& [String_Array-to-File] ''''' Print string array Arr$() to file''' FilNam$="" ''' Delete or write filename Buff$=JOIN$(Arr$(),$CRLF) ''' Name to edit: Arr$() IF DIR$(FilNam$)<>"" then KILL FilNam$ nf&=FREEFILE OPEN FilNam$ FOR BINARY AS #nf& PUT$ #nf&,Buff$ CLOSE #nf& Buff$="" ''' Delete if you still need Buff$ [CLIPBOARD] [Text-to-Clipboard] ''''' Write text string Buff$ to clipboard ''' LOCAL lpMem AS ASCIIZ PTR LOCAL hMem AS DWORD Buff$=Buff$+CHR$(0) ''' Name to edit: Buff$ hMem = GlobalAlloc(%GHND, LEN(Buff$) + 1) lpMem = GlobalLock(hMem) @lpMem = Buff$ GlobalUnlock hMem OpenClipboard 0 EmptyClipboard SetClipboardData %CF_TEXT , hMem CloseClipboard [Clipboard-to-Text] ''''' Read clipboard into text string Buff$ ''' LOCAL lpMem AS ASCIIZ PTR OpenClipboard(0) lpMem=GetClipboardData(%CF_TEXT) [email protected] ''' Name to edit: Buff$ CloseClipboard() [Bitmap-to-Clipboard] ''''' Put bitmap (handle: hBMP) to clipboard ''' GLOBAL(LOCAL) hBmp As Dword ''' BMP handle OpenClipboard (0) EmptyClipboard () SetClipboardData(%CF_BITMAP, hBmp) CloseClipboard() [TOOLTIPS] [1.To INCLUDE section] #INCLUDE "COMMCTRL.INC" ''' Delete if already included [2.To GLOBALS section] GLOBAL hToolTips AS DWORD [3.To PBMAIN] CALL InitCommonControls ''' Delete if already called [4.After each CONTROL ADD] ''' Dialog handle, Control ID, Your text for TT CALL SetToolTip (hToolTips, GetDlgItem(hDlg, %IDC_****), "* text *") [5.Main code - paste somewhere] ' Create ToolTips control if needed. FUNCTION ToolTip_Create (lToolTips AS LONG, BYVAL hWnd AS LONG) AS LONG IF lToolTips = 0 THEN IF hWnd = 0 THEN hWnd = GetActiveWindow() IF hWnd = 0 THEN EXIT FUNCTION lToolTips = CreateWindowEx(0, "tooltips_class32", "", %TTS_ALWAYSTIP , _ 0, 0, 0, 0, hWnd, BYVAL 0&, GetModuleHandle(""), BYVAL %NULL) END IF FUNCTION = lToolTips END FUNCTION '''' Set ToolTip FUNCTION SetToolTip (lToolTips AS LONG, BYVAL hWnd AS LONG, BYVAL txt AS STRING) AS LONG LOCAL ti AS TOOLINFO LOCAL St AS ASCIIZ*20 IF ToolTip_Create(lToolTips, GetParent(hWnd)) = 0 THEN EXIT FUNCTION 'ensure creation ti.cbSize = LEN(ti) ti.uFlags = %TTF_SUBCLASS OR %TTF_IDISHWND ti.hWnd = GetParent(hWnd) ti.uId = hWnd 'Remove existing tooltip IF SendMessage (lToolTips, %TTM_GETTOOLINFO, 0, BYVAL VARPTR(ti)) THEN SendMessage lToolTips, %TTM_DELTOOL, 0, BYVAL VARPTR(ti) END IF ti.cbSize = LEN(ti) ti.uFlags = %TTF_SUBCLASS OR %TTF_IDISHWND ti.hWnd = GetParent(hWnd) ti.uId = hWnd ti.lpszText = STRPTR(txt) FUNCTION = SendMessage(lToolTips, %TTM_ADDTOOL, 0, BYVAL VARPTR(ti)) 'add tooltip END FUNCTION [SUBCLASSING] [1.Add before any your code] '------- SUBCLASSING MACROS: can be used for any number of controls ----------------- MACRO SubClass_Set(phDlg, phCtl, pProc) SetWindowLong GetDlgItem(phDlg, phCtl), %GWL_USERDATA, _ SetWindowLong(GetDlgItem(phDlg, phCtl), %GWL_WNDPROC, CODEPTR(pProc)) END MACRO MACRO SubClass_Kill(phCtl) SetWindowLong(GetDlgItem(CBHNDL, phCtl), %GWL_WNDPROC, GetWindowLong(CBHNDL, %GWL_USERDATA)) END MACRO MACRO SubClass_OrgProc FUNCTION = CallWindowProc(GetWindowLong(hWnd, %GWL_USERDATA), hWnd, wMsg, wParam, lParam) END MACRO 'End subclassing [2.To %WM_DESTROY of main callback] ''' Remove subclass SubClass_Kill(%IDC_****) ''' Control ID here [3.After your CONTROL ADD] ''' (Dialog handle, Control ID, Name of you callback proc) SubClass_Set(hDlg, %IDC_****, ****CBProc) [4.Skeleton of your callback proc] '''' Callback procedure - change name, edit message IDs, write your code FUNCTION ****CBProc(BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, _ BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG SELECT CASE wMsg CASE %WM_ ''' Message ''' Your code CASE %WM_ END SELECT SubClass_OrgProc END FUNCTION