你真厉害!
你这些知识都是哪学来的?

呵呵,我和啊Ben,lzl1403都是从 TurboPascal的Help里面学的,
不过我们没有jtchang老师厉害啦

哈哈！所以说，我们要学会运用TurboPascal的Help啊！
但我也想问问，jtchang老师又是哪里学来的呢？？？？？？？[em18][em18]

仔细去试了SetRGBPalette这个过程，我晕倒~~~
它确实改变不了高亮颜色，即索引8-15的颜色。记得TC3好象也存在这样的毛病！

如果颜色由r,g,b组成，取值是0-63，那么共有64*64*64 = 262144 种颜色。由于以前显卡的常规显存是非常小的，在640*480模式下只允许调色板里同时存在16种颜色。换句话说，显存保存颜色的数值只是一个索引。当改变调色板某个索引的rgb颜色时，屏幕上所有该索引的点颜色都会改变。比如把颜色1改成红色，则当前屏幕上所有原来索引为1的点，都改成了红色。改变调色板是图片淡入淡出最快的方法，不用重新描点。

理论上，我们能在同一屏幕上，选取262144种颜色的其中16种，颜色任我们调。但是，16色本来就非常少，高亮颜色不能改，只能改变低亮0-7的颜色，相当痛苦！那高亮8种颜色不是我要的！

还好，给我的不好，我就自己编一个来代替。下面的过程，高亮的颜色也能调。呵呵！(^_^)

set_rgb_pal(colornum:byte; r,g,b:word);
colornum 取值为0 - 15。r,g,b取值0-63。把第colornum种颜色调成指定的r,g,b值。


procedure set_rgb_pal(colornum:byte; r,g,b:word);
begin
   colornum := colornum mod 16 ;
   asm
       mov ah,10h
       mov al,0
       mov bh,colornum
       mov bl,colornum
       int 10h
       mov al,colornum
       mov dx,$3c8
       out dx,al
       mov dx,$3c9
       mov ax,r
       out dx,ax
       mov ax,g
       out dx,ax
       mov ax,b
       out dx,ax
   end;
end;

哇,太棒了!
要是jtchang老师有空能把关于显卡的中断调用和输入输出全部
都介绍一次就好了

我补充3点：

一、set_rgb_pal过程我改成下面这样。把r,g,b改成byte类型更贴切。

procedure set_rgb_pal(colornum,r,g,b:byte);
begin
   colornum := colornum and $F ;
   asm
       mov ah,10h
       mov al,0
       mov bh,colornum
       mov bl,colornum
       int $10
       mov al,colornum
       mov dx,$3c8
       out dx,al
       mov dx,$3c9
       mov al,r
       out dx,al
       mov al,g
       out dx,al
       mov al,b
       out dx,al
   end;
end;

二、TP7作图模式下，缺省调色板值是这样的：

值    r    g    b
0    0    0    0
1    0    0    42
2    0    42    0
3    0    42    42
4    42    0    0
5    42    0    42
6    42    21    0
7    42    42    42
8    21    21    21
9    21    21    63
10    21    63    21
11    21    63    63
12    63    21    21
13    63    21    63
14    63    63    21
15    63    63    63

(书上抄来的，试了没错，呵呵！)

三、关于图像淡出实现的方法很多。能看到的程序，大多数是用Turbo C写的，但是用Turbo Pascal写的很少。下面有一个程序是C语言写的，我把它改成Pascal，并作修改，实现了整屏弹出、淡入、淡出的效果。有兴趣的话看一下。


uses crt,graph;
var
  red,grn,blu,red0,grn0,blu0 : array[0..255] of byte;
  gd,gm : integer;
  ch : char;

procedure outportb(pt:word; b:byte);
begin
    asm  mov dx, pt
         mov al, b
         out dx, al
     end;
end;

function inportb(pt:word): byte;
var  k: byte;
begin
    asm  mov dx, pt
         in al, dx
         mov k, al
    end;
    inportb := k;
end;

procedure closescr;  {关闭屏幕}
var   b : byte;
begin
    outportb($3C4,1);
    b := inportb($3C5);
    b := b or $20;
    outportb($3C5,b);
end;

procedure openscr; {打开屏幕}
var   b : byte;
begin
    outportb($3c4,1);
    b := inportb($3c5);
    b := b and $DF;
    outportb($3C5,b);
end;

procedure chgcolor(num,red,grn,blu: byte); {修改DAC寄存器}
begin
    outportb($3C8,num);  {颜色号}
    outportb($3C9,red);
    outportb($3C9,grn);
    outportb($3C9,blu);
end;

procedure dark; {修改DAC寄存器表各值为0}
var i: integer;
begin
   for i:=0 to 255 do
   begin
       outportb($3C7,i);    {设置为读DAC表方式}
       red0[i] := inportb($3C9);
       grn0[i] := inportb($3C9);
       blu0[i] := inportb($3C9);
       red[i] := 0; grn[i]:=0; blu[i] := 0;
       chgcolor(i,0,0,0);
   end;
end;

procedure bright; {恢复DAC表}
var  i,j,flg : integer;
begin
    flg := 1;
    repeat
       flg := 0;
       for i := 0 to 255 do
         begin
             if red[i] <> red0[i] then
                begin
                    flg := 1;   red[i] := red[i] + 1;
                end;
             if grn[i] <> grn0[i] then
                begin
                    flg := 1;   grn[i] := grn[i] + 1;
                end;
             if blu[i] <> blu0[i] then
                begin
                    flg := 1;   blu[i] := blu[i] + 1;
                end;
              chgcolor(i,red[i],grn[i],blu[i]);
         end;
         delay(90);
    until flg = 0;
end;

procedure darkout;  
var  i,j,flg : integer;
begin
    flg := 1;
    red := red0;  grn := grn0; blu := blu0;
    repeat
       flg := 0;
       for i := 0 to 255 do
         begin
             if red[i] <> 0 then
                begin
                    flg := 1;   red[i] := red[i] - 1;
                end;
             if grn[i] <> 0 then
                begin
                    flg := 1;   grn[i] := grn[i] - 1;
                end;
             if blu[i] <> 0 then
                begin
                    flg := 1;   blu[i] := blu[i] - 1;
                end;
              chgcolor(i,red[i],grn[i],blu[i]);
         end;
         delay(90);
    until flg = 0;
end;

procedure drawbar;   {画图}
var  i: integer;
begin
  for i := 0 to 15 do
    begin
       setfillstyle(1,i);
       sector(320,240,round(i*22.5),round((i+1)*22.5),220,220);
    end;
end;

begin
    gd := Detect;
    initgraph(gd,gm,'');
    if graphresult <> grOK then  halt;
     closescr;
     drawbar;
     ch := readkey;
     openscr;
     ch := readkey;
     cleardevice;
     dark;
     drawbar;
     bright;
     ch := readkey;
     darkout;
     closegraph;
end.

哇呀呀！厉害呀！高兴呀！谢谢呀！

顺便问问jtchang老师：16楼所说的“书上抄来的”是指什么书？我好想看看。

那本书不是pascal编的，是C。《C语言最新编程技巧200例》(修订本)。几年前不知在什么书店看到买的。里面有一些汉字显示、图像显示等程序。书名说“最新”，现在算很旧啦！呵呵！(^_^)

呵呵！