前几天看到有朋友讨论有关 Console 类型工程使用彩色字体输出的问题。

有人说 Fortran 这方面不在行，建议用 C 来实现，其实 C 也是使用外部的函数库的。如果单单为了这一点点东西就改用另一门语言，或者改用 QuickWin，似乎有点小题大做了。

仔细想想，其实彩色文字这方面平常我们也经常会需要的。比如程序碰到例外或出错了，我们都希望给出红色的错误提示，或者黄色的警告。于是就有了一个想法，写一个模块来实现彩色文本的窗口输出。（输出到文件当然就失效了）

翻了翻有关的 API 函数，大概能够实现了。拿出来大家共同探讨。

模块取名为 Colorized_Text_Mod 。使用了 Kernel32 这个 API 函数库的一些东西。所以，需要你的编译器有 API 的导入库。一般的 VF（CVF 和 IVF） 都是可以的，写程序的时候是在 IVF 下，如果 CVF 下通不过，一般把模块里的 Use Kernel32 改成 Use DFWin 就可以了。在 Linux 平台上跑的高手就不要笑话我了，那方面我还很欠缺。呵呵~~

先 Use Colorized_Text_Mod

使用之前必须先定义一个逻辑型变量来接收模块函数的返回值，比如：

[quote]Logical(kind=ctmKIND_LOGICAL) :: bRes[/quote]

调用 Colorized_Text_Mod 中的函数以后都可以判断失败或成功。失败时返回值为 ctmEXECUTE_ERROR 成功时则为 ctmEXECUTE_SUCCESS。

定义好以后需要初始化：

[quote]bRes = ctm_Init()[/quote]

通过调用函数 ctm_SetColor 来改变当前的颜色：

[quote]bRes = ctm_SetColor( iColorValue , wFlag )[/quote]

参数定义为：
[quote]Integer(kind=ctmKIND_COLOR) , Intent( IN ) :: iColorValue
Integer(kind=ctmKIND_FLAG) , Intent( IN ) :: wFlag[/quote]

iColorValue 为颜色索引值，一共有 16 种颜色可以选择，建议直接使用定义好的常量，使用其他量的时候应该定义为 Integer(kind=ctmKIND_COLOR)，并且小于等于16，大于等于0。十六个定义好的常量有：
[quote]ctmCOLOR_BLACK        0  黑色
ctmCOLOR_BLUE         1  蓝色
ctmCOLOR_GREEN        2  绿色
ctmCOLOR_CYAN         3  青色
ctmCOLOR_RED          4  红色
ctmCOLOR_MAGENTA      5  紫色
ctmCOLOR_BROWN        6  棕色
ctmCOLOR_LIGHTGRAY    7  浅灰色
ctmCOLOR_DARKGRAY     8  深灰色
ctmCOLOR_LIGHTBLUE    9  亮蓝色
ctmCOLOR_LIGHTGREEN   10 亮绿色
ctmCOLOR_LIGHTCYAN    11 亮青色
ctmCOLOR_LIGHTRED     12 亮红色
ctmCOLOR_LIGHTMAGENTA 13 亮紫色
ctmCOLOR_YELLOW       14 黄色
ctmCOLOR_WHITE        15 白色[/quote]

wFlag 指定需要设定的是文本颜色还是背景颜色。指定为 ctmSET_TEXT 代表要设定文本颜色，指定为 ctmSET_BG 代表要设定背景颜色。
测试发现改变背景颜色很不好看，建议就不要使用了。

通过调用 ctm_ResetColor( wFlag ) 恢复默认的显示方式
wFlag 可以指定为 ctmSET_TEXT 代表要恢复文本颜色，指定为 ctmSET_BG 代表要恢复背景颜色，指定为 ctmSET_BOTH 代表恢复文本和背景颜色。

最后调用 ctm_UnInit 结束 ：
[quote]bRes = ctm_UnInit()[/quote]
ctm_UnInit 内部会调用 ctm_ResetColor( ctm_SET_BOTH ) 恢复文本和背景颜色的显示。

举一个例子：
[quote]
Program Main
  Use Colorized_Text_Mod
  Implicit None
  Logical(kind=ctmKIND_LOGICAL) :: bRes
  bRes = ctm_Init()
  If ( .Not.bRes ) then
    write(*,*) '初始化失败！'
  EndIf
  bRes = ctm_SetColor( ctmCOLOR_BLUE , ctmSET_TEXT )
  Write(*,*) '蓝色文字'
  bRes = ctm_ResetColor( ctmSET_TEXT )
  Write(*,*) '恢复文字显示颜色'
  bRes = ctm_SetColor( ctmCOLOR_RED , ctmSET_TEXT )
  Write(*,*) '红色文字'
  bRes = ctm_SetColor( ctmCOLOR_YELLOW , ctmSET_BG )
  Write(*,*) '黄色背景'
  bRes = ctm_ResetColor( ctmSET_BG )
  Write(*,*) '恢复背景显示颜色，保留字体颜色'
  bRes = ctm_SetColor( ctmCOLOR_GREEN , ctmSET_BG )
  Write(*,*) '绿色背景'
  bRes = ctm_UnInit()
  Write(*,*) '恢复默认样式'
  Read(*,*)
End Program Main[/quote]

源码和例子都在附件中，喜欢的朋友可以拿去。