funcoes.bas

来自「A good aplication to see some components」· BAS 代码 · 共 63 行

Attribute VB_Name = "mdlFuncoes"
Sub AbreBanco()

    mPath = App.Path
    If Mid(mPath, Len(mPath)) <> "\" Then
        mPath = mPath & "\"
    End If
    Set DBGP3 = OpenDatabase(mPath & "\data\gp3man.mdb", , 0)
    
End Sub
Sub CarregaCombo(mForm As Form)

    With mForm
        .cboPista.Clear
        .cboPista.AddItem "Melbourne"
        .cboPista.AddItem "Interlagos"
        .cboPista.AddItem "Buenos Aires"
        .cboPista.AddItem "Imola"
        .cboPista.AddItem "Barcelona"
        .cboPista.AddItem "Monaco"
        .cboPista.AddItem "Montreal"
        .cboPista.AddItem "Magny Cours"
        .cboPista.AddItem "Silverstone"
        .cboPista.AddItem "Zeltweg"
        .cboPista.AddItem "Hockenhein"
        .cboPista.AddItem "Nurburgring"
        .cboPista.AddItem "Spa-Francorchamps"
        .cboPista.AddItem "Monza"
        .cboPista.AddItem "Sepang"
        .cboPista.AddItem "Suzuka"
        .cboPista.ListIndex = 0
    End With
   
End Sub


Sub FadeForm(frm As Form, pRed As Integer, pGreen As Integer, pBlue As Integer)
    
    Dim SaveScale As Integer, SaveStyle As Integer, SaveDraw As Integer
    Dim y As Long, x As Long, i As Long, J As Long, pixels As Long
    'salvar as configura珲es atuais do form
    SaveScale = frm.ScaleMode
    SaveStyle = frm.DrawStyle
    SaveDraw = frm.AutoRedraw
    'pintar a tela
    frm.ScaleMode = 3
    pixels = Screen.Height / Screen.TwipsPerPixelY
    x = pixels / 64 + 0.5
    frm.DrawStyle = 5
    frm.AutoRedraw = True
    For J = 0 To pixels Step x + 2
        y = 240 - 245 * J / pixels
        If y < 0 Then y = 0
        frm.Line (-2, J - 2)-(Screen.Width + 2, J + x + 3), RGB(-pRed * y, -pGreen * y, -pBlue * y), BF
    Next J
    'restaura configura珲es do form
    frm.ScaleMode = SaveScale
    frm.DrawStyle = SaveStyle
    frm.AutoRedraw = SaveDraw

End Sub