home *** CD-ROM | disk | FTP | other *** search
Visual Basic class definition | 1999-04-24 | 7.3 KB | 281 lines |
- VERSION 1.0 CLASS
- BEGIN
- MultiUse = -1 'True
- Persistable = 0 'NotPersistable
- DataBindingBehavior = 0 'vbNone
- DataSourceBehavior = 0 'vbNone
- MTSTransactionMode = 0 'NotAnMTSObject
- END
- Attribute VB_Name = "StretchSysCls"
- Attribute VB_GlobalNameSpace = True
- Attribute VB_Creatable = True
- Attribute VB_PredeclaredId = False
- Attribute VB_Exposed = True
- Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
- Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
- 'local variable(s) to hold property value(s)
- Private mvarhDC As Long 'local copy
- Private mvarBMP As Long
- Private mvarIsEmpty As Boolean 'local copy
- Private OldBMP As Long
- Private mvarTransparency As Boolean 'local copy
- Private ScreenWidth As Integer
- Private ScreenHeight As Integer
- Private ScreenX As Integer
- Private ScreenY As Integer
- 'local variable(s) to hold property value(s)
- Private mvarMaskBMP As Long 'local copy
- Private mvarMaskhDC As Long 'local copy
- Public TargetDC As Long
- 'local variable(s) to hold property value(s)
- Private mvarPicWidth As Integer 'local copy
- Private mvarPicHeight As Integer 'local copy
- Public NoAutoRedraw As Boolean
-
- Public Function CopyMask(ByVal X As Integer, ByVal y As Integer, ByVal H As Integer, ByVal W As Integer) As Boolean
- CP = BltSysMod.CopyPicture(mvarMaskhDC, X, y, H, W)
- End Function
-
- Public Function PasteMaskPicture(Optional ByVal X As Integer = 0, Optional ByVal y As Integer = 0) As Boolean
- OldBMP = SelectObject(mvarMaskhDC, mvarMaskBMP)
- ret% = BltSysMod.PastePicture(mvarMaskhDC, 0, 0)
- OldBMP = SelectObject(mvarMaskhDC, OldBMP)
- ScreenWidth = ClpBoard.Width
- ScreenHeight = ClpBoard.Height
- End Function
- Public Property Get PicHeight() As Integer
- 'used when retrieving value of a property, on the right side of an assignment.
- 'Syntax: Debug.Print X.PicHeight
- PicHeight = mvarPicHeight
- End Property
-
-
-
- Public Property Get PicWidth() As Integer
- 'used when retrieving value of a property, on the right side of an assignment.
- 'Syntax: Debug.Print X.PicWidth
- PicWidth = mvarPicWidth
- End Property
-
-
-
- Public Property Get ScrY() As Integer
- ScrY = ScreenY
- End Property
-
- Public Property Get MaskhDC() As Long
- 'used when retrieving value of a property, on the right side of an assignment.
- 'Syntax: Debug.Print X.MaskhDC
- MaskhDC = mvarMaskhDC
- End Property
-
-
-
- Public Property Get MaskBMP() As Long
- 'used when retrieving value of a property, on the right side of an assignment.
- 'Syntax: Debug.Print X.MaskBMP
- MaskBMP = mvarMaskBMP
- End Property
-
-
-
-
-
-
-
- Public Sub Redraw()
- Dim FrmDC As Long
- If mvarTransparency = False Then
- OldBMP = SelectObject(mvarhDC, mvarBMP)
- FrmDC = TargetDC
- ret% = StretchBlt(FrmDC, ScreenX, ScreenY, ScreenWidth, ScreenHeight, mvarhDC, 0, 0, mvarPicWidth, mvarPicHeight, SRCCOPY)
- OldBMP = SelectObject(mvarhDC, OldBMP)
- Else
- FrmDC = TargetDC
- OldBMP = SelectObject(mvarMaskhDC, mvarMaskBMP)
- ret% = StretchBlt(FrmDC, ScreenX, ScreenY, ScreenWidth, ScreenHeight, mvarMaskhDC, 0, 0, mvarPicWidth, mvarPicHeight, SRCAND)
- OldBMP2 = SelectObject(mvarhDC, mvarBMP)
- ret% = StretchBlt(FrmDC, ScreenX, ScreenY, ScreenWidth, ScreenHeight, mvarhDC, 0, 0, mvarPicWidth, mvarPicHeight, SRCPAINT)
- OldBMP = SelectObject(mvarhDC, OldBMP)
-
- End If
- End Sub
-
- Public Function PastePicture(Optional ByVal X As Integer = 0, Optional ByVal y As Integer = 0) As Boolean
- OldBMP = SelectObject(mvarhDC, mvarBMP)
- ret% = BltSysMod.PastePicture(mvarhDC, 0, 0)
- OldBMP = SelectObject(mvarhDC, OldBMP)
- ScreenWidth = ClpBoard.Width
- ScreenHeight = ClpBoard.Height
- mvarPicWidth = ScreenWidth
- mvarPicHeight = ScreenHeight
- End Function
-
- Public Function CopyPicture(ByVal X As Integer, ByVal y As Integer, ByVal H As Integer, ByVal W As Integer) As Boolean
- CopyPicture = BltSysMod.CopyPicture(mvarhDC, X, y, H, W)
- End Function
-
- Public Function Create(Hwnd As Long, DC As Long, W As Long, H As Long) As Boolean
- mvarhDC = CreateCompatibleDC(GetDC(Hwnd))
- mvarBMP = CreateCompatibleBitmap(GetDC(Hwnd), W, H)
- mvarMaskhDC = CreateCompatibleDC(GetDC(Hwnd))
- mvarMaskBMP = CreateCompatibleBitmap(GetDC(Hwnd), W, H)
- TargetDC = DC
- End Function
-
- Public Sub LoadMask(filename As String)
- Dim W As Integer, H As Integer
- DirectLoad filename, mvarMaskhDC, mvarMaskBMP, W, H
- If NoAutoRedraw = False Then
- Redraw
- End If
- End Sub
-
- Public Sub LoadPicture(filename As String)
- DirectLoad filename, mvarhDC, mvarBMP, mvarPicWidth, mvarPicHeight
- If NoAutoRedraw = False Then
- Redraw
- End If
- End Sub
-
-
- Public Property Let ScrX(vData As Integer)
- ScreenX = vData
- If NoAutoRedraw = False Then
- Redraw
- End If
- End Property
-
- Public Property Let ScrWidth(vData As Integer)
- ScreenWidth = vData
- If NoAutoRedraw = False Then
- Redraw
- End If
- End Property
- Public Property Let ScrHeight(vData As Integer)
- ScreenHeight = vData
- If NoAutoRedraw = False Then
- Redraw
- End If
- End Property
-
-
-
-
-
- Public Property Get ScrX() As Integer
- ScrX = ScreenX
- End Property
-
-
-
- Public Property Let ScrY(vData As Integer)
- ScreenY = vData
- If NoAutoRedraw = False Then
- Redraw
- End If
- End Property
-
-
- Public Property Get ScrHeight() As Integer
- ScrHeight = ScreenHeight
- End Property
-
- Public Property Get ScrWidth() As Integer
- ScrWidth = ScreenWidth
- End Property
-
-
-
- Public Sub SetPixel(X As Integer, y As Integer, RGBVal As Long)
- OldBMP = SelectObject(mvarhDC, mvarBMP)
- ret% = SystemSupport.SetPixel(mvarhDC, X, y, RGBVal)
- OldBMP = SelectObject(mvarhDC, OldBMP)
- End Sub
-
- Public Function ReadPixel(X As Integer, y As Integer) As Long
- OldBMP = SelectObject(mvarhDC, mvarBMP)
- ReadPixel = GetPixel(mvarhDC, X, y)
- OldBMP = SelectObject(mvarhDC, OldBMP)
- End Function
-
-
- Public Property Let Transparency(ByVal vData As Boolean)
- 'used when assigning a value to the property, on the left side of an assignment.
- 'Syntax: X.Transparency = 5
- mvarTransparency = vData
- End Property
-
-
-
- Public Property Get BMP() As Long
- 'used when retrieving value of a property, on the right side of an assignment.
- 'Syntax: Debug.Print X.BMP
- BMP = mvarBMP
- End Property
-
- Public Property Get Transparency() As Boolean
- 'used when retrieving value of a property, on the right side of an assignment.
- 'Syntax: Debug.Print X.Transparency
-
- Transparency = mvarTransparency
-
- End Property
-
-
-
- Public Property Let Layer(ByVal vData As Variant)
- 'used when assigning a value to the property, on the left side of an assignment.
- 'Syntax: X.Layer = 5
- mvarLayer = vData
- End Property
-
-
- Public Property Get Layer() As Variant
- 'used when retrieving value of a property, on the right side of an assignment.
- 'Syntax: Debug.Print X.Layer
- If IsObject(mvarLayer) Then
- Set Layer = mvarLayer
- Else
- Layer = mvarLayer
- End If
- End Property
-
-
-
- Public Property Get IsEmpty() As Boolean
- 'used when retrieving value of a property, on the right side of an assignment.
- 'Syntax: Debug.Print X.IsEmpty
- IsEmpty = mvarIsEmpty
- End Property
-
-
-
- Public Property Get hdc() As Long
- 'used when retrieving value of a property, on the right side of an assignment.
- 'Syntax: Debug.Print X.hDC
- hdc = mvarhDC
- End Property
-
-
-
- Private Sub Class_InitProperties()
-
- End Sub
-
-
- Private Sub Class_ReadProperties(PropBag As PropertyBag)
-
- End Sub
-
-
-
- Public Sub DestroyPicture()
- ret% = DeleteDC(mvarhDC)
- ret% = DeleteObject(mvarBMP)
- ret% = DeleteDC(mvarMaskhDC)
- re% = DeleteObject(mvarMaskBMP)
- End Sub
-
-
-