*-------------------------------------------------------------------------------------------------------------------------------------------------------- * (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="" /> * *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 * * 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 = * 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="" /> * *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 * * Height = 17 Name = "custraversegrid" Width = 27 _memberdata = * 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