Announcement

Collapse
No announcement yet.

Make PB/Win "work" like PB / CC?

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

  • Make PB/Win "work" like PB / CC?

    I am interested in purchasing PB Win 9. I have used V8 but currently use PBCC 8 for most everything. I would like to use one compiler [PBWIN] do everything but have not been able to figure out how to make PBWIN "act" like the console version. i.e. Open a window and "print" 10 lines of text starting in the upper left hand corner of the window. Maybe a close button at the bottom to keep it open until the result can be viewed. Most of my programs lately are simple utility programs that might read from a file and print a result, perform a calculation, print a result, etc and I haven't found a good way to do something like this in the "Windows" version.

    Is there any easy way to do something like this in PBWIN because I would like to upgrade?

    Ray Crumrine

  • #2
    PB/win is a GUI only. AFAIK, you can't get there from here (having PB/win emulate a CC app).

    If you want to just display text, you may be able to get away with just a simple MsgBox. Display what you want in it, click "Ok" to end or go on to other things.
    There are no atheists in a fox hole or the morning of a math test.
    If my flag offends you, I'll help you pack.

    Comment


    • #3
      The easy way is to just use a GRAPHIC window. It's very similar and has many advantages, as well.

      Bob Zale

      Comment


      • #4
        There are a few examples on the forum that show how to use a console window from within PBWin (often for debug messages etc, search for "AllocConsole").

        Here's one. Debug print to console:
        http://www.powerbasic.com/support/pb...34&#post167834

        This shows another alternative - using a Listbox in it's own window to log text from the main program:
        http://www.powerbasic.com/support/pb...7&postcount=19
        Rgds, Dave

        Comment


        • #5
          Open a window and "print" 10 lines of text starting in the upper left hand corner of the window. Maybe a close button at the bottom to keep it open until the result can be viewed.
          Use Listview control as a console. September 13 2003.

          Simple STDOUT for PB/DLL and PB/Win 2-13-04

          Wait for key, click or clock for PB/WIN and PB/CC


          MCM
          Last edited by Michael Mattias; 29 Apr 2009, 08:36 AM.
          Michael Mattias
          Tal Systems (retired)
          Port Washington WI USA
          [email protected]
          http://www.talsystems.com

          Comment


          • #6
            Thanks

            Thanks to all who posted. Since I have access to PBWIN 8 I am going to take a closer look at all of the options posted then I will decide whether to upgrade. Since PBWIN 9 now has a Tab control and the other new pieces, I am very interested. I experimented with building Tab controls a couple of years ago and it was a little clumsy to do.

            Ray Crumrine

            Comment


            • #7
              FireFly Visual Designer + Tab Controls = Easy.
              Paul Squires
              FireFly Visual Designer (for PowerBASIC Windows 10+)
              Version 3 now available.
              http://www.planetsquires.com

              Comment


              • #8
                Originally posted by Paul Squires View Post
                FireFly Visual Designer + Tab Controls = Easy.
                :iagree:
                Real programmers use a magnetized needle and a steady hand

                Comment


                • #9
                  Output To Window Like Console Screen

                  I guess by far the most complicated but coolest way to do it is to just create an ordinary Sdk style window and output text to it the same way we did in DOS gwbasic, Turbo Basic, QuickBasic or whatever. Of course, its considerably more complicated. But, like most things, its not that complicated once you 'get on to it'. In the Windows Api there are a number of text output statements that can be made to work like the old DOS or present Console Compiler 'Print' statement. The ones that immediately come to mind are TextOut(), DrawText(), and DrawTextEx().

                  When I first moved to Windows programming from the DOS world the thing that aggrevated me the most was trying to come up with a simple alternative to the 'Print' statement. My first Windows programming was with an early version of Visual Basic, and all the documentation seemed to concentrate on showing one how to print to a textbox or a listbox or a message box or whatever! But what if one simply wanted to print to a window? That simple thing took me a long time to figure out and aggrevated me to no end! Finally, after searching through several books I found that one could print to a Window in VB by simply doing something like...

                  Form1.Print "Hello, World!"

                  or even...

                  Me.Print "Hello, World!"

                  After quite a bit of time I eventually learned Sdk style programming in C, and with that I learned about TextOut() and all the other windows text printing functions.

                  The reason I'm mentioning all this is that for some reason that's the first thing I always want to do when I attempt to learn a new programming language, i.e., get something output easy to the screen. I think that goes back to how neat personal computers seemed to me when I got my first one back in the 80s. Before that I had some experience using Fortran on mainframes where one punched holes in cards, fed the program to a card reader, and waited anxiously for the clunky line printer to noisily hammer out some output! GWBASIC's Print seemed so neat & immediate and I immediately fell in love with it!

                  When I bought my first PowerBASIC Windows compiler (I think version 6) and discovered I could do SDK style Api coding with it, the first program I did was one where I could output scrollable lines of text to a blank screen. Since I do a lot of technical work crunching numbers, statistics, etc., I developed it into a routine where I'd print to a text file instead of just to a screen with 'Print', then I'd close the text file and read it into a memory buffer through which I could scroll and output the data to the screen. The only difference then between using this technique with the PowerBASIC Windows GUI compilers and a DOS BASIC or even the console compiler is that in your program you need to use file syntax with the print statement, i.e., instead of...

                  Print "Hello, World!"

                  one would use something like...

                  Print #1, "Hello, World!"

                  I abstracted all the complicated GDI (graphics devive interface), scrolling, memory buffer, and window creation code into appropriate more or less boilerplate routines, so that all one needed to do to use it was create a routine of any name such as "Sub MyOutputRoutine()"; and call the routine from either the WinMain() function or within the WM_CREATE processing code. Below is the program that just outputs to a scrollable window 200 lines of text. The input to this program is isolated to this single procedure like so...

                  Code:
                     
                  Sub DoSomethingOrOther()
                    Register i As Long
                    Local fp As Long
                  
                    fp=Freefile
                    Open CurDir$ & "\Work.txt" For Output As #fp
                    For i=0 To 200
                      Print #fp, i, "PowerBASIC Scrolling Demo!"
                    Next i
                    Close #fp
                  End Sub
                  ....and is called from the top of the WM_CREATE message handler...

                  Call DoSomethingOrOther().

                  Here's the 1st version of the program...

                  Code:
                  #Compile Exe
                  #Dim All
                  #Include "Win32api.inc"
                  
                  Type WndEventArgs
                    hIns               As Dword
                    hWnd               As Dword
                    wParam             As Long
                    lParam             As Long
                  End Type
                  
                  Type MyScrollInfo
                    iLastLine          As Long
                    cyChar             As Dword
                    iBegin             As Long
                    iScrollRange       As Long
                    iLinesVisible      As Long
                    lpsi As SCROLLINFO
                  End Type
                  
                  Type MessageHandler
                    wMessage As Long
                    dwFnPtr As Dword
                  End Type
                  
                  Global MsgHdlr() As MessageHandler
                  Declare Function FnPtr(wea As WndEventArgs) As Long
                  
                  
                  Sub DoSomethingOrOther()
                    Register i As Long
                    Local fp As Long
                  
                    fp=Freefile
                    Open CurDir$ & "\Work.txt" For Output As #fp
                    For i=0 To 200
                      Print #fp, i, "PowerBASIC Scrolling Demo!"
                    Next i
                    Close #fp
                  End Sub
                  
                  
                  Function fnWndProc_OnCreate(wea As WndEventArgs) As Long
                    Local ptrMyScrollInfo As MyScrollInfo Ptr
                    Local hMem As Dword Ptr
                    Local ps As PAINTSTRUCT
                    Local tm As TEXTMETRIC
                    Local strLn As String
                    Register i As Long
                    Local hDC As Dword
                    Local iLen As Long
                    Local fp As Long
                  
                    Call DoSomethingOrOther()
                    ptrMyScrollInfo=GlobalAlloc(%GPTR,Sizeof(MyScrollInfo))
                    If ptrMyScrollInfo Then
                       Call SetWindowLong(wea.hWnd,0,ptrMyScrollInfo)
                       fp=Freefile
                       Open CurDir$ & "\Work.txt" For Input As #fp
                       Filescan #fp, Records To @ptrMyScrollInfo.iLastLine
                       hMem=GlobalAlloc(%GPTR,@ptrMyScrollInfo.iLastLine*Sizeof(hMem))
                       Decr @ptrMyScrollInfo.iLastLine
                       Call SetWindowLong(wea.hWnd,4,hMem)
                       For i = 0 To @ptrMyScrollInfo.iLastLine
                         Line Input #fp, strLn
                         iLen=Len(strLn)
                         @hMem[i]=GlobalAlloc(%GPTR,iLen+1)
                         Call CopyMemory(@hMem[i],Strptr(strLn),iLen)
                       Next i
                       Close #fp
                       hDC=GetDC(wea.hWnd)
                       Call GetTextMetrics(hDC,tm)
                       @ptrMyScrollInfo.cyChar=tm.tmHeight
                       Call ReleaseDC(wea.hWnd,hDC)
                       @ptrMyScrollInfo.lpsi.cbSize=SizeOf(@ptrMyScrollInfo.lpsi)
                    Else
                       fnWndProc_OnCreate=-1
                       Exit Function
                    End If
                  
                    fnWndProc_OnCreate=0
                  End Function
                  
                  
                  Function fnWndProc_OnSize(wea As WndEventArgs) As Long
                    Local ptrMyScrollInfo As MyScrollInfo Ptr
                  
                    ptrMyScrollInfo=GetWindowLong(wea.hWnd,0)
                    @ptrMyScrollInfo.iLinesVisible=Fix(HiWrd(wea.lParam)/@ptrMyScrollInfo.cyChar)
                    @[email protected]@ptrMyScrollInfo.iLinesVisible+1
                    @ptrMyScrollInfo.lpsi.fMask=%SIF_ALL
                    @ptrMyScrollInfo.lpsi.nMin=0 : @[email protected]
                    @[email protected]
                    Call SetScrollInfo(wea.hWnd,%SB_VERT,@ptrMyScrollInfo.lpsi,%TRUE)
                  
                    fnWndProc_OnSize=0
                  End Function
                  
                  
                  Function fnWndProc_OnKeyDown(wea As WndEventArgs) As Long
                    Select Case wea.wParam
                      Case %VK_PGUP
                        Call SendMessage(wea.hWnd,%WM_VSCROLL,%SB_PAGEUP,0)
                      Case %VK_UP
                        Call SendMessage(wea.hWnd,%WM_VSCROLL,%SB_LINEUP,0)
                      Case %VK_PGDN
                        Call SendMessage(wea.hWnd,%WM_VSCROLL,%SB_PAGEDOWN,0)
                      Case %VK_DOWN
                        Call SendMessage(wea.hWnd,%WM_VSCROLL,%SB_LINEDOWN,0)
                    End Select
                  
                    fnWndProc_OnKeyDown=0
                  End Function
                  
                  
                  Function fnWndProc_OnVScroll(wea As WndEventArgs) As Long
                    Local ptrMyScrollInfo As MyScrollInfo Ptr
                  
                    ptrMyScrollInfo=GetWindowLong(wea.hWnd,0)
                    Select Case LoWrd(wea.wParam)
                      Case %SB_LINEUP
                        If @ptrMyScrollInfo.iBegin Then
                           Decr @ptrMyScrollInfo.iBegin
                           Call ScrollWindow(wea.hWnd,0,@ptrMyScrollInfo.cyChar,ByVal 0,ByVal 0)
                           @ptrMyScrollInfo.lpsi.fMask=%SIF_POS
                           @[email protected]
                           Call SetScrollInfo(wea.hWnd,%SB_VERT,@ptrMyScrollInfo.lpsi,%TRUE)
                        End If
                      Case %SB_PAGEUP
                        If @[email protected] >= 0 Then
                           @ptrMyScrollInfo.iBegin = @ptrMyScrollInfo.iBegin - @ptrMyScrollInfo.iLinesVisible
                           Call ScrollWindow(wea.hWnd,0,@ptrMyScrollInfo.iLinesVisible*@ptrMyScrollInfo.cyChar,ByVal 0,ByVal 0)
                           @ptrMyScrollInfo.lpsi.fMask=%SIF_POS
                           @[email protected]
                           Call SetScrollInfo(wea.hWnd,%SB_VERT,@ptrMyScrollInfo.lpsi,%TRUE)
                        Else
                           Call ScrollWindow(wea.hWnd,0,@ptrMyScrollInfo.iBegin*@ptrMyScrollInfo.cyChar,ByVal 0,ByVal 0)
                           @ptrMyScrollInfo.iBegin=0
                           @ptrMyScrollInfo.lpsi.fMask=%SIF_POS
                           @[email protected]
                           Call SetScrollInfo(wea.hWnd,%SB_VERT,@ptrMyScrollInfo.lpsi,%TRUE)
                        End If
                      Case %SB_LINEDOWN
                        If @[email protected]<[email protected] Then
                           Incr @ptrMyScrollInfo.iBegin
                           Call ScrollWindow(wea.hWnd,0,[email protected],ByVal 0,ByVal 0)
                           @ptrMyScrollInfo.lpsi.fMask=%SIF_POS
                           @[email protected]
                           Call SetScrollInfo(wea.hWnd,%SB_VERT,@ptrMyScrollInfo.lpsi,%TRUE)
                        End If
                      Case %SB_PAGEDOWN
                        If @[email protected]<[email protected] Then
                           @ptrMyScrollInfo.iBegin = @ptrMyScrollInfo.iBegin + @ptrMyScrollInfo.iLinesVisible
                           Call ScrollWindow(wea.hWnd,0,[email protected]*@ptrMyScrollInfo.cyChar,ByVal 0,ByVal 0)
                           @ptrMyScrollInfo.lpsi.fMask=%SIF_POS
                           @[email protected]
                           Call SetScrollInfo(wea.hWnd,%SB_VERT,@ptrMyScrollInfo.lpsi,%TRUE)
                        End If
                      Case %SB_THUMBTRACK
                        @ptrMyScrollInfo.lpsi.fMask=%SIF_TRACKPOS
                        Call GetScrollInfo(wea.hWnd,%SB_VERT,@ptrMyScrollInfo.lpsi)
                        @[email protected]
                        Call InvalidateRect(wea.hWnd,ByVal 0,%TRUE)
                        @ptrMyScrollInfo.lpsi.fMask=%SIF_POS
                        @[email protected]
                        Call SetScrollInfo(wea.hWnd,%SB_VERT,@ptrMyScrollInfo.lpsi,%TRUE)
                    End Select
                  
                    fnWndProc_OnVScroll=0
                  End Function
                  
                  
                  Function fnWndProc_OnPaint(wea As WndEventArgs) As Long
                    Local iStart As Long, iFinish As Long,iLine As Long
                    Local ptrMyScrollInfo As MyScrollInfo Ptr
                    Local pszStr As Asciiz Ptr
                    Local hMem As Dword Ptr
                    Local ps As PAINTSTRUCT
                    Register i As Dword
                    Local hDC As Dword
                  
                    ptrMyScrollInfo=GetWindowLong(wea.hWnd,0)
                    hMem=GetWindowLong(wea.hWnd,4)
                    hDC=BeginPaint(wea.hWnd,ps)
                    iStart=ps.rcPaint.nTop\@ptrMyScrollInfo.cyChar
                    iFinish=Ceil(ps.rcPaint.nBottom/@ptrMyScrollInfo.cyChar)-1
                    For i=iStart To iFinish
                      [email protected]+i
                      [email protected][iLine]
                      If iLine<[email protected] Then
                         Call TextOut(hDC,0,i*@ptrMyScrollInfo.cyChar,@pszStr,Len(@pszStr))
                      End If
                    Next i
                    Call EndPaint(wea.hWnd,ps)
                  
                    fnWndProc_OnPaint=0
                  End Function
                  
                  
                  Function fnWndProc_OnClose(wea As WndEventArgs) As Long
                    Local ptrMyScrollInfo As MyScrollInfo Ptr
                    Local fp,iLastLine As Long
                    Local pszStr As Asciiz Ptr
                    Local pMem As Dword Ptr
                    Register i As Long
                  
                    ptrMyScrollInfo=GetWindowLong(wea.hWnd,0)
                    pMem=GetWindowLong(wea.hWnd,4)
                    For i=0 To @ptrMyScrollInfo.iLastLine
                      [email protected][i]
                      Call GlobalFree(pszStr)
                    Next i
                    Call GlobalFree(ptrMyScrollInfo) 
                    Call GlobalFree(pMem)
                    Call PostQuitMessage(0)
                  
                    fnWndProc_OnClose=0
                  End Function
                  
                  
                  Function fnWndProc(ByVal hWnd As Dword, ByVal wMsg As Dword, ByVal wParam As Long, ByVal lParam As Long) As Long
                    Local wea As WndEventArgs
                    Register iReturn As Long
                    Register i As Long
                  
                    For i=0 To 5
                      If wMsg=MsgHdlr(i).wMessage Then
                         wea.hWnd=hWnd: wea.wParam=wParam: wea.lParam=lParam
                         Call Dword MsgHdlr(i).dwFnPtr Using FnPtr(wea) To iReturn
                         fnWndProc=iReturn
                         Exit Function
                      End If
                    Next i
                  
                    fnWndProc=DefWindowProc(hWnd,wMsg,wParam,lParam)
                  End Function
                  
                  
                  Sub AttachMessageHandlers()
                    ReDim MsgHdlr(5) As MessageHandler  'Associate Windows Message With Message Handlers
                    MsgHdlr(0).wMessage=%WM_CREATE   :   MsgHdlr(0).dwFnPtr=CodePtr(fnWndProc_OnCreate)
                    MsgHdlr(1).wMessage=%WM_SIZE     :   MsgHdlr(1).dwFnPtr=CodePtr(fnWndProc_OnSize)
                    MsgHdlr(2).wMessage=%WM_KEYDOWN  :   MsgHdlr(2).dwFnPtr=CodePtr(fnWndProc_OnKeyDown)
                    MsgHdlr(3).wMessage=%WM_VSCROLL  :   MsgHdlr(3).dwFnPtr=CodePtr(fnWndProc_OnVScroll)
                    MsgHdlr(4).wMessage=%WM_PAINT    :   MsgHdlr(4).dwFnPtr=CodePtr(fnWndProc_OnPaint)
                    MsgHdlr(5).wMessage=%WM_CLOSE    :   MsgHdlr(5).dwFnPtr=CodePtr(fnWndProc_OnClose)
                  End Sub
                  
                  
                  Function WinMain(ByVal hIns As Long, ByVal hPrev As Long, ByVal lpCmdLn As Asciiz Ptr, ByVal iShow As Long) As Long
                    Local hMainWnd As Dword,dwStyle As Dword
                    Local winclass As WndClassEx
                    Local szAppName As Asciiz*16
                    Local Msg As tagMsg
                  
                    szAppName="Scroll Demo"
                    Call AttachMessageHandlers()
                    winclass.lpszClassName=VarPtr(szAppName)               : winclass.lpfnWndProc=CodePtr(fnWndProc)
                    winclass.cbClsExtra=0                                  : winclass.cbWndExtra=8
                    winclass.cbSize=SizeOf(winclass)                       : winclass.style=%CS_HREDRAW Or %CS_VREDRAW
                    winclass.hInstance=hIns                                : winclass.hIcon=LoadIcon(%NULL,ByVal %IDI_APPLICATION)
                    winclass.hCursor=LoadCursor(%NULL,ByVal %IDC_ARROW)    : winclass.hbrBackground=GetStockObject(%WHITE_BRUSH)
                    winclass.lpszMenuName=%NULL                            : winclass.hIconSm=0
                    Call RegisterClassEx(winclass)
                    dwStyle=%WS_THICKFRAME Or %WS_MINIMIZEBOX Or %WS_VISIBLE Or %WS_VSCROLL Or %WS_SYSMENU
                    hMainWnd=CreateWindowEx(0,szAppName,szAppName,dwStyle,200,100,300,228,%HWND_DESKTOP,0,hIns,ByVal 0)
                    Call ShowWindow(hMainWnd,iShow)
                    Call UpdateWindow(hMainWnd)
                    While GetMessage(Msg,%NULL,0,0)
                      Call TranslateMessage(Msg)
                      Call DispatchMessage(Msg)
                    Wend
                  
                    Function=msg.wParam
                  End Function

                  And here is another version of the program that prints out piles of tabular data. For this program, since the data is tabular, I had to make some changes to GDI stuff so that numbers in columns line up and so forth. I used a CS_OWNDC window style for the window, and changed the font in the device context to a fixed font. Also, some fancy tricks with RSET to get the numbers justified pretty. Anyway, the thing to note about this program is that except for the GDI stuff mentioned above, its virtually identical to the 1st program. The only difference is the single procedure that outputs the data to a text file, in this case a 'PrintVolumes() Sub.

                  If anyone is interested in forestry stuff (I'm a deskbound forester), the tables are volumes of trees by Form Class, tree diameter, and saw log height. The numbers are in board foot volume. A board foot is twelve inches by twelve inches by one inch thick. Diameters are measured at 4.5 foot above ground and logs are sixteen feet each in the Eastern US. Form Class is a number related to tree taper. Anyway, the procedure provides lots of screen output data. Here is that program...

                  Code:
                  #Compile Exe
                  #Dim All
                  #Include "Win32api.inc"
                  
                  
                  Type WndEventArgs
                    hIns               As Dword
                    hWnd               As Dword
                    wParam             As Long
                    lParam             As Long
                  End Type
                  
                  
                  Type MyScrollInfo
                    iLastLine          As Long
                    cyChar             As Dword
                    iBegin             As Long
                    iScrollRange       As Long
                    iLinesVisible      As Long
                    lpsi As SCROLLINFO
                  End Type
                  
                  
                  Type MessageHandler
                    wMessage As Long
                    dwFnPtr As Dword
                  End Type
                  
                  
                  Global MsgHdlr() As MessageHandler
                  Declare Function FnPtr(wea As WndEventArgs) As Long
                  
                  
                  Function BFVolume(dblDbh As Double, dblLogs As Double, iFormClass As Long) As Long
                    Local dblVolume As Double
                  
                    dblVolume = _
                    ( _
                     (1.52968 * (dblLogs) ^ 2 + 9.58615 * (dblLogs) - 13.35212) + _
                     (1.7962 - 0.27465 * (dblLogs) ^ 2 - 2.59995 * (dblLogs)) * dblDbh + _
                     (0.04482 - 0.00961 * (dblLogs) ^ 2 + 0.45997 * (dblLogs)) * dblDbh ^ 2 _
                     ) * _
                    ((iFormClass - 78) * 0.03 + 1)
                  
                    Function=CLng(dblVolume)
                  End Function
                  
                  
                  Sub PrintVolumes()
                    Local strField As String*6
                    Local strLines As String
                    Local dbh As Double
                    Local ht  As Double
                    Register i As Long
                    Local fp As Long
                  
                    Open CurDir$ & "\Work.txt" For Output As #fp
                    For i=75 To 85
                      Print #fp, "       Board Foot Volume By Diameter (Dbh) And Number Of 16 Foot Logs      "
                      Print #fp,
                      Print #fp, "                               Form Class " & Str$(i)
                      Print #fp,
                      Print #fp, "Dbh     1.0     1.5     2.0     2.5     3.0     3.5     4.0     4.5     5.0"
                      Print #fp, "==========================================================================="
                      For dbh=12.0 To 40.0
                        strLines=Trim$(Str$(dbh))+Chr$(34)+"  "
                        For ht=1.0 To 5.0 Step 0.5
                          RSet strField=Str$(BFVolume(dbh,ht,i))
                          strLines=strLines+strField+"  "
                        Next ht
                        Print #fp, strLines
                        strLines=""
                      Next dbh
                      Print #fp, : Print #fp,
                    Next i
                    Close #fp
                  End Sub
                  
                  
                  Function fnWndProc_OnCreate(wea As WndEventArgs) As Long
                    Local ptrMyScrollInfo As MyScrollInfo Ptr
                    Local hDC,dwFont,hTmp As Dword
                    Local hMem As Dword Ptr
                    Local ps As PAINTSTRUCT
                    Local tm As TEXTMETRIC
                    Local strLn As String
                    Register i As Long
                    Local iLen As Long
                    Local fp As Long
                  
                    Call PrintVolumes()
                    ptrMyScrollInfo=GlobalAlloc(%GPTR,Sizeof(MyScrollInfo))
                    If ptrMyScrollInfo Then
                       Call SetWindowLong(wea.hWnd,0,ptrMyScrollInfo)
                       fp=Freefile
                       Open CurDir$ & "\Work.txt" For Input As #fp
                       Filescan #fp, Records To @ptrMyScrollInfo.iLastLine
                       hMem=GlobalAlloc(%GPTR,@ptrMyScrollInfo.iLastLine*Sizeof(hMem))
                       Decr @ptrMyScrollInfo.iLastLine
                       Call SetWindowLong(wea.hWnd,4,hMem)
                       For i = 0 To @ptrMyScrollInfo.iLastLine
                         Line Input #fp, strLn
                         iLen=Len(strLn)
                         @hMem[i]=GlobalAlloc(%GPTR,iLen+1)
                         Call CopyMemory(@hMem[i],Strptr(strLn),iLen)
                       Next i
                       Close #fp
                       hDC=GetDC(wea.hWnd)
                       dwFont=CreateFont(18,0,0,0,%FW_BOLD,0,0,0,%ANSI_CHARSET,%OUT_DEFAULT_PRECIS,%CLIP_DEFAULT_PRECIS,%PROOF_QUALITY,%DEFAULT_PITCH,"Courier New")
                       hTmp=SelectObject(hDC,dwFont)  'Select new font into DC
                       Call SetWindowLong(wea.hWnd,8,hTmp)
                       Call GetTextMetrics(hDC,tm)
                       @ptrMyScrollInfo.cyChar=tm.tmHeight
                       Call ReleaseDC(wea.hWnd,hDC)
                       @ptrMyScrollInfo.lpsi.cbSize=SizeOf(@ptrMyScrollInfo.lpsi)
                    Else
                       fnWndProc_OnCreate=-1
                       Exit Function
                    End If
                  
                    fnWndProc_OnCreate=0
                  End Function
                  
                  
                  Function fnWndProc_OnSize(wea As WndEventArgs) As Long
                    Local ptrMyScrollInfo As MyScrollInfo Ptr
                  
                    ptrMyScrollInfo=GetWindowLong(wea.hWnd,0)
                    @ptrMyScrollInfo.iLinesVisible=Fix(HiWrd(wea.lParam)/@ptrMyScrollInfo.cyChar)
                    @[email protected]@ptrMyScrollInfo.iLinesVisible+1
                    @ptrMyScrollInfo.lpsi.fMask=%SIF_ALL
                    @ptrMyScrollInfo.lpsi.nMin=0 : @[email protected]
                    @[email protected]
                    Call SetScrollInfo(wea.hWnd,%SB_VERT,@ptrMyScrollInfo.lpsi,%TRUE)
                  
                    fnWndProc_OnSize=0
                  End Function
                  
                  
                  Function fnWndProc_OnKeyDown(wea As WndEventArgs) As Long
                    Select Case wea.wParam
                      Case %VK_PGUP
                        Call SendMessage(wea.hWnd,%WM_VSCROLL,%SB_PAGEUP,0)
                      Case %VK_UP
                        Call SendMessage(wea.hWnd,%WM_VSCROLL,%SB_LINEUP,0)
                      Case %VK_PGDN
                        Call SendMessage(wea.hWnd,%WM_VSCROLL,%SB_PAGEDOWN,0)
                      Case %VK_DOWN
                        Call SendMessage(wea.hWnd,%WM_VSCROLL,%SB_LINEDOWN,0)
                    End Select
                  
                    fnWndProc_OnKeyDown=0
                  End Function
                  
                  
                  Function fnWndProc_OnVScroll(wea As WndEventArgs) As Long
                    Local ptrMyScrollInfo As MyScrollInfo Ptr
                  
                    ptrMyScrollInfo=GetWindowLong(wea.hWnd,0)
                    Select Case LoWrd(wea.wParam)
                      Case %SB_LINEUP
                        If @ptrMyScrollInfo.iBegin Then
                           Decr @ptrMyScrollInfo.iBegin
                           Call ScrollWindow(wea.hWnd,0,@ptrMyScrollInfo.cyChar,ByVal 0,ByVal 0)
                           @ptrMyScrollInfo.lpsi.fMask=%SIF_POS
                           @[email protected]
                           Call SetScrollInfo(wea.hWnd,%SB_VERT,@ptrMyScrollInfo.lpsi,%TRUE)
                        End If
                      Case %SB_PAGEUP
                        If @[email protected] >= 0 Then
                           @ptrMyScrollInfo.iBegin = @ptrMyScrollInfo.iBegin - @ptrMyScrollInfo.iLinesVisible
                           Call ScrollWindow(wea.hWnd,0,@ptrMyScrollInfo.iLinesVisible*@ptrMyScrollInfo.cyChar,ByVal 0,ByVal 0)
                           @ptrMyScrollInfo.lpsi.fMask=%SIF_POS
                           @[email protected]
                           Call SetScrollInfo(wea.hWnd,%SB_VERT,@ptrMyScrollInfo.lpsi,%TRUE)
                        Else
                           Call ScrollWindow(wea.hWnd,0,@ptrMyScrollInfo.iBegin*@ptrMyScrollInfo.cyChar,ByVal 0,ByVal 0)
                           @ptrMyScrollInfo.iBegin=0
                           @ptrMyScrollInfo.lpsi.fMask=%SIF_POS
                           @[email protected]
                           Call SetScrollInfo(wea.hWnd,%SB_VERT,@ptrMyScrollInfo.lpsi,%TRUE)
                        End If
                      Case %SB_LINEDOWN
                        If @[email protected]<[email protected] Then
                           Incr @ptrMyScrollInfo.iBegin
                           Call ScrollWindow(wea.hWnd,0,[email protected],ByVal 0,ByVal 0)
                           @ptrMyScrollInfo.lpsi.fMask=%SIF_POS
                           @[email protected]
                           Call SetScrollInfo(wea.hWnd,%SB_VERT,@ptrMyScrollInfo.lpsi,%TRUE)
                        End If
                      Case %SB_PAGEDOWN
                        If @[email protected]<[email protected] Then
                           @ptrMyScrollInfo.iBegin = @ptrMyScrollInfo.iBegin + @ptrMyScrollInfo.iLinesVisible
                           Call ScrollWindow(wea.hWnd,0,[email protected]*@ptrMyScrollInfo.cyChar,ByVal 0,ByVal 0)
                           @ptrMyScrollInfo.lpsi.fMask=%SIF_POS
                           @[email protected]
                           Call SetScrollInfo(wea.hWnd,%SB_VERT,@ptrMyScrollInfo.lpsi,%TRUE)
                        End If
                      Case %SB_THUMBTRACK
                        @ptrMyScrollInfo.lpsi.fMask=%SIF_TRACKPOS
                        Call GetScrollInfo(wea.hWnd,%SB_VERT,@ptrMyScrollInfo.lpsi)
                        @[email protected]
                        Call InvalidateRect(wea.hWnd,ByVal 0,%TRUE)
                        @ptrMyScrollInfo.lpsi.fMask=%SIF_POS
                        @[email protected]
                        Call SetScrollInfo(wea.hWnd,%SB_VERT,@ptrMyScrollInfo.lpsi,%TRUE)
                    End Select
                  
                    fnWndProc_OnVScroll=0
                  End Function
                  
                  
                  Function fnWndProc_OnPaint(wea As WndEventArgs) As Long
                    Local iStart As Long, iFinish As Long,iLine As Long
                    Local ptrMyScrollInfo As MyScrollInfo Ptr
                    Local hDC,hFont,hTmp As Dword
                    Local pszStr As Asciiz Ptr
                    Local hMem As Dword Ptr
                    Local ps As PAINTSTRUCT
                    Register i As Long
                  
                    ptrMyScrollInfo=GetWindowLong(wea.hWnd,0)
                    hMem=GetWindowLong(wea.hWnd,4)
                    hDC=BeginPaint(wea.hWnd,ps)
                    iStart=ps.rcPaint.nTop\@ptrMyScrollInfo.cyChar
                    iFinish=Ceil(ps.rcPaint.nBottom/@ptrMyScrollInfo.cyChar)-1
                    For i=iStart To iFinish
                      [email protected]+i
                      [email protected][iLine]
                      If iLine<[email protected] Then
                         Call TextOut(hDC,0,i*@ptrMyScrollInfo.cyChar,@pszStr,Len(@pszStr))
                      End If
                    Next i
                    Call EndPaint(wea.hWnd,ps)
                  
                    fnWndProc_OnPaint=0
                  End Function
                  
                  
                  Function fnWndProc_OnClose(wea As WndEventArgs) As Long
                    Local ptrMyScrollInfo As MyScrollInfo Ptr
                    Local dwFont,hTmp,hDC As Dword
                    Local fp,iLastLine As Long
                    Local pszStr As Asciiz Ptr
                    Local pMem As Dword Ptr
                    Register i As Long
                  
                    ptrMyScrollInfo=GetWindowLong(wea.hWnd,0)
                    pMem=GetWindowLong(wea.hWnd,4)
                    For i=0 To @ptrMyScrollInfo.iLastLine
                      [email protected][i]
                      Call GlobalFree(pszStr)
                    Next i
                    Call GlobalFree(ptrMyScrollInfo)  
                    Call GlobalFree(pMem)
                    hDC=GetDC(wea.hWnd)
                    hTmp=GetWindowLong(wea.hWnd,8)  'We saved the Device Context we selected out of the
                    dwFont=SelectObject(hDC,hTmp)   'default device context in WM_CREATE, and here we're
                    Call DeleteObject(dwFont)       'retrieving the Font we created so as to properly
                    Call PostQuitMessage(0)         'clean up by deleting it
                  
                    fnWndProc_OnClose=0
                  End Function
                  
                  
                  Function fnWndProc(ByVal hWnd As Dword, ByVal wMsg As Dword, ByVal wParam As Long, ByVal lParam As Long) As Long
                    Local wea As WndEventArgs
                    Register iReturn As Long
                    Register i As Long
                  
                    For i=0 To 5
                      If wMsg=MsgHdlr(i).wMessage Then
                         wea.hWnd=hWnd: wea.wParam=wParam: wea.lParam=lParam
                         Call Dword MsgHdlr(i).dwFnPtr Using FnPtr(wea) To iReturn
                         fnWndProc=iReturn
                         Exit Function
                      End If
                    Next i
                  
                    fnWndProc=DefWindowProc(hWnd,wMsg,wParam,lParam)
                  End Function
                  
                  
                  Sub AttachMessageHandlers()
                    ReDim MsgHdlr(5) As MessageHandler  'Associate Windows Message With Message Handlers
                    MsgHdlr(0).wMessage=%WM_CREATE   :   MsgHdlr(0).dwFnPtr=CodePtr(fnWndProc_OnCreate)
                    MsgHdlr(1).wMessage=%WM_SIZE     :   MsgHdlr(1).dwFnPtr=CodePtr(fnWndProc_OnSize)
                    MsgHdlr(2).wMessage=%WM_KEYDOWN  :   MsgHdlr(2).dwFnPtr=CodePtr(fnWndProc_OnKeyDown)
                    MsgHdlr(3).wMessage=%WM_VSCROLL  :   MsgHdlr(3).dwFnPtr=CodePtr(fnWndProc_OnVScroll)
                    MsgHdlr(4).wMessage=%WM_PAINT    :   MsgHdlr(4).dwFnPtr=CodePtr(fnWndProc_OnPaint)
                    MsgHdlr(5).wMessage=%WM_CLOSE    :   MsgHdlr(5).dwFnPtr=CodePtr(fnWndProc_OnClose)
                  End Sub
                  
                  
                  Function WinMain(ByVal hIns As Long, ByVal hPrev As Long, ByVal lpCmdLn As Asciiz Ptr, ByVal iShow As Long) As Long
                    Local hMainWnd As Dword,dwStyle As Dword
                    Local winclass As WndClassEx
                    Local szAppName As Asciiz*16
                    Local Msg As tagMsg
                  
                    szAppName="Scroll Demo"
                    Call AttachMessageHandlers()
                    winclass.lpszClassName=VarPtr(szAppName)               : winclass.lpfnWndProc=CodePtr(fnWndProc)
                    winclass.cbClsExtra=0                                  : winclass.cbWndExtra=12
                    winclass.cbSize=SizeOf(winclass)                       : winclass.style=%CS_HREDRAW Or %CS_VREDRAW Or %CS_OWNDC
                    winclass.hInstance=hIns                                : winclass.hIcon=LoadIcon(%NULL,ByVal %IDI_APPLICATION)
                    winclass.hCursor=LoadCursor(%NULL,ByVal %IDC_ARROW)    : winclass.hbrBackground=GetStockObject(%WHITE_BRUSH)
                    winclass.lpszMenuName=%NULL                            : winclass.hIconSm=0
                    Call RegisterClassEx(winclass)
                    dwStyle=%WS_THICKFRAME Or %WS_MINIMIZEBOX Or %WS_VISIBLE Or %WS_VSCROLL Or %WS_SYSMENU
                    hMainWnd=CreateWindowEx(0,szAppName,szAppName,dwStyle,200,75,800,665,%HWND_DESKTOP,0,hIns,ByVal 0)
                    Call ShowWindow(hMainWnd,iShow)
                    Call UpdateWindow(hMainWnd)
                    While GetMessage(Msg,%NULL,0,0)
                      Call TranslateMessage(Msg)
                      Call DispatchMessage(Msg)
                    Wend
                  
                    Function=msg.wParam
                  End Function

                  As I said, this is probably considered the hard way of doing things, but for anyone who could see their way clear to using something without understanding how it works, all that would be needed to use a program such as this would be to isolate the statements you want output into one procedure which you could name anything you like, then call that procedure from the fnWndProc_OnCreate() like you see in my code. Also, the initial size of the window is controlled all the way at the bottom of the program in WinMain(). Look for the numbers in the CreateWindowEx() call. This is a program I still find useful when I need to output stuff for easy examination.

                  Oh, bye the way. If you want that 'retro' dos look, there's no problem painting the screen black and the text white or yellow. If you wanted you could even fiddle around with the window styles and get rid of all vestiges of Windows including title bar and scroll bars!
                  Last edited by Fred Harris; 30 Apr 2009, 04:44 PM. Reason: fixed a boo boo!
                  Fred
                  "fharris"+Chr$(64)+"evenlink"+Chr$(46)+"com"

                  Comment


                  • #10
                    Fred I noticed you mentioned stuff like "Forestry"

                    Does that mean you are also into stuff like measuring tree rings and (I guess its called "Metrology" type of things?

                    My background is maybe a bit like yours. (I take what I know, learn what I can, and wonder how what I am learning can be applied to what I know so that I can understand better)

                    Your layout looks a lot like my experience with measuring tree rings etc (not by choice, but one of the devices I have to support is made for that sort of thing) so I wondered if motor-izing, the concept was feasible?

                    For what I know, people that are into measuring tree rings, tend to go from point to point, take a reading, but only know the points from eyeball so maybe not feasible...but just a thought for a bridge of worlds

                    coud be just rambling, but maybe you get what I meant, or could be jibberish
                    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


                    • #11
                      Hi Cliff!

                      At the moment I work pretty much in what might be described as the commercial end of forestry; dealing with timber sales, wood volumes, values, etc. A few years back though I was more into the research end of things, and I did a lot of tree ring analysis. Here is a link to the software I used...

                      http://www.regent.qc.ca/products/dendro/DENDRO.html

                      It was called WinDendro. The picture on the main page gives you a good idea of what it looked like. It was actually pretty neat. We had to prepare increment cores for scanning and analysis. The cores were taken with an instrument known as an increment borer - a fairly low tech sharp piece of sweedish steel - hollow in the center.

                      I always thought there might be money in that sort of highly specialized software. The way the volume licensing worked was as follows. The 1st copy of WinDendro cost $1500.00. The 2nd copy also cost $1500.00. Thereafter each additional copy cost another $1500. We had four copies and to run it one had to put a 'dongle' on the machine.

                      After running the program on each core the program would generate a text file containing the widths of each year's increment. I had a neat little VB program at the time that then stored the data in a database.

                      Dendrochronology is the science that attempts to date things by comparisons of matching tree ring patterns on old pieces of wood...

                      http://en.wikipedia.org/wiki/Dendrochronology
                      Fred
                      "fharris"+Chr$(64)+"evenlink"+Chr$(46)+"com"

                      Comment


                      • #12
                        You can always make a dialog with ddt and just labels (static controls) amd a button with the label(s) set to null, then set the text for the control (like printing to the screen).

                        keep the "ok"/close/end/exit button disabled until the text is printed on the
                        screen, then enable the 'ok' button or whatever text you want on the button
                        that closes (ends) the dialog.

                        Or, just use a message box with the information. The problem with the
                        message box approach, is if it takes a while to process information, then
                        without something else it will appear that the program is not doing anything.
                        Client Writeup for the CPA

                        buffs.proboards2.com

                        Links Page

                        Comment

                        Working...
                        X