Windows benzeri Form yapmaya ne dersiniz - Programlama- Zamansız Tartışma Platform

Yσкє∂!¢! · 30-12-07, 19:32 Çevrimiçi

uses crt,graph,dos;
var
k,gd,gm:integer;

x1,y1,x2,y2:integer;
type

form=object
procedure create(x,y,w,h:integer;acaption,atexttring);
procedure ref(newx,newy:integer;newcap,newtexttring);
procedure refresh;
function onclick:boolean;
private
x1:integer;
y1:integer;
x2:integer;
y2:integer;
width:integer;
height:integer;
captiontring;
texttring;
kindtring;
index:integer;
end;
const
derinlik=0;
ara=2;
baslikcubuguuzunlugu=15;
var
form1:form;
regs:registers;
mousex,mousey,eskix,eskiy:integer;
buton,eski_buton:byte;
size:word;
pointer;
label
bas;
procedure form.create;
var
k:integer;
begin
x1:=x;
y1:=y;
width:=w;
height:=h;
x2:=x+width;
y2:=y+height;
caption:=acaption;
text:=atext;
refresh;
end;

procedure form.ref;
begin
x1:=x1+newx;
y1:=y1+newy;
x2:=x1+width;
y2:=y1+height;
caption:=newcap;
text:=newtext;
end;

procedure form.refresh;
var
k:integer;
begin
setfillstyle(1,7);
bar(x1,y1,x2,y2);
for k:=0 to derinlik do
begin
setcolor(15);
line(x1+k,y1+k,x2-k,y1+k);
line(x1+k,y1+k,x1+k,y2-k);
setcolor(8);
line(x1+k,y2-k,x2-k,y2-k);
line(x2-k,y1+k,x2-k,y2-k);
end;
setfillstyle(1,1);

bar(x1+derinlik+ara,y1+derinlik+ara,x2-derinlik-ara,y1+derinlik+baslikcubuguuzunlugu);
setcolor(15);
outtextxy(x1+derinlik+ara+ara,((baslikcubuguuzunlu gu-8) div
2)+y1+derinlik+ara,caption);
outtextxy(((x2-x1-length(caption)*8) div 2)+x1,(((y2-y1-8) div
2)+y1),text);
{concount:=concount+1;
controls[concount].x1:=x1;
controls[concount].y1:=y1;
controls[concount].x2:=x2;
controls[concount].y2:=y2;
controls[concount].caption:=caption;
controls[concount].text:=";
controls[concount].kind:='Form';
controls[concount].index:=concount;}
end;

function form.onclick;
begin
if (mousex>=x1) and (mousex<=x2) and (mousey>=y1) and (mousey<=y2)
and (buton=1) then onclick:=true
else
onclick:=false;
end;

procedure kkk;
begin
regs.ax:=0000;
intr($33,regs);
regs.ax:=0001;
intr($33,regs);

end;

procedure mouse;
var
xstr,ystrtring;
ch:char;
begin

eskix:=mousex;
eskiy:=mousey;
eski_buton:=buton;
regs.ax:=$003;
intr($33,regs);
mousex:=regs.cx;
mousey:=regs.dx;
buton:=regs.bx;
{k:=mousex+mousey;}

end;

begin
detectgraph(gd,gm);
initgraph(gd,gm,");
size:=imagesize(0,0,300,100);
getmem(p,size);

setbkcolor(3);
for k:=0 to 100 do
begin
setcolor(random(15));
circle(240,240,k);
end;

getimage(100,100,400,200,p^);
form1.create(100,100,300,100,'Caption','Text');
x1:=100;
y1:=100;
x2:=400;
y2:=200;
kkk;
repeat
mouse ;
if form1.onclick then
begin
while buton=1 do
begin
mouse;
if (mousex=eskix) and (mousey=eskiy) then goto bas;
regs.ax:=$002;
intr($33,regs);
putimage(x1,y1,p^,normalput);
regs.ax:=$003;
intr($33,regs);
form1.ref(mousex-eskix,mousey-eskiy,form1.caption,form1.text);
x1:=form1.x1;
y1:=form1.y1;
x2:=form1.x2;
y2:=form1.y2;
if x1<0 then x1:=0;
if y1<0 then y1:=0;
if x2>getmaxx then x2:=getmaxx;
if y2>getmaxy then y2:=getmaxy;
regs.ax:=$002;
intr($33,regs);
getimage(x1,y1,x2,y2,p^);

form1.refresh;

bas:

end;
kkk;
end;

until keypressed;

freemem(p,size);
end.

Not : tp\BGI klasöründeki EGAVGA.BGI dosyasini tp\BIN klasörüne kopyalamayi unutmayin.

30-12-07, 19:32 Çevrimiçi	#1
Dekan Yσкє∂!¢! Huzur Pınarı Genel Mesajlar: 5.500 Teşekkür etti: 1.453 Teşekkür edildi: 2.037 RepForum Gücü: 65 Forum Puanı:22907 Ruhsal Durumum:	Windows benzeri Form yapmaya ne dersiniz uses crt,graph,dos; var k,gd,gm:integer; x1,y1,x2,y2:integer; type form=object procedure create(x,y,w,h:integer;acaption,atexttring); procedure ref(newx,newy:integer;newcap,newtexttring); procedure refresh; function onclick:boolean; private x1:integer; y1:integer; x2:integer; y2:integer; width:integer; height:integer; captiontring; texttring; kindtring; index:integer; end; const derinlik=0; ara=2; baslikcubuguuzunlugu=15; var form1:form; regs:registers; mousex,mousey,eskix,eskiy:integer; buton,eski_buton:byte; size:word; pointer; label bas; procedure form.create; var k:integer; begin x1:=x; y1:=y; width:=w; height:=h; x2:=x+width; y2:=y+height; caption:=acaption; text:=atext; refresh; end; procedure form.ref; begin x1:=x1+newx; y1:=y1+newy; x2:=x1+width; y2:=y1+height; caption:=newcap; text:=newtext; end; procedure form.refresh; var k:integer; begin setfillstyle(1,7); bar(x1,y1,x2,y2); for k:=0 to derinlik do begin setcolor(15); line(x1+k,y1+k,x2-k,y1+k); line(x1+k,y1+k,x1+k,y2-k); setcolor(8); line(x1+k,y2-k,x2-k,y2-k); line(x2-k,y1+k,x2-k,y2-k); end; setfillstyle(1,1); bar(x1+derinlik+ara,y1+derinlik+ara,x2-derinlik-ara,y1+derinlik+baslikcubuguuzunlugu); setcolor(15); outtextxy(x1+derinlik+ara+ara,((baslikcubuguuzunlu gu-8) div 2)+y1+derinlik+ara,caption); outtextxy(((x2-x1-length(caption)*8) div 2)+x1,(((y2-y1-8) div 2)+y1),text); {concount:=concount+1; controls[concount].x1:=x1; controls[concount].y1:=y1; controls[concount].x2:=x2; controls[concount].y2:=y2; controls[concount].caption:=caption; controls[concount].text:="; controls[concount].kind:='Form'; controls[concount].index:=concount;} end; function form.onclick; begin if (mousex>=x1) and (mousex<=x2) and (mousey>=y1) and (mousey<=y2) and (buton=1) then onclick:=true else onclick:=false; end; procedure kkk; begin regs.ax:=0000; intr($33,regs); regs.ax:=0001; intr($33,regs); end; procedure mouse; var xstr,ystrtring; ch:char; begin eskix:=mousex; eskiy:=mousey; eski_buton:=buton; regs.ax:=$003; intr($33,regs); mousex:=regs.cx; mousey:=regs.dx; buton:=regs.bx; {k:=mousex+mousey;} end; begin detectgraph(gd,gm); initgraph(gd,gm,"); size:=imagesize(0,0,300,100); getmem(p,size); setbkcolor(3); for k:=0 to 100 do begin setcolor(random(15)); circle(240,240,k); end; getimage(100,100,400,200,p^); form1.create(100,100,300,100,'Caption','Text'); x1:=100; y1:=100; x2:=400; y2:=200; kkk; repeat mouse ; if form1.onclick then begin while buton=1 do begin mouse; if (mousex=eskix) and (mousey=eskiy) then goto bas; regs.ax:=$002; intr($33,regs); putimage(x1,y1,p^,normalput); regs.ax:=$003; intr($33,regs); form1.ref(mousex-eskix,mousey-eskiy,form1.caption,form1.text); x1:=form1.x1; y1:=form1.y1; x2:=form1.x2; y2:=form1.y2; if x1<0 then x1:=0; if y1<0 then y1:=0; if x2>getmaxx then x2:=getmaxx; if y2>getmaxy then y2:=getmaxy; regs.ax:=$002; intr($33,regs); getimage(x1,y1,x2,y2,p^); form1.refresh; bas: end; kkk; end; until keypressed; freemem(p,size); end. Not : tp\BGI klasöründeki EGAVGA.BGI dosyasini tp\BIN klasörüne kopyalamayi unutmayin. Şahit olsun Kainat, Alemler şahit olsun . Titreyen sesin ile Yüregin şahit olsun. Çok Yakın Güzel Günler,Bir Kez Daha Ufka Bak, Hep Semaya Açtıgın,Ellerin Şahit Olsun. Ö(lürsem)S(ebebi)S(ensin) Deli Var YakalaYın

Konu Seçenekleri
Yazdırılabilir Sümü Göster Sayfayı E-Mail'le gönder