投稿者 snowmansnow  (社会人) 投稿日時 2021/12/28 22:53:26

 こんばんは、魔界の仮面弁士様
 >VBA7 な Access VBA が前提のようですが、API 宣言が結構間違っていませんか?
  ごめんなさい、見直しました
 
 Option Explicit
Private Type BITMAPFILEHEADER
       bfType       As String * 2
       bfSize       As Long
       bfReserved1  As Integer
       bfReserved2  As Integer
       bfOffBits    As Long
End Type

Private Type BitmapInfoHeader
    biSize  As Long
    biWidth As Long
    biHeight As Long
    biPlanes As Integer
    biBitCount As Integer
    biCompression As Long
    biSizeImage As Long
    biXPelsPerMeter As Long
    biYPelsPerMeter As Long
    biClrUsed As Long
    biClrImportant As Long
End Type

Private Type BITMAPINFO
    bmiHeader As BitmapInfoHeader
End Type


Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr

Declare PtrSafe Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As LongPtr) As LongPtr

Declare PtrSafe Function CreateDIBSection Lib "gdi32" (ByVal hdc As LongPtr, pBitmapInfo As BITMAPINFO, ByVal un As LongByVal lplpVoid As LongPtr, ByVal handle As LongPtr, ByVal dw As LongAs LongPtr

Declare PtrSafe Function GetDIBits Lib "gdi32" (ByVal aHDC As LongPtr, ByVal hBitmap As LongPtr, ByVal nStartScan As LongByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As LongAs Long

Declare PtrSafe Function SelectObject Lib "gdi32" (ByVal hdc As LongPtr, ByVal hObject As LongPtr) As LongPtr

Declare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As Long

Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As Long

Declare PtrSafe Function CreatePen Lib "gdi32" (ByVal nPenStyle As LongByVal nWidth As LongByVal crColor As LongAs LongPtr

Declare PtrSafe Function GetStockObject Lib "gdi32" (ByVal nIndex As LongAs LongPtr

Declare PtrSafe Function Rectangle Lib "gdi32" (ByVal hdc As LongPtr, ByVal X1 As LongByVal Y1 As LongByVal X2 As LongByVal Y2 As LongAs Long


Private Const PS_SOLID = 0
Private Const WHITE_BRUSH = 0
Private Const GRAY_BRUSH = 2
Private Const CWIDTH = 1500
Private Const CHEIGHT = 1500