这个版块里有一些源程序,应该对你有所帮助.
这里再贴上一段程序,作一些修改就可以满足你的要求:
!**********************************************************************************
!*******************************(第0部分)程序说明模块******************************
!**********************************************************************************
!这是用fortran语言开发的一个最简单的windows程序
!程序用来显示一行文本,并且解决高效率重画的问题
!下表是Win32和Fortran数据类型的等价关系:
!┏━━━━━━━━━━━━━━┳━━━━━━━━━━━━━━━━━┓
!│ Win32 Data Type │ Equivalent Fortran Data Type │
!│ BOOL, BOOLEAN │ LOGICAL(4) │
!│ BYTE │ BYTE │
!│ CHAR, CCHAR, UCHAR │ CHARACTER │
!│ COLORREF │ INTEGER(4) │
!│ DWORD, INT, LONG, ULONG│ INTEGER(4) │
!│ SHORT, USHORT, WORD │ INTEGER(2) │
!│ FLOAT │ REAL(4) │
!│ All Handles │ INTEGER(4) │
!│ All Pointers (LP*, P*) │ INTEGER(4) (Integer Pointers)│
!┗━━━━━━━━━━━━━━┻━━━━━━━━━━━━━━━━━┛
!
!**********************************************************************************
!****************************(第一部分)有用的数据模块******************************
!**********************************************************************************
!
module Constant
use dFwin
logical*4 results !存储函数的返回值
logical*4 IsDrawing !用来判断是否开始画线
integer*4 i
integer*4 X !文本的输出位置
integer*4 Y
integer*4 maxX !显示器的分辨率
integer*4 maxY
character*100 string !存储将要输出的文本
integer*4 memdc !存储兼容的设备描述表的句柄
integer*4 hbit !存储指定的设备描述表兼容的位图的句柄
integer*4 hbrush !存储画刷的句柄
end module Constant
!
!**********************************************************************************
!****************************(第二部分)主函数部分**********************************
!**********************************************************************************
!
integer function WinMain( hInstance, hPrevInstance, lpszCmdLine, nCmdShow )
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_WinMain@16' :: WinMain
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'WinMain' :: WinMain
!DEC$ ENDIF
!包含有用的模块
use Constant
!定义函数的传递参数
integer*4 hInstance !定义当前实例句柄
integer*4 hPrevInstance !定义句柄,永远是NULL型
integer*4 nCmdShow !定义程序执行的时候窗口的显示方式
integer*4 lpszCmdLine !指向字符串的指针
!===================================================
!定义函数接口,注意这一段是必须的
interface
integer*4 function MainWndProc ( hwnd, mesg, wParam, lParam )
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_MainWndProc@16' :: MainWndProc
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'MainWndProc' :: MainWndProc
!DEC$ ENDIF
integer*4 hwnd
integer*4 mesg
integer*4 wParam
integer*4 lParam
end function
end interface
!===================================================
type (T_WNDCLASS) wc !定义窗口的结构体类数据,确定窗口的特征
type (T_MSG) mesg !定义消息的结构体类数据
integer*4 hWnd !定义程序窗口的句柄
integer*4 COLOR !定义窗口的背景颜色
character*100 lpszClassName !定义窗口类的名字
character*100 lpszAppName !定义窗口的名字,即窗口的标题
COLOR=13 !用来改变窗口的背景颜色,从1-20颜色会变化
IsDrawing = .false. !用来判断是否开始画线
lpszClassName ="Generic"C
lpszAppName ="WINDOWS程序的框架"C
open(unit=10,file='hello.dat')
!指定窗口的特征
if(hPrevInstance .eq. 0) then
wc%lpszClassName = LOC(lpszClassName) !指定窗口类的名字
wc%lpfnWndProc = LOC(MainWndProc) !指定窗口函数的地址
wc%style = 0 !指定窗口的类型
wc%hInstance = hInstance !指定当前实例句柄
wc%hIcon = LoadIcon( NULL, IDI_WINLOGO) !指定窗口的图标
wc%hCursor = LoadCursor( NULL, IDC_CROSS ) !指定鼠标光标
wc%hbrBackground = ( COLOR_WINDOW+COLOR ) !指定窗口的背景颜色
wc%lpszMenuName = NULL !指定窗口主菜单的名字
wc%cbClsExtra = 0 !没有额外的信息提供
wc%cbWndExtra = 0 !没有额外的信息提供
i = RegisterClass(wc) !让系统注册窗口,即告知系统窗口的特征是什么样的
end if
!创建窗口
hWnd = CreateWindowEx( 0, & !扩展的窗口风格
lpszClassName, & !窗口类的名字
lpszAppName, & !窗口的标题
INT(WS_OVERLAPPEDWINDOW), & !窗口的类型
CW_USEDEFAULT, & !窗口左上角的X坐标
0, & !窗口左上角的Y坐标
CW_USEDEFAULT, & !窗口的宽度
0, & !窗口的高度
NULL, & !父窗口的句柄
NULL, & !主菜单的句柄
hInstance, & !当前实例句柄
NULL & !附加信息的指针
)
!显示窗口
i = ShowWindow( hWnd, SW_MAXIMIZE)
i = UpdateWindow( hWnd )
!进入消息循环
do while( GetMessage (mesg, NULL, 0, 0) .NEQV. .FALSE.)
i = TranslateMessage( mesg )
i = DispatchMessage( mesg )
end do
WinMain = mesg%wParam
return
end
!
!**********************************************************************************
!****************************(第三部分)窗口函数部分********************************
!**********************************************************************************
!
integer function MainWndProc ( hWnd, mesg, wParam, lParam )
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_MainWndProc@16' :: MainWndProc
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'MainWndProc' :: MainWndProc
!DEC$ ENDIF
use Constant
integer*4 hWnd !窗口的句柄
integer*4 mesg !消息类结构体
integer*4 wParam !消息相关的附加信息
integer*4 lParam !消息相关的附加信息
integer*4 hdc !当前设备描述表的句柄
integer*4 StartX, StartY !线段起点
integer*4 EndX, EndY !线段终点
integer*4 EndXX, EndYY !鼠标的当前位置
integer*4 hredpen !线段的颜色句柄
type (T_TEXTMETRIC) tm !定义当前字体信息的T_TEXTMETRIC结构体
type (T_SIZE) size !定义包含字符串宽度和高度信息的T_SIZE结构体
type (T_PAINTSTRUCT) paintstruct !定义包含窗口显示信息的T_PAINTSTRUCT结构体
logical*4 F,T
F=.false.
T=.true.
X=0
Y=0
!进行消息的处理
select case ( mesg )
case( WM_CREATE ) !创建虚拟窗口
maxX = GetSystemMetrics( SM_CXSCREEN ) !获得屏幕分辨率
maxY = GetSystemMetrics( SM_CYSCREEN )
hdc = GetDC( hWnd )
memdc = CreateCompatibleDC( hdc ) !创建兼容的设备描述表
hbit = CreateCompatibleBitmap( hdc,maxX,maxY ) !创建一个与指定的设备描述表兼容的位图
i = SelectObject( memdc,hbit )
hbrush = GetStockObject(WHITE_BRUSH)
i = SelectObject( memdc,hbrush )
results = PatBlt( memdc,0,0,maxX,maxY,PATCOPY ) !用所选画刷的颜色和图案来填充矩形
hredpen = CreatePen( PS_SOLID,1,RGB(0,0,255) ) !创建红色的,实线形画笔
i = SetBkMode(memdc,TRANSPARENT) !输出文本与窗体色彩一样
i = SelectObject(memdc,hredpen)
i = ReleaseDC(hWnd,hdc)
case ( WM_LBUTTONDOWN )
if(IsDrawing.EQ..FALSE.)then
StartX = LOWORD(lParam)
StartY = HIWORD(lParam)
results = MoveToEx(memdc,StartX,StartY,NULL)
endif
IsDrawing = .true.
EndX = LOWORD(lParam)
EndY = HIWORD(lParam)
write(10,*)endx,endy
results = MSFWIN$LineTo(memdc,EndX,EndY)
results = InvalidateRect(hwnd,NULL,F) !更新物理窗口
case ( WM_RBUTTONDOWN )
IsDrawing = .false.
case ( WM_MOUSEMOVE )
EndXX = LOWORD(lParam)
EndYY = HIWORD(lParam)
i = MSFWIN$SetTextColor(memdc,RGB(255,0,0)) !文字颜色
results = GetTextMetrics(memdc,tm)
results = PatBlt(memdc,X,Y,150,tm%tmHeight,PATCOPY)
write(string,"('屏幕坐标:'I4 'x' I4)") EndXX, EndYY
results = TextOut(memdc,X,Y,string,LEN(string))
results = InvalidateRect(hwnd,NULL,F) !更新物理窗口
case( WM_PAINT )
hdc = BeginPaint( hwnd,paintstruct )
result = BitBlt(hdc, &
paintstruct%rcPaint%left, &
paintstruct%rcPaint%top, &
paintstruct%rcPaint%right-paintstruct%rcPaint%left, &
paintstruct%rcPaint%bottom-paintstruct%rcPaint%top, &
memdc, &
paintstruct%rcPaint%left, &
paintstruct%rcPaint%top, &
SRCCOPY) !将虚拟窗口中的内容复制到物理窗口中
hdc=EndPaint(hwnd,paintstruct)
case ( WM_DESTROY ) !如果关闭窗口,则退出应用程序
results = DeleteDC(memdc)
results = DeleteObject(hredpen)
call PostQuitMessage( 0 )
case default !其他信息系统自己处理
MainWndProc = DefWindowProc( hWnd, mesg, wParam, lParam )
end select
return
end