romfast/comun
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
7abec075492629a5166b1533702efcfe0c9fe4e1
comun/utile/ListProperty/_lproperty.vc2

3254 lines
103 KiB
Plaintext
Raw Blame History

*--------------------------------------------------------------------------------------------------------------------------------------------------------
* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!!
*--------------------------------------------------------------------------------------------------------------------------------------------------------
*< FOXBIN2PRG: Version="1.21" SourceFile="_lproperty.vcx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries)
*
*
DEFINE CLASS _cal_button AS container
*< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" ProjectClassIcon="calendarbutton.bmp" ClassIcon="calendarbutton.bmp" />
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
*< OBJECTDATA: ObjPath="lblButton" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnButton" UniqueID="" Timestamp="" />
*<DefinedPropArrayMethod>
*m: backcolor_assign
*m: caption_access
*m: caption_assign
*m: forecolor_assign
*m: getfocus
*m: killfocus
*p: caption && Especifica el texto mostrado como título de un objeto.
*p: day
*p: downobject
*p: leftobject
*p: month
*p: rightobject
*p: upobject
*p: year
*</DefinedPropArrayMethod>
*<PropValue>
BackColor = 255,255,255
BorderWidth = 0
caption =
day = 0
downobject = .F.
Height = 27
leftobject = .F.
month = 0
Name = "_cal_button"
rightobject = .F.
upobject = .F.
Width = 26
year = .F.
*</PropValue>
ADD OBJECT 'btnButton' AS commandbutton WITH ;
Caption = "", ;
Height = 31, ;
Left = 124, ;
Name = "btnButton", ;
Style = 1, ;
Top = 87, ;
Width = 37
*< END OBJECT: BaseClass="commandbutton" />
ADD OBJECT 'lblButton' AS label WITH ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "Label1", ;
FontName = "MS Sans Serif", ;
Height = 15, ;
Left = 135, ;
Name = "lblButton", ;
Top = 96, ;
Width = 34
*< END OBJECT: BaseClass="label" />
PROCEDURE backcolor_assign
LPARAMETERS vNewVal
*To do: Modify this routine for the Assign method
THIS.BackColor = m.vNewVal
ENDPROC
PROCEDURE caption_access
*Pendiente: modificar esta rutina para el método Access
RETURN THIS.caption
ENDPROC
PROCEDURE caption_assign
LPARAMETERS vNewVal
*To do: Modify this routine for the Assign method
THIS.caption = m.vNewVal
With This.lblButton
nHeight = Fontmetric(1, .FontName, .FontSize)
nWidth = Txtwidth(This.Caption, .FontName, .FontSize) * Fontmetric(6, .FontName, .FontSize)
.Caption = This.Caption
.Top = (This.Height / 2) - (nHeight / 2)
.Left = (This.Width / 2) - (nWidth / 2)
EndWith
ENDPROC
PROCEDURE Click
This.btnButton.Click()
ENDPROC
PROCEDURE forecolor_assign
LPARAMETERS vNewVal
*To do: Modify this routine for the Assign method
THIS.ForeColor = m.vNewVal
This.lblButton.ForeColor = m.vNewVal
ENDPROC
PROCEDURE getfocus
With This.Parent
If Type("This.Parent.CurrentObject") == "O"
If !(.CurrentObject.Name == This.Name)
.CurrentObject.KillFocus()
EndIf
EndIf
.CurrentObject = This
This.BackColor = .cusFuncs.GetColor(.SelectedDayBackColor)
This.lblButton.ForeColor = .cusFuncs.GetColor(.SelectedDayForeColor)
This.btnButton.SetFocus()
EndWith
ENDPROC
PROCEDURE Init
With This.btnButton
.Top = 0
.Left = 0
.Width = This.Width
.Height = This.Height
.ZOrder(0)
EndWith
This.Caption = This.Caption
ENDPROC
PROCEDURE killfocus
This.ResetToDefault("BackColor")
This.lblButton.ForeColor = This.ForeColor
ENDPROC
PROCEDURE btnButton.Click
*Nodefault
With This.Parent
.GetFocus()
.Parent.OnClick(Date(.Year, .Month, .Day))
DoDefault()
EndWith
ENDPROC
PROCEDURE btnButton.KeyPress
LPARAMETERS nKeyCode, nShiftAltCtrl
Do Case
Case nKeyCode = 5 && Arriba
NoDefault
If Type("This.Parent.UpObject") == "O"
This.Parent.UpObject.Click()
EndIf
Case nKeyCode = 24 && Abajo
NoDefault
If Type("This.Parent.DownObject") == "O"
This.Parent.DownObject.Click()
EndIf
Case nKeyCode = 4 && Derecha
NoDefault
If Type("This.Parent.RightObject") == "O"
This.Parent.RightObject.Click()
EndIf
Case nKeyCode = 19 && Izquierda
NoDefault
If Type("This.Parent.LeftObject") == "O"
This.Parent.LeftObject.Click()
EndIf
Case nKeyCode = 32
NoDefault
EndCase
ENDPROC
ENDDEFINE
DEFINE CLASS _calendar AS container
*< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" ProjectClassIcon="calendar.bmp" ClassIcon="calendar.bmp" />
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
*< OBJECTDATA: ObjPath="shpTitleBar" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="cusFuncs" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnButton_1" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnButton_2" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnButton_3" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnButton_4" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnButton_5" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnButton_6" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnButton_7" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnButton_8" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnButton_9" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnButton_10" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnButton_11" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnButton_12" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnButton_13" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnButton_14" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnButton_15" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnButton_16" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnButton_17" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnButton_18" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnButton_19" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnButton_20" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnButton_21" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnButton_22" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnButton_23" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnButton_24" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnButton_25" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnButton_26" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnButton_27" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnButton_28" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnButton_29" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnButton_30" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnButton_31" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnButton_32" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnButton_33" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnButton_34" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnButton_35" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnButton_36" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnButton_37" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnButton_38" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnButton_39" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnButton_40" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnButton_41" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnButton_42" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="spnYear" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="cboMonth" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="lblTitleDay1" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="lblTitleDay2" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="lblTitleDay3" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="lblTitleDay4" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="lblTitleDay5" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="lblTitleDay6" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="lblTitleDay7" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnNext" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnPrevious" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="shpTodaybar" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Label7" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="lblToday" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnToday" UniqueID="" Timestamp="" />
*<DefinedPropArrayMethod>
*m: buildcalendar
*m: checkday
*m: date_assign
*m: getholidaytips
*m: getreference
*m: isholiday
*m: loadholidays
*m: onclick
*m: showdebut && Muestra un formulario y especifica si dicho formulario es modal o no modal.
*m: verify
*p: currentobject
*p: date
*p: day
*p: debutobject
*p: extradayforecolor
*p: holidayforecolor
*p: holidaylist
*p: ispainted
*p: month
*p: saturdayforecolor
*p: selecteddaybackcolor
*p: selecteddayforecolor
*p: showholidaytips
*p: sundayforecolor
*p: weekdayforecolor
*p: year
*p: _memberdata && XML Metadatos para propiedades personalizables.
*</DefinedPropArrayMethod>
*<PropValue>
BorderWidth = 0
currentobject =
date = ({})
day = 0
debutobject = .F.
extradayforecolor = sys:15
Height = 174
holidayforecolor = rgb:255,0,0
holidaylist =
ispainted = .F.
month = 0
Name = "_calendar"
saturdayforecolor = sys:18
selecteddaybackcolor = sys:13
selecteddayforecolor = sys:14
showholidaytips = .F.
sundayforecolor = rgb:255,0,0
weekdayforecolor = sys:18
Width = 192
year = 0
_memberdata = <VFPData>
<memberdata name="sundayforecolor" type="property" display="SundayForeColor" favorites="True" script="nControls = ASelObj(aObjects)&#xA;If nControls = 0&#xA; nControls = ASelObj(aObjects, 1)&#xA;EndIf &#xA;oObject = aObjects(1)&#xA;If oObject.Class = &quot;_calendar&quot;&#xA; Set Classlib To (oObject.ClassLibrary)&#xA; oFuncs = Createobject(&quot;_Functions&quot;)&#xA; oObject.SundayForeColor = oFuncs.PopWindow(&quot;_GetColor&quot;, oObject.SundayForeColor)&#xA; Release oFuncs&#xA;EndIf&#xA;"/>
<memberdata name="saturdayforecolor" type="property" display="SaturdayForeColor" favorites="True" script="nControls = ASelObj(aObjects)&#xA;If nControls = 0&#xA; nControls = ASelObj(aObjects, 1)&#xA;EndIf &#xA;oObject = aObjects(1)&#xA;If oObject.Class = &quot;_calendar&quot;&#xA; Set Classlib To (oObject.ClassLibrary)&#xA; oFuncs = Createobject(&quot;_Functions&quot;)&#xA; oObject.SaturdayForeColor = oFuncs.PopWindow(&quot;_GetColor&quot;, oObject.SaturdayForeColor)&#xA; Release oFuncs&#xA;EndIf&#xA;"/>
<memberdata name="holidayforecolor" type="property" display="HolidayForeColor" favorites="True" script="nControls = ASelObj(aObjects)&#xA;If nControls = 0&#xA; nControls = ASelObj(aObjects, 1)&#xA;EndIf &#xA;oObject = aObjects(1)&#xA;If oObject.Class = &quot;_calendar&quot;&#xA; Set Classlib To (oObject.ClassLibrary)&#xA; oFuncs = Createobject(&quot;_Functions&quot;)&#xA; oObject.HolidayForeColor = oFuncs.PopWindow(&quot;_GetColor&quot;, oObject.HolidayForeColor)&#xA; Release oFuncs&#xA;EndIf&#xA;"/>
<memberdata name="weekdayforecolor" type="property" display="WeekdayForeColor" favorites="True" script="nControls = ASelObj(aObjects)&#xA;If nControls = 0&#xA; nControls = ASelObj(aObjects, 1)&#xA;EndIf &#xA;oObject = aObjects(1)&#xA;If oObject.Class = &quot;_calendar&quot;&#xA; Set Classlib To (oObject.ClassLibrary)&#xA; oFuncs = Createobject(&quot;_Functions&quot;)&#xA; oObject.WeekdayForeColor = oFuncs.PopWindow(&quot;_GetColor&quot;, oObject.WeekdayForeColor)&#xA; Release oFuncs&#xA;EndIf&#xA;"/>
<memberdata name="extradayforecolor" type="property" display="ExtradayForeColor" favorites="True" script="nControls = ASelObj(aObjects)&#xA;If nControls = 0&#xA; nControls = ASelObj(aObjects, 1)&#xA;EndIf &#xA;oObject = aObjects(1)&#xA;If oObject.Class = &quot;_calendar&quot;&#xA; Set Classlib To (oObject.ClassLibrary)&#xA; oFuncs = Createobject(&quot;_Functions&quot;)&#xA; oObject.ExtradayForeColor = oFuncs.PopWindow(&quot;_GetColor&quot;, oObject.ExtradayForeColor)&#xA; Release oFuncs&#xA;EndIf&#xA;"/>
<memberdata name="selecteddaybackcolor" type="property" display="SelecteddayBackColor" favorites="True" script="nControls = ASelObj(aObjects)&#xA;If nControls = 0&#xA; nControls = ASelObj(aObjects, 1)&#xA;EndIf &#xA;oObject = aObjects(1)&#xA;If oObject.Class = &quot;_calendar&quot;&#xA; Set Classlib To (oObject.ClassLibrary)&#xA; oFuncs = Createobject(&quot;_Functions&quot;)&#xA; oObject.SelecteddayBackColor = oFuncs.PopWindow(&quot;_GetColor&quot;, oObject.SelecteddayBackColor)&#xA; Release oFuncs&#xA;EndIf&#xA;"/>
<memberdata name="selecteddayforecolor" type="property" display="SelecteddayForeColor" favorites="True" script="nControls = ASelObj(aObjects)&#xA;If nControls = 0&#xA; nControls = ASelObj(aObjects, 1)&#xA;EndIf &#xA;oObject = aObjects(1)&#xA;If oObject.Class = &quot;_calendar&quot;&#xA; Set Classlib To (oObject.ClassLibrary)&#xA; oFuncs = Createobject(&quot;_Functions&quot;)&#xA; oObject.SelecteddayForeColor = oFuncs.PopWindow(&quot;_GetColor&quot;, oObject.SelecteddayForeColor)&#xA; Release oFuncs&#xA;EndIf&#xA;" ReadOnly=".T."/>
<memberdata name="getholidaytips" type="method" display="GetHolidayTips" favorites="True"/>
<memberdata name="holidaylist" type="property" display="HolidayList" favorites="True"/>
<memberdata name="isholiday" type="method" display="IsHoliday" favorites="True"/>
<memberdata name="loadholidays" type="method" display="LoadHolidays" favorites="True"/>
<memberdata name="showholidaytips" type="property" display="ShowHolidayTips" favorites="True"/>
<memberdata name="date" type="property" display="Date" favorites="True"/>
</VFPData>
*</PropValue>
ADD OBJECT 'btnButton_1' AS _cal_button WITH ;
Height = 17, ;
Left = 2, ;
Name = "btnButton_1", ;
TabIndex = 1, ;
Tag = "0,8,2,0", ;
Top = 48, ;
Width = 26, ;
LBLBUTTON.Name = "LBLBUTTON", ;
btnButton.Name = "btnButton"
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="container" />
ADD OBJECT 'btnButton_10' AS _cal_button WITH ;
Height = 17, ;
Left = 56, ;
Name = "btnButton_10", ;
TabIndex = 10, ;
Top = 66, ;
Width = 26, ;
LBLBUTTON.Name = "LBLBUTTON", ;
btnButton.Name = "btnButton"
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="container" />
ADD OBJECT 'btnButton_11' AS _cal_button WITH ;
Height = 17, ;
Left = 83, ;
Name = "btnButton_11", ;
TabIndex = 11, ;
Top = 66, ;
Width = 26, ;
LBLBUTTON.Name = "LBLBUTTON", ;
btnButton.Name = "btnButton"
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="container" />
ADD OBJECT 'btnButton_12' AS _cal_button WITH ;
Height = 17, ;
Left = 110, ;
Name = "btnButton_12", ;
TabIndex = 12, ;
Top = 66, ;
Width = 26, ;
LBLBUTTON.Name = "LBLBUTTON", ;
btnButton.Name = "btnButton"
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="container" />
ADD OBJECT 'btnButton_13' AS _cal_button WITH ;
Height = 17, ;
Left = 137, ;
Name = "btnButton_13", ;
TabIndex = 13, ;
Top = 66, ;
Width = 26, ;
LBLBUTTON.Name = "LBLBUTTON", ;
btnButton.Name = "btnButton"
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="container" />
ADD OBJECT 'btnButton_14' AS _cal_button WITH ;
Height = 17, ;
Left = 164, ;
Name = "btnButton_14", ;
TabIndex = 14, ;
Top = 66, ;
Width = 26, ;
LBLBUTTON.Name = "LBLBUTTON", ;
btnButton.Name = "btnButton"
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="container" />
ADD OBJECT 'btnButton_15' AS _cal_button WITH ;
Height = 17, ;
Left = 2, ;
Name = "btnButton_15", ;
TabIndex = 15, ;
Top = 84, ;
Width = 26, ;
LBLBUTTON.Name = "LBLBUTTON", ;
btnButton.Name = "btnButton"
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="container" />
ADD OBJECT 'btnButton_16' AS _cal_button WITH ;
Height = 17, ;
Left = 29, ;
Name = "btnButton_16", ;
TabIndex = 16, ;
Top = 84, ;
Width = 26, ;
LBLBUTTON.Name = "LBLBUTTON", ;
btnButton.Name = "btnButton"
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="container" />
ADD OBJECT 'btnButton_17' AS _cal_button WITH ;
Height = 17, ;
Left = 56, ;
Name = "btnButton_17", ;
TabIndex = 17, ;
Top = 84, ;
Width = 26, ;
LBLBUTTON.Name = "LBLBUTTON", ;
btnButton.Name = "btnButton"
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="container" />
ADD OBJECT 'btnButton_18' AS _cal_button WITH ;
Height = 17, ;
Left = 83, ;
Name = "btnButton_18", ;
TabIndex = 18, ;
Top = 84, ;
Width = 26, ;
LBLBUTTON.Name = "LBLBUTTON", ;
btnButton.Name = "btnButton"
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="container" />
ADD OBJECT 'btnButton_19' AS _cal_button WITH ;
Height = 17, ;
Left = 110, ;
Name = "btnButton_19", ;
TabIndex = 19, ;
Top = 84, ;
Width = 26, ;
LBLBUTTON.Name = "LBLBUTTON", ;
btnButton.Name = "btnButton"
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="container" />
ADD OBJECT 'btnButton_2' AS _cal_button WITH ;
Height = 17, ;
Left = 29, ;
Name = "btnButton_2", ;
TabIndex = 2, ;
Tag = "0,9,3,1", ;
Top = 48, ;
Width = 26, ;
LBLBUTTON.Name = "LBLBUTTON", ;
btnButton.Name = "btnButton"
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="container" />
ADD OBJECT 'btnButton_20' AS _cal_button WITH ;
Height = 17, ;
Left = 137, ;
Name = "btnButton_20", ;
TabIndex = 20, ;
Top = 84, ;
Width = 26, ;
LBLBUTTON.Name = "LBLBUTTON", ;
btnButton.Name = "btnButton"
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="container" />
ADD OBJECT 'btnButton_21' AS _cal_button WITH ;
Height = 17, ;
Left = 164, ;
Name = "btnButton_21", ;
TabIndex = 21, ;
Top = 84, ;
Width = 26, ;
LBLBUTTON.Name = "LBLBUTTON", ;
btnButton.Name = "btnButton"
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="container" />
ADD OBJECT 'btnButton_22' AS _cal_button WITH ;
Height = 17, ;
Left = 2, ;
Name = "btnButton_22", ;
TabIndex = 22, ;
Top = 102, ;
Width = 26, ;
LBLBUTTON.Name = "LBLBUTTON", ;
btnButton.Name = "btnButton"
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="container" />
ADD OBJECT 'btnButton_23' AS _cal_button WITH ;
Height = 17, ;
Left = 29, ;
Name = "btnButton_23", ;
TabIndex = 23, ;
Top = 102, ;
Width = 26, ;
LBLBUTTON.Name = "LBLBUTTON", ;
btnButton.Name = "btnButton"
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="container" />
ADD OBJECT 'btnButton_24' AS _cal_button WITH ;
Height = 17, ;
Left = 56, ;
Name = "btnButton_24", ;
TabIndex = 24, ;
Top = 102, ;
Width = 26, ;
LBLBUTTON.Name = "LBLBUTTON", ;
btnButton.Name = "btnButton"
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="container" />
ADD OBJECT 'btnButton_25' AS _cal_button WITH ;
Height = 17, ;
Left = 83, ;
Name = "btnButton_25", ;
TabIndex = 25, ;
Top = 102, ;
Width = 26, ;
LBLBUTTON.Name = "LBLBUTTON", ;
btnButton.Name = "btnButton"
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="container" />
ADD OBJECT 'btnButton_26' AS _cal_button WITH ;
Height = 17, ;
Left = 110, ;
Name = "btnButton_26", ;
TabIndex = 26, ;
Top = 102, ;
Width = 26, ;
LBLBUTTON.Name = "LBLBUTTON", ;
btnButton.Name = "btnButton"
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="container" />
ADD OBJECT 'btnButton_27' AS _cal_button WITH ;
Height = 17, ;
Left = 137, ;
Name = "btnButton_27", ;
TabIndex = 27, ;
Top = 102, ;
Width = 26, ;
LBLBUTTON.Name = "LBLBUTTON", ;
btnButton.Name = "btnButton"
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="container" />
ADD OBJECT 'btnButton_28' AS _cal_button WITH ;
Height = 17, ;
Left = 164, ;
Name = "btnButton_28", ;
TabIndex = 28, ;
Top = 102, ;
Width = 26, ;
LBLBUTTON.Name = "LBLBUTTON", ;
btnButton.Name = "btnButton"
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="container" />
ADD OBJECT 'btnButton_29' AS _cal_button WITH ;
Height = 17, ;
Left = 2, ;
Name = "btnButton_29", ;
TabIndex = 29, ;
Top = 120, ;
Width = 26, ;
LBLBUTTON.Name = "LBLBUTTON", ;
btnButton.Name = "btnButton"
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="container" />
ADD OBJECT 'btnButton_3' AS _cal_button WITH ;
Height = 17, ;
Left = 56, ;
Name = "btnButton_3", ;
TabIndex = 3, ;
Tag = "0,10,4,2", ;
Top = 48, ;
Width = 26, ;
LBLBUTTON.Name = "LBLBUTTON", ;
btnButton.Name = "btnButton"
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="container" />
ADD OBJECT 'btnButton_30' AS _cal_button WITH ;
Height = 17, ;
Left = 29, ;
Name = "btnButton_30", ;
TabIndex = 30, ;
Top = 120, ;
Width = 26, ;
LBLBUTTON.Name = "LBLBUTTON", ;
btnButton.Name = "btnButton"
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="container" />
ADD OBJECT 'btnButton_31' AS _cal_button WITH ;
Height = 17, ;
Left = 56, ;
Name = "btnButton_31", ;
TabIndex = 31, ;
Top = 120, ;
Width = 26, ;
LBLBUTTON.Name = "LBLBUTTON", ;
btnButton.Name = "btnButton"
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="container" />
ADD OBJECT 'btnButton_32' AS _cal_button WITH ;
Height = 17, ;
Left = 83, ;
Name = "btnButton_32", ;
TabIndex = 32, ;
Top = 120, ;
Width = 26, ;
LBLBUTTON.Name = "LBLBUTTON", ;
btnButton.Name = "btnButton"
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="container" />
ADD OBJECT 'btnButton_33' AS _cal_button WITH ;
Height = 17, ;
Left = 110, ;
Name = "btnButton_33", ;
TabIndex = 33, ;
Top = 120, ;
Width = 26, ;
LBLBUTTON.Name = "LBLBUTTON", ;
btnButton.Name = "btnButton"
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="container" />
ADD OBJECT 'btnButton_34' AS _cal_button WITH ;
Height = 17, ;
Left = 137, ;
Name = "btnButton_34", ;
TabIndex = 34, ;
Top = 120, ;
Width = 26, ;
LBLBUTTON.Name = "LBLBUTTON", ;
btnButton.Name = "btnButton"
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="container" />
ADD OBJECT 'btnButton_35' AS _cal_button WITH ;
Height = 17, ;
Left = 164, ;
Name = "btnButton_35", ;
TabIndex = 35, ;
Top = 120, ;
Width = 26, ;
LBLBUTTON.Name = "LBLBUTTON", ;
btnButton.Name = "btnButton"
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="container" />
ADD OBJECT 'btnButton_36' AS _cal_button WITH ;
Height = 17, ;
Left = 2, ;
Name = "btnButton_36", ;
TabIndex = 36, ;
Top = 138, ;
Width = 26, ;
lblButton.Name = "lblButton", ;
btnButton.Name = "btnButton"
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="container" />
ADD OBJECT 'btnButton_37' AS _cal_button WITH ;
Height = 17, ;
Left = 29, ;
Name = "btnButton_37", ;
TabIndex = 37, ;
Top = 138, ;
Width = 26, ;
lblButton.Name = "lblButton", ;
btnButton.Name = "btnButton"
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="container" />
ADD OBJECT 'btnButton_38' AS _cal_button WITH ;
Height = 17, ;
Left = 56, ;
Name = "btnButton_38", ;
TabIndex = 38, ;
Top = 138, ;
Width = 26, ;
lblButton.Name = "lblButton", ;
btnButton.Name = "btnButton"
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="container" />
ADD OBJECT 'btnButton_39' AS _cal_button WITH ;
Height = 17, ;
Left = 83, ;
Name = "btnButton_39", ;
TabIndex = 39, ;
Top = 138, ;
Width = 26, ;
lblButton.Name = "lblButton", ;
btnButton.Name = "btnButton"
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="container" />
ADD OBJECT 'btnButton_4' AS _cal_button WITH ;
Height = 17, ;
Left = 83, ;
Name = "btnButton_4", ;
TabIndex = 4, ;
Tag = "0,11,5,3", ;
Top = 48, ;
Width = 26, ;
LBLBUTTON.Name = "LBLBUTTON", ;
btnButton.Name = "btnButton"
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="container" />
ADD OBJECT 'btnButton_40' AS _cal_button WITH ;
Height = 17, ;
Left = 110, ;
Name = "btnButton_40", ;
TabIndex = 40, ;
Top = 138, ;
Width = 26, ;
lblButton.Name = "lblButton", ;
btnButton.Name = "btnButton"
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="container" />
ADD OBJECT 'btnButton_41' AS _cal_button WITH ;
Height = 17, ;
Left = 137, ;
Name = "btnButton_41", ;
TabIndex = 41, ;
Top = 138, ;
Width = 26, ;
lblButton.Name = "lblButton", ;
btnButton.Name = "btnButton"
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="container" />
ADD OBJECT 'btnButton_42' AS _cal_button WITH ;
Height = 17, ;
Left = 164, ;
Name = "btnButton_42", ;
TabIndex = 42, ;
Top = 138, ;
Width = 26, ;
lblButton.Name = "lblButton", ;
btnButton.Name = "btnButton"
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="container" />
ADD OBJECT 'btnButton_5' AS _cal_button WITH ;
Height = 17, ;
Left = 110, ;
Name = "btnButton_5", ;
TabIndex = 5, ;
Tag = "0,12", ;
Top = 48, ;
Width = 26, ;
LBLBUTTON.Name = "LBLBUTTON", ;
btnButton.Name = "btnButton"
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="container" />
ADD OBJECT 'btnButton_6' AS _cal_button WITH ;
Height = 17, ;
Left = 137, ;
Name = "btnButton_6", ;
TabIndex = 6, ;
Top = 48, ;
Width = 26, ;
LBLBUTTON.Name = "LBLBUTTON", ;
btnButton.Name = "btnButton"
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="container" />
ADD OBJECT 'btnButton_7' AS _cal_button WITH ;
Height = 17, ;
Left = 164, ;
Name = "btnButton_7", ;
TabIndex = 7, ;
Top = 48, ;
Width = 26, ;
LBLBUTTON.Name = "LBLBUTTON", ;
btnButton.Name = "btnButton"
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="container" />
ADD OBJECT 'btnButton_8' AS _cal_button WITH ;
Height = 17, ;
Left = 2, ;
Name = "btnButton_8", ;
TabIndex = 8, ;
Top = 66, ;
Width = 26, ;
LBLBUTTON.Name = "LBLBUTTON", ;
btnButton.Name = "btnButton"
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="container" />
ADD OBJECT 'btnButton_9' AS _cal_button WITH ;
Height = 17, ;
Left = 29, ;
Name = "btnButton_9", ;
TabIndex = 9, ;
Top = 66, ;
Width = 26, ;
LBLBUTTON.Name = "LBLBUTTON", ;
btnButton.Name = "btnButton"
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="container" />
ADD OBJECT 'btnNext' AS commandbutton WITH ;
Caption = "„", ;
FontName = "Wingdings 3", ;
FontSize = 8, ;
Height = 20, ;
Left = 175, ;
Name = "btnNext", ;
SpecialEffect = 1, ;
TabIndex = 47, ;
Top = 5, ;
Width = 15
*< END OBJECT: BaseClass="commandbutton" />
ADD OBJECT 'btnPrevious' AS commandbutton WITH ;
Caption = "ƒ", ;
FontName = "Wingdings 3", ;
FontSize = 8, ;
Height = 20, ;
Left = 2, ;
Name = "btnPrevious", ;
SpecialEffect = 1, ;
TabIndex = 44, ;
Top = 5, ;
Width = 15
*< END OBJECT: BaseClass="commandbutton" />
ADD OBJECT 'btnToday' AS commandbutton WITH ;
Caption = "Command1", ;
FontName = "MS Sans Serif", ;
Height = 16, ;
Left = 2, ;
Name = "btnToday", ;
Style = 1, ;
TabIndex = 43, ;
Top = 156, ;
Width = 188
*< END OBJECT: BaseClass="commandbutton" />
ADD OBJECT 'cboMonth' AS combobox WITH ;
FontName = "MS Sans Serif", ;
Height = 20, ;
Left = 19, ;
Margin = 0, ;
Name = "cboMonth", ;
RowSource = "Enero,Febrero,Marzo,Abril,Mayo,Junio,Julio,Agosto,Setiembre,Octubre,Noviembre,Diciembre", ;
RowSourceType = 1, ;
Style = 2, ;
TabIndex = 45, ;
Top = 5, ;
Width = 99
*< END OBJECT: BaseClass="combobox" />
ADD OBJECT 'cusFuncs' AS _functions WITH ;
Height = 15, ;
Left = 3, ;
Name = "cusFuncs", ;
Top = 139, ;
Width = 20
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="custom" />
ADD OBJECT 'Label7' AS label WITH ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "Hoy:", ;
FontBold = .T., ;
FontName = "MS Sans Serif", ;
Height = 15, ;
Left = 48, ;
Name = "Label7", ;
TabIndex = 55, ;
Top = 157, ;
Width = 29
*< END OBJECT: BaseClass="label" />
ADD OBJECT 'lblTitleDay1' AS label WITH ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "D", ;
FontBold = .T., ;
FontName = "MS Sans Serif", ;
ForeColor = 255,255,255, ;
Height = 15, ;
Left = 10, ;
Name = "lblTitleDay1", ;
TabIndex = 48, ;
Top = 32, ;
Width = 12
*< END OBJECT: BaseClass="label" />
ADD OBJECT 'lblTitleDay2' AS label WITH ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "L", ;
FontBold = .T., ;
FontName = "MS Sans Serif", ;
ForeColor = 255,255,255, ;
Height = 15, ;
Left = 37, ;
Name = "lblTitleDay2", ;
TabIndex = 49, ;
Top = 32, ;
Width = 10
*< END OBJECT: BaseClass="label" />
ADD OBJECT 'lblTitleDay3' AS label WITH ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "M", ;
FontBold = .T., ;
FontName = "MS Sans Serif", ;
ForeColor = 255,255,255, ;
Height = 15, ;
Left = 63, ;
Name = "lblTitleDay3", ;
TabIndex = 50, ;
Top = 32, ;
Width = 13
*< END OBJECT: BaseClass="label" />
ADD OBJECT 'lblTitleDay4' AS label WITH ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "M", ;
FontBold = .T., ;
FontName = "MS Sans Serif", ;
ForeColor = 255,255,255, ;
Height = 15, ;
Left = 91, ;
Name = "lblTitleDay4", ;
TabIndex = 51, ;
Top = 32, ;
Width = 13
*< END OBJECT: BaseClass="label" />
ADD OBJECT 'lblTitleDay5' AS label WITH ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "J", ;
FontBold = .T., ;
FontName = "MS Sans Serif", ;
ForeColor = 255,255,255, ;
Height = 15, ;
Left = 119, ;
Name = "lblTitleDay5", ;
TabIndex = 52, ;
Top = 32, ;
Width = 9
*< END OBJECT: BaseClass="label" />
ADD OBJECT 'lblTitleDay6' AS label WITH ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "V", ;
FontBold = .T., ;
FontName = "MS Sans Serif", ;
ForeColor = 255,255,255, ;
Height = 15, ;
Left = 145, ;
Name = "lblTitleDay6", ;
TabIndex = 53, ;
Top = 32, ;
Width = 11
*< END OBJECT: BaseClass="label" />
ADD OBJECT 'lblTitleDay7' AS label WITH ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "S", ;
FontBold = .T., ;
FontName = "MS Sans Serif", ;
ForeColor = 255,255,255, ;
Height = 15, ;
Left = 172, ;
Name = "lblTitleDay7", ;
TabIndex = 54, ;
Top = 32, ;
Width = 11
*< END OBJECT: BaseClass="label" />
ADD OBJECT 'lblToday' AS label WITH ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "12/08/2006", ;
FontBold = .T., ;
FontName = "MS Sans Serif", ;
Height = 15, ;
Left = 77, ;
Name = "lblToday", ;
TabIndex = 56, ;
Top = 157, ;
Width = 71
*< END OBJECT: BaseClass="label" />
ADD OBJECT 'shpTitleBar' AS shape WITH ;
BackColor = 128,128,128, ;
BorderStyle = 0, ;
BorderWidth = 0, ;
Height = 17, ;
Left = 2, ;
Name = "shpTitleBar", ;
Top = 30, ;
Width = 188
*< END OBJECT: BaseClass="shape" />
ADD OBJECT 'shpTodaybar' AS shape WITH ;
BackColor = 255,255,255, ;
BorderStyle = 0, ;
Height = 16, ;
Left = 2, ;
Name = "shpTodaybar", ;
Top = 156, ;
Width = 188
*< END OBJECT: BaseClass="shape" />
ADD OBJECT 'spnYear' AS spinner WITH ;
DisabledBackColor = 255,255,255, ;
FontName = "MS Sans Serif", ;
Height = 20, ;
KeyboardHighValue = 3000, ;
KeyboardLowValue = 1900, ;
Left = 120, ;
Margin = 2, ;
Name = "spnYear", ;
SpinnerHighValue = 3000.00, ;
SpinnerLowValue = 1900.00, ;
TabIndex = 46, ;
Top = 5, ;
Width = 53
*< END OBJECT: BaseClass="spinner" />
PROCEDURE buildcalendar
Parameters lPaint, lReference
Local oCollection, sObject, dNext, dFirst, nDow, dDate
This.IsPainted = lPaint
If lPaint
dDate = Iif(Empty(This.Date), Date(), This.Date)
dFirst = Date(Year(dDate), Month(dDate), 1)
nDow = Dow(dFirst) - 1
dNext = dFirst - nDow
This.LoadHoliDays(dDate)
EndIf
For nIndex = 1 To 42
*/--- Dibuja los dias
sObject = "btnButton_" + Alltrim(Str(nIndex))
If lPaint
This.&sObject..Caption = Alltrim(Str(Day(dNext)))
This.&sObject..Year = Year(dNext)
This.&sObject..Month = Month(dNext)
This.&sObject..Day = Day(dNext)
This.&sObject..BackColor = Rgb(255,255,255)
This.&sObject..btnButton.ToolTipText = ""
If Month(dNext) # Month(dDate)
This.&sObject..ForeColor = This.cusFuncs.Getcolor(This.ExtradayForeColor)
Else
If This.IsHoliday(dNext)
This.&sObject..ForeColor = This.cusFuncs.Getcolor(This.HolidayForeColor)
This.&sObject..btnButton.ToolTipText = This.GetHolidayTips(dNext)
Else
If Dow(dNext) == 1
This.&sObject..ForeColor = This.cusFuncs.Getcolor(This.SundayForeColor)
Else
If Dow(dNext) == 7
This.&sObject..ForeColor = This.cusFuncs.Getcolor(This.SaturdayForeColor)
Else
This.&sObject..ForeColor = This.cusFuncs.Getcolor(This.WeekdayForeColor)
EndIf
EndIf
EndIf
EndIf
If dNext == dDate
If ThisForm.Visible
This.&sObject..Click()
Else
*/--- Para el caso de ventanas creadas con CreateObject()
This.DebutObject = This.&sObject.
BindEvent(ThisForm, "Activate", This, "ShowDebut")
EndIf
EndIf
dNext = dNext + 1
EndIf
*/--- Crear referencias de navegación con teclado
If lReference
This.&sObject..UpObject = This.GetReference(nIndex, "UP")
This.&sObject..DownObject = This.GetReference(nIndex, "DOWN")
This.&sObject..LeftObject = This.GetReference(nIndex, "LEFT")
This.&sObject..RightObject = This.GetReference(nIndex, "RIGTH")
EndIf
EndFor
If lReference
*/--- Para verificar si se pinto el calendario ;
antes del metodo show()
BindEvent(ThisForm, "Show", This, "Verify")
EndIf
ENDPROC
PROCEDURE checkday
Parameter zYear, zMonth, zDay
If zDay > 28
If zMonth = 2
If (Mod(zYear, 4) = 0 And Mod(zYear, 100) != 0) Or Mod(zYear, 400) = 0
If zDay > 29
zDay = 29
EndIf
Else
If zDay > 28
zDay = 28
EndIf
Endif
Else
If !InList(zMonth, 1, 3, 5, 7, 8, 10, 12)
If zDay > 30
zDay = 30
EndIf
Endif
Endif
EndIf
Return (zDay)
ENDPROC
PROCEDURE date_assign
LPARAMETERS dDate
Local sObject, nIndex
dDate = Iif(Empty(dDate), Date(), dDate)
If (Year(dDate) # Year(This.Date) Or Month(dDate) # Month(This.Date)) Or !This.IsPainted
This.Date = dDate
This.spnYear.Value = Year(dDate)
This.cboMonth.ListIndex = Month(dDate)
This.BuildCalendar(.T., .F.)
Else
If Type("This.CurrentObject") == "O"
nIndex = (Dow(Date(Year(dDate), Month(dDate), 1)) - 1) + Day(dDate)
sObject = "btnbutton_" + Alltrim(Str(nIndex))
If !(Lower(This.CurrentObject.Name) == sObject)
This.&sObject..Click()
EndIf
EndIf
This.Date = dDate
EndIf
ENDPROC
PROCEDURE getholidaytips
Parameters dDate
Local sMonth, sResult
sResult = ""
If This.ShowHolidayTips
sIniFile = JustPath(This.ClassLibrary) + "\Holidays.ini"
sMonth = CMonth(dDate)
sTipKey = "Day" + TransForm(Day(dDate), "@L 99") + "Tips"
sResult = This.cusFuncs.IniReadKey(sMonth, sTipKey, sIniFile)
EndIf
Return sResult
ENDPROC
PROCEDURE getreference
Parameters nPosition, sDirection
Local sObject
Do Case
Case sDirection = "UP"
If nPosition <= 7
Else
sObject = "btnButton_" + Alltrim(Str(nPosition - 7))
Return This.&sObject.
EndIf
Case sDirection = "DOWN"
If nPosition >= 36 And nPosition <= 42
Else
sObject = "btnButton_" + Alltrim(Str(nPosition + 7))
Return This.&sObject.
EndIf
Case sDirection = "RIGTH"
If Mod(nPosition, 7) = 0
Else
sObject = "btnButton_" + Alltrim(Str(nPosition + 1))
Return This.&sObject.
EndIf
Case sDirection = "LEFT"
If nPosition = 1 or Mod(nPosition - 1, 7) = 0
Else
sObject = "btnButton_" + Alltrim(Str(nPosition - 1))
Return This.&sObject.
EndIf
EndCase
Return .F.
ENDPROC
PROCEDURE Init
*------------------------------------------------------------*
*! ___ _ _ ___ _ _ ___ _ ___ !*
*! / __| /_\ | | | __| | \| | | \ /_\ | _ \ !*
*! | (__ / _ \ | |__ | _| | .` | | |) | / _ \ | / !*
*! \___| /_/ \_\ |____| |___| |_|\_| |___/ /_/ \_\ |_|_\ !*
*! !*
*------------------------------------------------------------*
*! Clase _Calendar !*
*! Creado por : Roberto Reátegui Kanashiro !*
*! E-Mail : zerohackx@gmail.com !*
*! Actualizado : 03/09/2006 !*
*! Lugar : Tarapoto - Perú !*
*------------------------------------------------------------*
This.lblToday.Caption = Dtoc(Date())
This.BuildCalendar(.F., .T.)
ENDPROC
PROCEDURE isholiday
Parameters dDate
Local lResult
lResult = .F.
If This.ShowHolidayTips
If TransForm(Day(dDate), "@L 99") $ This.HoliDayList
lResult = .T.
EndIf
EndIf
Return lResult
ENDPROC
PROCEDURE loadholidays
Parameters dDate
Local sMonth
If This.ShowHolidayTips
sIniFile = JustPath(This.ClassLibrary) + "\Holidays.ini"
sMonth = Cmonth(dDate)
This.Holidaylist = This.cusFuncs.IniReadKey(sMonth, "Days", sIniFile)
EndIf
Return
ENDPROC
PROCEDURE onclick
Parameters dDate
This.Date = dDate
ENDPROC
PROCEDURE showdebut && Muestra un formulario y especifica si dicho formulario es modal o no modal.
UnBindEvents(ThisForm, "Activate", This, "ShowDebut")
This.DebutObject.Click()
This.DebutObject = .F.
ENDPROC
PROCEDURE verify
Parameters nStyle
UnBindEvents(ThisForm, "Show", This, "Verify")
If !This.IsPainted
This.Date = Iif(Empty(This.Date), Date(), This.Date)
EndIf
ENDPROC
PROCEDURE btnNext.Click
With This.Parent
.Date = Gomonth(.Date, 1)
EndWith
ENDPROC
PROCEDURE btnPrevious.Click
With This.Parent
.Date = Gomonth(.Date, -1)
EndWith
ENDPROC
PROCEDURE btnToday.Click
Local sObject, dDate
With This.Parent
.Date = Ctod(.lblToday.Caption)
EndWith
ENDPROC
PROCEDURE cboMonth.InteractiveChange
With This.Parent
nDay = .CheckDay(Year(.Date), This.ListIndex, Day(.Date))
.Date = Date(Year(.Date), This.ListIndex, nDay)
EndWith
ENDPROC
PROCEDURE spnYear.InteractiveChange
With This.Parent
nDay = .CheckDay(This.Value, Month(.Date), Day(.Date))
.Date = Date(This.Value, Month(.Date), nDay)
EndWith
ENDPROC
PROCEDURE spnYear.KeyPress
LPARAMETERS nKeyCode, nShiftAltCtrl
If Between(nKeyCode, 48, 57)
NoDefault
EndIf
ENDPROC
ENDDEFINE
DEFINE CLASS _colorbox AS shape
*< CLASSDATA: Baseclass="shape" Timestamp="" Scale="Pixels" Uniqueid="" ProjectClassIcon="colorbutton.bmp" ClassIcon="colorbutton.bmp" />
*<DefinedPropArrayMethod>
*p: pickcolor
*</DefinedPropArrayMethod>
*<PropValue>
Height = 17
Name = "_colorbox"
pickcolor = .F.
Width = 18
*</PropValue>
PROCEDURE MouseDown
LPARAMETERS nButton, nShift, nXCoord, nYCoord
NoDefault
ENDPROC
PROCEDURE MouseUp
LPARAMETERS nButton, nShift, nXCoord, nYCoord
NoDefault
If nButton = 1
ThisForm.SelectColor(This)
Else
ThisForm.SelectColor(This, This.PickColor)
EndIf
ENDPROC
ENDDEFINE
DEFINE CLASS _functions AS custom
*< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" ProjectClassIcon="library.bmp" ClassIcon="library.bmp" />
*<DefinedPropArrayMethod>
*m: bintorgb
*m: getcolor
*m: getdescfromext
*m: inireadkey
*m: popwindow
*m: readregkey
*m: rgbtobin
*m: rgbtostr
*m: strtorgb
*</DefinedPropArrayMethod>
*<PropValue>
Height = 16
Name = "_functions"
Width = 29
*</PropValue>
PROCEDURE bintorgb
Parameters zColor
nResult = Rgb(Asc(Substr(zColor, 1, 1)), ;
Asc(Substr(zColor, 2, 1)), ;
Asc(Substr(zColor, 3, 1)))
Return (nResult)
ENDPROC
PROCEDURE getcolor
Parameters zColor
sOnError = On("ERROR")
*On Error lError = .T.
Declare Integer GetSysColor In win32api As GetSystemColor Integer
sCommand = GetWordNum(zColor, 1, ":")
sParams = GetWordNum(zColor, 2, ":")
nColor = 0
Do Case
Case sCommand == "rgb"
nColor = This.StrToRgb(sParams)
Case sCommand == "sys"
nColor = GetSystemColor(Val(sParams))
Otherwise
nColor = 0
EndCase
Clear Dlls "GetSystemColor"
On Error
Return (nColor)
ENDPROC
PROCEDURE getdescfromext
Parameters zString
zString = Lower(zString)
sResult = ""
nCount = GetWordCount(zString, ",")
For nIndex = 1 To nCount
sExtension = GetWordNum(zString, nIndex, ",")
If !Empty(sExtension)
sAppKey = This.ReadRegKey("HKCR\." + sExtension + "\", "")
If !Empty(sAppKey)
sAppDescript = This.ReadRegKey("HKCR\" + sAppKey + "\", "")
sAppDescript = Iif(!Empty(sAppDescript), sAppDescript, "Archivo " + Upper(sExtension))
sResult = sResult + Alltrim(sAppDescript)+ " (*." + sExtension + "):" + sExtension + ";"
EndIf
EndIf
EndFor
If !Empty(sResult)
sResult = Left(sResult, Len(sResult) - 1)
EndIf
Return sResult
ENDPROC
PROCEDURE inireadkey
Parameters zSection, zKey, zFile
Local sResult, nLength
Try
Declare Integer GetPrivateProfileString In Win32API As GetPrivStr String cSection, String cKey,;
String cDefault, String @cBuffer, Integer nBufferSize, String cIniFile
sResult = Space(1024)
nLength = GetPrivStr(zSection, zKey, "", @sResult, Len(sResult), zFile)
sResult = Left(sResult, nLength)
Clear Dlls "GetPrivStr"
Catch When .T.
EndTry
Return sResult
ENDPROC
PROCEDURE Init
*--------------------------------------------------------------------*
*! ___ _ _ _ _ ___ _____ ___ ___ _ _ ___ !*
*! | __| | | | | | \| | / __| |_ _| |_ _| / _ \ | \| | / __| !*
*! | _| | |_| | | .` | | (__ | | | | | (_) | | .` | \__ \ !*
*! |_| \___/ |_|\_| \___| |_| |___| \___/ |_|\_| |___/ !*
*! !*
*--------------------------------------------------------------------*
*! Clase _Functions !*
*! Creado por : Roberto Reátegui Kanashiro !*
*! E-Mail : zerohackx@gmail.com !*
*! Actualizado : 03/09/2006 !*
*! Lugar : Tarapoto - Perú !*
*--------------------------------------------------------------------*
ENDPROC
PROCEDURE popwindow
PARAMETER sWindow, uParam1, uParam2, uParam3, uParam4, uParam5
Local oWindow, uValue
oWindow = CreateObject(sWindow, uParam1, uParam2, uParam3, uParam4, uParam5)
oWindow.Show(1)
uValue = oWindow.RetValue
oWindow.Release()
Return (uValue)
ENDPROC
PROCEDURE readregkey
Parameters sFolder, uDefault
LOCAL uValue, lError
lError = .F.
sError = ON("ERROR")
*On Error lError = .T.
uValue = uDefault
oWinReg = CreateObject("WScript.Shell")
uValue = oWinReg.RegRead(sFolder)
Release oWinReg
On Error &sError.
uValue = Iif(lError, "", uValue)
Return (uValue)
ENDPROC
PROCEDURE rgbtobin
Parameters zColor
sValue = Chr(Int(BitAnd(zColor, 0xFF))) + ;
Chr(Int(BitAnd(zColor, 0x100FF00) / 0x100)) + ;
Chr(Int(BitAnd(zColor, 0xFF0000) / 0x10000))
Return (sValue)
ENDPROC
PROCEDURE rgbtostr
Parameters zColor
sValue = Str(Int(BitAnd(zColor, 0xFF)), 3) + "," ;
+ Str(Int(BitAnd(zColor, 0x100FF00) / 0x100), 3) + "," ;
+ Str(Int(BitAnd(zColor, 0xFF0000) / 0x10000), 3)
sValue = Strtran(sValue, " ", "")
Return (sValue)
ENDPROC
PROCEDURE strtorgb
Parameters zColor
Store 0 To nRed, nGreen, nBlue
If Occurs(",", zColor) = 2
nColor = Val(GetWordNum(zColor, 1, ","))
If BetWeen(nColor, 0, 255)
nRed = nColor
EndIf
nColor = Val(GetWordNum(zColor, 2, ","))
If BetWeen(nColor, 0, 255)
nGreen = nColor
EndIf
nColor = Val(GetWordNum(zColor, 3, ","))
If BetWeen(nColor, 0, 255)
nBlue = nColor
EndIf
EndIf
Return (Rgb(nRed, nGreen, nBlue))
ENDPROC
ENDDEFINE
DEFINE CLASS _getcolor AS form
*< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" ProjectClassIcon="colors.bmp" ClassIcon="colors.bmp" />
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
*< OBJECTDATA: ObjPath="pfmPages" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpBox" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpSelector" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern1" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern9" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern17" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern25" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern33" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern41" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpCustom1" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern2" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern10" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern18" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern26" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern34" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern42" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpCustom2" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern3" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern11" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern19" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern27" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern35" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern43" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpCustom3" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern4" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern12" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern20" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern28" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern36" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern44" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpCustom4" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern5" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern13" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern21" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern29" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern37" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern45" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpCustom5" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern6" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern14" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern22" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern30" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern38" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern46" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpCustom6" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern7" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern15" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern23" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern31" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern39" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern47" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpCustom7" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern8" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern16" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern24" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern32" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern40" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpPattern48" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpCustom8" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpCustom9" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpCustom10" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpCustom11" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpCustom12" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpCustom13" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpCustom14" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpCustom15" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page1.shpCustom16" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page2.lstSysColors" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pfmPages.Page2.shpSelector" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnOk" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnCancel" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="cusFuncs" UniqueID="" Timestamp="" />
*<DefinedPropArrayMethod>
*m: buildspecialwindow
*m: loadcustomcolors
*m: loadsyscolors
*m: locatecolor
*m: savecustomcolors
*m: selectcolor
*p: defaultcolor
*p: retvalue
*</DefinedPropArrayMethod>
*<PropValue>
AutoCenter = .T.
BorderStyle = 2
Caption = "Paleta de Colores"
defaultcolor =
DoCreate = .T.
FontName = "MS Sans Serif"
Height = 207
Icon = colors.ico
MaxButton = .F.
MinButton = .F.
Name = "_getcolor"
retvalue =
Width = 245
WindowType = 1
*</PropValue>
ADD OBJECT 'btnCancel' AS commandbutton WITH ;
Cancel = .T., ;
Caption = "\<Cancelar", ;
FontName = "MS Sans Serif", ;
Height = 23, ;
Left = 176, ;
Name = "btnCancel", ;
TabIndex = 3, ;
Top = 182, ;
Width = 67
*< END OBJECT: BaseClass="commandbutton" />
ADD OBJECT 'btnOk' AS commandbutton WITH ;
Caption = "\<Aceptar", ;
FontName = "MS Sans Serif", ;
Height = 23, ;
Left = 107, ;
Name = "btnOk", ;
TabIndex = 2, ;
Top = 182, ;
Width = 67
*< END OBJECT: BaseClass="commandbutton" />
ADD OBJECT 'cusFuncs' AS _functions WITH ;
Height = 16, ;
Left = 3, ;
Name = "cusFuncs", ;
Top = 189, ;
Width = 18
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="custom" />
ADD OBJECT 'pfmPages' AS pageframe WITH ;
ErasePage = .T., ;
Height = 178, ;
Left = 2, ;
Name = "pfmPages", ;
PageCount = 2, ;
TabIndex = 1, ;
TabStretch = 1, ;
TabStyle = 1, ;
Top = 2, ;
Width = 242, ;
Page1.Caption = "Paleta", ;
Page1.FontName = "MS Sans Serif", ;
Page1.Name = "Page1", ;
Page2.Caption = "Sistema", ;
Page2.FontName = "MS Sans Serif", ;
Page2.Name = "Page2"
*< END OBJECT: BaseClass="pageframe" />
ADD OBJECT 'pfmPages.Page1.shpBox' AS shape WITH ;
BackColor = 128,128,128, ;
BackStyle = 1, ;
Height = 139, ;
Left = 6, ;
Name = "shpBox", ;
Top = 6, ;
Width = 139
*< END OBJECT: BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpCustom1' AS _colorbox WITH ;
BackColor = 255,255,255, ;
BackStyle = 1, ;
Height = 16, ;
Left = 8, ;
Name = "shpCustom1", ;
pickcolor = .T., ;
Top = 110, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpCustom10' AS _colorbox WITH ;
BackColor = 255,255,255, ;
BackStyle = 1, ;
Height = 16, ;
Left = 25, ;
Name = "shpCustom10", ;
pickcolor = .T., ;
Top = 127, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpCustom11' AS _colorbox WITH ;
BackColor = 255,255,255, ;
BackStyle = 1, ;
Height = 16, ;
Left = 42, ;
Name = "shpCustom11", ;
pickcolor = .T., ;
Top = 127, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpCustom12' AS _colorbox WITH ;
BackColor = 255,255,255, ;
BackStyle = 1, ;
Height = 16, ;
Left = 59, ;
Name = "shpCustom12", ;
pickcolor = .T., ;
Top = 127, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpCustom13' AS _colorbox WITH ;
BackColor = 255,255,255, ;
BackStyle = 1, ;
Height = 16, ;
Left = 76, ;
Name = "shpCustom13", ;
pickcolor = .T., ;
Top = 127, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpCustom14' AS _colorbox WITH ;
BackColor = 255,255,255, ;
BackStyle = 1, ;
Height = 16, ;
Left = 93, ;
Name = "shpCustom14", ;
pickcolor = .T., ;
Top = 127, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpCustom15' AS _colorbox WITH ;
BackColor = 255,255,255, ;
BackStyle = 1, ;
Height = 16, ;
Left = 110, ;
Name = "shpCustom15", ;
pickcolor = .T., ;
Top = 127, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpCustom16' AS _colorbox WITH ;
BackColor = 255,255,255, ;
BackStyle = 1, ;
Height = 16, ;
Left = 127, ;
Name = "shpCustom16", ;
pickcolor = .T., ;
Top = 127, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpCustom2' AS _colorbox WITH ;
BackColor = 255,255,255, ;
BackStyle = 1, ;
Height = 16, ;
Left = 25, ;
Name = "shpCustom2", ;
pickcolor = .T., ;
Top = 110, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpCustom3' AS _colorbox WITH ;
BackColor = 255,255,255, ;
BackStyle = 1, ;
Height = 16, ;
Left = 42, ;
Name = "shpCustom3", ;
pickcolor = .T., ;
Top = 110, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpCustom4' AS _colorbox WITH ;
BackColor = 255,255,255, ;
BackStyle = 1, ;
Height = 16, ;
Left = 59, ;
Name = "shpCustom4", ;
pickcolor = .T., ;
Top = 110, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpCustom5' AS _colorbox WITH ;
BackColor = 255,255,255, ;
BackStyle = 1, ;
Height = 16, ;
Left = 76, ;
Name = "shpCustom5", ;
pickcolor = .T., ;
Top = 110, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpCustom6' AS _colorbox WITH ;
BackColor = 255,255,255, ;
BackStyle = 1, ;
Height = 16, ;
Left = 93, ;
Name = "shpCustom6", ;
pickcolor = .T., ;
Top = 110, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpCustom7' AS _colorbox WITH ;
BackColor = 255,255,255, ;
BackStyle = 1, ;
Height = 16, ;
Left = 110, ;
Name = "shpCustom7", ;
pickcolor = .T., ;
Top = 110, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpCustom8' AS _colorbox WITH ;
BackColor = 255,255,255, ;
BackStyle = 1, ;
Height = 16, ;
Left = 127, ;
Name = "shpCustom8", ;
pickcolor = .T., ;
Top = 110, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpCustom9' AS _colorbox WITH ;
BackColor = 255,255,255, ;
BackStyle = 1, ;
Height = 16, ;
Left = 8, ;
Name = "shpCustom9", ;
pickcolor = .T., ;
Top = 127, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern1' AS _colorbox WITH ;
BackColor = 255,255,255, ;
BackStyle = 1, ;
Height = 16, ;
Left = 8, ;
Name = "shpPattern1", ;
Top = 8, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern10' AS _colorbox WITH ;
BackColor = 255,128,128, ;
BackStyle = 1, ;
Height = 16, ;
Left = 25, ;
Name = "shpPattern10", ;
Top = 25, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern11' AS _colorbox WITH ;
BackColor = 255,192,128, ;
BackStyle = 1, ;
Height = 16, ;
Left = 42, ;
Name = "shpPattern11", ;
Top = 25, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern12' AS _colorbox WITH ;
BackColor = 255,255,128, ;
BackStyle = 1, ;
Height = 16, ;
Left = 59, ;
Name = "shpPattern12", ;
Top = 25, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern13' AS _colorbox WITH ;
BackColor = 128,255,128, ;
BackStyle = 1, ;
Height = 16, ;
Left = 76, ;
Name = "shpPattern13", ;
Top = 25, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern14' AS _colorbox WITH ;
BackColor = 128,255,255, ;
BackStyle = 1, ;
Height = 16, ;
Left = 93, ;
Name = "shpPattern14", ;
Top = 25, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern15' AS _colorbox WITH ;
BackColor = 128,128,255, ;
BackStyle = 1, ;
Height = 16, ;
Left = 110, ;
Name = "shpPattern15", ;
Top = 25, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern16' AS _colorbox WITH ;
BackColor = 255,128,255, ;
BackStyle = 1, ;
Height = 16, ;
Left = 127, ;
Name = "shpPattern16", ;
Top = 25, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern17' AS _colorbox WITH ;
BackColor = 192,192,192, ;
BackStyle = 1, ;
Height = 16, ;
Left = 8, ;
Name = "shpPattern17", ;
Top = 42, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern18' AS _colorbox WITH ;
BackColor = 255,0,0, ;
BackStyle = 1, ;
Height = 16, ;
Left = 25, ;
Name = "shpPattern18", ;
Top = 42, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern19' AS _colorbox WITH ;
BackColor = 255,128,0, ;
BackStyle = 1, ;
Height = 16, ;
Left = 42, ;
Name = "shpPattern19", ;
Top = 42, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern2' AS _colorbox WITH ;
BackColor = 255,192,192, ;
BackStyle = 1, ;
Height = 16, ;
Left = 25, ;
Name = "shpPattern2", ;
Top = 8, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern20' AS _colorbox WITH ;
BackColor = 255,255,0, ;
BackStyle = 1, ;
Height = 16, ;
Left = 59, ;
Name = "shpPattern20", ;
Top = 42, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern21' AS _colorbox WITH ;
BackColor = 0,255,0, ;
BackStyle = 1, ;
Height = 16, ;
Left = 76, ;
Name = "shpPattern21", ;
Top = 42, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern22' AS _colorbox WITH ;
BackColor = 0,255,255, ;
BackStyle = 1, ;
Height = 16, ;
Left = 93, ;
Name = "shpPattern22", ;
Top = 42, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern23' AS _colorbox WITH ;
BackColor = 0,0,255, ;
BackStyle = 1, ;
Height = 16, ;
Left = 110, ;
Name = "shpPattern23", ;
Top = 42, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern24' AS _colorbox WITH ;
BackColor = 255,0,255, ;
BackStyle = 1, ;
Height = 16, ;
Left = 127, ;
Name = "shpPattern24", ;
Top = 42, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern25' AS _colorbox WITH ;
BackColor = 128,128,128, ;
BackStyle = 1, ;
Height = 16, ;
Left = 8, ;
Name = "shpPattern25", ;
Top = 59, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern26' AS _colorbox WITH ;
BackColor = 192,0,0, ;
BackStyle = 1, ;
Height = 16, ;
Left = 25, ;
Name = "shpPattern26", ;
Top = 59, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern27' AS _colorbox WITH ;
BackColor = 192,64,0, ;
BackStyle = 1, ;
Height = 16, ;
Left = 42, ;
Name = "shpPattern27", ;
Top = 59, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern28' AS _colorbox WITH ;
BackColor = 192,192,0, ;
BackStyle = 1, ;
Height = 16, ;
Left = 59, ;
Name = "shpPattern28", ;
Top = 59, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern29' AS _colorbox WITH ;
BackColor = 0,192,0, ;
BackStyle = 1, ;
Height = 16, ;
Left = 76, ;
Name = "shpPattern29", ;
Top = 59, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern3' AS _colorbox WITH ;
BackColor = 255,224,192, ;
BackStyle = 1, ;
Height = 16, ;
Left = 42, ;
Name = "shpPattern3", ;
Top = 8, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern30' AS _colorbox WITH ;
BackColor = 0,192,192, ;
BackStyle = 1, ;
Height = 16, ;
Left = 93, ;
Name = "shpPattern30", ;
Top = 59, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern31' AS _colorbox WITH ;
BackColor = 0,0,192, ;
BackStyle = 1, ;
Height = 16, ;
Left = 110, ;
Name = "shpPattern31", ;
Top = 59, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern32' AS _colorbox WITH ;
BackColor = 192,0,192, ;
BackStyle = 1, ;
Height = 16, ;
Left = 127, ;
Name = "shpPattern32", ;
Top = 59, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern33' AS _colorbox WITH ;
BackColor = 64,64,64, ;
BackStyle = 1, ;
Height = 16, ;
Left = 8, ;
Name = "shpPattern33", ;
Top = 76, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern34' AS _colorbox WITH ;
BackColor = 128,0,0, ;
BackStyle = 1, ;
Height = 16, ;
Left = 25, ;
Name = "shpPattern34", ;
Top = 76, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern35' AS _colorbox WITH ;
BackColor = 128,64,0, ;
BackStyle = 1, ;
Height = 16, ;
Left = 42, ;
Name = "shpPattern35", ;
Top = 76, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern36' AS _colorbox WITH ;
BackColor = 128,128,0, ;
BackStyle = 1, ;
Height = 16, ;
Left = 59, ;
Name = "shpPattern36", ;
Top = 76, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern37' AS _colorbox WITH ;
BackColor = 0,128,0, ;
BackStyle = 1, ;
Height = 16, ;
Left = 76, ;
Name = "shpPattern37", ;
Top = 76, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern38' AS _colorbox WITH ;
BackColor = 0,128,128, ;
BackStyle = 1, ;
Height = 16, ;
Left = 93, ;
Name = "shpPattern38", ;
Top = 76, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern39' AS _colorbox WITH ;
BackColor = 0,0,128, ;
BackStyle = 1, ;
Height = 16, ;
Left = 110, ;
Name = "shpPattern39", ;
Top = 76, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern4' AS _colorbox WITH ;
BackColor = 255,255,192, ;
BackStyle = 1, ;
Height = 16, ;
Left = 59, ;
Name = "shpPattern4", ;
Top = 8, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern40' AS _colorbox WITH ;
BackColor = 128,0,128, ;
BackStyle = 1, ;
Height = 16, ;
Left = 127, ;
Name = "shpPattern40", ;
Top = 76, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern41' AS _colorbox WITH ;
BackColor = 0,0,0, ;
BackStyle = 1, ;
Height = 16, ;
Left = 8, ;
Name = "shpPattern41", ;
Top = 93, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern42' AS _colorbox WITH ;
BackColor = 64,0,0, ;
BackStyle = 1, ;
Height = 16, ;
Left = 25, ;
Name = "shpPattern42", ;
Top = 93, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern43' AS _colorbox WITH ;
BackColor = 128,64,64, ;
BackStyle = 1, ;
Height = 16, ;
Left = 42, ;
Name = "shpPattern43", ;
Top = 93, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern44' AS _colorbox WITH ;
BackColor = 64,64,0, ;
BackStyle = 1, ;
Height = 16, ;
Left = 59, ;
Name = "shpPattern44", ;
Top = 93, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern45' AS _colorbox WITH ;
BackColor = 0,64,0, ;
BackStyle = 1, ;
Height = 16, ;
Left = 76, ;
Name = "shpPattern45", ;
Top = 93, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern46' AS _colorbox WITH ;
BackColor = 0,64,64, ;
BackStyle = 1, ;
Height = 16, ;
Left = 93, ;
Name = "shpPattern46", ;
Top = 93, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern47' AS _colorbox WITH ;
BackColor = 0,0,64, ;
BackStyle = 1, ;
Height = 16, ;
Left = 110, ;
Name = "shpPattern47", ;
Top = 93, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern48' AS _colorbox WITH ;
BackColor = 64,0,64, ;
BackStyle = 1, ;
Height = 16, ;
Left = 127, ;
Name = "shpPattern48", ;
Top = 93, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern5' AS _colorbox WITH ;
BackColor = 192,255,192, ;
BackStyle = 1, ;
Height = 16, ;
Left = 76, ;
Name = "shpPattern5", ;
Top = 8, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern6' AS _colorbox WITH ;
BackColor = 192,255,255, ;
BackStyle = 1, ;
Height = 16, ;
Left = 93, ;
Name = "shpPattern6", ;
Top = 8, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern7' AS _colorbox WITH ;
BackColor = 192,192,255, ;
BackStyle = 1, ;
Height = 16, ;
Left = 110, ;
Name = "shpPattern7", ;
Top = 8, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern8' AS _colorbox WITH ;
BackColor = 255,192,255, ;
BackStyle = 1, ;
Height = 16, ;
Left = 127, ;
Name = "shpPattern8", ;
Top = 8, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpPattern9' AS _colorbox WITH ;
BackColor = 224,224,224, ;
BackStyle = 1, ;
Height = 16, ;
Left = 8, ;
Name = "shpPattern9", ;
Top = 25, ;
Width = 16
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="shape" />
ADD OBJECT 'pfmPages.Page1.shpSelector' AS shape WITH ;
BackStyle = 0, ;
BorderColor = 255,255,255, ;
Height = 16, ;
Left = 148, ;
Name = "shpSelector", ;
Top = 75, ;
Visible = .F., ;
Width = 16
*< END OBJECT: BaseClass="shape" />
ADD OBJECT 'pfmPages.Page2.lstSysColors' AS listbox WITH ;
FontName = "MS Sans Serif", ;
Height = 121, ;
Left = 5, ;
Name = "lstSysColors", ;
Top = 5, ;
Width = 229
*< END OBJECT: BaseClass="listbox" />
ADD OBJECT 'pfmPages.Page2.shpSelector' AS shape WITH ;
Height = 19, ;
Left = 5, ;
Name = "shpSelector", ;
SpecialEffect = 0, ;
Top = 129, ;
Width = 229
*< END OBJECT: BaseClass="shape" />
PROCEDURE buildspecialwindow
Parameters nXCoord, nYCoord
This.TitleBar = 0
This.BorderStyle = 1
This.WindowType = 0
This.HalfHeightCaption = .F.
With This
.PfmPages.Top = 0
.pfmPages.Left = 0
.Width = .pfmPages.Width + 1
.Height = .pfmPages.Height + 1
.Top = nXCoord
.Left = nYCoord - .Width
.btnOk.Visible = .F.
.btnCancel.Visible = .F.
EndWith
ENDPROC
PROCEDURE Init
*-------------------------------------------------------------*
*! ___ ___ _____ ___ ___ _ ___ ___ !*
*! / __| | __| |_ _| / __| / _ \ | | / _ \ | _ \ !*
*! | (_ | | _| | | | (__ | (_) | | |__ | (_) | | / !*
*! \___| |___| |_| \___| \___/ |____| \___/ |_|_\ !*
*! !*
*-------------------------------------------------------------*
*! Clase _GetColor !*
*! Creado por : Roberto Reátegui Kanashiro !*
*! E-Mail : zerohackx@gmail.com !*
*! Actualizado : 03/09/2006 !*
*! Lugar : Tarapoto - Perú !*
*-------------------------------------------------------------*
Parameters uParam1, uParam2, uParam3, uParam4, uParam5
*/--- Color por defecto
This.DefaultColor = uParam1
*/--- Cargar colores personalizados
This.LoadCustomColors()
sParam = GetWordNum(uParam1, 1, ":")
nIndex = 1
If sParam == "rgb"
This.LocateColor(This.cusFuncs.GetColor(uParam1))
Else
This.pfmPages.ActivePage = 2
nIndex = Val(GetWordNum(uParam1, 2, ":")) + 1
EndIf
*/--- Cargar colores del sistema
This.LoadSysColors(nIndex)
ENDPROC
PROCEDURE loadcustomcolors
sCustom = ""
sFileColors = JustPath(This.ClassLibrary) + "\custom.pal"
With This.pfmPages.Page1
Try
sCustom = FileToStr(sFileColors)
nCount = Len(sCustom)
nIndex = 1
For nItem = 1 To nCount Step 3
sBinColor = Substr(sCustom, nItem, 3)
sObject = "shpcustom" + Alltrim(Str(nIndex))
.&sObject..BackColor = This.cusFuncs.BinToRgb(sBinColor)
nIndex = nIndex + 1
EndFor
Catch When .T.
EndTry
EndWith
ENDPROC
PROCEDURE loadsyscolors
Parameters nIndex
With This.pfmPages.Page2
.lstSysColors.AddItem("Barra de desplazamiento")
.lstSysColors.AddItem("Escritorio")
.lstSysColors.AddItem("Barra de titulo activa")
.lstSysColors.AddItem("Barra de titulo inactiva")
.lstSysColors.AddItem("Menú")
.lstSysColors.AddItem("Fondo de la ventana")
.lstSysColors.AddItem("Marco de la ventana")
.lstSysColors.AddItem("Texto del menú")
.lstSysColors.AddItem("Texto de la ventana")
.lstSysColors.AddItem("Texto de la barra de titulo activa")
.lstSysColors.AddItem("Borde de ventana activa")
.lstSysColors.AddItem("Borde de ventana inactiva")
.lstSysColors.AddItem("Fondo de la aplicacion")
.lstSysColors.AddItem("Resalte")
.lstSysColors.AddItem("Resalte del texto")
.lstSysColors.AddItem("Cara del botón")
.lstSysColors.AddItem("Sombra del botón")
.lstSysColors.AddItem("Texto deshabilitado")
.lstSysColors.AddItem("Texto del botón")
.lstSysColors.AddItem("Texto de la barra de título inactiva")
.lstSysColors.AddItem("Resalte del botón")
.lstSysColors.AddItem("Sombra oscura del botón")
.lstSysColors.AddItem("Sombra iluminada del botón")
.lstSysColors.AddItem("Texto de información sobre herramientas")
.lstSysColors.AddItem("Ventana de Información")
.lstSysColors.ListIndex = nIndex
.lstSysColors.InterActiveChange()
EndWith
ENDPROC
PROCEDURE locatecolor
Parameters nColor, sCustom
On Error lError = .T.
With This.pfmPages.Page1
For Each oRef In .Controls
If oRef.Class = "_colorbox" And oRef.BackColor = nColor
This.SelectColor(oRef)
Exit For
EndIf
EndFor
EndWith
On Error
ENDPROC
PROCEDURE QueryUnload
NoDefault
This.btnCancel.Click()
ENDPROC
PROCEDURE savecustomcolors
Set Safety Off
sFileColors = JustPath(This.ClassLibrary) + "\custom.pal"
With This.pfmPages.Page1
sBuffer = ""
For nIndex = 1 To 16
sObject = "shpcustom" + Alltrim(Str(nIndex))
sBuffer = sBuffer + This.cusFuncs.RgbToBin(.&sObject..BackColor)
EndFor
StrToFile(sBuffer, sFileColors)
EndWith
ENDPROC
PROCEDURE selectcolor
Parameters oParent, lGetColor
With This.pfmPages.Page1
If lGetColor
nResult = GetColor(oParent.BackColor)
If nResult # -1
oParent.BackColor = nResult
EndIf
EndIf
.shpSelector.Top = oParent.Top - 1
.shpSelector.Left = oParent.Left - 1
.shpSelector.Width = oParent.Width + 2
.shpSelector.Height = oParent.Height + 2
.shpSelector.Visible = .T.
This.Tag = "rgb:" + This.cusFuncs.RgbToStr(oParent.BackColor)
EndWith
ENDPROC
PROCEDURE btnCancel.Click
ThisForm.RetValue = ThisForm.DefaultColor
ThisForm.Hide()
ENDPROC
PROCEDURE btnOk.Click
With ThisForm.pfmPages
ThisForm.RetValue = ThisForm.Tag
ThisForm.Hide()
EndWith
ENDPROC
PROCEDURE pfmPages.Page2.lstSysColors.InteractiveChange
sColor = "sys:" + Alltrim(Str(This.ListIndex - 1,2))
ThisForm.Tag = sColor
This.Parent.shpSelector.BackColor = ThisForm.cusFuncs.GetColor(sColor)
If ThisForm.TitleBar = 0
ThisForm.btnOk.Click()
EndIf
ENDPROC
ENDDEFINE
DEFINE CLASS _getdate AS form
*< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" ProjectClassIcon="wincalendar.bmp" ClassIcon="wincalendar.bmp" />
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
*< OBJECTDATA: ObjPath="Calendar" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnOk" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="btnCancel" UniqueID="" Timestamp="" />
*<DefinedPropArrayMethod>
*p: retvalue
*</DefinedPropArrayMethod>
*<PropValue>
AutoCenter = .T.
BorderStyle = 2
Caption = "Calendario"
DoCreate = .T.
Height = 203
Icon = calendar.ico
MaxButton = .F.
MinButton = .F.
Name = "_getdate"
retvalue = .F.
Width = 196
*</PropValue>
ADD OBJECT 'btnCancel' AS commandbutton WITH ;
Cancel = .T., ;
Caption = "\<Cancelar", ;
FontName = "MS Sans Serif", ;
Height = 23, ;
Left = 125, ;
Name = "btnCancel", ;
TabIndex = 3, ;
Top = 176, ;
Width = 67
*< END OBJECT: BaseClass="commandbutton" />
ADD OBJECT 'btnOk' AS commandbutton WITH ;
Caption = "\<Aceptar", ;
FontName = "MS Sans Serif", ;
Height = 23, ;
Left = 56, ;
Name = "btnOk", ;
TabIndex = 2, ;
Top = 176, ;
Width = 67
*< END OBJECT: BaseClass="commandbutton" />
ADD OBJECT 'Calendar' AS _calendar WITH ;
Height = 172, ;
Left = 2, ;
Name = "Calendar", ;
Top = 0, ;
Width = 192, ;
shpTitleBar.Name = "shpTitleBar", ;
cusFuncs.Name = "cusFuncs", ;
btnButton_1.btnButton.Name = "btnButton", ;
btnButton_1.lblButton.Name = "lblButton", ;
btnButton_1.Name = "btnButton_1", ;
btnButton_2.btnButton.Name = "btnButton", ;
btnButton_2.lblButton.Name = "lblButton", ;
btnButton_2.Name = "btnButton_2", ;
btnButton_3.btnButton.Name = "btnButton", ;
btnButton_3.lblButton.Name = "lblButton", ;
btnButton_3.Name = "btnButton_3", ;
btnButton_4.btnButton.Name = "btnButton", ;
btnButton_4.lblButton.Name = "lblButton", ;
btnButton_4.Name = "btnButton_4", ;
btnButton_5.btnButton.Name = "btnButton", ;
btnButton_5.lblButton.Name = "lblButton", ;
btnButton_5.Name = "btnButton_5", ;
btnButton_6.btnButton.Name = "btnButton", ;
btnButton_6.lblButton.Name = "lblButton", ;
btnButton_6.Name = "btnButton_6", ;
btnButton_7.btnButton.Name = "btnButton", ;
btnButton_7.lblButton.Name = "lblButton", ;
btnButton_7.Name = "btnButton_7", ;
btnButton_8.btnButton.Name = "btnButton", ;
btnButton_8.lblButton.Name = "lblButton", ;
btnButton_8.Name = "btnButton_8", ;
btnButton_9.btnButton.Name = "btnButton", ;
btnButton_9.lblButton.Name = "lblButton", ;
btnButton_9.Name = "btnButton_9", ;
btnButton_10.btnButton.Name = "btnButton", ;
btnButton_10.lblButton.Name = "lblButton", ;
btnButton_10.Name = "btnButton_10", ;
btnButton_11.btnButton.Name = "btnButton", ;
btnButton_11.lblButton.Name = "lblButton", ;
btnButton_11.Name = "btnButton_11", ;
btnButton_12.btnButton.Name = "btnButton", ;
btnButton_12.lblButton.Name = "lblButton", ;
btnButton_12.Name = "btnButton_12", ;
btnButton_13.btnButton.Name = "btnButton", ;
btnButton_13.lblButton.Name = "lblButton", ;
btnButton_13.Name = "btnButton_13", ;
btnButton_14.btnButton.Name = "btnButton", ;
btnButton_14.lblButton.Name = "lblButton", ;
btnButton_14.Name = "btnButton_14", ;
btnButton_15.btnButton.Name = "btnButton", ;
btnButton_15.lblButton.Name = "lblButton", ;
btnButton_15.Name = "btnButton_15", ;
btnButton_16.btnButton.Name = "btnButton", ;
btnButton_16.lblButton.Name = "lblButton", ;
btnButton_16.Name = "btnButton_16", ;
btnButton_17.btnButton.Name = "btnButton", ;
btnButton_17.lblButton.Name = "lblButton", ;
btnButton_17.Name = "btnButton_17", ;
btnButton_18.btnButton.Name = "btnButton", ;
btnButton_18.lblButton.Name = "lblButton", ;
btnButton_18.Name = "btnButton_18", ;
btnButton_19.btnButton.Name = "btnButton", ;
btnButton_19.lblButton.Name = "lblButton", ;
btnButton_19.Name = "btnButton_19", ;
btnButton_20.btnButton.Name = "btnButton", ;
btnButton_20.lblButton.Name = "lblButton", ;
btnButton_20.Name = "btnButton_20", ;
btnButton_21.btnButton.Name = "btnButton", ;
btnButton_21.lblButton.Name = "lblButton", ;
btnButton_21.Name = "btnButton_21", ;
btnButton_22.btnButton.Name = "btnButton", ;
btnButton_22.lblButton.Name = "lblButton", ;
btnButton_22.Name = "btnButton_22", ;
btnButton_23.btnButton.Name = "btnButton", ;
btnButton_23.lblButton.Name = "lblButton", ;
btnButton_23.Name = "btnButton_23", ;
btnButton_24.btnButton.Name = "btnButton", ;
btnButton_24.lblButton.Name = "lblButton", ;
btnButton_24.Name = "btnButton_24", ;
btnButton_25.btnButton.Name = "btnButton", ;
btnButton_25.lblButton.Name = "lblButton", ;
btnButton_25.Name = "btnButton_25", ;
btnButton_26.btnButton.Name = "btnButton", ;
btnButton_26.lblButton.Name = "lblButton", ;
btnButton_26.Name = "btnButton_26", ;
btnButton_27.btnButton.Name = "btnButton", ;
btnButton_27.lblButton.Name = "lblButton", ;
btnButton_27.Name = "btnButton_27", ;
btnButton_28.btnButton.Name = "btnButton", ;
btnButton_28.lblButton.Name = "lblButton", ;
btnButton_28.Name = "btnButton_28", ;
btnButton_29.btnButton.Name = "btnButton", ;
btnButton_29.lblButton.Name = "lblButton", ;
btnButton_29.Name = "btnButton_29", ;
btnButton_30.btnButton.Name = "btnButton", ;
btnButton_30.lblButton.Name = "lblButton", ;
btnButton_30.Name = "btnButton_30", ;
btnButton_31.btnButton.Name = "btnButton", ;
btnButton_31.lblButton.Name = "lblButton", ;
btnButton_31.Name = "btnButton_31", ;
btnButton_32.btnButton.Name = "btnButton", ;
btnButton_32.lblButton.Name = "lblButton", ;
btnButton_32.Name = "btnButton_32", ;
btnButton_33.btnButton.Name = "btnButton", ;
btnButton_33.lblButton.Name = "lblButton", ;
btnButton_33.Name = "btnButton_33", ;
btnButton_34.btnButton.Name = "btnButton", ;
btnButton_34.lblButton.Name = "lblButton", ;
btnButton_34.Name = "btnButton_34", ;
btnButton_35.btnButton.Name = "btnButton", ;
btnButton_35.lblButton.Name = "lblButton", ;
btnButton_35.Name = "btnButton_35", ;
btnButton_36.btnButton.Name = "btnButton", ;
btnButton_36.lblButton.Name = "lblButton", ;
btnButton_36.Name = "btnButton_36", ;
btnButton_37.btnButton.Name = "btnButton", ;
btnButton_37.lblButton.Name = "lblButton", ;
btnButton_37.Name = "btnButton_37", ;
btnButton_38.btnButton.Name = "btnButton", ;
btnButton_38.lblButton.Name = "lblButton", ;
btnButton_38.Name = "btnButton_38", ;
btnButton_39.btnButton.Name = "btnButton", ;
btnButton_39.lblButton.Name = "lblButton", ;
btnButton_39.Name = "btnButton_39", ;
btnButton_40.btnButton.Name = "btnButton", ;
btnButton_40.lblButton.Name = "lblButton", ;
btnButton_40.Name = "btnButton_40", ;
btnButton_41.btnButton.Name = "btnButton", ;
btnButton_41.lblButton.Name = "lblButton", ;
btnButton_41.Name = "btnButton_41", ;
btnButton_42.btnButton.Name = "btnButton", ;
btnButton_42.lblButton.Name = "lblButton", ;
btnButton_42.Name = "btnButton_42", ;
spnYear.Name = "spnYear", ;
cboMonth.Name = "cboMonth", ;
lblTitleDay1.Name = "lblTitleDay1", ;
lblTitleDay2.Name = "lblTitleDay2", ;
lblTitleDay3.Name = "lblTitleDay3", ;
lblTitleDay4.Name = "lblTitleDay4", ;
lblTitleDay5.Name = "lblTitleDay5", ;
lblTitleDay6.Name = "lblTitleDay6", ;
lblTitleDay7.Name = "lblTitleDay7", ;
btnNext.Name = "btnNext", ;
btnPrevious.Name = "btnPrevious", ;
shpTodaybar.Name = "shpTodaybar", ;
Label7.Name = "Label7", ;
lblToday.Name = "lblToday", ;
btnToday.Name = "btnToday"
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="container" />
PROCEDURE Init
*-------------------------------------------------------*
*! ___ ___ _____ ___ _ _____ ___ !*
*! / __| | __| |_ _| | \ /_\ |_ _| | __| !*
*! | (_ | | _| | | | |) | / _ \ | | | _| !*
*! \___| |___| |_| |___/ /_/ \_\ |_| |___| !*
*! !*
*-------------------------------------------------------*
*! Clase _GetDate !*
*! Creado por : Roberto Reátegui Kanashiro !*
*! E-Mail : zerohackx@gmail.com !*
*! Actualizado : 03/09/2006 !*
*! Lugar : Tarapoto - Perú !*
*-------------------------------------------------------*
Parameters uParam1, uParam2, uParam3, uParam4, uParam5
This.Calendar.Date = Ctod(Alltrim(uParam1))
ENDPROC
PROCEDURE QueryUnload
NoDefault
This.Hide
ENDPROC
PROCEDURE btnCancel.Click
ThisForm.RetValue = ""
ThisForm.Hide()
ENDPROC
PROCEDURE btnOk.Click
With ThisForm.Calendar
ThisForm.RetValue = Dtoc(.Date)
ThisForm.Hide()
EndWith
ENDPROC
ENDDEFINE
DEFINE CLASS listproperty AS container
*< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" ProjectClassIcon="property.bmp" ClassIcon="property.bmp" />
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
*< OBJECTDATA: ObjPath="ctnBox" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="ctnBox.grdList" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="ctnBox.grdList.clmProperty.Header1" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="ctnBox.grdList.clmValue.Header1" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="ctnBox.ctnSplitter" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="ctnBox.txtTextbox" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="ctnBox.cboCombo" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="ctnBox.btnButton" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="cusFuncs" UniqueID="" Timestamp="" />
*<DefinedPropArrayMethod>
*m: activatecontrol
*m: adjustcontrol
*m: creategripper
*m: getdatalist
*m: gettablename
*m: refreshcontrol
*m: releasecontrol
*p: currentbutton
*p: currentcontrol && Especifica qué control contenido en un objeto Column se usa para mostrar los valores de la celda activa.
*p: difference
*p: initialized
*p: isdown
*p: isover
*</DefinedPropArrayMethod>
*<PropValue>
BorderColor = 0,0,0
BorderWidth = 1
currentbutton = .F.
currentcontrol =
difference = 0
Height = 241
initialized = .F.
isdown = .F.
isover = .F.
Name = "listproperty"
SpecialEffect = 1
Style = 3
Width = 219
*</PropValue>
ADD OBJECT 'ctnBox' AS container WITH ;
BorderWidth = 0, ;
Height = 239, ;
Left = 2, ;
Name = "ctnBox", ;
SpecialEffect = 0, ;
Top = 2, ;
Width = 214
*< END OBJECT: BaseClass="container" />
ADD OBJECT 'ctnBox.btnButton' AS commandbutton WITH ;
Caption = "¼", ;
FontName = "Symbol", ;
FontSize = 7, ;
Height = 14, ;
Left = 8, ;
Name = "btnButton", ;
SpecialEffect = 1, ;
TabStop = .F., ;
Top = -25, ;
Width = 16
*< END OBJECT: BaseClass="commandbutton" />
ADD OBJECT 'ctnBox.cboCombo' AS combobox WITH ;
BorderStyle = 0, ;
FontName = "MS Sans Serif", ;
FontSize = 8, ;
Height = 17, ;
Left = 9, ;
Margin = 0, ;
Name = "cboCombo", ;
RowSourceType = 1, ;
Style = 2, ;
Top = -29, ;
Width = 113
*< END OBJECT: BaseClass="combobox" />
ADD OBJECT 'ctnBox.ctnSplitter' AS container WITH ;
BackColor = 0,0,0, ;
BackStyle = 0, ;
BorderWidth = 0, ;
Height = 237, ;
Left = 75, ;
MouseIcon = ve_sizeb.cur, ;
MousePointer = 99, ;
Name = "ctnSplitter", ;
Top = 1, ;
Width = 3
*< END OBJECT: BaseClass="container" />
ADD OBJECT 'ctnBox.grdList' AS grid WITH ;
AllowCellSelection = .F., ;
AllowHeaderSizing = .F., ;
AllowRowSizing = .F., ;
BackColor = 255,255,255, ;
ColumnCount = 2, ;
DeleteMark = .F., ;
FontName = "MS Sans Serif", ;
ForeColor = 0,0,0, ;
GridLineColor = 128,128,128, ;
GridLines = 1, ;
GridLineWidth = 1, ;
HeaderHeight = 0, ;
Height = 241, ;
HighlightBackColor = 0,0,128, ;
HighlightRow = .F., ;
HighlightRowLineWidth = 0, ;
HighlightStyle = 2, ;
Left = -1, ;
LockColumnsLeft = 1, ;
Name = "grdList", ;
RecordMark = .F., ;
RowHeight = 15, ;
ScrollBars = 2, ;
SplitBar = .F., ;
Top = -1, ;
Width = 217, ;
Column1.BackColor = 192,192,192, ;
Column1.FontName = "MS Sans Serif", ;
Column1.ForeColor = 0,0,0, ;
Column1.Name = "clmProperty", ;
Column2.BackColor = 255,255,255, ;
Column2.FontName = "MS Sans Serif", ;
Column2.ForeColor = 0,0,0, ;
Column2.Name = "clmValue", ;
Column2.Width = 122
*< END OBJECT: BaseClass="grid" />
ADD OBJECT 'ctnBox.grdList.clmProperty.Header1' AS header WITH ;
Caption = "Propiedad", ;
FontName = "MS Sans Serif", ;
Name = "Header1"
*< END OBJECT: BaseClass="header" />
ADD OBJECT 'ctnBox.grdList.clmValue.Header1' AS header WITH ;
Caption = "Valor", ;
FontName = "MS Sans Serif", ;
Name = "Header1"
*< END OBJECT: BaseClass="header" />
ADD OBJECT 'ctnBox.txtTextbox' AS textbox WITH ;
BorderStyle = 0, ;
DisabledBackColor = 255,255,255, ;
DisabledForeColor = 0,0,0, ;
FontName = "MS Sans Serif", ;
FontSize = 8, ;
Height = 17, ;
Left = 8, ;
Margin = 0, ;
Name = "txtTextbox", ;
Top = -50, ;
Width = 112
*< END OBJECT: BaseClass="textbox" />
ADD OBJECT 'cusFuncs' AS _functions WITH ;
Height = 20, ;
Left = 1, ;
Name = "cusFuncs", ;
Top = 247, ;
Width = 17
*< END OBJECT: ClassLib="_lproperty.vcx" BaseClass="custom" />
PROCEDURE activatecontrol
PARAMETERS oParent
sAlias = oParent.RecordSource
If !Empty(sAlias) Or !Eof(sAlias)
sState = Evaluate(sAlias + ".State")
sObjectType = Left(Evaluate(sAlias + ".ObjectType"), 1)
sObjectExtr = Right(Evaluate(sAlias + ".ObjectType"), 1)
With This.ctnBox
Do Case
Case sObjectType == "L"
This.CurrentControl = .cboCombo
This.GetDataList(.cboCombo, Evaluate(sAlias + ".Enums"))
.cboCombo.Left = oParent.Left + oParent.clmProperty.Width + 3
.cboCombo.Top = oParent.Top + ((oParent.RowHeight * oParent.ActiveRow) - oParent.RowHeight) + oParent.GridLineWidth
.cboCombo.Height = oParent.RowHeight - oParent.GridLineWidth
.cboCombo.Width = oParent.clmValue.Width
.cboCombo.Zorder(0)
.cboCombo.Visible = .T.
Case sObjectType == "T"
This.CurrentControl = .txtTextbox
.txtTextbox.Left = oParent.Left + oParent.clmProperty.Width + 3
.txtTextbox.Top = oParent.Top + ((oParent.RowHeight * oParent.ActiveRow) - oParent.RowHeight) + oParent.GridLineWidth
.txtTextbox.Height = oParent.RowHeight - oParent.GridLineWidth
.txtTextbox.Width = oParent.clmValue.Width
.txtTextbox.Enabled = ICase(sState = "E", .T., sState = "D", .F., .T.)
.txtTextbox.ReadOnly = Iif(sState = "L", .T., .F.)
.txtTextbox.Zorder(0)
.txtTextbox.Visible = .T.
If sObjectExtr = "B"
This.CurrentButton = .btnButton
.txtTextbox.Width = oParent.clmValue.Width - oParent.RowHeight
.btnButton.Top = .txtTextbox.Top
.btnButton.Left = .txtTextbox.Left + .txtTextbox.Width
.btnButton.Height = .txtTextbox.Height
.btnButton.Width = oParent.RowHeight
.btnButton.Zorder(0)
.btnButton.Visible = .T.
EndIf
EndCase
This.CurrentControl.ControlSource = sAlias + ".Display"
*This.CurrentControl.SetFocus()
EndWith
EndIf
ENDPROC
PROCEDURE adjustcontrol
*/--- Ajustar Caja
With This.ctnBox
.Top = 2
.Left = 2
.Width = This.Width - 4
.Height = This.Height - 4
EndWith
*/--- Ajustar Grid
With This.ctnBox.grdList
.Top = -1
.Left = -1
.Width = .Parent.Width + 3
.Height = .Parent.Height + 2
.GridLineColor = This.cusFuncs.getcolor("sys:16")
.clmProperty.BackColor = This.cusFuncs.getcolor("sys:15")
.clmProperty.ForeColor = This.cusFuncs.getcolor("sys:18")
EndWith
*/--- Ajustar Caja de Valores
With This.ctnBox.grdList
.clmValue.Width = .Width - (.clmProperty.Width + Sysmetric(15) + 5)
EndWith
*/--- Ajustar Splitter
With This.ctnBox.ctnSplitter
.Top = 0
.Left = .Parent.grdList.Left + .Parent.grdList.clmProperty.Width
.Width = 3
.Height = .Parent.Height
EndWith
*/---
This.Difference = This.Left + This.ctnBox.Left
sObjects = "This.Parent"
Do While Type(sObjects) == "O"
sClass = Lower(Evaluate(sObjects + ".BaseClass"))
If InList(sClass, "container", "pageframe")
This.Difference = This.Difference + Evaluate(sObjects + ".Left")
EndIf
sObjects = sObjects + ".Parent"
EndDo
*/--- Acomodar el primer control
This.ActivateControl(This.ctnBox.grdList)
ENDPROC
PROCEDURE creategripper
PARAMETERS oParent
This.ctnBox.AddObject("shpGripper", "Shape")
This.ctnBox.shpGripper.Left = oParent.Left
This.ctnBox.shpGripper.Top = oParent.Top
This.ctnBox.shpGripper.Height = oParent.Height
This.ctnBox.shpGripper.Width = 1
This.ctnBox.shpGripper.BackStyle = 1
This.ctnBox.shpGripper.DrawMode = 6
This.ctnBox.shpGripper.FillStyle = 0
This.ctnBox.shpGripper.Zorder(0)
This.ctnBox.shpGripper.Visible = .T.
ENDPROC
PROCEDURE getdatalist
Parameters oCombo, sData
#DEFINE CRLF Chr(13) + Chr(10)
oCombo.Clear
nCount = GetWordCount(sData, CRLF)
For nLine = 1 To nCount
oCombo.AddItem(Alltrim(GetWordNum(sData, nLine, CRLF)))
EndFor
ENDPROC
PROCEDURE gettablename
Return (This.ctnBox.grdList.RecordSource)
ENDPROC
PROCEDURE Init
*------------------------------------------------------------------*
*! _ ___ ___ ___ ___ ___ ___ _____ __ __ !*
*! | | | _ \ | _ \ / _ \ | _ \ | __| | _ \ |_ _| \ \ / / !*
*! | |__ | _/ | / | (_) | | _/ | _| | / | | \ V / !*
*! |____| |_| |_|_\ \___/ |_| |___| |_|_\ |_| |_| !*
*! !*
*------------------------------------------------------------------*
*! Clase _ListProperty !*
*! Creado por : Roberto Reátegui Kanashiro !*
*! E-Mail : zerohackx@gmail.com !*
*! Actualizado : 03/09/2006 !*
*! Lugar : Tarapoto - Perú !*
*------------------------------------------------------------------*
sClassLib = This.ClassLibrary
Set Classlib To (sClassLib)
This.AdjustControl()
This.Initialized = .T.
ENDPROC
PROCEDURE refreshcontrol
PARAMETERS oParent
With This.CurrentControl
.Left = oParent.Left + oParent.clmProperty.Width + 3
.Top = oParent.Top + ((oParent.RowHeight * oParent.ActiveRow) - oParent.RowHeight) + oParent.GridLineWidth
.Height = oParent.RowHeight - oParent.GridLineWidth
.Width = oParent.clmValue.Width
If This.CurrentButton.Visible = .T.
.Width = oParent.clmValue.Width - oParent.RowHeight
This.CurrentButton.Top = .Top
This.CurrentButton.Left = .Left + .Width
This.CurrentButton.Height = .Height
This.CurrentButton.Width = oParent.RowHeight
EndIf
EndWith
ENDPROC
PROCEDURE releasecontrol
If Type("This.CurrentControl") == "O"
This.CurrentControl.Visible = .F.
EndIf
If Type("This.CurrentButton") == "O"
This.CurrentButton.Visible = .F.
EndIf
ENDPROC
PROCEDURE Resize
If This.Initialized = .T.
This.Adjustcontrol()
EndIf
ENDPROC
PROCEDURE ctnBox.btnButton.Click
With This.Parent
sAlias = This.Parent.Parent.GetTableName()
If !Evaluate(sAlias + ".Procedure")
sCommand = Upper(GetWordNum(Alltrim(Evaluate(sAlias + ".enums")), 1, ":"))
sParams = Lower(GetWordNum(Alltrim(Evaluate(sAlias + ".enums")), 2, ":"))
sResult = ""
Do Case
Case sCommand = "COLOR"
nColor = .Parent.cusFuncs.StrToRgb(.txtTextbox.Value)
nColor = GetColor(nColor)
If nColor # -1
sResult = .Parent.cusFuncs.RgbToStr(nColor)
EndIf
Case sCommand = "PRINTER"
sResult = GetPrinter()
Case sCommand = "FONT"
sName = GetWordNum(.txtTextbox.Value, 1, ",")
nSize = Val(GetWordNum(.txtTextbox.Value, 2, ","))
sStyle = GetWordNum(.txtTextbox.Value, 3, ",")
sResult = GetFont(sName, nSize, sStyle)
Case sCommand = "PICTURE"
sResult = Lower(GetPict())
Case sCommand = "FOLDER"
sResult = Lower(GetDir(.txtTextbox.Value))
Case sCommand = "FILE"
sExtension = .Parent.cusFuncs.GetDescFromExt(sParams)
sResult = Lower(GetFile(sExtension))
EndCase
Else
sResult = ExecScript(Evaluate(sAlias + ".Enums"), .Parent.cusFuncs, .txtTextbox.Value)
EndIf
If !Empty(sResult)
.txtTextbox.Value = sResult
*.txtTextbox.SetFocus()
EndIf
EndWith
ENDPROC
PROCEDURE ctnBox.btnButton.Init
This.VisualEffect = 1
ENDPROC
PROCEDURE ctnBox.btnButton.MouseDown
LPARAMETERS nButton, nShift, nXCoord, nYCoord
This.VisualEffect = 2
ENDPROC
PROCEDURE ctnBox.btnButton.MouseUp
LPARAMETERS nButton, nShift, nXCoord, nYCoord
This.VisualEffect = 1
ENDPROC
PROCEDURE ctnBox.cboCombo.KeyPress
LPARAMETERS nKeyCode, nShiftAltCtrl
If InList(nKeycode,4, 13, 19)
Keyboard '{LEFTARROW}'
EndIf
ENDPROC
PROCEDURE ctnBox.ctnSplitter.MouseDown
LPARAMETERS nButton, nShift, nXCoord, nYCoord
This.Parent.Parent.IsDown = .T.
This.Parent.Parent.CreateGripper(This)
ENDPROC
PROCEDURE ctnBox.ctnSplitter.MouseMove
LPARAMETERS nButton, nShift, nXCoord, nYCoord
With This.Parent
If .Parent.IsDown
lIsOver = .T.
If lIsOver
nLimit = .grdList.Left + (.grdList.Width - (Sysmetric(15) * 3) - 5)
nNewPos = nXCoord - .Parent.Difference
If nNewPos > 0 And nNewPos < nLimit
.shpGripper.Move(nNewPos)
EndIf
EndIf
lIsOver = .F.
EndIf
EndWith
ENDPROC
PROCEDURE ctnBox.ctnSplitter.MouseUp
LPARAMETERS nButton, nShift, nXCoord, nYCoord
This.Parent.Parent.IsDown = .F.
This.Move(This.Parent.shpGripper.Left)
This.Parent.RemoveObject("shpGripper")
With This.Parent
.grdList.clmProperty.Width = (This.Left - (.grdList.Left + 1))
.grdList.clmValue.Width = .grdList.Width - (.grdList.clmProperty.Width + Sysmetric(15) + 5)
If Type("This.Parent.Parent.CurrentControl") == "O"
.Parent.CurrentControl.Left = .grdList.Left + .grdList.clmProperty.Width + 3
.Parent.CurrentControl.Width = .grdList.clmValue.Width
EndIf
EndWith
ENDPROC
PROCEDURE ctnBox.grdList.AfterRowColChange
LPARAMETERS nColIndex
This.Parent.Parent.ActivateControl(This)
ENDPROC
PROCEDURE ctnBox.grdList.BeforeRowColChange
LPARAMETERS nColIndex
This.Parent.Parent.ReleaseControl()
ENDPROC
PROCEDURE ctnBox.grdList.KeyPress
LPARAMETERS nKeyCode, nShiftAltCtrl
If nKeyCode = 13
NoDefault
This.Parent.Parent.CurrentControl.SetFocus()
Else
If InList(nKeyCode, 4, 19)
NoDefault
EndIf
EndIf
ENDPROC
PROCEDURE ctnBox.grdList.Scrolled
LPARAMETERS nDirection
Wait Window Str(This.ActiveRow) NoWait
This.Parent.Parent.RefreshControl(This)
ENDPROC
PROCEDURE ctnBox.txtTextbox.KeyPress
LPARAMETERS nKeyCode, nShiftAltCtrl
If nKeycode = 13
Keyboard '{UPARROW}'
EndIf
ENDPROC
ENDDEFINE
Reference in New Issue View Git Blame Copy Permalink