ＡＣＣＥＳＳ ＶＢＡ ＴＩＦＦ形式のファイルの解像度を取得したいです。

ＡＣＣＥＳＳ ＶＢＡ ＴＩＦＦ形式のファイルの解像度を取得したいです。

以前の書き込みに幅×高さのピクセル値の求め方がかかれてあり、理解しました。

用紙サイズの判別に上記の 幅ｘ高さと解像度を利用しようと考えています。

よろしくお願いします。

No.1 回答者： mitarashi 回答日時： 2010/06/28 21:49

大げさな方法。

なんとか2K文字をクリア。ご参考まで。

Private Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
Private Declare Function GdipCreateBitmapFromFile Lib "Gdiplus" (FileName As Any, bitmap As Long) As Long
Private Declare Function GdipDisposeImage Lib "Gdiplus" (ByVal Image As Long) As Long
Private Declare Function GdipGetImageHeight Lib "Gdiplus" (ByVal Image As Long, Height As Long) As Long
Private Declare Function GdipGetImageWidth Lib "Gdiplus" (ByVal Image As Long, Width As Long) As Long
Private Declare Sub GdiplusShutdown Lib "Gdiplus" (ByVal token As Long)
Private Declare Function GdiplusStartup Lib "Gdiplus" (token As Long, pInput As GdiplusStartupInput, pOutput As Any) As Long
Private Declare Function GdipGetImageHorizontalResolution Lib "Gdiplus" (ByVal Image As Long, resolution As Single) As Long
Private Declare Function GdipGetImageVerticalResolution Lib "Gdiplus" (ByVal Image As Long, resolution As Single) As Long
Sub test()
Dim udtInput As GdiplusStartupInput
Dim lngToken As Long, lngStatus As Long
Dim pSrcBmp As Long, pDstBmp As Long
Dim lngWidth As Long, lngHeight As Long
Dim horResln As Single, verResln As Single
Dim srcPath As String

srcPath = "C:\Documents and Settings\????????\デスクトップ\hoge.tif"
udtInput.GdiplusVersion = 1
If GdiplusStartup(lngToken, udtInput, ByVal 0&) <> 0 Then
Exit Sub
End If
If GdipCreateBitmapFromFile(ByVal StrPtr(srcPath), pSrcBmp) <> 0 Then
GdiplusShutdown lngToken
Exit Sub
End If
GdipGetImageWidth pSrcBmp, lngWidth
GdipGetImageHeight pSrcBmp, lngHeight
Debug.Print lngWidth, lngHeight
GdipGetImageHorizontalResolution pSrcBmp, horResln
GdipGetImageVerticalResolution pSrcBmp, verResln
Debug.Print horResln, verResln
GdipDisposeImage pSrcBmp
GdiplusShutdown lngToken
End Sub

参考URL：http://arkham46.developpez.com/articles/office/c …

この回答へのお礼

mitarashiさま

ご回答ありがとうございました。

悩んでいたことが解決しました。

お礼日時：2010/06/29 08:52