有没有从 DOS 过来的 PASCAL 或 C 高手？

[chendaiyin]

不只在 DOS 下如何用 PASCAL 或 C 做有图形界面的程序? 像 Edit.exe 一样，用哪些语句？好像 PASCAL 和 C 都没有图形语句？

[kylix2001]

我是从DOS过来的，但我不是高手。：）

TP6带有一个库，好像叫什么vision 之类的，太久了，忘了。：（
可以编出和TP6的IDE差不多的编辑器。

[XGZ]

Edit 不是用的图形模式，PASCAL 有一个图形单元，只要引用Graphics就行了（不知拼错了没有）

[chendaiyin]

请问谁有这些资料?

[BCB]

看你用的什么版本的PASCAL与C了

[enlightenment]

uses dos,crt,graph,bgilink;


procedure showmode; {初始化图形系统.}
var
graphdrive:integer;
graphmode:integer;
errcode:integer;
begin
{自动设定显示模式.}
graphdrive:=detect;
initgraph(graphdrive,graphmode,'');
errcode:=graphresult;
if errcode<>grok then
writeln('Graphics error:', grapherrormsg(errcode));
end;

[enlightenment]

{作图}{其中变量根据自己情况确定}

setlinestyle(solidln,0,thickwidth); {底面蓝色方条.}
setcolor(white);
rectangle((a div 16),(B DIV 48),((a*15) div 16),220);
setfillstyle(1,lightblue);
bar((a div 16),(b div 48),((a*15) div 16),220);

setlinestyle(solidln,0,normwidth);{画蓝色椭园.}
setcolor(white);
setfillstyle(1,blue);
sector(320,100,0,360,270,100);
setcolor(white);
LINE(50,100,590,100);

[enlightenment]

让你疯掉！


procedure graPH001; {随机彩色点.}
begin
PUTpixel(random(a),random(b),RANDOM(MAXCOLOR));
end;

procedure graPH002; {画随机单彩色线.}
begin
{作图}
{画随机单彩色过中心射线.}
line(RANDOM(a-1)+1,RANDOM(b-1)+1,RANDOM(a-1)+1,RANDOM(b-1)+1);
end;

procedure graph003; {画随机多彩色过中心射线.}
var
p,q:integer;
begin
{作图}
color:=getcolor;
color:=(color+1)mod(maxcolor+1);
setcolor(color);
p:=round((a-1)/2);q:=round((b-1)/2);
line(p,q,RANDOM(a-1)+1,RANDOM(b-1)+1);
delay(50)
end;

procedure graph004; {画随机多彩色过双中心线段.不同色}
var
c,d,m,n,p,q:integer;
begin
color:=getcolor;
color:=(color+1)mod(maxcolor+1);
setcolor(color);
p:=round((a-1)/4);q:=round((b-1)/2);
c:=RANDOM(a-1)+1;d:=RANDOM(b-1)+1;
line(2*p-c,2*q-d,c,d);
color:=getcolor;
color:=(color+1)mod(maxcolor+1);
setcolor(color);
m:=round((a-1)*3/4);n:=round((b-1)/2);
c:=RANDOM(a-1)+1;d:=RANDOM(b-1)+1;
line(2*m-c,2*n-d,c,d);
delay(20)
end;

procedure graph005; {画随机多彩色过三中心线段.同色}
var
c,d,e,f,m,n,p,q:integer;
begin
setcolor(random(maxcolor));
p:=round((a-1)/6);q:=round((b-1)/2);
c:=RANDOM(a-1)+1;d:=RANDOM(b-1)+1;
line(2*p-c,2*q-d,c,d);
setcolor(random(maxcolor));
m:=round((a-1)*5/6);n:=round((b-1)/2);
c:=RANDOM(a-1)+1;d:=RANDOM(b-1)+1;
line(2*m-c,2*n-d,c,d);
setcolor(random(maxcolor));
e:=round((a-1)/2);f:=round((b-1)/2);
c:=RANDOM(a-1)+1;d:=RANDOM(b-1)+1;
line(2*e-c,2*f-d,c,d);
delay(50)
end;

procedure graph006; {画随机多彩色过四中心线段.不同色}
var
c,d,e,f,g,h,m,n,p,q:integer;
begin
color:=getcolor;
color:=(color+1)mod(maxcolor+1);
setcolor(color);
p:=round((a-1)/4);q:=round((b-1)/4);
c:=RANDOM(a-1)+1;d:=RANDOM(b-1)+1;
line(2*p-c,2*q-d,c,d);
color:=getcolor;
color:=(color+1)mod(maxcolor+1);
setcolor(color);
m:=round((a-1)*3/4);n:=round((b-1)/4);
c:=RANDOM(a-1)+1;d:=RANDOM(b-1)+1;
line(2*m-c,2*n-d,c,d);
color:=getcolor;
color:=(color+1)mod(maxcolor+1);
setcolor(color);
e:=round((a-1)/4);f:=round((b-1)*3/4);
c:=RANDOM(a-1)+1;d:=RANDOM(b-1)+1;
line(2*e-c,2*f-d,c,d);
color:=getcolor;
color:=(color+1)mod(maxcolor+1);
setcolor(color);
g:=round((a-1)*3/4);h:=round((b-1)*3/4);
c:=RANDOM(a-1)+1;d:=RANDOM(b-1)+1;
line(2*g-c,2*h-d,c,d);
end;

procedure graph007; {画随机多彩色线段.}
begin
color:=getcolor;
color:=(color+1)mod(maxcolor+1);
setcolor(color);
line(RANDOM(a-1)+1,RANDOM(b-1)+1,RANDOM(a-1)+1,RANDOM(b-1)+1);
delay(50)
end;

procedure graph008; {画随机圆.}
var
c,d:integer;
begin
setcolor(random(maxcolor));
c:=random(a);d:=random(b);
circle(c,d,random(60)); {横,纵座标及半径.}
delay(100)
end;

procedure graph009; {画随机圆弧.}
var
c,d,m,n:integer;
begin
setcolor(random(maxcolor));
c:=random(a);d:=random(b);
m:=random(360);n:=random(360)+m;
arc(c,d,m,n,random(60));
delay(200)
end;

procedure graph010; {画随机椭圆.}
var
c,d,m,n:integer;
begin
setcolor(random(maxcolor));
c:=random(a);d:=random(b);
m:=random(60);n:=random(60);
ellipse(c,d,0,360,m,n);
delay(100)
end;

procedure graph011; {画随机椭圆弧.}
var
c,d,m,n,p,q:integer;
begin
setcolor(random(maxcolor));
c:=random(a);d:=random(b);
m:=random(60);n:=random(60);
p:=random(360);q:=random(360)+p;
ellipse(c,d,p,q,m,n);
delay(200)
end;

procedure graph012; {画随机圆弧面.}
var
c,d,p,q:integer;
begin
setcolor(random(maxcolor));
p:=random(360);q:=random(360)+p;
c:=random(a);d:=random(b);
setfillstyle(RANDOM(11),random(maxcolor));
pieslice(c,d,p,q,random(60));
delay(250)
END;

procedure graph013; {画随机椭圆弧面.}
var
c,d,p,q,M,N:integer;
begin
setcolor(random(maxcolor));
p:=random(360);q:=random(360)+p;
c:=random(a);d:=random(b);
m:=random(100);n:=random(100);
setfillstyle(random(11),random(maxcolor));
sector(c,d,p,q,m,n);
delay(250)
END;

procedure graph014; {画随机多彩色过中心线段,同心圆.不同色}
var
c,d,p,q:integer;
begin
color:=getcolor;
color:=(color+1)mod(maxcolor+1);
setcolor(color);
p:=round((a-1)/2);q:=round((b-1)/2);
c:=RANDOM(a-1)+1;d:=RANDOM(b-1)+1;
line(2*p-c,2*q-d,c,d);
circle(p,q,random(400)); {横,纵座标及半径.}
END;

procedure graph015; {画随机多彩色过四中心线段,同心圆.不同色}
var
c,d,E,F,G,H,M,N,p,q:integer;
begin
color:=getcolor;
color:=(color+1)mod(maxcolor+1);
setcolor(color);
p:=round((a-1)/4)+40;q:=round((b-1)/4);
c:=RANDOM(a-1)+1;d:=RANDOM(b-1)+1;
line(2*p-c,2*q-d,c,d);
circle(p,q,random(120)); {横,纵座标及半径.}
color:=getcolor;
color:=(color+1)mod(maxcolor+1);
setcolor(color);
m:=round((a-1)*3/4)-40;n:=round((b-1)/4);
c:=RANDOM(a-1)+1;d:=RANDOM(b-1)+1;
line(2*m-c,2*n-d,c,d);
circle(m,n,random(120)); {横,纵座标及半径.}
color:=getcolor;
color:=(color+1)mod(maxcolor+1);
setcolor(color);
e:=round((a-1)/4)+40;f:=round((b-1)*3/4);
c:=RANDOM(a-1)+1;d:=RANDOM(b-1)+1;
line(2*e-c,2*f-d,c,d);
circle(e,f,random(120)); {横,纵座标及半径.}
color:=getcolor;
color:=(color+1)mod(maxcolor+1);
setcolor(color);
g:=round((a-1)*3/4)-40;h:=round((b-1)*3/4);
c:=RANDOM(a-1)+1;d:=RANDOM(b-1)+1;
line(2*g-c,2*h-d,c,d);
circle(g,h,random(120)) {横,纵座标及半径.}
END;

procedure graph016; {画随机矩形.}
var
c,d,m,n:integer;
procedure swape(var x,y:integer); {将两位数由小到大排列,用于画矩形.}
var
t:integer;
begin
if x>y then
begin
t:=x;x:=y;y:=t
end
end;
begin
c:=random(a);m:=random(a);d:=random(b);n:=random(b);
swape(c,m);
swape(d,n);
setcolor(random(maxcolor));
rectangle(c,d,m,n);
delay(200)
end;

procedure graph017; {画随机填色矩形.}
var
c,d,M,N,p,q:integer;
procedure swape(var x,y:integer); {将两位数由小到大排列,用于画矩形.}
var
t:integer;
begin
if x>y then
begin
t:=x;x:=y;y:=t
end
end;
begin
setcolor(random(maxcolor));
c:=random(a);m:=random(a);d:=random(b);n:=random(b);
p:=round((c+m)/2);q:=round((d+n)/2);
swape(c,m);
swape(d,n);
rectangle(c,d,m,n);
setfillstyle(RANDOM(11),random(maxcolor));
bar(c+3,d+3,m-3,n-3);
delay(500)
END;


呵呵~~

[lastleo]

呵呵，何苦来着？

[enlightenment]

这叫“诲（毁）人不倦”啊！：）




再给你写技巧——鼠标控制（注意：非WIN32模式）！



UNIT U_MOUSE;
INTERFACE
PROCEDURE MOUSE_DETECT; {MOUSE_DETECT探测并显示鼠标}
PROCEDURE MOUSE_show; {MOUSE_SHOW 画图之后,鼠标不被图形覆盖}
PROCEDURE MOUSE_HIDDEN; {MOUSE_HIDDEN隐藏鼠标}
PROCEDURE MOUSE_GOTOXY(X,Y:INTEGER);
function mouse_x:integer; {MOUSE_X获得鼠标X座标}
function mouse_y:integer; {MOUSE_Y获得鼠标Y座标}
function mouse_click:integer; {MOUSE_CLICK获得鼠标击键状态}
FUNCTION MOUSE_IN_BOX(A,B,C,D:INTEGER):BOOLEAN;{A,B,C,D is the box range}
IMPLEMENTATION
USES DOS,CRT;

{///////////////////////////////////////////////////////////////////////////}
{MOUSE_DETECT探测并显示鼠标}
{MOUSE_SHOW 画图之后,鼠标不被图形覆盖}
{MOUSE_HIDDEN隐藏鼠标}
{MOUSE_X获得鼠标X座标}
{MOUSE_Y获得鼠标Y座标}
{MOUSE_CLICK获得鼠标击键状态}
{///////////////////////////////////////////////////////////////////////////}

PROCEDURE MOUSE_DETECT;
VAR
REGS:REGISTERS;
BEGIN
REGS.AX:=1;
INTR($33,REGS);
REGS.AX:=4;
REGS.CX:=320;
REGS.DX:=140;
intr($33,regs);
END;

PROCEDURE MOUSE_show;
VAR
REGS:REGISTERS;
BEGIN
REGS.AX:=3;
INTR($33,REGS);
REGS.AX:=4;
intr($33,regs);
END;

PROCEDURE MOUSE_GOTOXY(X,Y:INTEGER);
VAR
REGS:REGISTERS;
BEGIN
REGS.AX:=4;
REGS.CX:=X;
REGS.DX:=Y;
INTR($33,REGS);
END;


PROCEDURE MOUSE_HIDDEN;
VAR
REGS:REGISTERS;
BEGIN
REGS.AX:=2;
INTR($33,REGS);
END;

function mouse_x:integer;
VAR
REGS:REGISTERS;
BEGIN
REGS.AX:=3;
INTR($33,REGS);
mouse_x:=regs.cx;
END;

function mouse_y:integer;
VAR
REGS:REGISTERS;
BEGIN
REGS.AX:=3;
INTR($33,REGS);
mouse_y:=regs.dx;
END;

function mouse_click:integer;
VAR
REGS:REGISTERS;
BEGIN
REGS.AX:=3;
INTR($33,REGS);
mouse_click:=regs.bx;
END;

FUNCTION MOUSE_IN_BOX(A,B,C,D:INTEGER):BOOLEAN;{A,B,C,D is the box range}
var mousex,mousey:integer;
begin
mousex:=mouse_x;
mousey:=mouse_y;
IF (MOUSEX>A) AND (MOUSEX<C) THEN
BEGIN
IF (MOUSEY>B) AND (MOUSEY<D) THEN
MOUSE_IN_BOX:=TRUE
ELSE
MOUSE_IN_BOX:=FALSE;
END
ELSE
MOUSE_IN_BOX:=FALSE;
END;

END.




还有，

控制扬声器发声！分8个音阶，多、来、米、发、少、啦、希已经计算好，延时自己调。酷不酷？喝~~喝~~





USES CRT;


PROCEDURE SOUND_PLAY(PLAT,CORD,STAGE,change_num:INTEGER);
BEGIN
IF CORD=1 THEN
case stage of
1:begin sound(round(66*(1+CHANGE_NUM /10))); end;
2:begin sound(round(74*(1+CHANGE_NUM /10)));end;
3:begin sound(round(83*(1+CHANGE_NUM /10)));end;
4:begin sound(round(88*(1+CHANGE_NUM /10)));end;
5:begin sound(round(98*(1+CHANGE_NUM /10)));end;
6:begin sound(round(111*(1+CHANGE_NUM /10)));end;
7:begin sound(round(125*(1+CHANGE_NUM /10)));end;
end;

IF CORD=2 THEN
case stage of
1:begin sound(round(130*(1+CHANGE_NUM /10)));end;
2:begin sound(round(146*(1+CHANGE_NUM /10)));end;
3:begin sound(round(164*(1+CHANGE_NUM /10)));end;
4:begin sound(round(174*(1+CHANGE_NUM /10)));end;
5:begin sound(round(195*(1+CHANGE_NUM /10)));end;
6:begin sound(round(218*(1+CHANGE_NUM /10)));end;
7:begin sound(round(245*(1+CHANGE_NUM /10)));end;
end;

IF CORD=3 THEN
case stage of
1:begin sound(round(261*(1+CHANGE_NUM /10)));end;
2:begin sound(round(293*(1+CHANGE_NUM /10)));end;
3:begin sound(round(329*(1+CHANGE_NUM /10)));end;
4:begin sound(round(348*(1+CHANGE_NUM /10)));end;
5:begin sound(round(391*(1+CHANGE_NUM /10)));end;
6:begin sound(round(439*(1+CHANGE_NUM /10)));end;
7:begin sound(round(493*(1+CHANGE_NUM /10)));end;
end;



IF CORD=4 THEN
case stage of
1:begin sound(round(522*(1+CHANGE_NUM /10)));end;
2:begin sound(round(586*(1+CHANGE_NUM /10)));end;
3:begin sound(round(658*(1+CHANGE_NUM /10)));end;
4:begin sound(round(697*(1+CHANGE_NUM /10)));end;
5:begin sound(round(782*(1+CHANGE_NUM /10)));end;
6:begin sound(round(878*(1+CHANGE_NUM /10)));end;
7:begin sound(round(985*(1+CHANGE_NUM /10)));end;
end;


IF CORD=5 THEN
case stage of
1:begin sound(round(1044*(1+CHANGE_NUM /10)));end;
2:begin sound(round(1172*(1+CHANGE_NUM /10)));end;
3:begin sound(round(1315*(1+CHANGE_NUM /10)));end;
4:begin sound(round(1393*(1+CHANGE_NUM /10)));end;
5:begin sound(round(1564*(1+CHANGE_NUM /10)));end;
6:begin sound(round(1756*(1+CHANGE_NUM /10)));end;
7:begin sound(round(1970*(1+CHANGE_NUM /10)));end;
end;


IF CORD=6 THEN
case stage of
1:begin sound(round(2088*(1+CHANGE_NUM /10)));end;
2:begin sound(round(2343*(1+CHANGE_NUM /10)));end;
3:begin sound(round(2630*(1+CHANGE_NUM /10)));end;
4:begin sound(round(2787*(1+CHANGE_NUM /10)));end;
5:begin sound(round(3128*(1+CHANGE_NUM /10)));end;
6:begin sound(round(3512*(1+CHANGE_NUM /10)));end;
7:begin sound(round(3942*(1+CHANGE_NUM /10)));end;
end;

IF CORD=7 THEN
case stage of
1:begin sound(round(4176*(1+CHANGE_NUM /10)));end;
2:begin sound(round(4687*(1+CHANGE_NUM /10)));end;
3:begin sound(round(5261*(1+CHANGE_NUM /10)));end;
4:begin sound(round(5574*(1+CHANGE_NUM /10)));end;
5:begin sound(round(6257*(1+CHANGE_NUM /10)));end;
6:begin sound(round(7023*(1+CHANGE_NUM /10)));end;
7:begin sound(round(7883*(1+CHANGE_NUM /10)));end;
end;

IF CORD=8 THEN
case stage of
1:begin sound(round(8352*(1+CHANGE_NUM /10)));end;
2:begin sound(round(9374*(1+CHANGE_NUM /10)));end;
3:begin sound(round(10523*(1+CHANGE_NUM /10)));end;
4:begin sound(round(11148*(1+CHANGE_NUM /10)));end;
5:begin sound(round(12514*(1+CHANGE_NUM /10)));end;
6:begin sound(round(14046*(1+CHANGE_NUM /10)));end;
7:begin sound(round(15766*(1+CHANGE_NUM /10)));end;
end;

if cord=0 then nosound;

end;


以前认为都没有用的东西了，谁要就帖给谁！


谁还要？看我有没有？：）

[enlightenment]

对了，需要说明的，上面的鼠标控制程序，需要事先在DOS模式下加载鼠标驱动！：）


哼~~！这些个“遥想当年”的东西！

[jxd_2001]

靠，不要搞了，我受不了了，老古董了！

要开展览会吗？

不过挺经典的。

[testnet]

以前我多想要的代码，但现在没用了

[chendaiyin]

有了这些东西后如何控制输入的焦点在屏幕上的坐标呢？
如何得到用户输入呢？

[xiaoya]

hehe, 这几段程序好眼熟啊 :-)
是不是 demo 里的？

[AP]

我有 Turbo Pascal 7.0

[enlightenment]

To xiaoya(快乐的人请举手)：以上程序段皆是本人早期自己编写整理的！

图形函数段是当时练习时编的！

鼠标驱动是根据C语言的程序改过来的！

扬声器程序的频率是自己当时用计算器一个一个算出来的！

（请）不要看人挑担子不觉着累！冷嘲热讽的！（即便是些陈年旧事）

[神奇的肚肚]

enlightenment
我们如此的相似

[chendaiyin]

哪儿有TP的单元下载？图形单元，DOS单元，等等...

[xiaoya]

sorry. 我只是随便说说。其实以上代码我以前也写过的
当时还是一点 windows 编程都不会，真惨啊，画个 button 还要搞到头大 :-)
不过至少那时候学会了怎么编程:-)

[chendaiyin]

哪儿有Pascal的单元下载？图形单元，DOS单元，等等...