Some combinations are not intercepted by keypress.
Some are intercepted only by the form's keypress (like the ALT+letter) but not by the object's keypress.
Also the menu's shortcuts can be ignored (like CTRL+A).
I wrote a little more about keypress here:
https://www.foxite.com/archives/keypress-and-dodefault-for-textbox-0000412653.htm
In this case, CTRL+SHIFT+ENTER is used to run an executable as administrator.
Maybe this is the reason for not being intercepted by neither the form's, nor the object's keypress()
To intercept it, the wm_keyup message must be bind to the form's hwnd, and then the GetKeyState() function must be called.
If the highest bit of the returned value of GetKeyState() is equal to 1, then the key passed as parameter was pressed (CTRL or Shift)
I wrote a little more about binding wm_keyup message, here
http://praisachion.blogspot.ro/2015/06/detect-keyup-like-mouseup.html
Here is the solution for intercepting CTRL+SHIFT+Enter.
DECLARE integer GetKeyState IN User32 integer
#define VK_RETURN 0x0d && Enter
#define VK_SHIFT 0x10 && Shift
#define VK_CONTROL 0x11 && Control
#define VK_LSHIFT 0xa0 && Left Shift
#define VK_RSHIFT 0xa1 && Right Shift
#define VK_LCONTROL 0xa2 && Left CTRL
#define VK_RCONTROL 0xa3 && Right CTRL
PUBLIC ofrm
ofrm = CREATEOBJECT("MyForm")
ofrm.show()
DEFINE CLASS MyForm as Form
ADD OBJECT txt as textbox && the desired object
ADD OBJECT cmd as commandbutton WITH top = 50
PROCEDURE Init
BINDEVENT(This.HWnd,0x0101,This,"detectkeyup") && intercept keyup
ENDPROC
PROCEDURE detectkeyup
LPARAMETERS p1,p2,p3,p4
IF TYPE("This.ActiveControl") <> "U"
IF This.ActiveControl = ThisForm.txt AND p3 = VK_RETURN AND BITTEST(GetKeyState(VK_SHIFT),7) AND BITTEST(GetKeyState(VK_CONTROL),7)
* p3 = VK_RETURN && 13 enter
* place here the desired code
* in this sample just type to the screen which shift and control (left or right) was pressed
ACTIVATE SCREEN
?BITTEST(GetKeyState(VK_LSHIFT),7),BITTEST(GetKeyState(VK_LCONTROL),7),BITTEST(GetKeyState(VK_RSHIFT),7),BITTEST(GetKeyState(VK_RCONTROL),7)
ENDIF
ENDIF
ENDPROC
ENDDEFINE
Please read
https://msdn.microsoft.com/en-us/library/windows/desktop/ms646301%28v=vs.85%29.aspx
https://docs.omniref.com/ruby/gems/win32-autogui/0.5.0/symbols/Autogui::Input::VK_LSHIFT
https://msdn.microsoft.com/en-us/library/windows/desktop/ms646281%28v=vs.85%29.aspx
Related posts
http://praisachion.blogspot.com/2017/08/easter-eggs-4.html
http://praisachion.blogspot.com/2017/08/easter-eggs-3.html
http://praisachion.blogspot.com/2017/08/easter-eggs-2.html
http://praisachion.blogspot.com/2017/08/easter-eggs-1.html
http://praisachion.blogspot.com/2016/02/interceptin-ctrlshiftenter.html
http://praisachion.blogspot.com/2015/06/detect-keyup-like-mouseup.html
http://praisachion.blogspot.com/2015/01/how-can-i-prevent-undocking-docked-form.html
Faceți căutări pe acest blog
Se afișează postările cu eticheta API. Afișați toate postările
Se afișează postările cu eticheta API. Afișați toate postările
sâmbătă, 20 februarie 2016
miercuri, 19 august 2015
Changing the color of grid's HighlightRowLine
The selected row of a Grid is emphasized with a border around it.
The thickness can be controlled with the grid's HighlightRowLineWidth property.
But there is no HighlightRowLineColor property, and this color is given by the OS's "Selected Items" color.
In Windows 7 can be accessed this way :
Control Panel -> Personalization -> Window Color -> Selected Items (chosen from the combobox)
In Windows 10, I haven't found yet where it can be (I suppose lies in some registry key).
But a small VFP code can help you :
************
* Begin Code
************
Declare integer SetSysColors in user32 integer, string, string
lnNewColor = 255
setsyscolors(1,BINTOC(13,'4RS'),BINTOC(m.lnNewColor,'4RS')) && 1 means a single color would be changed; 13 is the numeric code for Selected Item
************
* End Code
************
Here is a more complete code
************
* Begin Code
************
Declare integer GetSysColor in user32 integer
Declare integer SetSysColors in user32 integer, string, string
LOCAL lnNewColor,lnOldColor
lnOldColor = GetSysColor(13) && store the old color
lnNewColor = 255
setsyscolors(1,BINTOC(13,'4RS'),BINTOC(m.lnNewColor,'4RS')) && set new color
DO FORM MyFormContainingTheGrid && verify the grid
setsyscolors(1,BINTOC(13,'4RS'),BINTOC(m.lnOldColor,'4RS')) && restore the old color
************
* End Code
************
GetSysColor
SetSysColor
Another VFP example for GetSysColor and SetSysColor
The thickness can be controlled with the grid's HighlightRowLineWidth property.
But there is no HighlightRowLineColor property, and this color is given by the OS's "Selected Items" color.
In Windows 7 can be accessed this way :
Control Panel -> Personalization -> Window Color -> Selected Items (chosen from the combobox)
In Windows 10, I haven't found yet where it can be (I suppose lies in some registry key).
But a small VFP code can help you :
************
* Begin Code
************
Declare integer SetSysColors in user32 integer, string, string
lnNewColor = 255
setsyscolors(1,BINTOC(13,'4RS'),BINTOC(m.lnNewColor,'4RS')) && 1 means a single color would be changed; 13 is the numeric code for Selected Item
************
* End Code
************
Here is a more complete code
************
* Begin Code
************
Declare integer GetSysColor in user32 integer
Declare integer SetSysColors in user32 integer, string, string
LOCAL lnNewColor,lnOldColor
lnOldColor = GetSysColor(13) && store the old color
lnNewColor = 255
setsyscolors(1,BINTOC(13,'4RS'),BINTOC(m.lnNewColor,'4RS')) && set new color
DO FORM MyFormContainingTheGrid && verify the grid
setsyscolors(1,BINTOC(13,'4RS'),BINTOC(m.lnOldColor,'4RS')) && restore the old color
************
* End Code
************
GetSysColor
SetSysColor
Another VFP example for GetSysColor and SetSysColor
duminică, 14 iunie 2015
Enable / disable form's scrollbars
The EnableScrollBar API allows to enable or disable scrollbars.
It can be enabled or disabled all of them or only some of them.
The documentation claims that the minimum OS must be Vista.
***************
* Begin code
***************
# DEFINE SB_BOTH 3
# DEFINE SB_HORZ 0
# DEFINE SB_VERT 1
# DEFINE ESB_DISABLE_BOTH 3
# DEFINE ESB_DISABLE_DOWN 2
# DEFINE ESB_DISABLE_LEFT 1
# DEFINE ESB_DISABLE_LTUP 1
# DEFINE ESB_DISABLE_RIGHT 2
# DEFINE ESB_DISABLE_RTDN 2
# DEFINE ESB_DISABLE_UP 1
# DEFINE ESB_ENABLE_BOTH 0
DECLARE INTEGER EnableScrollBar IN user32 INTEGER hwnd, INTEGER wSBflags, INTEGER wArrows
PUBLIC ofrm
ofrm = CREATEOBJECT("MyForm")
ofrm.show()
DEFINE CLASS myform as Form
scrollbars = 3
ADD OBJECT edt as editbox WITH left=100,top=100,width=400,height=400,value=REPLICATE("Disco, Duhamel"+CHR(13),40)
ADD OBJECT chk as checkbox WITH value=.T.,caption='Enabled'
PROCEDURE chk.interactivechange
IF This.Value
EnableScrollBar(ThisForm.HWnd,SB_BOTH,ESB_ENABLE_BOTH)
ELSE
EnableScrollBar(ThisForm.HWnd,SB_BOTH,ESB_DISABLE_BOTH )
ENDIF
ENDPROC
ENDDEFINE
***************
* End code
***************
Biblio
http://www.cs.uofs.edu/~beidler/Ada/win32/win32-winuser.html
https://msdn.microsoft.com/en-us/library/windows/desktop/bb787579%28v=vs.85%29.aspx
It can be enabled or disabled all of them or only some of them.
The documentation claims that the minimum OS must be Vista.
***************
* Begin code
***************
# DEFINE SB_BOTH 3
# DEFINE SB_HORZ 0
# DEFINE SB_VERT 1
# DEFINE ESB_DISABLE_BOTH 3
# DEFINE ESB_DISABLE_DOWN 2
# DEFINE ESB_DISABLE_LEFT 1
# DEFINE ESB_DISABLE_LTUP 1
# DEFINE ESB_DISABLE_RIGHT 2
# DEFINE ESB_DISABLE_RTDN 2
# DEFINE ESB_DISABLE_UP 1
# DEFINE ESB_ENABLE_BOTH 0
DECLARE INTEGER EnableScrollBar IN user32 INTEGER hwnd, INTEGER wSBflags, INTEGER wArrows
PUBLIC ofrm
ofrm = CREATEOBJECT("MyForm")
ofrm.show()
DEFINE CLASS myform as Form
scrollbars = 3
ADD OBJECT edt as editbox WITH left=100,top=100,width=400,height=400,value=REPLICATE("Disco, Duhamel"+CHR(13),40)
ADD OBJECT chk as checkbox WITH value=.T.,caption='Enabled'
PROCEDURE chk.interactivechange
IF This.Value
EnableScrollBar(ThisForm.HWnd,SB_BOTH,ESB_ENABLE_BOTH)
ELSE
EnableScrollBar(ThisForm.HWnd,SB_BOTH,ESB_DISABLE_BOTH )
ENDIF
ENDPROC
ENDDEFINE
***************
* End code
***************
Biblio
http://www.cs.uofs.edu/~beidler/Ada/win32/win32-winuser.html
https://msdn.microsoft.com/en-us/library/windows/desktop/bb787579%28v=vs.85%29.aspx
Using GetLocaleInfo and GetLocaleInfoEx for currencies (3) HTML example
In a similar way, a HTML document can be created.
First, the GetLocaleInfo example.
****************
* Begin code
****************
Declare INTEGER GetLocaleInfo in Win32API LONG Locale, LONG LCType, STRING @LpLCData, INTEGER cchData
LOCAL LpLCData,cchData,nretval,lni,lcPos,lcSetPoint,lcPoint,lcSetSep,lcSep,lcSetDec,lcDec,lcNumber,lcCurr,lcStr
LpLCData = space(255) && Address of buffer information.
cchData = LEN(LpLCData) && Size of buffer, LpLCData.
nretval = 0 && Number returned from API call.
RAND(-1)
**************
lcSetPoint = SET("Point")
lcSetSep = SET("Separator")
lcSetDec = SET("Decimals")
*
nretval = GetLocaleInfo(1024, 0x16, @LpLCData, cchData)
lcPoint = LEFT(LpLCData,nretval-1)
SET POINT TO lcPoint
nretval = GetLocaleInfo(1024, 0x17, @LpLCData, cchData)
lcSep = LEFT(LpLCData,nretval-1)
SET SEPARATOR TO lcSep
nretval = GetLocaleInfo(1024, 0x19, @LpLCData, cchData)
lcDec = LEFT(LpLCData,nretval-1)
SET DECIMALS TO &lcDec
nretval = GetLocaleInfo(1024, 0x14, @LpLCData, cchData)
lcCurr = LEFT(LpLCData,nretval-1)
nretval = GetLocaleInfo(1024, 0x1B, @LpLCData, cchData)
lcPos = LEFT(LpLCData,nretval-1)
lcNumber = ALLTRIM(TRANSFORM(1000000 * RAND(),"###" + REPLICATE(",###" , 4) + "." + REPLICATE("9",VAL(m.lcDec))))
lcStr = [<!DOCTYPE html><html><body>]
DO CASE
CASE lcPos = "0"
lcStr = m.lcStr + m.lcCurr + m.lcNumber
CASE lcPos = "1"
lcStr = m.lcStr + m.lcNumber + m.lcCurr
CASE lcPos = "2"
lcStr = m.lcStr + m.lcCurr + " " + m.lcNumber
CASE lcPos = "3"
lcStr = m.lcStr + m.lcNumber + " " + m.lcCurr
ENDCASE
lcStr = m.lcStr + [</body></html>]
STRTOFILE(m.lcStr,"test.htm")
SET POINT TO lcSetPoint
SET SEPARATOR TO lcSetSep
SET DECIMALS TO &lcSetDec
****************
* End code
****************
Obviously, because of Unicode the GetLocaleInfoEx example is a little more complicated.
Note the reversed order of the two UNICODE bytes, between Word and HTML
****************
* Begin code
****************
Declare INTEGER GetLocaleInfoEx in Win32API String Locale, LONG LCType, STRING @LpLCData, INTEGER cchData
LOCAL LpLCData,cchData,nretval,lni,lcPos,lcSetPoint,lcPoint,lcSetSep,lcSep,lcSetDec,lcDec,lcNumber,lcCurrh,lcStrex
LpLCData = space(255) && Address of buffer information.
cchData = LEN(LpLCData) && Size of buffer, LpLCData.
nretval = 0 && Number returned from API call.
RAND(-1)
**************
lcSetPoint = SET("Point")
lcSetSep = SET("Separator")
lcSetDec = SET("Decimals")
*
nretval = GetLocaleInfoEx(Null, 0x16, @LpLCData, cchData)
lcPoint = LEFT(LpLCData,nretval-1)
SET POINT TO lcPoint
nretval = GetLocaleInfoEx(Null, 0x17, @LpLCData, cchData)
lcSep = LEFT(LpLCData,nretval-1)
SET SEPARATOR TO lcSep
nretval = GetLocaleInfoEx(Null, 0x19, @LpLCData, cchData)
lcDec = LEFT(LpLCData,nretval-1)
SET DECIMALS TO &lcDec
nretval = GetLocaleInfoEx(Null, 0x14, @LpLCData, cchData)
lcCurrh = ""
FOR lni = 1 TO nretval-1
lcCurrh = m.lcCurrh + "&#x" + RIGHT(TRANSFORM(ASC(SUBSTR(LpLCData,2*lni)),"@0"),2) + RIGHT(TRANSFORM(ASC(SUBSTR(LpLCData,2*lni-1)),"@0"),2) + ";"
NEXT
nretval = GetLocaleInfoEx(Null, 0x1B, @LpLCData, cchData)
lcPos = LEFT(LpLCData,nretval-1)
lcNumber = ALLTRIM(TRANSFORM(1000000 * RAND(),"###" + REPLICATE(",###" , 4) + "." + REPLICATE("9",VAL(m.lcDec))))
lcStrex = [<!DOCTYPE html><html><body>]
DO CASE
CASE lcPos = "0"
lcStrex = m.lcStrex + m.lcCurrh + m.lcNumber
CASE lcPos = "1"
lcStrex = m.lcStrex + m.lcNumber + m.lcCurrh
CASE lcPos = "2"
lcStrex = m.lcStrex + m.lcCurrh + " " + m.lcNumber
CASE lcPos = "3"
lcStrex = m.lcStrex + m.lcNumber + " " + m.lcCurrh
ENDCASE
lcStrex = m.lcStrex + [</body></html>]
STRTOFILE(m.lcStrex,"testex.htm")
SET POINT TO lcSetPoint
SET SEPARATOR TO lcSetSep
SET DECIMALS TO &lcSetDec
****************
* End code
****************
Related posts
http://praisachion.blogspot.com/2015/06/using-getlocaleinfo-and-getlocaleinfoex_79.html
http://praisachion.blogspot.com/2015/06/using-getlocaleinfo-and-getlocaleinfoex_14.html
http://praisachion.blogspot.com/2015/06/using-getlocaleinfo-and-getlocaleinfoex.html
First, the GetLocaleInfo example.
****************
* Begin code
****************
Declare INTEGER GetLocaleInfo in Win32API LONG Locale, LONG LCType, STRING @LpLCData, INTEGER cchData
LOCAL LpLCData,cchData,nretval,lni,lcPos,lcSetPoint,lcPoint,lcSetSep,lcSep,lcSetDec,lcDec,lcNumber,lcCurr,lcStr
LpLCData = space(255) && Address of buffer information.
cchData = LEN(LpLCData) && Size of buffer, LpLCData.
nretval = 0 && Number returned from API call.
RAND(-1)
**************
lcSetPoint = SET("Point")
lcSetSep = SET("Separator")
lcSetDec = SET("Decimals")
*
nretval = GetLocaleInfo(1024, 0x16, @LpLCData, cchData)
lcPoint = LEFT(LpLCData,nretval-1)
SET POINT TO lcPoint
nretval = GetLocaleInfo(1024, 0x17, @LpLCData, cchData)
lcSep = LEFT(LpLCData,nretval-1)
SET SEPARATOR TO lcSep
nretval = GetLocaleInfo(1024, 0x19, @LpLCData, cchData)
lcDec = LEFT(LpLCData,nretval-1)
SET DECIMALS TO &lcDec
nretval = GetLocaleInfo(1024, 0x14, @LpLCData, cchData)
lcCurr = LEFT(LpLCData,nretval-1)
nretval = GetLocaleInfo(1024, 0x1B, @LpLCData, cchData)
lcPos = LEFT(LpLCData,nretval-1)
lcNumber = ALLTRIM(TRANSFORM(1000000 * RAND(),"###" + REPLICATE(",###" , 4) + "." + REPLICATE("9",VAL(m.lcDec))))
lcStr = [<!DOCTYPE html><html><body>]
DO CASE
CASE lcPos = "0"
lcStr = m.lcStr + m.lcCurr + m.lcNumber
CASE lcPos = "1"
lcStr = m.lcStr + m.lcNumber + m.lcCurr
CASE lcPos = "2"
lcStr = m.lcStr + m.lcCurr + " " + m.lcNumber
CASE lcPos = "3"
lcStr = m.lcStr + m.lcNumber + " " + m.lcCurr
ENDCASE
lcStr = m.lcStr + [</body></html>]
STRTOFILE(m.lcStr,"test.htm")
SET POINT TO lcSetPoint
SET SEPARATOR TO lcSetSep
SET DECIMALS TO &lcSetDec
****************
* End code
****************
Obviously, because of Unicode the GetLocaleInfoEx example is a little more complicated.
Note the reversed order of the two UNICODE bytes, between Word and HTML
****************
* Begin code
****************
Declare INTEGER GetLocaleInfoEx in Win32API String Locale, LONG LCType, STRING @LpLCData, INTEGER cchData
LOCAL LpLCData,cchData,nretval,lni,lcPos,lcSetPoint,lcPoint,lcSetSep,lcSep,lcSetDec,lcDec,lcNumber,lcCurrh,lcStrex
LpLCData = space(255) && Address of buffer information.
cchData = LEN(LpLCData) && Size of buffer, LpLCData.
nretval = 0 && Number returned from API call.
RAND(-1)
**************
lcSetPoint = SET("Point")
lcSetSep = SET("Separator")
lcSetDec = SET("Decimals")
*
nretval = GetLocaleInfoEx(Null, 0x16, @LpLCData, cchData)
lcPoint = LEFT(LpLCData,nretval-1)
SET POINT TO lcPoint
nretval = GetLocaleInfoEx(Null, 0x17, @LpLCData, cchData)
lcSep = LEFT(LpLCData,nretval-1)
SET SEPARATOR TO lcSep
nretval = GetLocaleInfoEx(Null, 0x19, @LpLCData, cchData)
lcDec = LEFT(LpLCData,nretval-1)
SET DECIMALS TO &lcDec
nretval = GetLocaleInfoEx(Null, 0x14, @LpLCData, cchData)
lcCurrh = ""
FOR lni = 1 TO nretval-1
lcCurrh = m.lcCurrh + "&#x" + RIGHT(TRANSFORM(ASC(SUBSTR(LpLCData,2*lni)),"@0"),2) + RIGHT(TRANSFORM(ASC(SUBSTR(LpLCData,2*lni-1)),"@0"),2) + ";"
NEXT
nretval = GetLocaleInfoEx(Null, 0x1B, @LpLCData, cchData)
lcPos = LEFT(LpLCData,nretval-1)
lcNumber = ALLTRIM(TRANSFORM(1000000 * RAND(),"###" + REPLICATE(",###" , 4) + "." + REPLICATE("9",VAL(m.lcDec))))
lcStrex = [<!DOCTYPE html><html><body>]
DO CASE
CASE lcPos = "0"
lcStrex = m.lcStrex + m.lcCurrh + m.lcNumber
CASE lcPos = "1"
lcStrex = m.lcStrex + m.lcNumber + m.lcCurrh
CASE lcPos = "2"
lcStrex = m.lcStrex + m.lcCurrh + " " + m.lcNumber
CASE lcPos = "3"
lcStrex = m.lcStrex + m.lcNumber + " " + m.lcCurrh
ENDCASE
lcStrex = m.lcStrex + [</body></html>]
STRTOFILE(m.lcStrex,"testex.htm")
SET POINT TO lcSetPoint
SET SEPARATOR TO lcSetSep
SET DECIMALS TO &lcSetDec
****************
* End code
****************
Related posts
http://praisachion.blogspot.com/2015/06/using-getlocaleinfo-and-getlocaleinfoex_79.html
http://praisachion.blogspot.com/2015/06/using-getlocaleinfo-and-getlocaleinfoex_14.html
http://praisachion.blogspot.com/2015/06/using-getlocaleinfo-and-getlocaleinfoex.html
Using GetLocaleInfo and GetLocaleInfoEx for currencies (2) Word automation example
The information given by GetLocaleInfo and GetLocaleInfoEx, can be used to write formatted numbers in Word, using automation.
The first example use GetLocaleInfo
Because the values returned by GetLocaleInfo are ASCII, it's easy to use them.
****************
* Begin code
****************
Declare INTEGER GetLocaleInfo in Win32API LONG Locale, LONG LCType, STRING @LpLCData, INTEGER cchData
LOCAL LpLCData,cchData,nretval,lni,lcCurr,lcPos,lcSetPoint,lcPoint,lcSetSep,lcSep,lcSetDec,lcDec,lcNumber,oWrd,oDoc,oRange
LCData = space(255) && Address of buffer information.
cchData = LEN(LpLCData) && Size of buffer, LpLCData.
nretval = 0 && Number returned from API call.
RAND(-1)
**************
lcSetPoint = SET("Point")
lcSetSep = SET("Separator")
lcSetDec = SET("Decimals")
oWrd = CREATEOBJECT("Word.application")
oDoc = oWrd.documents.add()
orange=odoc.range()
*
nretval = GetLocaleInfo(1024, 0x16, @LpLCData, cchData)
lcPoint = LEFT(LpLCData,nretval-1)
SET POINT TO lcPoint
nretval = GetLocaleInfo(1024, 0x17, @LpLCData, cchData)
lcSep = LEFT(LpLCData,nretval-1)
SET SEPARATOR TO lcSep
nretval = GetLocaleInfo(1024, 0x19, @LpLCData, cchData)
lcDec = LEFT(LpLCData,nretval-1)
SET DECIMALS TO &lcDec
nretval = GetLocaleInfo(1024, 0x14, @LpLCData, cchData)
lcCurr = LEFT(LpLCData,nretval-1)
nretval = GetLocaleInfo(1024, 0x1B, @LpLCData, cchData)
lcPos = LEFT(LpLCData,nretval-1)
lcNumber = ALLTRIM(TRANSFORM(1000000 * RAND(),"###" + REPLICATE(",###" , 4) + "." + REPLICATE("9",VAL(m.lcDec))))
DO CASE
CASE lcPos = "0"
orange.text = m.lcCurr + m.lcNumber
CASE lcPos = "1"
orange.text = m.lcNumber + m.lcCurr
CASE lcPos = "2"
orange.text = m.lcCurr + " " + m.lcNumber
CASE lcPos = "3"
orange.text = m.lcNumber + " " + m.lcCurr
ENDCASE
oWrd.visible = .T.
SET POINT TO lcSetPoint
SET SEPARATOR TO lcSetSep
SET DECIMALS TO &lcSetDec
****************
* End code
****************
The second example use GetLocaleInfoEx
Because the values returned by GetLocaleInfoEx are UNICODE, it's a little more complicated.
Each UNICODE character has two bytes, and to because it's easier to insert strings into Word, I build up a blob constant.
****************
* Begin code
****************
Declare INTEGER GetLocaleInfoEx in Win32API String Locale, LONG LCType, STRING @LpLCData, INTEGER cchData
LOCAL LpLCData,cchData,nretval,lni,lcCurr,lcPos,lcSetPoint,lcPoint,lcSetSep,lcSep,lcSetDec,lcDec,lcNumber,oWrd,oDoc,oRange
LCData = space(255) && Address of buffer information.
cchData = LEN(LpLCData) && Size of buffer, LpLCData.
nretval = 0 && Number returned from API call.
RAND(-1)
**************
lcSetPoint = SET("Point")
lcSetSep = SET("Separator")
lcSetDec = SET("Decimals")
oWrd = CREATEOBJECT("Word.application")
oDoc = oWrd.documents.add()
orange=odoc.range()
*
nretval = GetLocaleInfoEx(Null, 0x16, @LpLCData, cchData)
lcPoint = LEFT(LpLCData,nretval-1)
SET POINT TO lcPoint
nretval = GetLocaleInfoEx(Null, 0x17, @LpLCData, cchData)
lcSep = LEFT(LpLCData,nretval-1)
SET SEPARATOR TO lcSep
nretval = GetLocaleInfoEx(Null, 0x19, @LpLCData, cchData)
lcDec = LEFT(LpLCData,nretval-1)
SET DECIMALS TO &lcDec
nretval = GetLocaleInfoEx(Null, 0x14, @LpLCData, cchData)
lcCurr = "0h"
FOR lni = 1 TO nretval-1
lcCurr = m.lcCurr + RIGHT(TRANSFORM(ASC(SUBSTR(LpLCData,2*lni-1)),"@0"),2) + RIGHT(TRANSFORM(ASC(SUBSTR(LpLCData,2*lni)),"@0"),2)
NEXT
nretval = GetLocaleInfoEx(Null, 0x1B, @LpLCData, cchData)
lcPos = LEFT(LpLCData,nretval-1)
lcNumber = ALLTRIM(TRANSFORM(1000000 * RAND(),"###" + REPLICATE(",###" , 4) + "." + REPLICATE("9",VAL(m.lcDec))))
DO CASE
CASE lcPos = "0"
orange.text = EVALUATE(m.lcCurr)
orange.insertafter(m.lcNumber)
CASE lcPos = "1"
orange.text = m.lcNumber
orange.insertafter(EVALUATE(m.lcCurr))
CASE lcPos = "2"
orange.text = EVALUATE(m.lcCurr)
orange.insertafter(" " + m.lcNumber)
CASE lcPos = "3"
orange.text = m.lcNumber + " "
orange.insertafter(EVALUATE(m.lcCurr))
ENDCASE
oWrd.visible = .T.
SET POINT TO lcSetPoint
SET SEPARATOR TO lcSetSep
SET DECIMALS TO &lcSetDec
****************
* End code
****************
Related posts
http://praisachion.blogspot.com/2015/06/using-getlocaleinfo-and-getlocaleinfoex_79.html
http://praisachion.blogspot.com/2015/06/using-getlocaleinfo-and-getlocaleinfoex_14.html
http://praisachion.blogspot.com/2015/06/using-getlocaleinfo-and-getlocaleinfoex.html
The first example use GetLocaleInfo
Because the values returned by GetLocaleInfo are ASCII, it's easy to use them.
****************
* Begin code
****************
Declare INTEGER GetLocaleInfo in Win32API LONG Locale, LONG LCType, STRING @LpLCData, INTEGER cchData
LOCAL LpLCData,cchData,nretval,lni,lcCurr,lcPos,lcSetPoint,lcPoint,lcSetSep,lcSep,lcSetDec,lcDec,lcNumber,oWrd,oDoc,oRange
LCData = space(255) && Address of buffer information.
cchData = LEN(LpLCData) && Size of buffer, LpLCData.
nretval = 0 && Number returned from API call.
RAND(-1)
**************
lcSetPoint = SET("Point")
lcSetSep = SET("Separator")
lcSetDec = SET("Decimals")
oWrd = CREATEOBJECT("Word.application")
oDoc = oWrd.documents.add()
orange=odoc.range()
*
nretval = GetLocaleInfo(1024, 0x16, @LpLCData, cchData)
lcPoint = LEFT(LpLCData,nretval-1)
SET POINT TO lcPoint
nretval = GetLocaleInfo(1024, 0x17, @LpLCData, cchData)
lcSep = LEFT(LpLCData,nretval-1)
SET SEPARATOR TO lcSep
nretval = GetLocaleInfo(1024, 0x19, @LpLCData, cchData)
lcDec = LEFT(LpLCData,nretval-1)
SET DECIMALS TO &lcDec
nretval = GetLocaleInfo(1024, 0x14, @LpLCData, cchData)
lcCurr = LEFT(LpLCData,nretval-1)
nretval = GetLocaleInfo(1024, 0x1B, @LpLCData, cchData)
lcPos = LEFT(LpLCData,nretval-1)
lcNumber = ALLTRIM(TRANSFORM(1000000 * RAND(),"###" + REPLICATE(",###" , 4) + "." + REPLICATE("9",VAL(m.lcDec))))
DO CASE
CASE lcPos = "0"
orange.text = m.lcCurr + m.lcNumber
CASE lcPos = "1"
orange.text = m.lcNumber + m.lcCurr
CASE lcPos = "2"
orange.text = m.lcCurr + " " + m.lcNumber
CASE lcPos = "3"
orange.text = m.lcNumber + " " + m.lcCurr
ENDCASE
oWrd.visible = .T.
SET POINT TO lcSetPoint
SET SEPARATOR TO lcSetSep
SET DECIMALS TO &lcSetDec
****************
* End code
****************
The second example use GetLocaleInfoEx
Because the values returned by GetLocaleInfoEx are UNICODE, it's a little more complicated.
Each UNICODE character has two bytes, and to because it's easier to insert strings into Word, I build up a blob constant.
****************
* Begin code
****************
Declare INTEGER GetLocaleInfoEx in Win32API String Locale, LONG LCType, STRING @LpLCData, INTEGER cchData
LOCAL LpLCData,cchData,nretval,lni,lcCurr,lcPos,lcSetPoint,lcPoint,lcSetSep,lcSep,lcSetDec,lcDec,lcNumber,oWrd,oDoc,oRange
LCData = space(255) && Address of buffer information.
cchData = LEN(LpLCData) && Size of buffer, LpLCData.
nretval = 0 && Number returned from API call.
RAND(-1)
**************
lcSetPoint = SET("Point")
lcSetSep = SET("Separator")
lcSetDec = SET("Decimals")
oWrd = CREATEOBJECT("Word.application")
oDoc = oWrd.documents.add()
orange=odoc.range()
*
nretval = GetLocaleInfoEx(Null, 0x16, @LpLCData, cchData)
lcPoint = LEFT(LpLCData,nretval-1)
SET POINT TO lcPoint
nretval = GetLocaleInfoEx(Null, 0x17, @LpLCData, cchData)
lcSep = LEFT(LpLCData,nretval-1)
SET SEPARATOR TO lcSep
nretval = GetLocaleInfoEx(Null, 0x19, @LpLCData, cchData)
lcDec = LEFT(LpLCData,nretval-1)
SET DECIMALS TO &lcDec
nretval = GetLocaleInfoEx(Null, 0x14, @LpLCData, cchData)
lcCurr = "0h"
FOR lni = 1 TO nretval-1
lcCurr = m.lcCurr + RIGHT(TRANSFORM(ASC(SUBSTR(LpLCData,2*lni-1)),"@0"),2) + RIGHT(TRANSFORM(ASC(SUBSTR(LpLCData,2*lni)),"@0"),2)
NEXT
nretval = GetLocaleInfoEx(Null, 0x1B, @LpLCData, cchData)
lcPos = LEFT(LpLCData,nretval-1)
lcNumber = ALLTRIM(TRANSFORM(1000000 * RAND(),"###" + REPLICATE(",###" , 4) + "." + REPLICATE("9",VAL(m.lcDec))))
DO CASE
CASE lcPos = "0"
orange.text = EVALUATE(m.lcCurr)
orange.insertafter(m.lcNumber)
CASE lcPos = "1"
orange.text = m.lcNumber
orange.insertafter(EVALUATE(m.lcCurr))
CASE lcPos = "2"
orange.text = EVALUATE(m.lcCurr)
orange.insertafter(" " + m.lcNumber)
CASE lcPos = "3"
orange.text = m.lcNumber + " "
orange.insertafter(EVALUATE(m.lcCurr))
ENDCASE
oWrd.visible = .T.
SET POINT TO lcSetPoint
SET SEPARATOR TO lcSetSep
SET DECIMALS TO &lcSetDec
****************
* End code
****************
Related posts
http://praisachion.blogspot.com/2015/06/using-getlocaleinfo-and-getlocaleinfoex_79.html
http://praisachion.blogspot.com/2015/06/using-getlocaleinfo-and-getlocaleinfoex_14.html
http://praisachion.blogspot.com/2015/06/using-getlocaleinfo-and-getlocaleinfoex.html
Using GetLocaleInfo and GetLocaleInfoEx for currencies (1)
GetLocaleInfo and GetLocaleInfoEx can be used to get the local settings for currencies (the ones from Control Panel -> Regional Settings)
Both GetLocaleInfo and GetLocaleInfoEx gives plenty of informations. They can be invoked similarly, and gives similar results.
The main difference between the the functions signature is the first parameter. GetLocaleInfo have a LONG parameter, while GetLocaleInfoEx a character parameter.
GetLocaleInfo can be used in Windows XP, Vista and above. GetLocaleInfo tends to become deprecated.
GetLocaleInfoEx can be used in Windows Vista and above, but cannot be used in Windows XP.
GetLocaleInfo provide ASCII results, while GetLocaleInfoEx supports Unicode.
This means many currencies (like English India) can be obtained only with GetLocaleInfoEx.
To get the values for the default settings, the first parameter of GetLocaleInfoEx must be Null.
For other values, use the format <language> - <REGION>, but converted to Unicode
For example
StrConv ("en-AU", 5) + CHR (0)
or
StrConv ("en-US", 5) + CHR (0)
****************
* Begin code
****************
Declare INTEGER GetLocaleInfo in Win32API LONG Locale, LONG LCType, STRING @LpLCData, INTEGER cchData
Declare INTEGER GetLocaleInfoEx in Win32API String Locale, LONG LCType, STRING @LpLCData, INTEGER cchData
LOCAL LpLCData,cchData,nretval
LpLCData = space(255) && Address of buffer information.
cchData = LEN(LpLCData) && Size of buffer, LpLCData.
nretval = 0 && Number returned from API call.
? "currency symbol - user default"
LPCWSTR = Null
nretval = GetLocaleInfoEx(LPCWSTR, 0x14, @LpLCData, cchData)
?nretval,LpLCData,TRANSFORM(ASC(SUBSTR(LpLCData,2)),"@0"),TRANSFORM(ASC(LpLCData),"@0") && Euro (Unicode 0x20 0x0AC)
? "currency symbol - english - Great Britain"
LPCWSTR = STRCONV("en-GB",5)+CHR(0)
nretval = GetLocaleInfoEx(LPCWSTR, 0x14, @LpLCData, cchData)
?nretval,LpLCData,TRANSFORM(ASC(SUBSTR(LpLCData,2)),"@0"),TRANSFORM(ASC(LpLCData),"@0") && pounds (Unicode 0x000 0x0A3 ou ASCII 0xA3)
? "currency symbol"
nretval = GetLocaleInfo(1024, 0x14, @LpLCData, cchData)
?nretval,LEFT(LpLCData,nretval-1)
nretval = GetLocaleInfoEx(Null, 0x14, @LpLCData, cchData)
?nretval
FOR lni = 1 TO nretval-1
?? TRANSFORM(ASC(SUBSTR(LpLCData,2*lni)),"@0"),TRANSFORM(ASC(SUBSTR(LpLCData,2*lni-1)),"@0")
NEXT
? "currency position"
nretval = GetLocaleInfoEx(Null, 0x1B, @LpLCData, cchData)
?nretval,LpLCData
? "decimal separator"
nretval = GetLocaleInfoEx(Null, 0x16, @LpLCData, cchData)
?nretval,LpLCData
? "thousand separator"
nretval = GetLocaleInfoEx(Null, 0x17, @LpLCData, cchData)
?nretval,LpLCData
? "number of decimals"
nretval = GetLocaleInfoEx(Null, 0x19, @LpLCData, cchData)
?nretval,LpLCData
****************
* End code
****************
Biblio
http://www.foxite.com/archives/getlocaleinfoex-fountain-of-knowledge-0000424218.htm
ftp://ftp.microsoft.com/misc1/DEVELOPR/FOX/KB/Q177/1/46.TXT
https://msdn.microsoft.com/en-us/library/windows/desktop/dd318103%28v=vs.85%29.aspx
https://msdn.microsoft.com/en-us/library/windows/desktop/dd318101%28v=vs.85%29.aspx
https://msdn.microsoft.com/en-us/library/windows/desktop/dd464799%28v=vs.85%29.aspx
https://msdn.microsoft.com/en-us/library/windows/desktop/dd373755%28v=vs.85%29.aspx
http://www.pinvoke.net/default.aspx/kernel32/GetLocaleInfoEx.html
Related posts
http://praisachion.blogspot.com/2015/06/using-getlocaleinfo-and-getlocaleinfoex_79.html
http://praisachion.blogspot.com/2015/06/using-getlocaleinfo-and-getlocaleinfoex_14.html
http://praisachion.blogspot.com/2015/06/using-getlocaleinfo-and-getlocaleinfoex.html
luni, 9 februarie 2015
API Messagebox
VFP's native Messagebox() has some limitations.
1 The maximum length of the message is 1024 (it appears that characters after the 1024th are truncated)
MessageBox(SPACE(1023)+"123", "Message title", 0)
2 Unicode characters cannot be showed
3 Other limitations
API Messagebox() is easy to be used and has no such restrictions.
There are two type of messageboxes:
- MessageBoxA, useful for ASCII messages
- MessageBoxW, useful for Unicode messages
1 In the first example, is shown a message, with more than 1024 characters:
DECLARE INTEGER MessageBoxA IN user32;
INTEGER hWindow, STRING lpText,;
STRING lpCaption, LONG uType
= MessageBoxA(_screen.HWnd, SPACE(5000)+"123", "Message title", 0)
2 The second example contains another set of buttons (6)
DECLARE INTEGER MessageBoxA IN user32 INTEGER hWindow, STRING lpText,STRING lpCaption, LONG uType
= MessageBoxA(_screen.HWnd, "Well ?"+CHR(13)+"Oh, no, no, no!", "Message title", 6)
3 The window shown in front of all windows from your desktop (WS_EX_TOPMOST style => 0x1000)
DECLARE INTEGER MessageBoxA IN user32 INTEGER hWindow, STRING lpText,STRING lpCaption, LONG uType
= MessageBoxA(_screen.HWnd, "Well ?", "Message title", 0x1000)
This style can be applied even to VFP messagebox:
MESSAGEBOX("AAAAA !",0x1000)
4 The ability to display Unicode characters.
To achieve this, instead of MessageBoxA must be used MessageBoxW.
The message and the title are strings ended with a CHR(0).
Regular text must be converted with STRCON(...,5), but can be used Unicode characters as a blob constant. (See http://www.news2news.com/vfp/?function=73)
Example for regular text
DECLARE INTEGER MessageBoxW IN user32 INTEGER hWindow, STRING lpText, STRING lpCaption, LONG uType
= MessageBoxW(_screen.HWnd, STRCONV("Well ?"+CHR(13)+"Oh, no, no, no!"+CHR(0),5), STRCONV("Message title"+CHR(0),5), 0)
Examples for blob constant (for Unicode, see http://unicode-table.com/en/)
Character "0" is Unicode 0x0030. As blob constant will be written 0h3000 (note the reversed order of the two bytes). Because the string must be ended with a CHR(0), displaying a "0" become :
DECLARE INTEGER MessageBoxW IN user32 INTEGER hWindow, STRING lpText, STRING lpCaption, LONG uType
= MessageBoxW(_screen.HWnd, 0h300000, STRCONV("Message title"+CHR(0),5), 0)
To display "01", the blob constant will be 0h3000310000, where 3000 is Unicode "0", 3100 is Unicode "1" and 00 is the string terminator.
DECLARE INTEGER MessageBoxW IN user32 INTEGER hWindow, STRING lpText, STRING lpCaption, LONG uType
= MessageBoxW(_screen.HWnd, 0h3000310000, STRCONV("Message title"+CHR(0),5), 0)
Note that some characters might not be displayed.
Another Unicode message.
DECLARE INTEGER MessageBoxW IN user32 INTEGER hWindow, STRING lpText, STRING lpCaption, LONG uType
= MessageBoxW(_screen.HWnd, 0h26094709350940092E09470935093E0900, STRCONV("Message title"+CHR(0),5), 0)
See http://www.tek-tips.com/viewthread.cfm?qid=1743552
1 The maximum length of the message is 1024 (it appears that characters after the 1024th are truncated)
MessageBox(SPACE(1023)+"123", "Message title", 0)
2 Unicode characters cannot be showed
3 Other limitations
API Messagebox() is easy to be used and has no such restrictions.
There are two type of messageboxes:
- MessageBoxA, useful for ASCII messages
- MessageBoxW, useful for Unicode messages
1 In the first example, is shown a message, with more than 1024 characters:
DECLARE INTEGER MessageBoxA IN user32;
INTEGER hWindow, STRING lpText,;
STRING lpCaption, LONG uType
= MessageBoxA(_screen.HWnd, SPACE(5000)+"123", "Message title", 0)
2 The second example contains another set of buttons (6)
DECLARE INTEGER MessageBoxA IN user32 INTEGER hWindow, STRING lpText,STRING lpCaption, LONG uType
= MessageBoxA(_screen.HWnd, "Well ?"+CHR(13)+"Oh, no, no, no!", "Message title", 6)
3 The window shown in front of all windows from your desktop (WS_EX_TOPMOST style => 0x1000)
DECLARE INTEGER MessageBoxA IN user32 INTEGER hWindow, STRING lpText,STRING lpCaption, LONG uType
= MessageBoxA(_screen.HWnd, "Well ?", "Message title", 0x1000)
This style can be applied even to VFP messagebox:
MESSAGEBOX("AAAAA !",0x1000)
4 The ability to display Unicode characters.
To achieve this, instead of MessageBoxA must be used MessageBoxW.
The message and the title are strings ended with a CHR(0).
Regular text must be converted with STRCON(...,5), but can be used Unicode characters as a blob constant. (See http://www.news2news.com/vfp/?function=73)
Example for regular text
DECLARE INTEGER MessageBoxW IN user32 INTEGER hWindow, STRING lpText, STRING lpCaption, LONG uType
= MessageBoxW(_screen.HWnd, STRCONV("Well ?"+CHR(13)+"Oh, no, no, no!"+CHR(0),5), STRCONV("Message title"+CHR(0),5), 0)
Examples for blob constant (for Unicode, see http://unicode-table.com/en/)
Character "0" is Unicode 0x0030. As blob constant will be written 0h3000 (note the reversed order of the two bytes). Because the string must be ended with a CHR(0), displaying a "0" become :
DECLARE INTEGER MessageBoxW IN user32 INTEGER hWindow, STRING lpText, STRING lpCaption, LONG uType
= MessageBoxW(_screen.HWnd, 0h300000, STRCONV("Message title"+CHR(0),5), 0)
To display "01", the blob constant will be 0h3000310000, where 3000 is Unicode "0", 3100 is Unicode "1" and 00 is the string terminator.
DECLARE INTEGER MessageBoxW IN user32 INTEGER hWindow, STRING lpText, STRING lpCaption, LONG uType
= MessageBoxW(_screen.HWnd, 0h3000310000, STRCONV("Message title"+CHR(0),5), 0)
Note that some characters might not be displayed.
Another Unicode message.
DECLARE INTEGER MessageBoxW IN user32 INTEGER hWindow, STRING lpText, STRING lpCaption, LONG uType
= MessageBoxW(_screen.HWnd, 0h26094709350940092E09470935093E0900, STRCONV("Message title"+CHR(0),5), 0)
See http://www.tek-tips.com/viewthread.cfm?qid=1743552
Abonați-vă la:
Postări (Atom)