谁知道啊?

解决方案 »

  1.   

    参考吧
    ·[名称]           制作垂直标题栏的窗体[语言种类]       Visual Basic[类别一]         窗体[类别二]         空[类别三]         空[数据来源]       未知[来源时间]       未知[保存时间]       2002-01-10[关键字一]       垂直[关键字二]       窗体[关键字三]       标题栏[文件列表]       空[内容简介]       空[心得体会]       空[源代码内容]源代码如下:
    Module1Option Explicit 
    Public Const GWL_WNDPROC = (-4)Public Const WM_LBUTTONDOWN = &H201
    Public Const WM_NCHITTEST = &H84
    Public Const WM_NCLBUTTONDOWN = &HA1
    Public Const HTCLIENT = 1
    Public Const HTCAPTION = 2Public Const LF_FACESIZE = 32
    Public Const DEFAULT_CHARSET = 1
    Public Const DT_CALCRECT = &H400Type LOGFONT
    lfHeight As Long
    lfWidth As Long
    lfEscapement As Long
    lfOrientation As Long
    lfWeight As Long
    lfItalic As Byte
    lfUnderline As Byte
    lfStrikeOut As Byte
    lfCharSet As Byte
    lfOutPrecision As Byte
    lfClipPrecision As Byte
    lfQuality As Byte
    lfPitchAndFamily As Byte
    lfFaceName(0 To LF_FACESIZE - 1) As Byte
    End TypeDeclare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
    Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
    Declare Sub RtlMoveMemory Lib "KERNEL32" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
    Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hDC As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As LongType RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
    End TypeDeclare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
    Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As LongDeclare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
    Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongPublic prevWndProc As LongFunction WndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If Msg = WM_LBUTTONDOWN Then
    SendMessage Form1.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, ByVal 0&
    Else
    WndProc = CallWindowProc(prevWndProc, hwnd, Msg, wParam, lParam)
    End If
    End FunctionForm1 Private Sub Form_Load()
    prevWndProc = GetWindowLong(Me.hwnd, GWL_WNDPROC)
    SetWindowLong Picture1.hwnd, GWL_WNDPROC, AddressOf WndProc
    End SubPrivate Sub Form_Unload(Cancel As Integer)
    SetWindowLong Picture1.hwnd, GWL_WNDPROC, prevWndProc
    End SubPrivate Sub Picture1_Paint()
    Dim font As LOGFONT, hOldFont As Long, hFont As Long
    Dim w As Integer, h As Integer, r As RECTWith Picture1RtlMoveMemory font.lfFaceName(0), _
    ByVal CStr(.font.Name), _
    LenB(StrConv(.font.Name, vbFromUnicode)) + 1
    font.lfHeight = (.font.Size * -20) / Screen.TwipsPerPixelY
    font.lfEscapement = 2700
    font.lfWeight = IIf(.font.Bold, 700, 400)
    font.lfItalic = .font.Italic
    font.lfUnderline = .font.Underline
    font.lfStrikeOut = .font.Strikethrough
    font.lfCharSet = DEFAULT_CHARSET
    hFont = CreateFontIndirect(font)
    hOldFont = SelectObject(.hDC, hFont)r.Left = 0: r.Top = 0
    DrawText Me.hDC, .Tag, LenB(StrConv(.Tag, vbFromUnicode)), r, DT_CALCRECT
    w = r.Right
    h = r.Bottom.Cls.CurrentX = .ScaleWidth - h / 2
    .CurrentY = cmdClose.Height + 15
    Picture1.Print .TagSelectObject .hDC, hOldFont
    DeleteObject hFont
    End With
    End Sub
         以上代码保存于: SourceCode Explorer(源代码数据库)
               复制时间: 2005-09-12 12:58:03
               软件版本: 1.0.880
               软件作者: Shawls
                 E-Mail: [email protected]
                     QQ: 9181729
      

  2.   

    [名称]           闪烁的标题栏[语言种类]       Visual Basic[类别一]         动画/图像[类别二]         空[类别三]         空[数据来源]       未知[来源时间]       未知[保存时间]       2002-01-05[关键字一]       API[关键字二]       标题栏[关键字三]       闪烁[文件列表]       空[内容简介]       空[心得体会]       空[源代码内容]本例通过调用API函数 FlashWindow 实现了窗体标题栏的闪烁,标题栏的闪烁通常用来引起使用者的注意。   在VB中声明这个API函数的方法是:    Private Declare Function FlashWindow Lib "user32" (ByVal hwnd As Long, 
       ByVal bInvert As Long) As Long    其中各个参数的意义如下表所示: 参数 意义hwnd Long,要闪烁显示的窗口的句柄 
    bInvert Long,TRUE(非零)表示切换窗口标题;FALSE返回最初状态 
    返回值 Long,如窗口在调用前处于活动状态,则返回TRUE(非零)   为了使窗体出现闪烁的效果,我们在Timer控件的Timer属性中调用FlashWindow函数即可,使用的方法如下:   Call FlashWindow(Me.hwnd, True)    其中Me.hwnd是当前窗体的句柄,而把bInvert设为True则表示进入标题栏闪烁状态。   而停止闪烁的方法只要把bInvert设为False就行了,如下所示:
      Call FlashWindow(Me.hwnd, False)   好了,非常简单,试试把它用到你的程序中去吧。  为了学习方便,以下提供了源代码并附详细的中文注释: -------------------------------------------
    一个窗体标题闪烁的例子
    -------------------------------------------
    程序说明:
    本例通过调用API函数 FlashWindow 实现了窗体标题栏的闪烁,标题栏的闪烁
    通常用来引起用户的注意。
    -------------------------------------------
    【VB声明】 Private Declare Function FlashWindow Lib "user32" (ByVal hwnd As Long, ByVal bInvert As Long) As Long 【说明】
    闪烁显示指定窗口。这意味着窗口的标题和说明文字会发生变化,似乎从活动切换到非活动状态、或反向切换。通常对不活动的窗口应用这个函数,引起用户的注意 【返回值】
    Long,如窗口在调用前处于活动状态,则返回TRUE(非零) 
    【备注】
    该函数通常与一个计数器组合使用,生成连续的闪烁效果。在windows
    nt及windows for workgroup中,bInvert参数会被忽略。但在windows 95中不会忽略 【参数表】
    hwnd ----------- Long,要闪烁显示的窗口的句柄 bInvert -------- Long,TRUE(非零)表示切换窗口标题;FALSE返回最初状态 Private Declare Function FlashWindow Lib "user32" ( _
    ByVal hwnd As Long, ByVal bInvert As Long) As Long  用来标示当前是否处于闪烁状态,取值True/False Dim OnFlash As Boolean Private Sub Command1_Click()  如果没有闪烁,开始闪烁 If OnFlash = False Then
    Command1.Caption = "停止闪烁"
    Timer1.Enabled = True
    OnFlash = True  否则,停止闪烁 Else
    Timer1.Enabled = False
    Command1.Caption = "窗体标题栏闪烁" 这一语句是必须的,不然停止闪烁时标题栏可能会处于灰暗状态Call FlashWindow(Me.hwnd, False)
    OnFlash = False
    End If
    End Sub  以一定时间间隔闪烁,可以通过改变Timer1控件的Interval属性的值来改变 Private Sub Timer1_Timer() 调用 FlashWindow函数,Me.hwnd是Form1窗体的句柄Call FlashWindow(Me.hwnd, True)
    End Sub
         以上代码保存于: SourceCode Explorer(源代码数据库)
               复制时间: 2005-09-12 12:58:25
               软件版本: 1.0.880
               软件作者: Shawls
                 E-Mail: [email protected]
                     QQ: 9181729