Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

5,000 PowerBASIC Classes - code sample

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • 5,000 PowerBASIC Classes - code sample

    5,000 powerbasic classes - code sample

    'can i interest you in 5000 classes?'

    this is about an article on microsoft.com http://msdn.microsoft.com/vbrun/vbfu...s/default.aspx

    the article shows how to compile a net class down to a dll(tlb) that can be accessed with com.

    there is already a thread about this with more information: http://www.powerbasic.com/support/pb...ad.php?t=21719


    this a simple, working sample of using the net class to download a url into a textbox.

    note!!! - this won't work without seeing the article and downloading the net classes!

    Code:
    '===================================================
    #pbforms created v1.51
    #compile exe
    #dim all
    ' --------------------------------------------------
    ' --------------------------------------------------
    #pbforms begin includes
    #if not %def(%winapi)
        #include "win32api.inc"
    #endif
    #pbforms end includes
    ' --------------------------------------------------
    ' --------------------------------------------------
    #pbforms begin constants
    %idc_button1  = 1001
    %idc_textbox1 = 1003
    %idc_textbox2 = 1004
    %idd_dialog1  =  101
    #pbforms end constants
    ' --------------------------------------------------
    ' --------------------------------------------------
    declare callback function showdialog1proc()
    declare function showdialog1(byval hparent as dword) as long
    #pbforms declarations
    ' --------------------------------------------------
    ' --------------------------------------------------
    global ghdlg as dword
    ' --------------------------------------------------
    ' --------------------------------------------------
    ' --------------------------------------------------
    ' --------------------------------------------------
    ' library file:      c:\tlbs\wrappers.tlb
    ' --------------------------------------------------
    ' progid:            regexwrapper
    ' interface name:    regexwrapperregexwrapper
    '
    ' progid:            webclientwrapper
    ' interface name:    regexwrapperwebclientwrapper
    '
    ' interface prefix:  regexwrapper
    ' --------------------------------------------------
    $progid_regexwrapper = "regexwrapper"
    $progid_webclientwrapper = "webclientwrapper"
    interface dispatch regexwrapperregexwrapper
        member get tostring<&h00000000>() as string
        member call equals<&h60020001>(in obj as variant<&h00000000> ) as long
        member call gethashcode<&h60020002>() as long
        member call gettype<&h60020003>() as regexwrappertype
        member call setexpression<&h60020004>(in patternstring as string<&h00000000> )
        member call setignorecase<&h60020005>()
        member call setcompiled<&h60020006>()
        member call matches<&h60020007>(in input as string<&h00000000> ) as variant
    end interface
    interface dispatch regexwrapperwebclientwrapper
        member get tostring<&h00000000>() as string
        member call equals<&h60020001>(in obj as variant<&h00000000> ) as long
        member call gethashcode<&h60020002>() as long
        member call gettype<&h60020003>() as regexwrappertype
        member call downloadfileasstring<&h60020004>(in url as string<&h00000000> ) as string
        member call downloadfile<&h60020005>(in url as string<&h00000000>, in filename as string<&h00000001> ) as variant
    end interface
    ' --------------------------------------------------
    ' --------------------------------------------------
    ' --------------------------------------------------
    ' --------------------------------------------------
    function pbmain()
        showdialog1 %hwnd_desktop
    end function
    ' --------------------------------------------------
    ' --------------------------------------------------
    callback function showdialog1proc()
    
        select case as long cbmsg
            case %wm_initdialog
                ' initialization handler
    
            case %wm_ncactivate
                static hwndsavefocus as dword
                if isfalse cbwparam then
                    ' save control focus
                    hwndsavefocus = getfocus()
                elseif hwndsavefocus then
                    ' restore control focus
                    setfocus(hwndsavefocus)
                    hwndsavefocus = 0
                end if
    
            case %wm_command
                ' process control notifications
                select case as long cbctl
                    case %idc_button1
                        if cbctlmsg = %bn_clicked then call downloadurl()
    
                    case %idc_textbox1
    
                    case %idc_textbox2
    
                end select
        end select
    end function
    ' --------------------------------------------------
    ' --------------------------------------------------
    function showdialog1(byval hparent as dword) as long
        local lrslt as long
    
    #pbforms begin dialog %idd_dialog1->->
        local hdlg  as dword
    
        dialog new hparent, "pb_net", 126, 92, 301, 219, %ws_popup or %ws_border _
            or %ws_dlgframe or %ws_sysmenu or %ws_minimizebox or _
            %ws_clipsiblings or %ws_visible or %ds_modalframe or %ds_center or _
            %ds_3dlook or %ds_nofailcreate or %ds_setfont, %ws_ex_controlparent _
            or %ws_ex_left or %ws_ex_ltrreading or %ws_ex_rightscrollbar, to _
            hdlg
        control add button,  hdlg, %idc_button1, "download url", 5, 5, 60, 15
        control add textbox, hdlg, %idc_textbox1, "http://www.powerbasic.com/", 70, 5, 225, 15
        control add textbox, hdlg, %idc_textbox2, ", 5, 25, 290, 190, %ws_child _
            or %ws_visible or %ws_tabstop or %ws_hscroll or %ws_vscroll or _
            %es_left or %es_multiline or %es_autohscroll or %es_autovscroll or _
            %es_nohidesel or %es_wantreturn, %ws_ex_clientedge or %ws_ex_left or _
            %ws_ex_ltrreading or %ws_ex_rightscrollbar
    #pbforms end dialog
        ghdlg = hdlg
        dialog show modal hdlg, call showdialog1proc to lrslt
    
    #pbforms begin cleanup %idd_dialog1
    #pbforms end cleanup
    
        function = lrslt
    end function
    ' --------------------------------------------------
    ' --------------------------------------------------
    ' --------------------------------------------------
    
    ' --------------------------------------------------
    sub downloadurl()
        dim ogetrul as dispatch
        dim surl as string
        dim vurl as variant
        dim vresult as variant
        
        
        let ogetrul = new dispatch in "webclientwrapper"
        
        control get text ghdlg, %idc_textbox1 to surl
        if surl=" then exit sub
    
        vurl = surl
        
        object get ogetrul.downloadfileasstring( vurl ) to vresult
        control set text ghdlg, %idc_textbox2, variant$(vresult)
        
        let ogetrul = nothing
    
    end sub
    ' --------------------------------------------------
    '===================================================

    ------------------




    [this message has been edited by stan durham (edited april 15, 2005).]
Working...
X