Announcement

Collapse
No announcement yet.

change the font in my edit field

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • change the font in my edit field

    How do I change the font in my edit field

    I am using PowerBASIC Forms to create the window and edit field.

    PBFormsRichEdit

    IDCRichEdit

    Brian
    Brian Heibert
    [email protected]
    http://www.heibertsoftware.com
    http://www.winvocalassist.com
    http://www.heibert.net

  • #2
    Originally posted by Brian Heibert View Post
    How do I change the font in my edit field
    If you are using PBForms, it's in the Properties of the control (double-click or right-click on the control in PBForms). If you want to do it in your own code, for example because you want to change it more than once, use CONTROL SET FONT.

    If you mean "how do I create a font", then you will need a function to do it. PBForms has one, try changing a font in the control's PBFORMS properties, then use view.show DDT code and look at the ShowDialog function for the dialog which contains the control in question. Alternatively, there are plenty in code examples in this forum. Remembering that any fonts which you make also have to be deleted, often done in the WM_DESTROY handler when closing a window.

    Comment


    • #3
      Looks like you're using a RichEdit control?

      RichEdit controls work with RTF rich-text format text (and possibly graphics).
      Colours and fonts are set by "control word" commands - ie a kind of Markup.
      Save an RTF doc created in WordPad and then open it in NotePad to see how it looks.

      The last post in this thread links to a web page put together by Shannon which
      examines how Rich Text works in a very practical way.
      http://www.powerbasic.com/support/pb...ad.php?t=19938

      Usefull search keywords for forum discussions of RichEdit methods: EM_STREAMOUT and EM_STREAMIN

      There are examples of using EM_SETCHARFORMAT to adjust RichEdit text in Borje's RichEdit Demo:
      http://www.powerbasic.com/support/pb...ad.php?t=23537

      Do yoursellf a big favour and get POFFS offline search engine for PB Forums - download here: http://www.reonis.com/POFFS/index.htm
      Rgds, Dave

      Comment


      • #4
        Originally posted by Dave Biggs View Post
        Looks like you're using a RichEdit control?
        Richedit also responds to the same method used for Edit and various other controls:

        Code:
        sendmessage <window handle>, %WM_SETFONT, <fonthandle>, 0
        Last edited by Chris Holbrook; 28 Feb 2008, 03:06 PM. Reason: all thumbs

        Comment


        • #5
          I was hoping that would be brought up.

          Streamin Streamout is one way, but somewhere I spotted you could just set text?

          Only reason I ask is that I have an app based on it that constantly changes the text that if in a exe and I close, no problem, but if in a dll I get a crash of some sort and trying to track down if its because of a pointer that is no longer valid?

          My only other problem (probably best for a different thread question) is that I streamin streamout RTF codes that involve an image (copied straight from Notepad) and works in Wordpad, but not in RichEdit?

          Sorry if I hijacked a moment, but I can ask elsewhere, just thought I would bring it up just in case
          Engineer's Motto: If it aint broke take it apart and fix it

          "If at 1st you don't succeed... call it version 1.0"

          "Half of Programming is coding"....."The other 90% is DEBUGGING"

          "Document my code????" .... "WHYYY??? do you think they call it CODE? "

          Comment


          • #6
            Thanks
            I changed the font in PowerBASIC Forms

            In the Font area

            Brian
            Brian Heibert
            [email protected]
            http://www.heibertsoftware.com
            http://www.winvocalassist.com
            http://www.heibert.net

            Comment


            • #7
              I though that you meant you wanted to Change the font in your edit control. (During execution)
              Here's some code which shows how that can be done anyway.
              Code:
              #Dim All
              #Include "WIN32API.INC"
              #Include "RICHEDIT.INC"
              '------------------/
              %RE_TEST     = 101
              %BTN_Test    = 102
              %BTN_Test2   = 103
              %BTN_Test3   = 104
              '------------------/
               
              Sub SetRfColor(ByVal hEdit As Dword, ByVal fontcolor As Long)    'TT Borje
               Local cf As CHARFORMAT
                cf.cbsize      = Len(cf)
                cf.dwmask      = %cfm_color
                cf.crtextcolor = fontcolor
               
                SendMessage(hEdit, %em_setcharformat, %scf_word Or %scf_selection, VarPtr(cf))
               
              End Sub
              '------------------/SetRfColor
               
              Function MakeFont(ByVal FFont As String, ByVal PointSize As Long) As Long
               Local hDC      As Long
               Local CyPixels As Long
                hDC = GetDC(%HWND_DESKTOP)
                  CyPixels  = GetDeviceCaps(hDC, %LOGPIXELSY)
                ReleaseDC %HWND_DESKTOP, hDC
                  PointSize = (PointSize * CyPixels) \ 72
               Function = CreateFont(0 - PointSize, 0, 0, 0, %FW_NORMAL, 0, 0, 0, _
                          %ANSI_CHARSET, %OUT_TT_PRECIS, %CLIP_DEFAULT_PRECIS, _
                          %DEFAULT_QUALITY, %FF_DONTCARE, ByCopy FFont)
              End Function
              '------------------/MakeFont
               
              Sub Control_Set_Font(ByVal hControl As Dword) ' DDT lacks "Control Set Font"
               Local hLogFont As Dword
               
                hLogFont = MakeFont("Courier New Bold",12)
                'hLogFont = GetStockObject(%SYSTEM_FIXED_FONT)
                'hLogFont = MakeFont("System_Fixed_Font Bold",9)
                SendMessage (hControl, %WM_SETFONT, hLogFont, 0)
               
               DeleteObject hLogFont    
              End Sub
              '------------------/Control_Set_Font
               
              CallBack Function DlgProc()
                Select Case As Long CbMsg
                  Case %WM_COMMAND
                    Select Case As Long CbCtl
                      Case %BTN_Test                        ' fill label manuallly - could use %EM_STREAMIN here
                        If CbCtlMsg = %BN_CLICKED Then
                          Local RE_Header, RE_Text As String
                          RE_Header = _                                               ' RT header starts with {
                            "{"+ _                                                    ' <- Opening brace  **
                            "\rtf1\ansi\ansicpg1252\deff0\deflang1033"+ _             ' Version and Char set
                            "{\fonttbl"+ _                                            ' Font table
                            "{\f0\fswiss\fprq2\fcharset0 Microsoft Sans Serif;}"+ _   ' \f0 = default/initial font
                            "{\f1\fswiss\fprq2\fcharset0 Arial;}"+ _
                            "{\f2\fnil\fprq2\fcharset2 Wingdings;}}"+ _
                            "{\colortbl"+ _                                           ' Colour table
                            "\red0\green0\blue0;"+ _                                  ' black  \cf0
                            "\red255\green0\blue0;"+ _                                ' red    \cf1
                            "\red0\green0\blue255;}"                                  ' blue   \cf2
               
                          RE_Text =  _                                                ' marked up text
                            "\fs18 "+ _                                               ' fs18 = use 9 point text
                            "You \i \b could \b0 \i0 use WM_SETFONT to set the font for a richedit control. \line "+ _
                            "\b Or even 'CONTROL_SET_FONT'.  \b0 "+ _                 ' \b BOLD \b0
                            "\fs22 \f2 J "+ _                                         ' \f2 font: "Wingdings" J = :)
                            "\fs18 \f0 \line "+ _                                     ' \f0 font: "MS Sans Serif"
                            "You can set the font at design time (easily when using PBForms!), \line "+ _
                            "but if you want to have varied fonts \i within \i0  the control, "+ _
                            "you \b can \b0 with a richedit control - by using other methods. \line \line "+ _
                            "\fs22 \f1 "+ _                                           ' \f1 font: "Arial"
                            "Of course a richedit control can have not only different "+ _
                            "fonts but \cf1 colours \cf0 \cf2 too \cf0! "+ _
                            "\fs24 \f2 J \Line \Line"+ _                              ' \f2 font: "Wingdings" J = :)
                            "\fs18 \f0"+ _                                            ' \f0 font: "MS Sans Serif"
                            "In this sample, the initial text of the RE control is replaced at run time \line "+ _
                            "with text that was prepared with markup codes at design time. \Line \line "+ _"
                            "At runtime text is (usually) changed using EM_STREAMIN with alternative \line "+ _"
                            "strings written into the source code or loaded from an external file. \Line "+ _
                            "EM_SETCHARFORMAT can also be used to change formats. \line "+ _
                            " - Select some text and click Sel2Red for example."+ _
                            "}"                                                       ' <- Closing brace  **
               
                          RE_Text = RE_Header + RE_Text                         ' Add RT Header to marked up text
               
                          Control Set Text CbHndl, %RE_TEST, RE_Text            ' RichEdit SET TEXT
                          Control Add Button, CbHndl, %BTN_Test3, "Sel2Red", 150, 100, 50, 15,
                          Dialog ReDraw CbHndl                                  ' Paint scroll bar properly
                        End If
               
                      Case %BTN_Test2
                        If CbCtlMsg = %BN_CLICKED Then
                          CONTROL_SET_FONT (GetDlgItem(CbHndl, %RE_Test))
                        End If
               
                      Case %BTN_Test3
                        If CbCtlMsg = %BN_CLICKED Then
                          Local szSel As Asciiz * 256
                          Local LenSel As Long
                            szSel = Space$(255) & Chr$(0)                       ' Prepare buffer for selected text
                            LenSel = SendMessage( GetDlgItem(CbHndl, %RE_Test),%EM_GETSELTEXT, 0, ByVal VarPtr(szSel))
                            If LenSel < 1 Then Exit Function
                          SetRfColor (GetDlgItem(CbHndl, %RE_Test), %Red)
                        End If
               
                      Case %RE_Test
                        If CbCtlMsg = %EN_SETFOCUS Then
                          Control Send CbHndl, %RE_Test, %EM_SETSEL, -1, 0      ' Prevent highlight on entry
                        End If
               
                    End Select
                End Select
              End Function
              '------------------/DlgProc
               
              Function PBMain()
               Local hDlg As Dword 
               Local sInitialText As String 
                LoadLibrary "RICHED32.DLL"
               
                sInitialText = "RE control pre-loaded with this text when created"
               
                Dialog New 0, "RichEdit fonts etc", 100, 100, 300, 120, %WS_CAPTION Or %WS_SYSMENU, To hDlg
                Control Add Button, hDlg, %BTN_Test, "New Text", 85, 100, 50, 15
                Control Add Button, hDlg, %BTN_Test2, "WM_SETFONT", 15, 100, 55, 15,
                Control Add "RichEdit", hDlg, %RE_Test, sInitialText, 10, 5, 280, 90, %WS_CHILD Or %WS_VISIBLE _
                  Or %ES_MULTILINE Or %WS_VSCROLL Or %ES_AUTOVSCROLL Or %WS_TABSTOP
                Control Send hDlg, %RE_Test, %EM_SETBKGNDCOLOR, 0, GetSysColor(%COLOR_BTNFACE)  ' Adjust appearance
               
                Dialog Show Modal hDlg, Call DlgProc
              End Function
              '------------------/PbMain
              (Richedit controls have quite a few features that ordinary Text/Edit boxes don't have which can make
              them a bit 'tricky' to work with).

              Borge's "About Box" shows how to Stream data from an RTF file (eg prepared in WordPad) which has been
              compiled in the resource file.
              By using COM, the program can handle images in the RTF too:
              http://www.reonis.com/POFFS/aboutbox.zip
              Rgds, Dave

              Comment


              • #8
                i use the makefont function as above.
                but i use a different command as below
                CONTROL SEND hdLG,%IDC_TEXTBOX1,%WM_SETFONT,glhgtfont,%TRUE
                it must do the same thing as the sendmessage command above.

                as i have been learning gui i have been creating small programs.
                i have found it useful to create a global variables for my fonts.

                i have a variable set to a medium font size, like glfontsize=10&
                i can do two things using this variable, one to accomplish setting the size of fonts in my dialog and controls and the other, to change my fontsize by the users choices.

                i am sure half that code came from the forum, or at least i used code as a starter.
                i wanted to do other things with this program, like make a button for a transparency setting, but was still playing around with fonts and i have not used the program on smaller display monitors.
                it would be really nice also to have a search routine that wraps from bottom to the top after a search has been completed.



                this is a new program and not quite polished yet.
                i have been using it and have not even distributed the program to my users yet.
                it is a simple text viewer with no other functions, no print, no select file, that is the way i wanted it.

                the program retrieves a file named list.prn in the root directory if no file is placed on the command line.
                so you might want to remove that code before compiling, i had been using it as a test file while programming.

                i wanted something for myself and employees that have aging eyes.
                the default font is courier because we look at formated columns at our work a lot.


                Code:
                '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 gstextundo() AS STRING
                
                
                GLOBAL hFont,hbuttonfont AS DWORD
                GLOBAL FONTSIZE AS LONG
                GLOBAL gifontbold AS LONG
                
                
                '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 = 8192
                      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 linesinthefile(file AS STRING) AS LONG
                   LOCAL filename AS STRING
                   LOCAL filecount AS LONG
                   LOCAL linecount AS LONG
                   LOCAL hfile1 AS INTEGER
                   LOCAL I AS LONG
                   LOCAL junk AS STRING
                
                   filecount=0&
                   linecount=-1&
                
                   FileName = DIR$(file, 7) '%System OR %ReadOnly OR %Hidden )
                   DO
                   IF LEN(FileName) THEN
                     IF (GETATTR(FileName) AND %SUBDIR) THEN  'It's a subfolder
                         EXIT FUNCTION
                       ELSE
                         linecount=0&
                     END IF
                     INCR FILECOUNT
                     FileName = DIR$ 'Get next file or folder
                   END IF
                   LOOP WHILE LEN(Filename) 'Loop if something found
                   DIR$ CLOSE
                
                   hfile1=FREEFILE
                   IF filecount=1& THEN
                
                    OPEN file FOR INPUT ACCESS READ LOCK SHARED AS hfile1
                     WHILE ISFALSE EOF(1)
                        LINE INPUT #1, junk
                        IF LEN(junk)>largestwidthline THEN largestwidthline=LEN(junk)
                       INCR linecount
                       IF linecount MOD 10000& =0& THEN SLEEP 10
                    WEND
                    CLOSE #1
                  '     FILESCAN #hfile1, RECORDS TO linecount, WIDTH TO largestwidthline
                  '  REDIM Datainthefile(0 TO linecount) 'global as string
                  '
                  '   LINE INPUT #1, datainthefile() TO linecount
                    IF linecount&>0& THEN
                      OPEN file FOR INPUT ACCESS READ LOCK SHARED AS hfile1
                      REDIM datainthefile(0 TO (LINECOUNT-1&))
                        FOR i=0& TO linecount
                        LINE INPUT #1, datainthefile(i)
                         IF i MOD 10000& =0&THEN SLEEP 10
                      NEXT i
                    CLOSE #1
                    END IF
                  END IF
                FUNCTION=linecount
                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
                
                      '------------------------------------------------------------------
                      ' Create and set an initial fixed-width font in the TextBox.
                      '------------------------------------------------------------------
                
                     ' msgbox "start"
                      ' gstext=""
                      ' FOR i=lbound(datainthefile)  to ubound(datainthefile)
                      ' gstext=gstext+Datainthefile(I)+$crlf
                      ' NEXT I
                     ' msgbox "end"
                       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
                  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_BUTNOPEN  ' "Open" button was clicked
                   '       IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
                   '           sText = OpenFileProc(CBHNDL)
                   '           IF LEN(sText) THEN
                   '               CONTROL SET TEXT CBHNDL, %IDC_TEXTBOX1, sText
                   '           END IF
                   '       END IF
                   '
                   '   CASE %IDC_BUTNVIEW  ' "Preview" button was clicked
                   '       IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
                   '           ' Grab TextBox contents, dialog title and show Print Preview
                   '           CONTROL GET TEXT CBHNDL, %IDC_TEXTBOX1 TO sText
                   '           DIALOG GET TEXT CBHNDL TO sTitle
                   '           DlgPreview CBHNDL, sTitle, sText, pd
                   '      END IF
                
                   '   CASE %IDC_BUTNPAGE
                   '       IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
                   '           PageSetupDlgProc CBHNDL, pd
                   '       END IF
                   '
                
                      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 linecount   AS LONG
                 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
                REDIM gstextundo(0 TO 3)
                
                Filename=TRIM$(COMMAND$)
                IF LEN(filename)=0& THEN filename="C:\list.prn" 'for testing purposes
                'linecount = linesinthefile(filename)
                'MSGBOX STR$(LINECOUNT)
                gstext=getfile(filename)
                'msgbox str$(ubound(datainthefile() ))
                'gstext=JOIN$(datainthefile(),$CRLF)
                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)
                     linecount=TALLY(gstext,$CRLF)+1&
                     FOR i=0 TO 3
                     gstextundo(i)=gstext
                     SLEEP 5
                     NEXT i
                     ELSE
                     gstext="the file is empty"+$CRLF+"or there is no file"
                END IF
                
                'IF linecount<0& THEN
                '    IF filename="" THEN
                '      MSGBOX "filename needed, place a filename on the command line",," "
                '      ELSE
                '      MSGBOX filename+" does not exist",," "
                '    END IF
                '    EXIT FUNCTION
                'END IF
                
                
                ' FOR i=0 TO linecount-1&
                '  IF LEN(Datainthefile(i))=0& THEN Datainthefile(I)=" "  'an array passed to a listbox cannot have a empty cell(subscript)
                ' ' IF LEN(Datainthefile(i))>largestwidthline THEN largestwidthline=LEN(datainthefile(i))
                '  NEXT I
                
                gifontbold=1&
                FONTSIZE=10&
                gifontsize=fontsize
                gibuttonfontsize=8
                vscrollbarwidth=largestwidthline*(fontsize-2&)
                vwindowsize=vscrollbarwidth+fontsize
                IF vwindowsize>550& THEN vwindowsize=550&
                IF vwindowsize<100 THEN vwindowsize=100&
                hwindowsize=linecount*(fontsize+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_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
                 DIALOG SHOW MODAL hDlg CALL DlgProc
                
                END FUNCTION
                Last edited by Paul Purvis; 1 Mar 2008, 06:06 AM.
                p purvis

                Comment


                • #9
                  altered code
                  txt2wndw
                  Code:
                  '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
                  p purvis

                  Comment


                  • #10
                    Thanks for the heads up. The full path to the preview.inc on this machine:
                    Code:
                    #INCLUDE "c:\pbwin80\samples\ddt\graphic\textview\PREVIEW.INC" '
                    CMD shortcut to open any location:
                    %windir%\system32\cmd.exe /k " cd\ & x: & cd x:\xxxx
                    Change to run as administrator
                    How long is an idea? Write it down.

                    Comment

                    Working...
                    X