Initial: flux text FoxBin2Prg (git urmareste .??2 in-arbore, binarele VFP git-ignored)
Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
This commit is contained in:
306
clase/accessibility.vc2
Normal file
306
clase/accessibility.vc2
Normal file
@@ -0,0 +1,306 @@
|
||||
*--------------------------------------------------------------------------------------------------------------------------------------------------------
|
||||
* (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
|
||||
Reference in New Issue
Block a user