Windows GDI+ API 呼び出しによる画像ファイル読み書き
Win32/64API の GDI では BMP ファイルの読み書きしかできませんでしたが、その後に出た GDI+ で JPG/PNG/GIF/TIFF 等が読み書きできるようになりました。しかしながら C++ のクラス利用などが前提となって GDI の時の様に素朴に C ルーチン呼び出しのインターフェースを書くだけでは利用できず、私にはお手上げでした。
その後、昔から Fortran での画像処理を手掛けていた Fortran Plaza さんが、gfortran から GDI＋ を利用できることを示してソースコードも公開されました。その内容はライブラリ全体を包括するような本格的なもので、大規模で少し難しく、そのうち勉強しようと思いつつほったらかしていました。
最近、AI に 「GDI+ での jpg 読み書き Fortran プログラム書けるか？」と聞いてみたところ、「お安い御用さ！」と言いつつ、ホイホイプログラムを吐き出し、画像サイズを出すところまではわずかな修正で行けました。そこから先は嘘だらけになって若干苦労しましたが、必要最低限の API インターフェースの用意で、JPG/PNG/GIF/TIFF 等の画像ファイルを RGB 形式の配列として読み込み、適当な処理をした後、JPG/PNG/GIF/TIFF 等の好みの形式で書き出せるようになりました。
かったるい C との interface 書きなどを AI がやってくれるので、AI 様様と言ったところです。ただ AI 様は、質問者の私がよく分からないことを、分からない人なりの要領を得ない問で聞くと、嘘と真を混ぜて答えてきて閉口させられます。こちらも真偽の判断がつかないので、すぐ騙されます。この辺は、次の世代の AI を待ちたいと思います。
AI 利用は 八合目あたりまで AI 様のケーブルカーで登って、そこから頂上までは自力登山という感じでしょうか。最近の腐りきった Google 検索などではなかなか欲しい情報にたどり着けないので 、AI 様なしではこのプログラムは書けなかったと思います。なおもっぱら Claude 無料枠に書いてもらいました。ChatGPT をクロスチェックに利用しました。
実行例
jpg ファイルを読み込んで、色を反転させて別名 jpg ファイルに保存しています。
GDI+ initialized successfully
Image loaded successfully
0 width 1280
0 height 720
Image saved successfully
Bitmap disposed successfully
GDI+ shut down successfully
GDI+ library unloaded successfully
続行するには何かキーを押してください . . .
入力ファイル
出力ファイル
ソース・プログラム
intel fortran ifx 2024.2.0 で実行しました。stdcall などの呼び出し規約の関係で Win64 でなければ動きません。
ファイルの読み込みの方は、拡張子で自動判別して読み込めますが、書き込みの方は jpg 決め打ちになっています。CLSID を変えることで書き出しファイル形式を変えられます。（CLSID は ID 数列を 32bit little endian, 16 bit little endian, 16 bit little endian, 8bit/4bit の並びで解釈します。ＡＩに騙されましたｗ）ファイル名は末尾に C 言語式の NULL 番兵が必要です。また ASCII 文字列では駄目で、16bit の wide 文字列に変換する必要があります。（ＡＩに騙されましたｗ）
プログラムの概要：
- gdiplus.dll をダイナミックロード。
- CreateBitmapFromFile によって 32bit BMP 形式（ARGB 形式）で読み込む。
- RGB の配列をいじる。
- GdipSaveImageToFile でファイルに書き出す。
module LoadDll_m use, intrinsic :: iso_c_binding implicit none private public :: LoadLibrary, GetProcAddress, FreeLibrary ! Windows API functions ; load DLL interface function LoadLibrary(lpFileName) bind(C, name='LoadLibraryA') import integer(C_INTPTR_T) :: LoadLibrary character(kind=C_CHAR), intent(in) :: lpFileName(*) end function LoadLibrary function GetProcAddress(hModule, lpProcName) bind(C, name='GetProcAddress') import type(C_FUNPTR) :: GetProcAddress integer(C_INTPTR_T), value :: hModule character(kind=C_CHAR), intent(in) :: lpProcName(*) end function GetProcAddress function FreeLibrary(hModule) bind(C, name='FreeLibrary') import integer(C_INT) :: FreeLibrary integer(C_INTPTR_T), value :: hModule end function FreeLibrary end interface end module LoadDll_m module WideString_m use, intrinsic :: iso_c_binding implicit none ! Windows API constants for multibyte-to-wide integer(C_INT), parameter :: CP_ACP = 0 integer(C_INT), parameter :: MB_ERR_INVALID_CHARS = z'00000008' ! Interface for MultiByteToWideChar interface function MultiByteToWideChar(CodePage, dwFlags, lpMultiByteStr, cbMultiByte, & lpWideCharStr, cchWideChar) bind(C, name='MultiByteToWideChar') import integer(C_INT), value :: CodePage, dwFlags type(C_PTR), value :: lpMultiByteStr integer(C_INT), value :: cbMultiByte type(C_PTR), value :: lpWideCharStr integer(C_INT), value :: cchWideChar integer(C_INT) :: MultiByteToWideChar end function MultiByteToWideChar end interface contains function to_wide_string(text) result(res) character(len = *), intent(in), target :: text character(kind=C_CHAR, len=:), allocatable, target :: res integer(C_INT) :: len_text, iret character(kind=C_CHAR, len=:), pointer :: wide_string len_text = MultiByteToWideChar(CP_ACP, MB_ERR_INVALID_CHARS, & c_loc(text), len_trim(text), & C_NULL_PTR, 0) if (len_text == 0) then print *, "to_wide_string: Error in getting length." !Error code:", GetLastError() stop end if ! Allocate the wide string return heap allocate(character(kind=C_CHAR, len=len_text*2) :: res) ! Convert the string iret = MultiByteToWideChar(CP_ACP, MB_ERR_INVALID_CHARS, & c_loc(text), len_trim(text), & c_loc(res), len_text) if (iret == 0) then print *, "to_wide_string: Error in conversion." ! Error code:", GetLastError() stop end if end function to_wide_string end module WideString_m module GdiPlus_m use, intrinsic :: iso_c_binding use :: LoadDll_m use :: WideString_m implicit none ! Bitmap Constants integer(c_int), parameter :: PixelFormat32bppARGB = 2498570 integer(c_int), parameter :: ImageLockModeRead = 1, ImageLockModeWrite = 2 ! GDI+ data types type, bind(C) :: GdiplusStartupInput_t integer(C_LONG) :: GdiplusVersion type(C_FUNPTR) :: DebugEventCallback integer(C_INT) :: SuppressBackgroundThread integer(C_INT) :: SuppressExternalCodecs end type GdiplusStartupInput_t ! Additional types type, bind(c) :: Rect_t integer(c_long) :: X = 0, Y = 0, Width = 0, Height = 0 end type Rect_t type, bind(c) :: BitmapData_t integer(c_int) :: Width integer(c_int) :: Height integer(c_int) :: Stride integer(c_int) :: PixelFormat type(c_ptr) :: Scan0 type(c_ptr) :: Reserved end type BitmapData_t ! GDI+ function pointer types abstract interface function GdiplusStartupFunc(token, input, output) bind(C) import integer(C_INT) :: GdiplusStartupFunc integer(C_INT64_T) :: token type(GdiplusStartupInput_t), intent(in) :: input type(C_PTR), value :: output end function GdiplusStartupFunc subroutine GdiplusShutdownFunc(token) bind(C) import integer(C_INT64_T), value :: token end subroutine GdiplusShutdownFunc function GdipLoadImageFromFileFunc(filename, image) bind(C) import integer(C_INT) :: GdipLoadImageFromFileFunc character(kind=C_CHAR), intent(in):: filename(*) type(C_PTR) :: image end function GdipLoadImageFromFileFunc function GdipSaveImageToFileFunc(image, filename, clsidEncoder, encoderParams) bind(C) import integer(C_long) :: GdipSaveImageToFileFunc type(C_PTR), value :: image character(kind=C_CHAR), intent(in) :: filename(*) type(C_PTR), value :: clsidEncoder type(C_PTR), value :: encoderParams end function GdipSaveImageToFileFunc function GdipGetImageWidthFunc(image, width) bind(c) import integer(c_long) :: GdipGetImageWidthFunc type(c_ptr), value :: image integer(c_int), intent(out) :: width end function GdipGetImageWidthFunc function GdipGetImageHeightFunc(image, height) bind(c) import integer(c_long) :: GdipGetImageHeightFunc type(c_ptr), value :: image integer(c_int), intent(out) :: height end function GdipGetImageHeightFunc function GdipDisposeImageFunc(image) bind(c) import integer(c_long) :: GdipDisposeImageFunc type(c_ptr), value :: image end function GdipDisposeImageFunc function GdipBitmapLockBitsFunc(bitmap, rect, flags, format, lockedBitmapData) bind(c) import integer(c_long) :: GdipBitmapLockBitsFunc type(c_ptr), value :: bitmap type(Rect_t), intent(in) :: rect integer(c_int), value :: flags integer(c_int), value :: format type(BitmapData_t) :: lockedBitmapData end function GdipBitmapLockBitsFunc function GdipBitmapUnlockBitsFunc(bitmap, lockedBitmapData) bind(c) import integer(c_long) :: GdipBitmapUnlockBitsFunc type(c_ptr), value :: bitmap type(BitmapData_t), intent(in) :: lockedBitmapData end function GdipBitmapUnlockBitsFunc function GdipCreateBitmapFromFileFunc(filename, bitmap) bind(c) import integer(c_long) :: GdipCreateBitmapFromFileFunc character(kind=C_CHAR), intent(in):: filename(*) type(c_ptr):: bitmap end function GdipCreateBitmapFromFileFunc end interface type(C_FUNPTR) :: procStartup, procShutdown ! type(C_FUNPTR) :: procLoadImage, procSaveImage type(c_funptr) :: procGetImageWidth, procGetImageHeight, procDisposeImage ! type(c_funptr) :: procCreateBitmapFromFile type(c_funptr) :: procBitmapLockBits, procBitmapUnlockBits ! procedure(GdiplusStartupFunc), pointer :: GdiplusStartup procedure(GdiplusShutdownFunc), pointer :: GdiplusShutdown ! procedure(GdipLoadImageFromFileFunc), pointer :: GdipLoadImageFromFile procedure(GdipSaveImageToFileFunc), pointer :: GdipSaveImageToFile procedure(GdipGetImageWidthFunc), pointer :: GdipGetImageWidth procedure(GdipGetImageHeightFunc), pointer :: GdipGetImageHeight procedure(GdipDisposeImageFunc), pointer :: GdipDisposeImage ! procedure(GdipCreateBitmapFromFileFunc), pointer :: GdipCreateBitmapFromFile procedure(GdipBitmapLockBitsFunc), pointer :: GdipBitmapLockBits procedure(GdipBitmapUnlockBitsFunc), pointer :: GdipBitmapUnlockBits ! ! CLSID ! {557CF400-1A04-11D3-9A73-0000F81EF32E} bmp ! {557CF401-1A04-11D3-9A73-0000F81EF32E} jpeg ! {557CF402-1A04-11D3-9A73-0000F81EF32E} gif ! {557CF403-1A04-11D3-9A73-0000F81EF32E} emf ! {557CF404-1A04-11D3-9A73-0000F81EF32E} wmf ! {557CF405-1A04-11D3-9A73-0000F81EF32E} tiff ! {557CF406-1A04-11D3-9A73-0000F81EF32E} png ! {557CF407-1A04-11D3-9A73-0000F81EF32E} icon integer(c_long), target :: clsid_bmp_encoder(4) = [z'557cf400', z'11d31a04', z'0000739a', z'2ef31ef8'] !bmp integer(c_long), target :: clsid_jpg_encoder(4) = [z'557cf401', z'11d31a04', z'0000739a', z'2ef31ef8'] !jpg integer(c_long), target :: clsid_gif_encoder(4) = [z'557cf402', z'11d31a04', z'0000739a', z'2ef31ef8'] !gif integer(c_long), target :: clsid_emf_encoder(4) = [z'557cf403', z'11d31a04', z'0000739a', z'2ef31ef8'] !emf integer(c_long), target :: clsid_wmf_encoder(4) = [z'557cf404', z'11d31a04', z'0000739a', z'2ef31ef8'] !wmf integer(c_long), target :: clsid_tif_encoder(4) = [z'557cf405', z'11d31a04', z'0000739a', z'2ef31ef8'] !tiff integer(c_long), target :: clsid_png_encoder(4) = [z'557cf406', z'11d31a04', z'0000739a', z'2ef31ef8'] !png integer(c_long), target :: clsid_ico_encoder(4) = [z'557cf407', z'11d31a04', z'0000739a', z'2ef31ef8'] !icon ! integer(C_INTPTR_T) :: hLib integer(C_INT64_T) :: token type(GdiplusStartupInput_t) :: input ! ! Bitmap type(BitmapData_t), target :: bmpData type(c_ptr), target :: bitmap contains subroutine initialize_GDI() integer(C_INT) :: status ! Load the GDI+ library hLib = LoadLibrary("gdiplus.dll"//C_NULL_CHAR) if (hLib == 0) then print *, "Failed to load GDI+ library" stop end if ! Get the addresses of GDI+ functions procStartup = GetProcAddress(hLib, "GdiplusStartup"//C_NULL_CHAR) procShutdown = GetProcAddress(hLib, "GdiplusShutdown"//C_NULL_CHAR) ! procLoadImage = GetProcAddress(hLib, "GdipCreateBitmapFromFile"//C_NULL_CHAR) procSaveImage = GetProcAddress(hLib, "GdipSaveImageToFile"//C_NULL_CHAR) procGetImageWidth = GetProcAddress(hLib, "GdipGetImageWidth"//C_NULL_CHAR) procGetImageHeight = GetProcAddress(hLib, "GdipGetImageHeight"//C_NULL_CHAR) procDisposeImage = GetProcAddress(hLib, "GdipDisposeImage"//C_NULL_CHAR) ! procCreateBitmapFromFile = GetProcAddress(hLib, "GdipCreateBitmapFromFile"//C_NULL_CHAR) procBitmapLockBits = GetProcAddress(hLib, "GdipBitmapLockBits"//C_NULL_CHAR) procBitmapUnlockBits = GetProcAddress(hLib, "GdipBitmapUnlockBits"//C_NULL_CHAR) if (.not. c_associated(procStartup) .or. & .not. c_associated(procShutdown) .or. & .not. c_associated(procLoadImage) .or. & .not. c_associated(procSaveImage) .or. & .not. c_associated(procGetImageWidth) .or. & .not. c_associated(procGetImageHeight) .or. & .not. c_associated(procDisposeImage) .or. & .not. c_associated(procCreateBitmapFromFile) .or. & .not. c_associated(procBitmapLockBits) .or. & .not. c_associated(procBitmapUnlockBits) ) then print *, "Failed to get one or more GDI+ function addresses" status = FreeLibrary(hLib) stop end if ! Associate the C function pointers with the Fortran procedure pointers call c_f_procpointer(procStartup, GdiplusStartup) call c_f_procpointer(procShutdown, GdiplusShutdown) ! call c_f_procpointer(procLoadImage, GdipLoadImageFromFile) call c_f_procpointer(procSaveImage, GdipSaveImageToFile) call c_f_procpointer(procGetImageWidth, GdipGetImageWidth) call c_f_procpointer(procGetImageHeight, GdipGetImageHeight) call c_f_procpointer(procDisposeImage, GdipDisposeImage) ! call c_f_procpointer(procBitmapLockBits, GdipBitmapLockBits) call c_f_procpointer(procBitmapUnLockBits, GdipBitmapUnLockBits) call c_f_procpointer(procCreateBitmapFromFile, GdipCreateBitmapFromFile) ! Initialize GDI+ startup input input%GdiplusVersion = 1 input%DebugEventCallback = C_NULL_FUNPTR input%SuppressBackgroundThread = 0 input%SuppressExternalCodecs = 0 ! Call GdiplusStartup status = GdiplusStartup(token, input, C_NULL_PTR) if (status /= 0) then print *, "Failed to initialize GDI+. Error code:", status status = FreeLibrary(hLib) stop else print *, "GDI+ initialized successfully" end if end subroutine initialize_GDI subroutine finialize_GDI() integer(C_INT) :: status ! Shutdown GDI+ call GdiplusShutdown(token) print *, "GDI+ shut down successfully" ! Unload the GDI+ library status = FreeLibrary(hLib) if (status == 0) then print *, "Failed to unload GDI+ library" else print *, "GDI+ library unloaded successfully" end if end subroutine finialize_GDI subroutine open_and_read(fn, pixels) character(kind=c_char, len=*), target, intent(in) :: fn integer(c_int), pointer, intent(out) :: pixels(:, :) ! integer(C_INT) :: status integer(C_INT) :: iwidth, iheight type(Rect_t) :: rect_in ! status = GdipCreateBitmapFromFile(to_wide_string(fn), bitmap) if (status /= 0) then print *, "Failed to load image. Error code:", status stop else print *, "Image loaded successfully" status = GdipGetImageWidth(bitmap, iwidth) print *, status, 'width ', iwidth status = GdipGetImageHeight(bitmap, iHeight) print *, status, 'height', iheight end if ! bmpData%Width = iwidth bmpData%Height = iheight bmpData%Stride = ((iwidth * 32 + 31) / 32) * 4 bmpData%PixelFormat = PixelFormat32bppARGB ! Lock bitmap bits / c_null_ptr rect_in%X = 0 rect_in%Y = 0 rect_in%Width = iwidth rect_in%Height = iheight ! status = GdipBitmapLockBits(bitmap, rect_in, ImageLockModeRead + ImageLockModeWrite, & PixelFormat32bppARGB, bmpData) if (status /= 0) then print *, 'BitmapLockBits failed. status =', status stop end if ! ! bind to pixel data call c_f_pointer(bmpData%Scan0, pixels, [iwidth, iheight]) end subroutine open_and_read subroutine write_and_close(fn) character(kind=c_char, len=*), intent(in) :: fn ! integer(C_INT) :: status ! status = GdipBitmapUnLockBits(bitmap, bmpData) if (status /= 0) then print *, 'BitmapUnLockBits failed. status =', status stop end if ! Save the image to a new file status = GdipSaveImageToFile(bitmap, to_wide_string(fn), C_loc(clsid_jpg_encoder), C_NULL_PTR) if (status /= 0) then print *, "Failed to save image. Error code:", status else print *, "Image saved successfully" end if ! Clean up status = GdipDisposeImage(bitmap) if (status /= 0) then print *, "Failed to dispose Bitmap. Error code:", status else print *, "Bitmap disposed successfully" end if end subroutine write_and_close end module GdiPlus_m program test_gdiplus use, intrinsic :: iso_c_binding use :: LoadDll_m use :: GdiPlus_m implicit none call initialize_GDI() BMP:block character(kind=c_char, LEN = 256), target :: fn integer(c_int), pointer :: pixels(:, :) ! load bmp/jpg/gif/png/... file as 32bit ARGB 2d-array fn = "C:\temp\kositantan.jpg"//C_NULL_CHAR call open_and_read(fn, pixels) ! RGBA:block integer(c_int) :: ir, ig, ib, ia do concurrent (integer::ix = 1:size(pixels, 1), iy = 1:size(pixels, 2)) ! Extract ARGB values ia = iand(ishft(pixels(ix, iy), -24), 255) ir = iand(ishft(pixels(ix, iy), -16), 255) ig = iand(ishft(pixels(ix, iy), -8), 255) ib = iand( pixels(ix, iy) , 255) pixels(ix, iy) = (256 - ib) + 256 * (256 - ig + 256 * (256 - ir + 256 * ia)) end do end block RGBA ! ! save as jpg ! ( bmp/jpg/gif/png/... ) fn = "C:\temp\sika.jpg"//C_NULL_CHAR call write_and_close(fn) end block BMP call finialize_GDI() end program test_gdiplus
