Unit MyTPU; INTERFACE {----------------------------------------} Procedure InitVGA; Procedure CloseVGA; Procedure Mouse; Function GetValue(text:string;x1,y1,MinValue,MaxValue:integer):integer; {----------------------------------------------} IMPLEMENTATION {----------------------------------------------} Uses CRT,Graph,F_Mouse; {--------------------------------------} Procedure VGADRV;external; {$L vgadrv.obj} {---------------------------------------} Procedure InitVGA; Var Gd,Gm:Integer; Begin if RegisterBGIDriver(@VGADRV) < 1 then Halt(1); Gd := VGA;Gm:=VGAhi; InitGraph(Gd, Gm,''); if GraphResult <> grOk then begin Write(GraphErrorMsg(GraphResult)); Halt(1); end; end{InitVGA}; {--------------------------------------} Procedure CloseVGA; begin CloseGraph end;{CloseVGA} {--------------------------------------------} Procedure MOUSE; begin if not InitMouse then begin WriteLn('Unable to Init mouse'); Halt(1); end else ShowMouse; end;{MOUSE} {------------------------------------------} Function GetValue(text:string;x1,y1,MinValue,MaxValue:integer):integer; Var p1 : pointer; s1 : word; x,y,StartX,StartY,xk : integer; k : real; length : integer; ch : char; st : string; value : byte; code : integer; {--------------------------------------} Procedure EnterVal; Begin SetFillStyle(CloseDotFill,LightBlue); Bar(Startx,starty,Startx+length,Starty+60); SetColor(White); Rectangle(Startx,starty,Startx+length,Starty+60); SetColor(LightGray); SetTextJustify(CenterText,TopText); OutTextXY(startx + length div 2, Starty+15,Text); SetColor(Yellow); SetTextJustify(LeftText,TopText); x := Startx+20; y := Starty+35; st := ''; Repeat ch := readkey; if ch <> #13 then begin st := st + ch; OutTextXY(x,y,ch); if x < startx+length-40 then x := x + TextWidth(ch); end; Until ch = #13; End;{EnterVal} {-----------------------------------} Procedure WriteBox(x,y:Integer); Begin SetColor(White); SetFillStyle(CloseDotFill,LightBlue); Bar(StartX+length div 2 - x,StartY+30-y,StartX+length div 2+x,StartY+30+y); Rectangle(StartX+length div 2 - x,StartY+30-y,StartX+length div 2+x,StartY+30+y); Delay(5); End;{WriteBox} {-------------------------------------} Begin If MinValue > MaxValue then begin GetValue := 0; Exit; end; length := TextWidth(text) + 50; StartX := x1 - length div 2; StartY := y1 - 30; if length div 2 > x1 then startX := 2; if y1 - 30 < 2 then Starty := 1; if length div + x1 > 639 then Startx := 639 - length; if y1 + 30 > 479 then StartY := 419; s1 := ImageSize(Startx,Starty,startx+length,Starty+60); GetMem(p1,s1); GetImage(Startx,Starty,startx+length,Starty+60,p1^); value :=0 ; xk := 1; k :=60/length; for xk := 1 to length div 2 do WriteBox(xk,round(xk*k)); Repeat EnterVal; val(st,value,code); Until (code = 0) and (value in [MinValue..MaxValue]); PutImage(Startx,Starty,p1^,NormalPut); GetValue := Value; End;{GetValue} {----------------------------------------------} end.