apidevicecontext.cls

1500个WINDOWS API类全集,包括了主要的API调用接口

    HorizontalTextAlignment = TA_LEFT
End Select

End Property


Public Property Get LineCapability(ByVal Capability As enLineCapabilities) As Boolean

Dim lret As Long

lret = GetDeviceCaps(cLINECAPS)
LineCapability = (lret And Capability)

End Property

Public Property Let MappingMode(ByVal newMode As enMappingModes)

Static OldMappingMode As enMappingModes

If newMode <> OldMappingMode Then
    OldMappingMode = SetMapMode(mHDC, newMode)
End If

End Property

Public Property Get MappingMode() As enMappingModes

MappingMode = GetMapMode(mHDC)

End Property


Private Property Let mTextAlign(ByVal newAlign As Long)

    Call SetTextAlign(mHDC, newAlign)
    If Err.LastDllError > 0 Then
        ReportError Err.LastDllError, "ApiDeviceContext:SetTextAlign", GetLastSystemError
    End If
    
End Property

Private Property Get mTextAlign() As Long

mTextAlign = GetTextAlign(mHDC)
If Err.LastDllError > 0 Then
    ReportError Err.LastDllError, "ApiDeviceContext:GetTextAlign", GetLastSystemError
End If

End Property

Public Property Get Pens() As Collection

Dim colPens As Collection

Set colPens = GetDCPenCollection(mHDC)

If Err.LastDllError Then
    ReportError Err.LastDllError, "ApiDeviceContext:Pens", GetLastSystemError
End If

Set Pens = colPens

End Property

Public Property Get PixelAspectDiagonal() As Long

    PixelAspectDiagonal = GetDeviceCaps(cASPECTXY)

End Property

Public Property Get PixelAspectHeight() As Long

    PixelAspectHeight = GetDeviceCaps(cASPECTY)
    
End Property

Public Property Get PixelAspectWidth() As Long

    PixelAspectWidth = GetDeviceCaps(cASPECTX)
    
End Property

Public Property Get PixelsPerInch_Horizontal() As Long

PixelsPerInch_Horizontal = GetDeviceCaps(cLOGPIXELSX)

End Property
Public Property Get PixelsPerInch_Vertical() As Long

PixelsPerInch_Vertical = GetDeviceCaps(cLOGPIXELSY)

End Property



Public Property Get PolygonCapability(ByVal Capability As enPolygonCapabilities) As Boolean

Dim lret As Long

lret = GetDeviceCaps(cPOLYGONALCAPS)
PolygonCapability = (lret And Capability)

End Property

Public Property Get RasterCapability(ByVal Capability As enRasterCapabilities) As Boolean

Dim lret As Long

lret = GetDeviceCaps(cRASTERCAPS)
RasterCapability = (lret And Capability)


End Property

Public Property Set SelectedBrush(ByVal brushNew As ApiLogBrush)

Dim lret As Long

If brushNew Is Nothing Then
    If mInitialBrush Is Nothing Then
        '\\ Nothing has ever been selected to unselect
    Else
        lret = SelectObject(mHDC, mInitialBrush.Handle)
        If Err.LastDllError Then
            ReportError Err.LastDllError, "ApiDeviceContext:SelectedBrush (Set)", GetLastSystemError
        End If
    End If
Else
    lret = SelectObject(mHDC, brushNew.Handle)
    If Err.LastDllError Then
        ReportError Err.LastDllError, "ApiDeviceContext:SelectedBrush (Set)", GetLastSystemError
    End If
    '\\ Initial fon is not ours to unselect
    If mInitialBrush Is Nothing Then
        Set mInitialBrush = New ApiLogBrush
        mInitialBrush.Handle = lret
    End If
End If

End Property

Public Property Get SelectedBrush() As ApiLogBrush

    Dim lOldBrush As Long
    Dim lNewBrush As Long
    Dim lBrush As ApiLogBrush
    
    lOldBrush = SelectObject(mHDC, APIDispenser.System.GraphicalDeviceInterface.StockBrush(BLACK_BRUSH).Handle)
    lNewBrush = SelectObject(mHDC, lOldBrush)
    
    Set lBrush = New ApiLogBrush
    lBrush.Handle = lOldBrush
    
    Set SelectedBrush = lBrush
    
End Property

Public Property Get SelectedFont() As ApiLogFont

    Dim lOldFont As Long
    Dim lNewFont As Long
    Dim lFont As ApiLogFont
    
    lOldFont = SelectObject(mHDC, APIDispenser.System.GraphicalDeviceInterface.StockFont(ANSI_FIXED_FONT).Handle)
    lNewFont = SelectObject(mHDC, lOldFont)
    
    Set lFont = New ApiLogFont
    lFont.Handle = lOldFont
    
    Set SelectedFont = lFont
    
End Property


Public Property Set SelectedFont(ByVal fntNew As ApiLogFont)

Dim lret As Long

If fntNew Is Nothing Then
    If mInitialFont Is Nothing Then
        '\\ Nothing has ever been selected to unselect
    Else
        lret = SelectObject(mHDC, mInitialFont.Handle)
        If Err.LastDllError Then
            ReportError Err.LastDllError, "ApiDeviceContext:SelectedFont (Set)", GetLastSystemError
        End If
    End If
Else
    lret = SelectObject(mHDC, fntNew.Handle)
    If Err.LastDllError Then
        ReportError Err.LastDllError, "ApiDeviceContext:SelectedFont (Set)", GetLastSystemError
    End If
    '\\ Initial fon is not ours to unselect
    If mInitialFont Is Nothing Then
        Set mInitialFont = New ApiLogFont
        mInitialFont.Handle = lret
    End If
End If

End Property

Public Property Set SelectedPen(ByVal newpen As ApiLogPen)

Dim lret As Long

If newpen Is Nothing Then
    If mInitialPen Is Nothing Then
        '\\ Nothing has ever been selected to unselect
    Else
        lret = SelectObject(mHDC, mInitialPen.Handle)
        If Err.LastDllError Then
            ReportError Err.LastDllError, "ApiDeviceContext:SelectedPen (Set)", GetLastSystemError
        End If
    End If
Else
    lret = SelectObject(mHDC, newpen.Handle)
    If Err.LastDllError Then
        ReportError Err.LastDllError, "ApiDeviceContext:SelectedPen (Set)", GetLastSystemError
    End If
    '\\ Initial fon is not ours to unselect
    If mInitialPen Is Nothing Then
        Set mInitialPen = New ApiLogPen
        mInitialPen.Handle = lret
    End If
End If


End Property

Public Property Get SelectedPen() As ApiLogPen

    Dim lOldpen As Long
    Dim lNewpen As Long
    Dim lPen As ApiLogPen
    
    lOldpen = SelectObject(mHDC, APIDispenser.System.GraphicalDeviceInterface.StockPen(NULL_PEN).Handle)
    lNewpen = SelectObject(mHDC, lOldpen)
    
    Set lPen = New ApiLogPen
    lPen.Handle = lOldpen
    
    Set SelectedPen = lPen
    
End Property

Public Property Let StretchBltMode(ByVal smNew As StretchBltModes)

Call SetStretchBltMode(mHDC, smNew)
If Err.LastDllError > 0 Then
    ReportError Err.LastDllError, "ApiDeviceContext:StretchBltMode (Let)", GetLastSystemError
End If
'\\ Note that if the mode is halftone you should reset the brush origin...
If smNew = SBM_HALFTONE Then
    Dim ptThis As APIPoint
    Set ptThis = New APIPoint
    ptThis.x = 0
    ptThis.y = 0
    Set BrushOrigin = ptThis
End If

End Property

Public Property Get StretchBltMode() As StretchBltModes

    StretchBltMode = GetStretchBltMode(mHDC)
    If Err.LastDllError > 0 Then
        ReportError Err.LastDllError, "ApiDeviceContect:StretchBltMode (Get)", GetLastSystemError
    End If
    
End Property


Public Property Get TextCapability(ByVal Capability As enTextCapabilities) As Boolean

Dim lret As Long

lret = GetDeviceCaps(cTEXTCAPS)
TextCapability = (lret And Capability)

End Property

Public Property Set TextColour(ByVal newColour As ApiColour)

Call SetTextColor(mHDC, newColour.ColourRef)
If Err.LastDllError > 0 Then
    ReportError Err.LastDllError, "ApiDeviceContext:TextColour", GetLastSystemError
End If

End Property

Public Property Get TextColour() As ApiColour

Dim colourThis As ApiColour
Dim lcolourRef As Long

Set colourThis = New ApiColour
lcolourRef = GetTextColor(mHDC)
If Err.LastDllError > 0 Then
    ReportError Err.LastDllError, "ApiDeviceContext:TextColour", GetLastSystemError
End If
colourThis.ColourRef = lcolourRef
Set TextColour = colourThis

End Property

Public Sub TextOut(ByVal xPos As Long, ByVal yPos As Long, ByVal Text As String)

Dim lret As Long

lret = TextOutApi(mHDC, xPos, yPos, Text, Len(Text))
If Err.LastDllError Then
    ReportError Err.LastDllError, "ApiDeviceContext:TextOut", GetLastSystemError
End If

End Sub

Public Property Let UpdateTextCurrentPosition(ByVal bIn As Boolean)
 
 Dim lAlign As Long
 
 If bIn Then
    '\\ Add TA_UPDATECP to mTextAlign
    mTextAlign = mTextAlign Or TA_UPDATECP
 Else
    '\\ Remove TA_UPDATECP from mTextAlign
    mTextAlign = mTextAlign Xor TA_UPDATECP
 End If
 
End Property

Public Property Get UpdateTextCurrentPosition() As Boolean

Dim lAlign As Long

lAlign = mTextAlign
UpdateTextCurrentPosition = (lAlign And TA_UPDATECP)

End Property

Public Property Get VerticalTextAlignment() As VerticalTextAlignments

Dim lAlign As Long

lAlign = mTextAlign

Select Case True
Case lAlign And TA_BASELINE
    VerticalTextAlignment = TA_BASELINE
Case lAlign And TA_BOTTOM
    VerticalTextAlignment = TA_BOTTOM
Case Else
    VerticalTextAlignment = TA_TOP
End Select

End Property

Public Property Get Width(ByVal MeasurementScale As enDeviceMesaurementScale) As Long

If MeasurementScale = DMS_Millimeters Then
    Width = GetDeviceCaps(cHORZSIZE)
Else
    Width = GetDeviceCaps(cHORZRES)
End If

End Property