REM ======================================================== REM SCPRTL10.DLL demonstration script. REM Working with shapes REM (C) 1998 by Alex Vakulenko, http://www.vakcer.com/oberon REM ======================================================== ' ================== SCORTL10.DLL public functions ============== DECLARE FUNCTION BeginImage& LIB "scprtl10.dll" (BYVAL x&,BYVAL y&,BYVAL Color&) ALIAS "BeginImage" DECLARE SUB EndImage LIB "scprtl10.dll" (BYVAL Path$) ALIAS "EndImage" DECLARE SUB ImageFillRect LIB "scprtl10.dll" (BYVAL x1&,BYVAL y1&,BYVAL x2&,BYVAL y2&,BYVAL Color&) ALIAS "ImageFillRect" DECLARE SUB ImageLine LIB "scprtl10.dll" (BYVAL x1&,BYVAL y1&,BYVAL x2&,BYVAL y2&,BYVAL Width&,BYVAL Color&) ALIAS "ImageLine" DECLARE SUB ImageRectangle LIB "scprtl10.dll" (BYVAL x1&,BYVAL y1&,BYVAL x2&,BYVAL y2&,BYVAL Width&,BYVAL Color&) ALIAS "ImageRectangle" DECLARE SUB ImageEllipse LIB "scprtl10.dll" (BYVAL x1&,BYVAL y1&,BYVAL x2&,BYVAL y2&,BYVAL Width&,BYVAL Color&) ALIAS "ImageEllipse" DECLARE SUB ImageFillEllipse LIB "scprtl10.dll" (BYVAL x1&,BYVAL y1&,BYVAL x2&,BYVAL y2&,BYVAL Color&) ALIAS "ImageFillEllipse" DECLARE SUB ImagePolyline LIB "scprtl10.dll" (BYVAL n&,BYREF pt&,BYVAL w&,BYVAL Color&) ALIAS "ImagePolyline" DECLARE SUB ImageFillPolyline LIB "scprtl10.dll" (BYVAL n&,BYREF pt&,BYVAL Color&) ALIAS "ImageFillPolyline" ' =========== End of SCORTL10.DLL public function declarations ============== DECLARE FUNCTION RGB&(r&,g&,b&) ' Script private declarations DECLARE SUB BuildPreview GLOBAL ImageFile$,h&,v&,EllX&,EllY&,EllW&,EllH&,RectX&,RectY&,RectW&,RectH&,XX&,YY&,HH&,WW& GLOBAL TriX&,TriY&,TriH&,TriW&,Filled&,Grid& XX&=10 YY&=10 HH&=100 WW&=100 EllX&=XX EllY&=YY EllW=50 EllH=25 RectW=40 RectH=40 RectX=XX+WW-RectW RectY=YY+(HH-RectH)\2 TriW=40 TriH=40 TriX=XX+(WW-TriW)\2 TriY=YY+HH-TriH Filled=1 Grid=1 ' BMP image file to store previewa ImageFile$=GetTempFolder()+"demo_temp.bmp" ' ========== Main Dialog description BEGIN DIALOG OBJECT MainDialog 164, 160, "Align Objects", SUB MainDlgFunc GROUPBOX 6, 30, 52, 102, .GroupBox4, "Vertical" CHECKBOX 13, 43, 38, 10, .Top, "Top" CHECKBOX 13, 78, 38, 10, .VCenter, "Center" CHECKBOX 13, 113, 38, 10, .Bottom, "Bottom" GROUPBOX 6, 3, 153, 25, .GroupBox5, "Horizontal" CHECKBOX 13, 13, 38, 10, .Left, "Left" CHECKBOX 66, 13, 38, 10, .HCenter, "Center" CHECKBOX 119, 13, 35, 10, .Right, "Right" GROUPBOX 62, 30, 97, 102, .GroupBox1, "Preview" IMAGE 68, 39, 85, 77, .Preview CHECKBOX 68, 118, 55, 10, .Filled, "Filled shapes" CHECKBOX 126, 118, 28, 10, .Grid, "Grid" OKBUTTON 34, 141, 40, 14, .OK1 CANCELBUTTON 91, 141, 40, 14, .Cancel1 END DIALOG '===== Dialog box even handler SUB MainDlgFunc(BYVAL ControlID%, BYVAL EventCode%) SELECT CASE EventCode CASE 0 BuildPreview ' Create preview CASE 2 SELECT CASE ControlID CASE MainDialog.Top.GETID() TO MainDialog.Bottom.GETID() v&=0 IF ControlID<>MainDialog.Top.GETID() THEN MainDialog.Top.SetValue 0 ELSE v=MainDialog.Top.GetValue() ENDIF IF ControlID<>MainDialog.VCenter.GETID() THEN MainDialog.VCenter.SetValue 0 ELSE v=MainDialog.VCenter.GetValue()*2 ENDIF IF ControlID<>MainDialog.Bottom.GETID() THEN MainDialog.Bottom.SetValue 0 ELSE v=MainDialog.Bottom.GetValue()*3 ENDIF BuildPreview CASE MainDialog.Left.GETID() TO MainDialog.Right.GETID() h&=0 IF ControlID<>MainDialog.Left.GETID() THEN MainDialog.Left.SetValue 0 ELSE h=MainDialog.Left.GetValue() ENDIF IF ControlID<>MainDialog.HCenter.GETID() THEN MainDialog.HCenter.SetValue 0 ELSE h=MainDialog.HCenter.GetValue()*2 ENDIF IF ControlID<>MainDialog.Right.GETID() THEN MainDialog.Right.SetValue 0 ELSE h=MainDialog.Right.GetValue()*3 ENDIF BuildPreview CASE MainDialog.Filled.GETID(),MainDialog.Grid.GETID() Filled=MainDialog.Filled.GetValue() Grid=MainDialog.Grid.GetValue() BuildPreview END SELECT END SELECT END SUB '=========================== Main Script Body ===================================== ' Initialize all dialog controls MainDialog.Preview.SetStyle 288 MainDialog.Top.SetThreeState FALSE MainDialog.VCenter.SetThreeState FALSE MainDialog.Bottom.SetThreeState FALSE MainDialog.Left.SetThreeState FALSE MainDialog.HCenter.SetThreeState FALSE MainDialog.Right.SetThreeState FALSE MainDialog.Filled.SetThreeState FALSE MainDialog.Filled.SetValue Filled MainDialog.Grid.SetThreeState FALSE MainDialog.Grid.SetValue Grid DIALOG MainDialog ' Display dialog box STOP ' ======= Create preview of the selected font SUB BuildPreview DIM Tri&(4,2) ' Triangle points coordinates BeginImage 120,120,RGB(255,255,255) ' Create an empty image in memory IF Grid THEN ' Draw Grid ImageRectangle XX,YY,XX+WW-1,YY+HH-1,1,RGB(200,200,200) ImageLine XX,YY+HH\2,XX+WW-1,YY+HH\2,1,RGB(200,200,200) ImageLine XX+WW\2,YY,XX+WW\2,YY+HH-1,1,RGB(200,200,200) END IF rx&=RectX ry&=RectY ex&=EllX ey&=EllY tx&=TriX ty&=TriY SELECT CASE h ' Horizontal alignment CASE 1 ' Left rx=XX ex=XX tx=XX CASE 2 ' Center rx=XX+(WW-RectW)\2 ex=XX+(WW-EllW)\2 tx=XX+(WW-TriW)\2 CASE 3 ' Right rx=XX+WW-RectW ex=XX+WW-EllW tx=XX+WW-TriW END SELECT SELECT CASE v ' Vertical alignment CASE 1 ' Top ry=YY ey=YY ty=YY CASE 2 ' Center ry=YY+(HH-RectH)\2 ey=YY+(HH-EllH)\2 ty=YY+(HH-TriH)\2 CASE 3 ' Bottom ry=YY+HH-RectH ey=YY+HH-EllH ty=YY+HH-TriH END SELECT Tri(1,1)=tx Tri(1,2)=ty+TriH-1 Tri(2,1)=tx+TriW\2 Tri(2,2)=ty Tri(3,1)=tx+TriW-1 Tri(3,2)=ty+TriH-1 IF Filled=0 THEN ' Not filled shapes Tri(4,1)=Tri(1,1) ' 4th point to close unfilled triangle Tri(4,2)=Tri(1,2) ImageRectangle rx,ry,rx+RectW-1,ry+RectH-1,1,RGB(0,0,255) ImageEllipse ex,ey,ex+EllW-1,ey+EllH-1,1,RGB(255,0,0) ImagePolyline 4,Tri(1,1),1,RGB(0,200,0) ELSE ' Filled Shapes ImageFillRect rx,ry,rx+RectW-1,ry+RectH-1,RGB(0,0,255) ImageFillEllipse ex,ey,ex+EllW-1,ey+EllH-1,RGB(255,0,0) ImageFillPolyline 3,Tri(1,1),RGB(0,200,0) END IF EndImage ImageFile$ ' Save the image to file and free memory MainDialog.Preview.SetImage ImageFile ' Display the image in dialog box IMAGE control END SUB FUNCTION RGB&(r&,g&,b&) RGB=(r AND 255)+((g AND 255)<<8)+((b AND 255)<<16) END FUNCTION