from 229
VB用のdtools.dllを入手する。
上記作者の許諾は得てないけど、
DTOOLS.BI
'F−BASIC6.で使用するDTOOL.BIファイル
'2001/06/18 Ver 1.4d
'Attribute VB_Name = "DTools"
'左上の座標の色を透明色にする
#define CLR_INVALID -1
'ディスプレイモード
#defineDT_MODE320 0
#defineDT_MODE640 1
#defineDT_MODE800 2
#defineDT_MODE1024 3
#defineDT_MODE1152 4
#define DT_MODE1280 5
#define DT_MODE1600 6
'色数
#define DT_BPP8 0
#define DT_BPP16 &H10
#define DT_BPP24 &H20
#define DT_BPP32 &H30
'スクリーンモード
#define DT_FULLSCREEN 0
#define DT_WINDOWMODE &H100
'描画フラグ
#define DT_NORMAL 0
#define DT_NOSRCKEY 1
#define DT_DESTKEY 2
#define DT_NOWAIT 4
#define DT_NOCLIP 8
'メモリタイプ
#define DT_DEFAULT 0
#define DT_VRAM 1
#define DT_SYSTEM 2
'パレット操作用
type PALETTEENTRY
PERED as byte '赤
PEGREEN as byte '緑
PEBLUE as byte '青
PEFLAGS as byte
end type
'メモリ操作用
type MEMSTATE
LPSURFACE as long 'サーフェスの一番左上のメモリアドレス
LPITCH as long 'サーフェスのピッチ
end type
'ピクセルフォーマット用
type COLORMASK
BPP As Long
RBITS as long
GBITS as long
BBITS as long
RMASK as long
GMASK as long
BMASK as long
End Type
'DrawTools 各命令宣言
'DitectDraw基本制御
public declare function DTINIT lib "Dtools.dll" alias "DTInit" (byval DISPMODE as long, byval HWND as long) as long
public declare function DTEND lib "Dtools.dll" alias "DTEnd" () as long
public declare function DTENUMDISPLAYMODE lib "Dtools.dll" alias "DTEnumDisplayMode" (byval HWND as long, byval LBWND as long) as long
public declare function DTRESTORE lib "Dtools.dll" alias "DTRestore" () as long
'サーフェス関係
public declare function DTSETMEMORYMODE lib "Dtools.dll" alias "DTSetMemoryMode" (byval MEMORYTYPE as long) as long
public declare function DTGETMEMORYMODE lib "Dtools.dll" alias "DTGetMemoryMode" (byval DEST as long) as long
public declare function DTCREATESURFACE lib "Dtools.dll" alias "DTCreateSurface" (byval DEST as long, byval DX as long, byval DY as long) as long
public declare function DTCREATESPRITE lib "Dtools.dll" alias "DTCreateSprite" (byval DEST as long, byval HBMP as long, byval DX as long, byval DY as long) as long
public declare function DTCOPYBITMAP lib "Dtools.dll" alias "DTCopyBitmap" (byval DEST as long, byval HBMP as long) as long
public declare function DTDELETESURFACE lib "Dtools.dll" alias "DTDeleteSurface" (byval DEST as long) as long
public declare function DTDUPLICATESURFACE lib "Dtools.dll" alias "DTDuplicateSurface" (byval DEST as long, byval SRC as long) as long
public declare function DTSETCOLORKEY lib "Dtools.dll" alias "DTSetColorKey" (byval DEST as long, byval COL as long) as long
public declare function DTGETCOLORKEY lib "Dtools.dll" alias "DTGetColorKey" (byval DEST as long) as long
'描画関係
public declare function DTCLEAR lib "Dtools.dll" alias "DTClear" (byval DEST as long, byval COL as long, byval FLAG as long) as long
public declare function DTBITBLT lib "Dtools.dll" alias "DTBitBlt" (byval DEST as long, byval DX as long, byval DY as long, byval _WIDTH as long, byval HEIGHT as long, byval SRC as long, byval SX as long, byval SY as long, byval FLAG as long) as long
'Public Declare Function DTStretchBlt Lib "Dtools.dll" alias "DTStretchBlt"
'(ByVal Dest As Long, ByVal dx As Long, ByVal dy As Long, ByVal Width As Long, ByVal Height As Long, ByVal Src As Long, ByVal sx As Long, ByVal sy As Long, ByVal srcWidth As Long, ByVal srcHeight As Long, ByVal Flag As Long) As Long
public declare function DTSTRETCHBLT lib "Dtools.dll" alias "DTStretchBlt" (byval DEST& , byval DX&, byval DY& , byval _WIDTH& , byval HEIGHT& , byval SRC& , byval SX& , byval SY& , byval SRCWIDTH& , byval SRCHEIGHT& , byval FLAG&) as long
public declare function DTUPDATE lib "Dtools.dll" alias "DTUpdate" (byval FLAG as long) as long
'エフェクト関係
'Public Declare Function DTEffectPrepare Lib "Dtools.dll" (ByVal Dest As Long, ByVal Src As Long, ByVal CopySurface As Long) As Long
'Public Declare Function DTEffectEnd Lib "Dtools.dll" () As Long
'Public Declare Function DTEffectRotateBlt Lib "Dtools.dll" (ByVal dx As Long, ByVal dy As Long, ByVal Width As Long, ByVal Height As Long, ByVal sx As Long, ByVal sy As Long, ByVal Deg As Long, ByVal Flag As Long) As Long
'Public Declare Function DTEffectTableBlt Lib "Dtools.dll" (ByVal dx As Long, ByVal dy As Long, ByVal Width As Long, ByVal Height As Long, ByVal sx As Long, ByVal sy As Long, Table As Any) As Long
'Public Declare Function DTEffectHalfBlt Lib "Dtools.dll" (ByVal dx As Long, ByVal dy As Long, ByVal Width As Long, ByVal Height As Long, ByVal sx As Long, ByVal sy As Long, ByVal Flag As Long) As Long
'クリップ関係
public declare function DTSETCLIPRECT lib "Dtools.dll" alias "DTSetClipRect" (byval DEST as long, byval LEFT as long, byval TOP as long, byval RIGHT as long, byval BOTTOM as long) as long
public declare function DTRESETCLIPRECT lib "Dtools.dll" alias "DTResetClipRect" (byval DEST as long) as long
public declare function DTCOPYCLIPRECT lib "Dtools.dll" alias "DTCopyClipRect" (byval DEST as long, byval SRC as long) as long
'デバイスコンテキスト関係
public declare function DTGETDC lib "Dtools.dll" alias "DTGetDC" (byval DEST as long) as long
public declare function DTRELEASEDC lib "Dtools.dll" alias "DTReleaseDC" (byval DEST as long, byval HDC as long) as long
'パレット関係
public declare function DTSETPALETTE lib "Dtools.dll" alias "DTSetPalette" (byval FILENAME as string) as long
public declare function DTCOLORMATCH lib "Dtools.dll" alias "DTColorMatch" (byval COL as long) as long
public declare function DTGETPALETTEENTRIES lib "Dtools.dll" alias "DTGetPaletteEntries" (LPPAL as PALETTEENTRY, byval BASE as long, byval COUNT as long) as long
public declare function DTSETPALETTEENTRIES lib "Dtools.dll" alias "DTSetPaletteEntries" (LPPAL as PALETTEENTRY, byval BASE as long, byval COUNT as long) as long
public declare function DTGETPIXELFORMAT lib "Dtools.dll" alias "DTGetPixelFormat" (LPCM as COLORMASK) as long
'メモリ操作関係
public declare function DTLOCK lib "Dtools.dll" alias "DTLock Lib" (byval DEST as long, MEMSTA as MEMSTATE) as long
public declare function DTUNLOCK lib "Dtools.dll" alias "DTUnlock" (byval DEST as long, MEMSTA as MEMSTATE) as long
public declare function DTFILLMEMORY lib "Dtools.dll" alias "DTFillMemory" (byval DEST as long, byval BDATA as byte) as long
'ポインタ関係
public declare function DTGETDDPTR lib "Dtools.dll" alias "DTGetDDPtr" () as long
public declare function DTGETPALETTEPTR lib "Dtools.dll" alias "DTGetPalettePtr" () as long
public declare function DTGETSURFACEPTR lib "Dtools.dll" alias "DTGetSurfacePtr" (byval DEST as long) as long
'ここまで<DTOOL.BI>
VBサンプルの長い定義をF-BASIC用に詰めたもの
HWND&=GETHWND
'RET&=DTINIT(DT_MODE640 or DT_BPP32 or DT_WINDOWMODE,HWND&)
RET&=DTINIT(DT_MODE640 or DT_BPP32 or DT_FULLSCREEN,HWND&)
RET&=DTCLEAR(0,0,0)
RET&=DTUPDATE(0)
*LOOP
K$=inkey$
select case K$
case "r"
'COL&=HGCOLOR(5)
COL&=RGB(0,0,255)
RET&=DTCLEAR(0,COL&,0)
RET&=DTUPDATE(0)
case "g"
'COL&=HGCOLOR(9)
COL&=RGB(0,255,0)
RET&=DTCLEAR(0,COL&,0)
RET&=DTUPDATE(0)
case "b"
'COL&=HGCOLOR(3)
COL&=RGB(255,0,0)
RET&=DTCLEAR(0,COL&,0)
RET&=DTUPDATE(0)
case chr$(27)
goto *FIN
case else
wait 1
end select
goto *LOOP
Set wmiObjSet = GetObject _
("winmgmts:{impersonationLevel=impersonate}"). _
InstancesOf("Win32_SerialPort")
For Each obj In wmiObjSet
MsgBox obj.Caption
Next
>解決方法
>マイクロソフトでは、現在この問題を修正する修正プログラムを提供中ですが、
>修正プログラムはこの資料に記載された問題のみを修正することを目的としており、
>障害があったコンピュータに対してのみ適用することを推奨します。この修正プログラムは、
>今後さらにテストを受ける場合があります。この問題で深刻な影響を受けていない場合は、
>この修正プログラムが含まれる次の Windows XP Service Pack がリリースされるまで
>待つことを推奨します。
:
中略
:
>状況
>マイクロソフトでは、この問題をこの資料の冒頭に記載したマイクロソフト製品の問題として認識しています。
>この問題は、Windows XP Service Pack 1 で修正済みです。
ImmGetCompositionFontでフォント名の取得がうまかいかないとのことですが
考えられる個所はAPI関数名ではないかと推測します。
/*エイリアスにはANSI系関数を指定する
/*IMMGETCOMPOSITIONFONT lib "imm32.dll" Alias "ImmGetCompositionFontA" (
LOGFONT構造体の lfFaceName メンバの定義はF-BASICでは次のようになります。
#define LF_FACESIZE 32
type LOGFONT
lfHeight As Long
lfWidth As Long
〜〜〜(省略)〜〜〜
lfFaceName(LF_FACESIZE-1) as Byte
end type
このように通常はByte型ですが、F-BASICでは扱いづらいので、String*n型に
することも可能だと思います。 (提示されたソースではそのようで)