🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: cn.bbs.comp.program
Article #573

vb�������1

#573
From: ���δ�
Date: Mon, 22 Jun 1998 00:00
196 lines
7972 bytes
VB����С���ɣ�1�� 

                               ����λͼ�˵�

                                       ̷��

----��ͨ���ij����в˵��������ı��ķ�ʽ���ڣ���ʱ���Ե÷dz�������ζ�����
�ܹ��ڲ˵��м���λͼͼ�Σ����Ἣ��������û���ʹ����Ȥ�����Ľ��������ʹ
��λͼ�����˵�ѡ� 

����λͼ�˵�

----����λͼ�˵���ʵ�dz��򵥣�����Ҫ�õ�WindowsӦ�ó����̽ӿڣ�API����
һЩ�˵������λͼ��������Ҫ����Щ����������������Ӧ�ó���ı�׼ģ
���У������������μ�������򡣲������£� 

   1.ʹ�ú���GetSubMenu����ȡ�Ӳ˵���ľ��ͨ��ʹ�ú���
      CreateCompatibleDC������һ�����ݵ��豸���������? 
   2.��һ��ѭ�������ͨ��ʹ��CreateCompatibleBitmap����SelectObject����
      �Լ�BitBlt�������ֱ���Ը����˵����������λͼѡ�뵽�����豸����
      �У� 
   3.ͨ��ModifyMenu������������λͼ�˵�ѡ� 
   4.ʹ��DeleteDC�������ͷ��豸�������Ա�����ij������ʹ�����ǡ� 

----��ȡλͼ�����ж��ַ������ڱ�����������ڴ������������ĸ�ͼ�ο�ؼ���
ʹ����������4��Ԥ���ͼ������Ϊ�˵�ѡ��λͼ��Դ�ļ�����Ȼ��Ҳ����ʹ������
�ķ���������ʹ��LoadPicture�������Ӵ���װ��λͼ�� 

�������

   1.��Visual Basic�п�ʼһ���µĹ��̣�����ȱʡ�ķ�������Form1�� 
   2.����һ���µ�ģ�飬����ȱʡ�ķ�������Module1.Bas�� 
   3.�����µ��������ͳ�����ӵ�Module1.Basģ���У� 



      Option Explicit

      Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long

      Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, 

        ByVal nPos As Long) As Long

      Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long,

        ByVal nPos As Long) As Long

      Declare Function ModifyMenu Lib "user32" Alias "ModifyMenuA" 

       (ByVal hMenu As Long,ByVal nPosition As Long, ByVal wFlags As Long,

        ByVal wIDNewItem As Long, ByVal lpString As Any) As Long

      Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long

      Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

      Declare Function CreateCompatibleBitmap Lib "gdi32"

       (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long

      Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, 

       ByVal hObject As Long) As Long

      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

      Public Const SRCCOPY = &HCC0020

      Public Const MF_BYPOSITION = &H400&

      Public Const MF_BITMAP = &H4&



      ע����������������Ҫ��д��һ���ڡ� 
   4.��Form1�����4��ͼ�ο�ؼ��������ǵ�Name��������ΪPicture1�������ǵ�
      Index������������Ϊ0��1��2��3�������ǵ�AutoRedrew��������ΪTrue����
      ���ǵ�AutoResize��������ΪTure���Լ������ǵ�Visable��������ΪFalse��
   5.�������4��ͼ�ο�ؼ���Picture������������ΪFace1.ico��Face2.ico��
      Face3.ico��Face4.ico�� 
   6.��Form1����ӵ�һ���˵������ı�������Ϊ��[&F]�ļ������������Ϊ
      mnuFile�����������һ���Ӳ˵������ı�������Ϊ��[&E]�˳��������
      ����ΪmnuExit�� 
   7.��Form1����ӵڶ����˵������ı�������Ϊ��[&A]���ס����������Ϊ
      mnuFace�����������4���Ӳ˵���ֱ𽫸�4���Ӳ˵�����������Ϊ��[N]
      �����[&S]΢Ц������ [&L]��Ц�����Լ���[&O]���ˡ��������ǵ����
      ����Ϊ��mnuFaceSel��������Ӧ����4���Ӳ˵������������Ϊ0��1��2��3�� 
   8.�����µĴ�����ӵ�Form1��Form_Load�¼��У� 



      Private Sub Form_Load()

          Dim nLoopCtr As Integer

          Dim lResult As Long

          Dim hTempDC As Long

          Dim nWidth As Integer

          Dim nHeight As Integer

          Dim lTempID As Long

          Dim hMenuID As Long

          Dim lItemCount As Long

          Dim hBitmap As Long

          

          nWidth = Picture1(nLoopCtr).Width \ Screen.TwipsPerPixelX

          nHeight = Picture1(nLoopCtr).Height \ Screen.TwipsPerPixelY

          hMenuID = GetSubMenu(GetMenu((Me.hwnd)), 1)

          

          hTempDC = CreateCompatibleDC(Picture1(nLoopCtr).hdc)

          

          For nLoopCtr = 0 To 3

              hBitmap = CreateCompatibleBitmap(Picture1(nLoopCtr).hdc, nWidth,

                        nHeight)

              

              lTempID = SelectObject(hTempDC, hBitmap)

              

              lResult = BitBlt(hTempDC, 0, 0, nWidth, nHeight, (Picture1(nLoopCtr).

                        hdc), 0, 0, SRCCOPY)

              

              lTempID = SelectObject(hTempDC, lTempID)

              

              mnuFaceSel(nLoopCtr).Caption = ""

              

              lResult = ModifyMenu(hMenuID, nLoopCtr, MF_BYPOSITION Or MF_BITMAP,

                        GetMenuItemID(hMenuID, nLoopCtr), hBitmap)

              

          Next nLoopCtr

          

          lResult = DeleteDC(hTempDC)

      End Sub


   9.�����µĴ�����ӵ����˳����Ӳ˵��ĵ����¼��У� 



      Private Sub mnuExit_Click(Index As Integer)

          Select Case Index

              Case 0

                  Unload Me

          End Select

      End Sub



      ���и�������򣬵��������ס��˵�����ῴ����4������ͼ�����γɵ�λͼ
      �Ӳ˵����ͼ1��ʾ���������ļ���\���˳����˵����˳�Ӧ�ó��� 

--
�� ��Դ:��Yat-sen Channel argo.zsu.edu.cn��[FROM: 202.116.78.75]
Technical Details
Message-ID: <3PCW2B$tT3@argo.zsu.edu.cn>
Path: arc1-ca.pugleaf.net!unknown!not-for-mail

Show Full Headers
Complete Article Headers
X-Google-Language: Chinese,GB
X-Google-Thread: fc86e,d505ccb68994c3f8,start
X-Google-Attributes: gidfc86e,public
From: ox.bbs@argo.zsu.edu.cn (���δ�)
Subject: vb�������1
Date: 1998/06/22
Message-ID: <3PCW2B$tT3@argo.zsu.edu.cn>
X-Deja-AN: 365073799
X-Filename: Programming/M.898523243.A
Organization: Yat-sen Channel BBS
Newsgroups: cn.bbs.comp.program