program OS; uses dos, crt, graph, dmouse, strings; type TObj=record left, top, bottom, right: integer; color: word; down: boolean; name: string[20]; end; Ticons=record notempty: boolean; name: string[20]; ftype: word; color: word; end; Tmenuitems=record name: string[20]; fwd: word; end; var grDriver: Integer; grMode: Integer; oldi, oldj: word; gi,gj: word; itimer: word; cdmi: word; omi,omj, mpos, mi: array[0..4] of integer; visible: array[0..4] of boolean; cmi,mbwd: array[0..4] of integer; di,odi: word; mfocused,omf,mcur,mfwd: word; focused: (desktop, startbar, startmenu, dtopmenu); Dtop, SBar, sbutton, smenu, dmenu: TObj; Icons: array[0..18,0..16] of Ticons; Menuitems: array[0..4,0..20] of Tmenuitems; Dmenuitems: array[0..10] of Tmenuitems; hh,mm,ss,hnd: word; y,m,d: word; const DESK=1; START=2; SBUT=3; SMEN=4; DMEN=10; procedure dmenuadd(name: string); begin dmenuitems[cdmi].name:=name; inc(cdmi); end; procedure redmenu(n,color: integer); begin setfillstyle(1,color); with dmenu do begin bar(gi*40, gj*40+n*20, 40*(gi+3), gj*40+(n+1)*20); rectangle(gi*40, gj*40+n*20, 40*(gi+3), gj*40+(n+1)*20); outtextxy(40*gi+7,gj*40+(n+1)*20-14, dmenuitems[n].name); end; end; procedure retime; var trg: string[2]; day:word; begin setcolor(black); setfillstyle(1,smenu.color); getdate(y,m,d,day); bar(sbar.right-80,sbar.top+2,sbar.right-2,sbar.bottom-2); rectangle(sbar.right-80,sbar.top+2,sbar.right-2,sbar.bottom-2); if (getmousex>=sbar.right-80)and(getmousey>=sbar.top+2)and (getmousex<=sbar.right-2)and(getmousey<=sbar.bottom-2) then begin str(d,trg); if d<10 then trg:='0'+trg; outtextxy(sbar.right-75+2,sbar.top+7,trg+'.'); str(m,trg); if m<10 then trg:='0'+trg; outtextxy(sbar.right-75+2+25,sbar.top+7,trg+'.'); str(y,trg); if y<10 then trg:='0'+trg; outtextxy(sbar.right-75+2+50,sbar.top+7,trg); end else begin str(hh,trg); if hh<10 then trg:='0'+trg; outtextxy(sbar.right-75+2,sbar.top+7,trg+':'); str(mm,trg); if mm<10 then trg:='0'+trg; outtextxy(sbar.right-75+2+25,sbar.top+7,trg+':'); str(ss,trg); if ss<10 then trg:='0'+trg; outtextxy(sbar.right-75+2+50,sbar.top+7,trg); end; end; procedure timer; begin gettime(hh,mm,ss,hnd); if itimer<>ss then begin retime; itimer:=ss; end; end; procedure remitem(foc,n,m :integer; color: word; starty: integer); begin setfillstyle(1,color); with smenu do begin bar((40*3)*foc, starty-m*20, (40*3)*(foc+1), starty-m*20-20); rectangle((40*3)*foc, starty-m*20, (40*3)*(foc+1), starty-m*20-20); outtextxy(40*3*foc+7,starty-m*20-14, menuitems[n][m].name); if menuitems[n][m].fwd>0 then outtextxy((40*3)*(foc+1)-10,starty-m*20-14, '>'); end; end; procedure addmenuitem(n: integer; name: string; ex: word); begin menuitems[n][cmi[n]].name:=name; menuitems[n][cmi[n]].fwd:=ex; cmi[n]:=cmi[n]+1; end; procedure RepaintIco(i,j: integer); begin setcolor(dtop.color); setfillstyle(1,dtop.color); bar(i*40,j*40,(i+1)*40,(j+1)*40); if (icons[i][j].notempty) then begin setcolor(white); setfillstyle(1,icons[i][j].color); bar3d(i*40+3,j*40+3+4,i*40+32,j*40+32+4,4,true); end; setcolor(Black); end; procedure Repaint(target: TObj; ftype: integer); var i,j, len, cnt: integer; begin if sbutton.down=true then sbutton.color:=darkgray else sbutton.color:=lightgray; with target do begin setcolor(Black); setfillstyle(1,color); case ftype of 1: begin bar(left, top, right, bottom); oldi:=255; oldj:=255; repaint(sbar,2); repaint(sbutton,3); retime; for i:=0 to 15 do for j:=0 to 10 do repaintico(i,j); end; 2: begin bar(left, top, right, bottom); rectangle(left, top, right, bottom); end; 3: begin bar(left, top, right, bottom); rectangle(left, top, right, bottom); setfillstyle(1,RED); bar(left+3, top+3, left+8,top+8); rectangle(left+3, top+3, left+8,top+8); setfillstyle(1,yellow); bar(left+3, top+8, left+8,top+13); rectangle(left+3, top+8, left+8,top+13); setfillstyle(1,BLUE); bar(left+8, top+3, left+13,top+8); rectangle(left+8, top+3, left+13,top+8); setfillstyle(1,Green); bar(left+8, top+8, left+13,top+13); rectangle(left+8, top+8, left+13,top+13); outtextxy(left+10*2,top+5,'START'); end; 4: begin for i:=0 to 4 do begin omi[i]:=255; omj[i]:=255; end; setcolor(Black); setfillstyle(1,color); for i:=0 to cmi[0]-1 do remitem(0,mfocused,i,smenu.color,smenu.bottom); end; DMEN: begin for i:=0 to cdmi-1 do redmenu(i,dmenu.color); end; end; end; end; procedure InitObj(ftype, tl, tt, tr, tb: integer; tc: word); var target: Tobj; i,j:word; begin with target do begin left:=tl; top:=tt; right:=tr; bottom:=tb; color:=tc; end; case ftype of DESK:begin itimer:=255; dtop:=target; for i:=0 to 16 do for j:=0 to 16 do icons[i][j].notempty:=false; end; START: sbar:=target; SBUT: Sbutton:=target; SMEN: begin Smenu:=target; for i:=0 to 4 do omi[i]:=255; end; DMEN: begin dmenu:=target; end; end; end; procedure showhint(i,j: integer); var ftype: string[20]; begin setcolor(BLACK); setfillstyle(1,YELLOW); bar(i*40,j*40,(i+3)*40,(j+3)*40); rectangle(i*40,j*40,(i+3)*40,(j+3)*40); if icons[i-1][j-1].ftype=0 then ftype:='Text File'; outtextxy(i*40+2,j*40+2,'-Type:'); outtextxy(i*40+9*2,j*40+9+2,ftype); outtextxy(i*40+2,j*40+2+20,'-Name:'); outtextxy(i*40+9*2,j*40+9+2+20,icons[i-1][j-1].name); end; function onobj(target: Tobj): boolean; begin onobj:=false; with target do if (getmousex>=target.left)and(getmousex<=target.right) and(getmousey>=target.top)and(getmousey<=target.bottom) then onobj:=true; {((getmousexsmenu.right) or(getmouseysmenu.bottom))} end; function onmenu(n: integer): boolean; begin onmenu:=false; if (getmousex>(40*3)*(n))and(getmousex<(40*3)*(n+1))and (getmousey>mpos[mfocused]-20*cmi[mcur])and (getmousey(40*gi))and(getmousex<(40*(gi+3)))and (getmousey>(gj*40))and (getmousey<(gj*40+20*cdmi)) then ondmenu:=true; end; procedure dtopprocess; var i,j: integer; begin gi:=trunc(getmousex/40) ; gj:=trunc(getmousey/40) ; if mouseclicked(2) then begin repaint(Dmenu,DMEN); focused:=dtopmenu; odi:=255; end; if (gi<>oldi)or(gj<>oldj) then begin if oldj*40=480-40*3 then begin repaint(sbar,START); repaint(sbUTTON,SBUT) end; end; end; if gj*40mfocused then begin if omf>mfocused then begin clearmenu(omf,2); mcur:=mbwd[omf]; end else begin mbwd[mfocused]:=mcur; mcur:=mfwd; end; omf:=mfocused; end; end; procedure selmenuitem; var l: word; begin chmf; mpos[0]:=smenu.bottom; if (onmenu(mfocused))and(visible[mfocused]=true) then begin mi[mfocused]:=trunc((mpos[mfocused]-getmousey)/20); if (menuitems[mcur][mi[mfocused]].fwd>0) then begin mfwd:=menuitems[mcur][mi[mfocused]].fwd; if (visible[mfocused+1]=false) then begin mpos[mfocused+1]:=mpos[mfocused]-(mi[mfocused])*20; for l:=0 to cmi[mfwd]-1 do remitem(mfocused+1,mfwd,l,smenu.color,mpos[mfocused+1]); visible[mfocused+1]:=true; end; end else if (visible[mfocused+1]=true) then clearmenu(mfocused+1,1); if (omi[mfocused]<>mi[mfocused]) then begin if (visible[mfocused+1]=true) then clearmenu(mfocused+1,1); remitem(mfocused,mcur,omi[mfocused],smenu.color,mpos[mfocused]); remitem(mfocused,mcur,mi[mfocused],darkgray,mpos[mfocused]); omi[mfocused]:=mi[mfocused]; end; end; end; procedure Sprocess; var i: word; begin if (mouseclicked(1)) then begin if (onobj(sbutton)) then begin sbutton.down:=true; mfocused:=0; mcur:=0; mfwd:=0; repaint(Dtop,1); for i:=0 to 4 do mbwd[i]:=0; visible[0]:=true; end; end; end; procedure Smenuprocess; var i,j: integer; begin if (mouseclicked(1))and(not onmenu(mfocused))and(not onobj(sbutton)) then begin if (getmousey>460) then begin focused:=startbar; sbutton.down:=false; repaint(Dtop,1); end else begin focused:=desktop; sbutton.down:=false; repaint(Dtop,1); end; end else selmenuitem; end; procedure dmenproc; begin if ondmenu then begin if mouseclicked(1) then begin focused:=desktop; repaint(dtop,1) end; di:=trunc((getmousey-gj*40)/20); if (di<>odi) then begin redmenu(di,DARKGRAY); redmenu(odi,Dmenu.color); odi:=di; end; end else begin if mouseclicked(1)or(mouseclicked(2)) then begin focused:=desktop; repaint(dtop,1) end; end; end; begin addmenuitem(0,'Menu 1-1',0); addmenuitem(0,'Menu 1-2',0); addmenuitem(0,'Menu 1-3',1); addmenuitem(0,'Menu 1-4',2); addmenuitem(1,'Menu 2-1-1',0); addmenuitem(1,'Menu 2-1-2',0); addmenuitem(1,'Menu 2-1-3',0); addmenuitem(1,'Menu 2-1-4',0); addmenuitem(1,'Menu 2-1-5',3); addmenuitem(2,'Menu 2-2-1',4); addmenuitem(2,'Menu 2-2-2',0); addmenuitem(2,'Menu 2-2-3',0); addmenuitem(2,'Menu 2-2-4',0); addmenuitem(2,'Menu 2-2-5',0); addmenuitem(2,'Menu 2-2-6',0); addmenuitem(3,'Menu 3-1-1',0); addmenuitem(3,'Menu 3-1-2',0); addmenuitem(3,'Menu 3-1-3',0); addmenuitem(4,'Menu 3-2-1',0); addmenuitem(4,'Menu 3-2-2',0); addmenuitem(4,'Menu 3-2-3',0); addmenuitem(4,'Menu 3-2-4',0); addmenuitem(4,'Menu 3-2-5',0); dmenuadd('Hello World!'); dmenuadd('one!'); dmenuadd('two!'); dmenuadd('three!'); dmenuadd('four!'); initObj(DESK,0,0,640,480,BLUE); initObj(START,0,460,640,480,GREEN); initObj(SBUT,sbar.left+2,sbar.top+2,sbar.left+40*2-2,sbar.bottom-2,LIGHTGRAY); initObj(SMEN,0,0,(40*3)*5,460-1,LIGHTGRAY); initObj(DMEN,0,0,(40*3)*5,460-1,LIGHTGRAY); grDriver := VGAlo; InitGraph(grDriver, grMode,'../bgi'); repaint(dtop,1); createcur(0,0,getmaxx,getmaxy); addico(1,1,'1.txt', 0,LIGHTGRAY); addico(1,2,'2.txt', 0,YELLOW); addico(1,3,'3.txt', 0,RED); addico(2,1,'4.txt', 0,BROWN); addico(2,2,'5.txt', 0,black); addico(2,3,'6.txt', 0,GREEN); addico(10,1,'7.txt', 0,GREEN); addico(11,1,'8.txt', 0,GREEN); {****************************************************************} repeat if (getmousey>460) then begin if (focused=desktop) then focused:=startbar; if focused<>startmenu then if sbutton.down=true then begin focused:=startmenu; repaint(SMENu,4); repaint(Sbutton,SBUT); end; end else begin if (focused<>dtopmenu)and(focused<>startmenu)and(focused<>desktop) then begin focused:=desktop; sbutton.down:=false; repaint(Sbutton,SBUT); end; end; case focused of desktop: dtopprocess; startbar: sprocess; startmenu: smenuprocess ; dtopmenu: dmenproc; end; timer; movecur; until(keypressed); readkey; {****************************************************************} deletecur; CloseGraph; end.