oform = Newobject("myform") oform.Width=oform.timeline1.Width oform.Height=oform.timeline1.Height oform.Show Define Class myform As Form Caption = "Timeline for financial movement" listipwindow=.f. showtips=.t. Add Object timeline As timeline With Visible = .T., Name = "timeline1" Procedure Init This.timeline1.dDt_start=Date()-110 This.timeline1.dDt_end=Date()+40 This.timeline1.dDt_base=Date() If Used("cur_test") Use In "cur_test" Endif Select 0 Create Cursor cur_test (numdoc c(8),dtmovim d(10),idmovim c(2),vlmovim N(12,2)) i2=1 For i = 1 To 50 If i<26 m.idmovim="01" && forecast movement i2=i2+1 Else m.idmovim="02" && payment movement i2=i2-1 Endif m.numdoc=Transform(i2,"@L 999999") m.dtmovim=This.timeline1.dDt_start+i2 m.vlmovim=110.32 Insert Into cur_test From Memvar Endfor Endproc Procedure Show This.timeline1.setup_timeline() ldbase = Thisform.timeline1.dDt_base ldend = Thisform.timeline1.dDt_end ldstart = Thisform.timeline1.dDt_start *SET STEP on Dimension asema[7] asema[1] = "Sun" asema[2] = "Mon" asema[3] = "Tue" asema[4] = "Wed" asema[5] = "Thu" asema[6] = "Fry" asema[7] = "Sat" Thisform.timeline1.clearall() Select cur_test Scan If Inlist(idmovim,"01","02") Else Loop Endif lntipo = Iif(idmovim="01",3,4) If Empty(dtmovim) lcday = "" Else lcday = asema[DOW(dtmovim)]+" "+Transform(Day(dtmovim),"@L 99") Endif lcdescri = Iif(idmovim="01","Forecast/","Payment/")+lcday+"/"+Alltrim(numdoc)+"/"+Transform(vlmovim,"9999,999,999.99")+Chr(13) lnvlverde=vlmovim lnvlverme=0 lnvlbase=0 This.timeline1.event_insert(lntipo, dtmovim, lnvlverde, lnvlverme, lnvlbase, lcdescri) lccab = "" Endscan Endproc Enddefine Define Class month As Container Width = 107 Height = 147 BorderWidth = 0 BackColor = Rgb(221,221,221) ntipo = 0 Name = "month" *\ *\ Member Object Label1 *\ Add Object Label1 As Label With; AutoSize = .T.,; FontBold = .T.,; FontSize = 8,; BackStyle = 0,; Caption = "Label1",; Height = 16,; Left = 7,; Top = 128,; Width = 38,; ForeColor = Rgb(197,188,203),; Name = "Label1" *\ *\ Member Object Line1 *\ Add Object Line1 As Line With; BorderWidth = 1,; Height = 28,; Left = 0,; Top = 118,; Width = 0,; BorderColor = Rgb(180,170,188),; Name = "Line1" *\ *\ Member Object Line2 *\ Add Object Line2 As Line With; Height = 0,; Left= (-2),; Top = 118,; Width = 130,; BorderColor = Rgb(202,197,207),; Name = "Line2" Procedure Init() This.ntipo = Iif(Type("this.parent.ntipo")="N",This.Parent.ntipo,2) Endproc Enddefine &&month Define Class messages As Form Top = 0 Left = 0 Height = 120 Width = 230 Desktop = .T. ShowWindow = 2 DoCreate = .T. BorderStyle = 1 Caption = "" ControlBox = .F. Closable = .F. MaxButton = .F. MinButton = .F. Movable = .F. TabStop = .F. TitleBar = 0 AlwaysOnTop = .T. BackColor = Rgb(255,255,193) oparent= "" Name = "messages" *\ *\ Member Object Timer1 *\ Add Object Timer1 As Timer With; Top = 28,; Left = 286,; Height = 23,; Width = 23,; Enabled = .F.,; Interval = 10000,; Name = "Timer1" Procedure Timer1.Timer() This.Enabled=.F. Thisform.Visible=.F. Endproc *\ *\ Member Object List1 *\ Add Object List1 As ListBox With; FontSize = 7,; ColumnCount = 4,; ColumnWidths = "45,30,60,80",; Height = 85,; ColumnLines = .F.,; IncrementalSearch = .F.,; Left = 0,; SpecialEffect = 1,; TabStop = .F.,; Top = 15,; Width = 230,; ItemForeColor = Rgb(193,97,0),; ItemBackColor = Rgb(255,255,179),; SelectedItemForeColor = Rgb(255,128,64),; SelectedItemBackColor = Rgb(255,255,128),; BorderColor = Rgb(255,255,198),; Themonth = .F.,; AutoHideScrollbar = 1,; Name = "List1" Procedure List1.MouseMove() Lparameters nButton, nShift, nXCoord, nYCoord Thisform.Timer1.Reset Endproc Procedure List1.KeyPress() Lparameters nKeyCode, nShiftAltCtrl Thisform.Timer1.Reset Endproc *\ *\ Member Object Label1 *\ Add Object Label1 As Label With; BackStyle = 0,; Caption = "Tipo",; Height = 17,; Left = 4,; Top= (-1),; Width = 40,; ForeColor = Rgb(255,128,0),; Name = "Label1" *\ *\ Member Object Label2 *\ Add Object Label2 As Label With; BackStyle = 0,; Caption = "Num.doc.",; Height = 17,; Left = 79,; Top= (-1),; Width = 55,; ForeColor = Rgb(255,128,0),; Name = "Label2" *\ *\ Member Object Label3 *\ Add Object Label3 As Label With; BackStyle = 0,; Caption = "Value",; Height = 17,; Left = 167,; Top= (-1),; Width = 31,; ForeColor = Rgb(255,128,0),; Name = "Label3" *\ *\ Member Object Line1 *\ Add Object Line1 As Line With; Height = 0,; Left= (-1),; Top = 13,; Width = 47,; BorderColor = Rgb(255,128,0),; Name = "Line1" *\ *\ Member Object Line2 *\ Add Object Line2 As Line With; Height = 0,; Left = 80,; Top = 13,; Width = 55,; BorderColor = Rgb(255,128,0),; Name = "Line2" *\ *\ Member Object Line3 *\ Add Object Line3 As Line With; Height = 0,; Left = 145,; Top = 13,; Width = 56,; BorderColor = Rgb(255,128,0),; Name = "Line3" *\ *\ Member Object Line4 *\ Add Object Line4 As Line With; Height = 0,; Left= (-3),; Top = 101,; Width = 47,; BorderColor = Rgb(255,128,0),; Name = "Line4" *\ *\ Member Object Line5 *\ Add Object Line5 As Line With; Height = 0,; Left = 80,; Top = 101,; Width = 55,; BorderColor = Rgb(255,128,0),; Name = "Line5" *\ *\ Member Object Line6 *\ Add Object Line6 As Line With; Height = 0,; Left = 145,; Top = 101,; Width = 56,; BorderColor = Rgb(255,128,0),; Name = "Line6" *\ *\ Member Object lbltotal *\ Add Object lbltotal As Label With; FontBold = .T.,; FontSize = 7,; Alignment = 1,; BackStyle = 0,; Caption = "Value",; Height = 12,; Left = 141,; Top = 103,; Width = 57,; ForeColor = Rgb(255,128,0),; Name = "lbltotal" Procedure Init() Declare SetWindowLong In Win32Api As _Sol_SetWindowLong Integer, Integer, Integer Declare SetLayeredWindowAttributes In Win32Api As _Sol_SetLayeredWindowAttributes Integer, String, Integer, Integer Endproc Procedure Deactivate() This.Visible = .F. Thisform.oparent.listipwindow=.F. Endproc Procedure Show() Lparameters nStyle #Define BADOS_LOC "Is available for XP or beyond" If Val(Os(3))<5 messagebox(BADOS_LOC) Return .F. Endif _Sol_SetWindowLong(Thisform.HWnd, -20, 0x00080000) _Sol_SetLayeredWindowAttributes(Thisform.HWnd, 0, 200, 2) Endproc Enddefine &&messages Define Class semana As Container Width = 38 Height = 118 BorderWidth = 0 BackColor = Rgb(238,238,238) lbinddone = .F. ntipo = 0 ntotal = 0 Name = "semana" *\ *\ Member Object Shape1 *\ Add Object Shape1 As Shape With; Top = 28,; Left = 4,; Height = 67,; Width = 14,; BorderStyle = 0,; Visible = .F.,; BackColor = Rgb(204,157,149),; Name = "Shape1" Procedure Shape1.Click() This.Parent.show_message(This.cmessage,This.ntotal) Endproc Procedure Shape1.Init() This.AddProperty("cmessage","") This.AddProperty("ntotal",0) This.AddProperty("ncntpass",0) Endproc *\ *\ Member Object Label1 *\ Add Object Label1 As Label With; FontSize = 7,; WordWrap = .T.,; Alignment = 1,; BackStyle = 0,; Caption = "Label1",; Height = 18,; Left = 2,; Top = 100,; Width = 33,; ForeColor = Rgb(183,170,195),; Name = "Label1" *\ *\ Member Object Line1 *\ Add Object Line1 As Line With; Height = 126,; Left = 37,; Top = 0,; Width = 0,; BorderColor = Rgb(221,221,221),; Name = "Line1" *\ *\ Member Object Shape2 *\ Add Object Shape2 As Shape With; Top= (-1),; Left = 20,; Height = 96,; Width = 14,; BorderStyle = 0,; Visible = .F.,; BackColor = Rgb(176,208,182),; Name = "Shape2" Procedure Shape2.Click() This.Parent.show_message(This.cmessage,This.ntotal) Endproc Procedure Shape2.Init() This.AddProperty("cmessage","") This.AddProperty("ntotal",0) This.AddProperty("ncntpass",0) Endproc *\ *\ Member Object Image1 *\ * Add Object Image1 As Image With; * Picture= "..\galeria\png\01.png", Add Object Image1 As Shape With; Height = 10,; Left = 10,; Top = 17,; Visible = .F.,; Width = 10,; backcolor=RGB(255,0,0),; curvature=50,; Name = "Image1" Procedure Image1.Click() This.Parent.show_message(This.cmessage,This.ntotal) Endproc Procedure Image1.Init() This.AddProperty("cmessage","") This.AddProperty("ntotal",0) This.AddProperty("ncntpass",0) Endproc *\ *\ Member Object Image2 *\ * Add Object Image2 As Image With; * Picture= "..\galeria\png\02.png", Add Object Image2 As Shape With; Height = 10,; Left = 10,; Top = 45,; Visible = .F.,; Width = 10,; backcolor=RGB(0,255,0),; curvature=50,; Name = "Image2" Procedure Image2.Click() This.Parent.show_message(This.cmessage,This.ntotal) Endproc Procedure Image2.Init() This.AddProperty("cmessage","") This.AddProperty("ntotal",0) This.AddProperty("ncntpass",0) Endproc *\ *\ Member Object Image3 *\ * Add Object Image3 As Image With; * Picture= "..\galeria\png\03.png", Add Object Image3 As Shape With; Height = 10,; Left = 10,; Top = 60,; Visible = .F.,; Width = 10,; backcolor=RGB(0,128,192),; curvature=50,; Name = "Image3" Procedure Image3.Click() This.Parent.show_message(This.cmessage,This.ntotal) Endproc Procedure Image3.Init() This.AddProperty("cmessage","") This.AddProperty("ntotal",0) This.AddProperty("ncntpass",0) Endproc *\ *\ Member Object Image4 *\ * Add Object Image4 As Image With; * Picture= "..\galeria\png\07.png", Add Object Image4 As Shape With; Height = 10,; Left = 10,; Top = 31,; Visible = .F.,; Width = 10,; backcolor=RGB(255,0,255),; curvature=50,; Name = "Image4" Procedure Image4.Click() This.Parent.show_message(This.cmessage,This.ntotal) Endproc Procedure Image4.Init() This.AddProperty("cmessage","") This.AddProperty("ntotal",0) This.AddProperty("ncntpass",0) Endproc Procedure show_message() Lparameters pcMessage, pntotal Thisform.omessages.List1.Clear() Do While .T. If Empty(pcMessage) Exit Endif lnpos=At(Chr(13),pcMessage) If lnpos>0 pcMsg = Substr(pcMessage,1,lnpos-1) pcMessage = Stuff(pcMessage,1,lnpos,"") Else Exit Endif lnpos=At("/",pcMsg) If lnpos>0 lctype=Substr(pcMsg,1,lnpos-1) pcMsg=Stuff(pcMsg,1,lnpos,"") Else lctype="" Endif lnpos=At("/",pcMsg) If lnpos>0 lcday=Substr(pcMsg,1,lnpos-1) pcMsg=Stuff(pcMsg,1,lnpos,"") Else lcday="" Endif lnpos=At("/",pcMsg) If lnpos>0 lcdoc=Substr(pcMsg,1,lnpos-1) pcMsg=Stuff(pcMsg,1,lnpos,"") Else lcdoc="" Endif lcval=pcMsg Thisform.listipwindow=.T. With Thisform.omessages .Top = Mrow(_Screen.Name,3)-(.Height/3)+10 .Left = Mcol(_Screen.Name,3)-(.Width/2) .List1.AddItem(lctype) .List1.ListItem(.List1.ListCount,2)=lcday .List1.ListItem(.List1.ListCount,3)=lcdoc .List1.ListItem(.List1.ListCount,4)=lcval .Timer1.Enabled = .T. .Visible = .T. Endwith Enddo Thisform.omessages.lbltotal.Caption=Transform(pntotal,"9999,999,999.99") Endproc Procedure Init() This.ntipo = Iif(Type("this.parent.ntipo")="N",This.Parent.ntipo,2) Endproc Enddefine &&semana Define Class timeline As Container Width = 586 Height = 150 SpecialEffect = 1 MousePointer = 9 BackColor = Rgb(238,238,238) dDt_start = ({}) dDt_end = ({}) dDt_base = ({}) ntipo = 2 Name = "timeline" *\ *\ Member Object otimeline *\ Add Object otimeline As Container With; Top = 2,; Left = 2,; Width = 293,; Height = 148,; BackStyle = 0,; BorderWidth = 0,; MousePointer = 9,; Name = "otimeline" Procedure otimeline.Init() Thisform.AddProperty("omessages",Newobject("messages")) Thisform.omessages.oparent=Thisform This.AddProperty("perae",.F.) This.AddProperty("Moving",.F.) This.AddProperty("Starting", Null) This.AddProperty("RestrictHorizontal",.F.) This.AddProperty("RestrictVertical",.T.) This.Starting = Createobject('Empty') AddProperty(This.Starting, 'X', Null) AddProperty(This.Starting, 'Y', Null) AddProperty(This.Starting, 'Left', Null) AddProperty(This.Starting, 'Top', Null) Endproc Procedure otimeline.MouseDown() Lparameters nButton, nShift, nXCoord, nYCoord *thisform.listipwindow=.t. If nButton = 1 This.Moving = .T. This.Starting.Left = This.Left This.Starting.Top = This.Top This.Starting.X = nXCoord This.Starting.Y = nYCoord Endif *If nButton = 4 * This.Moving = !This.Moving * IF This.Moving * SYS(2060 , 0) * ELSE * SYS(2060 , 1) * endif * This.Starting.Left = This.Left * This.Starting.Top = This.Top * This.Starting.X = nXCoord * This.Starting.Y = nYCoord *Endif Endproc Procedure otimeline.MouseMove() Lparameters nButton, nShift, nXCoord, nYCoord *IF this.perae * RETURN *ENDIF *this.perae=.t. If This.Moving lnMinPos = (This.Parent.Width-This.Width-9) lnMaxPos = 3 lnpos = This.Starting.Left + Iif(This.RestrictHorizontal, 0, (nXCoord - This.Starting.X)) lnindex = 1 If This.Starting.Y>130 lnindex = 4 lnpos = This.Starting.Left + Iif(This.RestrictHorizontal, 0, (nXCoord - This.Starting.X)*lnindex) Endif If lnpos < lnMinPos Return Else If lnpos > lnMaxPos Return Endif Endif This.Left = This.Starting.Left + Iif(This.RestrictHorizontal, 0, (nXCoord - This.Starting.X)*lnindex) This.Top = This.Starting.Top + Iif(This.RestrictVertical, 0, (nYCoord - This.Starting.Y)) Endif *this.perae=.f. Endproc Procedure otimeline.MouseUp() Lparameters nButton, nShift, nXCoord, nYCoord If nButton = 1 This.Moving = .F. Endif Endproc *\ *\ Member Object lente *\ Add Object lente As Shape With; Top = 97,; Left = 271,; Height = 53,; Width = 44,; BorderStyle = 6,; DrawMode = 5,; Name = "lente" Procedure setup_timeline() Dimension lamonthes[12] lamonthes[01] = "Jan" lamonthes[02] = "Feb" lamonthes[03] = "Mar" lamonthes[04] = "Apr" lamonthes[05] = "May" lamonthes[06] = "Jun" lamonthes[07] = "Jul" lamonthes[08] = "Ago" lamonthes[09] = "Sep" lamonthes[10] = "Oct" lamonthes[11] = "Nov" lamonthes[12] = "Dec" If Amembers(laMembers, This.otimeline, 2) > 0 loObj = This.otimeline For Each lcMember In laMembers o = loObj.&lcMember If Type("o.name")="C" .And. Type("o.baseclass")="C" If o.BaseClass<>"Container" Loop Endif loObj = o This.otimeline.RemoveObject(o.Name) Endif Endfor Endif *** ** lddtfim = This.dDt_end+7 Do While Dow(lddtfim)<>7 lddtfim=lddtfim+1 Enddo *** ** lddtini = This.dDt_start-7 lddtbase = This.dDt_base Do While Dow(lddtini)<>1 lddtini=lddtini-1 Enddo *** lnoldmonth = 0 lnoldano = 0 lnoldsem = 0 lotimeline = This.otimeline With lotimeline .Visible = .T. Endwith lldone = .F. Do While lddtini =< lddtfim lnmonth=Month(lddtini) lnano=Year(lddtini) lnddsem=Dow(lddtini) If lnoldmonth = lnmonth Else If Type("lomonth.name")="C" lcweek2 = This.WeekOfMonth(lddtini) lcweek = Transform(Week(lddtini),"@L 999") lnpos = This.setupandposit(lomonth) lomonth.Width = lnpos lomonth.Line2.Width = lomonth.Width+4 lomonth.Visible = .T. lldone = .T. Endif lnmaiorano = Year(This.ThisSaturday(lddtini)) lcper = Transform(lnmonth,"@L 99")+Transform(lnmaiorano,"@L 9999") If lddtini<lddtbase lcprefix="A" Else lcprefix="D" Endif lotimeline.Newobject(lcprefix+"month"+lcper,"month") lomonth = Evaluate("lotimeline."+lcprefix+"month"+lcper) Bindevent(lomonth,"MouseDown",This.otimeline,"MouseDown") Bindevent(lomonth,"MouseUp",This.otimeline,"MouseUp") Bindevent(lomonth,"MouseMove",This.otimeline,"MouseMove") lomonth.MousePointer=9 lcdescr = lamonthes[lnmonth]+" / "+ Transform(lnano,"@L 9999") lomonth.Label1.Caption=lcdescr lomonth.AddProperty("nSemanaI",Week(lddtini,2)) lomonth.AddProperty("nSemanaF",Week(lddtini,2)) lnddsem=1 Endif If lnddsem=1 lnmaiordia = This.ThisSaturday(lddtini) lnmenordia = lddtini llnnxtmon = Month(lnmenordia) lcweek2 = This.WeekOfMonth(lnmenordia) lnano = Year(lnmenordia) lnmonth = Month(lnmenordia) lcweek = Transform(Week(lnmenordia,1),"@L 999") If lnoldano = lnano Else lcweek = Transform(Week(lnmenordia),"@L 999") Endif If lcweek = "001" And lnmonth = 12 lnWeek = Week(lnmenordia-7,1) + 1 lcweek = Transform(lnWeek,"@L 999") Endif lcper = Transform(lnmonth,"@L 99")+Transform(lnano,"@L 9999")+lcweek lomonth.Newobject("sem"+Transform(lnano,"@L 9999")+lcweek,"semana") losemana = Evaluate("lomonth."+"sem"+Transform(lnano,"@L 9999")+lcweek) losemana.Label1.Caption=lcweek2 losemana.AddProperty("dDiaI",lnmenordia) losemana.AddProperty("dDiaF",lnmaiordia) If This.dDt_end<lnmaiordia This.dDt_end=lnmaiordia Endif If Week(lddtini,2)>lomonth.nSemanaF lomonth.nSemanaF = Week(lddtini,2) Endif lldone = .F. Endif lddtini = lddtini + 1 lnoldmonth = lnmonth lnoldano = lnano lnoldsem = lnddsem Enddo If lldone Else lnpos = This.setupandposit(lomonth) lomonth.Width = lnpos lomonth.Line2.Width = lomonth.Width+4 lomonth.Visible = .T. lldone = .T. Endif If Amembers(laMembers2, lotimeline, 2) > 0 lnpos = 0 loObj2 = lotimeline For Each lcMember2 In laMembers2 o = loObj2.&lcMember2 If Type("o.name")="C" .And. Type("o.baseclass")="C" If o.BaseClass<>"Container" Loop Endif o.Left = lnpos o.Visible = .T. lnpos = lnpos+o.Width Endif Endfor lotimeline.Width = lnpos lotimeline.Left = ((lotimeline.Width-This.Width)/2)*(-1) This.lente.ZOrder(0) Endif lotimeline.Starting.Left = lotimeline.Left lotimeline.Starting.Top = lotimeline.Top lotimeline.Starting.X = lotimeline.Left lotimeline.Starting.Y = lotimeline.Top Endproc Procedure WeekOfMonth() Lparameters m.date2 Private m.date2,i,m.factor,dd1,dd2,lcdd dd1=This.ThisSunDay(m.date2) lcdd=Transform(Day(dd1)) dd2=This.ThisSaturday(m.date2) If dd1=dd2 lcdd="day "+lcdd Else lcdd=lcdd+" - "+Transform(Day(dd2)) Endif Return lcdd Endproc Procedure ThisSaturday() Lparameters m.date Private m.date,lnoldmonth,llcontinua lnoldmonth = Month(m.date) llcontinua = .T. Do While Dow(m.date)<>7 And llcontinua lnprxdia = m.date+1 If Month(lnprxdia)<>lnoldmonth llcontinua = .F. Loop Endif m.date = m.date+1 Enddo Return(m.date) Endproc Procedure ThisSunDay() ** this returns the Sunday... Lparameters m.date Private m.date,i,lnoldmonth,llcontinua lnoldmonth=Month(m.date) llcontinua = .T. Do While Dow(m.date)<>1 And llcontinua If (Month(m.date-1))<>lnoldmonth llcontinua = .F. Loop Endif m.date=m.date-1 Enddo Return(m.date) Endproc Procedure setupandposit() Lparameters pomonth Local lnpos, loObj2, losemana, lomonth, lcweek, lnano, lnocorr lnpos = 0 loObj2 = pomonth If Amembers(laMembers2, pomonth, 2) > 0 Else Return Endif If (pomonth.nSemanaF - pomonth.nSemanaI)>0 Else * RETURN Endif = Asort(laMembers2) && Sort the array For Each lcMember2 In laMembers2 o = loObj2.&lcMember2 If Type("o.name")="C" .And. Type("o.baseclass")="C" If o.BaseClass<>"Container" Loop Endif o.Left = lnpos lnpos = lnpos+o.Width If o.lbinddone Else o.Visible = .T. Bindevent(o,"MouseDown",This.otimeline,"MouseDown") Bindevent(o,"MouseUp",This.otimeline,"MouseUp") Bindevent(o,"MouseMove",This.otimeline,"MouseMove") o.MousePointer=9 * Bindevent(o,"MouseDown",This,"mmdownlow") o.MousePointer=9 o.lbinddone=.T. Endif Endif Endfor Return lnpos Endproc Procedure event_insert() Lparameters pntipo, pdtmov, pnvlverde, pnvlverme, pnvlbase, pcdescri If pdtmov<This.dDt_base lcprefix="A" Else lcprefix="D" Endif lnmonth = Month(pdtmov) lnano = Year(pdtmov) lcper = Transform(lnmonth,"@L 99")+Transform(lnano,"@L 9999") If Type("this.otimeline."+lcprefix+"month"+lcper)<>"O" Return Endif lomonth = Evaluate("this.otimeline."+lcprefix+"month"+lcper) If Amembers(laMembers2, lomonth, 2) > 0 lnpos = 0 loObj2 = lomonth For Each lcMember2 In laMembers2 o = loObj2.&lcMember2 If Type("o.name")="C" .And. Type("o.baseclass")="C" If o.BaseClass<>"Container" .Or. Substr(o.Name,1,3)<>"sem" Loop Endif If pdtmov >= o.dDiaI .And. pdtmov =< o.dDiaF If o.ntipo=1 Else If pntipo=1 o.Image1.cmessage=o.Image1.cmessage+pcdescri o.Image1.ntotal=o.Image1.ntotal+pnvlverde o.Image1.ncntpass=o.Image1.ncntpass+1 lccnt=Alltrim(Str(o.Image1.ncntpass)) o.Image1.ToolTipText=lccnt+" Previsão(ões) (R$"+Alltrim(Transform(o.Image1.ntotal,"9999,999,999.99"))+")" o.Image1.Visible=.T. Endif If pntipo=2 o.Image4.cmessage=o.Image4.cmessage+pcdescri o.Image4.ntotal=o.Image4.ntotal+pnvlverde o.Image4.ncntpass=o.Image4.ncntpass+1 lccnt=Alltrim(Str(o.Image4.ncntpass)) o.Image4.ToolTipText=lccnt+" Pagamento(s) (R$"+Alltrim(Transform(o.Image4.ntotal,"9999,999,999.99"))+")" o.Image4.Visible=.T. Endif If pntipo=3 o.Image2.cmessage=o.Image2.cmessage+pcdescri o.Image2.ntotal=o.Image2.ntotal+pnvlverde o.Image2.ncntpass=o.Image2.ncntpass+1 lccnt=Alltrim(Str(o.Image2.ncntpass)) o.Image2.ToolTipText=lccnt+" Provisionamento(s) (R$"+Alltrim(Transform(o.Image2.ntotal,"9999,999,999.99"))+")" o.Image2.Visible=.T. Endif If pntipo=4 o.Image3.cmessage=o.Image3.cmessage+pcdescri o.Image3.ntotal=o.Image3.ntotal+pnvlverde o.Image3.ncntpass=o.Image3.ncntpass+1 lccnt=Alltrim(Str(o.Image3.ncntpass)) o.Image3.ToolTipText=lccnt+" Pagamento(s) (R$"+Alltrim(Transform(o.Image3.ntotal,"9999,999,999.99"))+")" o.Image3.Visible=.T. Endif Endif Endif Endif Endfor Endif Endproc Procedure clearall() loobjx = This.otimeline If Amembers(laMembers, loobjx, 2) > 0 For Each lcMember In laMembers ox = loobjx.&lcMember If Type("ox.name")="C" .And. Type("ox.baseclass")="C" If ox.BaseClass<>"Container" .Or. Substr(ox.Name,2,3)<>"month" Loop Endif lomonth = ox If Amembers(laMembers2, lomonth, 2) > 0 lnpos = 0 loObj2 = lomonth For Each lcMember2 In laMembers2 o = loObj2.&lcMember2 If Type("o.name")="C" .And. Type("o.baseclass")="C" If o.BaseClass<>"Container" .Or. Substr(o.Name,1,3)<>"sem" Loop Endif If o.ntipo=1 Else o.Image1.cmessage="" o.Image1.ntotal=0 o.Image1.ToolTipText="" o.Image1.ncntpass=0 o.Image1.Visible=.F. o.Image4.cmessage="" o.Image4.ntotal=0 o.Image4.ToolTipText="" o.Image4.ncntpass=0 o.Image4.Visible=.F. o.Image2.cmessage="" o.Image2.ntotal=0 o.Image2.ToolTipText="" o.Image2.ncntpass=0 o.Image2.Visible=.F. o.Image3.cmessage="" o.Image3.ntotal=0 o.Image3.ToolTipText="" o.Image3.ncntpass=0 o.Image3.Visible=.F. Endif Endif Endfor Endif Endif Endfor Endif Endproc Enddefine &&timeline