Reportevent External Function and Eventcreate command line command

You can use the command shell to do this too but this has the drawback of not being able to assign the source of the event.

First you need the following External Functions:

Function ulong RegisterEventSource ( &
	ulong lpUNCServerName, &
	string lpSourceName &
	) Library "advapi32.dll" Alias For "RegisterEventSourceW"

Function boolean ReportEvent ( &
	ulong hEventLog, &
	uint wType, &
	uint wCategory, &
	ulong dwEventID, &
	ulong lpUserSid, &
	uint wNumStrings, &
	ulong dwDataSize, &
	string lpStrings[], &
	ulong lpRawData &
	) Library "advapi32.dll" Alias For "ReportEventW"

Function boolean DeregisterEventSource ( &
	ref ulong hEventLog &
	) Library "advapi32.dll"

Then in PowerScript

integer li_messagelevel
string ls_errmsg[]
string ls_messagesource
ulong lul_eventsource
// the event message is here
ls_errmsg[1] = "Event Log Entry " + String(now(), 'hh:mm:ss') 
// setting the source of the message
ls_messagesource = this.classname()

lul_eventsource = RegisterEventSource(0, ls_messagesource)
IF IsNull(ls_eventsource) THEN ls_eventsource = -1
// set the level of the message
li_messagelevel = 4 // Information,  also 1 = Error, 2 = Warning

IF lul_eventsource > 0 THEN
	// write to the log
	ReportEvent(lul_eventsource, li_messagelevel, 0, 0, 0, &
        UpperBound(ls_errmsg), 0, ls_errmsg, 0)
	DeregisterEventSource(lul_eventsource)
END IF

Viewing the Log

Per the MSDN documentation, if the source name cannot be found the event logging service uses the Application log. Although events will be reported , the events will not include descriptions because there are no message and category message files for looking up descriptions related to the event identifiers.

Thanks to Roland Smith for most of the code for this functionality.

You are also able to use the ‘EVENTCREATE’ command line command.

From the Microsoft Technet page (found Here):

Enables an administrator to create a custom event in a specified event log.
Syntax
eventcreate [/s Computer [/u Domain\User [/p Password]] {[/l {APPLICATION|SYSTEM}]|[/so SrcName]} /t {ERROR|WARNING|INFORMATION|SUCCESSAUDIT|FAILUREAUDIT} /id EventID /d Description
Top of page 
Parameters
/s   Computer   : Specifies the name or IP address of a remote computer (do not use backslashes). The default is the local computer.
/u   Domain \ User   : Runs the command with the account permissions of the user specified by User or Domain\User. The default is the permissions of the current logged on user on the computer issuing the command.
/p   Password   : Specifies the password of the user account that is specified in the /u parameter.
/l { APPLICATION | SYSTEM } : Specifies the name of the event log where the event will be created. The valid log names are APPLICATION and SYSTEM.
/so   SrcName   : Specifies the source to use for the event. A valid source can be any string and should represent the application or component that is generating the event.
/t { ERROR | WARNING | INFORMATION | SUCCESSAUDIT | FAILUREAUDIT } : Specifies the type of event to create. The valid types are ERROR, WARNING, INFORMATION, SUCCESSAUDIT, and FAILUREAUDIT.
/id   EventID   : Specifies the event ID for the event. A valid ID is any number from 1 to 65535.
/d   Description   : Specifies the description to use for the newly created event.
/? : Displays help at the command prompt.

In PowerScript:

// command line event log
integer li_rtn
string ls_msg, ls_eventmsg
ls_msg = 'Command Line Message'

 ls_EventMsg = 'EVENTCREATE /T ERROR /ID 100 /SO "My Application" /l APPLICATION /D "' +ls_msg + '" '
 li_Rtn = Run (ls_EventMsg,  Minimized!)

 IF li_Rtn <> 1 THEN
	messagebox('event log', 'error loging msg')
 END IF

And the message in the Event Log viewer

To use this the user must be an administrator on the machine or you have to provide the id/password combination of one.

Thanks to Kyle Griffis for this tip.

"The Get function retrieves the complete defenition of the window in 
a big long variable. All the bits in this long value describe the window. 
So there are bits for the type of border (which indicates if a window is 
resizable), menu, colors etc.etc. We can modify this long value, altering 
the design of the window. Using the SetWindowLong() we update the window with 
our specific modifications."

I used this in ancestor code of a userobject I use to create visible panels within the main window.

// Unicode declarations, used 'A' for ANSI
function long GetWindowLongW (long hWindow, integer nIndex) Library "user32.dll"
function long SetWindowLongW (long hWindow, integer nIndex, long dwNewLong) library "user32.dll"

// code in my post constructor event
n_cst_numerical lnv_num // PFC numeric service
long		ll_Styles
boolean		lb_Control

constant long	WS_THICKFRAME = 262144
constant long	WS_SYSMENU = 524288

ll_styles = GetWindowLongw(handle(THIS), -16)
if ll_styles <> 0 then

	ll_styles = lnv_num.of_BitWiseOr(ll_styles, WS_THICKFRAME)
// don't need control menu but leave this for reference 
//	if ab_Control then 
//		ll_styles = lnv_num.of_BitWiseOr(ll_styles, WS_SYSMENU)
//	end if

	SetWindowLongW(handle(THIS), -16, ll_styles)
end if

At first my UO cannot be resized.

Now it can!

I’ve seen other references to these API calls for manipulating windows for other things but I have not investigated further.

Usage Notes:

function ulong SHGetFolderPath(ulong hwndOwner, long nFolder, &
ulong hToken, long dwFlags, Ref string pszPath) library 'shell32.dll' &
alias For "SHGetFolderPathA;Ansi"

or

Function long SHGetFolderPath ( long hwndOwner, long nFolder, &
long hToken, long dwFlags, Ref string pszPath ) Library "shell32.dll" &
alias For "SHGetFolderPathW"

Constant Long CSIDL_PERSONAL = 5 // current user My Documents
Constant Long CSIDL_APPDATA = 26 // current user Application Data
Constant Long CSIDL_LOCAL_APPDATA = 28 // local settings Application Data
Constant Long CSIDL_COMMON_DOCUMENTS = 46 // all users My Documents
Constant Long CSIDL_COMMON_APPDATA = 35 // all users Application Data
string ls_path
ulong lul_handle, lul_rc, lul_hToken

ls_path = Space(256)
lul_handle = Handle(This)
SetNull(lul_hToken)
lul_rc = SHGetFolderPath(lul_handle, CSIDL_APPDATA, lul_hToken, 0, ls_path)

RETURN ls_path // path

keybd_event( int bVk, int bScan, int dwFlags, int dwExtraInfo) Library "user32.dll"

Next create a user event in the listview control. I called mine ue_scrolltoitem. The event has two parameters, ai_oldindex and ai_newindex. In this event put the following script.

listviewitem  lvi_1
long li_rc
// unselect old value
IF ai_oldindex > 0 THEN
	li_rc = This.GetItem(ai_oldindex, lvi_1)
	lvi_1.HasFocus=FALSE
	lvi_1.selected=FALSE
	li_rc = This.SetItem(ai_oldindex , lvi_1)
END IF
// select new value
li_rc = This.GetItem(ai_newindex , lvi_1)
lvi_1.HasFocus=TRUE
lvi_1.selected=TRUE
li_rc = This.SetItem(ai_newindex , lvi_1)

this.setfocus()

// simulate up arrow then down arrow to move selected item into visible portion of the control
IF ai_newindex < this.totalitems( ) AND ai_newindex > 1 THEN
	// decimal value of the virtural keyboard up arrow (0x26)
	keybd_event( 38, 1, 0, 0)
	// decimal value of the virtural keyboard down arrow (0x28)
	keybd_event(40,1,0,0)
ELSEIF ai_newindex = 1 THEN
	// decimal value of the virtural keyboard down arrow (0x28)
	keybd_event(40,1,0,0)
	// decimal value of the virtural keyboard up arrow (0x26)
	keybd_event( 38, 1, 0, 0)
END IF

This technique sets up the highlighted row as the last one in the visible portion of the control. You can modify it to ‘scroll up’ as many times as needed to put it at the top of the control should you need to do so.

// window event script with string parameter
// string parameter is the caption on the folder selection dialog window

uo_select_folder luo_folder
// iw_parent set somewhere else on the window
RETURN luo_folder.uf_browseforfolder( iw_parent, as_caption)

Export for non visual object. Uses Unicode API calls.

$PBExportHeader$uo_select_folder.sru
forward
global type uo_select_folder from nonvisualobject
end type
type str_itemid from structure within uo_select_folder
end type
type str_itemidlist from structure within uo_select_folder
end type
type str_browseinfo from structure within uo_select_folder
end type
end forward

type str_itemid from structure
	unsignedint		db
	character		abid
end type

type str_itemidlist from structure
	str_itemid		mkid
end type

type str_browseinfo from structure
	unsignedlong		howner
	unsignedlong		pidlroot
	string		pszdisplayname
	string		lpsztitle
	unsignedinteger		ulflags
	unsignedlong		lpfn
	long		lparm
	integer		iimage
end type

global type uo_select_folder from nonvisualobject autoinstantiate
end type

type prototypes
 Function unsignedlong SHGetPathFromIDListW( unsignedlong pidl, ref string pszPath) Library 'shell32'
Function unsignedlong SHBrowseForFolderW( str_browseinfo lpstr_browseinfo ) Library 'shell32'
Subroutine CoTaskMemFree( ulong idlist ) Library 'ole32'
end prototypes
forward prototypes
public function string uf_browseforfolder (ref window awi_parent, string as_caption)
end prototypes

public function string uf_browseforfolder (ref window awi_parent, string as_caption);str_browseinfo lstr_bi
str_itemidlist lstr_idl
unsignedlong ll_pidl
unsignedlong ll_r
Integer li_pos
String ls_Path
unsignedlong ll_Null

SetNull( ll_Null )

lstr_bi.hOwner = Handle( awi_Parent )
lstr_bi.pidlRoot = 0
lstr_bi.lpszTitle = as_caption
lstr_bi.ulFlags = 1
lstr_bi.pszDisplayName = Space( 255 )
lstr_bi.lpfn = ll_Null

ll_pidl = SHBrowseForFolderW( lstr_bi )

ls_Path = Space( 255 )
ll_R = SHGetPathFromIDListW( ll_pidl, ls_Path )

CoTaskMemFree( ll_pidl )

RETURN ls_Path
end function

on uo_select_folder.create
call super::create
TriggerEvent( this, "constructor" )
end on

on uo_select_folder.destroy
TriggerEvent( this, "destructor" )
call super::destroy
end on

The code is available here within an Archive File which also includes exports of the objects. Basically you will need to define the ‘mousemove’ event on your datawindow control (mapped to pbm_dwnmousemove) along with an string instance variable that tracks which row/column combination the mouse pointer is over. The instance variable is very important since it prevents the code from constantly being executed when the user keeps the pointer on the same row/column. Within the mouse move the position and width of the datawindow object column being pointed to is compared to the width of the datawindow control and the position of the horizontal scrollbar. Left and Right positioning of the column is also taken into consideration. If the text in the pointed at column is not completely within the control, it it placed into the Tooltip Text of the column. All columns have Tooltips enabled so once the Tip text has a value, the tip appears.

The code to derive the text and determine its length is encapsulated in an non visual object and uses a variety of API calls.

The sample application datawindow has columns of all Edit types as well as a couple of computed columns. One periodic issue is with dropdown datawindows and listboxed which have ‘Display all columns’ on. Another is with the ‘Always show arrow’ option which sometimes keeps the tooltip coming on even though all the text is visible.

Sample Screenshots:

This shows the bubblehelp for a Checkbox column. If the column has three states the text will show either ‘On’, ‘Off’, or ‘Other’.

This shows the right side of the datawindow control with no bubblehelp.

This shows the bubblehelp on a computed column.

At the bottom of the sample application are text boxes which display various position and size information which was useful in creating the checking logic. Since this is a grid datawindow you can re-order the columns as you wish. Also note the datawindow conrol can be resized which makes testing easier.

Code from mousemove event

// listview tooltips functionality for datawindow
//
// check to see if datawindow column text is cut off by either the size of the datawindow
// control or the position of the horizontal scrollbar
// if the text is cut off, put the text into the tooltip for the datawindow column so it
// will display.
Long    ll_hScrollPos, ll_width
Long    ll_colX, ll_colW, ll_colXW, ll_textwidth
datawindow ldw
string ls_mod, ls_value, ls_err, ls_checkname, ls_oldcolname, ls_alignment
s_dwbubble lstr_bubble

ldw = THIS
IF  row > 0 AND dwo.name <> 'datawindow' THEN
	ls_checkname = (dwo.Name  + '/' + string(row))
	// only do this if mouse moved to new row/column since last time
	IF(is_curcol <> ls_checkname) THEN
		IF Len(is_curcol) > 0 THEN // blank out previous tip
			ls_oldcolname = Left(is_curcol, Pos(is_curcol,'/') - 1)
			ls_mod = ls_oldcolname + '.Tooltip.Tip = ""'
			ls_err = this.modify(ls_mod)
		END IF
		ll_width = w_dwbubblehelp.dw_1.width
		ll_hScrollPos = Long( THIS.Describe("DataWindow.HorizontalScrollPosition") )
		ls_mod = dwo.name + '.x'
		ll_colX = Long( THIS.Describe(ls_mod) )
		ls_mod = dwo.name + '.width'
		ll_colW = Long( this.Describe(ls_mod) )
		ll_colXW = ll_colX + ll_colW
		IF ll_colXW < ll_hScrollPos THEN
			 // "Not visible"
		ELSE
			 IF ( ll_colX < ll_hScrollPos ) AND ( ll_colXW > ll_hScrollPos ) THEN
				 // Partially Visible Left 
				 // get the text value and its length
				lstr_bubble = idw.uf_get_width_of_data(row, dwo.name, ldw, iw_parent)
				ll_textwidth = lstr_bubble.i_width
				ls_value = lstr_bubble.s_value
				ls_mod = dwo.name + '.Alignment'
				ls_alignment = this.describe(ls_mod)
				IF ls_alignment = '1' THEN // right alighment
					IF ll_textwidth > ll_colw THEN // text wider than column
						ls_mod = dwo.name + '.Tooltip.Tip = "' + ls_value + '"'
						ls_err = this.modify(ls_mod)
					ELSEIF ll_colXW - ll_textwidth <  ll_hScrollPos THEN 
						 // text cut off by datawindow control or scrollbar
						ls_mod = dwo.name + '.Tooltip.Tip = "' + ls_value + '"'
						ls_err = this.modify(ls_mod)
					ELSE
						ls_mod = dwo.name + '.Tooltip.Tip = ""'
						ls_err = this.modify(ls_mod)
					END IF
				ELSE // other alignments
					IF ll_textwidth > ll_colw THEN
						ls_mod = dwo.name + '.Tooltip.Tip = "' + ls_value + '"'
						ls_err = this.modify(ls_mod)
					ELSEIF ll_textwidth > (ll_colXW - (ll_width + ll_hScrollPos)) THEN
						ls_mod = dwo.name + '.Tooltip.Tip = "' + ls_value + '"'
						ls_err = this.modify(ls_mod)
					ELSE
						ls_mod = dwo.name + '.Tooltip.Tip = ""'
						ls_err = this.modify(ls_mod)
					END IF
				END IF
				  
			ELSEIF (ll_colXW >  ll_hScrollPos) AND (ll_colXW > (ll_width + ll_hScrollPos) ) THEN 
				// Partially Visible Right 
				// get the text value and its length
				lstr_bubble = idw.uf_get_width_of_data(row, dwo.name, ldw, iw_parent)
				ll_textwidth = lstr_bubble.i_width
				ls_value = lstr_bubble.s_value
				ls_mod = dwo.name + '.Alignment'
				ls_alignment = this.describe(ls_mod)
				IF ls_alignment = '0' THEN // left alighment
					IF ll_textwidth > ll_colw THEN // text wider than column
						ls_mod = dwo.name + '.Tooltip.Tip = "' + ls_value + '"'
						ls_err = this.modify(ls_mod)
					ELSEIF ll_width + ll_hScrollPos - ll_colX < ll_textwidth + Round((ll_textwidth / 10), 0) THEN  
						// text cut off by datawindow control or scrollbar
						ls_mod = dwo.name + '.Tooltip.Tip = "' + ls_value + '"'
						ls_err = this.modify(ls_mod)
					ELSE
						ls_mod = dwo.name + '.Tooltip.Tip = ""'
						ls_err = this.modify(ls_mod)
					END IF
				ELSE
					IF ll_textwidth > ll_colw THEN // text wider than column width
						ls_mod = dwo.name + '.Tooltip.Tip = "' + ls_value + '"'
						ls_err = this.modify(ls_mod)
					ELSEIF ll_textwidth > (ll_colW - (ll_width + ll_hScrollPos)) THEN 
						// text cut off by datawindow control or scrollbar
						ls_mod = dwo.name + '.Tooltip.Tip = "' + ls_value + '"'
						ls_err = this.modify(ls_mod)
					ELSE
						ls_mod = dwo.name + '.Tooltip.Tip = ""'
						ls_err = this.modify(ls_mod)
					END IF
				END IF
			 ELSE
				// "Visible"			
				// this could be modifed for grid columns resized smaller than text value
				ls_mod = dwo.name + '.Tooltip.Tip = ""'
				ls_err = this.modify(ls_mod)
			 END IF
		END IF
	END IF	
	is_curcol = dwo.Name + '/' + string(row)
END IF

Thanks to Adam Simmonds for his assistance on this.

First the external function declaration:

FUNCTION int GetModuleFileNameW(&
           ulong hinstModule, &
           REF string lpszPath, &
           ulong cchPath) LIBRARY "kernel32"
// or for those of you way back in time

FUNCTION int GetModuleFileNameA(&
           ulong hinstModule, &
           REF string lpszPath, &
           ulong cchPath) LIBRARY "kernel32"

Now in your script do the following:

string ls_Path
unsignedlong lul_handle

ls_Path = space(1024)

lul_handle = Handle(GetApplication())
GetModuleFilenameW(lul_handle, ls_Path, 1024)// or GetModuleFilenameA if appropriate

You can use the PFC fileservice to easily strip off the exe name from ls_path or do it yourself.

Set up some sort of global application object. The PFC application object is a prime example of this. Here we will use ‘gnv_app’.

Declare a couple of instance variables on the object. Something like

>boolean ib_inPB
application iapp_object

In the open event of your main window you can then do:

 gnv_app.iapp_object = GetApplication()
gnv_app.ib_inPB = (handle(nv_app.iapp_object) = 0)

From Powerbuilder Help:
“As far as Windows is concerned, your application does not have a handle when it is run from PowerBuilder. When you build and run an executable version of your application, the Handle function returns a valid handle for the application.”

Now you can implement your development code inside an “IF gnv_app.ib_inpb THEN…” block.

The basic process makes use of two windows API calls: AddFontResource and RemoveFontResource. The declarations are as follows (both ANSI and Unicode):

Function int AddFontResourceA(string lpFileName) library "gdi32.dll"
Function int AddFontResourceW(string lpFileName) library "gdi32.dll"
Function int RemoveFontResourceA(string lpFileName) library "gdi32.dll"
Function int RemoveFontResourceW(string lpFileName) library "gdi32.dll"

To demonstrate the techniques, I’ve created a sample application.

In the ‘Load Fonts’ button clicked event there is the following:

integer li_fonts, li_i
long	ll_row
OLEObject lole_word, lole_fonts
string ls_file_name
dw_1.reset() // clear existing entries

lole_word = CREATE oleobject
lole_fonts = CREATE oleobject
TRY
	lole_word.connecttonewobject('word.application')
CATCH (runtimeerror a)
	Messagebox('Error','Error connecting with MS Word. Process terminating.')
	RETURN -1
END TRY
lole_word.visible = FALSE // dont want to see word
lole_fonts = lole_word.fontnames
li_fonts = lole_fonts.count
// build font list in datawindow
FOR li_i = 1 to li_fonts
	ll_row = dw_1.insertrow(0)
	dw_1.setitem(ll_row,'fontname',lole_fonts.item(li_i))
NEXT
dw_1.sort()
lole_word.quit() // close word
DESTROY lole_fonts
DESTROY lole_word

This uses OLE with MS Word to retrieve the list of font names installed on the system.

There is a font file included with the example which can be used as the temporary font in the demonstration. Run the application and click on the ‘Select Font File’ button to choose this file.

Now click the ‘Add Font’ button. The font’s name and a sample of it should appear in the appropriate fields.

If you click the ‘Load Fonts’ button again you will see the new font name in the list.

Finally, click the ‘Remove Font’ button to remove it. The ‘New Font Example’ text will now revert.

If you click the ‘Load Fonts’ button again you will see the new font name has been removed from the list.

The zip archive containing the PB files, exports, and the sample font file can be downloaded here.

Anyway, the functionality is encapsulated in an nvo and involves three API external functions.

FUNCTION ulong GetPixel(ulong hwnd, long xpos, long ypos) LIBRARY "Gdi32.dll"
// get device context - required for graphic stuff
FUNCTION ulong GetDC(long hwnd) LIBRARY "user32.dll"
FUNCTION long ReleaseDC (long hwnd, ulong hDC) LIBRARY "user32.dll"

The function is called of_get_color. It accepts a dragobject by reference.

long ll_xpos, ll_ypos
ulong ul_rtn
ulong ul_handle, ul_device
// get handle
ul_handle = handle(a_object)
ul_device = GetDC(ul_handle)
// get position of pointer
ll_xpos = UnitsToPixels(a_object.PointerX(), XUnitsToPixels!)
ll_ypos = UnitsToPixels(a_object.PointerY(), YUnitsToPixels!)

ul_rtn = GetPixel(ul_device, ll_xpos, ll_ypos)
ReleaseDC( ul_handle, ul_device)

RETURN ul_rtn

On the window there is an event which is triggered when the user clicks on an appropriate object.

int li_r, li_b, li_g
ulong lul_color
n_pixelcolor lnv_color
lul_color =  lnv_color.of_get_color(a_object)
//max value of unsigned long indicates error
IF lul_color = 4294967295 THEN
	r_1.fillcolor = 0
	st_ul.text = 'Invalid Color'
	st_rgb.text = ''
	RETURN
END IF
// get RGB values
li_r = mod(lul_color,256)
li_g = mod((lul_color / 256), 256)
li_b = mod ((lul_color / 65536), 256)

st_ul.text = 'U Long: ' + string(lul_color)
st_rgb.text = 'RGB( ' + string(li_r) + ', ' + string(li_g) + ', ' + string(li_b) + ')'
st_rgb.textcolor = RGB(li_r,li_g,li_b) //just to prove the values are correct
r_1.fillcolor = lul_color

The window displays the color value as well as its derived RGB values.

Pixel Color App

Color clicked on.

The code is in PB11.5.1. A zip file with the .pbl and appropriate exports can be found here.

Special thanks to Roland Smith of TeamSybase.