アイコンを描画          <TOP>


DrawIcon アイコンを描画
DrawIconEx アイコンを描画
Sleep カレントスレッドの実行を指定の時間だけ中断
LoadImage 画像ファイルの読み込み
DestroyCursor カーソルを破棄する
SendMessage ウィンドウにメッセージを送信
CreateWindowEx ウィンドウ(コントロール)を作成
DestroyWindow CreateWindowExの解放
GetDC 指定されたウィンドウのデバイスコンテキストのハンドルを取得
ReleaseDC デバイスコンテキストを解放
 

 

'================================================================
'= アイコンを描画
'=    (DrawIcon2.bas)
'================================================================
#include "Windows.bi"

' アイコンを描画
Declare Function Api_DrawIcon& Lib "user32" Alias "DrawIcon" (ByVal hDC&, ByVal x&, ByVal y&, ByVal exhIcon&)

' アイコンを描画
Declare Function Api_DrawIconEx& Lib "user32" Alias "DrawIconEx" (ByVal hDC&, ByVal xLeft&, ByVal yTop&, ByVal hIcon&, ByVal cxWidth&, ByVal cyWidth&, ByVal istepIfAniCur&, ByVal hbrFlickerFreeDraw&, ByVal diFlags&)

' カレントスレッドの実行を指定の時間だけ中断
Declare Sub Api_Sleep Lib "Kernel32" Alias "Sleep" (ByVal dwMilliseconds&)

' 画像ファイルの読み込み
Declare Function Api_LoadImage& Lib "user32" Alias "LoadImageA" (ByVal hInst&, ByVal lpszName&, ByVal uType&, ByVal cxDesired&, ByVal cyDesired&, ByVal fuLoad&)

' カーソルを破棄する
Declare Function Api_DestroyCursor& Lib "user32" Alias "DestroyCursor" (ByVal hCursor&)

' ウィンドウにメッセージを送信
Declare Function Api_SendMessage& Lib "user32" Alias "SendMessageA" (ByVal hWnd&, ByVal wMsg&, ByVal wParam&, ByVal lParam&)

' ウィンドウ(コントロール)を作成
Declare Function Api_CreateWindowEx& Lib "user32" Alias "CreateWindowExA" (ByVal ExStyle&, ByVal ClassName$, ByVal WinName&, ByVal Style&, ByVal x&, ByVal y&, ByVal nWidth&, ByVal nHeight&, ByVal hParent&, ByVal hMenu&, ByVal hInstance&, lpParam As Any)

' CreateWindowExの解放
Declare Function Api_DestroyWindow& Lib "user32" Alias "DestroyWindow" (ByVal hWnd&)

' 指定されたウィンドウのデバイスコンテキストのハンドルを取得
Declare Function Api_GetDC& Lib "user32" Alias "GetDC" (ByVal hWnd&)

' デバイスコンテキストを解放
Declare Function Api_ReleaseDC& Lib "user32" Alias "ReleaseDC" (ByVal hWnd&, ByVal hDC&)

#define DI_DEFAULTSIZE 8                'widthとheightが0である場合、アイコン(マウスカーソル)をデフォルトのサイズで描画
#define DI_NORMAL 3                     'DI_IMAGEとDI_MASKの組み合わせ
#define IMAGE_CURSOR 2                  'カーソル
#define LR_DEFAULTSIZE &H40             '標準サイズで表示
#define LR_SHARED &H8000                'イメージハンドルを固定する
#define OCR_APPSTARTING 32650           '標準の矢印カーソルと小さい砂時計カーソル
#define OCR_NORMAL 32512                'Windows組込ビットマップ
#define SS_ICON &H3                     'アイコンを表示するスタティックコントロールを作成
#define STM_SETIMAGE &H172              'ピクチャーコントロールのビットマップを変更
#define WS_CHILD &H40000000             '親ウィンドウを持つコントロール(子ウィンドウ)を作成する
#define WS_VISIBLE &H10000000           '可視状態のウィンドウを作成する

Var Shared Picture1 As Object
Var Shared Picture2 As Object
Var Shared Button1 As Object

Picture1.Attach GetDlgItem("Picture1")
Picture2.Attach GetDlgItem("Picture2")
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14

Var Shared hWndCur As Long
Var Shared hCur As Long
Var Shared hDC As Long

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    Var Ret As Long

    hDC = Api_GetDC(Picture1.GethWnd)

    hCur = Api_LoadImage(ByVal 0, OCR_APPSTARTING, IMAGE_CURSOR, 0, 0, LR_SHARED Or LR_DEFAULTSIZE)

    SetWindowText "Cursor Handle : &H" & Hex$(hCur)
    
    hWndCur = Api_CreateWindowEx(0, "Static", ByVal 0, WS_CHILD Or WS_VISIBLE Or SS_ICON, 0, 0, 32, 32, Picture2.GethWnd, ByVal 0, GethInst, ByVal 0)

    Ret = Api_SendMessage(hWndCur, STM_SETIMAGE, IMAGE_CURSOR, hCur)
End Sub

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var i As Long
    Var Ret As Long
    
    i = 0
    While 0 <> Api_DrawIconEx(hDC, 0, 0, hCur, 0, 0, I, 0, DI_DEFAULTSIZE Or DI_NORMAL)
        i = i + 1
        CallEvent
        Api_Sleep(100)
        Picture1.Cls
    Wend
    Ret = Api_DrawIconEx(hDC, 0, 0, hCur, 0, 0, 0, 0, DI_DEFAULTSIZE Or DI_NORMAL)
End Sub

'================================================================
'=
'================================================================
Declare Sub MainForm_QueryClose edecl ()
Sub MainForm_QueryClose()
    Var Ret As Long

    Ret = Api_DestroyWindow(hWndCur)
    Ret = Api_ReleaseDC(hDC, Picture1.GethWnd)
End Sub

'================================================================
'=
'================================================================
While 1
    WaitEvent
Wend
Stop
End