307 lines
10 KiB
Plaintext
307 lines
10 KiB
Plaintext
*--------------------------------------------------------------------------------------------------------------------------------------------------------
|
|
* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!!
|
|
*--------------------------------------------------------------------------------------------------------------------------------------------------------
|
|
*< FOXBIN2PRG: Version="1.21" SourceFile="accessibility.vcx" CPID="1250" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries)
|
|
*
|
|
*
|
|
DEFINE CLASS cusfonthandler AS custom
|
|
*< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*<DefinedPropArrayMethod>
|
|
*m: applyfont
|
|
*m: applyfonttogrid
|
|
*m: changefont
|
|
*m: computenewfontsize
|
|
*m: getfont
|
|
*m: promptforfont
|
|
*p: cdefaultfont && The default font to display when prompting the user for the new font, if the target container doesn't have font properties.
|
|
*p: cexceptclasses && Clasele exceptate de la marirea fontului: ex: LABEL
|
|
*p: cfontname && The name of the font chosen by the user.cResize The name of a class to use for resizing and repositioning controls.
|
|
*p: cresizelib && The name of the class library containing the resizer class.
|
|
*p: ldrilldown && Indicates whether the new font and size should be applied to contained objects. .T., by default.
|
|
*p: lnoresize && Indicates whether the resizing step should be omitted. .F., by default.
|
|
*p: ndefaultsize && The default font size to display when prompting the user for the new font, if the target container doesn't have font properties.
|
|
*p: nfontsize && The size of the font chosen by the user.
|
|
*p: noriginalsize && The original font size of the container (form), used in proportional sizing.
|
|
*p: oresize && An object reference to the resizing object.
|
|
*p: otarget && An object reference to the object (form) being refonted.
|
|
*p: _memberdata && XML Metadata for customizable properties
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
cdefaultfont = Segoe UI
|
|
cexceptclasses =
|
|
cfontname = Segoe UI
|
|
cresizelib =
|
|
Height = 17
|
|
ldrilldown = .T.
|
|
lnoresize = .T.
|
|
Name = "cusfonthandler"
|
|
ndefaultsize = 10
|
|
nfontsize = 0
|
|
noriginalsize = 0
|
|
oresize = .NULL.
|
|
otarget = .NULL.
|
|
Width = 22
|
|
_memberdata = <VFPData>
|
|
<memberdata name="cdefaultfont" display="cDefaultFont"/>
|
|
<memberdata name="cfontname" display="cFontName"/>
|
|
<memberdata name="cresizelib" display="cResizeLib"/>
|
|
<memberdata name="ldrilldown" display="lDrillDown"/>
|
|
<memberdata name="lnoresize" display="lNoResize"/>
|
|
<memberdata name="ndefaultsize" display="nDefaultSize"/>
|
|
<memberdata name="nfontsize" display="nFontSize"/>
|
|
<memberdata name="noriginalsize" display="nOriginalSize"/>
|
|
<memberdata name="oresize" display="oResize"/>
|
|
<memberdata name="otarget" displa<VFPData><memberdata name="cdefaultfont" display="cDefaultFont"/>
|
|
<memberdata name="cdefaultfont" display="cDefaultFont"/>
|
|
<memberdata name="cfontname" display="cFontName"/>
|
|
<memberdata name="cresizelib" display="cResizeLib"/>
|
|
<memberdata name="ldrilldown" display="lDrillDown"/>
|
|
<memberdata name="lnoresize" display="lNoResize"/>
|
|
</VFPData>
|
|
*</PropValue>
|
|
|
|
PROCEDURE applyfont
|
|
* Applies the new font and size to an object and then, recursively, to its contents.
|
|
Lparameters oApplyTo
|
|
|
|
Local nRatio
|
|
If Pemstatus(oApplyTo, "FontName",5)
|
|
With oApplyTo
|
|
* Compute new font size
|
|
nNewSize = This.ComputeNewFontSize(.FontSize)
|
|
*!* If nNewSize < 8
|
|
*!* * Handle small fonts
|
|
*!* .FontSize = nNewSize
|
|
*!* ENDIF
|
|
If Pemstatus(oApplyTo,'lChangeFont',5)
|
|
If .lChangeFont
|
|
.FontName = This.cFontName
|
|
Endif
|
|
Endif
|
|
If Pemstatus(oApplyTo,'lResizeFont',5)
|
|
*!* IF .lResizeFont
|
|
If .lResizeFont And nNewSize >= 8
|
|
.FontSize = nNewSize
|
|
Endif
|
|
Endif
|
|
Endwith
|
|
Endif
|
|
|
|
If This.lDrillDown
|
|
* Apply the new font to all contained objects
|
|
* keeping the fonts proportional
|
|
If Pemstatus(oApplyTo, "Objects", 5)
|
|
* it's a container, so away we go
|
|
Try
|
|
For Each oObject In oApplyTo.Objects
|
|
* Don't modify objects with lResizeFont = .F.
|
|
If Pemstatus(oObject,'lResizeFont',5)
|
|
If !oObject.lResizeFont
|
|
* Am adaugat linia cu This.ApplyFont pentru ca pot avea alte obiecte in oObject pe care trebuie modificat fontul
|
|
* Ex. : un grid dintr-un pageframe
|
|
This.ApplyFont(oObject)
|
|
Loop
|
|
Endif
|
|
Endif
|
|
If Upper(oObject.BaseClass) = "GRID"
|
|
This.ApplyFontToGrid( oObject )
|
|
Else
|
|
This.ApplyFont( oObject )
|
|
Endif
|
|
Endfor && Each
|
|
Catch
|
|
Endtry
|
|
Endif && Pemstatus
|
|
Endif && This.lDrillDown
|
|
Return
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE applyfonttogrid
|
|
* Applies the new font and size to a grid and its contents. Grids require special handling.
|
|
* Change font in grid. Special handling is needed
|
|
* because any change to a grid or column's FontName
|
|
* and FontSize properties is automatically passed down to its members.
|
|
Lparameters oGrid As Grid
|
|
|
|
Local aGridData[1], oTraverser, oColumn As Column
|
|
Local nEntries, nCount, aFontData[1]
|
|
oTraverser = CREATEOBJECT("cusTraverseGrid") && Newobject("cusTraverseGrid","Accessibility")
|
|
nEntries = oTraverser.BuildGridArray(oGrid, @aGridData)
|
|
Release oTraverser
|
|
*!* nEntries = Alen(aGridData)
|
|
Dimension aFontData[ nEntries, 2]
|
|
* Now get original font info
|
|
For nCount = 1 To nEntries
|
|
aFontData[ nCount, 1 ] = aGridData[ nCount ]
|
|
If Pemstatus(aGridData[ nCount ], "FontSize", 5)
|
|
aFontData[ nCount, 2 ] = ;
|
|
aGridData[ nCount ].FontSize
|
|
Else
|
|
aFontData[ nCount, 2 ] = -1
|
|
Endif
|
|
Endfor
|
|
* Now apply font
|
|
* First, apply to grid
|
|
*!* modificare 13.09.2013 : vreau sa nu imi faca randul mai mic decat era initial
|
|
If !Pemstatus(oGrid,"nMinRowHeight",5)
|
|
AddProperty(oGrid,"nMinRowHeight",oGrid.RowHeight)
|
|
Endif
|
|
*!* modificare 13.09.2013 ^
|
|
|
|
*!* modificare 24.09.2013 : vreau sa nu imi faca header-ul mai mic decat era initial
|
|
If !Pemstatus(oGrid,"nMinHeaderHeight",5)
|
|
AddProperty(oGrid,"nMinHeaderHeight",oGrid.HeaderHeight)
|
|
Endif
|
|
*!* modificare 13.09.2013 ^
|
|
|
|
oGrid.FontName = This.cFontName
|
|
oGrid.FontSize = This.ComputeNewFontSize(oGrid.FontSize)
|
|
oGrid.RowHeight = MAX(oGrid.nMinRowHeight,oGrid.RowHeight) && modificare 13.09.2013
|
|
oGrid.HeaderHeight = IIF(oGrid.nMinHeaderHeight = 0, 0, MAX(oGrid.nMinHeaderHeight,oGrid.HeaderHeight)) && modificare 24.09.2013
|
|
* Now apply to grid members from the outside in
|
|
* using stored font information
|
|
For nCount = 1 To nEntries
|
|
If aFontData[ nCount, 2] <> -1
|
|
aFontData[ nCount, 1].FontName = This.cFontName
|
|
aFontData[ nCount, 1].FontSize = ;
|
|
This.ComputeNewFontSize( aFontData[ nCount, 2] )
|
|
Endif
|
|
Endfor
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE changefont
|
|
Lparameters oTarget, tnResizeFont, tcFontName
|
|
* The key method that lets the user choose a new font and size and apply it.
|
|
|
|
This.oTarget = m.oTarget
|
|
|
|
If This.Getfont(m.tnResizeFont, m.tcFontName)
|
|
If Not This.lNoResize And ;
|
|
NOT Pemstatus(This.oTarget, "lHasResizerData", 5)
|
|
* If we're resizing and haven't saved form info,
|
|
* save it now
|
|
This.cusResize.SaveFormDimensions( This.oTarget )
|
|
Endif
|
|
This.ApplyFont( This.oTarget )
|
|
* Now resize if requested and available
|
|
If Not This.lNoResize And ;
|
|
PEMSTATUS(This,"cusResize", 5)
|
|
* If we're resizing, do it.
|
|
This.cusResize.AdjustControls( This.oTarget )
|
|
Endif
|
|
Endif && This.GetFont
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE computenewfontsize
|
|
* Computes the new font size of a control, given the old font size.
|
|
Lparameters nOldSize
|
|
|
|
Local nRatio, nNewSize
|
|
Assert Vartype(nOldSize) = "N" Message "ComputeNewFontSize: Must pass numeric parameter"
|
|
nRatio = nOldSize/This.nOriginalSize
|
|
nNewSize = Round(This.nFontSize * nRatio,0)
|
|
Return nNewSize
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE getfont
|
|
LPARAMETERS tnResizeFont, tcFontName
|
|
* tnFontSize: = just resizes the font, without prompting the user
|
|
* Sets things up for the user to choose a new font and size.
|
|
|
|
* Let the user choose a font.
|
|
Local lReturn
|
|
* First, set up defaults
|
|
If Pemstatus(This.oTarget,"FontName",5)
|
|
This.cFontName = This.oTarget.FontName
|
|
This.nFontSize = This.oTarget.FontSize
|
|
This.nOriginalSize = This.nFontSize
|
|
Else
|
|
This.cFontName = This.cDefaultFont
|
|
This.nFontSize = This.nDefaultSize
|
|
This.nOriginalSize = This.nFontSize
|
|
ENDIF
|
|
|
|
IF TYPE('tnResizeFont') = 'N'
|
|
This.nFontSize = This.nFontSize + m.tnResizeFont
|
|
|
|
IF TYPE('tcFontName') = 'C' AND !EMPTY(m.tcFontName)
|
|
This.cFontName = m.tcFontName
|
|
ENDIF
|
|
|
|
lReturn = .T.
|
|
else
|
|
lReturn = This.PromptForFont()
|
|
ENDIF
|
|
Return m.lReturn
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE promptforfont
|
|
* Prompt the user for font input
|
|
* and store the results in the right properties
|
|
* In this version, the GETFONT() dialog is used
|
|
* but the bold and italic settings are ignored.
|
|
Local cNewFont, lReturn
|
|
cNewFont = Getfont(This.cFontName, This.nFontSize)
|
|
|
|
If Not Empty(cNewFont)
|
|
Alines(aFontInfo, cNewFont, ",")
|
|
This.cFontName = aFontInfo[1]
|
|
This.nFontSize = Val(aFontInfo[2])
|
|
lReturn = .T.
|
|
Else
|
|
lReturn = .F.
|
|
Endif
|
|
Return lReturn
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS custraversegrid AS custom
|
|
*< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*<DefinedPropArrayMethod>
|
|
*m: buildgridarray && Build an array containing an entry for each object \ncontained in the grid (drilling down to the very bottom level)
|
|
*p: _memberdata && XML Metadata for customizable properties
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
Height = 17
|
|
Name = "custraversegrid"
|
|
Width = 27
|
|
_memberdata = <VFPData>
|
|
<memberdata name="buildgridarray" display="BuildGridArray"/>
|
|
</VFPData>
|
|
*</PropValue>
|
|
|
|
PROCEDURE buildgridarray && Build an array containing an entry for each object \ncontained in the grid (drilling down to the very bottom level)
|
|
Lparameters oGrid, aGridData
|
|
Local lnDimension, loColumn, loControl
|
|
EXTERNAL ARRAY aGridData
|
|
|
|
lnDimension = 0
|
|
|
|
For Each loColumn In oGrid.Columns
|
|
lnDimension = lnDimension + 1
|
|
Dimension aGridData[m.lnDimension]
|
|
aGridData[m.lnDimension] = m.loColumn
|
|
|
|
For Each loControl In loColumn.Controls
|
|
lnDimension = lnDimension + 1
|
|
Dimension aGridData[m.lnDimension]
|
|
aGridData[m.lnDimension] = m.loControl
|
|
Endfor
|
|
Endfor
|
|
|
|
RETURN m.lnDimension
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|