Imaginecorp
IS-IT--Management
Thanks to Olaf for the excellent code and idea, for anyone interested in creating a tag cloud instead of a grid, they are pretty cool, here is how you can do it in VFP. This is to give you an idea on how it can be done, based upon this you can create your own, it is extremely simple
This has not been tested thoroughly, you will have to fine tune…
First create a subclass of a label, and then create 2 forms.
Thats is it...
This has not been tested thoroughly, you will have to fine tune…
First create a subclass of a label, and then create 2 forms.
Code:
**************************************************
*-- Class Library: c:\imaginecorp\libraries\tagcloud.vcx
**************************************************
**************************************************
*-- Class: tool_label (c:\imaginecorp\libraries\tagcloud.vcx)
*-- ParentClass: label
*-- BaseClass: label
*-- Time Stamp: 04/24/07 08:16:09 PM
*
DEFINE CLASS tool_label AS label
AutoSize = .T.
BackStyle = 0
Caption = "Label1"
Height = 17
Width = 40
Name = "tool_label"
PROCEDURE MouseEnter
Lparameters nButton, nShift, nXCoord, nYCoord
This.ToolTipText = "Double Click to view Transcations"
This.BackColor = Rgb(255,255,204)
This.BackStyle = 1
This.ForeColor = Rgb(0,0,0)
ENDPROC
PROCEDURE MouseLeave
Lparameters nButton, nShift, nXCoord, nYCoord
This.ToolTipText = ""
This.ForeColor = This.oldcolor
This.BackColor = This.Parent.BackColor
This.BackStyle = 0
ENDPROC
PROCEDURE Init
With This
.AddProperty("custid","")
.AddProperty("OldColor",0)
.BackColor = .Parent.BackColor
Endwith
ENDPROC
PROCEDURE DblClick
Do Form tagcloud_display With This.custid,This.Caption,;
IIF(This.Left < (Thisform.Width/2),"Right","Left")
ENDPROC
ENDDEFINE
*
*-- EndDefine: tool_label
**************************************************
Code:
PUBLIC oform1
oform1=NEWOBJECT("form1")
oform1.Show
RETURN
**************************************************
*-- Form: form1 (c:\imaginecorp\tag_cloud.scx)
*-- ParentClass: form
*-- BaseClass: form
*-- Time Stamp: 04/24/07 08:27:11 PM
*
DEFINE CLASS form1 AS form
Height = 400
Width = 600
ScrollBars = 2
DoCreate = .T.
ShowTips = .T.
AutoCenter = .T.
BorderStyle = 2
Caption = "TagClouds: Customer Purchases...."
BackColor = RGB(249,249,249)
Name = "Form1"
PROCEDURE QueryUnload
Aused(temp)
For x = 1 To Alen(temp,1)
Use In (temp[x,1])
Endfor
ENDPROC
PROCEDURE Init
[B][I]*****Change the following to where you
*****saved the Label class
Set Classlib To c:\imaginecorp\libraries\tagcloud[/I][/B]
***************************************
Local lnMaxFontsize, lnMinFontsize ,lnMaxbrightness
lnMaxbrightness=200
lnMaxFontsize=30
lnMinFontsize=9
Close Databases All
Open Database Home()+"Samples\Northwind\Northwind.dbc"
Select;
Customers.Companyname,customers.customerid as custid,CustomerStats.nOrders,;
Sum(Orderdetails.quantity * Orderdetails.unitprice * (1-Orderdetails.discount)) As nTotal,;
(CustomerStats.dTo-CustomerStats.dFrom+1) As nDays;
From;
Customers,orders,Orderdetails,(Select Customerid,;
Count(*) As nOrders,Min(orderdate) As dFrom,Max(orderdate) As dTo;
FROM orders ;
Group By 1 ) As CustomerStats;
Group By Companyname,custid,nOrders,nDays;
Order By Companyname;
Where Customers.Customerid = CustomerStats.Customerid;
and orders.Customerid = Customers.Customerid;
and orders.Orderid = Orderdetails.Orderid;
Into Cursor curCustomers nofilter
Select;
MAX(nTotal) As nMax,;
Max(nTotal/nOrders) As nMaxAverageOrders,;
Max(nTotal/nDays) As nMaxAverageTotal;
From curCustomers;
Into Cursor curMax
nMaxTotal = Int(Mton(curMax.nMax))
Select curCustomers
Store 0 To nRecno, nLeft, nwidth, nheight, nFontHeight,nwidth,nTop
nTop = 33
nLeft = 3
With This
Scan
nRecno = nRecno + 1
nFontSize = Ceiling(Int(Mton(curCustomers.nTotal/curCustomers.nOrders/;
curMax.nMaxAverageOrders*(lnMaxFontsize-lnMinFontsize)+lnMinFontsize+.5)))
nFontHeight = Fontmetric(1,"Arial",nFontSize)
NewWidth = (Len(Alltrim(curCustomers.Companyname))*Fontmetric(6,"Arial",nFontSize))
If (nLeft+NewWidth) > .Width
nLeft = 3
nTop = nTop + lnMaxFontsize + 15
nheight = nheight + nTop + 34
.Height = nheight
Endif
clabel = "label"+Transform(nRecno)
.AddObject(clabel,"tool_label")
oCont = Evaluate("this."+clabel)
With oCont
.Caption = Alltrim(curCustomers.Companyname)
.custid = curCustomers.custid
.ForeColor = RGB(0,0,0)
.OldColor = .ForeColor
.FontSize = nFontSize
.Top = (nTop - nFontHeight)+1
.Left = nLeft
.Visible = .T.
Endwith
nwidth = oCont.Width
nLeft = nLeft + (nwidth + 10)
Endscan
.Height = 400
.Width = 615
Endwith
ENDPROC
ENDDEFINE
*
*-- EndDefine: form1
**************************************************
Code:
PUBLIC ocloudorders
ocloudorders=NEWOBJECT("cloudorders")
ocloudorders.Show
RETURN
**************************************************
*-- Form: cloudorders (c:\imaginecorp\tagcloud_display.scx)
*-- ParentClass: form
*-- BaseClass: form
*-- Time Stamp: 04/24/07 08:37:04 PM
*
DEFINE CLASS cloudorders AS form
Top = 48
Left = 58
Height = 235
Width = 478
DoCreate = .T.
BorderStyle = 2
Caption = "Form1"
Name = "cloudorders"
ADD OBJECT grid1 AS grid WITH ;
ColumnCount = 6, ;
DeleteMark = .F., ;
GridLines = 3, ;
Height = 200, ;
Left = 5, ;
ReadOnly = .T., ;
RecordMark = .T., ;
RecordSource = ['" "'], ;
ScrollBars = 2, ;
Top = 5, ;
Width = 467, ;
GridLineColor = RGB(192,192,192), ;
HighlightStyle = 2, ;
AllowCellSelection = .F., ;
Name = "Grid1", ;
Column1.ControlSource = "", ;
Column1.Width = 70, ;
Column1.ReadOnly = .T., ;
Column1.Name = "Column1", ;
Column2.ColumnOrder = 3, ;
Column2.ControlSource = "", ;
Column2.Width = 70, ;
Column2.ReadOnly = .T., ;
Column2.Name = "Column2", ;
Column3.ColumnOrder = 2, ;
Column3.ControlSource = "", ;
Column3.Width = 70, ;
Column3.ReadOnly = .T., ;
Column3.Name = "Column3", ;
Column4.ControlSource = "", ;
Column4.Width = 70, ;
Column4.ReadOnly = .T., ;
Column4.Name = "Column4", ;
Column5.ControlSource = "", ;
Column5.Width = 75, ;
Column5.ReadOnly = .T., ;
Column5.Format = "R$", ;
Column5.InputMask = "###,###.##", ;
Column5.Name = "Column5", ;
Column6.ControlSource = "", ;
Column6.Width = 75, ;
Column6.ReadOnly = .T., ;
Column6.Format = "R$", ;
Column6.InputMask = "###,###.##", ;
Column6.Name = "Column6"
ADD OBJECT cloudorders.grid1.column1.header1 AS header WITH ;
Caption = "Order ID", ;
Name = "Header1"
ADD OBJECT cloudorders.grid1.column1.text1 AS textbox WITH ;
BorderStyle = 0, ;
Margin = 0, ;
ReadOnly = .T., ;
ForeColor = RGB(0,0,0), ;
BackColor = RGB(255,255,255), ;
Name = "Text1"
ADD OBJECT cloudorders.grid1.column2.header1 AS header WITH ;
Caption = "Req. Date", ;
Name = "Header1"
ADD OBJECT cloudorders.grid1.column2.text1 AS textbox WITH ;
BorderStyle = 0, ;
Margin = 0, ;
ReadOnly = .T., ;
ForeColor = RGB(0,0,0), ;
BackColor = RGB(255,255,255), ;
Name = "Text1"
ADD OBJECT cloudorders.grid1.column3.header1 AS header WITH ;
Caption = "Order Date", ;
Name = "Header1"
ADD OBJECT cloudorders.grid1.column3.text1 AS textbox WITH ;
BorderStyle = 0, ;
Margin = 0, ;
ReadOnly = .T., ;
ForeColor = RGB(0,0,0), ;
BackColor = RGB(255,255,255), ;
Name = "Text1"
ADD OBJECT cloudorders.grid1.column4.header1 AS header WITH ;
Caption = "Ship Date", ;
Name = "Header1"
ADD OBJECT cloudorders.grid1.column4.text1 AS textbox WITH ;
BorderStyle = 0, ;
Margin = 0, ;
ReadOnly = .T., ;
ForeColor = RGB(0,0,0), ;
BackColor = RGB(255,255,255), ;
Name = "Text1"
ADD OBJECT cloudorders.grid1.column5.header1 AS header WITH ;
Caption = "Freight", ;
Name = "Header1"
ADD OBJECT cloudorders.grid1.column5.text1 AS textbox WITH ;
BorderStyle = 0, ;
Margin = 0, ;
ReadOnly = .T., ;
ForeColor = RGB(0,0,0), ;
BackColor = RGB(255,255,255), ;
Name = "Text1"
ADD OBJECT cloudorders.grid1.column6.header1 AS header WITH ;
Caption = "Cost", ;
Name = "Header1"
ADD OBJECT cloudorders.grid1.column6.text1 AS textbox WITH ;
BorderStyle = 0, ;
Margin = 0, ;
ReadOnly = .T., ;
ForeColor = RGB(0,0,0), ;
BackColor = RGB(255,255,255), ;
Name = "Text1"
ADD OBJECT text1 AS textbox WITH ;
Format = "R$", ;
Height = 23, ;
InputMask = "###,###,###.##", ;
Left = 322, ;
ReadOnly = .T., ;
TabStop = .F., ;
Top = 207, ;
Width = 130, ;
Name = "Text1"
ADD OBJECT label1 AS label WITH ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "Total Purchases Todate:", ;
Height = 17, ;
Left = 170, ;
Top = 211, ;
Width = 136, ;
Name = "Label1"
PROCEDURE Deactivate
This.Release
ENDPROC
PROCEDURE Init
Lparameters pCustId,pcustname,pMove
Set Talk Off
This.Left = Iif(pMove = "Left",5,((_Screen.Width - This.Width) - 10))
This.Top = 5
This.Caption = Alltrim(pcustname)+"'s Transcations..."
Select customers.companyname,orders.orderid,orders.orderdate,;
orders.requireddate,orders.shippeddate,orders.freight,Sum((orderdetails.unitprice*orderdetails.quantity)-;
((orderdetails.unitprice*orderdetails.quantity)*orderdetails.discount)) As totalcost ;
FROM customers,orders,orderdetails ;
WHERE customers.customerid = pCustId ;
AND customers.customerid = orders.customerid ;
AND orders.orderid = orderdetails.orderid ;
GROUP By 1,2,3,4,5,6 ;
ORDER By 3,2 ;
INTO Cursor custcursor
Calculate Sum(totalcost+freight) To This.text1.Value
With This.grid1
.RecordSource = "custcursor"
.column1.ControlSource = "custcursor.orderid"
.column2.ControlSource = "custcursor.orderdate"
.column3.ControlSource = "custcursor.requireddate"
.column4.ControlSource = "custcursor.shippeddate"
.column5.ControlSource = "custcursor.freight"
.column6.ControlSource = "custcursor.totalcost"
.Refresh
Go Top
Endwith
ENDPROC
ENDDEFINE
*
*-- EndDefine: cloudorders
**************************************************Thats is it...