صفر و یک

{ This is a tutorial program about mouse useage in Pascal enviroment.
For fix runtime error 200, you can download the patch from:
http://www.procomputer.blogfa.com
If you had any other problem and question you can cantact me.
Author: Heresh bashiri
Email : Heresh86@gamil.com }


uses graph, drivers, crt;

VAR
mouse: TEvent;{TEvent value can take mouse & keyboard event. for more
information see help->index, and type TEvent. }
GraphicDriver, GraphicMode: integer;{ use for InitGraph procedure. }
mainAssign: integer;{ every button has one keyAssign. when one of }
{ them click, it change the mainAssign to it's keyAssing }
const
chLen = 8; { each charcter length eqaul to 8 pixel. }
chHi = 10; { each charcter Hight eqaul to 10 pixel. }
FIX = 8;{ to fix the mouse position we need it to plus whit mouseWhere.}

function IntToStr(num: Longint): String;
{ Convert any integer type to a string }
var
tempStr: string[11];
begin
Str(num, tempStr);
IntToStr := tempStr;
end;

procedure drawButton(x1, y1, x2, y2, color: integer; title: string);
var
Xcenter, Ycenter: integer;
titleLen, oldColor: integer;
fillInfo: fillSettingsType;
begin
getFillSettings(fillInfo);{ we save the fill style in fillInfo to set it
back at the end of procedure so other parts of program wont be effective
by changing the fillStyle. }
oldColor:= getColor;{ we use the oldColor same as fillInfo. }
setFillStyle(1, 0);
setColor(color);
bar(x2, y1+5, x2+5, y2+5); { shadow }
bar(x1+5, y2, x2+5, y2+5); { shadow }
rectangle(x1, y1, x2, y2); { border }
rectangle(x1+2, y1+2, x2-2, y2-2);{ border }
titleLen:= length(title)*chLen; { title length in pixels. }
Xcenter:= (x2-x1-titleLen) div 2;{ we find the center of button to type
the title. }
Ycenter:= (y2-y1- chHi div 2) div 2;{ like the above line find Ycenter }
outTextXY(x1+Xcenter, y1+Ycenter, title);
setFillStyle(fillInfo.pattern, fillInfo.color);{ set the fillStyle to
what it was befor procedure }
setColor(oldColor);
end;

procedure button(x1, y1, x2, y2, keyAssign: integer);
begin
if(mouseWhere.x*8 > x1)and(mouseWhere.x*8 < x2) and
(mouseWhere.y*8 > y1)and(mouseWhere.y*8 < y2) then
mainAssign:= keyAssign;
end;

procedure drawScreen;
var
fillInfo: fillSettingsType;
begin
getFillSettings(fillInfo);
setFillStyle(1, 1); { set background color and style }
bar(0, 0, 640, 480); { screen background }
rectangle(10, 10, 630, 470); { screen border }
outTextXY(20, 20, 'Mouse position:');
outTextXY(20, 450, 'Press any key to exit');
drawButton(500, 100, 600, 130, 15, 'Circle');
drawButton(500, 135, 600, 165, 15, 'Rectangle');
drawButton(500, 170, 600, 200, 15, 'Refresh');
drawButton(500, 205, 600, 235, 15, 'Exit');
setFillStyle(fillInfo.pattern, fillInfo.color);
end;

procedure showMousePosition(Xscreen, Yscreen:integer);
{ This Procedure show the mouse position in X & Y of screen.
(X between 0-640, Y between 0-480) in pixel. }
var
fillInfo: fillSettingsType;
begin
if mouse.what = 4 then{ mouse.what return four when mouse move }
{ mouse }
begin
getFillSettings(fillInfo);
setFillStyle(1, 1);
bar(Xscreen, Yscreen, Xscreen+6*chLen, Yscreen+2*chHi);
outTextXY(Xscreen, Yscreen, 'X= ');
outTextXY(Xscreen+3*chLen, Yscreen, IntToStr(mouseWhere.X*FIX));
outTextXY(Xscreen, Yscreen+chHi, 'Y= ');
outTextXY(Xscreen+3*chLen, Yscreen+chHi, IntTostr(mouseWhere.Y*FIX));
setFillStyle(fillInfo.pattern, fillInfo.color);
end;
end;

procedure checkAssign(mainAssign: integer);
{ check whiche button click }
begin
case mainAssign of
1: arc(100,100,0,360,20); { Circle Button }
2: rectangle(80,130,120,190);{ Rectangle Button }
3: drawScreen; { Refresh Button }
4:begin { Exit Button }
closeGraph;
halt;
end;
end; { case end}
end;


{main program}
BEGIN
GraphicDriver := Detect;
InitGraph(GraphicDriver, GraphicMode, '');
drawScreen;
showMouse;
InitEvents;
repeat { Keep program running until key press}
mainAssign:= 0;
GetMouseEvent(mouse);
showMousePosition(40, 40);
if mouse.what = 2 then { mouse.what return two when mouse click}
begin
button(500, 100, 600, 130, 1);
button(500, 135, 600, 165, 2);
button(500, 170, 600, 200, 3);
button(500, 205, 600, 235, 4);
end;
checkAssign(mainAssign);
until keypressed;

closeGraph;
end.