'================================================================
'=　拡大鏡
'=  StretchBlt
'=    (Loupe2.bas)
'================================================================
#include "Windows.bi"

Type POINTAPI
    X As Long
    Y As Long
End Type

' ウィンドウにメッセージを送信。この関数は、指定したウィンドウのウィンドウプロシージャが処理を終了するまで制御を返さない
Declare Function Api_SendMessage& Lib "user32" Alias "SendMessageA" (ByVal hWnd&, ByVal wMsg&, ByVal wParam&, lParam As Any)

' ウィンドウのサイズ、位置、および Z オーダーを設定
Declare Function Api_SetWindowPos& Lib "user32" Alias "SetWindowPos" (ByVal hWnd&, ByVal hWndInsertAfter&, ByVal X&, ByVal Y&, ByVal CX&, ByVal CY&, ByVal uFlags&)

' マウスのキャプチャを解放
Declare Function Api_ReleaseCapture& Lib "user32" Alias "ReleaseCapture" ()

' Windowsのデスクトップウィンドウを識別。返されるポインタは、一時的なポインタ。後で使用するために保存しておくことはできない
Declare Function Api_GetDesktopWindow& Lib "user32" Alias "GetDesktopWindow" ()

' 拡縮をともなうグラフィックデバイス間のイメージを転送
Declare Function Api_StretchBlt& Lib "gdi32" Alias "StretchBlt" (ByVal hDC&, ByVal X&, ByVal Y&, ByVal nWidth&, ByVal nHeight&, ByVal hSrcDC&, ByVal xSrc&, ByVal ySrc&, ByVal nSrcWidth&, ByVal nSrcHeight&, ByVal dwRop&)

' 指定されたウィンドウのクライアント領域または画面全体を表すディスプレイデバイスコンテキストのハンドルを取得
Declare Function Api_GetDC& Lib "user32" Alias "GetDC" (ByVal hWnd&)

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

' マウスカーソル(マウスポインタ)の現在の位置に相当するスクリーン座標を取得
Declare Function Api_GetCursorPos& Lib "user32" Alias "GetCursorPos" (lpPoint As POINTAPI)

#define WM_NCLBUTTONDOWN &HA1           '非クライアント領域で左マウスボタンを押す
#define HWND_TOPMOST (-1)               'ウィンドウを常に最前面に配置
#define SWP_SHOWWINDOW &H40             'ウィンドウを表示する
#define SWP_NOSIZE &H1                  'ウィンドウの現在のサイズを保持する
#define SWP_NOMOVE &H2                  'ウィンドウの現在位置を保持する
#define HTCAPTION 2                     'タイトルバーをクリックしたことを示す
#define RCCOPY &HCC0020                 '転送元長方形を転送先長方形にそのままコピー
#define COLORONCOLOR 3                  '取り除く点の情報を保存することなく削除

Var Shared hWnd As Long
Var Shared dtphDC As Long
Var Shared FormWidth As Long
Var Shared FormHeight As Long
Var Shared N As single                  '倍率

Var Shared Picture1 As Object
Var Shared Timer1 As Object
Var Shared VScroll1 As Object

Picture1.Attach GetDlgItem("Picture1")
Timer1.Attach GetDlgItem("Timer1")
VScroll1.Attach GetDlgItem("VScroll1")

'================================================================
'=
'================================================================
declare sub MainForm_Start edecl ()
sub MainForm_Start()
    Var dtphWnd As Long

    FormWidth = 600
    FormHeight = 140
    SetWindowSize FormWidth, FormHeight

    Picture1.SetWindowSize FormWidth - 30, FormHeight
    Picture1.MoveWindow 0, 0

    VScroll1.SetWindowSize 14, FormHeight - 40
    VScroll1.MoveWindow FormWidth - 24, 4
    VScroll1.SetScrollRange 10, 30
    VScroll1.SetScrollStep 5, 1
    VScroll1.SetScrollPos 20
    N = 2
    SetWindowtext "拡大鏡 倍率:" & Trim$(Str$(N)) & "倍"

    MoveWindow 0, 0
    ShowWindow -1

    dtphWnd = Api_GetDesktopWindow()        'デスクトップハンドル取得
    dtphDC = Api_GetDC(dtphWnd)             'デバイスコンテキスト取得

    Timer1.SetInterval 1
    Timer1.Enable -1
End sub

'================================================================
'= カーソル位置のデスクトップ画像を拡大(２倍)して転送
'================================================================
Declare Sub Timer1_Timer edecl ()
Sub Timer1_Timer()
    Var pa As POINTAPI
    Var pichDC As Long
    Var Ret As Long

    pichDC = Api_GetDC(Picture1.GethWnd)    'Picture1のDC取得
    Ret = Api_GetCursorPos(pa)
    Ret = Api_SetWindowPos(GethWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE)
    Ret = Api_StretchBlt(pichDC, 0, 0, FormWidth * N, FormHeight * N, dtphDC, pa.X, pa.Y - 10, FormWidth, FormHeight, RCCOPY)
End Sub

'================================================================
'=    
'================================================================
Declare Sub VScroll1_Change edecl ()
Sub VScroll1_Change()
    N = VScroll1.GetScrollPos / 10
    SetWindowtext "拡大鏡 倍率:" & Trim$(Str$(N)) & "倍"
End sub

'================================================================
'=    
'================================================================
Declare Sub MainForm_MouseDown edecl (Button%, Shift%, X!, Y!)
Sub MainForm_MouseDown(Button%, Shift%, X!, Y!)
    Var Ret As Long

    Ret = Api_ReleaseCapture()
    Ret = Api_SendMessage(GethWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
End Sub

'================================================================
'=　
'================================================================
Declare Sub MainForm_QueryClose(Cancel%, ByVal Mode%)
Sub MainForm_QueryClose(Cancel%, ByVal Mode%)
    Var Ret As Long

    Ret = Api_ReleaseDC(hWnd, hDC)
    End
End sub

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