Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
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