romfast/comun
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
c4d869921dc3ff29f97d14af7fef401ebcecc416
comun/utile/foxcharts/gdiplusx.vc2

1104 lines
35 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="gdiplusx.vcx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries)
*
*
DEFINE CLASS ctlcanvas AS control
*< CLASSDATA: Baseclass="control" Timestamp="" Scale="Pixels" Uniqueid="" />
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
*< OBJECTDATA: ObjPath="Imgcanvas1" UniqueID="" Timestamp="" />
*<DefinedPropArrayMethod>
*m: beforedraw
*m: clear
*m: setup
*p: ogfx
*</DefinedPropArrayMethod>
*<PropValue>
BackStyle = 0
BorderWidth = 0
Height = 252
Name = "ctlcanvas"
ogfx = (NULL)
Width = 348
*</PropValue>
ADD OBJECT 'Imgcanvas1' AS imgcanvas WITH ;
Height = 252, ;
Left = 0, ;
Name = "Imgcanvas1", ;
Top = 0, ;
Width = 348
*< END OBJECT: ClassLib="gdiplusx.vcx" BaseClass="image" />
PROCEDURE beforedraw
ENDPROC
PROCEDURE clear
LPARAMETERS eColor
This.imgcanvas1.Clear(eColor)
ENDPROC
PROCEDURE Init
This.imgcanvas1.Width = This.Width
This.imgCanvas1.Height = This.Height
This.imgCanvas1.Anchor = 15
ENDPROC
PROCEDURE Resize
This.imgcanvas1.Resize()
ENDPROC
PROCEDURE setup
ENDPROC
ENDDEFINE
DEFINE CLASS ctlthemeprogressbar AS control
*< CLASSDATA: Baseclass="control" Timestamp="" Scale="Pixels" Uniqueid="" />
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
*< OBJECTDATA: ObjPath="Imgthemebase1" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Imgthemebase2" UniqueID="" Timestamp="" />
*<DefinedPropArrayMethod>
*m: orientation_assign
*m: updatecontrol
*m: value_assign
*p: max
*p: min
*p: orientation
*p: value && Specifies the current state of a control.
*</DefinedPropArrayMethod>
*<PropValue>
Height = 28
max = 100
min = 0
Name = "ctlthemeprogressbar"
orientation = 0
value = 0
Width = 296
*</PropValue>
ADD OBJECT 'Imgthemebase1' AS imgthemebase WITH ;
Height = 21, ;
Left = 3, ;
Name = "Imgthemebase1", ;
themeclass = (STRCONV("Progress"+0h00,5)), ;
themepart = 1, ;
Top = 3, ;
Width = 57
*< END OBJECT: ClassLib="gdiplusx.vcx" BaseClass="image" />
ADD OBJECT 'Imgthemebase2' AS imgthemebase WITH ;
Height = 21, ;
Left = 62, ;
Name = "Imgthemebase2", ;
themeclass = (STRCONV("Progress"+0h00,5)), ;
themepart = 1, ;
Top = 3, ;
Width = 57
*< END OBJECT: ClassLib="gdiplusx.vcx" BaseClass="image" />
PROCEDURE Init
This.UpdateControl()
ENDPROC
PROCEDURE orientation_assign
LPARAMETERS tnOrientation
IF BETWEEN(m.tnOrientation, 0, 1)
This.Orientation = m.tnOrientation
This.Value = This.Value
ENDIF
ENDPROC
PROCEDURE Resize
This.UpdateControl()
ENDPROC
PROTECTED PROCEDURE updatecontrol
WITH This.imgthemebase1
.Top = 0
.Left = 0
.Width = This.Width
.Height = This.Height
IF This.Orientation = 0 && Horizontal
.ThemePart = 1
ELSE
.ThemePart = 2
ENDIF
.Draw()
ENDWITH
WITH This.imgthemebase2
.Top = 4
.Left = 4
m.lnPct = (This.Value-This.Min)/(This.Max-This.Min)
IF This.Orientation = 0 && Horizontal
.Width = (This.Width-8)*m.lnPct
.Height = MAX(This.Height-8,1)
.ThemePart = 3
ELSE
.Width = This.Width-8
.Height = MAX((This.Height-8)*m.lnPct,1)
.Top = This.Height-4-.Height
.ThemePart = 4
ENDIF
.Draw()
ENDWITH
ENDPROC
PROCEDURE value_assign
LPARAMETERS tnValue
LOCAL lnPct
IF BETWEEN(m.tnValue, This.Min, This.Max)
This.Value = m.tnValue
This.UpdateControl()
ENDIF
ENDPROC
ENDDEFINE
DEFINE CLASS imgcanvas AS image
*< CLASSDATA: Baseclass="image" Timestamp="" Scale="Pixels" Uniqueid="" />
*<DefinedPropArrayMethod>
*m: activate && Occurs when a FormSet, Form, or Page object becomes active or when a ToolBar object is shown.
*m: afterdraw
*m: backstyle_access
*m: beforedraw
*m: clear && Clears the contents of a ComboBox or ListBox control.
*m: createosb
*m: declaredll
*m: deleteosb
*m: draw && Repaints a Form object.
*m: drawreport
*m: getextent
*m: height_access
*m: interpolationmode_assign
*m: lredrawnow_assign
*m: rectangle_access
*m: refresh && Repaints a Form or control and refreshes any values.
*m: rendermode_assign
*m: renderosb
*m: resize && Occurs when an object is resized.
*m: save
*m: setup
*m: smoothingmode_assign
*m: textrenderinghint_assign
*m: width_access
*p: controls && An array for accessing the controls in a container object.
*p: drawwheninvisible
*p: hdc
*p: interpolationmode
*p: lignorepaint
*p: lredrawnow
*p: obmp
*p: ogfx
*p: rectangle
*p: rendermode && 0 = Memory BMP ; 1 = File BMP ; 4 = Memory PNG
*p: smoothingmode
*p: textrenderinghint
*p: _bmpheight
*p: _bmpwidth
*p: _csize
*p: _hbitmapold
*p: _heightoverride
*p: _hwnd
*p: _inform
*p: _isinitialized
*p: _memberdata && XML Metadata for customizable properties
*p: _tempemffile
*p: _tempfile
*p: _usesmooth
*p: _widthoverride
*</DefinedPropArrayMethod>
PROTECTED lignorepaint,_bmpheight,_bmpwidth,_hbitmapold,_heightoverride,_hwnd,_inform,_isinitialized,_tempemffile,_tempfile,_widthoverride
*<PropValue>
BackStyle = 0
controls = (NULL)
drawwheninvisible = .F.
hdc = 0
Height = 162
interpolationmode = 0
lignorepaint = .F.
lredrawnow = .F.
Name = "imgcanvas"
obmp = (NULL)
ogfx = (NULL)
rectangle = (NULL)
rendermode = 0
smoothingmode = 4
textrenderinghint = 3
Width = 182
_bmpheight = 0
_bmpwidth = 0
_csize =
_hbitmapold = 0
_heightoverride = -1
_hwnd = 0
_inform = .F.
_isinitialized = .F.
_memberdata = <VFPData>
<memberdata name="beforedraw" type="method" display="BeforeDraw"/>
<memberdata name="hdc" type="property" display="HDC"/>
<memberdata name="ogfx" type="property" display="oGfx"/>
<memberdata name="refresh" type="method" display="Refresh"/>
<memberdata name="clear" type="method" display="Clear"/>
<memberdata name="draw" type="method" display="Draw"/>
<memberdata name="controls" type="property" display="Controls"/>
<memberdata name="setup" type="method" display="SetUp"/>
<memberdata name="save" type="method" display="Save"/>
<memberdata name="afterdraw" type="method" display="AfterDraw"/>
<memberdata name="interpolationmode" type="property" display="InterpolationMode"/>
<memberdata name="rectangle" type="property" display="Rectangle"/>
<memberdata name="rendermode" type="property" display="RenderMode"/>
<memberdata name="smoothingmode" type="property" display="SmoothingMode"/>
<memberdata name="textrenderinghint" type="property" display="TextRenderingHint"/>
<memberdata name="obmp" type="property" display="oBmp"/>
<memberdata name="drawwheninvisible" type="property" display="DrawWhenInvisible"/>
<memberdata name="lredrawnow" type="property" display="lRedrawNow"/>
<memberdata name="drawreport" type="method" display="DrawReport"/>
<memberdata name="resize" type="method" display="Resize"/>
<memberdata name="activate" type="method" display="Activate"/>
<memberdata name="_usesmooth" type="property" display="_UseSmooth"/>
</VFPData>
_tempemffile =
_tempfile =
_usesmooth = .F.
_widthoverride = -1
*</PropValue>
PROCEDURE activate && Occurs when a FormSet, Form, or Page object becomes active or when a ToolBar object is shown.
*********************************************************************
** Method: ImgCanvas.Activate
**
** Occurs when the Image Canvas is activated for the 1st time
**
** History:
** 2007/12/23: CWollenhaupt - Coded - observations below
**
*********************************************************************
*********************************************************************
* We cannot display a control properly during the initialization of a form. Because the
* form is invisible while it's loaded, it doesn't trigger any Resize event when the size
* changes or controls are moved around. Nor are several properties updated correctly at
* this point. The form becomes visible when the Activate event is triggered.
*
* The control might have been drawn already, for instance, by calling the Draw method
* directly. If the control's size hasn't changed, there's no need to repeat drawing the
* control. However, if the size differs we now have to redraw the control with the
* actual size.
*
* Activate can fire repeatedly. There's little advantage of frequently drawing the same
* image. Hence, we unbind the control once it was triggered.
*
*********************************************************************
LOCAL lcNewSize
m.lcNewSize = BINTOC(This.Width, "4rs") + BINTOC(This.Height, "4rs")
IF NOT This._cSize == m.lcNewSize
This.Draw()
ENDIF
IF This._InForm
UNBINDEVENTS(Thisform,"Activate",This,"Activate")
ENDIF
ENDPROC
PROCEDURE afterdraw
ENDPROC
PROTECTED PROCEDURE backstyle_access
** For use in Grids, if the control is hosted in a grid
** it needs to update for each visible row. This event
** will fire as each visible row in the Grid
This.Draw()
RETURN THIS.BackStyle
ENDPROC
PROCEDURE beforedraw
ENDPROC
PROCEDURE clear && Clears the contents of a ComboBox or ListBox control.
LPARAMETERS teColor
** eColor can be RGB, ARGB or Color object
DO CASE
** Color object
CASE VARTYPE(m.teColor) = "O"
This.oGfx.Clear(m.teColor)
** RGB color
CASE VARTYPE(m.teColor) = "N" AND BITAND(m.teColor,0xFF000000) = 0
This.oGfx.Clear(_SCREEN.System.Drawing.Color.FromRGB(m.teColor))
** ARGB color
CASE VARTYPE(m.teColor) = "N"
This.oGfx.Clear(_SCREEN.System.Drawing.Color.FromARGB(m.teColor))
OTHERWISE
IF This._InForm
*! ToDo: Need to add support for XP theme background
This.oGfx.Clear(_SCREEN.System.Drawing.Color.FromRGB(This.Parent.BackColor))
ELSE
This.oGfx.Clear(_SCREEN.System.Drawing.Color.White)
ENDIF
ENDCASE
ENDPROC
PROTECTED PROCEDURE createosb
LPARAMETERS tnWidth, tnHeight
This.DeleteOSB()
LOCAL loRect
IF EMPTY(m.tnWidth)
m.tnWidth = This.Width
m.tnHeight = This.Height
ENDIF
This._BMPWidth = m.tnWidth
This._BMPHeight = m.tnHeight
m.tnWidth = MAX(m.tnWidth,1)
m.tnHeight = MAX(m.tnHeight,1)
WITH _Screen.System.Drawing
DO CASE
CASE This.RenderMode = 1 && Render to File
This.oBmp = .Bitmap.New(m.tnWidth, m.tnHeight, .Imaging.PixelFormat.Format24bppRGB)
CASE This.RenderMode = 7 && Render to EMF
IF EMPTY(This._tempfile)
This._tempfile = ADDBS(SYS(2023))+SYS(2015)+".emf"
ELSE
DELETE FILE (This._tempfile)
CLEAR RESOURCES (This._tempfile)
This._tempfile = ADDBS(SYS(2023))+SYS(2015)+".emf"
ENDIF
loRect = .Rectangle.New(0, 0, m.tnWidth, m.tnHeight)
This.oBmp = .Imaging.Metafile.New(This._tempfile,0, m.loRect, ;
.Imaging.MetafileFrameUnit.Pixel, ;
.Imaging.MetaFileType.EmfPlusOnly)
OTHERWISE
This.oBmp = .Bitmap.New(m.tnWidth, m.tnHeight)
ENDCASE
This.oGfx = .Graphics.FromImage(This.oBmp)
This.oGfx.SmoothingMode = This.SmoothingMode
This.oGfx.TextRenderingHint = This.TextRenderingHint
This.oGfx.InterpolationMode = This.InterpolationMode
ENDWITH
ENDPROC
PROCEDURE declaredll
ENDPROC
PROTECTED PROCEDURE deleteosb
This.oGfx = NULL
This.oBMP = NULL
ENDPROC
PROCEDURE Destroy
LOCAL m.lcFile
IF VARTYPE(This.Controls) = "O"
This.Controls.Remove(-1)
ENDIF
This.Controls = NULL
This.DeleteOSB()
IF VARTYPE(This._TempEMFFile)="O"
This.Picture = ""
FOR EACH m.lcFile IN This._TempEMFFile
IF FILE(m.lcFile)
DELETE FILE (m.lcFile)
ENDIF
ENDFOR
ENDIF
IF FILE(This._tempfile)
This.Picture = ""
DELETE FILE (This._tempFile)
ENDIF
ENDPROC
PROCEDURE draw && Repaints a Form object.
*********************************************************************
** Method: ImgCanvas.Draw
**
** History:
** 2006/../..: BDurban - Coded
** 2007/12/23: CWollenhaupt - Fixed observations below
**
*********************************************************************
LPARAMETERS tnWidth, tnHeight, toGfx
LOCAL loGfxOld
*********************************************************************
* When we have many GDI+ objects on a form we have to make sure that we don't redraw
* them too many times as this reduces performance quite a bit. While the form is not
* visible we cannot rely on the current dimension. It might change without us being
* notified. Therefore we filter calls only redrawing when there's actually something to
* do.
*********************************************************************
IF This._InForm
IF NOT This.lRedrawNow AND NOT Thisform.Visible AND NOT This.DrawWhenInvisible
RETURN
ENDIF
ENDIF
IF NOT This._IsInitialized
RETURN
ENDIF
IF EMPTY(m.tnWidth)
This._WidthOverride = -1
This._HeightOverride = -1
m.tnWidth = This.Width
m.tnHeight = This.Height
ELSE
This._WidthOverride = m.tnWidth
This._HeightOverride = m.tnHeight
ENDIF
IF VARTYPE(m.toGfx) = "O"
m.loGFXOld = This.oGfx
This.oGfx = m.toGFX
This.BeforeDraw()
* This.RenderOSB()
This.AfterDraw()
This.oGfx = m.loGFXOld
ELSE
This._cSize = BINTOC(m.tnWidth,"4rs") + BINTOC(m.tnHeight,"4rs")
IF This._BMPWidth <> m.tnWidth OR This._BMPHeight <> m.tnHeight OR This.RenderMode = 7
This.CreateOSB(m.tnWidth, m.tnHeight)
ENDIF
This.BeforeDraw()
This.RenderOSB()
This.AfterDraw()
ENDIF
This._WidthOverride = -1
This._HeightOverride = -1
ENDPROC
PROCEDURE drawreport
LPARAMETERS tnWidth, tnHeight
LOCAL loRect, loEMF, loGFX, lcTempFile, lnSelect
** Hooking into a report is sensitive to the work area changing
** lets make sure we can restore the current workarea in case it changes
m.lnSelect = SELECT()
m.tnWidth = EVL(m.tnWidth, This.Width)
m.tnHeight = EVL(m.tnHeight, This.Height)
** The only way to support EMF in a VFP 9 report is to either draw it
** ourselves or go to disk. The Image object's PictureVal does not work
** for EMFs. So we are going to create a temp EMF file to draw to and
** then return the file name from this function. All temp files need to
** be stored in a collection so we can clean them up later
IF VARTYPE(This._TempEMFFile) <> "O"
This._TempEMFFile = CREATEOBJECT("Collection")
ENDIF
m.lcTempFile = ADDBS(SYS(2023))+SYS(2015)+".emf"
This._TempEMFFile.Add(m.lcTempFile)
WITH _SCREEN.System.Drawing
m.loRect = .Rectangle.New(0,0,m.tnWidth,m.tnHeight)
* m.loEMF = .Imaging.Metafile.New(m.lcTempFile, 0, ;
m.loRect, ;
.Imaging.MetafileFrameUnit.Pixel, ;
.Imaging.MetafileType.Emf)
* m.loEMF = .Imaging.Metafile.New(m.lcTempFile, 0, ;
m.loRect, ;
.Imaging.MetafileFrameUnit.Pixel, ;
.Imaging.MetafileType.EmfPlusDual)
m.loEMF = .Imaging.Metafile.New(m.lcTempFile, 0, ;
m.loRect, ;
.Imaging.MetafileFrameUnit.Pixel, ;
_Screen.System.Drawing.Imaging.MetafileType.EmfPlusOnly)
ASSERT m.loEMF.Handle <> 0 MESSAGE "Invalid EMF"
m.loGFX = .Graphics.FromImage(m.loEMF)
** Override the default Width, Height and Graphics
IF This._UseSmooth
loGfx.SmoothingMode = This.SmoothingMode
loGfx.TextRenderingHint = This.TextRenderingHint
loGfx.InterpolationMode = This.InterpolationMode
ENDIF
This.Draw(m.tnWidth, m.tnHeight, m.loGfx)
ENDWITH
m.loGFX = NULL
m.loEMF = NULL
m.loStream = NULL
m.loRect = NULL
SELECT (m.lnSelect)
RETURN m.lcTempFile
ENDPROC
PROCEDURE getextent
ENDPROC
PROTECTED PROCEDURE height_access
* If we are hosted in a Grid, the Height is invalid.
* We need to use the Grid's RowHeight
IF This._InForm AND This.Parent.BaseClass = "Column"
RETURN This.Parent.Parent.RowHeight
ENDIF
RETURN IIF(This._HeightOverride < 0, This.Height, This._HeightOverride)
ENDPROC
PROCEDURE Init
*********************************************************************
** Method: ImgCanvas.Init
**
** Initializes the ImageCanvas
**
** History:
** 2006/../..: BDurban - Coded
** 2007/12/23: CWollenhaupt - Fixed observations below
**
*********************************************************************
LOCAL lcPath
IF VARTYPE(_SCREEN.System) <> "O"
m.lcPath = ADDBS(JUSTPATH(SUBSTR(SYS(16), AT(" ",SYS(16),2)+1)))
DO CASE
CASE FILE("system.app")
DO ("system.app")
CASE FILE(m.lcPath+"system.app")
DO (m.lcPath+"system.app")
CASE FILE(m.lcPath+"system.prg")
DO (m.lcPath+"system.prg")
ENDCASE
ENDIF
This._InForm = TYPE("ThisForm")=="O"
This._IsInitialized = .T.
This.CreateOSB()
This.Controls=CREATEOBJECT("Collection")
This.Setup()
*========================================================================================
* Changes to the original class:
*
* - Bind the Form's Activate method to a new Activate method in this control. Previously
* the method was bound to Draw which forces a redraw. By redirecting this to Activate
* we can use additionally checks to confirm that we actually need to redraw the
* control. In addition, we only have to draw the control the first time the form is
* activated. After that any need to redraw is triggered by a Resize, the UIEnabled
* event or an explicit call to Draw.
*
* - Pages don't have a Resize event. In order to add this control a page it must respond
* to the PageFrame's Resize event after VFP completed the Resize event. Otherwise the
* PageWidth and PageHeight properties still contain the old values.
*
*========================================================================================
IF This._InForm
BINDEVENT(Thisform, "Activate", This, "Activate")
IF This.Parent.BaseClass == "Page"
BINDEVENT(This.Parent.Parent, "Resize", This, "Resize", 1)
ELSE
BINDEVENT(This.Parent, "Resize", This, "Resize")
ENDIF
ENDIF
ENDPROC
PROTECTED PROCEDURE interpolationmode_assign
LPARAMETERS vNewVal
THIS.InterpolationMode = m.vNewVal
This.oGfx.InterpolationMode = m.vNewVal
ENDPROC
PROTECTED PROCEDURE lredrawnow_assign
*********************************************************************
** Method: lRedrawNow_Assign
**
** History:
** 2007/12/23: CWollenhaupt - Coded - observations below
**
*********************************************************************
LPARAMETERS tlNow
*********************************************************************
* Force the control to resize itself. Draw additionaly ensures that we
** only draw the control when it is visible.
*********************************************************************
IF m.tlNow
This.lRedrawNow = .T.
This.Draw()
This.lRedrawNow = .F.
ENDIF
ENDPROC
PROTECTED PROCEDURE rectangle_access
IF VARTYPE(This.Rectangle) <> "O"
This.Rectangle = _SCREEN.System.Drawing.Rectangle.New(0,0,This.Width,This.Height)
ELSE
This.Rectangle.Width = This.Width
This.Rectangle.Height = This.Height
ENDIF
RETURN This.Rectangle
ENDPROC
PROCEDURE refresh && Repaints a Form or control and refreshes any values.
ENDPROC
PROTECTED PROCEDURE rendermode_assign
LPARAMETERS vNewVal
*To do: Modify this routine for the Assign method
THIS.RenderMode = m.vNewVal
This.CreateOSB()
ENDPROC
PROTECTED PROCEDURE renderosb
**************************************************************
* FUNCTION RenderOSB
*
* This PROTECTED method is called when the Image control needs
* to be updated to the screen.
**************************************************************
LOCAL llLockScreen
IF This._InForm
m.llLockScreen = ThisForm.LockScreen
ThisForm.LockScreen = .T.
ENDIF
DO CASE
CASE This.RenderMode = 0 && Memory BITMAP
This.PictureVal = This.oBmp.GetPictureValfromHBitmap()
CASE This.RenderMode = 1 && File BITMAP
IF EMPTY(This._tempfile)
This._tempfile = ADDBS(SYS(2023))+SYS(2015)+".bmp"
ELSE
This.Picture = ""
CLEAR RESOURCES (This._tempfile)
DELETE FILE (This._tempfile)
This._tempfile = ADDBS(SYS(2023))+SYS(2015)+".bmp"
ENDIF
This.oBmp.Save(This._tempfile, _Screen.System.Drawing.Imaging.ImageFormat.Bmp)
This.Picture = (This._tempfile)
CASE This.RenderMode = 4 && Memory PNG
** PNG PictureVal is only supported in SP2 and later
IF VERSION(4) >= "09.00.0000.5411" && "09.00.0000.5815" && VFP 9.0 SP2
This.PictureVal = This.oBmp.GetPictureVal(_Screen.System.Drawing.Imaging.ImageFormat.Png)
ELSE
** Default to BMP if SP1 or earlier
This.PictureVal = This.oBmp.GetPictureValfromHBitmap()
ENDIF
CASE This.RenderMode = 5 && File PNG
IF EMPTY(This._tempfile)
This._tempfile = ADDBS(SYS(2023))+SYS(2015)+".png"
ELSE
This.Picture = ""
CLEAR RESOURCES (This._tempfile)
DELETE FILE (This._tempfile)
This._tempfile = ADDBS(SYS(2023))+SYS(2015)+".png"
ENDIF
This.oBmp.Save(This._tempfile, _Screen.System.Drawing.Imaging.ImageFormat.Png)
This.Picture = (This._tempfile)
CASE This.RenderMode = 8 && File EMF
This.oGfx = NULL
LOCAL llLocked
IF This._InForm
m.llLocked = ThisForm.LockScreen
ThisForm.LockScreen = .T.
ENDIF
This.Picture = (This._tempFile)
IF This._InForm AND NOT ThisForm.LockScreen = m.llLocked
ThisForm.LockScreen = m.llLocked
ENDIF
ENDCASE
IF This._InForm
ThisForm.LockScreen = m.llLockScreen
ENDIF
RETURN
ENDPROC
PROCEDURE resize && Occurs when an object is resized.
IF This.Stretch = 0 AND This.Anchor > 0 && AND (m.nWidth <> This.Width OR m.nHeight <> This.Height)
This.Draw()
ENDIF
ENDPROC
PROCEDURE save
*********************************************************************
** Method: Save
**
** Saves an image of the current canvas object
**
** History:
** 2006/08/05: BDurban/CChalom - Added save method
** 2006/08/10: BDurban - Changed to use new oBMP property
*********************************************************************
LPARAMETERS tcFilename ;
, toEncoder AS xfcImageCodecInfo, toEncoderParams AS xfcEncoderParameters
LOCAL loExc
TRY
This.oBMP.Save(m.tcFilename, m.toEncoder, m.toEncoderParams)
CATCH TO m.loExc
THROW m.loExc
ENDTRY
ENDPROC
PROCEDURE setup
ENDPROC
PROTECTED PROCEDURE smoothingmode_assign
LPARAMETERS vNewVal
THIS.SmoothingMode = m.vNewVal
This.oGfx.SmoothingMode = m.vNewVal
ENDPROC
PROTECTED PROCEDURE textrenderinghint_assign
LPARAMETERS vNewVal
THIS.TextRenderingHint = m.vNewVal
This.oGfx.TextRenderingHint = m.vNewVal
ENDPROC
PROCEDURE UIEnable
*********************************************************************
** Method: ImgCanvas.UIEnable
**
** Occurs for all objects contained in a Page objects whenever the page is activated or deactivated
**
** History:
** 2007/12/23: CWollenhaupt - Coded - observations below
**
*********************************************************************
LPARAMETERS lEnable
*========================================================================================
* Using the form's Activate event only works for controls that reside on the form
* directly. It doesn't work for controls on a pageframe when the pageframe is anchored
* and resizes automatically. Controls on invisible pages aren't notified. Therefore we
* use the UIEnable event to redraw controls when the page becomes visible.
*========================================================================================
LOCAL lcNewSize
IF m.lEnable
m.lcNewSize = BINTOC(This.Width, "4rs") + BINTOC(This.Height, "4rs")
IF NOT This._cSize == m.lcNewSize
This.Draw()
ENDIF
ENDIF
ENDPROC
PROTECTED PROCEDURE width_access
** If we are hosted in a Grid, the width is invalid.
** We need to use the Column's width
IF This._InForm AND This.Parent.BaseClass = "Column"
RETURN This.Parent.Width
ENDIF
RETURN IIF(This._WidthOverride < 0, This.Width, This._WidthOverride)
ENDPROC
ENDDEFINE
DEFINE CLASS imgthemebase AS imgcanvas OF "gdiplusx.vcx"
*< CLASSDATA: Baseclass="image" Timestamp="" Scale="Pixels" Uniqueid="" />
*<DefinedPropArrayMethod>
*m: themestate_assign
*p: isxp
*p: themeclass
*p: themepart
*p: themestate
*</DefinedPropArrayMethod>
*<PropValue>
isxp = .F.
Name = "imgthemebase"
themeclass =
themepart = 0
themestate = 0
*</PropValue>
PROCEDURE beforedraw
IF NOT This.IsXP
RETURN
ENDIF
*!* Here's a super simple example
*!* There's more to this obviously, such as printing text on certain controls like Tabs or Buttons
*!* Anyways, I wanted to get most of the grunt work out of the way, now we can play
*!* Also, if you're wondering where I got all this stuff... I ripped and figured it out from a very impressive sample
*!* VB 6.0 application that Explores all of the stuff in uxtheme.dll
*!* http://www.vbaccelerator.com/home/vb/code/libraries/XP_Visual_Styles/Drawing_with_XP_Visual_Styles/article.asp
*!* I'd like us to make an example like what that guy did for this... only make it even better. :)
LOCAL System AS xfcSystem, lcThemeClass, ;
lnHDC, lnTheme, lqRectStruct
System = _SCREEN.System && NEWOBJECT("xfcSystem","System")
This.Clear()
WITH _SCREEN.System
m.lnTheme = OpenThemeData(0, This.ThemeClass) && Get ready to draw some theme stuff
IF m.lnTheme > 0
m.lnHDC = This.oGfx.GetHDC()
m.lqRectStruct = 0h00000000+0h00000000+BINTOC(This.Width,"4rs")+BINTOC(This.Height,"4rs")
hr=DrawThemeParentBackground(ThisForm.HWnd, m.lnHDC, @lqRectStruct)
** hr=DrawThemeBackground(lnTheme, lnHDC, EBP_NORMALGROUPCOLLAPSE, EBNGC_NORMAL, @lcRectStruct, @lcRectStruct)
hr=DrawThemeBackground(m.lnTheme, m.lnHDC, This.ThemePart, This.ThemeState, m.lqRectStruct, m.lqRectStruct)
This.oGfx.ReleaseHDC(m.lnHDC)
CloseThemeData(m.lnTheme)
ENDIF
ENDWITH
*!* One thing to keep in mind here is that we aren't anti-aliasing yet
*!* (VB 6.0 application didn't either) so the rendered controls look a little rough.
ENDPROC
PROCEDURE declaredll
DODEFAULT()
IF NOT This.IsXP
RETURN
ENDIF
TRY
imgThemeBaseDeclareDLL(0)
CATCH
DECLARE Long Sleep IN WIN32API AS imgThemeBaseDeclareDLL Long
*!* Here are the declares, as I haven't tested all of them there may be some that need adjusting
*!* most notably will be some of the ones that have a "LONG @" which may actually be STRING @ since
*!* they are looking for a structure
DECLARE LONG CloseThemeData IN UXTHEME LONG hTheme
DECLARE LONG DrawThemeBackground IN UXTHEME LONG hTheme, LONG hdc, LONG iPartId, LONG iStateId, STRING @pRect, STRING @pClipRect
DECLARE LONG DrawThemeBackgroundEx IN UXTHEME LONG hTheme, LONG hdc, LONG iPartId, LONG iStateId, LONG @pRect, STRING @poptions
DECLARE LONG DrawThemeEdge IN UXTHEME LONG hTheme, LONG hdc, LONG iPartId, LONG iStateId, LONG @pDestRect, uint egde, uint flags, LONG @pRect
DECLARE LONG DrawThemeIcon IN UXTHEME LONG hTheme, LONG hdc, LONG iPartId, LONG iStateId, LONG @pRect, LONG himl, LONG iImageIndex
DECLARE LONG DrawThemeParentBackground IN UXTHEME LONG hWnd, LONG hdc, STRING @pRect
DECLARE LONG DrawThemeText IN UXTHEME LONG hTheme, LONG hdc, LONG iPartId, LONG iStateId, STRING text, LONG textLength, LONG textFlags, LONG textFlags2, LONG @pRect
DECLARE LONG EnableThemeDialogTexture IN UXTHEME LONG hWnd, STRING flags
DECLARE LONG EnableTheming IN UXTHEME LONG fEnable
DECLARE LONG GetCurrentThemeName IN UXTHEME STRING stringThemeName, LONG lengthThemeName, STRING stringColorName, LONG lengthColorName, STRING stringSizeName, LONG lengthSizeName
DECLARE STRING GetThemeAppProperties IN UXTHEME
DECLARE LONG GetThemeBackgroundContentRect IN UXTHEME LONG hTheme, LONG hdc, LONG iPartId, LONG iStateId, LONG @pBoundingRect, LONG @pContentRect
DECLARE LONG GetThemeBackgroundExtent IN UXTHEME LONG hTheme, LONG hdc, LONG iPartId, LONG iStateId, LONG @pRect, LONG @pClipRect
DECLARE LONG GetThemeBackgroundRegion IN UXTHEME LONG hTheme, LONG hdc, LONG iPartId, LONG iStateId, LONG @pRect, LONG @pRegion
DECLARE LONG GetThemeBool IN UXTHEME LONG hTheme, LONG iPartId, LONG iStateId, LONG iPropId, LONG @pfVal
DECLARE LONG GetThemeColor IN UXTHEME LONG hTheme, LONG iPartId, LONG iStateId, LONG iPropId, LONG @pColor
DECLARE LONG GetThemeDocumentationProperty IN UXTHEME STRING stringThemeName, STRING stringPropertyName, STRING @stringValue, LONG lengthValue
DECLARE LONG GetThemeEnumValue IN UXTHEME LONG hTheme, LONG iPartId, LONG iStateId, LONG iPropId, LONG @piVal
DECLARE LONG GetThemeFilename IN UXTHEME LONG hTheme, LONG iPartId, LONG iStateId, LONG iPropId, STRING themeFileName, LONG themeFileNameLength
DECLARE LONG GetThemeFont IN UXTHEME LONG hTheme, LONG hdc, LONG iPartId, LONG iStateId, LONG iPropId, LONG @pFont
DECLARE LONG GetThemeInt IN UXTHEME LONG hTheme, LONG iPartId, LONG iStateId, LONG iPropId, LONG @piVal
DECLARE LONG GetThemeIntList IN UXTHEME LONG hTheme, LONG iPartId, LONG iStateId, LONG iPropId, LONG @pIntList
DECLARE LONG GetThemeMargins IN UXTHEME LONG hTheme, LONG hdc, LONG iPartId, LONG iStateId, LONG iPropId, LONG @pMargins
DECLARE LONG GetThemeMetric IN UXTHEME LONG hTheme, LONG hDC, LONG iPartId, LONG iStateId, LONG iPropId, LONG @piVal
DECLARE LONG GetThemePartSize IN UXTHEME INTEGER hTheme, INTEGER hdc, INTEGER iPartId, INTEGER iStateId, INTEGER @pRect, INTEGER eSize, STRING @SIZE
DECLARE LONG GetThemePosition IN UXTHEME LONG hTheme, LONG iPartId, LONG iStateId, LONG iPropId, LONG @pPoint
DECLARE LONG GetThemePropertyOrigin IN UXTHEME LONG hTheme, LONG iPartId, LONG iStateId, LONG iPropId, LONG @pOrigin
DECLARE LONG GetThemeRect IN UXTHEME LONG hTheme, LONG iPartId, LONG iStateId, LONG iPropId, LONG @pRect
DECLARE LONG GetThemeString IN UXTHEME LONG hTheme, LONG iPartId, LONG iStateId, LONG iPropId, STRING @themeString, LONG themeStringLength
DECLARE LONG GetThemeSysBool IN UXTHEME LONG hTheme, LONG iBoolId
DECLARE LONG GetThemeSysBrush IN UXTHEME LONG hTheme, LONG iColorId
DECLARE LONG GetThemeSysColor IN UXTHEME LONG hTheme, LONG iColorId
DECLARE LONG GetThemeSysFont IN UXTHEME LONG hTheme, LONG iFontId, LONG @plf
DECLARE LONG GetThemeSysInt IN UXTHEME LONG hTheme, LONG iIntId, LONG @piVal
DECLARE LONG GetThemeSysSize IN UXTHEME LONG hTheme, LONG iSizeId
DECLARE LONG GetThemeSysString IN UXTHEME LONG hTheme, LONG iStringId, STRING @stringSys, LONG stringSysLength
DECLARE LONG GetThemeTextExtent IN UXTHEME LONG hTheme, LONG hdc, LONG iPartId, LONG iStateId, STRING text, LONG textLength, LONG textFlags, LONG @boundingRect, STRING @extentRect
DECLARE LONG GetThemeTextMetrics IN UXTHEME LONG hTheme, LONG hdc, LONG iPartId, LONG iStateId, STRING @textMetric
DECLARE LONG GetWindowTheme IN UXTHEME LONG hWnd
DECLARE LONG HitTestThemeBackground IN UXTHEME LONG hTheme, LONG hdc, LONG iPartId, LONG iStateId, LONG dwOptions, LONG @pRect, LONG hrgn, POINT ptTest, STRING @code
DECLARE LONG IsAppThemed IN UXTHEME
DECLARE LONG IsThemeActive IN UXTHEME
DECLARE LONG IsThemeBackgroundPartiallyTransparent IN UXTHEME LONG hTheme, LONG iPartId, LONG iStateId
DECLARE LONG IsThemeDialogTextureEnabled IN UXTHEME LONG hWnd
DECLARE LONG IsThemePartDefined IN UXTHEME LONG hTheme, LONG iPartId, LONG iStateId
DECLARE LONG OpenThemeData IN UXTHEME LONG hWnd, STRING classList
DECLARE LONG SetSystemVisualStyle IN UXTHEME STRING pszFilename, STRING pszColor, STRING pszSize, LONG dwReserved
DECLARE SetThemeAppProperties IN UXTHEME STRING props
DECLARE LONG SetWindowTheme IN UXTHEME LONG hWnd, STRING textSubAppName, STRING textSubIdList
ENDTRY
ENDPROC
PROCEDURE Init
This.IsXP = FILE(GETENV("windir")+"\system32\uxtheme.dll")
This.DeclareDll()
DODEFAULT()
ENDPROC
PROCEDURE themestate_assign
LPARAMETERS vNewVal
THIS.themestate = m.vNewVal
This.Draw()
ENDPROC
ENDDEFINE
DEFINE CLASS imgthemebutton AS imgthemebase OF "gdiplusx.vcx"
*< CLASSDATA: Baseclass="image" Timestamp="" Scale="Pixels" Uniqueid="" />
*<PropValue>
Height = 29
Name = "imgthemebutton"
themeclass = (STRCONV("Button"+0h00,5))
themepart = 1
themestate = 1
Width = 114
*</PropValue>
PROCEDURE MouseDown
LPARAMETERS nButton, nShift, nXCoord, nYCoord
This.ThemeState = 3
ENDPROC
PROCEDURE MouseEnter
LPARAMETERS nButton, nShift, nXCoord, nYCoord
This.ThemeState = 2
ENDPROC
PROCEDURE MouseLeave
LPARAMETERS nButton, nShift, nXCoord, nYCoord
This.ThemeState = 1
ENDPROC
PROCEDURE MouseUp
LPARAMETERS nButton, nShift, nXCoord, nYCoord
This.ThemeState = 2
ENDPROC
ENDDEFINE
DEFINE CLASS imgthemeclock AS imgthemebase OF "gdiplusx.vcx"
*< CLASSDATA: Baseclass="image" Timestamp="" Scale="Pixels" Uniqueid="" />
*<PropValue>
Height = 94
Name = "imgthemeclock"
themeclass = (STRCONV("Clock"+0h00,5))
themepart = 1
themestate = 1
Width = 99
*</PropValue>
ENDDEFINE
DEFINE CLASS imgthemeprogressbar AS imgthemebase OF "gdiplusx.vcx"
*< CLASSDATA: Baseclass="image" Timestamp="" Scale="Pixels" Uniqueid="" />
*<PropValue>
Height = 20
Name = "imgthemeprogressbar"
themeclass = (STRCONV("Progress"+0h00,5))
themepart = 1
themestate = 1
Width = 207
*</PropValue>
ENDDEFINE
DEFINE CLASS imgthemetoolbarbutton AS imgthemebase OF "gdiplusx.vcx"
*< CLASSDATA: Baseclass="image" Timestamp="" Scale="Pixels" Uniqueid="" />
*<PropValue>
Height = 37
Name = "imgthemetoolbarbutton"
themeclass = (STRCONV("Toolbar"+0h00,5))
themepart = 1
themestate = 1
Width = 37
*</PropValue>
PROCEDURE MouseDown
LPARAMETERS nButton, nShift, nXCoord, nYCoord
This.ThemeState = 3
ENDPROC
PROCEDURE MouseEnter
LPARAMETERS nButton, nShift, nXCoord, nYCoord
This.ThemeState = 2
ENDPROC
PROCEDURE MouseLeave
LPARAMETERS nButton, nShift, nXCoord, nYCoord
This.ThemeState = 1
ENDPROC
PROCEDURE MouseUp
LPARAMETERS nButton, nShift, nXCoord, nYCoord
This.ThemeState = 2
ENDPROC
ENDDEFINE
Reference in New Issue View Git Blame Copy Permalink