discussion for a keyword search with upto 3 addtional keywords close to primary keyword
http://powerbasic.com/support/pbforu...d.php?p=279522
http://powerbasic.com/support/pbforu...d.php?p=279522
'txt2wndw.bas 'compiled with pbwin 8.04 'program reads a file then displays the contents in a window #COMPILE EXE #REGISTER NONE #DIM ALL #INCLUDE "Win32Api.Inc" #INCLUDE "COMDLG32.INC" ' Common dialog declares #INCLUDE "PREVIEW.INC" ' Preview dialog include from tutorials in the samples directory %IDC_BUTNOPEN = 120 ' Control id's %IDC_BUTNVIEW = 121 %IDC_BUTNPAGE = 122 %IDC_BUTNFONT = 123 %IDC_BUTNFONT1 = 124 %IDC_BUTNFONT2 = 125 %IDC_BUTNFONT3 = 126 %ListBox = 201 GLOBAL datainthefile() AS STRING GLOBAL largestwidthline AS LONG GLOBAL gifontsize AS DWORD GLOBAL gibuttonfontsize AS DWORD GLOBAL gstext AS STRING GLOBAL glinecount AS LONG GLOBAL gLINESTART AS LONG GLOBAL gcharactercount AS LONG GLOBAL glinestartcharactercount AS LONG GLOBAL hFont,hbuttonfont AS DWORD GLOBAL FONTSIZE AS LONG GLOBAL gifontbold AS LONG GLOBAL ghdlg AS WORD 'FUNCTION DECLARATIONS--------------------------------------------------------------- DECLARE FUNCTION findwidestpart(BYVAL a AS STRING) AS LONG DECLARE FUNCTION GetFile (BYVAL sFile AS STRING) AS STRING DECLARE FUNCTION MakeFontEx (BYVAL FontName AS STRING, _ BYVAL PointSize AS LONG, _ BYVAL fBold AS LONG, _ BYVAL fItalic AS LONG, _ BYVAL fUnderline AS LONG) AS DWORD DECLARE FUNCTION SelectFontProc (BYVAL hDlg AS DWORD, _ BYVAL id AS LONG, _ hFont AS DWORD, _ pd AS PreviewData) AS LONG '---------------------------------------------------------------------------------------- '==================================================================== FUNCTION GetFile (BYVAL sFile AS STRING) AS STRING '-------------------------------------------------------------------- ' Open and return given file's contents as a string '-------------------------------------------------------------------- LOCAL ff AS LONG LOCAL sBuf AS STRING IF LEN(DIR$(sFile)) = 0 THEN MSGBOX "The file does not exist.", %MB_TASKMODAL, "Error" EXIT FUNCTION END IF ff = FREEFILE OPEN sFile FOR BINARY ACCESS READ LOCK SHARED AS ff LEN = 16000 IF ERR THEN ' Always trap ev. errors on file open actions MSGBOX ERROR$(ERR), %MB_TASKMODAL, "Error" RESET : ERRCLEAR : EXIT FUNCTION END IF GET$ ff, LOF(ff), sBuf CLOSE ff FUNCTION = sBuf END FUNCTION FUNCTION findcharactercount() AS LONG LOCAL TEMP1 AS LONG,TEMP2 AS LONG LOCAL I AS QUAD TEMP1=1& TEMP2=1& FOR i=1 TO glinestart temp2=INSTR(TEMP1,GSTEXT,$CRLF) IF glinestart=i THEN gCHARACTERCOUNT=TEMP1 glinestartcharactercount=INSTR(TEMP1,GSTEXT,$CRLF)-1&-gcharactercount EXIT FUNCTION END IF IF i=glinecount THEN EXIT FOR temp1=temp2+1 NEXT i gCHARACTERCOUNT=INSTR(-1,gstext,$CRLF) gCHARACTERCOUNT=INSTR(gcharactercount-1,gstext,$CRLF) glinestartcharactercount=2 END FUNCTION 'FUNCTION EmLineScroll(BYVAL hEdit AS LONG, BYVAL x AS LONG, BYVAL y AS LONG) AS LONG ' FUNCTION = SendMessage(hEdit, %EM_LINESCROLL, x, y) 'END FUNCTION '==================================================================== FUNCTION MakeFontEx (BYVAL FontName AS STRING, _ BYVAL PointSize AS LONG, _ BYVAL fBold AS LONG, _ BYVAL fItalic AS LONG, _ BYVAL fUnderline AS LONG) AS DWORD '-------------------------------------------------------------------- ' Create a desired font and return its handle. '-------------------------------------------------------------------- LOCAL hDC AS DWORD, CharSet AS LONG, CyPixels AS LONG IF gifontbold THEN fbold=700 ELSE fbold=400 hDC = GetDC(%HWND_DESKTOP) CyPixels = GetDeviceCaps(hDC, %LOGPIXELSY) EnumFontFamilies hDC, BYVAL STRPTR(FontName), CODEPTR(EnumCharSet), BYVAL VARPTR(CharSet) ReleaseDC %HWND_DESKTOP, hDC PointSize = 0 - (PointSize * CyPixels) \ 72 FUNCTION = CreateFont(PointSize, 0, _ 'height, width(default=0) 0, 0, _ 'escapement(angle), orientation fBold, _ 'weight (%FW_DONTCARE = 0, %FW_NORMAL = 400, %FW_BOLD = 700) fItalic, _ 'Italic fUnderline, _ 'Underline %FALSE, _ 'StrikeThru CharSet, %OUT_TT_PRECIS, _ %CLIP_DEFAULT_PRECIS, %DEFAULT_QUALITY, _ %FF_DONTCARE , BYCOPY FontName) END FUNCTION '==================================================================== FUNCTION EnumCharSet (elf AS ENUMLOGFONT, ntm AS NEWTEXTMETRIC, _ BYVAL FontType AS LONG, CharSet AS LONG) AS LONG '-------------------------------------------------------------------- ' Get type of character set - ansi, symbol, etc. A must for some fonts.. ' Called from FUNCTION MakeFontEx. '-------------------------------------------------------------------- CharSet = elf.elfLogFont.lfCharSet END FUNCTION '==================================================================== FUNCTION SelectFontProc (BYVAL hDlg AS DWORD, _ BYVAL id AS LONG, _ hFont AS DWORD, _ pd AS PreviewData) AS LONG '-------------------------------------------------------------------- ' Use COMDLG32's Font dialog for font settings '-------------------------------------------------------------------- LOCAL cf AS CHOOSEFONTAPI, lf AS LOGFONT IF hFont THEN GetObject hFont, SIZEOF(lf), lf cf.lStructSize = SIZEOF(CHOOSEFONTAPI) cf.hwndOwner = hDlg cf.lpLogFont = VARPTR(lf) cf.Flags = %CF_BOTH OR %CF_FORCEFONTEXIST OR %CF_INITTOLOGFONTSTRUCT cf.nFontType = %SCREEN_FONTTYPE IF ChooseFont(cf) THEN pd.FontName = lf.lfFaceName pd.FontSize = cf.iPointSize / 10 pd.FontType = IIF&(lf.lfWeight < 500, 0, 1) IF lf.lfItalic THEN pd.FontType = pd.FontType OR 2 IF lf.lfUnderline THEN pd.FontType = pd.FontType OR 4 IF hFont THEN DeleteObject hFont hFont = MakeFontEx (pd.FontName, pd.FontSize, _ lf.lfWeight, lf.lfItalic, lf.lfUnderline) FUNCTION = %TRUE END IF END FUNCTION '______________________________________________________________________________ CALLBACK FUNCTION DlgProc LOCAL h, w, x, y AS LONG LOCAL i AS LONG SELECT CASE AS LONG CBMSG CASE %WM_INITDIALOG ' <- Received right before the dialog is shown '------------------------------------------------------------------ ' The main program is responsible for maintaining a Static or Global ' PreviewData variable and calling InitPreviewDlg before the Print ' Preview dialog in Preview.inc is used. '------------------------------------------------------------------ STATIC pd AS PreviewData ' <- Defined in Preview.inc InitPreviewDlg pd ' <- Located in Preview.inc IF LEN(gsText) THEN CONTROL SET TEXT CBHNDL, %listbox , gsText IF hFont THEN DeleteObject hFont hFont = MakeFontEx("Courier New", gifontsize, 0, 0, 0) IF hFont THEN CONTROL SEND CBHNDL, %Listbox, %WM_SETFONT, hFont, 1 CONTROL SET FOCUS ghdlg, %listbox LISTBOX SELECT ghdlg, %listbox, 4& ' CONTROL SEND ghDlg, %listbox , %Es_readonly, 1&,0& IF gcharactercount THEN IF glinecount>=glinestart THEN CONTROL SEND ghDlg, %listbox , %EM_SETSEL, gcharactercount&, gcharactercount+glinestartcharactercount& CONTROL SEND ghDlg, %listbox , %Es_readonly, 1&,0& IF glinestart<=glinecount THEN CONTROL SEND CBHNDL, %LISTBOX, %EM_LINESCROLL,0, glinestart-10 ELSE CONTROL SEND ghDlg, %listbox , %EM_SETSEL, gcharactercount&, gcharactercount+glinestartcharactercount& CONTROL SEND CBHNDL, %LISTBOX, %EM_LINESCROLL,0, glinecount END IF END IF FUNCTION=1& CASE %WM_DESTROY ' <- Received right before the dialog is destroyed IF hFont THEN DeleteObject hFont CASE %WM_COMMAND '---------------------------------------------------- ' Messages from the controls are handled here. ' Example: Button clicks generates a %BN_CLICKED message ' and menu clicks generates the value 1. '---------------------------------------------------- SELECT CASE AS LONG CBCTL CASE %IDC_BUTNFONT IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN IF SelectFontProc (CBHNDL, %listbox, hFont, pd) THEN CONTROL SEND CBHNDL, %listbox, %WM_SETFONT, hFont, 1 END IF END IF CASE %IDC_BUTNFONT1 IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN IF gifontsize>5 THEN gifontsize=gifontsize-1 IF hFont THEN DeleteObject hFont hFont = MakeFontEx("Courier New", gifontsize, 0, 0, 0) IF hFont THEN CONTROL SEND CBHNDL, %Listbox, %WM_SETFONT, hFont, 1 END IF CASE %IDC_BUTNFONT2 IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN IF gifontsize<72 THEN gifontsize=gifontsize+1 IF hFont THEN DeleteObject hFont hFont = MakeFontEx("Courier New", gifontsize, 0, 0, 0) IF hFont THEN CONTROL SEND CBHNDL, %Listbox, %WM_SETFONT, hFont, 1 END IF CASE %IDC_BUTNFONT3 IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN IF hFont THEN DeleteObject hFont IF gifontbold THEN gifontbold=0& ELSE gifontbold=1& hFont = MakeFontEx("Courier New", gifontsize, 0, 0, 0) IF hFont THEN CONTROL SEND CBHNDL, %Listbox, %WM_SETFONT, hFont, 1 END IF END IF CASE %IDCANCEL ' "Exit" button or the Esc-key was pressed IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN DIALOG END CBHNDL, 0 END IF END SELECT CASE %WM_SIZE ' is sent on resize - auto-size the TextBox IF CBWPARAM <> %SIZE_MINIMIZED THEN ' avoid minimized state w = LO(WORD, CBLPARAM) ' dialog client area's width in pixels h = HI(WORD, CBLPARAM) ' dialog client area's height in pixels DIALOG PIXELS CBHNDL, w, h TO UNITS w, h ' convert to dialog units CONTROL GET LOC CBHNDL, %listbox TO x, y ' we need top pos CONTROL SET SIZE CBHNDL, %listbox, w, h - y ' auto-size.. END IF END SELECT END FUNCTION FUNCTION findwidestpart(BYVAL a AS STRING) AS LONG LOCAL i AS LONG LOCAL j AS LONG LOCAL k AS LONG LOCAL l AS LONG k=0& l=LEN(a) i=1& findagain: j=INSTR(i,a,$CRLF) IF j THEN IF j-i>k THEN k=j-i i=j+2 IF i<l THEN GOTO findagain END IF IF i<l AND l-i>k THEN k=l-i FUNCTION=k END FUNCTION '______________________________________________________________________________ FUNCTION PBMAIN() LOCAL hDlg AS DWORD LOCAL Root AS STRING DIM Datainthefile(0 TO 0) AS STRING LOCAL Filter AS STRING LOCAL FileCount AS DWORD LOCAL filename AS STRING LOCAL I AS DOUBLE LOCAL hfile2 AS LONG LOCAL aa AS STRING LOCAL bb AS STRING LOCAL vscrollbarwidth AS LONG LOCAL vwindowsize AS LONG LOCAL hwindowsize AS LONG LOCAL TEMP1 AS LONG,TEMP2 AS LONG LOCAL COMMANDLINE$ commandline$=" "+TRIM$(COMMAND$)+" " TEMP1=INSTR(UCASE$(commandline$),"/L:") IF TEMP1 THEN TEMP2=INSTR(TEMP1+3,UCASE$(commandline$)," ")-(TEMP1+3) gLINESTART=VAL(MID$(COMMANDLINE$,TEMP1+3,TEMP2)) COMMANDLINE$=REMOVE$(COMMANDLINE$,MID$(COMMANDLINE$,TEMP1,TEMP1+TEMP2+3)) END IF Filename=TRIM$(COMMANDLINE$) gstext=getfile(filename) I=INSTR(gstext,$CRLF+CHR$(26)) IF I THEN gstext=LEFT$(gstext,I+1) ELSE I=INSTR(gstext,CHR$(26)) IF I THEN gstext=LEFT$(gstext,I-1&) END IF IF LEN(gstext)>0& THEN SLEEP 10 largestwidthline=findwidestpart(gstext) glinecount=TALLY(gstext,$CRLF) IF glinestart THEN findcharactercount ELSE gstext="The file is empty or"+$CRLF+"there is no file on "+$CRLF+_ "the command line."+$CRLF+_ "An option to start"+$CRLF+"viewing at a specific"+$CRLF+"line can be added"+$CRLF+_ "using /L:####" END IF gifontbold=1& FONTSIZE=10& gifontsize=fontsize gibuttonfontsize=8 vscrollbarwidth=largestwidthline*((fontsize/2)-2&) vwindowsize=vscrollbarwidth+fontsize IF vwindowsize>400& THEN vwindowsize=400& IF vwindowsize<100 THEN vwindowsize=100& hwindowsize=glinecount*((fontsize/2)+2&) IF hwindowsize>300& THEN hwindowsize=300& IF hwindowsize<100 THEN hwindowsize=100& DIALOG FONT "Courier New",FONTSIZE DIALOG NEW %HWND_DESKTOP, filename, , , vwindowsize, hwindowsize, _ %WS_CAPTION OR %WS_SYSMENU OR _ %WS_MINIMIZEBOX OR %WS_MAXIMIZEBOX OR %WS_THICKFRAME OR %WS_BORDER OR %WS_CLIPSIBLINGS OR %WS_CLIPCHILDREN, 0 TO hDlg SetClassLong hDlg, %GCL_HICON, LoadIcon(BYVAL %NULL, BYVAL %IDI_INFORMATION) ' CONTROL ADD LISTBOX, hDlg, %ListBox, Datainthefile(), 0, 10, vwindowsize, hwindowsize, %LBS_NOTIFY OR _ ' %WS_TABSTOP OR %WS_VSCROLL OR %WS_HSCROLL, %WS_EX_CLIENTEDGE CONTROL ADD TEXTBOX, hDlg, %listbox, "", 0, 10, vwindowsize, hwindowsize, _ %WS_HSCROLL OR %ES_MULTILINE OR %ES_NOHIDESEL OR %ES_WANTRETURN OR _ %WS_VSCROLL , %WS_EX_CLIENTEDGE CONTROL SET COLOR hDlg,%listbox,-1,-1 CONTROL SEND hDlg, %ListBox, %LB_SETHORIZONTALEXTENT, vscrollbarwidth+(fontsize*3&), 0 CONTROL ADD BUTTON, hDlg, %IDC_BUTNFONT, "Font", 1, 1, 18, 8 CONTROL ADD BUTTON, hDlg, %IDC_BUTNFONT1, "font", 21, 1, 18, 8 CONTROL ADD BUTTON, hDlg, %IDC_BUTNFONT2, "FONT", 41, 1, 18, 8 CONTROL ADD BUTTON, hDlg, %IDC_BUTNFONT3, "Bold", 61, 1, 18, 8 CONTROL ADD BUTTON, hDlg, %IDCANCEL, "E&xit", 81, 1, 18, 8 hFont = MakeFontEx("Courier New", 10, 2, 0, 0) IF hFont THEN CONTROL SEND hDlg, %Listbox, %WM_SETFONT, hFont, 1 ' SLEEP 20 END IF hbuttonFont = MakeFontEx("Courier New", gibuttonfontsize, 0, 0, 0) IF hbuttonFont THEN CONTROL SEND hDlg, %Listbox, %WM_SETFONT, hbuttonfont, 1 END IF ghdlg=hdlg DIALOG SHOW MODAL hDlg CALL DlgProc END FUNCTION
We process personal data about users of our site, through the use of cookies and other technologies, to deliver our services, and to analyze site activity. For additional details, refer to our Privacy Policy.
By clicking "I AGREE" below, you agree to our Privacy Policy and our personal data processing and cookie practices as described therein. You also acknowledge that this forum may be hosted outside your country and you consent to the collection, storage, and processing of your data in the country where this forum is hosted.
Comment