Mastering Visual Basic 5/MasteringVisualBasic5.iso/olympus/ik32_15t/vb4.shr/draw.Bas

BASIC Source File | 1996-07-23 | 5.5 KB | 262 lines

Attribute VB_Name = "Module2"
Public g_Lines(10) As Long
Public g_nDrawLimit As Long
Function ChkXBounds(v As Long) As Integer

    If (v < 0 Or v >= g_nDrawLimit) Then
        ChkXBounds = 0
    Else
        ChkXBounds = 1
    End If
    Exit Function

End Function

Function ChkYBounds(v As Long) As Integer

    If (v < 0 Or v >= g_nDrawLimit) Then
        ChkYBounds = 0
    Else
        ChkYBounds = 1
    End If
    Exit Function

End Function

Sub SetDrawArrows()

    frmPicbuf!picbuf1.DrawArrows = Draw!cmbDA.ListIndex

End Sub

Sub SetDrawStyle()

    frmPicbuf!picbuf1.DrawStyle = Draw!cmbDS.ListIndex

End Sub


Sub SetDrawWidth()

    frmPicbuf!picbuf1.DrawWidth = CInt(Draw!txtDW.Text)

End Sub

Sub SetFillStyle()

    frmPicbuf!picbuf1.FillStyle = Draw!cmbFS.ListIndex

End Sub

Sub SetFillTransparent()

    If Draw!chkFT = 1 Then
        frmPicbuf!picbuf1.FillTransparent = 1
    Else
        frmPicbuf!picbuf1.FillTransparent = 0
    End If

End Sub


Function SetLines() As Integer

    Dim X As Long
    Dim Y As Long

    ' point 1
    X = CInt(Draw!txtLX1.Text)
    Y = CInt(Draw!txtLY1.Text)
    If (ChkXBounds(X) = 0 Or ChkYBounds(Y) = 0) Then
        SetLines = 0
        Exit Function
    End If
    g_Lines(1) = X
    g_Lines(2) = Y

    ' point 2
    X = CInt(Draw!txtLX2.Text)
    Y = CInt(Draw!txtLY2.Text)
    If (ChkXBounds(X) = 0 Or ChkYBounds(Y) = 0) Then
        SetLines = 1
        Exit Function
    End If
    g_Lines(3) = X
    g_Lines(4) = Y

    ' point 3
    X = CInt(Draw!txtLX3.Text)
    Y = CInt(Draw!txtLY3.Text)
    If (ChkXBounds(X) = 0 Or ChkYBounds(Y) = 0) Then
        SetLines = 2
        Exit Function
    End If
    g_Lines(5) = X
    g_Lines(6) = Y

    ' point 4
    X = CInt(Draw!txtLX4.Text)
    Y = CInt(Draw!txtLY4.Text)
    If (ChkXBounds(X) = 0 Or ChkYBounds(Y) = 0) Then
        SetLines = 3
        Exit Function
    End If
    g_Lines(7) = X
    g_Lines(8) = Y

    ' point 5
    X = CInt(Draw!txtLX5.Text)
    Y = CInt(Draw!txtLY5.Text)
    If (ChkXBounds(X) = 0 Or ChkYBounds(Y) = 0) Then
        SetLines = 4
        Exit Function
    End If
    g_Lines(9) = X
    g_Lines(10) = Y

    SetLines = 5
    Exit Function

End Function


Sub SetImageAttributes()

    Draw!txtCD.Text = frmPicbuf!picbuf1.ColorDepth
    Draw!txtIS.Text = frmPicbuf!picbuf1.Xresolution & "," & frmPicbuf!picbuf1.Yresolution
    Exit Sub

End Sub

Sub SetForeColorTextBoxes()

    Draw!txtFCRed.Text = Str$(getRed(frmPicbuf!picbuf1.ForeColor))
    Draw!txtFCGreen.Text = Str$(getGreen(frmPicbuf!picbuf1.ForeColor))
    Draw!txtFCBlue.Text = Str$(GetBlue(frmPicbuf!picbuf1.ForeColor))

    Exit Sub

End Sub

Sub SetForeColorPicbuf()

    Dim color As Long
    color = RGB(CInt(Draw!txtFCRed.Text), CInt(Draw!txtFCGreen.Text), CInt(Draw!txtFCBlue.Text))
    Draw!frmPicbuf.picbuf1.ForeColor = color

    Exit Sub

End Sub


Sub SetBackColorTextBoxes()

    Draw!txtBCRed.Text = Str$(getRed(frmPicbuf!picbuf1.BackColor))
    Draw!txtBCGreen.Text = Str$(getGreen(frmPicbuf!picbuf1.BackColor))
    Draw!txtBCBlue.Text = Str$(GetBlue(frmPicbuf!picbuf1.BackColor))
    Exit Sub

End Sub

Sub SetFillColorTextBoxes()

    Draw!txtFillCRed.Text = Str$(getRed(frmPicbuf!picbuf1.FillColor))
    Draw!txtFillCGreen.Text = Str$(getGreen(frmPicbuf!picbuf1.FillColor))
    Draw!txtFillCBlue.Text = Str$(GetBlue(frmPicbuf!picbuf1.FillColor))

    Exit Sub

End Sub


Sub SetBackColorPicbuf()

    Dim color As Long
    color = RGB(CInt(Draw!txtBCRed.Text), CInt(Draw!txtBCGreen.Text), CInt(Draw!txtBCBlue.Text))
    Draw!frmPicbuf.picbuf1.BackColor = color
    Exit Sub

End Sub




Function GetDestination() As Integer

    If Draw!optDIB.value = True Then
        GetDestination = 0
    Else
        GetDestination = 1
    End If

End Function
Sub SetText()

    ' font bold
    If Draw!chkFontBold.value = 1 Then
        frmPicbuf!picbuf1.Font.Bold = True
    Else
        frmPicbuf!picbuf1.Font.Bold = False
    End If

    ' font italic
    If Draw!chkFontItalic.value = 1 Then
        frmPicbuf!picbuf1.Font.Bold = True
    Else
        frmPicbuf!picbuf1.Font.Bold = False
    End If

    ' font strikethrough
    If Draw!chkFontStrikethru.value = 1 Then
        frmPicbuf!picbuf1.Font.Strikethrough = True
    Else
        frmPicbuf!picbuf1.Font.Strikethrough = False
    End If

    ' font underline
    If Draw!chkFontUnderline.value = 1 Then
        frmPicbuf!picbuf1.Font.Strikethrough = True
    Else
        frmPicbuf!picbuf1.Font.Strikethrough = False
    End If

    ' Alignment
    frmPicbuf!picbuf1.TextAlignment = Draw!cmbTA.ListIndex

    ' AutoSize
    If Draw!chkTA = 1 Then
        frmPicbuf!picbuf1.TextAutoSize = 1
    Else
        frmPicbuf!picbuf1.TextAutoSize = 0
    End If

    ' Ext Leading
    If Draw!chkTEL = 1 Then
        frmPicbuf!picbuf1.TextExtLeading = 1
    Else
        frmPicbuf!picbuf1.TextExtLeading = 0
    End If

    ' MultiLine
    If Draw!chkTML = 1 Then
        frmPicbuf!picbuf1.TextMultiLine = 1
    Else
        frmPicbuf!picbuf1.TextMultiLine = 0
    End If

    ' get the text
    frmPicbuf!picbuf1.Text = Draw!txtText.Text

End Sub

Sub SetupDrawing()
    Draw.SetSelection
    SetDrawWidth
    SetDrawStyle
    SetDrawArrows
    SetFillStyle
    SetFillTransparent
End Sub