version
6.50
0
Form1
238
268

6
Collections.dll
fgControlsDesktop.dll
FormLib.dll
HTTP.dll
ListviewDesktop.dll
StringsEx.dll
6
HTTP.dll
StringsEx.dll
Collections.dll
ListViewDevice.dll
fgControlsDevice.dll
FormLib.dll
12
lbl4:fgLabel
coltype:ColumnType
lbl2:fgLabel
strb:StringBuilder
response:WebResponse
frmMain:FormLib
stre:StringsEx
lbl3:fgLabel
sl:SortedList
lv:Listview
lbl1:fgLabel
request:WebRequest
0
Sub designer
addform(Form1,"Form1","",220,220,220)@
addlabel(form1,Label4,5,252,230,12,"Label4",220,220,220,0,0,0,True,True,9)@
addlabel(form1,Label3,5,190,225,18,"Label3",220,220,220,0,0,0,True,True,9)@
addlabel(form1,Label2,120,210,115,40,"Label2",220,220,220,0,0,0,True,True,9)@
addlabel(form1,Label1,5,210,115,40,"Label1",220,220,220,0,0,0,True,True,9)@
addtimer(form1,Timer1,5,245,500)@
addarraylist(form1,AL2,95,235,80,25)@
addarraylist(form1,AL1,5,235,80,25)@
addmenuitem(form1,mnuFile,"File",True,False)@
addmenuitem(mnufile,mnuSettings,"Settings",False,False)@
addmenuitem(mnufile,mnuHistory,"History",True,False)@
addmenuitem(mnufile,mnuAbout,"About",True,False)@
addmenuitem(mnufile,mnuQuit,"Exit",True,False)@
addmenuitem(form1,mnuUpdate,"Update",True,False)@
End Sub
@EndOfDesignText@
Sub Globals
      Dim Buffer(0) As byte
	  Dim StockData(0) As string
	 Dim Cells(3)
	  Dim Cats(10)
		Dim Controls(0)
		scale=1
		SortAscending=True
	  '<config>
	  updateInterval=10
	  stockSymbols="GM|F|HMC|TM"
	  stockHistory=AppPath & "\stockhistory.txt"
	  '</config>
	  
	  
	  timerCount=updateInterval
	  'tickertape=""
	  
	  programName="Pocket Quotes"
	  programVersion="D.11"
	  
	  '.11 - implemented listview
	  
	  'based on this ASP Alliance article: http://aspalliance.com/112_Building_a_Yahoo_stock_quote_ticker.all
	  
	  '//todo
	  '1 - stock history log - done
	  '2 - config editor
	  '3 - sort stock symbol list - done
	  '4 - vga - done
	  '5 - landscape
	  
	  basefactor=2 'Filippo addition
End Sub


Sub App_Start
     
	  Form1.Text=programName
	  'textbox1.Text=""
	  	  
	  'Filippo addition
	  frmMain.New1("Form1",B4PObject(1))

'Filippo changed
	   If form1.Height > 400 Then
			scale=2
			'ChangeToVGA
			'on PPC - add for menu bar at bottom
			If cPPC=True Then
				basefactor=52
			End If

		End If

	SetDisplay

'Filippo changed
	  'If form1.Height+52 > =form1.Width Then 'portrait
	   lv.New1("Form1",0,0,form1.Width,label3.top - 2)
	  'Else
	  '	lv.New1("Form1",0,0,form1.Width, form1.Height-2)
	'End If
	
	  coltype.New1
    lv.AddColumn("Stock",(form1.Width /3) ,0 ,False, coltype.NText ) 'does not exist "coltype.cVariant"
  '  lv.AddColumn("Price",(form1.Width /3.5) ,1 ,True, coltype.cDecimal)
	lv.AddColumn("Price",(form1.Width/3.5), 1, False, coltype.Money)
	lv.AddColumn("Change",(form1.Width /3.5) ,1,False, coltype.NText) 'does not exist "coltype.cVariant"
    Lv.Fontsize=10
	lv.Visible=True
	lv.FullRowSelect=True
    Lv.SetRowColor(cBeige,cSilver)
	  lv.AddContextMenu("Add")
	  lv.AddContextMenu("Edit")
	  lv.AddContextMenu("Delete")
	  Form1.Show
	  	  
	  'LoadTheme
	  
	  Timer1.Interval =  6000' 'milliseconds
      Timer1.Enabled = True

	  CheckMeOut
	  LoadINI
	  LoadStockSymbols
      UpdateStockData
	  If al2.Count > 0 Then
		DisplayStockData 
		
		lv.SelectRow(0)
		lv_SelectionChanged
	  Else
	  	'Msgbox("Unable to download stock data","Http quotes")
	  End If
	  
'Filippo changed
'	  If form1.Height > 400 Then
'			scale=2
'			ChangeToVGA
'		End If

	'Filippo addition
	frmMain_resize
End Sub

Sub frmMain_resize
	If form1.Height >= form1.Width Then 'portrait
		lv.Height=label3.top - 2 
	Else
		lv.Height=form1.Height - 2
	End If
End Sub

Sub SetDisplay
'set display for 320x320
If form1.Width=320 Then
	scale=1.25
'Else
'	scale=1 'Filippo changed
End If

'Filippo changed
'on PPC - add for menu bar at bottom
'If cPPC=True Then
'	basefactor=28
'Else
'	basefactor=2
'End If

'////////////////////////////////
'FORM1 controls
'////////////////////////////////
	label4.Height=12 * scale
	label1.Height=40* scale
	label2.Height=40* scale
	label3.Height=18* scale
	
	label4.Width=230* scale
	label4.Left=5* scale
	
	label1.Width=115* scale
	label1.Left=5* scale 'Filipppo changed
	
	label2.Width=115* scale
	label2.Left=label1.Left+label1.Width+2
	
	label3.Width=230* scale
	label3.Left=5* scale 'Filipppo changed
	
	
	  label4.Top=form1.Height-label4.Height - basefactor
	  label1.Top=label4.Top-label1.Height -2
	  label2.Top=label4.Top-label2.Height -2
	  label3.Top=label2.Top-label3.Height-2
	
	lbl1.New1("label1")
	lbl1.Transparent=True
	lbl1.ForeColor=cBlack
	lbl1.TextAlignment=lbl1.alLeft
	label1.FontSize=8
	label1.Text=""
	
	
	
	  lbl2.New1("label2")
	lbl2.Transparent=True
	lbl2.ForeColor=cBlack
	lbl2.TextAlignment=lbl2.alLeft
	label2.FontSize=8
	label2.Text=""
	
	  lbl3.New1("label3")
	lbl3.Transparent=True
	lbl3.ForeColor=cBlack
	lbl3.TextAlignment=lbl3.alCenter
	label3.FontSize=11
	label3.Text=""
	
	lbl4.New1("label4")
	lbl4.Transparent=True
	lbl4.ForeColor=cBlack
	lbl4.TextAlignment=lbl3.alCenter
	label4.FontSize=8
	label4.Text=""
	
	'form1.Image=AppPath & "\background.jpg"
	
End Sub

Sub CheckMeOut
	If FileExist(AppPath & "\pquote.ini") = False Then
		FileOpen(c1,AppPath & "\pquote.ini", cWrite,,cASCII)
		FileWrite(c1, "updateInterval=" & updateInterval)
		FileWrite(c1, "stockSymbols=" & stockSymbols)
		FileWrite(c1, "stockHistory=" & stockHistory)
		FileClose(c1)
	End If
	If DirExist(AppPath & "\cache") = False Then
		DirCreate(AppPath & "\cache")
	End If
		
End Sub

Sub LoadINI
	FileOpen(c1, AppPath & "\pquote.ini",cRead,,cASCII)
	stre.New1
	
	r=FileRead(c1)
	Do Until r= EOF
	x=StrIndexOf(r,"=",0)
	If x >0 Then
		ini=SubString(r,0,x)
		
		value=SubString(r,x+1, StrLength(r)-x-1)
		stre.Trim(value)
		
		Select ini
			Case "updateInterval"
				updateInterval=value
			Case "stockSymbols"
				stockSymbols=value
			Case "stockHistory"
				stockHistory=value
		End Select
	End If
	r=FileRead(c1)
	Loop
	FileClose(c1)


End Sub
Sub LoadStockSymbols

	sl.New1

	StockData()=StrSplit(stockSymbols,"|")
	For i = 0 To ArrayLen(StockData())-1 
		If StockData(i) <> "" Then
			'AL1.Add(StockData(i) )
			sl.Add(StockData(i),StockData(i) )
		End If
	Next 
	For x=0 To sl.Count -1
		al1.Add(sl.GetKeyAt(x) )
	Next
	
	
End Sub

Sub UpdateStockData
	AL2.Clear
	For x=0 To AL1.Count-1
		symbol=AL1.Item(x)
		URL="http://quote.yahoo.com/d/quotes.csv?s=" & symbol & "&d=t&f=sl1d1t1c1ohgvj1pp2wern"
		data=GetText(URL)
		If data="" Then
			data=readCache(symbol)
			If data="" Then
			''Msgbox("No data from http request","Http error")
			Else
				al2.Add(data)
			End If
			
		Else
				'AL2.Add(GetText(URL) )
				al2.Add(data)
				SaveCache(symbol, data)
			If mnuHistory.Checked=True Then
				WriteStockHistory(AL2.Item(x) )
			End If
		End If
	Next

End Sub
Sub saveCache (symbol,data)
	FileOpen(c1, AppPath & "\cache\" & symbol & ".cache",cWrite,,cASCII)
	FileWrite(c1, data)
	FileClose(c1)
End Sub
Sub readCache(symbol)
	If FileExist(AppPath & "\cache\" & symbol & "\.cache") = True Then
		FileOpen(c1,AppPath & "\cache\" & symbol & "\.cache",cRead,,cASCII)
		r=FileRead(c1)
		FileClose(c1)
	Else
		r=""
	End If
	
	Return r
End Sub

Sub DisplayStockData
'function stub
ErrorLabel (DisplayStockDataError)

If al2.Count > 0 Then


'listbox1.Clear
lv.RemoveAllRows


	For x=0 To AL2.Count -1
		StockData()=StrSplit(AL2.Item(x), ",")
		'get rid of quotes
		strb.New1(50)
		strb.Append(StockData(0) )
		strb.Replace(Chr(34), "")
		symbol=strb.ToString
		cells(0)=symbol
		cells(1)=StockData(1)
		cells(2)=StockData(4)
		lv.AddRow(cells() )
		
		
		'listbox1.Add( symbol & cTab & StockData(1) & cTab & StockData(4) )
	Next

	' lv.SelectedRow(0)
	'listbox1.SelectedIndex=0

End If

DisplayStockDataError:

End Sub

Sub lv_SelectionChanged


ErrorLabel(lvSC_error)
     'label1.text="Selected Row: " & lv.SelectedRow
	 StockData()=StrSplit(AL2.Item(lv.SelectedRow), "," )
	
	
	
	strb.New1(50)
	strb.Append(StockData(15) )
	strb.Replace(Chr(34), "")
	company=strb.ToString
	
	x =StrIndexOf(company,CRLF,0)
	If x > 0 Then
		company=SubString(company,0,x)
	End If
	
	strb.New1(50)
	strb.Append(StockData(3))
	strb.Replace(Chr(34),"")
	stkTime=strb.ToString
	
	strb.New1(50)
	strb.Append(StockData(2) )
	strb.Replace(Chr(34), "")
    stkDate=strb.ToString
	
	strb.New1(50)
	strb.Append(StockData(12) )
	strb.Replace(Chr(34), "")
	'history="52 week: " & strb.ToString
	
	traded="Last trade:" & stkTime & " est on " & stkDate 
	
		
	'fluctuation="Highest: " & StockData(6) & " Lowest: " & StockData(7)

	fluctL="Highest:" & stre.PadLeft(StockData(6), 15, Chr(32))
	fluctR="Lowest:" & stre.PadLeft(StockData(7),15, Chr(32))
	fluctuation=fluctL & CRLF  & fluctR


	'TextBox1.Text=  company   & CRLF & recent & CRLF &  fluctuation & CRLF &  history & CRLF & traded
	
	'label1.Text=company
	
	recentL="Close:" & stre.PadLeft(StockData(10),15,Chr(32))
	recentR="Open:" & stre.PadLeft(StockData(5),15, Chr(32))
	recent=recentL & CRLF & recentR
	
	
	
	
	
	'tickertape=" * Symbol: " & lv.Cellget("Stock", lv.SelectedRow) & " * " & recent & " *  " & fluctuation & " *  " & history & " *  " & traded
	label1.Text=CRLF & recent 
	label2.Text=  CRLF & fluctuation
	label3.Text=company
	label4.Text=traded
	lvSC_error:
	
End Sub



Sub mnuUpdate_Click
	UpdateStockData
	If al2.Count > 0 Then
		DisplayStockData
		lv.SelectRow(0)
	   lv_SelectionChanged
	End If
End Sub
Sub Lv_DoubleClick
 Msgbox("Future screen: show information for " & lv.Cellget("Stock",lv.SelectedRow),"Program TODO")
End Sub

Sub lv_ColumnClick
	'mnuUpdate_Click
'lv.TableSort("colFamilyName ASC")

  'SortAscending=Not(SortAscending)
 ' lv.SortColumn(lv.SelectedColumn,SortAscending)
End Sub
Sub GetText (URL)
ErrorLabel (GetTextError)
      Response.New1
	  
      Request.New1(URL)
	  request.TimeOut=30000
      Response.Value = Request.GetResponse 'This line calls the server and gets the response.
      string = Response.GetString 'Get the Response string.
      Response.Close
      Return string
GetTextError:
	  Return ""
End Sub
Sub WriteStockHistory(str)
	FileOpen(c1,stockHistory, cWrite, cAppend, cASCII)
	FileWrite(c1, str)
	FileClose(c1)

End Sub


Sub mnuQuit_Click
	AppClose
End Sub

Sub Timer1_Tick
	 timerCount=timerCount-1
     If timerCount < = 0 Then 
	 	timerCount=updateInterval
		mnuUpdate_Click
	 End If
	 
End Sub

Sub mnuAbout_Click
	Msgbox(programName & CRLF & programVersion, "About")
End Sub

Sub mnuHistory_Click
	If mnuHistory.Checked=True Then
		mnuHistory.Checked=False
	Else
		mnuHistory.Checked=True
	End If
End Sub

Sub Lv_Contextclick
    Select Lv.SelectedContextMenu
       Case "Delete"
           'Do something
		   lv.RemoveRow(lv.SelectedRow)
       Case "Edit"
            'Do something
			Msgbox(lv.SelectedRow)
	Case "Add"
		'Do Something
		Msgbox("Future: add stock to list", "Program TODO")
      End Select
End Sub

Sub ChangeToVGA
    Controls() = GetControls("")
    For i = 0 To ArrayLen(Controls())-1
        Select ControlType(Controls(i))
            Case "ListBox","NumUpDown","Button","TextBox","Label","ComboBox","Panel","RadioBtn","Table","ImageButton","CheckBox","Image"
                Control(Controls(i)).Left = 2 * Control(Controls(i)).Left
                Control(Controls(i)).Top = 2 * Control(Controls(i)).Top
                Control(Controls(i)).Height = 2 * Control(Controls(i)).Height
                Control(Controls(i)).Width = 2 * Control(Controls(i)).Width
'*** Uncomment these lines if your application includes Tables.
'                If ControlType(Controls(i)) = "Table" Then
'                    tbl = Controls(i)
'                    For i2 = 0 To Control(tbl,Table).ColCount-1
'                        col = Control(tbl,Table).ColName(i2)
'                        Control(tbl,Table).ColWidth(col) = Control(tbl,Table).ColWidth(col) * 2
'                    Next
'                End If
        End Select
    Next
End Sub