回 帖 发 新 帖 刷新版面

主题:pascal中的图画

请问PASCAL中的图画都要自己一笔一笔画吗?能不能应用自己硬盘里其他图片?或有其他办法吗?如果一笔一笔画的话,一个程序会变得很长.

回复列表 (共5个回复)

沙发

接着的:
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.


板凳

根据林记的理念,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 楼

恩,顶一下,
根据lzl1403的理念,也可以自己编个简单程序来画,
不过我这里没这个程序

4 楼

我也顶。
根据lzl1403和林记的理念,TP的作图模式只能画16色的图。
也就是说,你要先把BMP图片换成16色才能用以上单元。

方法:用“画图”打开,选“另存为”,再选“16色位图”……

5 楼

原来如此,长见识

我来回复

您尚未登录,请登录后再回复。点此登录或注册