主题:pascal中的图画
绿步甲
[专家分:1610] 发布于 2005-08-30 14:49:00
请问PASCAL中的图画都要自己一笔一笔画吗?能不能应用自己硬盘里其他图片?或有其他办法吗?如果一笔一笔画的话,一个程序会变得很长.
回复列表 (共5个回复)
沙发
lzl1403 [专家分:1670] 发布于 2005-08-30 15:47:00
接着的:
procedure LoadBMP(fname:string;var bi:TBMPInfoHeader;var Image:Pointer);
var
fin:bf;
bh:TBMPFileHeader;
numq,width,h:longint;
i,j:longint;
t:byte;
tms:longint;
kw,imgw,memsize:word;
k,p,q,img:Pointer;
pal:array [0..15] of TRGBQUAD;
begin
assign(fin,fname);
reset(fin);
ReadBuf(fin,@bh,sizeof(bh));
ReadBuf(fin,@bi,sizeof(bi));
{seek(fin,sizeof(bi)+sizeof(bh)+((1 shl bi.biBitCount)*4));}
numq:=1 shl bi.biBitCount;
for i:= 0 to numq-1 do
ReadBuf(fin,@pal[i],sizeof(TRGBQUAD));
tms:=bh.bfSize-bh.bfOffBits;
tms:=tms shr 10;
if tms=0 then memsize:=1
else memsize:=tms+1;
GetMem(k,bh.bfSize-bh.bfOffBits);
GetMem(Image,(bh.bfSize-bh.bfOffBits)*2);
ReadBuf(fin,pbyte(k),bh.bfSize-bh.bfOffBits);
close(fin);
width:=(bi.biWidth*bi.biBitCount+31)shr 5 shl 2;
h:=bi.biHeight-1;
for i:=0 to h div 2 do
for j:=0 to width-1 do
begin
p:=k;
inc(longint(p),i*width+j);
t:=pbyte(p)^;
q:=k;
inc(longint(q),(h-i)*width+j);
pbyte(p)^:=pbyte(q)^;
pbyte(q)^:=t;
end;
for i:=0 to h do
for j:=0 to width-1 do
begin
p:=k;
inc(longint(p),i*width+j);
q:=Image;
inc(longint(q),(i*width+j)*2);
pbyte(q)^:=conv(pbyte(p)^ div 16);
inc(longint(q));
pbyte(q)^:=conv(pbyte(p)^ mod 16);
end;
dispose(k);
end;
procedure DrawBMP(Image:Pointer;x,y,w,h,x1,y1,x2,y2:longint;keycolor:byte);
var
i,j:longint;
c:byte;
begin
w:=(w*4+31)shr 5 shl 3;
for i:=y1 to y2 do
begin
for j:=x1 to x2 do
begin
c:=pbyte(longint(Image)+w*i+j)^;
if (keycolor>15)or(c<>keycolor) then PutPixel(x+j-x1,y+i-y1,c);
end;
end;
end;
end.
板凳
lzl1403 [专家分:1670] 发布于 2005-08-30 15:47:00
根据林记的理念,pascal可以读BMP格式的图:
林记编的读BMP格式图片的Unit:
unit Readbmp;
interface
type
TBMPFileHeader=record
bfType:word;
bfSize:longint;
bfReserved1:word;
bfReserved2:word;
bfOffBits:longint;
end;
TBMPInfoHeader=record
bfSize:longint;
biWidth:longint;
biHeight:longint;
biPlanes:word;
biBitCount:word;
biCompression:longint;
biSizeImage:longint;
biXPelsPerMeter:longint;
biYPelsPerMeter:longint;
biClrUsed:longint;
biClrImportant:longint;
end;
TRGBQUAD=record
b:byte;
g:byte;
r:BYTE;
res:byte;
end;
procedure LoadBMP(fname:string;var bi:TBMPInfoHeader;var Image:Pointer);
procedure DrawBMP(Image:Pointer;x,y,w,h,x1,y1,x2,y2:longint;keycolor:byte);
implementation
uses Graph,XMS;
type
pbyte=^byte;
bf=file of byte;
procedure ReadBuf(var f:bf;p:pbyte;size:longint);
var
i:longint;
c:byte;
begin
for i:=0 to size-1 do
begin
read(f,c);
pbyte(longint(p)+i)^:=c;
end;
end;
function conv(k:byte):byte;
begin
conv:=k;
case k of
1:conv:=4;
3:conv:=6;
4:conv:=1;
6:conv:=3;
9:conv:=12;
11:conv:=14;
12:conv:=9;
14:conv:=11;
end;
end;
3 楼
林记 [专家分:1680] 发布于 2005-08-30 16:21:00
恩,顶一下,
根据lzl1403的理念,也可以自己编个简单程序来画,
不过我这里没这个程序
4 楼
阿Ben [专家分:2200] 发布于 2005-08-30 23:29:00
我也顶。
根据lzl1403和林记的理念,TP的作图模式只能画16色的图。
也就是说,你要先把BMP图片换成16色才能用以上单元。
方法:用“画图”打开,选“另存为”,再选“16色位图”……
5 楼
风花雪月☆雨 [专家分:460] 发布于 2005-08-31 12:37:00
原来如此,长见识
我来回复