网页资讯视频图片知道文库贴吧地图采购
进入贴吧全吧搜索

 
 
 
日一二三四五六
       
       
       
       
       
       

签到排名:今日本吧第个签到,

本吧因你更精彩,明天继续来努力!

本吧签到人数:0

一键签到
成为超级会员,使用一键签到
一键签到
本月漏签0次!
0
成为超级会员,赠送8张补签卡
如何使用?
点击日历上漏签日期,即可进行补签。
连续签到:天  累计签到:天
0
超级会员单次开通12个月以上,赠送连续签到卡3张
使用连续签到卡
06月14日漏签0天
pascal吧 关注:14,951贴子:132,337
  • 看贴

  • 图片

  • 吧主推荐

  • 视频

  • 游戏

  • 1 2 3 下一页 尾页
  • 70回复贴,共3页
  • ,跳到 页  
<<返回pascal吧
>0< 加载中...

【教程】Free Pascal从零开始编游戏(Display单元库使用说明)

  • 只看楼主
  • 收藏

  • 回复
  • ax_pokl
  • begin
    9
该楼层疑似违规已被系统折叠 隐藏此楼查看此楼


下载地址:
http://pan.baidu.com/s/1o6OWBfs
http://axpokl.ys168.com/
求申精。


  • ax_pokl
  • begin
    9
该楼层疑似违规已被系统折叠 隐藏此楼查看此楼
Free Pascal从零开始编游戏(基础部分)
Display单元库使用说明
制作:ax_pokl
目录
前言
第一章 配置
第二章 窗口
第三章 绘图
第四章 文字
第五章 消息
第六章 音频
第七章 应用
第八章 窗口的建立
第九章 图片的读取
第十章 图片的绘制
第十一章 音频的播放
第十二章 帧率的获取
第十三章 用户的消息
附录
后记
前言
献给所有热爱游戏编程的程序员们。
本教程分为两个部分:
基础部分:第一到七章讲解Display单元库使用方法,
在阅读前请先阅读《一天学会Free Pascal》教程;
高阶部分:第八到十三章讲解Display单元库实现方法,
在阅读前请先阅读《Pascal之Windows API简明教程》。
本教程使用Windows NT为内核的操作系统。
本教程的实例均通过Free Pascal 2.6.4编译。
本教程使用Display单元库,请先阅读单元库display.pp内所有文字说明和所有子程序重载
本教程所有实例永久下载地址:
http://pan.baidu.com/s/1o6OWBfs
http://axpokl.ys168.com/
作者ax_pokl联系方式:
E-mail:ax_pokl@sina.com,QQ:395838203。
由于作者水平有限,教程难免有错误和疏漏之处,敬请谅解。发现错误请联系作者,谢谢!


2025-06-14 20:42:28
广告
  • ax_pokl
  • begin
    9
该楼层疑似违规已被系统折叠 隐藏此楼查看此楼
第四章 文字
第一节 输出文字
第二节 设定字体大小
第三节 设定字体
第一节 输出文字
以下过程可以输出文字:
procedure DrawText(s:ansistring;cfg,cbg:longword);
procedure DrawText(s:ansistring;c:longword);
procedure DrawText(s:ansistring);
s为需要输出的字符串。
cfg,cbg分别为文字的颜色和背景色。如果只指定c,则背景色为透明(不绘制背景色)。不指定c时,默认的文字颜色是窗体的前景色。
可以使用XY系列过程将文字输出到指定位置:
procedure DrawTextXY(s:ansistring;x,y:longword);
或者ln系列过程按行效果输出:
procedure DrawTextln(s:ansistring);
使用w系列过程可输出定宽文本:
procedure DrawTextw(s:ansistring);
定宽字符宽度取决于字体,请先定义字体大小。
部分过程也可将文字输出到指定图片,具体请参见Display单元库重载表。
实例:
uses Display;//使用Display单元库
begin
CreateWin();//建立窗口
DrawTextln('ax_pokl output text.');//输出文本并换行
DrawTextw('ax_pokl''s text is tight');//输出定宽文本(宽度默认为0)
DrawTextXY('ax_pokl output text anywhere',50,50);//指定位置输出文本
DrawTextXY('ax_pokl output text anywhere',50,50);//指定位置输出文本
DrawTextXY('',0,80);//强制改变输出位置
DrawText('and it''s colorful ',Orange);//输出带颜色文本
DrawText('with backgroud color',Red,Blue);//输出带背景颜色文本
FreshWin();//刷新窗口
Msgbox('绘制完成');//输出绘制完成信息
end.
第二节 设定字体大小
以下过程可以设定字体大小:
procedure SetFontWidth(w:longword);
procedure SetFontHeight(h:longword);
procedure SetFontSize(w,h:longword);
w,h为宽和高,设为0时有特殊含义:
h为0时,将使用系统默认的高度。
w为0时,宽度将匹配高度。
设为0时,虽然显示的字体有宽和高,但其宽或高仍旧为0。
实例:
uses Display;//使用Display单元库
var pyi:longword;
begin
CreateWin();//建立窗口
SetFontSize(5,10);//宽5,高10
DrawTextXY('5,10',0,0,White,Red);
SetFontHeight(20);//高20,宽不变
DrawTextXY('-,20',0,20,White,Red);
SetFontSize(0,0);//默认大小
DrawTextXY('匹配,默认',0,40,White,Red);
SetFontSize(0,20);//高20,宽匹配
DrawTextXY('匹配,20',0,60,White,Red);
for pyi:=0 to 4 do line(0,pyi*20,GetWidth,0,Orange);
FreshWin();//刷新窗口
Msgbox('绘制完成');//输出绘制完成信息
end.
第三节 设定字体
以下过程可以设定字体:
procedure SetFontWeight(wg:longword);
procedure SetFontLtalic(lt:longword);
procedure SetFontUnderLine(ud:longword);
procedure SetFontStrikeOut(sk:longword);
procedure SetFontName(s:ansistring);
粗细wg默认为0,标准为400,粗体为700。
斜体lt,下划线ud,删除线sk为0或1。
用SetFont(b:pbitmap)可将当前字体选入图片。
实例:
Display;//使用Display单元库
begin
CreateWin();//建立窗口
SetFontName('Comic Sans MS');//字体名称
DrawTextXY('Comic Sans MS',0,0);
SetFontWeight(700);//粗体
DrawTextXY('Weight',0,20);SetFontWeight(0);
SetFontLtalic(1);//斜体
DrawTextXY('Ltalic',0,40);SetFontLtalic(0);
SetFontUnderLine(1);//下划线
DrawTextXY('UnterLine',0,60);SetFontUnderLine(0);
SetFontStrikeOut(1);//删除线
DrawTextXY('StrikeOut',0,80);SetFontStrikeOut(0);
FreshWin();//刷新窗口
Msgbox('绘制完成');//输出绘制完成信息
end.


  • ax_pokl
  • begin
    9
该楼层疑似违规已被系统折叠 隐藏此楼查看此楼
第五章 消息
第一节 获取消息
第二节 处理消息
第三节 获取时间
第四节 获取帧率
第五节 控制帧率
第一节 获取消息
窗口必须不断获取消息才不会失去响应:
function IsNextMsg():boolean;
function GetNextMsg():longword;
function WaitNextMsg():longword;
IsNexgMsg和WaitNextMsg会把新消息发送给窗口,GetNextmsg则不会。只有当新消息存在时,新消息才会被发送给窗口。
IsNextMsg会返回队列中是否有新消息。GetNextMsg和WaitNexgMsg会返回消息号。
在新消息产生之前,WaitNextMsg不会返回。 IsNextMsg和GetNextMsg会立即返回,无论是否有新消息。
实例:
uses Display;//使用Display单元库
begin
CreateWin();//建立窗口
repeat//第一种消息循环
if IsNextMsg then//如果有新消息
SetTitle(i2s(GetNextMsg()));//输出消息号到标题栏
until not(IsWin()) or (GetNextMsg()=258);//直到窗口关闭或者消息号为258(按键)
repeat//第二种消息循环
WaitNextMsg();//等待新消息
SetTitle(i2s(GetNextMsg()));//输出消息号到标题栏
until not(IsWin()) or (GetNextMsg()=258);//直到窗口关闭或者消息号为258(按键)
end.
第二节 处理消息
获取消息后,可以使用以下函数进行处理
function IsMsg(uM:longword):boolean;
function GetMsg(uM:longword):qword;
function WaitMsg(uM:longword):qword;
IsMsg用以判断当前消息是否指定消息。
GetMsg可获取消息的参数。如果当前消息不是指定消息,则函数返回0。
WaitMsg会等待指定消息并返回消息的参数。
uM也可以使用数组,即uM:array of longword。
以下函数可以判断特定类型消息:
function IsKey():boolean;
function IsKey(k:longword):boolean;
function IsMouse():boolean;
function IsMouse(m:longword):boolean;
function IsMouseLeft():boolean;
function IsMouseMove():boolean;
function IsDropFile():boolean;
部分以上函数也有Get和Wait的版本。
以下函数可获取鼠标的位置:
function GetMouseAbsX():longint;
function GetMouseAbsY():longint;
function GetMouseWinX():longint;
function GetMouseWinY():longint;
function GetMousePosX():longint;
function GetMousePosY():longint;
Abs,Win和Pos分别为鼠标的绝对坐标,窗口坐标和绘图区坐标。
实例:
uses Display;//使用Display单元库
begin
CreateWin();//建立窗口
repeat
SetTitle(i2s(GetMousePosX())+' '+i2s(GetMousePosY()));//输出鼠标位置到标题栏
WaitNextMsg();
if IsKey() then MsgBox(i2s(GetKey()));//如果是按键则输出按键号
if IsMouse() then Msgbox(i2s(GetMouse()));//如果按鼠标则输出鼠标号
if IsMouseWheel() then Msgbox(i2s(GetMouseWheel()));//如果鼠标滚轮则输出滚轮号
if IsDropFile() then Msgbox(GetDropFile());//如果是拖拽文件则输出文件名
until not(IsWin()) or (IsKey(27));//直到关闭窗口或按ESC键
end.
第三节 获取时间
以下函数可以获取时间:
function GetTimeR():real;
function GetTime():longword;
GetTimeR返回从窗口建立开始到现在的时间。
GetTime返回整型时间,以毫秒计。
实例:
uses Display;//使用Display单元库
begin
CreateWin();//建立窗口
repeat
SetTitle(i2s(GetTime()));//输出时间到标题栏
IsNextMsg();Delay(1);////等待新消息并延迟1毫秒
until not(IsWin()) or IsKey();//直到窗口关闭或按键
end.
第四节 获取帧率
以下函数可以获取帧率:
function GetFPSL():longword;
function GetFPSR():real;
function GetFPS():longword;
GetFPSL返回从一秒前开始到当前的帧数(刷新次数,即调用FreshWin的次数)。
GetFPSR返回GetFPSL*一秒前开始第一帧到当前帧(最后刷新)的时间(时间小于1秒)。
GetFPS返回GetFPSR取整的结果。
实例:
uses Display;//使用Display单元库
begin
CreateWin();//建立窗口
repeat
IsNextMsg();//等待新消息
Clear();//清屏
DrawTextXY('',0,0);//设置文本输出位置
DrawTextln(i2s(GetFPSL()));//输出瞬时刷新率
DrawTextln(i2s(GetFPS()));//输出平均刷新率
FreshWin();//刷新窗口
Delay(1);//延迟1毫秒
until not(IsWin()) or IsKey();//直到窗口关闭或按键
end.
第五节 处理帧率
以下过程可以延迟时间:
procedure Delay(t:longword);
procedure Delay(t:real);
procedure Delay();
t为longword时以毫秒计。
最短延迟时间视系统状态而定,这可能是1000/60毫秒或者1毫秒(1系统tick)。
实例:
uses Display;//使用Display单元库
var frame:longword=120;//帧率
var time:real=0;//当前帧时间
begin
CreateWin();//建立窗口
repeat
if IsNextMsg() then//如果有新消息
begin
if (frame>10) and IsKey(37) then frame:=frame-1;//如果按左则减小帧率
if (frame<480) and IsKey(39) then frame:=frame+1;//如果按右则增加帧率
end;
if GetTimeR()>time+1/frame then//如果当前时间已超过一帧时间
begin
while GetTimeR()>time+1/frame do time:=time+1/frame;//增加帧数(包括跳帧)
Clear();//清屏
DrawTextlnXY(i2s(GetFPSL()),0,0);//输出瞬时刷新率
DrawTextln(i2s(GetFPS()));//输出平均刷新率
DrawTextln(i2s(frame));//输出瞬时刷新率
FreshWin();//刷新窗口
end;
Delay(1);//延迟1毫秒
until not(IsWin()) or IsKey(27);//直到窗口关闭或按ESC键
end.


  • ax_pokl
  • begin
    9
该楼层疑似违规已被系统折叠 隐藏此楼查看此楼
第六章 音频
第一节 读取音频
第二节 播放音频
第三节 设定音量
第四节 暂停音频
第五节 跳转音频
第六节 音频播放器
第一节 读取音频
以下函数可以读取音频,请在读取之前先创建longword类型变量:
function LoadAudio(s:ansistring):longword;
之后对音频的操作需要这个longword类型变量。
可以同时读取多个音频,用longword变量区分。
支持的音频格式有wav,mp3,wmv等系统内生支持的格式,和Windows media player相同。
实例:
uses Display;//使用Display单元库
var audio:longword;
begin
audio:=LoadAudio('display.mp3');//读取音频
Msgbox(i2s(audio));//输出音频号
end.
第二节 播放音频
以下过程可以播放音频:
procedure PlayAudio(id:longword;b:boolean);
procedure PlayAudio(id:longword);
b为true时,音频将重复播放。
不指定b时默认为false(单曲播放)。
实例:
uses Display;//使用Display单元库
var audio1,audio2:longword;
begin
audio1:=LoadAudio('display.mp3');//读取音频1
audio2:=LoadAudio('display.mp3');//读取音频2
PlayAudio(audio1);//播放音频1
Msgbox('正在播放音频');
PlayAudio(audio2,true);//重复播放音频2
Msgbox('正在重复播放音频');
end.
第三节 设定音量
播放过程中可获取或设定音频音量:
function GetAudioVol(id:longword):longword;
procedure SetAudioVol(id:longword;v:longword);
音量v为longword类型,范围为0到1000。
每个音频可以设定不同的音量。
音频必须在开始播放以后才能设定音量。
实例:
uses Display;//使用Display单元库
var audio:longword;
begin
audio:=LoadAudio('display.mp3');//读取音频
PlayAudio(audio);//播放音频
SetAudioVol(audio,200);//设定音量
Msgbox('正在播放音频,音量200');
end.
第四节 暂停音频
以下过程可以实现音频的暂停,继续,停止:
procedure PauseAudio(id:longword);
procedure ResumeAudio(id:longword);
procedure StopAudio(id:longword);
procedure ReleaseAudio(id:longword);
Pause和Resume可以暂停,继续音频的播放。
用Stop停止播放音频后,可以用Play重新播放。
如需彻底将音频从内存中释放,请用Release。
实例:
uses Display;//使用Display单元库
var audio:longword;
begin
audio:=LoadAudio('display.mp3');//读取音频
PlayAudio(audio);//播放音频
Msgbox('正在播放音频,按确定暂停');
PauseAudio(audio);
Msgbox('音频已暂停,按确定继续');
ResumeAudio(audio);
Msgbox('音频已继续重复播放');
StopAudio(audio);
Msgbox('音频已停止播放');
PlayAudio(audio);
Msgbox('音频已重新开始播放');
ReleaseAudio(audio);
Msgbox('音频已释放');
end.
第五节 跳转音频
以下过程可以实现音频的跳转,以及获取音频的播放位置和长度:
function GetAudioLen(id:longword):longword;
function GetAudioPos(id:longword):longword;
procedure SetAudioPos(id:longword;pos:longword);
procedure SetAudioPos(id:longword;pos:longword;b:boolean);
获取的位置和长度为longword,以毫秒计。
如需从指定位置重复播放,请设b为true。
实例:
uses Display;//使用Display单元库
var audio:longword;
begin
audio:=LoadAudio('display.mp3');//读取音频
PlayAudio(audio);SetAudioPos(audio,GetAudioLen(audio)div 2);//从中间开始播放音频
Msgbox('正在播放音频,从中间开始');
end.


  • ax_pokl
  • begin
    9
该楼层疑似违规已被系统折叠 隐藏此楼查看此楼
第七章 应用
第一节 音频播放器
第二节 俄罗斯方块
第一节 音频播放器
使用前六章知识,编写简易音频播放器:
uses Display;//使用Display单元库
var w:longword=600;//窗口宽
var h:longword=100;//窗口高
var frame:longword=120;//帧率
var time:real=0;//当前帧时间
var audio:longword;//音频句柄
var pos:longword;//音频窗口位置
var play:boolean=false;//音频播放状态
begin
CreateWin(w,h,blue);//建立蓝色窗口
SetTitle('display.mp3');//设定标题
audio:=LoadAudio('display.mp3');//读取音频
PlayAudio(audio);//播放音频
repeat//开始消息循环
if IsNextMsg() then//如果有新消息
begin
if IsDropFile() then//如果有拖拽文件
begin
SetTitle(GetDropFile());//设定标题为拖拽文件名
StopAudio(audio);//停止正在播放的音频
audio:=LoadAudio(GetDropFile());//读取音频
PlayAudio(audio);//播放音频
play:=true;//设定音频状态
end;
if IsKey(37) then//如果按左
SetAudioPos(audio,max(GetAudioPos(audio)-1000,0));//倒退1秒
if IsKey(39) then//如果按右
SetAudioPos(audio,min(GetAudioPos(audio)+1000,GetAudioLen(audio)));//前进1秒
if IsKey(40) then//如果按下
SetAudioVol(audio,max(GetAudioVol(audio)-100,0));//减小100音量
if IsKey(38) then//如果按上
SetAudioVol(audio,min(GetAudioVol(audio)+100,1000));//增大100音量
if IsMouseLeft() then//如果鼠标左键
SetAudioPos(audio,round(GetMousePosX()/w*GetAudioLen(audio)));//跳转音频
if IsMouseRight() or IsKey(32) then//如果鼠标右键或按空格
begin
if play then PauseAudio(audio)//如果正在播放则暂停
else ResumeAudio(audio);//否则继续播放
play:=not(play);//更改音频状态
end;
end;
if GetAudioPos(audio)=GetAudioLen(audio) then//如果已播放完毕
SetAudioPos(audio,0);//重头播放
if GetTimeR()>time+1/frame then//如果当前时间已超过一帧时间
begin
while GetTimeR()>time+1/frame do time:=time+1/frame;//增加帧数(包括跳帧)
if GetAudioLen(audio)=0 then pos:=0//如果音频长度为0(没有音频)则设音频窗口位置为0
else pos:=round(GetAudioPos(audio)/
GetAudioLen(audio)*w);//否则设定音频窗口位置
Clear();Bar(0,0,pos,100,Yellow);//绘制播放状态
DrawTextlnXY(i2s(GetAudioPos(audio))+' / '+i2s(GetAudioLen(audio)),0,0,Yellow,Blue);//输出状态
FreshWin();//刷新窗口
end;
Delay(1);//延迟1毫秒
until not(IsWin()) or (IsKey(27));//直到关闭窗口或按ESC
end.


  • ax_pokl
  • begin
    9
该楼层疑似违规已被系统折叠 隐藏此楼查看此楼
第二节 俄罗斯方块
一款简易的俄罗斯方块小游戏:
{$APPTYPE GUI}//关闭控制台
uses Display;//使用Display单元库
const w=10;//场地宽
const h=20;//场地高
var sz:longword=30;//方块大小
var frame:longword=120;//帧率
var time:real=0;//当前帧时间
var downtime:real;//下落时间
var i,j:shortint;//场地行列计数
var x,y,r,k:shortint;//当前方块状态
var bd:array[0..w-1,0..h-1]of shortint;//场地方块
const bdc:array[0..7]of longword=
($1F1F1F,$7F7F7F,$7F7FFF,$7FFF7F,$FF7F7F,$7FFFFF,$FFFF7F,$FF7FFF);//方块颜色
const bdk:array[1..7,0..3,0..3,0..3]of longword=
(
(
((0,0,0,0),(0,1,1,0),(0,1,1,0),(0,0,0,0)),
((0,0,0,0),(0,1,1,0),(0,1,1,0),(0,0,0,0)),
((0,0,0,0),(0,1,1,0),(0,1,1,0),(0,0,0,0)),
((0,0,0,0),(0,1,1,0),(0,1,1,0),(0,0,0,0))
),
(
((0,0,0,0),(2,2,2,2),(0,0,0,0),(0,0,0,0)),
((0,0,2,0),(0,0,2,0),(0,0,2,0),(0,0,2,0)),
((0,0,0,0),(2,2,2,2),(0,0,0,0),(0,0,0,0)),
((0,0,2,0),(0,0,2,0),(0,0,2,0),(0,0,2,0))
),
(
((0,0,0,0),(0,0,3,3),(0,3,3,0),(0,0,0,0)),
((0,0,3,0),(0,0,3,3),(0,0,0,3),(0,0,0,0)),
((0,0,0,0),(0,0,3,3),(0,3,3,0),(0,0,0,0)),
((0,0,3,0),(0,0,3,3),(0,0,0,3),(0,0,0,0))
),
(
((0,0,0,0),(0,4,4,0),(0,0,4,4),(0,0,0,0)),
((0,0,0,4),(0,0,4,4),(0,0,4,0),(0,0,0,0)),
((0,0,0,0),(0,4,4,0),(0,0,4,4),(0,0,0,0)),
((0,0,0,4),(0,0,4,4),(0,0,4,0),(0,0,0,0))
),
(
((0,0,0,0),(0,5,5,5),(0,5,0,0),(0,0,0,0)),
((0,0,5,0),(0,0,5,0),(0,0,5,5),(0,0,0,0)),
((0,0,0,5),(0,5,5,5),(0,0,0,0),(0,0,0,0)),
((0,5,5,0),(0,0,5,0),(0,0,5,0),(0,0,0,0))
),
(
((0,0,0,0),(0,6,6,6),(0,0,0,6),(0,0,0,0)),
((0,0,6,6),(0,0,6,0),(0,0,6,0),(0,0,0,0)),
((0,6,0,0),(0,6,6,6),(0,0,0,0),(0,0,0,0)),
((0,0,6,0),(0,0,6,0),(0,6,6,0),(0,0,0,0))
),
(
((0,0,0,0),(0,7,7,7),(0,0,7,0),(0,0,0,0)),
((0,0,7,0),(0,0,7,7),(0,0,7,0),(0,0,0,0)),
((0,0,7,0),(0,7,7,7),(0,0,0,0),(0,0,0,0)),
((0,0,7,0),(0,7,7,0),(0,0,7,0),(0,0,0,0))
)
);//方块类型
procedure DrawBlock(i,j,k:shortint);//画方块
begin Bar(i*sz,(h-j-1)*sz,sz,sz,bdc[k]);end;
procedure NewBlock();forward;
procedure Restart();//重新开始
begin
For i:=0 to w-1 do for j:=0 to h-1 do bd[i,j]:=0;//清空场地
NewBlock();//新方块
end;
function EraseLine():boolean;//消行
begin
for j:=0 to h-1 do//从最底行开始
begin
EraseLine:=true;//是满行
for i:=0 to w-1 do if bd[i,j]=0 then EraseLine:=false;//如果有洞则不是
if EraseLine then break;//如果是满行则跳出
end;
if EraseLine then//如果是满行(消行)
while j<(h-1) do//从此行开始(往上)
begin
for i:=0 to w-1 do//遍历该行
bd[i,j]:=bd[i,j+1];//上方方块掉落
j:=j+1;//继续上一行
end;
end;
procedure FixBlock();//固定方块(落底)
begin
for i:=0 to 3 do for j:=0 to 3 do//遍历方块行列
if bdk[k,r,j,i]>0 then bd[i+x,j+y]:=k;NewBlock();//如果是格子非空则画到场地
while EraseLine() do ;//消行
end;
function Overlay():boolean;//判断重叠
begin
Overlay:=false;//设非重叠
for i:=0 to 3 do for j:=0 to 3 do//遍历方块行列
if (bdk[k,r,j,i]>0) then//如果格子非空
if (i+x<0)or(i+x>=w)or(j+y<0)or(j+y>=h) then Overlay:=true//如果超出场地则重叠
else if (bd[i+x,j+y]>0) then Overlay:=true;//如果没超出场地但场地非空也重叠
end;
procedure NewBlock();//新方块
begin
x:=3;//新方块行
y:=16;//新方块列
r:=0;//新方块旋转
k:=random(7)+1;//新方块类型
if Overlay() then Restart();//如果重叠则重来
end;
function Rotate(d:shortint):boolean;//旋转
begin
r:=r+1;if r>3 then r:=0;Rotate:=not(Overlay());//尝试旋转
if not(Rotate) then r:=r-1;if r<0 then r:=3;//如果不能旋转则转回来
end;
function Move(dx,dy:shortint):boolean;//移动
begin
x:=x+dx;y:=y+dy;Move:=not(Overlay());//尝试移动
if not(Move) then begin x:=x-dx;y:=y-dy;end;//如果不能移动则移回来
if not(Move) and (dy<0) then FixBlock();//如果不能移动且下落则固定
if dy<0 then downtime:=GetTimeR();//如果下落则重置下落时间
end;
begin//主程序
Randomize();//初始化随机种子
CreateWin(w*sz,h*sz);//建立窗口
SetTitle('俄罗斯方块');//设定标题
Restart();//重新开始
repeat//开始消息循环
if IsNextMsg() then//如果有新消息
begin
if IsKey(37) then Move(-1,0);//如果按左则左移
if IsKey(39) then Move(+1,0);//如果按右则右移
if IsKey(40) then Move(0,-1);//如果按下则下落
if IsKey(38) then Rotate(1);//如果按上则旋转
if IsKey(32) then while Move(0,-1) do ;//如果按空格则下底
end;
if GetTimeR>downtime+1 then Move(0,-1);//如果超过1秒则下落
if GetTimeR()>time+1/frame then//如果当前时间已超过一帧时间
begin
while GetTimeR()>time+1/frame do time:=time+1/frame;//增加帧数(包括跳帧)
Clear();
for i:=0 to w-1 do for j:=0 to h-1 do DrawBlock(i,j,bd[i,j]);//画场地
for i:=0 to 3 do for j:=0 to 3 do if bdk[k,r,j,i]>0 then DrawBlock(i+x,j+y,k);//画当前方块
FreshWin();//刷新窗口
end;
Delay(1);//延迟1毫秒
until not(IsWin()) or (IsKey(27));//直到关闭窗口或按ESC键
end.


  • ax_pokl
  • begin
    9
该楼层疑似违规已被系统折叠 隐藏此楼查看此楼
附录
Display单元库重载表
详情请参阅display.pp,以下列出部分重载:
function max(x,y:longint):longint;inline;
function min(x,y:longint):longint;inline;
procedure MsgBox(s,title:ansistring);
procedure MsgBox(s:ansistring);
procedure Delay(t:longword);
function GetFPSR():real;
function GetFPS():longword;
function GetError():longword;
procedure CreateWin(w,h:longword;cfg,cbg:longword);
procedure CreateWin(w,h:longword;c:longword);
procedure CreateWin(w,h:longword);
procedure CreateWin(c:longword);
procedure CreateWin();
procedure FreshWin();
procedure CloseWin();
function IsWin():boolean;
procedure SetDrawProcedure(th:tprocedure);
procedure SetTitle(s:ansistring);
function GetTitle():ansistring;
function GetTimeR():real;
function GetTime():longword;
function GetWidth():longword;
function GetHeight():longword;
function GetSize():longword;
function GetPosX():longint;
function GetPosY():longint;
function GetBGColor():longword;
procedure SetBGColor(c:longword);
function GetFGColor():longword;
procedure SetFGColor(c:longword);
function GetBlue(c:longword):byte;
function GetGreen(c:longword):byte;
function GetRed(c:longword):byte;
function GetAlpha(c:longword):byte;
function GetRGB(r,g,b:byte):longword;
procedure SetFont(b:pbitmap);
procedure SetFontWidth(w:longword);
procedure SetFontHeight(h:longword);
procedure SetFontSize(w,h:longword);
procedure SetFontWeight(wg:longword);
procedure SetFontLtalic(lt:longword);
procedure SetFontUnderLine(ud:longword);
procedure SetFontStrikeOut(sk:longword);
procedure SetFontName(s:ansistring);
procedure DrawTextXY(b:pbitmap;s:ansistring;
x,y:longword;cfg,cbg:longword);
procedure DrawTextXY(s:ansistring;
x,y:longword;cfg,cbg:longword);
procedure DrawTextXY(s:ansistring;
x,y:longword;c:longword);
procedure DrawTextXY(s:ansistring;x,y:longword);
procedure DrawText(s:ansistring);
procedure DrawTextln(s:ansistring);
function GetPixel(x,y:longword):longword;
procedure SetPixel(x,y:longword;c:longword);
procedure Line(x,y:longword;w,h:longint;c:longword);
procedure Bar(x,y:longword;w,h:longint;
cfg,cbg:longword);
procedure Bar(x,y:longword;w,h:longint;c:longword);
procedure Clear(c:longword);
procedure Circle(x,y,r:longint;c:longword);
procedure Ellipse(x,y,rx,ry:longint;c:longword);
function CreateBMP(w,h:longword):pbitmap;
function LoadBMP(s:ansistring):pbitmap;
procedure ReleaseBMP(b:pbitmap);
procedure DrawBMP(bs,bd:pbitmap;
xs,ys,ws,hs,xd,yd,wd,hd:longword;c:longword);
procedure DrawBMP(b:pbitmap;
xs,ys,ws,hs,xd,yd,wd,hd:longword;c:longword);
procedure DrawBMP(b:pbitmap;
xs,ys,xd,yd,w,h:longword;c:longword);
procedure DrawBMP(b:pbitmap;
xd,yd,wd,hd:longword;c:longword);
procedure DrawBMP(b:pbitmap;
xd,yd:longword;c:longword);
procedure DrawBMP(b:pbitmap;c:longword);
procedure DrawBMP(b:pbitmap);
procedure DrawBMP(xd,yd,wd,hd:longword);
procedure DrawBMP(xd,yd:longword);
procedure DrawBMP();


2025-06-14 20:36:28
广告
  • ax_pokl
  • begin
    9
该楼层疑似违规已被系统折叠 隐藏此楼查看此楼
function IsNextMsg():boolean;
function GetNextMsg():longword;
function WaitNextMsg():longword;
function IsMsg(uM:longword):boolean;
function GetMsg(uM:longword):int64;
function WaitMsg(uM:longword):int64;
function IsKey():boolean;
function IsKey(k:longword):boolean;
function IsMouse():boolean;
function IsMouseMove():boolean;
function IsMouseLeft():boolean;
function IsMouseMiddle():boolean;
function IsMouseRight():boolean;
function IsMouseWheel():boolean;
function GetMouseWheel():longint;
function IsDropFile():boolean;
function GetMousePosX():longint;
function GetMousePosY():longint;
function LoadAudio(s:ansistring):longword;
procedure PlayAudio(id:longword;s:ansistring;
b:boolean);
procedure PlayAudio(id:longword;s:ansistring);
procedure PlayAudio(id:longword;b:boolean);
procedure PlayAudio(id:longword);
procedure PauseAudio(id:longword);
procedure ResumeAudio(id:longword);
procedure StopAudio(id:longword);
procedure ReleaseAudio(id:longword);
function GetAudioVol(id:longword):longword;
procedure SetAudioVol(id:longword;v:longword);
function GetAudioLen(id:longword):longword;
function GetAudioPos(id:longword):longword;
procedure SetAudioPos(id:longword;pos:longword);
procedure SetAudioPos(id:longword;pos:longword;
b:boolean);
Display单元库还有字符串处理子程序和大数处理(利用字符串)的子程序。
Display单元库也支持文件块状读取和文件、文件夹的操作。
此外,使用Display单元库还可以模拟鼠标和键盘的操作。
由于篇幅有限,以上有关的子程序就不做介绍了,有兴趣的同学可以自己参看Display单元库源码。
后记
使用简单的办法开发窗体应用软件和游戏一直是我的愿望,因此我便写了Display单元库。现在,这个愿望似乎已经实现了。
随着智能手机的普及,我希望Display单元库不仅局限于Windows操作系统,使得它未来能在各种Linux,Mac OS和Andriod系统上运行。
几十个子程序数百个子程序,Display单元库虽然经历了三年多的修改,其中仍有不少错误和缺点。也请各位大神多多指点。


  • 孤独的木薯
  • read
    11
该楼层疑似违规已被系统折叠 隐藏此楼查看此楼
好复杂的样子


  • AE86
  • asset
    12
该楼层疑似违规已被系统折叠 隐藏此楼查看此楼
感谢大神 前排膜拜


  • 大土豆菌
  • begin
    9
该楼层疑似违规已被系统折叠 隐藏此楼查看此楼
dd


  • ax_pokl
  • begin
    9
该楼层疑似违规已被系统折叠 隐藏此楼查看此楼
@canadaottawa


  • 炎龙
  • while
    14
该楼层疑似违规已被系统折叠 隐藏此楼查看此楼
good,好东西


2025-06-14 20:30:28
广告
  • Alex_CerMer
  • asset
    12
该楼层疑似违规已被系统折叠 隐藏此楼查看此楼
诶~这还蛮新鲜的@唧唧歪歪v587


登录百度账号

扫二维码下载贴吧客户端

下载贴吧APP
看高清直播、视频!
  • 贴吧页面意见反馈
  • 违规贴吧举报反馈通道
  • 贴吧违规信息处理公示
  • 1 2 3 下一页 尾页
  • 70回复贴,共3页
  • ,跳到 页  
<<返回pascal吧
分享到:
©2025 Baidu贴吧协议|隐私政策|吧主制度|意见反馈|网络谣言警示