{$ifdef WIN32} {$mode tp} {$endif} uses crt, graph; const max_buttons = 10; btn_width = 100; btn_height = 45; btn_between = 5; type taction = procedure; trect_object = object xst, yst, xfn, yfn: integer; constructor init(x_st, y_st, x_fn, y_fn: integer); end; ptbutton = ^tbutton; tbutton = object(trect_object) caption: string; action: taction; constructor init(x_st, y_st, x_fn, y_fn: integer; s: string; act: taction); procedure draw(b: boolean); virtual; procedure press(is_pressed: boolean); virtual; private function get_xst: integer; virtual; function get_yst: integer; virtual; function get_xfn: integer; virtual; function get_yfn: integer; virtual; end; ptbutton_rect = ^tbutton_rect; tbutton_rect = object(tbutton) constructor init(x_st, y_st, x_fn, y_fn: integer; s: string; act: taction); end; ptbutton_romb = ^tbutton_romb; tbutton_romb = object(tbutton) constructor init(x_st, y_st, x_fn, y_fn: integer; s: string; act: taction); private function get_xst: integer; virtual; function get_yst: integer; virtual; function get_xfn: integer; virtual; function get_yfn: integer; virtual; end; tpanel = object(trect_object) save_x: integer; buttons_count: integer; buttons: array[1 .. max_buttons] of ptbutton; constructor init(x_st, y_st, x_fn, y_fn: integer); procedure Insert(b: ptbutton); procedure draw(n: integer); procedure zoom; procedure unzoom; function count: integer; end; var panel: tpanel; deepth: integer; {$ifndef WIN32} {$f+} {$endif} procedure actTask; begin outtextxy(getmaxx div 2, getmaxy - 50, 'OOP example'); end; procedure actZoom; begin cleardevice; panel.zoom; end; procedure actUnzoom; begin cleardevice; panel.unzoom; end; procedure actGrow; begin inc(deepth); end; {$ifndef WIN32} {$f-} {$endif} constructor trect_object.init(x_st, y_st, x_fn, y_fn: integer); begin xst := x_st; yst := y_st; xfn := x_fn; yfn := y_fn; end; constructor tbutton.init(x_st, y_st, x_fn, y_fn: integer; s: string; act: taction); begin inherited init(x_st, y_st, x_fn, y_fn); caption := s; action := act; end; procedure tbutton.draw(b: boolean); var pts: array[1 .. 5] of pointtype; begin pts[1].X := get_xst; pts[1].Y := yst; pts[2].X := xfn; pts[2].Y := get_yst; pts[3].X := get_xfn; pts[3].Y := yfn; pts[4].X := xst; pts[4].Y := get_yfn; pts[5] := pts[1]; if b then setfillstyle(solidfill, lightgray) else setfillstyle(solidfill, lightgreen); setcolor(white); drawpoly(5, pts); {$ifdef WIN32} floodfill(xst + ((xfn - xst) div 2), yst + ((yfn - yst) div 2), white); {$else} fillpoly(4, pts); {$endif} press(false); settextjustify(centertext, centertext); outtextxy(xst + ((xfn - xst) div 2), yst + ((yfn - yst) div 2), caption) end; procedure tbutton.press(is_pressed: boolean); const color: array[boolean, 1 .. 2] of integer = ( (white, darkgray), (darkgray, white) ); var i: integer; begin setcolor(color[is_pressed, 1]); for i := 0 to deepth do begin { 1 } moveto(get_xst + i, yst + i); lineto(xfn - i, get_yst + i); lineto(get_xfn - i, yfn - i); end; setcolor(color[is_pressed, 2]); for i := 0 to deepth do begin { 1 } moveto(get_xst + i, yst + i); lineto(xst + i, get_yfn - i); lineto(get_xfn - i, yfn - i); end; end; function tbutton.get_xst: integer; begin get_xst := xst; end; function tbutton.get_yst: integer; begin get_yst := yst; end; function tbutton.get_xfn: integer; begin get_xfn := xfn; end; function tbutton.get_yfn: integer; begin get_yfn := yfn; end; constructor tbutton_rect.init(x_st, y_st, x_fn, y_fn: integer; s: string; act: taction); begin inherited init(x_st, y_st, x_fn, y_fn, s, act); end; constructor tbutton_romb.init(x_st, y_st, x_fn, y_fn: integer; s: string; act: taction); begin inherited init(x_st, y_st, x_fn, y_fn, s, act); end; function tbutton_romb.get_xst: integer; begin get_xst := xst + ((xfn - xst) div 2); end; function tbutton_romb.get_yst: integer; begin get_yst := yst + ((yfn - yst) div 2); end; function tbutton_romb.get_xfn: integer; begin get_xfn := xst + ((xfn - xst) div 2); end; function tbutton_romb.get_yfn: integer; begin get_yfn := yst + ((yfn - yst) div 2); end; constructor tpanel.init(x_st, y_st, x_fn, y_fn: integer); begin inherited init(x_st, y_st, x_fn, y_fn); buttons_count := 0; deepth := 0; save_x := xfn; end; procedure tpanel.insert(b: ptbutton); begin if buttons_count < max_buttons then begin inc(b^.xst, xst); inc(b^.yst, yst); inc(buttons_count); buttons[buttons_count] := b; end; end; procedure tpanel.draw(n: integer); var i: integer; begin (* setfillstyle(solidfill, lightgray); bar(xst, yst, xfn, yfn); *) setcolor(white); rectangle(xst, yst, xfn, yfn); for i := 1 to buttons_count do buttons[i]^.draw(n = i); end; procedure tpanel.zoom; begin save_x := xfn; xfn := getmaxx - 10; end; procedure tpanel.unzoom; begin xfn := save_x; end; function tpanel.count: integer; begin count := buttons_count; end; var gdriver, gmode, errcode: integer; finished: boolean; x, current: integer; ch: char; begin gdriver := detect; initgraph(gdriver, gmode, ''); errcode := graphresult; if errcode <> grOk then begin writeln('graph error: ', grapherrormsg(errcode)); readln; halt(100); end; panel.init(10, 10, 10 + 4 * (btn_width + btn_between) + btn_between, 10 + btn_height + btn_between); x := btn_between; panel.insert(new(ptbutton_rect, init(x, btn_between, x + btn_width, 2 * btn_between + btn_height, 'task', actTask))); inc(x, btn_width + btn_between); panel.insert(new(ptbutton_romb, init(x, btn_between, x + btn_width, 2 * btn_between + btn_height, 'zoom', actZoom))); inc(x, btn_width + btn_between); panel.insert(new(ptbutton_rect, init(x, btn_between, x + btn_width, 2 * btn_between + btn_height, 'unzoom', actUnzoom))); inc(x, btn_width + btn_between); panel.insert(new(ptbutton_romb, init(x, btn_between, x + btn_width, 2 * btn_between + btn_height, 'grow', actGrow))); current := 1; finished := false; repeat panel.draw(current); ch := readkey; case ch of #27: finished := true; #13: begin panel.buttons[current]^.press(true); panel.buttons[current]^.action; end; #0: case readkey of #77: if current = panel.count then current := 1 else inc(current); #75: if current = 1 then current := panel.count else dec(current); end; end; delay(2); until finished = true; closegraph; end.