?
Solved

SetConsoleCursorPosition API Fails

Posted on 2000-01-31
11
Medium Priority
?
1,048 Views
Last Modified: 2012-06-27
Paste the following code in a module and run the code using Main() as the startup object.

Can anyone tell me why the SetConsoleCursorPosition API fails?

Thanks.


Option Explicit
Type COORD
        x As Integer
        y As Integer
End Type
Public Const STD_INPUT_HANDLE = -10&
Public Const STD_OUTPUT_HANDLE = -11&
Public Const STD_ERROR_HANDLE = -12&
Public hStdIn  As Long   ' handle of Standard Input
Public hStdOut As Long   ' handle of Standard Output
Public hStdErr As Long   ' handle of Standard Error Output
Declare Function AllocConsole Lib "kernel32" () As Long
Declare Function FreeConsole Lib "kernel32" () As Long
Declare Function GetStdHandle Lib "kernel32" (ByVal nStdHandle As Long) As Long
Declare Function SetConsoleCursorPosition Lib "kernel32" _
    (ByVal hConsoleOutput As Long, dwCursorPosition As COORD) As Long
Declare Function ReadFile Lib "kernel32" _
    (ByVal hFile As Long, _
    lpBuffer As Any, _
    ByVal nNumberOfBytesToRead As Long, _
    lpNumberOfBytesRead As Long, _
    lpOverlapped As Any) As Long
Declare Function WriteFile Lib "kernel32" _
    (ByVal hFile As Long, _
    ByVal lpBuffer As String, _
    ByVal nNumberOfBytesToWrite As Long, _
    lpNumberOfBytesWritten As Long, _
    lpOverlapped As Any) As Long

Sub Main()
      Dim Lbuf As String
      AllocConsole
      hStdIn = GetStdHandle(STD_INPUT_HANDLE)
      hStdOut = GetStdHandle(STD_OUTPUT_HANDLE)
      hStdErr = GetStdHandle(STD_ERROR_HANDLE)
      if setcpos(5,5) = true then
            cWrite "SetConsoleCursorPosition API Passed!"
      else
            cWrite "SetConsoleCursorPosition API Failed!"
      End If
      cWrite "Press Enter:"
      Lbuf = cRead
      FreeConsole
      End
End Sub
            
Function SetCpos(Row As Integer, Col As Integer) As Boolean
      Dim lInfo As COORD
      lInfo.x = Col
      lInfo.y = Row
      If Not SetConsoleCursorPosition(hStdOut, lInfo) = 0 Then SetCpos = True
End Function

Sub cWrite(lString As String, Optional Binary As Boolean)
    Dim lBytesWritten As Long
    Dim s As String
    s = IIf(Binary = True, lString, lString & vbCrLf)
    WriteFile hStdOut, s, Len(s), lBytesWritten, ByVal 0&
End Sub

Function cRead(Optional BufferSize As Long) As String
    Dim sBuf As String
    Dim BytesRead As Long
    Dim Retcode As Long
    Dim sBufSize As Long
    sBufSize = IIf(BufferSize = 0, 2048, BufferSize)
    sBuf = String(sBufSize, Chr$(0))
    Retcode = ReadFile(hStdIn, ByVal sBuf, sBufSize, BytesRead, ByVal 0&)
    cRead = Left$(sBuf, BytesRead - 2)
End Function
 
0
Comment
Question by:mikieac
11 Comments
 

Author Comment

by:mikieac
ID: 2477621
Adjusted points to 250
0
 

Author Comment

by:mikieac
ID: 2477816
Adjusted points to 350
0
 

Author Comment

by:mikieac
ID: 2477817
I guess this was harder than I thought... Anybody have any ideas?
0
The new generation of project management tools

With monday.com’s project management tool, you can see what everyone on your team is working in a single glance. Its intuitive dashboards are customizable, so you can create systems that work for you.

 
LVL 2

Expert Comment

by:danelroisman
ID: 2478366

Hi!

Function SetCpos(Row As Integer, Col As Integer) As Boolean

'get handle to stdout here!
'!!!!!!!!!!!!!!!!!!!!!!
hStdOut = GetStdHandle(STD_OUTPUT_HANDLE)
'!!!!!!!!!!!!!!!!!!!!!!!

Dim lInfo As COORD
lInfo.x = Col
lInfo.y = Row
If Not SetConsoleCursorPosition(hStdOut, lInfo) = 0 Then SetCpos = True
End Function


Daniel

0
 

Author Comment

by:mikieac
ID: 2479591
Adjusted points to 450
0
 

Author Comment

by:mikieac
ID: 2479592
Sorry, that doesn't work.  hStdOut is a global variable.  Once it gets set in Main(), it doesn't change.

0
 
LVL 14

Accepted Solution

by:
mcrider earned 1800 total points
ID: 2480110
It's not your fault... Blame Microsoft!

The reason the SetConsoleCursorPosition function fails is it is declared incorrectly in the API text viewer.  It is defined like this:

     Declare Function SetConsoleCursorPosition _
          Lib "kernel32" (ByVal hConsoleOutput As Long, _
          dwCursorPosition As COORD) As Long

The problem is, the 2nd argument "dwCursorPosition" must be passed ByVal, not ByRef.  If you don't specify ByVal, ByRef is the default in Visual Basic... HOWEVER... VB will not let you pass a user-defined type ByVal.

This means you have to define the function like this:

     Declare Function SetConsoleCursorPosition _
          Lib "kernel32" (ByVal hConsoleOutput As Long, _
          ByVal dwCursorPosition As Long) As Long

Now, you have to fit the X/Y values that used to be assigned with the COORD type into a Long type.  You can do this by adding this function to your module:

     Function cvtCoordToLng(wHi As Integer, wLo As Integer) As Long
        cvtCoordToLng = (wHi * &H10000) Or (wLo And &HFFFF&)
     End Function


Then when you call the SetConsoleCursorPosition API, you want to do it like this:

     Dim Row As Integer
     Dim Col As Integer
     Dim rVal As Long
     'SET Row and Col to the proper values here
     rVal = SetConsoleCursorPosition(hStdOut, cvtCoordToLng(Row, Col))


Hope this helps!


Cheers!
0
 
LVL 9

Expert Comment

by:Ruchi
ID: 2480123
As I read the MSDN library article about SetConsoleCursorPosition API, it says,"
When a screen buffer's cursor is visible, its appearance can vary, ranging from completely filling a character cell to showing up as a horizontal line at the bottom of the cell. The dwSize member of the CONSOLE_CURSOR_INFO structure specifies the percentage of a character cell that is filled by the cursor. If this member is less than 1 or greater than 100, SetConsoleCursorInfo fails."

Also, you must declare the headers -- Wincon.h and Windows.h in C++ or C or Visual C++. This API may not work with VB, doesn't it?

0
 
LVL 14

Expert Comment

by:mcrider
ID: 2480159
Ruchi & mikieac,

Try the code with the modifications I suggested, and the API will work!


Cheers!
0
 

Author Comment

by:mikieac
ID: 2480584
mcrider, you are amazing!  This works perfectly!!!!!

Thank-you so much.
0
 
LVL 14

Expert Comment

by:mcrider
ID: 2480697
Thanks for the points! Glad I could help!


Cheers!
0

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction While answering a recent question about filtering a custom class collection, I realized that this could be accomplished with very little code by using the ScriptControl (SC) library.  This article will introduce you to the SC library a…
Background What I'm presenting in this article is the result of 2 conditions in my work area: We have a SQL Server production environment but no development or test environment; andWe have an MS Access front end using tables in SQL Server but we a…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
Suggested Courses
Course of the Month3 days, 3 hours left to enroll

600 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question