🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

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

����λͼ�˵�

#1106
From: �ϵ�
Date: Sun, 19 Apr 1998 00:00
147 lines
7791 bytes
������: kkk (��), ����: Windows
��  ��: ����λͼ�˵�
����վ: '3m�Ͻ�ɺ�m' (Sun Mar 29 13:24:08 1998) , վ���ż�

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

����λͼ�˵�
    ����λͼ�˵���ʵ�dz��򵥣�����Ҫ�õ�Windows
Ӧ�ó����̽ӿڣ�API����һЩ�˵������λͼ����
������Ҫ����Щ����������������Ӧ�ó���ı�
׼ģ���У������������μ��������
    ������Ҫʹ�ú���GetSubMenu����ȡ�Ӳ˵����
���ͨ��ʹ�ú���CreateCompatibleDC������һ��
���ݵ��豸���������?Ȼ����һ��ѭ�������ͨ��ʹ
��CreateCompatibleBitmap����SelectObject������
��BitBlt�������ֱ���Ը����˵����������λͼѡ
�뵽�����豸�����У�Ȼ��ͨ��ModifyMenu���������
���λͼ�˵�ѡ���Ҫ�μǵ��ǣ������Ҫʹ��
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��ʾ������"�ļ�"\"
�˳�"�˵����˳�Ӧ�ó���


ͼ1

--
m;36m�� ��Դ:���Ͻ�ɺ� bbs.njupt.edu.cn��[FROM: 202.119.224.86]m

--
�� ��Դ:���ϴ�С�ٺ���Ϣ����վ bbs.nju.edu.cn��[FROM: a507yjh.nju.edu]
Technical Details
Message-ID: <3OAjQV$tb9@bbs.nju.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,9f8363949684aef4,start
X-Google-Attributes: gidfc86e,public
From: mendy.bbs@bbs.nju.edu.cn (�ϵ�)
Subject: ����λͼ�˵�
Date: 1998/04/19
Message-ID: <3OAjQV$tb9@bbs.nju.edu.cn>
X-Deja-AN: 345980900
X-Filename: Programming/M.893024767.A
Organization: nju_bbs
Newsgroups: cn.bbs.comp.program