Files
vfp_roaauto/COMUN/programe/oHeader.prg

59 lines
1.5 KiB
Plaintext

Define Class PSHeader As Header
cHOrder = ""
nOrderColor = Rgb(0,0,255)
nNotOrderColor = 0
cCallMethod = 'Refresh()'
cPictureProp = ''
Procedure Init
Lparameters tcOldCaption, tcFontName, tnOldForeColor, tllOldFontUnderline, tcMethodName, tcOrder, tlOldWordWrap, tcPictureProp
DoDefault()
This.Alignment = 2
This.Caption = tcOldCaption
This.ForeColor = tnOldForeColor
This.FontUnderline = tllOldFontUnderline
this.WordWrap = tlOldWordWrap
This.FontName = tcFontName
This.nNotOrderColor = tnOldForeColor
If !Empty(tcMethodName)
This.cCallMethod = Alltrim(tcMethodName)
ENDIF
If !Empty(tcPictureProp)
This.cPictureProp = Alltrim(tcPictureProp)
Endif
*This.cHOrder = Strextract(Lower(This.Name),'grh')
IF ([*] $ tcOrder) OR ([+] $ tcOrder) OR ([-] $ tcOrder) OR ([/] $ tcOrder) OR ([(] $ tcOrder)
this.cHOrder = []
ELSE
this.cHOrder = ALLTRIM(tcOrder)
ENDIF
Endproc
Procedure DblClick
lcOrder = This.cHOrder
If !Empty(lcOrder)
This.Parent.Parent.SetAll("ForeColor", This.nNotOrderColor, "PSHeader")
This.Parent.Parent.SetAll("FontUnderline", .F., "PSHeader")
this.Parent.Parent.SetAll("Picture",'',"PSHeader")
This.ForeColor = This.nOrderColor
This.FontUnderline = .T.
lcCallMethod = [THIS.Parent.Parent.] + This.cCallMethod + [(lcOrder)]
&lcCallMethod
IF !EMPTY(This.cPictureProp)
lcPictureName = [THIS.Parent.Parent.] + This.cPictureProp
this.Picture = &lcPictureName
ENDIF
Else
* Leave as is
Endif
Endproc
Enddefine