REM ========================================================
REM           SCPRTL20.DLL demonstration script.
REM                   Working with fonts
REM (C) 1999 by Alex Vakulenko, http://www.vakcer.com/oberon
REM ========================================================

#include "scprtl20.csi"

' Script private declarations
DECLARE SUB BuildPreview
DECLARE SUB CollectFonts

GLOBAL ImageFile$,Size&,Style&,Font$,Color&,Back&,FontFlag&,Bold&,Italic&,Underline&,StrikeOut&
GLOBAL Fonts$(1),Sample$
FontFlag&=7
Bold=0
Italic=0
Underline=0
StrikeOut=0
Font="Arial"
Size=24
Sample$=""

' BMP image file to store previewa
ImageFile$=GetTempFolder()+"demo_temp.bmp"

GLOBAL Colors$(8),ColorVal&(8)
Colors(1)="Black"
ColorVal(1)=RGB(0,0,0)
Colors(2)="Red"
ColorVal(2)=RGB(255,0,0)
Colors(3)="Green"
ColorVal(3)=RGB(0,255,0)
Colors(4)="Blue"
ColorVal(4)=RGB(0,0,255)
Colors(5)="Cyan"
ColorVal(5)=RGB(0,255,255)
Colors(6)="Magenta"
ColorVal(6)=RGB(255,0,255)
Colors(7)="Yellow"
ColorVal(7)=RGB(255,255,0)
Colors(8)="While"
ColorVal(8)=RGB(255,255,255)

' ========== Main Dialog description
BEGIN DIALOG OBJECT MainDialog 209, 187, "Choose Font Example", SUB MainDlgFunc
	GROUPBOX  3, 4, 78, 119, .GroupBox2, "Font"
	LISTBOX  5, 13, 73, 68, .Fonts
	CHECKBOX  7, 84, 50, 10, .TTF, "TrueType"
	CHECKBOX  7, 97, 50, 10, .T1, "Type 1"
	CHECKBOX  7, 110, 50, 10, .Raster, "Raster"
	GROUPBOX  85, 4, 69, 67, .GroupBox3, "Style"
	CHECKBOX  91, 15, 50, 10, .Bold, "Bold"
	CHECKBOX  91, 29, 50, 10, .Italic, "Italic"
	CHECKBOX  91, 42, 50, 10, .Underline, "Underline"
	CHECKBOX  91, 55, 50, 10, .Strikeout, "Strikeout"
	TEXT  86, 77, 20, 8, .Text3, "Size:"
	SPINCONTROL  109, 75, 34, 12, .Size
	TEXT  146, 77, 8, 8, .Text4, "pt"
	TEXT  87, 94, 20, 8, .Text5, "Color:"
	DDLISTBOX  109, 92, 45, 80, .Colors
	TEXT  87, 113, 20, 8, .Text7, "Back:"
	DDLISTBOX  109, 110, 45, 80, .Back
	TEXT  3, 130, 30, 8, .Text6, "Sample:"
	TEXTBOX  35, 127, 121, 13, .Sample
	GROUPBOX  3, 142, 152, 42, .GroupBox1, "Preview"
	IMAGE  6, 151, 145, 30, .Preview
	OKBUTTON  161, 8, 40, 14, .OK1
	CANCELBUTTON  161, 29, 40, 14, .Cancel1
END DIALOG

'===== Dialog box even handler
SUB MainDlgFunc(BYVAL ControlID%, BYVAL EventCode%)
SELECT CASE EventCode
	CASE 0 
		BuildPreview ' Create initial font preview
	CASE 1
		SELECT CASE ControlID
			CASE MainDialog.Size.GETID()
				Size=MainDialog.Size.GetValue()
				BuildPreview
			CASE MainDialog.Sample.GETID()
				Sample=MainDialog.Sample.GETTEXT()
				BuildPreview
		END SELECT
	CASE 2
		SELECT CASE ControlID
			CASE MainDialog.Fonts.GETID(),MainDialog.Colors.GETID(),MainDialog.Back.GETID()
				Font$=Fonts(MainDialog.Fonts.GetSelect())
				Color=ColorVal(MainDialog.Colors.GetSelect())
				Back=ColorVal(MainDialog.Back.GetSelect())
				BuildPreview
			CASE MainDialog.TTF.GETID(),MainDialog.T1.GETID(),MainDialog.Raster.GETID()
				TTF&=MainDialog.TTF.GETVALUE()
				T1&=MainDialog.T1.GETVALUE()
				Raster&=MainDialog.Raster.GETVALUE()
				FontFlag=TTF+T1*2+Raster*4
				CollectFonts
				BuildPreview
			CASE MainDialog.Bold.GETID(),MainDialog.Italic.GETID(), \\
				MainDialog.Underline.GETID(),MainDialog.StrikeOut.GETID()
				Bold=MainDialog.Bold.GETVALUE()
				Italic=MainDialog.Italic.GETVALUE()
				Underline=MainDialog.Underline.GETVALUE()
				StrikeOut=MainDialog.StrikeOut.GETVALUE()
				BuildPreview
		END SELECT
END SELECT
END SUB

'=========================== Main Script Body =====================================

' Initialize all dialog controls
MainDialog.Preview.SetStyle 288 ' Use this style to center image in control rather than stretching it to fit.
MainDialog.Size.SETMINRANGE 1
MainDialog.Size.SETVALUE Size
CollectFonts
MainDialog.Colors.SetArray Colors
MainDialog.Colors.SetSelect 1
Color=ColorVal(1)
MainDialog.Back.SetArray Colors
MainDialog.Back.SetSelect 8
Back=ColorVal(8)
MainDialog.TTF.SetThreeState FALSE
MainDialog.T1.SetThreeState FALSE
MainDialog.Raster.SetThreeState FALSE
MainDialog.Bold.SetThreeState FALSE
MainDialog.Italic.SetThreeState FALSE
MainDialog.Underline.SetThreeState FALSE
MainDialog.StrikeOut.SetThreeState FALSE
MainDialog.TTF.SetValue (FontFlag AND 1)
MainDialog.T1.SetValue (FontFlag AND 2)\2
MainDialog.Raster.SetValue (FontFlag AND 4)\4
MainDialog.Bold.SetValue Bold
MainDialog.Italic.SetValue Italic
MainDialog.Underline.SetValue Underline
MainDialog.StrikeOut.SetValue StrikeOut
MainDialog.Sample.SetText Sample

DIALOG MainDialog ' Display dialog box
STOP

' ====== Build a list of installed fonts
SUB CollectFonts
	n&=EnumSystemFonts(FontFlag)	' Get the number of installed fonts
							' FontFlag is a sum of the following values:
							'  1 - List TrueType fonts
							'  2 - List Type 1 fonts
							'  4 - List Raster fonts
	REDIM Fonts(n) ' Resize the array to hold all the fonts
	sel&=1
	FOR i&=1 to n
 		GetFontName i-1,Fonts(i) ' Get the name of the font, addressed by its index
		IF Fonts(i)=Font THEN sel=i
	NEXT i
	MainDialog.Fonts.SETARRAY Fonts
	MainDialog.Fonts.SETSELECT sel
	Font$=Fonts(sel)
END SUB

' ======= Create preview of the selected font
SUB BuildPreview
cx&=220 ' Preview window dimensions in pixels
cy&=50
s$=Sample
IF s$="" THEN s$=Font$ ' If sample string is empty, display font name instead
BeginImage cx,cy,Back ' Create an empty image in memory
	ImageGetTextSize s$,x&,y&,Font,Size,400+300*Bold,Italic,Underline,StrikeOut 
		' Calculate the string size in pixels (returned in X& and Y&). Required to center the string
	ImageTextOut s$,(cx-x)\2,(cy-y)\2,Font,Size,400+300*Bold,Italic,Underline,StrikeOut,Color
		' Draw the text string in the center of image
EndImage ImageFile$ ' Save the image to file and free memory
MainDialog.Preview.SetImage ImageFile ' Display the image in dialog box IMAGE control
END SUB