INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Jobs

Help on help

How can I navigate through all these FAQs? by baltman
Posted: 23 Oct 03 (Edited 26 Dec 04)

&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
&&                           
&& Tek-Tips VFP FAQ Organizer   
&& Updated 2004-12-25
&&                             
&& Works on any Tek-tips Area
&& by updating the ForumNumber  
&&                            
&& Copy and paste into a .PRG!  
&&                             
&&       Brian Altman          
&&                              
&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
&&
&&  Note That InternetCheckConnection may not
&&  work on all computers. I have disabled
&&  the feature while I look into it.
&&                              
&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

CODE

PUBLIC form1,lnForumNumber, lcConnect

lnForumNumber=184
lcForumName=[VFP General Coding Issues]

form1= CREATEOBJECT([form1])
form1.Show
RETURN

DEFINE CLASS form1 AS form
    DoCreate = .T.
    Caption = [Form1]
    Name = [Form1]

    ADD OBJECT optiongroup1 AS optiongroup WITH ;
        ButtonCount = 2, ;
        Value = 1, ;
        Height = 45, ;
        Name = [Optiongroup1], ;
        Option1.Caption = [Filter on:], ;
        Option1.Value = 1, ;
        Option1.Height = 17, ;
        Option1.Left = 5, ;
        Option1.Top = 2, ;
        Option1.Width = 163, ;
        Option1.Name = [Option1], ;
        Option2.Caption = [Sort by:], ;
        Option2.Height = 17, ;
        Option2.Left = 2, ;
        Option2.Top = 24, ;
        Option2.Width = 163, ;
        Option2.Name = [Option2]

    ADD OBJECT list1 AS listbox WITH ;
        Name = [List1]

    ADD OBJECT list2 AS listbox WITH ;
        RowSourceType = 2, ;
        Name = [List2]

    ADD OBJECT grid1 AS grid WITH ;
        DeleteMark=.f., ;
        ColumnCount = 5, ;
        FontSize = 9, ;
        RecordSource = [faq_info], ;
        RowHeight = 18, ;
        Top = 36, ;
        Name = [Grid1], ;
        Column1.FontSize = 9, ;
        Column1.ControlSource = [faq_info.faqmajor], ;
        Column1.Name = [Column1], ;
        Column2.FontSize = 9, ;
        Column2.ControlSource = [faq_info.faqtitle], ;
        Column2.Name = [Column2], ;
        Column3.FontSize = 9, ;
        Column3.ControlSource = [faq_info.faqauthor], ;
        Column3.Name = [Column3], ;
        Column4.FontSize = 9, ;
        Column4.ControlSource = [faq_info.faqdate], ;
        Column4.Name = [Column4], ;
        Column5.FontSize = 9, ;
        Column5.ControlSource = [faq_info.faqrating], ;
        Column5.Name = [Column5]

    ADD OBJECT command1 AS commandbutton WITH ;
        Caption = [Visit This FAQ], ;
        Name = [Command1]

    ADD OBJECT text1 AS textbox WITH ;
        Name = [Text1]

    ADD OBJECT command2 AS commandbutton WITH ;
        AutoSize = .t., ;
        Caption = [Filter on Word/Phrase], ;
        Name = [Command2]

    ADD OBJECT command3 AS commandbutton WITH ;
        AutoSize = .t., ;
        Caption = [Close], ;
        Name = [Command3]
        
    ADD OBJECT command4 AS commandbutton WITH ;
        AutoSize = .t., ;
        Caption = [Clear Filter], ;
        Name = [Command4]

    ADD OBJECT Combo1 AS combobox WITH ;
         ReadOnly = .t., ;
         Style = 2, ;
         Name = [Combo1]

    PROCEDURE Load
        SET TALK OFF
        SET SAFETY OFF
        PUBLIC gcVarFAQArea, gcFilterField, gcFilterValue, gcThisTitle

            DECLARE INTEGER InternetCheckConnection in wininet;
               STRING lpszUrl,;
              INTEGER dwFlags,;
            INTEGER dwReserved
            
            IF InternetCheckConnection('http://www.tek-tips.com', 1, 0) = 1
             lcConnect=[Y]
            ELSE
             lcConnect=[N]
            ENDIF

        WAIT WINDOW AT SROWS()/2, (SCOLS()/2)-10 [Getting FAQ listing from Tek-Tips'];
            +CHR(13)+CHR(13)+lcForumName+[ From ]+IIF(lcConnect=[Y],[Internet],[Archive]);
            +CHR(13)+CHR(13)+[Please Support Tek-Tips Today!] TIMEOUT 1

        IF lcConnect=[Y]
        lcURL=[http://www.tek-tips.com/faq.cfm?pid=]+TRANSFORM(lnForumNumber)
        objHTTP = CreateObject([MSXML2.XMLHTTP])
        objHTTP.Open([GET], lcURL, .f.)
        objHTTP.Send
           FAQs=(objHTTP.ResponseText)
           IF DIRECTORY('c:/temp')=.f.
           MKDIR c:/temp
           ENDIF
           FAQs=CHRTRAN(FAQs,CHR(9)+CHR(1)+CHR(34),[ ])
           STRTOFILE(FAQs,[c:/temp/Offline.txt]+TRANSFORM(lnForumNumber))
        ENDIF
        
        IF lcConnect=[N] AND FILE([c:/temp/Offline.txt]+TRANSFORM(lnForumNumber))=.t.
        WAIT WINDOW AT SROWS()/2, SCOLS()/2 [Getting FAQ listing from Offline Archive] nowait
        FAQs=FILETOSTR([c:/temp/Offline.txt]+TRANSFORM(lnForumNumber))
        ENDIF
    
        IF lcConnect=[N] AND FILE([c:/temp/Offline.txt]+TRANSFORM(lnForumNumber))=.f.
        FAQs=[]
        ENDIF
        
        WAIT WINDOW AT SROWS()/2, (SCOLS()/2)-10 [Organizing FAQ listings] NOWAIT

        lcFAQRating=[]

        IF USED([FAQ_Info])= .f.
          CREATE TABLE FAQ_Info (FAQMajor c(30), FAQLink c(30), FAQTitle c(150),FAQAuthor c(20),;
                               FAQDate c(10), FAQRating c(12), AuthOdr c(20), RatingOdr c(12))
        ELSE
          SELECT FAQ_Info
          ZAP
        ENDIF
        
        FOR x = 1 TO ALINES(FAQ_Array,FAQs)
        lcString=FAQ_Array(x)
           
         DO CASE
           CASE [faqs.cfm?fid=] $ LOWER(lcString) &&Link and title
               lcFAQTitle=SUBSTR(lcString,AT([>],lcString,3)+1,-1+AT([<],lcString,4)-AT([>],lcString,3))
               lcFAQLink=SUBSTR(lcString,AT([faqs.cfm?fid=],lcString,1),AT([>],lcString,3)-AT([faqs.cfm?fid=],lcString,1))

           CASE [COLSPAN=4 STYLE] $ UPPER(lcString) AND [><H3>] $ UPPER(lcString) &&Major Group
                lcFAQMajorGroup=SUBSTR(lcString,AT([>],lcString,2)+1,AT([<],lcString,3)-(AT([>],lcString,2)+1))
    
           CASE [userinfo.cfm?member] $ LOWER(lcString) &&Author
                lcFAQAuthor=SUBSTR(lcString,AT([?member=],lcString,1)+8,AT([>],lcstring,2)-(AT([?member=],lcString,1)+8))
                
           CASE [<TD ALIGN=] $ UPPER(lcString)  AND [RIGHT] $ UPPER(lcString) &&FAQ Date
                lcFAQDate=DTOS(CTOD(substr(lcString,AT([>],lcString,1)+1,AT([<],lcString,2)-(1+AT([>],lcString,1)))))
        
           CASE [</TITLE>] $ UPPER(lcString) &&then title
                gcVarFAQArea=SUBSTR(lcString,AT([>],lcString,1)+1,AT([<],lcString,2)-(AT([>],lcString,1)+1))
 
           CASE [<TD ALIGN=] $ UPPER(lcString) and [CENTER] $ UPPER(lcString) AND LEN(ALLTRIM(lcstring))<40 &&FAQ Rating
                lcFAQRating=TRANSFORM(VAL(CHRTRAN(substr(lcString,AT([>],lcString,1)+1,5),[</],[])) )
                lcFAQRating=IIF(VAL(lcFAQRating)=0,[Not Rated],lcFAQRating)
                lcRatingOdr=IIF(lcFAQRating=[N],CHR(1)+[Not Rated],IIF(VAL(lcFAQRating)=10,[10],[ ]+alltr(lcFAQRating)))
         ENDCASE

         IF LEN(lcFAQRating)>0
          APPEND BLANK
          REPLACE FAQMajor WITH lcFAQMajorGroup
          REPLACE FAQLink WITH lcFAQLink
          REPLACE FAQTitle WITH lcFAQTitle
          REPLACE FAQAuthor WITH lcFAQAuthor
          REPLACE FAQDate WITH lcFAQDate
          REPLACE FAQRating WITH lcFAQRating
          REPLACE AuthOdr WITH PROPER(lcFAQAuthor)
          REPLACE RatingOdr WITH lcRatingOdr
          lcFAQRating=[]
         ENDIF
        ENDFOR
        SELECT * from FAQ_Info ORDER BY FAQDate DESCENDING INTO table temp
        SELECT FAQ_Info
        ZAP
        APPEND FROM temp
        LOCATE

        WAIT CLEAR
    ENDPROC

    PROCEDURE Init
     IF RECCOUNT()=0 AND FILE([c:/temp/Offline.txt]+TRANSFORM(lnForumNumber))=.f.
     MESSAGEBOX([No Internet Connection and no Offline Archive Available],[Error],0)
     thisform.command3.click
     ELSE
       This.Width  = _Screen.width*5.5/6
       This.Height = _Screen.Height*5.5/6
       THIS.Left   = (_Screen.width-THIS.Width)/2
       THIS.Top    = (_Screen.Height-THIS.Height)/3
       
        gcThisTitle=ALLTRIM(UPPER(FAQTitle))

        WITH thisform
        thisform.Caption=gcVarFAQArea
        .grid1.fontsize=8
        .grid1.FontName=[Arial]
        .grid1.readonly=.t.

        .grid1.column1.ControlSource=[FAQ_Info.FAQMajor]
        .grid1.column1.width=165
        .grid1.column1.header1.caption=[Major Group]

        .grid1.column2.ControlSource=[FAQ_Info.FAQTitle]
        .grid1.column2.width=530
        .grid1.column2.header1.caption=[FAQ Title]

        .grid1.column3.ControlSource=[FAQ_Info.FAQAuthor]
        .grid1.column3.width=100
        .grid1.column3.header1.caption=[FAQ Author]

        .grid1.column4.ControlSource=[FAQ_Info.FAQDate]
        .grid1.column4.width=70
        .grid1.column4.header1.caption=[FAQ Date]

        .grid1.column5.ControlSource=[FAQ_Info.FAQRating]
        .grid1.column5.width=70
        .grid1.column5.header1.caption=[FAQ Rating]

        IF .List1.ListCount=0
         .List1.addlistitem([Major Group],1)
         .List1.addlistitem([FAQ Author],2)
         .List1.addlistitem([FAQ Date],3)
         .List1.addlistitem([FAQ Rating],4)
        
         .Combo1.AddItem([VFP General Coding Issues])
         .Combo1.AddItem([VFP Databases, SQL&VFP, and Reports])
         .Combo1.AddItem([VFP Forms, Classes and Controls])
         .Combo1.AddItem([VFP Automation, Mail & 3rd Party Svcs])
         .Combo1.AddItem([VFP Web Related Issues])
         .Combo1.Width=250
         .Combo1.Value= [VFP General Coding Issues]
        ELSE
         thisform.list2.RowSource=[]
         thisform.list2.ControlSource=[]
         thisform.list2.refresh
        ENDIF

        .grid1.Refresh
        ENDWITH
        THIS.Resize
        ENDIF
        ENDPROC

&&This [resize] event brought to you by wgcs in Thread184-687849
    PROCEDURE Resize
      LOCAL lnHfact, lnWfact
        WITH thisform
          lnHFact = .height/615
          lnWFact = .width /1050

        .grid1.Top    = 5 * lnHFact
        .grid1.Left   = 5 * lnHFact
        .grid1.width  = 1045* lnWFact
        .grid1.height = 505 * lnHFact

        .grid1.column1.width= .grid1.width * (175/1035)
        .grid1.column2.width= .grid1.width * (545/1035)
        .grid1.column3.width= .grid1.width * (130/1035)
        .grid1.column4.width= .grid1.width * (75/1035)
        .grid1.column5.width= .grid1.width * (75/1035)

        .grid1.Refresh

        .optiongroup1.Left  = 16  * lnWFact
        .optiongroup1.Width = 180 * lnWFact
        .optiongroup1.Top   = 555 * lnHFact

        .list1.Left   = 210 * lnWFact
        .list1.Top    = 515 * lnHFact
        .list1.Height = 75  * lnHFact
        .list1.width  = 225 * lnWFact

        .list2.Left   = 455 * lnWFact
        .list2.Top    = 515 * lnHFact
        .list2.Height = 75  * lnHFact
        .list2.width  = 225 * lnWFact

        .text1.Left   = 685 * lnWFact
        .text1.Width  = 275 * lnWFact
        .text1.Top    = 550 * lnHFact
        
        .command1.Left   = 16  * lnWFact
        .command1.Width  = 180 * lnWFact
        .command1.Top    = 515 * lnHFact
        .command1.Height = 37  * lnHFact

        .command2.Left   = 685 * lnWFact
        .command2.Top    = 575 * lnHFact
        
        .command3.Left   = 973 * lnWFact
        .command3.Top    = 575 * lnHFact
        
        .command4.Left   = 840 * lnWFact
        .command4.Top    = 575 * lnHFact

        .combo1.Left     = 685 * lnWFact        
        .combo1.top      = 515 * lnHFact
        
        ENDWITH
    ENDPROC

    PROCEDURE combo1.InteractiveChange
        DO CASE
            CASE thisform.combo1.value=[VFP Automation, Mail & 3rd Party Svcs]
             lnForumNumber=1251
             
            CASE thisform.combo1.value=[VFP Databases, SQL&VFP, and Reports]
             lnForumNumber=1252

            CASE thisform.combo1.value=[VFP Forms, Classes and Controls]
             lnForumNumber=1254

            CASE thisform.combo1.value=[VFP Web Related Issues]
             lnForumNumber=1253

            OTHERWISE thisform.combo1.value=[VFP General Coding Issues]
             lnForumNumber=184
        ENDCASE
        lcForumName=thisform.combo1.value
        Thisform.Load
        Thisform.Init        
    ENDPROC

    PROCEDURE optiongroup1.InteractiveChange
        IF thisform.optiongroup1.Value=2 &&sort by
        thisform.LockScreen=.t.
        SELECT FAQ_Info
        SET FILTER TO
        LOCATE
        thisform.grid1.refresh
        thisform.LockScreen=.f.
        ENDIF
    ENDPROC

    PROCEDURE list1.Click
        thisform.LockScreen=.t.
        DO CASE
        CASE thisform.list1.value=[Major Group]
        gcFilterField=[FAQMajor]

        CASE thisform.list1.value=[FAQ Author]
        gcFilterField=[AuthOdr]

        CASE thisform.list1.value=[FAQ Date]
        gcFilterField=[FAQDate]

        CASE thisform.list1.value=[FAQ Rating]
        gcFilterField=[RatingOdr]
        ENDCASE

        thisform.list2.RowSource=[]
        thisform.list2.ControlSource=[]
        
        DO CASE
        CASE thisform.optiongroup1.Value=1 &&filter by
        IF gcFilterField=[FAQDate] OR gcFilterField=[RatingOdr]
          SELECT dist &gcFilterField as ff ORDER BY 1 descending from FAQ_Info INTO table templist2 nowait
        ELSE
          SELECT dist &gcFilterField as ff from FAQ_Info INTO table templist2 nowait
        ENDIF

        thisform.list2.RowSource=[templist2.ff]
        thisform.list2.ControlSource=[templist2.ff]
        thisform.list2.refresh

        CASE thisform.optiongroup1.Value=2 &&sort by
            IF gcFilterField=[FAQDate] OR gcFilterField=[RatingOdr]
            SELECT * from FAQ_Info ORDER BY &gcFilterField descending INTO table temp
            ELSE
            SELECT * from FAQ_Info ORDER BY &gcFilterField INTO table temp
            ENDIF
        SELECT FAQ_Info
        ZAP
        APPEND FROM temp
        ENDCASE

        GO top
        thisform.grid1.Refresh
        thisform.LockScreen=.f.
    ENDPROC

    PROCEDURE list2.Click
        IF thisform.optiongroup1.Value=1 &&filter by
        thisform.LockScreen=.t.
        gcFilterValue=thisform.list2.Value

        SELECT FAQ_Info
        SET FILTER TO EVALUATE(gcFilterField)=gcFilterValue
        GO TOP
        thisform.grid1.Refresh
        
        thisform.LockScreen=.f.
        ENDIF
    ENDPROC

    PROCEDURE grid1.Refresh
     IF RECCOUNT()>0
        WITH thisform.grid1
        .column1.DynamicBackColor =[IIF(UPPER(FAQTitle)=gcThisTitle,65535,16777215)]
        .column2.DynamicBackColor =[IIF(UPPER(FAQTitle)=gcThisTitle,65535,16777215)]
        .column3.DynamicBackColor =[IIF(UPPER(FAQTitle)=gcThisTitle,65535,16777215)]
        .column4.DynamicBackColor =[IIF(UPPER(FAQTitle)=gcThisTitle,65535,16777215)]
        .column5.DynamicBackColor =[IIF(UPPER(FAQTitle)=gcThisTitle,65535,16777215)]
        thisform.grid1.setfocus
        ENDWITH
      ENDIF
    ENDPROC

    PROCEDURE grid1.AfterRowColChange
        LPARAMETERS nColIndex
        SELECT faq_info
        gcThisTitle=ALLTRIM(UPPER(FAQTitle))
        thisform.grid1.Refresh
    ENDPROC

    PROCEDURE command1.Click
        SELECT faq_info
        lcURL=[www.tek-tips.com/]+ALLTRIM(FAQLink)
        loHyperlink = CREATEOBJECT([hyperlink])
        loHyperlink.navigateto(lcURL)
    ENDPROC

    PROCEDURE command2.Click
        IF LEN(ALLTRIM(thisform.text1.Value))>0
        SELECT faq_info
        SET FILTER TO (ALLTRIM(UPPER(thisform.text1.Value))) $ (UPPER(faqmajor)) OR ;
        (ALLTRIM(UPPER(thisform.text1.Value))) $ (UPPER(faqtitle)) OR ;
        (ALLTRIM(UPPER(thisform.text1.Value))) $ (UPPER(faqauthor)) OR ;
        (ALLTRIM(UPPER(thisform.text1.Value))) $ (UPPER(faqdate))
        ELSE
        SET FILTER TO
        ENDIF
       thisform.grid1.Refresh
    ENDPROC

    PROCEDURE command3.Click
     RELEASE form1,lnForumNumber, lcConnect
     DROP TABLE FAQ_Info
     DROP TABLE temp
     IF ADIR(laTempChk,[templist2.dbf])=1
      DROP TABLE templist2
     ENDIF
     RELEASE gcVarFAQArea, gcFilterField, gcFilterValue, gcThisTitle
     thisform.Release
     SET SAFETY ON
    ENDPROC
    
    PROCEDURE command4.Click
       thisform.text1.Value=[]
       SELECT faq_info
       SET FILTER TO
       thisform.grid1.Refresh
    ENDPROC
    
ENDDEFINE

Back to Microsoft: Visual FoxPro FAQ Index
Back to Microsoft: Visual FoxPro Forum

My Archive

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close