你想搞什么呢

我想把那个程序的启动界面设成VB6的启动界面

简单的东东

到网上搜索一下了，不要懒

我搜索了几天，就找到上面那个小的，根本没有大的，郁闷[em10]

那就运行VB6,截屏！

试过了，怎么也截不了屏，速度在快也不行啊，[em1]

自己截取吧，这是我设计用来截“红警”启动图的，直接输入代码就行了


Option Explicit

Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long



Dim Mc As Integer, xx As Single, yy As Single 'Mc 0:正常  1:开始截取  2、3:进行截取  4:完成截取
Dim WithEvents Timer1 As Timer, WithEvents Picture1 As PictureBox
Dim L As Long, T As Long, R As Long, B As Long



Private Sub ScrnCap(Left As Long, Top As Long, Right As Long, Bottom As Long)
    Dim rWidth As Long
    Dim rHeight As Long
    Dim SourceDC As Long
    Dim DestDC As Long
    Dim BHandle As Long
    Dim Wnd As Long
    Dim DHandle As Long
    rWidth = Right - Left
    rHeight = Bottom - Top
    SourceDC = CreateDC("DISPLAY", 0, 0, 0)
    DestDC = CreateCompatibleDC(SourceDC)
    BHandle = CreateCompatibleBitmap(SourceDC, rWidth, rHeight)
    SelectObject DestDC, BHandle
    BitBlt DestDC, 0, 0, rWidth, rHeight, SourceDC, Left, Top, &HCC0020
    Wnd = Screen.ActiveForm.hwnd
    OpenClipboard Wnd
    EmptyClipboard
    SetClipboardData 2, BHandle
    CloseClipboard
    DeleteDC DestDC
    ReleaseDC DHandle, SourceDC
End Sub



Private Sub Form_DblClick()
Dim Filepath As String
If Picture Then Filepath = App.Path & IIf(Right(App.Path, 1) = "\", "", "\") & "save.bmp": SavePicture Picture, Filepath: MsgBox "Save to " & Filepath
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer) 'Mc 0:正常  1:开始截取  2、3:进行截取  4:完成截取
    If KeyAscii <> 99 Then Exit Sub
    If Mc = 4 Then
        'Caption = ""
        'ControlBox = False
        ScrnCap (L + Left + 75) / 15, (T + Top + 360) / 15, (R + Left + 60) / 15, (B + Top + 345) / 15
        Set Me.Picture = Clipboard.GetData
        Mc = 0
        SetCap 0
        Exit Sub
    End If
    If Not (Mc = 1) Then Mc = 1: SetCap 1
End Sub

Sub SetCap(Ind As Integer)
Dim CapTmp As String
CapTmp = "按CTRL+W截取,双击窗体保存"
Select Case Ind
Case 0
CapTmp = CapTmp & "   按C键进行剪切         "
Case 1
CapTmp = CapTmp & "   请进行剪切            "
Case 2
CapTmp = CapTmp & "   再按C键确认           "
End Select
Caption = CapTmp & "Http://hi.baidu.com/kuangzu"
End Sub

Private Sub Form_Load()
Set Timer1 = Me.Controls.Add("vb.timer", "timer1")
'Set Picture1 = Me.Controls.Add("vb.picturebox", "Picture1")
'Picture1.Move 0, 0, Width, 300
Timer1.Enabled = True
Timer1.Interval = 100
SetCap 0
Me.Width = IIf(Width < 8060, 8060, Width)
Me.Height = IIf(Height < 5960, 5960, Height)
Me.AutoRedraw = True
Set Me.Picture = Nothing
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Mc And Button = 1 Then
'If Mc = 2 Then Mc = 3: Exit Sub
Mc = 2
Cls
If X < xx Then L = X: R = xx Else L = xx: R = X
If Y < yy Then T = Y: B = yy Else T = yy: B = Y
Line (X, Y)-(X, yy)
Line -(xx, yy)
Line -(xx, Y)
Line -(X, Y)

Else
'If Mc = 1 Then Mc = 0
If Mc = 2 Or Mc = 3 Then Mc = 4: SetCap 2
xx = X
yy = Y
End If
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Picture1.Visible = False
Picture1.Tag = "1"
End Sub

Private Sub Timer1_Timer()
If Timer1.Interval = 800 Then Timer1.Interval = 100: Exit Sub
If GetAsyncKeyState(vbKeyControl) And GetAsyncKeyState(vbKeyW) Then
Cls
Mc = 0
SetCap 0
ScrnCap 0, 0, Screen.Width / Screen.TwipsPerPixelX, Screen.Height / Screen.TwipsPerPixelY '280, 210, 740, 550
'Set Me.Picture = Nothing
Set Me.Picture = Clipboard.GetData
Timer1.Interval = 800
End If
End Sub





[img]http://blog.programfan.com/upfile/200809/20080913214613.jpg[/img]

谢谢哦，高手，我试试，
不错不错，厉害，截取到了，谢谢，谢谢[em1]