com support in new .995

[mhwlng]

Hi Ben,

as requested, I moved the COM/OCX discussion over here...

setting a string method works ok
ROTLABEL.Caption:=BSTR(1234)

but I still have problems with numerical values :

could you please add support for the other visual basic standard variable types :


COM VB
VT_CY Currency 8 bytes -922,337,203,685,477.5808 to 922,337,203,685,477.5807
VT_BOOL Boolean 2 bytes True or False
VT_I2 Integer 2 bytes -32,768 to 32,767
VT_R4 Single 4 bytes -3.402823E38 to -1.401298E-45 for negative values; 1.401298E-45 to 3.402823E38 for positive values
VT_UI4/VT_I4 Long 4 bytes -2,147,483,648 to 2,147,483,647
VT_R8 Double 8 bytes
VT_UI1 Byte 1 byte 0 to 255
VT_DATE Date 8 bytes January 1, 100 to December 31, 9999

and of course, these are also COM variable types that don't match a VB variable type :

VT_I1
VT_UI2
VT_UI4
VT_INT
VT_UINT

(for example visual basic uses Currency type for font size)

Marcel

[mhwlng]

see attached picture

the 45 degree text on top of the album cover is a (admittedly not very useful :D ) test active-x control written in visual basic (well, I just downloaded it off the internet, really :D )

I added this vb code to set the caption to the currently playing artist :


Dim inrns As INetRemoteNameSpace
Set inrns = New NetRemoteLibrary.CoNetRemote
m_Caption = inrns.GetValue("MP.Artist")
Set inrns = Nothing

now, what is the best way to keep the text updated ?

Do I simply set up a timer and call above every couple 100ms or can I do something clever with your 'registercallback' function ? If so, can you explain how it works ?


Marcel

[mhwlng]

I changed my test visual basic ocx to use GDI+ instead of GDI

See attached picture.

Looks quite nice, with anti-aliasing enabled and simple drop shadow(just draw the same text in black with a small offset)

The only thing that is not working in this vb ocx is alpha-blending, so a semi-transparent drop shadow is not possible (On vb, a simple mask with a 'magic colour' (I use pink, RGB (FF,00,FF)) is used to determine which parts of the ocx are transparent.......)

Other than that, GDI+ also allows gradient fills, bitmaps as fills etc..
I am still playing with it (I haven't used GDI+ before :D )

Note that GDI+ is built into XP (which I use)

You can download it for other win32 os's here :

http://www.microsoft.com/downloads/release.asp?releaseid=32738
Marcel

[Ben S]

Nice work!

I've added the types you've requested (And will have a new nrbasic plugin for you shortly).

The best way to keep the text updated is to use the callback. In doing some reading I see that I am imposing my Java/C++ paradigm to COM. I should most likely be using "event sink"s on the INetRemoteVariable object.

For now, you should be able to create your own object which implements INetRemoteVariableCallbackObject, and then pass that to INetRemoteNameSpace's RegisterCallback method.

NetRemote should then call your VariableChanged method whenever the variable changes.

Note that I am having some trouble doing this in C#. It seems to bomb when NetRemote tries to call my c# app's VariableChanged method.

----

Do you want to create the "Marquee" com object? All I want is something that will scroll text nicely for times when the text won't completely fit in the bounds. I'll end up doing this at some point unless someone else decides to do it.

[mhwlng]

Do you want to create the "Marquee" com object?

Wel... the stuff that I am doing uses visual basic on win32.....
I assume that the majority of NR users use the PPC version ?
So any work I might do, would not be of use to them and you would have to create an object yourself anyway :D ....

I'll give the callback thing a go...

Marcel

[mhwlng]

I can't get the callback to work...

It expects a pointer to an object of type INetRemoteVariableCallbackObject

I have defined a visual basic function like :
Sub VariableChanged(sender_handle As Long, obj_handle As Long, var As INetRemoteVariable)
....
End Sub

And I can get the address of this function using the AddressOf operator
but that operator returns a Long variable and I can't persuade vb to typecast that to an INetRemoteVariableCallbackObject ?????

with the Internet Explorer COM object you can do something like :

Dim WithEvents IE As InternetExplorer
...
Set IE = New InternetExplorer
...
Private Sub IE_DownloadBegin()
.....
End Sub

and with 'normal' windows api callbacks the pointer is declared as a Long :

Declare Function EnumWindows Lib "User32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long

....
Success& = EnumWindows(AddressOf cbFunc, 58&)

....

Public Function cbFunc (ByVal Hwnd As Long, ByVal lParam As Long) as Long
......
End Function


any ideas anybody ???

Regards,

Marcel

[Ben S]

How would you go about implementing an interface? Say you wanted to create your own IMHLWing interface?

That's what you need to do here. In C# or C++ it's basically :

class MyClass: IMHLWing{
...
}

[mhwlng]

that's the problem Ben,

VB6 doesn't have much O-O capabilities, so I can't instantiate a class of type... whatever..

So If you have a function that has a 'long' as pointer type

like this win32 function

Declare Function EnumWindows Lib "User32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long

or you implement a COM event like internet explorer DownloadBegin


then I can use it...

Marcel

[Ben S]

Let me do some investigating.

How do people build COM objects in Visual Basic?

[mhwlng]

How do people build COM objects in Visual Basic?

Aaah.. very simple, (that's why a simple person like me is using vb6 :D )

When you create a vb6 project, just select project type activex control which compiles into an ocx (it also allows activex exe, activex dll,activex document dll,activex document exe)

Job done...

You have a 'usercontrol' form where you can add your buttons/labels/scroll bars/etc.
In my above example, I just use the form hdc handle to draw GDI+ stuff, VB6 takes care of repainting etc....

If you want to give the control a method,
just define an internal 'global' variable that gets used in the code.

Private m_Angle As Single

' Set it to some default value (all vb variables already default to 0 automatically)
Private Sub UserControl_InitProperties()
m_Angle = 45
End Sub

' Load properties
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
m_Angle = PropBag.ReadProperty("Angle", 45)
End Sub

' Save properties.
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
PropBag.WriteProperty "Angle", m_Angle, 45
End Sub

' The above property bag stuff, is for when you USE this COM object. You can set the angle at DESIGN time to some value and it will automatically be written to a file and remain PERSISTENT, for the next time that you open the form editor...

' Return the text's angle.
Public Property Get Angle() As Single
Angle = m_Angle
End Property

' Set the text's rotation angle.
Public Property Let Angle(ByVal New_Angle As Single)
m_Angle = New_Angle
PropertyChanged "Angle"

'...... do something, usually force a redraw of the control
'.....
End Property


That's it...

no O-O stuff anywhere in sight.... :)

Marcel

[mhwlng]

I managed to create a useful ocx (Well. I think so anyway :D )

It is invisible and it converts 'wm_mousewheel' messages into keyboard arrow key presses...

How useful is that ? I hear you say ! Well... I'll tell you :D

I have 2 buttons on my tablet pc which simulate a mousewheel (i.e. they create wm_mousewheel messages)

I have lots of panels with NR scroll bars on them. Which I wanted to be able to operate with my 2 hardware buttons

howto :

In properties/hotkeys, define CCF arrow up and CCF arrow down to be well... keyboard arrow up and keyboard arrow down (Makes sense, right :D )

Then, in TONTO, create a SEPARATE DEVICE for each panel that needs to react to these 2 arrow buttons on the keyboard.
In the device properties\up arrow and \down arrow, set the same IR actions as the 2 NR buttons on the panel that you want to control with the keyboard...

Ok, so now we have full keyboard support for all required panels
(more than 2 keys work as well of course if you have proper arrow keys on your device or a full keyboard)

Now place the ocx on each panel that needs mousewheel support.

It waits until it detects a WM_MOUSEWHEEL message, and then simulates an 'UP' or 'DOWN' keypress (using visual basic sendkeys function)

I used this helper dll that I modified slightly to handle mousewheel messages :
http://vbaccelerator.com/home/VB/Code/Libraries/Hooks/vbAccelerator_Hook_Library/article.asp

this is the complete code :


Option Explicit

Private Const WM_MOUSEWHEEL As Long = &H20A

Implements IWindowsHook

Private Function HiWord(ByVal Dword As Long) As Integer
HiWord = (Dword And (Not &HFFFF&)) \ &HFFFF&
End Function

Private Function IWindowsHook_HookProc( _
ByVal eType As EHTHookTypeConstants, _
ByVal nCode As Long, _
ByVal wParam As Long, _
ByVal lParam As Long, _
bConsume As Boolean _
) As Long

With MouselParam(lParam)

Select Case wParam
Case WM_MOUSEWHEEL
If HiWord(.mouseData) > 0 Then
SendKeys "{UP}", False
Else
SendKeys "{DOWN}", False
End If

bConsume = False

End Select
End With
End Function

Private Sub UserControl_Initialize()

InstallHook Me, WH_MOUSE

End Sub

Private Sub UserControl_Terminate()

RemoveHook Me, WH_MOUSE

End Sub

P.S. No luck in getting the callbacks to work in vb6 yet...

Marcel

[mhwlng]

addition to above,

I found that the ocx is never unloaded at a JUMP to another panel ?

If I place the OCX on the startup panel, it always stays active

is this a bug in NR or my OCX ?

things are now not entirely stable anymore :D stay tuned...

<addition>

every time that I navigate back to the 'default panel' (where the ocx is) another instance of the ocx is loaded. it is never unloaded

any idea what is going on ?
</addition>

Marcel

[mhwlng]

Marcel said :


any idea what is going on ?

Marcel replied :

Well, Marcel, I think I know what is going on :D

I defined the ocx as being windowless (to make it invisible). that caused it not to be unloaded properly. I now made it 'windowed' (and transparent) instead and loading/unloading seems to work ok now.


You know, I heard that talking to yourself is a sure sign of of mental illness :roll:

Marcel

[mhwlng]

Hmmm, this thread looks more like my personal BLOG :D

anyway, moving on...

I created another useful OCX :

You can move the mouse to a certain position and perform a 'mouseclick'

why :

My tabletpc hardware scroll buttons already work with IE/listboxes

BUT For listboxes,after the panel is loaded, I have to 'click' once inside the listbox to set the focus, then the hardware scroll buttons work ok...

and for embedded internet exporer, you need to do that as well, PLUS the mouse cursor must remain inside the IE window.

so the following code moves the cursor to a certain position and performs a 'mouseclick', if the hardware scroll buttons are pressed... (only if the coordinates don't match)


Option Explicit

Private Const WM_MOUSEWHEEL As Long = &H20A

Implements IWindowsHook

'parts copied from http&#58;//www.Planet-Source-Code.com/vb/scripts/ShowCode.asp?txtCodeId=52199&lngWId=1

Private Const m_def_X = 0
Private Const m_def_Y = 0

Private m_X As Long
Private m_Y As Long

Private Type POINTAPI
X As Long
Y As Long
End Type

Private Declare Function GetCursorPos Lib "user32" &#40;lpPoint As POINTAPI&#41; As Long

Private Declare Function SetCursorPos Lib "user32" &#40;ByVal X As Long, _
ByVal Y As Long&#41; As Long

Private Declare Sub mouse_event Lib "user32" &#40;ByVal dwFlags As Long, _
ByVal dx As Long, _
ByVal dy As Long, _
ByVal cButtons As Long, _
ByVal dwExtraInfo As Long&#41;

Private Const MOUSEEVENTF_LEFTDOWN As Long = &H2
Private Const MOUSEEVENTF_LEFTUP As Long = &H4
Private Const MOUSEEVENTF_MIDDLEDOWN As Long = &H20
Private Const MOUSEEVENTF_MIDDLEUP As Long = &H40
Private Const MOUSEEVENTF_RIGHTDOWN As Long = &H8
Private Const MOUSEEVENTF_RIGHTUP As Long = &H10

Private Sub Click&#40;&#41;
Call mouse_event&#40;MOUSEEVENTF_LEFTDOWN, 0&, 0&, 0&, 0&&#41;
Call mouse_event&#40;MOUSEEVENTF_LEFTUP, 0&, 0&, 0&, 0&&#41;
End Sub

Private Sub UserControl_InitProperties&#40;&#41;
m_X = m_def_X
m_Y = m_def_Y
End Sub

Private Sub UserControl_ReadProperties&#40;PropBag As PropertyBag&#41;
m_X = PropBag.ReadProperty&#40;"X", m_def_X&#41;
m_Y = PropBag.ReadProperty&#40;"Y", m_def_Y&#41;
End Sub

Private Sub UserControl_WriteProperties&#40;PropBag As PropertyBag&#41;
PropBag.WriteProperty "X", m_X, m_def_X
PropBag.WriteProperty "Y", m_Y, m_def_Y
End Sub

Public Property Get X&#40;&#41; As Long
X = m_X
End Property

Public Property Let X&#40;ByVal New_X As Long&#41;
m_X = New_X
PropertyChanged "X"
End Property

Public Property Get Y&#40;&#41; As Long
Y = m_Y
End Property

Public Property Let Y&#40;ByVal New_Y As Long&#41;
m_Y = New_Y
PropertyChanged "Y"
End Property

Private Function HiWord&#40;ByVal Dword As Long&#41; As Integer
HiWord = &#40;Dword And &#40;Not &HFFFF&&#41;&#41; \ &HFFFF&
End Function

Private Function IWindowsHook_HookProc&#40; _
ByVal eType As EHTHookTypeConstants, _
ByVal nCode As Long, _
ByVal wParam As Long, _
ByVal lParam As Long, _
bConsume As Boolean _
&#41; As Long

Dim P As POINTAPI

With MouselParam&#40;lParam&#41;

Select Case wParam
Case WM_MOUSEWHEEL

Call GetCursorPos&#40;P&#41;
If &#40;P.X <> m_X&#41; Or &#40;P.Y <> m_Y&#41; Then
Call SetCursorPos&#40;m_X, m_Y&#41;
Click
End If

bConsume = False

End Select
End With
End Function

Private Sub UserControl_Initialize&#40;&#41;
InstallHook Me, WH_MOUSE
End Sub

Private Sub UserControl_Terminate&#40;&#41;
RemoveHook Me, WH_MOUSE
End Sub


Note that to access X/Y long variables, you need to use .995>=RC5 and type I4, like so :

NRMOUSEMOVE.X:=I4(760)

Marcel

[Ben S]

Wow dude. The stuff you're doing is NetRemote++ (or NetRemote#)! Very cool stuff!

I will check out the OCX unloading if it is invisible. The code does assume that it is a control that it can create as a window and destroy as a window.

I also found my problem with calling callbacks in C#. It was actually related to a threading issue and com not being initialized properly. I now have my C# app "watching" all of the variables in NetRemote.

I've also done some exploring of VB, as I'd prefer to stay with callbacks for now. I found this page (http://msdn.microsoft.com/library/default.asp?url=/library/en-us/vbcon98/html/vbconcreatingimplementinginterface.asp) concerning implementing interfaces in VB.

It looks to me like you can do ...




Option Explicit
Implements INetRemoteVariableCallbackObject

Private Sub VariableChanged&#40;ByVal Sender As Long,ByVal Object As Long, ByVal MyVar As INetRemoteVariable&#41;
Debug.Print "Something changed"
End Sub


I'm no VB guy, though. That could be completely wrong.

Regarding I4, etc. I've done that code and will have something to you to play with shortly.

[mhwlng]

well, this compiles ok

Implements INetRemoteVariableCallbackObject

Private Sub INetRemoteVariableCallbackObject_VariableChanged(B yVal sender_handle As Long, ByVal obj_handle As Long, ByVal var As NetRemoteLibrary.INetRemoteVariable)
....
End Sub

but The function never gets called .

don't you have to use RegisterCallback to say which variable to watch or something ??

there I get stuck at the 'obj' parameter...


Marcel

[Ben S]

Yes. You'll then call INetRemoteNamespace::RegisterCallback(var name, (your callback),param);

It looks like you can do ...



Private i as INetRemoteNameSpace
Private o as New CoNetRemote

Private Sub INetRemoteVariableCallbackObject_Load&#40;&#41;
Set i = o
o.RegisterCallback "MP.Track",Me,0
End Sub


Once again, I've never opened a VB editor, so that's what I gather from perusing the web regarding Visual Basic callbacks.

I guess "Me" is like the "this" pointer in C/C++/Java/C#

[mhwlng]

well this does compile ok :


Implements INetRemoteVariableCallbackObject
Private inrns As INetRemoteNameSpace
Private inrnshandle As Long

Private Sub INetRemoteVariableCallbackObject_VariableChanged&#40;B yVal sender_handle As Long, ByVal obj_handle As Long, ByVal var As NetRemoteLibrary.INetRemoteVariable&#41;
....
End Sub

Private Sub UserControl_Initialize&#40;&#41;

Set inrns = New NetRemoteLibrary.CoNetRemote
inrns.RegisterCallback "MP.Artist", Me, inrnshandle

End Sub


but still no effect

Marcel

[Ben S]

Do both of those methods exist on the same "object". IE: Does "me" refer to the "thing" that implements INetRemoteVariableCallbackObject?

Would it throw an error if it couldn't call RegisterCallback correctly?

A VB guru would have to jump in here, as I don't know enough to help, unfortunately.

The version I'm about to release a slightly revised COM interface model that I'm sure works (I'm using it from C#).

[mhwlng]

I just updated to RC5 and I can now access VB methods of type Long OK,

using :

NRMOUSEMOVE.X:=I4(760)

(I updated the OCX code in the earlier thread as well, to reflect this)

P.S. I used a hex editor to see what types you added and I found these :
DATE
UI1
R8
UI4
R4
I4
I2
BOOL
CY
BSTR

I tried BOOL, but everything I try, resolves to true :
NRSOUND.Play (BOOL(0))
NRSOUND.Play (BOOL(FALSE))

am I doing something wrong here ?

I2 works ok with VB type 'integer'

NRSOUND.Play (I2(0))


still no luck on the callbacks using the new COM function

inrns.RegisterCallback Me, inrnshandle

Marcel

[mhwlng]

Here's another ocx

I needed to have audible feedback on all my buttons...

so just add this OCX to your panel, add 'play' to all the buttons and voila :D :

NRSOUND.Sound:=BSTR(c:\windows\media\Windows XP Logon Sound.wav)

NRSOUND.Play(I2(0))


Option Explicit

Private Declare Function PlaySound Lib "winmm.dll" Alias "sndPlaySoundA" &#40;ByVal lpszSoundName As String, ByVal uFlags As Long&#41; As Long

Private Const SND_SYNC = &H0
Private Const SND_ASYNC = &H1
Private Const SND_NODEFAULT = &H2
Private Const SND_FILENAME = &H20000
Private Const SND_NOSTOP = &H10

Private Const m_def_Sound = "c&#58;\windows\media\Windows XP Start.wav"

Private m_Sound As String

Private Sub UserControl_InitProperties&#40;&#41;
m_Sound = m_def_Sound
End Sub

Private Sub UserControl_ReadProperties&#40;PropBag As PropertyBag&#41;
m_Sound = PropBag.ReadProperty&#40;"Sound", m_def_Sound&#41;
End Sub

Private Sub UserControl_WriteProperties&#40;PropBag As PropertyBag&#41;
PropBag.WriteProperty "Sound", m_Sound, m_def_Sound
End Sub

Public Property Get Sound&#40;&#41; As String
Sound = m_Sound
End Property

Public Property Let Sound&#40;ByVal New_Sound As String&#41;
m_Sound = New_Sound
PropertyChanged "Sound"
End Property

Public Sub Play&#40;Optional sync As Integer = 0&#41;
If &#40;sync <> 0&#41; Then
PlaySound m_Sound, SND_NOSTOP Or SND_FILENAME Or SND_SYNC Or SND_NODEFAULT
Else
PlaySound m_Sound, SND_NOSTOP Or SND_FILENAME Or SND_ASYNC Or SND_NODEFAULT
End If
End Sub


Marcel

[mhwlng]

re: callbacks :

here is an example of a different class, that is supposed to work :


Implements PropertyBag

Private PropBag2 As PropertyBag

' these are the 4 class members that are 'implemented'
Private Property Let PropertyBag_Contents&#40;ByVal RHS As Variant&#41;
'---
End Property

Private Property Get PropertyBag_Contents&#40;&#41; As Variant
'---
End Property

Private Function PropertyBag_ReadProperty&#40;ByVal Name As String, Optional ByVal DefaultValue As Variant&#41; As Variant
'---
End Function

Private Sub PropertyBag_WriteProperty&#40;ByVal Name As String, ByVal Value As Variant, Optional ByVal DefaultValue As Variant&#41;
'---
End Sub

Private Sub UserControl_Initialize&#40;&#41;
Set PropBag2 = New PropertyBag
End Sub

Private Sub UserControl_Terminate&#40;&#41;
Set PropBag2 = nothing
End Sub

note that there are NO registercallback style function calls anywhere:
apparently the line : Set PropBag2 = New PropertyBag does that...

so maybe you could implement something similar ?

this works ok :


Private inrns As INetRemoteNameSpace
Set inrns = New NetRemoteLibrary.CoNetRemote

but this returns a compiler error 'invalid use of New keyword' :


Private xx As INetRemoteVariableCallbackObject
Set xx= New INetRemoteVariableCallbackObject

still confused :D

Marcel

[mhwlng]

just tried RC6

some names have changed, from RegisterCallback to Advise

and INetRemoteVariableCallbackObject to INetRemoteVariableEvents

but it still doesn't work in VB...

Marcel

[Ben S]

Let's keep working on this via our email conversation until we can get this working.

We'll get this! Soon, hopefully!

[mhwlng]

here's another simple ocx application :

I have one button that switches off my tv/amplifier etc.
I added an invisible OCX to the page (see earlier in this thread for more examples) with a 'Shutdown' function that switches off my tabletpc after it has switched off my tv etc....

the code, I got here http://www.jaredshelp.com/article65.html


Option Explicit

'API constants
Private Const EWX_LOGOFF = 0
Private Const EWX_SHUTDOWN = 1
Private Const EWX_POWEROFF = &H8
Private Const EWX_REBOOT = 2
Private Const EWX_FORCE = 4
Private Const EWX_FORCEIFHUNG = &H10
Private Const TOKEN_ADJUST_PRIVILEGES = &H20
Private Const TOKEN_QUERY = &H8
Private Const SE_PRIVILEGE_ENABLED = &H2
Private Const ANYSIZE_ARRAY = 1
Private Const VER_PLATFORM_WIN32_NT = 2

'API structures
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Private Type LUID
LowPart As Long
HighPart As Long
End Type
Private Type LUID_AND_ATTRIBUTES
pLuid As LUID
Attributes As Long
End Type
Private Type TOKEN_PRIVILEGES
PrivilegeCount As Long
Privileges&#40;ANYSIZE_ARRAY&#41; As LUID_AND_ATTRIBUTES
End Type

'API Declarations
Private Declare Function GetCurrentProcess Lib "kernel32" &#40;&#41; As Long
Private Declare Function OpenProcessToken Lib "advapi32" &#40;ByVal ProcessHandle As Long, _
ByVal DesiredAccess As Long, TokenHandle As Long&#41; As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" _
&#40;ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID&#41; As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32" &#40;ByVal TokenHandle As Long, _
ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, _
ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, _
ReturnLength As Long&#41; As Long
Private Declare Function ExitWindowsEx Lib "user32" &#40;ByVal uFlags As Long, _
ByVal dwReserved As Long&#41; As Long
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _
&#40;ByRef lpVersionInformation As OSVERSIONINFO&#41; As Long

' IsWinNT&#40;&#41; - Detect if the program is running under Windows NT
Private Function IsWinNT&#40;&#41; As Boolean
Dim myOS As OSVERSIONINFO
myOS.dwOSVersionInfoSize = Len&#40;myOS&#41;
GetVersionEx myOS
IsWinNT = &#40;myOS.dwPlatformId = VER_PLATFORM_WIN32_NT&#41;
End Function
' EnableShutDown&#40;&#41; - Set the shut down privilege for the current application
Private Sub EnableShutDown&#40;&#41;
Dim hProc As Long, hToken As Long, mLUID As LUID, mPriv As TOKEN_PRIVILEGES, mNewPriv As TOKEN_PRIVILEGES
hProc = GetCurrentProcess&#40;&#41;
OpenProcessToken hProc, TOKEN_ADJUST_PRIVILEGES + TOKEN_QUERY, hToken
LookupPrivilegeValue "", "SeShutdownPrivilege", mLUID
mPriv.PrivilegeCount = 1
mPriv.Privileges&#40;0&#41;.Attributes = SE_PRIVILEGE_ENABLED
mPriv.Privileges&#40;0&#41;.pLuid = mLUID
' enable shutdown privilege for the current application
AdjustTokenPrivileges hToken, False, mPriv, 4 + &#40;12 * mPriv.PrivilegeCount&#41;, mNewPriv, 4 + &#40;12 * mNewPriv.PrivilegeCount&#41;
End Sub

Public Sub Shutdown&#40;&#41;
Dim Flags As Long
Flags = EWX_SHUTDOWN + EWX_FORCE
If IsWinNT Then EnableShutDown
ExitWindowsEx Flags, 0
End Sub

[mhwlng]

here's another simple invisible ocx :

it calculates the battery level for my tabletpc and dumps it into a NR variable (the last one in the picture)

the code is quite simple :


Option Explicit

Private inrns As INetRemoteNameSpace
Private inrnshandle As Long

Private OldBatteryString As String

Private Sub Timer1_Timer&#40;&#41;
Dim BatteryString As String

Timer1.Interval = 1000
GetSystemPowerStatus SysPower
If SysPower.BatteryFlag = 128 Then
BatteryString = "NO BATTERY"
Else
If SysPower.ACLineStatus <> 0 Then
If SysPower.BatteryLifePercent < 100 Then
BatteryString = "Charging &#40;" + Format$&#40;SysPower.BatteryLifePercent / 100, "##0.0%"&#41; + "&#41;"
Else
BatteryString = "ON AC POWER"
End If
Else
BatteryString = Format$&#40;Val&#40;SysPower.BatteryLifeTime&#41; * &#40;1 / 3600&#41;, "##0.0"&#41; + " Hours &#40;" + Format$&#40;SysPower.BatteryLifePercent / 100, "##0.0%"&#41; + "&#41;"
End If
End If

If OldBatteryString <> BatteryString Then
OldBatteryString = BatteryString
inrns.SetValue inrnshandle, "BATTERYTIMEREMAINING", BatteryString
End If
End Sub

Private Sub UserControl_Initialize&#40;&#41;
Set inrns = New NetRemoteLibrary.CoNetRemote
End Sub

Private Sub UserControl_Terminate&#40;&#41;
Set inrns = Nothing
End Sub

*********
*********with the following code in a module &#58;
*********
Public Declare Function GetSystemPowerStatus Lib "kernel32" &#40;lpSystemPowerStatus As SYSTEM_POWER_STATUS&#41; As Long
Public Declare Function SetSystemPowerState Lib "kernel32" &#40;ByVal fSuspend As Long, ByVal fForce As Long&#41; As Long

Public Type SYSTEM_POWER_STATUS
ACLineStatus As Byte 'Checks to see if your connected to the walloutlet or not
BatteryFlag As Byte 'Battery status
BatteryLifePercent As Byte 'precentage left
Reserved1 As Byte 'Dont use
BatteryLifeTime As Long 'Total time left of your battery
BatteryFullLifeTime As Long 'Total UPtime of your battery
End Type

Public SysPower As SYSTEM_POWER_STATUS


The numbers in the picture ABOVE the horizontal line contain information about my SERVER pc.

the first 4 numbers in the picture come from the Motherboard Monitor Plugin for girder (I don't have any fans, but they could easily be shown as well...)

the disk size is a bit of luacom code (thanks Mike C):

function Public.get_FreeDiskSpace&#40;&#41;

local objWMIService = luacom_GetObject &#40; "winmgmts&#58;&#123;impersonationLevel=impersonate&#125;!\\\\" ..".".. "\\root\\cimv2"&#41;

local objDiskRefresher = luacom.CreateObject &#40;"WbemScripting.SWbemRefresher"&#41;

objDiskRefresher.AutoReconnect = 1

local refobjDisk = objDiskRefresher&#58;AddEnum&#40;objWMIService,"win32_perfformatteddata_perfdisk_logicaldisk"&#41;.objectSet

objDiskRefresher&#58;Refresh &#40;&#41;
objDiskRefresher&#58;Refresh &#40;&#41;

local enum = luacom.GetEnumerator &#40;refobjDisk&#41;
local item = enum&#58;Next &#40;&#41;
local x
local y
while item do
if item&#58;Name &#40;&#41; == "C&#58;" then
x = item&#58;FreeMegaBytes&#40;&#41;
y = item&#58;PercentFreeSpace&#40;&#41;
end
item = enum&#58;Next&#40;&#41;
end
item = nil
enum = nil
objDiskRefresher = nil
objWMIService = nil
collectgarbage &#40;&#41;

return x,y

end

[mhwlng]

ok then...

Here's another ocx, which works similar to above battery level ocx. Only this one gives the signal strength of the WIFI connection + the SSID of the access point that it is connected to !

The signal is in dBm. I am not sure how to convert this to % ? (I found that -40 dBm equates 100% and higher negative numbers are lower % and db's are of course logarithmic)

:?: does anyone know the correct formula :?:

Marcel


Option Explicit

Private inrns As INetRemoteNameSpace
Private inrnshandle As Long

Private oldsignalstring As String

Private Sub Timer1_Timer&#40;&#41;
Dim signalstring As String

On Error GoTo errorhandler

Timer1.Interval = 1000

signalstring = CStr&#40;SigStrength&#40;&#41;&#41; + "dBm &#40;" + SSID&#40;&#41; + "&#41;"

If signalstring <> oldsignalstring Then
oldsignalstring = signalstring
inrns.SetValue inrnshandle, "WIFISIGNALSTRENGTH", signalstring
End If
Exit Sub
errorhandler&#58;
signalstring = "UNKNOWN"
oldsignalstring = signalstring
inrns.SetValue inrnshandle, "WIFISIGNALSTRENGTH", signalstring
End Sub

Private Sub UserControl_Initialize&#40;&#41;
Set inrns = New NetRemoteLibrary.CoNetRemote
End Sub

Private Sub UserControl_Terminate&#40;&#41;
Set inrns = Nothing
End Sub




***********
*********** add the following stuff to a module
***********

Option Explicit

Private Sub GetWMI&#40;ByRef WMIArray As WbemScripting.SWbemObjectSet, WMIQuery As String&#41;
Set WMIArray = GetObject&#40;"winmgmts&#58;&#123;impersonationLevel=impersonate&#125;!\\.\root \wmi"&#41;.ExecQuery&#40;WMIQuery&#41;
End Sub

Function SigStrength&#40;&#41; As Long
Dim objMSNdis_80211_ReceivedSignalStrengthSet As WbemScripting.SWbemObjectSet
Dim objMSNdis_80211_ReceivedSignalStrength As WbemScripting.SWbemObject

Call GetWMI&#40;objMSNdis_80211_ReceivedSignalStrengthSet, "Select * from MSNdis_80211_ReceivedSignalStrength Where active=true"&#41;

For Each objMSNdis_80211_ReceivedSignalStrength In objMSNdis_80211_ReceivedSignalStrengthSet
SigStrength = objMSNdis_80211_ReceivedSignalStrength.Ndis80211Re ceivedSignalStrength
Next

End Function

Function DataRate&#40;&#41; As String
Dim objMSNdis_80211_DataRateSet As WbemScripting.SWbemObjectSet
Dim objMSNdis_80211_DataRate As WbemScripting.SWbemObject
Call GetWMI&#40;objMSNdis_80211_DataRateSet, "Select * from MSNdis_80211_DataRate Where active=true"&#41;
For Each objMSNdis_80211_DataRate In objMSNdis_80211_DataRateSet
DataRate = objMSNdis_80211_DataRate.Ndis80211DataRate
Next
End Function

Function SSID&#40;&#41; As String
Dim objMSNdis_80211_ServiceSetIdentifierSet As WbemScripting.SWbemObjectSet
Dim objMSNdis_80211_ServiceSetIdentifier As WbemScripting.SWbemObject
Dim ID As String
Dim I As Long

Call GetWMI&#40;objMSNdis_80211_ServiceSetIdentifierSet, "Select * from MSNdis_80211_ServiceSetIdentifier Where active=true"&#41;

For Each objMSNdis_80211_ServiceSetIdentifier In objMSNdis_80211_ServiceSetIdentifierSet
ID = ""
For I = 0 To objMSNdis_80211_ServiceSetIdentifier.Ndis80211SsId &#40;0&#41; - 1
ID = ID & Chr&#40;objMSNdis_80211_ServiceSetIdentifier.Ndis80211 SsId&#40;I + 4&#41;&#41;
Next
SSID = ID
Next
End Function

[mhwlng]

Here's another one : an e-mail/voice-mail checker ocx...

This one is *VERY* specific to my situation..

Most e-mail checkers have a POP3 or MAPI client that connects to a POP3 server, looking for unread mail.

In my situation, I already have a PC with outlook running, that checks my mail at regular intervals and removes the messages from the server. So these POP3 mail checkers would always show 'no mail'. Not very useful :D

So I do it differently : I ask outlook on my 'main' pc how many unread mails it has. (This will only work if outlook is always running of course)

My telecom provider also sends my voicemail messages via e-mail, so I look for a specific (dutch) subject name to distinguish voicemail messages from normal e-mail...

Note that this program will only work if outlook is also installed on the NetRemote PC. (don't use it or configure it, only install it)

Marcel


Option Explicit

Private inrns As INetRemoteNameSpace
Private inrnshandle As Long

Dim oldunreadcount As Long
Dim oldvoicemailcount As Long

Private Const m_def_Server = ""

Private m_Server As String

Private Sub Timer1_Timer&#40;&#41;

On Error Resume Next

Dim objOutlook
Dim objNameSpace
Dim objFolder
Dim oItems
Dim omsg
Dim unreadcount As Long
Dim voicemailcount As Long
Dim mailstring As String

Dim i As Long

Const olFolderInbox = 6

Timer1.Interval = 60000

Set objOutlook = CreateObject&#40;"Outlook.application", m_Server&#41;
Set objNameSpace = objOutlook.GetNameSpace&#40;"MAPI"&#41;

Set objFolder = objNameSpace.GetDefaultFolder&#40;olFolderInbox&#41;

Set oItems = objFolder.Items
Set oItems = oItems.Restrict&#40;"&#91;Unread&#93; = true"&#41;

unreadcount = 0
voicemailcount = 0

For i = 1 To oItems.Count
Set omsg = oItems.Item&#40;i&#41;
If Trim&#40;omsg.Subject&#41; = "Nieuw VoiceMail bericht" Then
voicemailcount = voicemailcount + 1
Else
unreadcount = unreadcount + 1
End If
Next i

Set oItems = Nothing
Set objFolder = Nothing
Set objNameSpace = Nothing
Set objOutlook = Nothing

If unreadcount <> oldunreadcount Then
oldunreadcount = unreadcount
If unreadcount = 0 Then
mailstring = "No e-mail waiting"
ElseIf unreadcount = 1 Then
mailstring = "1 e-mail waiting"
Else
mailstring = CStr&#40;unreadcount&#41; + " e-mails waiting"
End If
inrns.SetValue inrnshandle, "MAILWAITING", mailstring
End If
If voicemailcount <> oldvoicemailcount Then
oldvoicemailcount = voicemailcount
If voicemailcount = 0 Then
mailstring = "No voice-mail waiting"
ElseIf voicemailcount = 1 Then
mailstring = "1 voice-mail waiting"
Else
mailstring = CStr&#40;voicemailcount&#41; + " voice-mails waiting"
End If
inrns.SetValue inrnshandle, "VOICEMAILWAITING", mailstring
End If
End Sub

Private Sub UserControl_InitProperties&#40;&#41;
m_Server = m_def_Server
End Sub

Private Sub UserControl_ReadProperties&#40;PropBag As PropertyBag&#41;
m_Server = PropBag.ReadProperty&#40;"Server", m_def_Server&#41;
End Sub

Private Sub UserControl_WriteProperties&#40;PropBag As PropertyBag&#41;
PropBag.WriteProperty "Server", m_Server, m_def_Server
End Sub

Public Property Get Server&#40;&#41; As String
Server = m_Server
End Property

Public Property Let Server&#40;ByVal New_Server As String&#41;
m_Server = New_Server
PropertyChanged "Server"
End Property

Private Sub UserControl_Initialize&#40;&#41;
oldunreadcount = -1
oldvoicemailcount = -1

Set inrns = New NetRemoteLibrary.CoNetRemote
End Sub

Private Sub UserControl_Terminate&#40;&#41;
Set inrns = Nothing
End Sub

[mhwlng]

I found that the font properties on the MP search edit box can't be changed... so I created a simple universal TextBox ocx

you can set a number of properties like :


&#123;4588BDB6-41D3-435D-B95A-BD0225C600A7&#125;
NRTEXTBOX.FontSize&#58;=CY&#40;12&#41;
NRTEXTBOX.FontName&#58;=BSTR&#40;Verdana&#41;
NRTEXTBOX.MaxLength&#58;=I4&#40;0&#41;
NRTEXTBOX.Variable&#58;=BSTR&#40;MP.SearchString&#41;

and it also changes the focus automatically...


Private inrns As INetRemoteNameSpace
Private inrnshandle As Long

Private nrvariable As String

Private Sub Text1_Change&#40;&#41;
' not sure why tempvariable is needed ?????????
' it seems it gets changed when SetValue is called ?????
Dim tempvariable As String
If nrvariable <> "" Then
tempvariable = nrvariable
inrns.SetValue inrnshandle, tempvariable, Text1.Text
End If
End Sub

Private Sub UserControl_Initialize&#40;&#41;
Set inrns = New NetRemoteLibrary.CoNetRemote
End Sub

Private Sub UserControl_Terminate&#40;&#41;
Set inrns = Nothing
End Sub

Private Sub UserControl_Resize&#40;&#41;
Text1.Top = 0
Text1.Left = 0
Text1.Width = Width
Text1.Height = Height
End Sub

Private Sub UserControl_InitProperties&#40;&#41;
Set Text1.Font = Ambient.Font
End Sub

Public Property Get FontSize&#40;&#41; As Currency
FontSize = Text1.Font.Size
End Property

Public Property Let FontSize&#40;new_fontsize As Currency&#41;
Text1.Font.Size = new_fontsize
End Property

Public Property Get FontName&#40;&#41; As String
FontName = Text1.Font.Name
End Property

Public Property Let FontName&#40;new_fontname As String&#41;
Text1.Font.Name = new_fontname
End Property

Public Property Get Variable&#40;&#41; As String
Variable = nrvariable
End Property

Public Property Let Variable&#40;new_variable As String&#41;
' not sure why tempvariable is needed ?????????
' it seems it gets changed when GetValue is called ?????
Dim tempvariable As String
nrvariable = new_variable
tempvariable = nrvariable
Text1.Text = inrns.GetValue&#40;tempvariable&#41;
Text1.SetFocus
End Property

Public Property Get MaxLength&#40;&#41; As Long
MaxLength = Text1.MaxLength
End Property

Public Property Let MaxLength&#40;new_maxlength As Long&#41;
Text1.MaxLength = new_maxlength
End Property

[Mastiff]

Holy cr...! This is really something I have been lolking for! I just hope I find out how incorporate this in my CCF - programming doesn't really work with me... Is there any way to get you to put up that CCF page somewhere? Does that require bribes, pleading or threats? I'm okay with any of the above... :wink:

[mhwlng]

my stuff only works on win32 (some bits only on XP)....

So... If you are using windows ce, you're out of luck :D

If you're only interested in a JRMC search screen, just look at ben's latest file. It's in there...


Marcel

[mhwlng]

Some more experiments :D

I show the same set of 'status icons' at the top of the screen on EACH panel...
I do this by configuring these buttons/frames on the deviceTemplate in Tonto.

Each panel can also add it's own buttons to the top of the screen.. (like a back or browser refresh button)

The battery icon is an experimental alpha-blended active-x control that shows the battery state. (20 different pictures 'stolen' from www.wincustomize.com)
(code for reading battery status can be found earlier in this thread)

The icon, to the left of that is an experimental alpha-blended active-x control that shows the WIFI signal strength and the connected SSID.
(code for the wifi calls (xp only) can be found earlier in this thread)

All the other bits are NORMAL NR frames/buttons controlled from girder.

The telephone icon+number indicates how many voicemails there are waiting. The icon turns transparent if there are none...

The stamp icon+number indicates how many e-mails there are waiting. The icon turns transparent if there are none...

The code to handle mail is also explained earlier in this thread,
only I moved the code from an active-x control in NR to a bit of lua code in girder that runs once a minute. But the principle is the same...

The yellow bit is my caller id indicator...
I have an old unused ISDN modem with caller id capability connected to the serial port of my girder pc.
I use the girder serial port plugin to receive the phonenumber from the modem. (there is an example how to do this on the girder download page)

Then I do a simple lookup (via lua/luacom) in an access database to find the corresponding name, which is then sent to NR....

issues :

* the yellow bit is a frame. and because it is defined on the deviceTemplate, it will apear BEHIND buttons/frames that are defined on all the panels.. that is why it is placed at the top of the screen...
Also I can't put it on top of the 2 active-x controls because they are always visible...

* The mail checking code can hang girder if outlook hasn't been started in a certain way (still investigating better ways to do this)...

* The active-x controls use gdi+ and alpha blending...
I am not quite happy with the way alpha blending is implemented at the moment...

I can only fix this, if/when Ben creates a method to have an 'on panel load' IR action...

BEN, if you are listening and you are planning such a feature, PLEASE fire the event AFTER the panel is displayed, NOT when the previous panel is still displayed and the buttons/frames/active-x controls are still being loaded in memory...

Marcel

[Mastiff]

No, I was thinking about the NetRemote WinXP computer in my living room! So please give me some candy, don't just tempt me with pictures of it! :wink:

[mhwlng]

hmmm... ok then...

http://piazza.iaehv.nl/users/mhwlng/marcel%20v0.3.zip (3Mb)

Please read README.TXT carefully...

Expect your pc's to crash often and in most interesting ways.....

you have been warned :D

By the way, this version will probably be outdated in about 5 minutes....

Marcel

[Mastiff]

Thanks a lot! Will thos crashes happen with just that search thing? That's mainly what I was after. And can you link up later versions as they come along?

[mhwlng]

As I said before...

If you just want the search thing, just copy it from Ben's file.
Don't use mine, it will probably only cause you (and me) problems :D

re :crashing... I was speaking in general... and I was (half) joking...
not everything is 100% stable yet...

YMMV (your mileage may vary)

you need to follow the instructions in the readme file exactly...

Marcel

[Mastiff]

But your search looks better. I want to experiment a bit with it, at least. We'll see if my PC survives... :wink:

[Mastiff]

Aha, I see what you mean now. I actually thought the search box itself (which is the same one I use) was modified. Sorry about causing you this extra work. But I must say that it's interesting to see the inner workings of something like this! :D Also I can use the ZoomPlayer stuff since I have pro 4. I like that!

[Ben S]

Wow. This stuff just keeps getting cooler.

I wish there was some way we could sit down together for a few hours and hammer out the problems.

Regarding your "on page load" method, I'm starting to put more hooks in for lua to do things like that. Let me see if I can get a build to you that will allow you to "notify" the object that the page is fully loaded.

[mhwlng]

I wish there was some way we could sit down together for a few hours and hammer out the problems.

yeah, If I could get the on variable change callback to work in VB,
then I could create something like :

* progress bar
* vu meter
* dial
* strip chart
* scroll bar

the possiblities are endless (for the one person (me) that is using win32 anyway)

and with the on-page-load ir action they could be properly alpha blended as well...



Marcel