Teclado Numerico en VFP

299 views
Skip to first unread message

Gregorio Nava

unread,
Nov 29, 2017, 8:31:46 PM11/29/17
to publicesvfoxpro
Saludos, tengo un aplicacion VFP 9.0, necesito usar un teclado numerico para los montos, (para eliminar el teclado del equipo) y quisiera saber de algun ejemplo para poder empezar, en la red vi una clase de Woody pero no he podido descargarla, de antemano gracias por su ayuda
Message has been deleted

Gregori Arjona Toledo

unread,
Nov 30, 2017, 4:08:37 AM11/30/17
to Comunidad de Visual Foxpro en Español
Aqui tienes el codigo que buscas:









*Begin code
set safe off
set defa to addbs(justpath(sys(16,1)))

publi m.myvar1,m.myvar2,m.myvar3
text to m.myvar1 noshow
/9j/4QFFRXhpZgAASUkqAAgAAAAIABIBAwABAAAAAQAAABoBBQABAAAAbgAAABsBBQABAAAAdgAAACgBAwABAAAAAgAAADEBAgAdAAAAfgAAADIBAgAVAAAAmwAAABMCAwABAAAAAgAAAGmHBAABAAAAsAAAAAAAAAAsAQAAAQAAACwBAAABAAAAQWRvYmUgUGhvdG9zaG9wIENTIE1hY2ludG9zaAAyMDA1OjEyOjE1IDEyOjU5OjI1AAAHAACQBwAEAAAAMDIyMAGRBwAEAAAAAQIDAACgBwAEAAAAMDEwMAGgAwABAAAAAQAAAAKgBAABAAAARgAAAAOgBAABAAAARgAAAAWgBAABAAAACgEAAAAAAAACAAEAAgAFAAAAKAEAAAIABwAEAAAAAwAAAAAAAAABAQEBAAAAAAAAAAAAAAAAAAAAAAD/wAARCABGAEYDASIAAhEBAxEB/9sAhAAFAwMEAwMFBAQEBQUFBgcNCAcHBwcQCwwJDRMQFBMSEBISFRceGRUWHBYSEhojGhwfICEiIRQZJSckICceISEgAQUFBQcGBw8ICA8gFRIVFSAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICD/xAGiAAABBQEBAQEBAQAAAAAAAAAAAQIDBAUGBwgJCgsQAAIBAwMCBAMFBQQEAAABfQECAwAEEQUSITFBBhNRYQcicRQygZGhCCNCscEVUtHwJDNicoIJChYXGBkaJSYnKCkqNDU2Nzg5OkNERUZHSElKU1RVVldYWVpjZGVmZ2hpanN0dXZ3eHl6g4SFhoeIiYqSk5SVlpeYmZqio6Slpqeoqaqys7S1tre4ubrCw8TFxsfIycrS09TV1tfY2drh4uPk5ebn6Onq8fLz9PX29/j5+gEAAwEBAQEBAQEBAQAAAAAAAAECAwQFBgcICQoLEQACAQIEBAMEBwUEBAABAncAAQIDEQQFITEGEkFRB2FxEyIygQgUQpGhscEJIzNS8BVictEKFiQ04SXxFxgZGiYnKCkqNTY3ODk6Q0RFRkdISUpTVFVWV1hZWmNkZWZnaGlqc3R1dnd4eXqCg4SFhoeIiYqSk5SVlpeYmZqio6Slpqeoqaqys7S1tre4ubrCw8TFxsfIycrS09TV1tfY2dri4+Tl5ufo6ery8/T19vf4+fr/2gAMAwEAAhEDEQA/APeLixh+KFs19fyNJauSbeAt8iL246Z9652T4LaSznbYxY/3K0fhFM7+F7JSf+WYFenQwLtHy1wwhGrFSlufc4zG18orSw9CVoJ2SPH/APhSemf8+EX/AHxR/wAKU0sf8uEX/fFezCBMfdFMeBccKKr6rDscn+s+N/mZ40fgxpK9bKEf8App+D+iL1tYB/wGvW7m3XB+UVjX1uozwKl4eC6HVRz/ABlTRzZ5w3wo0FOtvBx/siszW/hloUNlI8dtASq54Fd3fQgE8CsLU1xbTDHGw1jKnFaWPYw+PxUmm6jPNvBn7Qd78G9WutN1FrnVNFeP9xbtJlreQEfcJzhSM5XpnGMc563/AIbo0H/oXbv/AL/D/CvnP4r8azx/eNcXk1yxxNSmuWL0PbzDJcvxNX2tWknJpXd2vyaPuj4PH/imrH/cFerwkbB9K8l+EJx4Xsz6RivUbe4Gwc16WG+BHwnE0b42dv5mXwRjimtjtUInGKZJcDHWum580oO4y4IwRWNfkYNXrm5GOtYt9cjkZrObPTwtN3MnUCMmsDVT/o0v+4a172cEmsTUpP8ARpf9w1yTPqcJCyR8tfFb/kMf8CNcXXY/FVgdYP8AvGuMyK8yW59tiXaS9EfcXwpfZ4RtT6RCu5ttSGwc9q8/+GkmzwVAfSEVrQaphR81epSlywR8RmuF9ti6v+I7RdSX+9UcmpDHWuWGrHH3qa+qEj71a+0PKWW6m5c6iCDzWTd3ucjNUJdRz3qnLdluAazlM76GC5SW5uMmszUJM2sv+4akkm7Z5qnfP/osoH901i2etSpcp8yfFE51g/7xrjuK674nnOrn/eNcfXA9z6XFu00vJH2v8PWx4Gh/64/0qFLwgdaz/AHiCzXwbFA8yq3lY5PtUYvrcHAmT867VJcqPHnh5PFVW1vI2VvT60fbD6/rWQL6D/nqn/fVKL+DtKn/AH1S5hfVvI1DdZ70wzk98Vni/gx/rk/MUv2yA/8ALZP++qOYaoW6Fwy56VBeEfZZf9w1ELuDoJk/76qHUNRtobGZnnTAQ/xUXKVKV9EfOHxMP/E3P+8a5HNdL8Qr2O51ZjGwIDGuY3iuS1z08dJKrZ9kfS37Q3gm/wDg5qLahpt5DLouozM1tBkiS3J5KdMFRng5zjjHGT403xJv8/xfnX0p+3X/AMizoX/Xd/5Cvj49a3xUVCq1E83Iswr1stpVKju7NX9G0vwR1o+JWodPm/OlHxL1D1f865EUo6VzXZ6v1uodcPiXqA7v+dH/AAszUPV/zrkaKLsaxdQ6/wD4WbqHq/51XvviJf3MBjLOARjrXMU1/u07sUsXVS0Pqb9mn9mfTPFWjnxl4ya31G1voSllZIW+T5hl3PHzfLgAZGCefT2P/hl/4W/9CvD/AN/H/wAaX9mH/kiXh/8A65N/6Ga9Lr2sPQp+zTa6H5ZnWc4+OPqwhVaSk0knbb0P/9k=
endtext
strtofile(strconv(m.myvar1,14),'img1.jpg')

text to m.myvar2 noshow
/9j/4AAQSkZJRgABAQEBLAEsAAD/2wBDAAYEBAQFBAYFBQYJBgUGCQsIBgYICwwKCgsKCgwQDAwMDAwMEAwODxAPDgwTExQUExMcGxsbHCAgICAgICAgICD/2wBDAQcHBw0MDRgQEBgaFREVGiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICD/wAARCACLAEYDAREAAhEBAxEB/8QAHAABAAIDAQEBAAAAAAAAAAAAAAUGAQMEAgcI/8QAPxAAAAUCAwMEEAQHAAAAAAAAAAECBBIDBQYRIRRyshZBYXETIjEyNVFSVFVikZKTobHCM0KBwRUjRHOi0fD/xAAbAQEAAgMBAQAAAAAAAAAAAAAABAUBAwYCB//EADcRAAEDAgAKCAUEAwAAAAAAAAABAhEDBAUSMTIzQXGBsfATFBUhUVKRkiNCU6HRIjRhwQaC4f/aAAwDAQACEQMRAD8A/TtxuGykinTR2Z1W0o0S0zy7qlHzJTzmIV5eJRTuSXuyJzqQ30KGP3r3NTKvOsrt3uzFnmV2e1HDg/6JqZ00J/RJkfvqHM3uEEbpnq53lb3J9v7Utba2e/RNRrfF3evOxCE5W2XmtdTLmzrqFP2tR+mvuUseza3nT2mOVtm9FL+OoO1qP019yjs2r509o5W2b0Uv46g7Wo/TX3KOzavnT2jldZvRa/jqDtaj9Nfco7Nq+dPaekYssJqLsltqoT5SKyjV9U/UZbhWhrY5P9l/4YXBtbU9PQsdtuR1qRuLQ7U8pI/EYOFZrLdWrtyPxSzIxf2d+6Mak7HTW12XcuX1lCqr0MVcWq3FXzJ+MnpCk8zeUHjdNeiZxPQyMslJMtDSouYyMdJb3DazMZuTnuUrKtJWOhSsXS6m1bvrqWrirUNqzz/KmmZp4kqWOTv7zFx6utVxW7E7vypcW9tjubT1ImMu/lEPn1Q6lSoqpUUa1rPNSj1MzMca6VWVynUNhEhMh5gPMGZEAgSIBAkQCBIiECTptz1zb3aHTc8lo5uYy50n0GN1vWdSejm5UNNek2o3FdkPorS6NmztLvOLO40eymXdyqoiWfWpKsj6h3NletpvxvkqNnekcUX7HLVLdzm4vzMWN3PErF9UZ2dknx1a5n1zP/Y5y+X4TdruJb2afFdsbwK/AVEFnIgECRAIEiAQJEAgzIgECRAIElhrHnhu256mSqpf5GLd37Zm/iVbf3D9xi7a2tn/AHK/GYXejbtdxFtpHbE4ENAVsE+RAIEiAQJEAgSIBAkQCBIgMQZkmHGlgYF61TiMWT/27N/EgM079x6f621rv1uMx6uNG3a7ieaOkdsTgRsBBgmSYgECREIEiIQJEQgSIBAkQCBJIO/ArIvWqcRiZU0LN5Fp6V242OdWDffq8Zj1VzE2rxPLM9dicDigI0EiRAIEiAQJEAgSIBAkQCBIgECTpfeCmhesv6jdW0Td5qo6R242q1ZUt+rxmNjs1Nq8TWmeuxOBpgNUGyRAIEmIBAkQCDMiAQJEAgSIBAkzcdGDYulX1GbjRtMUM9TfT1ao36nGY2pm714mt2d6cDEBiBIgECRAIEiAQJEAgSIBAkQCBJouujWgXSoarnNQ22+cp0tNW5by+Mxvp5N68TTUzvTgbYD3B4kQCBIgECRAIEiAxAkQCBIgECTgvH4VIukxGusiEm2yqddu1pHvL4zG+hk3rxNFfLz4HXAb4NEiAQJEAgSIBAkQCDMiIQJEQgSRF7/IXT+wgXhOtDts+qKm8rjMSbXXt/sj3XPoSMBMgiSIBAkQCBIgECRAYgSIBAkQCBJA37SqRdP7EKq9ylnZ5DusGvZt4+JQl2WvnWpGvNRLwE+CDIgECRAIEiAQJEAgSIBAkQCBJWMQ6OzL/u9IUt/nlxZZpI4a1U46/uUJmD8rudakS/1E7AWcFdIgECRAIEiAQJEAgSIBAkQCBJUcSaXBZdXCQ5/CGk58C8scwksJ61XfX9yhNwZldzrUiYSyNLJAXEFTJiAQJEAgzIgECRAIEiAQJEAgSUnE/hWqW7wJHNYS0q86kOhwfo051kpgzWu96/uUJ2CM5/OtSFhXI0tMBeQU0iAQJEAgSIBAkQCBIgECRAIElBxVpe65bvAkcphPTru4IdNg7QpzrUksPVEsMTO2FTtZrqU0Z+MlZp9pCdZL0N2+mviqffuIl83pLdr08EUucR0UFBIiECRAIEiAQJEAgSIBAkwaSLU+4ECT5/slbEN/dE1yyyNZGZ5dok0oL2jladu69uHIzbu7kOo6RLWg3G51k9jbDjirVK7sEmddJFtCEd8ce9WnpLnF9/kOCXOXp6WdrT+0KzBN81E6J+TV+DTZMdtV000bnnTqlptBFmlXWRakYrrLDbVSKvcvibLvA7kWafengTxYhsJlnt1H3yFr1+h52+pW9SreVTPKCxefUffIOv0PO31MdSreVfQxygsXn9H3yDr9Dzt9R1Kt5VHKCxef0ffIOv0PO31HUq3lU81MSWCmmSn1Iy9U5H7E5mMOwjbp86HpLCuvyqVa/YuqXEv4faqa4Vu1UrL+Yv1UpLuEYo73Cq1vh0UXv9V2FzZ4MSl+uouT0Qs+EcPKtDJR18jeuMlVstSSRd6jPoz1HWYDwX1Wn+rSOy/x/BT4Svenf3ZqZPyTwuytK9ibD9nrM3D1bVO1JTn2VOaDM8+6cTLP9RRYXwZbvpuqK1MfxycMpaWF7Va9GI79JQdha+R8zHD9XZ4HTdK4bC18j5mHVmeA6Vw2Fr5HzMOrM8B0rhsLXyPmYdWZ4DpXHuhb2iq9NKkaKURHqfj6x7p2tNXIkazy+s6D6Za7JarcnNm2TSUou2XqpXVJWZ5D6JZ4PoUE+G1EX7+q95yFxd1KueskgJxGP//Z
endtext
strtofile(strconv(m.myvar2,14),'img2.jpg')

text to m.myvar3 noshow
/9j/4AAQSkZJRgABAQEASABIAAD/2wBDABALCwwMDBENDREYEA4QGBwVEREVHCEZGRkZGSEgGRwcHBwZICAlJygnJSAwMDQ0MDBAQEBAQEBAQEBAQEBAQED/2wBDAREQEBITEhYSEhYWEhUSFhwWFxcWHCgcHB0cHCgxJSAgICAlMSwvKCgoLyw2NjExNjZAQD9AQEBAQEBAQEBAQED/wAARCABGAEYDASIAAhEBAxEB/8QAGgABAQADAQEAAAAAAAAAAAAAAAMCBAYFAf/EADIQAAECAQkHAwMFAAAAAAAAAAABAgMEBRETFTRRcrEGEjGBktHwISMyQVKhIkJhccH/xAAZAQACAwEAAAAAAAAAAAAAAAAAAwECBQT/xAAiEQACAQIGAwEAAAAAAAAAAAAAAQIDEQQSMUFRcRMzkSH/2gAMAwEAAhEDEQA/AOwr4cvarGL6etB4UrmpGxFpVepe5CZpU9sCEqLxYmheUSp7n0qopyO+nQs9mmtzXsxmLup3cWYzF3U7uZV7hXuK5h/iXEfhjZjMXdTu4sxmLup3cyr3CvcGYPEuI/DGzGYu6ndzUlUhhs+7qd3N2vca0peruJFyVSjvGPwzmKfUmqO6TyuI5ZG9u9D3l3lY9FT0Sn6LSDmZ/WiA1U47/wDigdHQz68YxqNJHRzTdoORuheL8iE03aDkboXi/ISzRht0jAAFRgAAACMfgWIx+AEnO7QXdudNFA2gu7c6aKDohoZWK9r6Okmm7QcjdC8X5EJpu0HI3QvF+QlmhDbpGAAKjAAAAEY/AsRj8AJOd2gu7c6aKBtBd2500UHRDQysV7X0dJNN2g5G6F4vyNGbI+7JoX8MRF5Gw+UIqiWaMF+LpGYJVyCuQqMKglXIK5AAqRj8D7XISixEVAA8HaC7tzpooE+Uvgta1KV3qfwDohoZWJ9j6PXnrdmicYsn4wonvQqP2teq/pX+lpNG1WYO85gFGlcfTnLIv0WozB3nMWozB3nMAixfPLkWozB3nMWozB3nMALBnlyLUZg7zmYrObF+jvOYAWDPLk97ZCQwJxiRpbKG78KH7MOGv3ejnOX8UAAatDgqNuTP/9k=
endtext
strtofile(strconv(m.myvar3,14),'img3.jpg')


publi yform
yform=newObject("asup")
yform.show
read events
retu
*
DEFINE CLASS asup AS form
    Height = 222
    Width = 252
    AutoCenter = .T.
    Caption = "Sampleform for Virtual Keyboard"
    *-- Reference for the Keyboard
    okeyboard = .NULL.
    Name = "Form1"

    ADD OBJECT label1 AS label WITH ;
        AutoSize = .T., ;
        BackStyle = 0, ;
        Caption = "Enter Value:", ;
        Height = 17, ;
        Left = 24, ;
        Top = 36, ;
        Width = 68, ;
        Style = 3, ;
        Name = "Label1"

    ADD OBJECT text1 AS textbox WITH ;
        FontName = "Courier New", ;
        Alignment = 3, ;
        Value = 0, ;
        Height = 23, ;
        InputMask = "999,999.999", ;
        Left = 100, ;
        SelectOnEntry = .T., ;
        Top = 33, ;
        Width = 128, ;
        Name = "Text1"

    ADD OBJECT label2 AS label WITH ;
        AutoSize = .T., ;
        BackStyle = 0, ;
        Caption = "Enter Value:", ;
        Height = 17, ;
        Left = 25, ;
        Top = 68, ;
        Width = 68, ;
        Style = 3, ;
        Name = "Label2"

    ADD OBJECT text2 AS textbox WITH ;
        FontName = "Courier New", ;
        Alignment = 3, ;
        Value = 0, ;
        Height = 23, ;
        InputMask = "999,999.999", ;
        Left = 101, ;
        SelectOnEntry = .T., ;
        Top = 65, ;
        Width = 128, ;
        Name = "Text2"


    ADD OBJECT label3 AS label WITH ;
        AutoSize = .T., ;
        BackStyle = 0, ;
        Caption = "Enter Value:", ;
        Height = 17, ;
        Left = 25, ;
        Top = 99, ;
        Width = 68, ;
        Style = 3, ;
        Name = "Label3"

    ADD OBJECT text3 AS textbox WITH ;
        FontName = "Courier New", ;
        Alignment = 3, ;
        Value = 0, ;
        Height = 23, ;
        InputMask = "999,999.999", ;
        Left = 101, ;
        SelectOnEntry = .T., ;
        Top = 96, ;
        Width = 128, ;
        Name = "Text3"

    ADD OBJECT label4 AS label WITH ;
        AutoSize = .T., ;
        BackStyle = 0, ;
        Caption = "Enter Value:", ;
        Height = 17, ;
        Left = 26, ;
        Top = 131, ;
        Width = 68, ;
        Style = 3, ;
        Name = "Label4"

    ADD OBJECT text4 AS textbox WITH ;
        FontName = "Courier New", ;
        Alignment = 3, ;
        Value = 0, ;
        Height = 23, ;
        InputMask = "999,999.999", ;
        Left = 102, ;
        SelectOnEntry = .T., ;
        Top = 128, ;
        Width = 128, ;
        Name = "Text4"

    ADD OBJECT label5 AS label WITH ;
        AutoSize = .T., ;
        WordWrap = .T., ;
        Caption = "Here the additional OK Button closes the entry form", ;
        Height = 32, ;
        Left = 12, ;
        Top = 168, ;
        Width = 204, ;
        Name = "Label5"

    PROCEDURE Destroy
        ** Kill the Keyboard
        Thisform.okeyboard = .NULL.
    ENDPROC


    PROCEDURE Init
         *
        * THISFORM.oKeyboard = NEWOBJECT("tlbNumKeyboard1")     &&uncomment to see another keybord....
        ** choose the one you like best
        THISFORM.oKeyboard = NEWOBJECT("tlbNumKeyboard2")    
        ** see also Form.Destroy for killig it

        WITH THISFORM.oKeyboard
            .LEFT = THISFORM.LEFT + THISFORM.WIDTH && position to the right of form
            .TOP = (_SCREEN.HEIGHT - .HEIGHT) /2
            .VISIBLE = .T.
        ENDWITH
    ENDPROC


    PROCEDURE text1.LostFocus
        This.BackColor = RGB(255,255,255)
    ENDPROC


    PROCEDURE text1.GotFocus
        This.BackColor = RGB(255,128,255)
    ENDPROC

    PROCEDURE text2.GotFocus
        This.BackColor = RGB(255,128,255)
    ENDPROC

    PROCEDURE text2.LostFocus
        This.BackColor = RGB(255,255,255)
    ENDPROC

    PROCEDURE text3.GotFocus
        This.BackColor = RGB(255,128,255)
    ENDPROC

    PROCEDURE text3.LostFocus
        This.BackColor = RGB(255,255,255)
    ENDPROC

    PROCEDURE text4.GotFocus
        This.BackColor = RGB(255,128,255)
    ENDPROC

    PROCEDURE text4.LostFocus
        This.BackColor = RGB(255,255,255)
    ENDPROC

    Procedure destroy
    clea events
    endproc


ENDDEFINE
*
*-- EndDefine: asup
**************************************************
*
DEFINE CLASS cmdkeyboard AS commandbutton
    Height = 70
    Width = 70
    FontBold = .T.
    FontName = "Verdana"
    FontSize = 22
    Picture = "img1.jpg"    &&"images\rot02_70x70.jpg"
    Caption = "1"
    PicturePosition = 12
    Alignment = 2
    Name = "cmdkeyboard"


    PROCEDURE Click
        DO CASE
        CASE This.Caption ="C"
            KEYBOARD "{BACKSPACE}"
        CASE This.Caption ="Space"
            KEYBOARD " "
        CASE This.Caption ="<"
            KEYBOARD "{LEFTARROW}"
        CASE This.Caption =">"
            KEYBOARD "{RIGHTARROW}"
        CASE This.Caption = CHR(0xFC)   && this is the Ansicode of that WingDings symbols, See \Windows\CharMap.exe for those codes
            KEYBOARD "{ENTER}"
            ** Want to close the form?
            _screen.ActiveForm.release() 

        CASE This.Caption = CHR(0xD9)
            KEYBOARD "{UPARROW}"
        CASE This.Caption = CHR(0xDA)
            KEYBOARD "{DNARROW}"    
        CASE This.Caption = "."
            KEYBOARD SET("POINT")   && for international settings

        OTHERWISE
            KEYBOARD This.Caption
        ENDCASE
    ENDPROC

ENDDEFINE
*
*-- EndDefine: cmdkeyboard

*
DEFINE CLASS cntnumkeyboard1 AS container
    Width = 209
    Height = 278
    BackStyle = 0
    BorderWidth = 0
    Name = "cntnumkeyboard1"

    ADD OBJECT cmdkeyboard1 AS cmdkeyboard WITH ;
        Top = 0, ;
        Left = 0, ;
        Name = "Cmdkeyboard1"

    ADD OBJECT cmdkeyboard2 AS cmdkeyboard WITH ;
        Top = 0, ;
        Left = 69, ;
        Caption = "2", ;
        Name = "Cmdkeyboard2"

    ADD OBJECT cmdkeyboard3 AS cmdkeyboard WITH ;
        Top = 0, ;
        Left = 138, ;
        Caption = "3", ;
        Name = "Cmdkeyboard3"

    ADD OBJECT cmdkeyboard4 AS cmdkeyboard WITH ;
        Top = 69, ;
        Left = 0, ;
        Caption = "4", ;
        Name = "Cmdkeyboard4"

    ADD OBJECT cmdkeyboard5 AS cmdkeyboard WITH ;
        Top = 69, ;
        Left = 69, ;
        Caption = "5", ;
        Name = "Cmdkeyboard5"

    ADD OBJECT cmdkeyboard6 AS cmdkeyboard WITH ;
        Top = 69, ;
        Left = 138, ;
        Caption = "6", ;
        Name = "Cmdkeyboard6"

    ADD OBJECT cmdkeyboard7 AS cmdkeyboard WITH ;
        Top = 138, ;
        Left = 0, ;
        Caption = "7", ;
        Name = "Cmdkeyboard7"

    ADD OBJECT cmdkeyboard8 AS cmdkeyboard WITH ;
        Top = 138, ;
        Left = 69, ;
        Caption = "8", ;
        Name = "Cmdkeyboard8"

    ADD OBJECT cmdkeyboard9 AS cmdkeyboard WITH ;
        Top = 138, ;
        Left = 138, ;
        Caption = "9", ;
        Name = "Cmdkeyboard9"

    ADD OBJECT cmdkeyboard10 AS cmdkeyboard WITH ;
        Top = 207, ;
        Left = 0, ;
        Caption = ".", ;
        Name = "Cmdkeyboard10"

    ADD OBJECT cmdkeyboard11 AS cmdkeyboard WITH ;
        Top = 207, ;
        Left = 69, ;
        Caption = "0", ;
        Name = "Cmdkeyboard11"

    ADD OBJECT cmdkeyboard12 AS cmdkeyboard WITH ;
        Top = 207, ;
        Left = 138, ;
        Caption = "C", ;
        Name = "Cmdkeyboard12"
ENDDEFINE
*
*-- EndDefine: cntnumkeyboard1

*
DEFINE CLASS cntnumkeyboard2 AS cntnumkeyboard1
    Width = 284
    Height = 279
    Name = "cntnumkeyboard2"
    Cmdkeyboard1.Name = "Cmdkeyboard1"
    Cmdkeyboard2.Name = "Cmdkeyboard2"
    Cmdkeyboard3.Name = "Cmdkeyboard3"
    Cmdkeyboard4.Name = "Cmdkeyboard4"
    Cmdkeyboard5.Name = "Cmdkeyboard5"
    Cmdkeyboard6.Name = "Cmdkeyboard6"
    Cmdkeyboard7.Name = "Cmdkeyboard7"
    Cmdkeyboard8.Name = "Cmdkeyboard8"
    Cmdkeyboard9.Name = "Cmdkeyboard9"
    Cmdkeyboard10.Name = "Cmdkeyboard10"
    Cmdkeyboard11.Name = "Cmdkeyboard11"
    Cmdkeyboard12.Name = "Cmdkeyboard12"

    ADD OBJECT cmdkeyboard13 AS cmdkeyboard WITH ;
        Top = 1, ;
        Left = 212, ;
        Height = 70, ;
        Width = 70, ;
        FontName = "Wingdings", ;
        Picture ="img2.jpg", ;
        Caption = "Ù", ;
        Name = "Cmdkeyboard13"

    ADD OBJECT cmdkeyboard14 AS cmdkeyboard WITH ;
        Top = 70, ;
        Left = 212, ;
        Height = 70, ;
        Width = 70, ;
        FontName = "Wingdings", ;
        Picture = "img2.jpg", ;
        Caption = "Ú", ;
        Name = "Cmdkeyboard14"

    ADD OBJECT cmdkeyboard15 AS cmdkeyboard WITH ;
        Top = 139, ;
        Left = 212, ;
        Height = 139, ;
        Width = 70, ;
        FontName = "Wingdings", ;
        FontSize = 34, ;
        Picture = "img2.jpg" , ;
        Caption = "ü", ;
        Name = "Cmdkeyboard15"

ENDDEFINE
*
*-- EndDefine: cntnumkeyboard2
**************************************************
*
DEFINE CLASS tlbnumkeyboard1 AS toolbar
    Caption = "Numeric Input"
    Height = 284
    Left = 0
    Top = 0
    Width = 219
    ControlBox = .F.
    Name = "tlbnumkeyboard1"

    ADD OBJECT cntnumkeyboard1 AS cntnumkeyboard1 WITH ;
        Top = 3, ;
        Left = 5, ;
        Name = "Cntnumkeyboard1", ;
        Cmdkeyboard1.Name = "Cmdkeyboard1", ;
        Cmdkeyboard2.Name = "Cmdkeyboard2", ;
        Cmdkeyboard3.Name = "Cmdkeyboard3", ;
        Cmdkeyboard4.Name = "Cmdkeyboard4", ;
        Cmdkeyboard5.Name = "Cmdkeyboard5", ;
        Cmdkeyboard6.Name = "Cmdkeyboard6", ;
        Cmdkeyboard7.Name = "Cmdkeyboard7", ;
        Cmdkeyboard8.Name = "Cmdkeyboard8", ;
        Cmdkeyboard9.Name = "Cmdkeyboard9", ;
        Cmdkeyboard10.Name = "Cmdkeyboard10", ;
        Cmdkeyboard11.Name = "Cmdkeyboard11", ;
        Cmdkeyboard12.Name = "Cmdkeyboard12"

ENDDEFINE
*
*-- EndDefine: tlbnumkeyboard1
*
DEFINE CLASS tlbnumkeyboard2 AS toolbar
    Caption = "Numeric Input"
    Height = 285
    Left = 0
    Top = 0
    Width = 294
    ControlBox = .F.
    Name = "tlbnumkeyboard2"

    ADD OBJECT cntnumkeyboard21 AS cntnumkeyboard2 WITH ;
        Top = 3, ;
        Left = 5, ;
        Name = "Cntnumkeyboard21", ;
        Cmdkeyboard1.Name = "Cmdkeyboard1", ;
        Cmdkeyboard2.Name = "Cmdkeyboard2", ;
        Cmdkeyboard3.Name = "Cmdkeyboard3", ;
        Cmdkeyboard4.Name = "Cmdkeyboard4", ;
        Cmdkeyboard5.Name = "Cmdkeyboard5", ;
        Cmdkeyboard6.Name = "Cmdkeyboard6", ;
        Cmdkeyboard7.Name = "Cmdkeyboard7", ;
        Cmdkeyboard8.Name = "Cmdkeyboard8", ;
        Cmdkeyboard9.Name = "Cmdkeyboard9", ;
        Cmdkeyboard10.Name = "Cmdkeyboard10", ;
        Cmdkeyboard11.Name = "Cmdkeyboard11", ;
        Cmdkeyboard12.Name = "Cmdkeyboard12", ;
        Cmdkeyboard13.Name = "Cmdkeyboard13", ;
        Cmdkeyboard14.Name = "Cmdkeyboard14", ;
        Cmdkeyboard15.Name = "Cmdkeyboard15"

ENDDEFINE
*
*-- EndDefine: tlbnumkeyboard2


*endcode




Carlos Miguel FARIAS

unread,
Nov 30, 2017, 7:30:28 AM11/30/17
to Grupo Fox
ACTIVATE WINDOW CALCULATOR
los datos (dos posibles) los obtienes de _CALCMEN (el de la memoria) o de _CALCVALUE, el del visor.
Puedes cargar valores previos a ambos datos.
Saludos: Miguel

Gregorio Nava

unread,
Nov 30, 2017, 8:39:15 AM11/30/17
to publicesvfoxpro
Buen dia, muchas gracias por el codigo, tengo una pregunta, el codigo lo guardo en un prg y lo ejecuto, todo bien, solo al momento de dale enter para salir me arroja un mensaje el cual adjunto, gracias
ErrorReclado.png

wpalomo

unread,
Nov 30, 2017, 11:27:49 AM11/30/17
to Comunidad de Visual Foxpro en Español
Debes comentar la siguiente linea:


            ** Want to close the form?
            _screen.ActiveForm.release()    // A esta linea poner en modo comentario   ===>    **  _screen.ActiveForm.release()


Suerte

Gregorio Nava

unread,
Nov 30, 2017, 1:36:23 PM11/30/17
to publicesvfoxpro
Ya lo hice y funciona bien, pero ahora la llamar el prg desde un formulario de nivel superior no muestra el teclado virtual

Gregori Arjona Toledo

unread,
Dec 1, 2017, 2:20:33 AM12/1/17
to Comunidad de Visual Foxpro en Español
El codigo anterior es una prueba, para que funcione en tu programa debes adaptar el codigo un poco para que funcione en tu proyecto.

Primero graba todo el codigo en un PRG , por exemplo teclado.prg 

Crea una nueva propiedad en tu formulario llamada okeyboard, que es donde alojaremos el objeto teclado y en el init de tu formulario añade el siguiente codigo

SET PROCEDURE TO TECLADO.PRG
thisform.oKeyboard = NEWOBJECT("tlbNumKeyboard2")



Imagina que quieres que el teclado se abra al pulsar un boton del formulario, pues añade en el metodo click del boto el siguiente codigo:

thisform.okeyboard.Show

cuando quieras ocultarlo usa este codigo:

thisform.okeyboard.Hide

Gregorio Nava

unread,
Dec 1, 2017, 6:33:42 AM12/1/17
to publicesvfoxpro
Bien,voy a pobrar, gracias por la ayuda
Reply all
Reply to author
Forward
0 new messages