Ver Fonte

* Added Makefiles
* added FV specific units and objects from old FV

peter há 24 anos atrás
pai
commit
c552369bd1

+ 1057 - 0
fv/Makefile

@@ -0,0 +1,1057 @@
+#
+# Don't edit, this file is generated by FPCMake Version 1.1 [2001/08/02]
+#
+default: all
+override PATH:=$(subst \,/,$(PATH))
+ifeq ($(findstring ;,$(PATH)),)
+inUnix=1
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+SEARCHPATH:=$(subst ;, ,$(PATH))
+endif
+PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH))))
+ifeq ($(PWD),)
+PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH))))
+ifeq ($(PWD),)
+nopwd:
+	@echo You need the GNU utils package to use this Makefile!
+	@echo Get ftp://ftp.freepascal.org/pub/fpc/dist/go32v2/utilgo32.zip
+	@exit
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=
+endif
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=.exe
+endif
+ifndef inUnix
+ifeq ($(OS),Windows_NT)
+inWinNT=1
+else
+ifdef OS2_SHELL
+inOS2=1
+endif
+endif
+else
+ifneq ($(findstring cygwin,$(MACHTYPE)),)
+inCygWin=1
+endif
+endif
+ifdef inUnix
+BATCHEXT=.sh
+else
+ifdef inOS2
+BATCHEXT=.cmd
+else
+BATCHEXT=.bat
+endif
+endif
+ifdef inUnix
+PATHSEP=/
+else
+PATHSEP:=$(subst /,\,/)
+endif
+ifdef PWD
+BASEDIR:=$(subst \,/,$(shell $(PWD)))
+ifdef inCygWin
+ifneq ($(findstring /cygdrive/,$(BASEDIR)),)
+BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR))
+BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR)))
+BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR))
+endif
+endif
+else
+BASEDIR=.
+endif
+ifndef FPC
+ifdef PP
+FPC=$(PP)
+else
+ifdef inUnix
+CPU_SOURCE=$(shell uname -m)
+ifeq (m68k,$(CPU_SOURCE))
+FPC=ppc68k
+else
+FPC=ppc386
+endif
+else
+FPC=ppc386
+endif
+endif
+endif
+override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
+override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
+ifndef OS_TARGET
+OS_TARGET:=$(shell $(FPC) -iTO)
+endif
+ifndef OS_SOURCE
+OS_SOURCE:=$(shell $(FPC) -iSO)
+endif
+ifndef CPU_TARGET
+CPU_TARGET:=$(shell $(FPC) -iTP)
+endif
+ifndef CPU_SOURCE
+CPU_SOURCE:=$(shell $(FPC) -iSP)
+endif
+ifndef FPC_VERSION
+FPC_VERSION:=$(shell $(FPC) -iV)
+endif
+export FPC OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FPC_VERSION
+ifdef FPCDIR
+override FPCDIR:=$(subst \,/,$(FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+else
+override FPCDIR=wrong
+endif
+ifeq ($(FPCDIR),wrong)
+override FPCDIR=..
+ifeq ($(wildcard $(FPCDIR)/rtl),)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=wrong
+endif
+endif
+endif
+ifeq ($(FPCDIR),wrong)
+ifdef inUnix
+override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=/usr/lib/fpc/$(FPC_VERSION)
+endif
+else
+override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))))
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=c:/pp
+endif
+endif
+endif
+endif
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
+PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages)
+override PACKAGE_NAME=fv
+override PACKAGE_VERSION=1.0.5
+override TARGET_UNITS+=buildfv
+override TARGET_EXAMPLEDIRS+=test
+override CLEAN_UNITS+=$(subst $(PPUEXT),,$(wildcard *$(PPUEXT)))
+override INSTALL_UNITS+=$(subst $(PPUEXT),,$(wildcard *$(PPUEXT)))
+override INSTALL_FPCPACKAGE=y
+override COMPILER_TARGETDIR+=.
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO=
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+ifndef DATE
+DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE=
+else
+DATE:=$(firstword $(DATE))
+endif
+else
+DATE:=$(firstword $(DATE))
+endif
+endif
+export DATE
+ifndef GINSTALL
+GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL=
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+endif
+export GINSTALL
+ifndef CPPROG
+CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(CPPROG),)
+CPPROG=
+else
+CPPROG:=$(firstword $(CPPROG))
+endif
+endif
+export CPPROG
+ifndef RMPROG
+RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(RMPROG),)
+RMPROG=
+else
+RMPROG:=$(firstword $(RMPROG))
+endif
+endif
+export RMPROG
+ifndef MVPROG
+MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MVPROG),)
+MVPROG=
+else
+MVPROG:=$(firstword $(MVPROG))
+endif
+endif
+export MVPROG
+ifndef ECHOREDIR
+ECHOREDIR:=$(subst /,$(PATHSEP),$(ECHO))
+endif
+ifndef COPY
+COPY:=$(CPPROG) -fp
+endif
+ifndef COPYTREE
+COPYTREE:=$(CPPROG) -rfp
+endif
+ifndef MOVE
+MOVE:=$(MVPROG) -f
+endif
+ifndef DEL
+DEL:=$(RMPROG) -f
+endif
+ifndef DELTREE
+DELTREE:=$(RMPROG) -rf
+endif
+ifndef INSTALL
+ifdef inUnix
+INSTALL:=$(GINSTALL) -c -m 644
+else
+INSTALL:=$(COPY)
+endif
+endif
+ifndef INSTALLEXE
+ifdef inUnix
+INSTALLEXE:=$(GINSTALL) -c -m 755
+else
+INSTALLEXE:=$(COPY)
+endif
+endif
+ifndef MKDIR
+MKDIR:=$(GINSTALL) -m 755 -d
+endif
+export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
+ifndef PPUMOVE
+PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(PPUMOVE),)
+PPUMOVE=
+else
+PPUMOVE:=$(firstword $(PPUMOVE))
+endif
+endif
+export PPUMOVE
+ifndef FPCMAKE
+FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(FPCMAKE),)
+FPCMAKE=
+else
+FPCMAKE:=$(firstword $(FPCMAKE))
+endif
+endif
+export FPCMAKE
+ifndef ZIPPROG
+ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ZIPPROG),)
+ZIPPROG=
+else
+ZIPPROG:=$(firstword $(ZIPPROG))
+endif
+endif
+export ZIPPROG
+ifndef TARPROG
+TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(TARPROG),)
+TARPROG=
+else
+TARPROG:=$(firstword $(TARPROG))
+endif
+endif
+export TARPROG
+ifndef AS
+AS=as
+endif
+ifndef LD
+LD=ld
+endif
+ifndef RC
+RC=rc
+endif
+PPAS=ppas$(BATCHEXT)
+ifdef inUnix
+LDCONFIG=ldconfig
+else
+LDCONFIG=
+endif
+ifdef DATE
+DATESTR:=$(shell $(DATE) +%Y%m%d)
+else
+DATESTR=
+endif
+ifndef UPXPROG
+ifeq ($(OS_TARGET),go32v2)
+UPXPROG:=1
+endif
+ifeq ($(OS_TARGET),win32)
+UPXPROG:=1
+endif
+ifdef UPXPROG
+UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(UPXPROG),)
+UPXPROG=
+else
+UPXPROG:=$(firstword $(UPXPROG))
+endif
+else
+UPXPROG=
+endif
+endif
+export UPXPROG
+ZIPOPT=-9
+ZIPEXT=.zip
+ifeq ($(USETAR),bz2)
+TAROPT=vI
+TAREXT=.tar.bz2
+else
+TAROPT=vz
+TAREXT=.tar.gz
+endif
+LOADEREXT=.as
+EXEEXT=.exe
+PPLEXT=.ppl
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.so
+STATICLIBPREFIX=libp
+RSTEXT=.rst
+FPCMADE=fpcmade
+ifeq ($(OS_TARGET),go32v1)
+PPUEXT=.pp1
+OEXT=.o1
+ASMEXT=.s1
+SMARTEXT=.sl1
+STATICLIBEXT=.a1
+SHAREDLIBEXT=.so1
+STATICLIBPREFIX=
+FPCMADE=fpcmade.v1
+PACKAGESUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+FPCMADE=fpcmade.dos
+ZIPSUFFIX=go32
+endif
+ifeq ($(OS_TARGET),linux)
+EXEEXT=
+HASSHAREDLIB=1
+FPCMADE=fpcmade.lnx
+ZIPSUFFIX=linux
+endif
+ifeq ($(OS_TARGET),freebsd)
+EXEEXT=
+HASSHAREDLIB=1
+FPCMADE=fpcmade.freebsd
+ZIPSUFFIX=freebsd
+endif
+ifeq ($(OS_TARGET),win32)
+PPUEXT=.ppw
+OEXT=.ow
+ASMEXT=.sw
+SMARTEXT=.slw
+STATICLIBEXT=.aw
+SHAREDLIBEXT=.dll
+FPCMADE=fpcmade.w32
+ZIPSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+PPUEXT=.ppo
+ASMEXT=.so2
+OEXT=.oo2
+AOUTEXT=.out
+SMARTEXT=.so
+STATICLIBEXT=.ao2
+SHAREDLIBEXT=.dll
+FPCMADE=fpcmade.os2
+ZIPSUFFIX=emx
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+PPUEXT=.ppa
+ASMEXT=.asm
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.library
+FPCMADE=fpcmade.amg
+endif
+ifeq ($(OS_TARGET),atari)
+PPUEXT=.ppt
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=.ttp
+FPCMADE=fpcmade.ata
+endif
+ifdef REQUIRE_UNITSDIR
+override UNITSDIR+=$(REQUIRE_UNITSDIR)
+endif
+ifdef REQUIRE_PACKAGESDIR
+override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR)
+endif
+ifdef ZIPINSTALL
+ifeq ($(OS_TARGET),linux)
+UNIXINSTALLDIR=1
+endif
+ifeq ($(OS_TARGET),freebsd)
+UNIXINSTALLDIR=1
+endif
+else
+ifeq ($(OS_SOURCE),linux)
+UNIXINSTALLDIR=1
+endif
+ifeq ($(OS_SOURCE),freebsd)
+UNIXINSTALLDIR=1
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef UNIXINSTALLDIR
+INSTALL_PREFIX=/usr/local
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=/pp
+else
+INSTALL_BASEDIR:=/$(PACKAGE_NAME)
+endif
+endif
+endif
+export INSTALL_PREFIX
+ifndef DIST_DESTDIR
+DIST_DESTDIR:=$(BASEDIR)
+endif
+export DIST_DESTDIR
+ifndef INSTALL_BASEDIR
+ifdef UNIXINSTALLDIR
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION)
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/$(PACKAGE_NAME)
+endif
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)
+endif
+endif
+ifndef INSTALL_BINDIR
+ifdef UNIXINSTALLDIR
+INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin
+else
+INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(OS_TARGET)
+endif
+endif
+endif
+ifndef INSTALL_UNITDIR
+INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(OS_TARGET)
+ifdef INSTALL_FPCPACKAGE
+ifdef PACKAGE_NAME
+INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME)
+endif
+endif
+endif
+ifndef INSTALL_LIBDIR
+ifdef UNIXINSTALLDIR
+INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib
+else
+INSTALL_LIBDIR:=$(INSTALL_UNITDIR)
+endif
+endif
+ifndef INSTALL_SOURCEDIR
+ifdef UNIXINSTALLDIR
+ifdef INSTALL_FPCPACKAGE
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/src/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/src/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIRL:=$(INSTALL_BASEDIR)/source
+endif
+endif
+endif
+ifndef INSTALL_DOCDIR
+ifdef UNIXINSTALLDIR
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc
+endif
+endif
+endif
+ifndef INSTALL_EXAMPLEDIR
+ifdef UNIXINSTALLDIR
+ifdef INSTALL_FPCPACKAGE
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples
+endif
+endif
+endif
+ifndef INSTALL_DATADIR
+INSTALL_DATADIR=$(INSTALL_BASEDIR)
+endif
+ifeq ($(OS_TARGET),linux)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(OS_TARGET),go32v2)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(OS_TARGET),win32)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(OS_TARGET),os2)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(OS_TARGET),freebsd)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(OS_TARGET),beos)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(OS_TARGET),amiga)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(OS_TARGET),atari)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifdef REQUIRE_PACKAGES_RTL
+PACKAGEDIR_RTL:=$(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR)))))
+ifneq ($(PACKAGEDIR_RTL),)
+PACKAGEDIR_RTL:=$(firstword $(PACKAGEDIR_RTL))
+ifeq ($(wildcard $(PACKAGEDIR_RTL)/$(FPCMADE)),)
+override COMPILEPACKAGES+=package_rtl
+package_rtl:
+	$(MAKE) -C $(PACKAGEDIR_RTL) all
+endif
+ifneq ($(wildcard $(PACKAGEDIR_RTL)/$(OS_TARGET)),)
+UNITDIR_RTL=$(PACKAGEDIR_RTL)/$(OS_TARGET)
+else
+UNITDIR_RTL=$(PACKAGEDIR_RTL)
+endif
+else
+PACKAGEDIR_RTL=
+UNITDIR_RTL:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /rtl/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_RTL),)
+UNITDIR_RTL:=$(firstword $(UNITDIR_RTL))
+else
+UNITDIR_RTL=
+endif
+endif
+ifdef UNITDIR_RTL
+override COMPILER_UNITDIR+=$(UNITDIR_RTL)
+endif
+endif
+.PHONY: package_rtl
+override FPCOPTDEF=$(CPU_TARGET)
+ifneq ($(OS_TARGET),$(OS_SOURCE))
+override FPCOPT+=-T$(OS_TARGET)
+endif
+ifdef UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
+endif
+ifdef LIBDIR
+override FPCOPT+=$(addprefix -Fl,$(LIBDIR))
+endif
+ifdef OBJDIR
+override FPCOPT+=$(addprefix -Fo,$(OBJDIR))
+endif
+ifdef INCDIR
+override FPCOPT+=$(addprefix -Fi,$(INCDIR))
+endif
+ifdef LINKSMART
+override FPCOPT+=-XX
+endif
+ifdef CREATESMART
+override FPCOPT+=-CX
+endif
+ifdef DEBUG
+override FPCOPT+=-gl
+override FPCOPTDEF+=DEBUG
+endif
+ifdef RELEASE
+override FPCOPT+=-Xs -OG2p3 -n
+override FPCOPTDEF+=RELEASE
+endif
+ifdef STRIP
+override FPCOPT+=-Xs
+endif
+ifdef OPTIMIZE
+override FPCOPT+=-OG2p3
+endif
+ifdef VERBOSE
+override FPCOPT+=-vwni
+endif
+ifdef COMPILER_OPTIONS
+override FPCOPT+=$(COMPILER_OPTIONS)
+endif
+ifdef COMPILER_UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR))
+endif
+ifdef COMPILER_LIBRARYDIR
+override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR))
+endif
+ifdef COMPILER_OBJECTDIR
+override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR))
+endif
+ifdef COMPILER_INCLUDEDIR
+override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR))
+endif
+ifdef COMPILER_TARGETDIR
+override FPCOPT+=-FE$(COMPILER_TARGETDIR)
+ifeq ($(COMPILER_TARGETDIR),.)
+override TARGETDIRPREFIX=
+else
+override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
+endif
+endif
+ifdef COMPILER_UNITTARGETDIR
+override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR)
+ifeq ($(COMPILER_UNITTARGETDIR),.)
+override UNITTARGETDIRPREFIX=
+else
+override UNITTARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
+endif
+else
+ifdef COMPILER_TARGETDIR
+override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR)
+override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)
+endif
+endif
+ifdef OPT
+override FPCOPT+=$(OPT)
+endif
+ifdef FPCOPTDEF
+override FPCOPT+=$(addprefix -d,$(FPCOPTDEF))
+endif
+ifdef CFGFILE
+override FPCOPT+=@$(CFGFILE)
+endif
+ifdef USEENV
+override FPCEXTCMD:=$(FPCOPT)
+override FPCOPT:=!FPCEXTCMD
+export FPCEXTCMD
+endif
+override COMPILER:=$(FPC) $(FPCOPT)
+ifeq (,$(findstring -s ,$(COMPILER)))
+EXECPPAS=
+else
+ifeq ($(OS_SOURCE),$(OS_TARGET))
+EXECPPAS:=@$(PPAS)
+endif
+endif
+.PHONY: fpc_units
+ifdef TARGET_UNITS
+override ALLTARGET+=fpc_units
+override UNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_UNITS))
+override INSTALLPPUFILES+=$(UNITPPUFILES)
+override CLEANPPUFILES+=$(UNITPPUFILES)
+endif
+fpc_units: $(UNITPPUFILES)
+ifdef TARGET_RSTS
+override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS))
+override CLEANRSTFILES+=$(RSTFILES)
+endif
+.PHONY: fpc_examples
+ifdef TARGET_EXAMPLES
+HASEXAMPLES=1
+override EXAMPLESOURCEFILES:=$(wildcard $(addsuffix .pp,$(TARGET_EXAMPLES)) $(addsuffix .pas,$(TARGET_EXAMPLES)))
+override EXAMPLEFILES:=$(addsuffix $(EXEEXT),$(TARGET_EXAMPLES))
+override EXAMPLEOFILES:=$(addsuffix $(OEXT),$(TARGET_EXAMPLES)) $(addprefix $(STATICLIBPREFIX),$(addsuffix $(STATICLIBEXT),$(TARGET_EXAMPLES)))
+override CLEANEXEFILES+=$(EXAMPLEFILES) $(EXAMPLEOFILES)
+ifeq ($(OS_TARGET),os2)
+override CLEANEXEFILES+=$(addsuffix $(AOUTEXT),$(TARGET_EXAMPLES))
+endif
+endif
+ifdef TARGET_EXAMPLEDIRS
+HASEXAMPLES=1
+endif
+fpc_examples: all $(EXAMPLEFILES) $(addsuffix _all,$(TARGET_EXAMPLEDIRS))
+.PHONY: fpc_packages fpc_all fpc_smart fpc_debug
+$(FPCMADE): $(ALLTARGET)
+	@$(ECHOREDIR) Compiled > $(FPCMADE)
+fpc_packages: $(COMPILEPACKAGES)
+fpc_all: fpc_packages $(FPCMADE)
+fpc_smart:
+	$(MAKE) all LINKSMART=1 CREATESMART=1
+fpc_debug:
+	$(MAKE) all DEBUG=1
+.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .pp
+%$(PPUEXT): %.pp
+	$(COMPILER) $<
+	$(EXECPPAS)
+%$(PPUEXT): %.pas
+	$(COMPILER) $<
+	$(EXECPPAS)
+%$(EXEEXT): %.pp
+	$(COMPILER) $<
+	$(EXECPPAS)
+%$(EXEEXT): %.pas
+	$(COMPILER) $<
+	$(EXECPPAS)
+vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR)
+.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall
+ifdef INSTALL_UNITS
+override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS))
+endif
+ifdef INSTALLPPUFILES
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(INSTALLPPUFILES))
+override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(INSTALLPPULINKFILES)))
+override INSTALL_CREATEPACKAGEFPC=1
+endif
+ifdef INSTALLEXEFILES
+override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(INSTALLEXEFILES))
+endif
+fpc_install: $(INSTALLTARGET)
+ifdef INSTALLEXEFILES
+	$(MKDIR) $(INSTALL_BINDIR)
+ifdef UPXPROG
+	-$(UPXPROG) $(INSTALLEXEFILES)
+endif
+	$(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR)
+endif
+ifdef INSTALL_CREATEPACKAGEFPC
+ifdef FPCMAKE
+ifdef PACKAGE_VERSION
+ifneq ($(wildcard Makefile.fpc),)
+	$(FPCMAKE) -p -T$(OS_TARGET) Makefile.fpc
+	$(MKDIR) $(INSTALL_UNITDIR)
+	$(INSTALL) Package.fpc $(INSTALL_UNITDIR)
+endif
+endif
+endif
+endif
+ifdef INSTALLPPUFILES
+	$(MKDIR) $(INSTALL_UNITDIR)
+	$(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR)
+ifneq ($(INSTALLPPULINKFILES),)
+	$(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR)
+endif
+ifneq ($(wildcard $(LIB_FULLNAME)),)
+	$(MKDIR) $(INSTALL_LIBDIR)
+	$(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR)
+ifdef inUnix
+	ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME)
+endif
+endif
+endif
+ifdef INSTALL_FILES
+	$(MKDIR) $(INSTALL_DATADIR)
+	$(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR)
+endif
+fpc_sourceinstall: distclean
+	$(MKDIR) $(INSTALL_SOURCEDIR)
+	$(COPYTREE) $(BASEDIR) $(INSTALL_SOURCEDIR)
+fpc_exampleinstall: $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS))
+ifdef HASEXAMPLES
+	$(MKDIR) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef EXAMPLESOURCEFILES
+	$(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef TARGET_EXAMPLEDIRS
+	$(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EXAMPLEDIR)
+endif
+.PHONY: fpc_distinstall
+fpc_distinstall: install exampleinstall
+.PHONY: fpc_zipinstall fpc_zipsourceinstall fpc_zipexampleinstall
+ifndef PACKDIR
+ifndef inUnix
+PACKDIR=$(BASEDIR)/../fpc-pack
+else
+PACKDIR=/tmp/fpc-pack
+endif
+endif
+ifndef ZIPNAME
+ifdef DIST_ZIPNAME
+ZIPNAME=$(DIST_ZIPNAME)
+else
+ZIPNAME=$(ZIPPREFIX)$(PACKAGE_NAME)$(ZIPSUFFIX)
+endif
+endif
+ifndef ZIPTARGET
+ifdef DIST_ZIPTARGET
+ZIPTARGET=DIST_ZIPTARGET
+else
+ZIPTARGET=install
+endif
+endif
+ifndef USEZIP
+ifdef inUnix
+USETAR=1
+endif
+endif
+ifndef inUnix
+USEZIPWRAPPER=1
+endif
+ifdef USEZIPWRAPPER
+ZIPPATHSEP=$(PATHSEP)
+ZIPWRAPPER=$(subst /,$(PATHSEP),$(DIST_DESTDIR)/fpczip$(BATCHEXT))
+else
+ZIPPATHSEP=/
+endif
+ZIPCMD_CDPACK:=cd $(subst /,$(ZIPPATHSEP),$(PACKDIR))
+ZIPCMD_CDBASE:=cd $(subst /,$(ZIPPATHSEP),$(BASEDIR))
+ifdef USETAR
+ZIPDESTFILE:=$(DIST_DESTDIR)/$(ZIPNAME)$(TAREXT)
+ZIPCMD_ZIP:=$(TARPROG) cf$(TAROPT) $(ZIPDESTFILE) *
+else
+ZIPDESTFILE:=$(DIST_DESTDIR)/$(ZIPNAME)$(ZIPEXT)
+ZIPCMD_ZIP:=$(subst /,$(ZIPPATHSEP),$(ZIPPROG)) -Dr $(ZIPOPT) $(ZIPDESTFILE) *
+endif
+fpc_zipinstall:
+	$(MAKE) $(ZIPTARGET) INSTALL_PREFIX=$(PACKDIR) ZIPINSTALL=1
+	$(DEL) $(ZIPDESTFILE)
+ifdef USEZIPWRAPPER
+ifneq ($(ECHOREDIR),echo)
+	$(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_CDPACK))" > $(ZIPWRAPPER)
+	$(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_ZIP))" >> $(ZIPWRAPPER)
+	$(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_CDBASE))" >> $(ZIPWRAPPER)
+else
+	echo $(ZIPCMD_CDPACK) > $(ZIPWRAPPER)
+	echo $(ZIPCMD_ZIP) >> $(ZIPWRAPPER)
+	echo $(ZIPCMD_CDBASE) >> $(ZIPWRAPPER)
+endif
+ifdef inUnix
+	/bin/sh $(ZIPWRAPPER)
+else
+	$(ZIPWRAPPER)
+endif
+	$(DEL) $(ZIPWRAPPER)
+else
+	$(ZIPCMD_CDPACK) ; $(ZIPCMD_ZIP) ; $(ZIPCMD_CDBASE)
+endif
+	$(DELTREE) $(PACKDIR)
+fpc_zipsourceinstall:
+	$(MAKE) fpc_zipinstall ZIPTARGET=sourceinstall ZIPSUFFIX=src
+fpc_zipexampleinstall:
+ifdef HASEXAMPLES
+	$(MAKE) fpc_zipinstall ZIPTARGET=exampleinstall ZIPSUFFIX=exm
+endif
+fpc_zipdistinstall:
+	$(MAKE) fpc_zipinstall ZIPTARGET=distinstall
+.PHONY: fpc_clean fpc_cleanall fpc_distclean
+ifdef EXEFILES
+override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES))
+endif
+ifdef CLEAN_UNITS
+override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
+endif
+ifdef CLEANPPUFILES
+override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))
+override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES))
+override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES)))
+endif
+fpc_clean: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+	-$(DEL) $(CLEANEXEFILES)
+endif
+ifdef CLEANPPUFILES
+	-$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+	-$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+	-$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+ifdef CLEAN_FILES
+	-$(DEL) $(CLEAN_FILES)
+endif
+ifdef LIB_NAME
+	-$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
+endif
+	-$(DEL) $(FPCMADE) Package.fpc $(PPAS) link.res $(FPCEXTFILE) $(REDIRFILE)
+fpc_distclean: clean
+ifdef COMPILER_UNITTARGETDIR
+TARGETDIRCLEAN=fpc_clean
+endif
+fpc_cleanall: $(CLEANTARGET) $(TARGETDIRCLEAN)
+ifdef CLEANEXEFILES
+	-$(DEL) $(CLEANEXEFILES)
+endif
+	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
+	-$(DELTREE) *$(SMARTEXT)
+	-$(DEL) $(FPCMADE) $(PPAS) link.res $(FPCEXTFILE) $(REDIRFILE)
+ifdef AOUTEXT
+	-$(DEL) *$(AOUTEXT)
+endif
+.PHONY: fpc_info
+fpc_info:
+	@$(ECHO)
+	@$(ECHO)  == Package info ==
+	@$(ECHO)  Package Name..... $(PACKAGE_NAME)
+	@$(ECHO)  Package Version.. $(PACKAGE_VERSION)
+	@$(ECHO)
+	@$(ECHO)  == Configuration info ==
+	@$(ECHO)
+	@$(ECHO)  FPC.......... $(FPC)
+	@$(ECHO)  FPC Version.. $(FPC_VERSION)
+	@$(ECHO)  Source CPU... $(CPU_SOURCE)
+	@$(ECHO)  Target CPU... $(CPU_TARGET)
+	@$(ECHO)  Source OS.... $(OS_SOURCE)
+	@$(ECHO)  Target OS.... $(OS_TARGET)
+	@$(ECHO)
+	@$(ECHO)  == Directory info ==
+	@$(ECHO)
+	@$(ECHO)  Basedir......... $(BASEDIR)
+	@$(ECHO)  FPCDir.......... $(FPCDIR)
+	@$(ECHO)  UnitsDir........ $(UNITSDIR)
+	@$(ECHO)  PackagesDir..... $(PACKAGESDIR)
+	@$(ECHO)
+	@$(ECHO)  GCC library..... $(GCCLIBDIR)
+	@$(ECHO)  Other library... $(OTHERLIBDIR)
+	@$(ECHO)
+	@$(ECHO)  == Tools info ==
+	@$(ECHO)
+	@$(ECHO)  Pwd....... $(PWD)
+	@$(ECHO)  Mv........ $(MVPROG)
+	@$(ECHO)  Cp........ $(CPPROG)
+	@$(ECHO)  Rm........ $(RMPROG)
+	@$(ECHO)  GInstall.. $(GINSTALL)
+	@$(ECHO)  Echo...... $(ECHO)
+	@$(ECHO)  Date...... $(DATE)
+	@$(ECHO)  FPCMake... $(FPCMAKE)
+	@$(ECHO)  PPUMove... $(PPUMOVE)
+	@$(ECHO)  Upx....... $(UPXPROG)
+	@$(ECHO)  Zip....... $(ZIPPROG)
+	@$(ECHO)
+	@$(ECHO)  == Object info ==
+	@$(ECHO)
+	@$(ECHO)  Target Loaders...... $(TARGET_LOADERS)
+	@$(ECHO)  Target Units........ $(TARGET_UNITS)
+	@$(ECHO)  Target Programs..... $(TARGET_PROGRAMS)
+	@$(ECHO)  Target Dirs......... $(TARGET_DIRS)
+	@$(ECHO)  Target Examples..... $(TARGET_EXAMPLES)
+	@$(ECHO)  Target ExampleDirs.. $(TARGET_EXAMPLEDIRS)
+	@$(ECHO)
+	@$(ECHO)  Clean Units......... $(CLEAN_UNITS)
+	@$(ECHO)  Clean Files......... $(CLEAN_FILES)
+	@$(ECHO)
+	@$(ECHO)  Install Units....... $(INSTALL_UNITS)
+	@$(ECHO)  Install Files....... $(INSTALL_FILES)
+	@$(ECHO)
+	@$(ECHO)  == Install info ==
+	@$(ECHO)
+	@$(ECHO)  DateStr.............. $(DATESTR)
+	@$(ECHO)  ZipPrefix............ $(ZIPPREFIX)
+	@$(ECHO)  ZipSuffix............ $(ZIPSUFFIX)
+	@$(ECHO)  Install FPC Package.. $(INSTALL_FPCPACKAGE)
+	@$(ECHO)
+	@$(ECHO)  Install base dir..... $(INSTALL_BASEDIR)
+	@$(ECHO)  Install binary dir... $(INSTALL_BINDIR)
+	@$(ECHO)  Install library dir.. $(INSTALL_LIBDIR)
+	@$(ECHO)  Install units dir.... $(INSTALL_UNITDIR)
+	@$(ECHO)  Install source dir... $(INSTALL_SOURCEDIR)
+	@$(ECHO)  Install doc dir...... $(INSTALL_DOCDIR)
+	@$(ECHO)  Install example dir.. $(INSTALL_EXAMPLEDIR)
+	@$(ECHO)  Install data dir..... $(INSTALL_DATADIR)
+	@$(ECHO)
+	@$(ECHO)  Dist destination dir. $(DIST_DESTDIR)
+	@$(ECHO)  Dist zip name........ $(DIST_ZIPNAME)
+	@$(ECHO)
+TARGET_EXAMPLEDIRS_TEST=1
+ifdef TARGET_EXAMPLEDIRS_TEST
+test_all:
+	$(MAKE) -C test all
+test_debug:
+	$(MAKE) -C test debug
+test_smart:
+	$(MAKE) -C test smart
+test_examples:
+	$(MAKE) -C test examples
+test_shared:
+	$(MAKE) -C test shared
+test_install:
+	$(MAKE) -C test install
+test_sourceinstall:
+	$(MAKE) -C test sourceinstall
+test_exampleinstall:
+	$(MAKE) -C test exampleinstall
+test_distinstall:
+	$(MAKE) -C test distinstall
+test_zipinstall:
+	$(MAKE) -C test zipinstall
+test_zipsourceinstall:
+	$(MAKE) -C test zipsourceinstall
+test_zipexampleinstall:
+	$(MAKE) -C test zipexampleinstall
+test_zipdistinstall:
+	$(MAKE) -C test zipdistinstall
+test_clean:
+	$(MAKE) -C test clean
+test_distclean:
+	$(MAKE) -C test distclean
+test_cleanall:
+	$(MAKE) -C test cleanall
+test_info:
+	$(MAKE) -C test info
+test:
+	$(MAKE) -C test all
+.PHONY: test_all test_debug test_smart test_examples test_shared test_install test_sourceinstall test_exampleinstall test_distinstall test_zipinstall test_zipsourceinstall test_zipexampleinstall test_zipdistinstall test_clean test_distclean test_cleanall test_info test
+endif
+all: fpc_all
+debug: fpc_debug
+smart: fpc_smart
+examples: fpc_examples
+shared:
+install: fpc_install
+sourceinstall: fpc_sourceinstall
+exampleinstall: fpc_exampleinstall
+distinstall: fpc_distinstall
+zipinstall: fpc_zipinstall
+zipsourceinstall: fpc_zipsourceinstall
+zipexampleinstall: fpc_zipexampleinstall
+zipdistinstall: fpc_zipdistinstall
+clean: fpc_clean $(addsuffix _clean,$(TARGET_EXAMPLEDIRS))
+distclean: fpc_distclean
+cleanall: fpc_cleanall
+info: fpc_info
+.PHONY: all debug smart examples shared install sourceinstall exampleinstall distinstall zipinstall zipsourceinstall zipexampleinstall zipdistinstall clean distclean cleanall info
+ifneq ($(wildcard fpcmake.loc),)
+include fpcmake.loc
+endif
+buildfv$(PPUEXT): $(wildcard *.pas *.inc)

+ 31 - 0
fv/Makefile.fpc

@@ -0,0 +1,31 @@
+#
+#   Makefile.fpc for Free Vision for Free Pascal
+#
+
+[package]
+name=fv
+version=1.0.5
+
+[target]
+units=buildfv
+exampledirs=test
+
+[libs]
+libname=libfpfv.so
+libversion=1.0
+
+[compiler]
+targetdir=.
+
+[install]
+units=$(subst $(PPUEXT),,$(wildcard *$(PPUEXT)))
+fpcpackage=y
+
+[clean]
+units=$(subst $(PPUEXT),,$(wildcard *$(PPUEXT)))
+
+[default]
+fpcdir=..
+
+[rules]
+buildfv$(PPUEXT): $(wildcard *.pas *.inc)

+ 6 - 2
fv/app.pas

@@ -57,7 +57,7 @@ USES
    {$ENDIF}
 
    GFVGraph,                                          { GFV standard unit }
-   Common, Memory,                                    { GFV standard units }
+   FVCommon, Memory,                                    { GFV standard units }
    Objects, Drivers, Views, Menus, HistList, Dialogs; { GFV standard units }
 
 {***************************************************************************}
@@ -1088,7 +1088,11 @@ END;
 END.
 {
  $Log$
- Revision 1.11  2001-05-31 21:39:11  pierre
+ Revision 1.12  2001-08-04 19:14:32  peter
+   * Added Makefiles
+   * added FV specific units and objects from old FV
+
+ Revision 1.11  2001/05/31 21:39:11  pierre
   + AltF12 to force Redraw of Application
 
  Revision 1.10  2001/05/31 12:15:24  pierre

+ 42 - 0
fv/buildfv.pas

@@ -0,0 +1,42 @@
+{
+  $Id$
+
+  Unit to build all units of Free Vision
+}
+unit buildfv;
+interface
+uses
+  fvcommon,
+  objects,
+  drivers,
+  fileio,
+  memory,
+  gfvgraph,
+
+  fvconsts,
+  resource,
+  views,
+  validate,
+  msgbox,
+  dialogs,
+  menus,
+  app,
+  stddlg,
+
+  tabs,
+  statuses,
+  histlist,
+  inplong,
+  gadgets,
+  time;
+
+implementation
+
+end.
+{
+  $Log$
+  Revision 1.1  2001-08-04 19:14:32  peter
+    * Added Makefiles
+    * added FV specific units and objects from old FV
+
+}

Diff do ficheiro suprimidas por serem muito extensas
+ 630 - 71
fv/dialogs.pas


+ 73 - 69
fv/drivers.pas

@@ -78,7 +78,7 @@ USES
 
    video,
    GFVGraph,                                          { GFV graphics unit }
-   Common, Objects;                                   { GFV standard units }
+   FVCommon, Objects;                                 { GFV standard units }
 
 {***************************************************************************}
 {                              PUBLIC CONSTANTS                             }
@@ -231,28 +231,28 @@ CONST
 {---------------------------------------------------------------------------}
 TYPE
    TEvent = PACKED RECORD
-      What: Word;                                     { Event type }
-      Case Word Of
+      What: Sw_Word;                                     { Event type }
+      Case Sw_Word Of
         evNothing: ();                                { ** NO EVENT ** }
         evMouse: (
           Buttons: Byte;                              { Mouse buttons }
           Double: Boolean;                            { Double click state }
           Where: TPoint);                             { Mouse position }
         evKeyDown: (                                  { ** KEY EVENT ** }
-          Case Integer Of
-            0: (KeyCode: Word);                       { Full key code }
+          Case Sw_Integer Of
+            0: (KeyCode: Sw_Word);                       { Full key code }
             1: (CharCode: Char;                       { Char code }
                 ScanCode: Byte;                       { Scan code }
                 KeyShift: byte));                     { Shift states }
         evMessage: (                                  { ** MESSAGE EVENT ** }
-          Command: Word;                              { Message command }
-          Id     : Word;                              { Message id }
+          Command: Sw_Word;                              { Message command }
+          Id     : Sw_Word;                              { Message id }
           Data   : Real;                              { Message data }
-          Case Word Of
+          Case Sw_Word Of
             0: (InfoPtr: Pointer);                    { Message pointer }
             1: (InfoLong: Longint);                   { Message longint }
-            2: (InfoWord: Word);                      { Message word }
-            3: (InfoInt: Integer);                    { Message integer }
+            2: (InfoWord: Word);                      { Message Sw_Word }
+            3: (InfoInt: Integer);                    { Message Sw_Integer }
             4: (InfoByte: Byte);                      { Message byte }
             5: (InfoChar: Char));                     { Message character }
    END;
@@ -262,7 +262,7 @@ TYPE
 {                    ERROR HANDLER FUNCTION DEFINITION                      }
 {---------------------------------------------------------------------------}
 TYPE
-   TSysErrorFunc = FUNCTION (ErrorCode: Integer; Drive: Byte): Integer;
+   TSysErrorFunc = FUNCTION (ErrorCode: Sw_Integer; Drive: Byte): Sw_Integer;
 
 {***************************************************************************}
 {                            INTERFACE ROUTINES                             }
@@ -283,13 +283,13 @@ the screen. For example, given the string '~B~roccoli' as its
 parameter, CStrLen returns 8.
 25May96 LdB
 ---------------------------------------------------------------------}
-FUNCTION CStrLen (Const S: String): Integer;
+FUNCTION CStrLen (Const S: String): Sw_Integer;
 
 {-MoveStr------------------------------------------------------------
 Moves a string into a buffer for use with a view's WriteBuf or WriteLine.
-Dest must be a TDrawBuffer (or an equivalent array of words). The
-characters in Str are moved into the low bytes of corresponding words
-in Dest. The high bytes of the words are set to Attr, or remain
+Dest must be a TDrawBuffer (or an equivalent array of Sw_Words). The
+characters in Str are moved into the low bytes of corresponding Sw_Words
+in Dest. The high bytes of the Sw_Words are set to Attr, or remain
 unchanged if Attr is zero.
 25May96 LdB
 ---------------------------------------------------------------------}
@@ -297,30 +297,30 @@ PROCEDURE MoveStr (Var Dest; Const Str: String; Attr: Byte);
 
 {-MoveCStr-----------------------------------------------------------
 The characters in Str are moved into the low bytes of corresponding
-words in Dest. The high bytes of the words are set to Lo(Attr) or
+Sw_Words in Dest. The high bytes of the Sw_Words are set to Lo(Attr) or
 Hi(Attr). Tilde characters (~) in the string toggle between the two
-attribute bytes passed in the Attr word.
+attribute bytes passed in the Attr Sw_Word.
 25May96 LdB
 ---------------------------------------------------------------------}
 PROCEDURE MoveCStr (Var Dest; Const Str: String; Attrs: Word);
 
 {-MoveBuf------------------------------------------------------------
 Count bytes are moved from Source into the low bytes of corresponding
-words in Dest. The high bytes of the words in Dest are set to Attr,
+Sw_Words in Dest. The high bytes of the Sw_Words in Dest are set to Attr,
 or remain unchanged if Attr is zero.
 25May96 LdB
 ---------------------------------------------------------------------}
-PROCEDURE MoveBuf (Var Dest, Source; Attr: Byte; Count: Word);
+PROCEDURE MoveBuf (Var Dest, Source; Attr: Byte; Count: Sw_Word);
 
 {-MoveChar------------------------------------------------------------
 Moves characters into a buffer for use with a view's WriteBuf or
-WriteLine. Dest must be a TDrawBuffer (or an equivalent array of words).
-The low bytes of the first Count words of Dest are set to C, or
-remain unchanged if Ord(C) is zero. The high bytes of the words are
+WriteLine. Dest must be a TDrawBuffer (or an equivalent array of Sw_Words).
+The low bytes of the first Count Sw_Words of Dest are set to C, or
+remain unchanged if Ord(C) is zero. The high bytes of the Sw_Words are
 set to Attr, or remain unchanged if Attr is zero.
 25May96 LdB
 ---------------------------------------------------------------------}
-PROCEDURE MoveChar (Var Dest; C: Char; Attr: Byte; Count: Word);
+PROCEDURE MoveChar (Var Dest; C: Char; Attr: Byte; Count: Sw_Word);
 
 {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 {                        KEYBOARD SUPPORT ROUTINES                          }
@@ -351,7 +351,7 @@ Returns the ascii character for the Ctrl+Key scancode that was given.
 FUNCTION GetCtrlChar (KeyCode: Word): Char;
 
 {-CtrlToArrow--------------------------------------------------------
-Converts a WordStar-compatible control key code to the corresponding
+Converts a Sw_WordStar-compatible control key code to the corresponding
 cursor key code.
 25May96 LdB
 ---------------------------------------------------------------------}
@@ -449,7 +449,7 @@ PROCEDURE ClearScreen;
 Does nothing provided for compatability purposes only.
 04Jan97 LdB
 ---------------------------------------------------------------------}
-PROCEDURE SetVideoMode (Mode: Word);
+PROCEDURE SetVideoMode (Mode: Sw_Word);
 
 {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 {                           ERROR CONTROL ROUTINES                          }
@@ -473,7 +473,7 @@ PROCEDURE DoneSysError;
 Error handling is not yet implemented so this simply drops through.
 20May98 LdB
 ---------------------------------------------------------------------}
-FUNCTION SystemError (ErrorCode: Integer; Drive: Byte): Integer;
+FUNCTION SystemError (ErrorCode: Sw_Integer; Drive: Byte): Sw_Integer;
 
 {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 {                           STRING FORMAT ROUTINES                          }
@@ -532,25 +532,25 @@ CONST
    SysErrActive : Boolean = False;                    { Compatability only }
    FailSysErrors: Boolean = False;                    { Compatability only }
    ButtonCount  : Byte = 0;                           { Mouse button count }
-   DoubleDelay  : Word = 8;                           { Double click delay }
-   RepeatDelay  : Word = 8;                           { Auto mouse delay }
-   SysColorAttr : Word = $4E4F;                       { System colour attr }
-   SysMonoAttr  : Word = $7070;                       { System mono attr }
-   StartupMode  : Word = $FFFF;                       { Compatability only }
-   CursorLines  : Word = $FFFF;                       { Compatability only }
+   DoubleDelay  : Sw_Word = 8;                           { Double click delay }
+   RepeatDelay  : Sw_Word = 8;                           { Auto mouse delay }
+   SysColorAttr : Sw_Word = $4E4F;                       { System colour attr }
+   SysMonoAttr  : Sw_Word = $7070;                       { System mono attr }
+   StartupMode  : Sw_Word = $FFFF;                       { Compatability only }
+   CursorLines  : Sw_Word = $FFFF;                       { Compatability only }
    ScreenBuffer : Pointer = Nil;                      { Compatability only }
    SaveInt09    : Pointer = Nil;                      { Compatability only }
-   SysErrorFunc : TSysErrorFunc = SystemError;        { System error ptr }
+   SysErrorFunc : TSysErrorFunc = {$ifdef FPC}@{$endif}SystemError; { System error ptr }
 
 {---------------------------------------------------------------------------}
 {          >>> NEW INITIALIZED DOS/DPMI/WIN/NT/OS2 VARIABLES <<<            }
 {---------------------------------------------------------------------------}
 CONST
    TextModeGFV    : Boolean = False;                  { DOS/DPMI textmode op }
-   DefLineNum     : Integer = 25;                     { Default line number }
-   DefFontHeight  : Integer = 0;                      { Default font height }
-   SysFontWidth   : Integer = 8;                      { System font width }
-   SysFontHeight  : Integer = 16;                     { System font height }
+   DefLineNum     : Sw_Integer = 25;                     { Default line number }
+   DefFontHeight  : Sw_Integer = 0;                      { Default font height }
+   SysFontWidth   : Sw_Integer = 8;                      { System font width }
+   SysFontHeight  : Sw_Integer = 16;                     { System font height }
 
 {***************************************************************************}
 {                      UNINITIALIZED PUBLIC VARIABLES                       }
@@ -565,7 +565,7 @@ VAR
    ScreenWidth : Byte;                                { Screen text width }
    ScreenHeight: Byte;                                { Screen text height }
 {$ifdef GRAPH_API}
-   ScreenMode  : Word;                                { Screen mode }
+   ScreenMode  : Sw_Word;                                { Screen mode }
 {$else not GRAPH_API}
    ScreenMode  : TVideoMode;                         { Screen mode }
 {$endif GRAPH_API}
@@ -628,10 +628,10 @@ CONST AltCodes: Array [0..127] Of Byte = (
 {                           NEW CONTROL VARIABLES                           }
 {---------------------------------------------------------------------------}
 CONST
-   HideCount : Integer = 0;                           { Cursor hide count }
-   QueueCount: Word = 0;                              { Queued message count }
-   QueueHead : Word = 0;                              { Queue head pointer }
-   QueueTail : Word = 0;                              { Queue tail pointer }
+   HideCount : Sw_Integer = 0;                           { Cursor hide count }
+   QueueCount: Sw_Word = 0;                              { Queued message count }
+   QueueHead : Sw_Word = 0;                              { Queue head pointer }
+   QueueTail : Sw_Word = 0;                              { Queue tail pointer }
 
 {***************************************************************************}
 {                 PRIVATE INTERNAL UNINITIALIZED VARIABLES                  }
@@ -644,14 +644,14 @@ VAR
    LastDouble : Boolean;                              { Last double buttons }
    LastButtons: Byte;                                 { Last button state }
    DownButtons: Byte;                                 { Last down buttons }
-   EventCount : Word;                                 { Events in queue }
-   AutoDelay  : Word;                                 { Delay time count }
-   DownTicks  : Word;                                 { Down key tick count }
-   AutoTicks  : Word;                                 { Held key tick count }
-   LastWhereX : Word;                                 { Last x position }
-   LastWhereY : Word;                                 { Last y position }
-   DownWhereX : Word;                                 { Last x position }
-   DownWhereY : Word;                                 { Last y position }
+   EventCount : Sw_Word;                                 { Events in queue }
+   AutoDelay  : Sw_Word;                                 { Delay time count }
+   DownTicks  : Sw_Word;                                 { Down key tick count }
+   AutoTicks  : Sw_Word;                                 { Held key tick count }
+   LastWhereX : Sw_Word;                                 { Last x position }
+   LastWhereY : Sw_Word;                                 { Last y position }
+   DownWhereX : Sw_Word;                                 { Last x position }
+   DownWhereY : Sw_Word;                                 { Last y position }
    LastWhere  : TPoint;                               { Last mouse position }
    DownWhere  : TPoint;                               { Last down position }
    EventQHead : Pointer;                              { Head of queue }
@@ -865,8 +865,8 @@ end;
 {---------------------------------------------------------------------------}
 {  CStrLen -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25May96 LdB           }
 {---------------------------------------------------------------------------}
-FUNCTION CStrLen (Const S: String): Integer;
-VAR I, J: Integer;
+FUNCTION CStrLen (Const S: String): Sw_Integer;
+VAR I, J: Sw_Integer;
 BEGIN
    J := 0;                                            { Set result to zero }
    For I := 1 To Length(S) Do
@@ -881,7 +881,7 @@ PROCEDURE MoveStr (Var Dest; Const Str: String; Attr: Byte);
 VAR I: Word; P: PWord;
 BEGIN
    For I := 1 To Length(Str) Do Begin                 { For each character }
-     P := @TWordArray(Dest)[I-1];                     { Pointer to word }
+     P := @TWordArray(Dest)[I-1];                     { Pointer to Sw_Word }
      If (Attr <> 0) Then WordRec(P^).Hi := Attr;      { Copy attribute }
      WordRec(P^).Lo := Byte(Str[I]);                  { Copy string char }
    End;
@@ -891,12 +891,12 @@ END;
 {  MoveCStr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 10Jul99 LdB          }
 {---------------------------------------------------------------------------}
 PROCEDURE MoveCStr (Var Dest; Const Str: String; Attrs: Word);
-VAR B: Byte; I, J: Word; P: PWord;
+VAR B: Byte; I, J: Sw_Word; P: PWord;
 BEGIN
    J := 0;                                            { Start position }
    For I := 1 To Length(Str) Do Begin                 { For each character }
      If (Str[I] <> '~') Then Begin                    { Not tilde character }
-       P := @TWordArray(Dest)[J];                     { Pointer to word }
+       P := @TWordArray(Dest)[J];                     { Pointer to Sw_Word }
        If (Lo(Attrs) <> 0) Then
          WordRec(P^).Hi := Lo(Attrs);                 { Copy attribute }
        WordRec(P^).Lo := Byte(Str[I]);                { Copy string char }
@@ -912,11 +912,11 @@ END;
 {---------------------------------------------------------------------------}
 {  MoveBuf -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 10Jul99 LdB           }
 {---------------------------------------------------------------------------}
-PROCEDURE MoveBuf (Var Dest, Source; Attr: Byte; Count: Word);
+PROCEDURE MoveBuf (Var Dest, Source; Attr: Byte; Count: Sw_Word);
 VAR I: Word; P: PWord;
 BEGIN
    For I := 1 To Count Do Begin
-     P := @TWordArray(Dest)[I-1];                     { Pointer to word }
+     P := @TWordArray(Dest)[I-1];                     { Pointer to Sw_Word }
      If (Attr <> 0) Then WordRec(P^).Hi := Attr;      { Copy attribute }
      WordRec(P^).Lo := TByteArray(Source)[I-1];       { Copy source data }
    End;
@@ -925,11 +925,11 @@ END;
 {---------------------------------------------------------------------------}
 {  MoveChar -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 10Jul99 LdB          }
 {---------------------------------------------------------------------------}
-PROCEDURE MoveChar (Var Dest; C: Char; Attr: Byte; Count: Word);
+PROCEDURE MoveChar (Var Dest; C: Char; Attr: Byte; Count: Sw_Word);
 VAR I: Word; P: PWord;
 BEGIN
    For I := 1 To Count Do Begin
-     P := @TWordArray(Dest)[I-1];                     { Pointer to word }
+     P := @TWordArray(Dest)[I-1];                     { Pointer to Sw_Word }
      If (Attr <> 0) Then WordRec(P^).Hi := Attr;      { Copy attribute }
      If (Ord(C) <> 0) Then WordRec(P^).Lo := Byte(C); { Copy character }
    End;
@@ -964,7 +964,7 @@ END;
 {  GetAltChar -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25May96 LdB        }
 {---------------------------------------------------------------------------}
 FUNCTION GetAltChar (KeyCode: Word): Char;
-VAR I: Integer;
+VAR I: Sw_Integer;
 BEGIN
    GetAltChar := #0;                                  { Preset fail return }
    If (Lo(KeyCode) = 0) Then Begin                    { Extended key }
@@ -997,10 +997,10 @@ FUNCTION CtrlToArrow (KeyCode: Word): Word;
 CONST NumCodes = 11;
       CtrlCodes : Array [0..NumCodes-1] Of Char =
         (#19, #4, #5, #24, #1, #6, #7, #22, #18, #3, #8);
-      ArrowCodes: Array [0..NumCodes-1] Of Word =
+      ArrowCodes: Array [0..NumCodes-1] Of Sw_Word =
        (kbLeft, kbRight, kbUp, kbDown, kbHome, kbEnd, kbDel, kbIns,
         kbPgUp, kbPgDn, kbBack);
-VAR I: Integer;
+VAR I: Sw_Integer;
 BEGIN
    CtrlToArrow := KeyCode;                            { Preset key return }
    For I := 0 To NumCodes - 1 Do
@@ -1029,7 +1029,7 @@ end;
 procedure GetKeyEvent (Var Event: TEvent);
 var
   key      : TKeyEvent;
-  keycode  : word;
+  keycode  : Word;
   keyshift : byte;
 begin
   if Keyboard.PollKeyEvent<>0 then
@@ -1205,11 +1205,11 @@ END;
 {  InitVideo -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Nov99 LdB         }
 {---------------------------------------------------------------------------}
 PROCEDURE InitVideo;
-VAR {$ifdef Use_API}I, J: Integer;
+VAR {$ifdef Use_API}I, J: Sw_Integer;
     {$else not Use_API}
-    {$IFDEF OS_DOS} I, J: Integer;Ts: TextSettingsType;{$ENDIF}
+    {$IFDEF OS_DOS} I, J: Sw_Integer;Ts: TextSettingsType;{$ENDIF}
     {$IFDEF OS_WINDOWS} Dc, Mem: HDc; TempFont: TLogFont; Tm: TTextmetric; {$ENDIF}
-    {$IFDEF OS_OS2} Ts, Fs: Integer; Ps: HPs; Tm: FontMetrics; {$ENDIF}
+    {$IFDEF OS_OS2} Ts, Fs: Sw_Integer; Ps: HPs; Tm: FontMetrics; {$ENDIF}
     {$ENDIF}
 BEGIN
 {$ifdef GRAPH_API}
@@ -1271,7 +1271,7 @@ END;
 {---------------------------------------------------------------------------}
 {  SetVideoMode -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 10Nov99 LdB      }
 {---------------------------------------------------------------------------}
-PROCEDURE SetVideoMode (Mode: Word);
+PROCEDURE SetVideoMode (Mode: Sw_Word);
 BEGIN
    If (Mode > $100) Then DefLineNum := 50             { 50 line mode request }
      Else DefLineNum := 24;                           { Normal 24 line mode }
@@ -1300,7 +1300,7 @@ END;
 {---------------------------------------------------------------------------}
 {  SystemError -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 20May98 LdB       }
 {---------------------------------------------------------------------------}
-FUNCTION SystemError (ErrorCode: Integer; Drive: Byte): Integer;
+FUNCTION SystemError (ErrorCode: Sw_Integer; Drive: Byte): Sw_Integer;
 BEGIN
    If (FailSysErrors = False) Then Begin              { Check error ignore }
 
@@ -1474,7 +1474,11 @@ BEGIN
 END.
 {
  $Log$
- Revision 1.10  2001-05-10 16:46:27  pierre
+ Revision 1.11  2001-08-04 19:14:33  peter
+   * Added Makefiles
+   * added FV specific units and objects from old FV
+
+ Revision 1.10  2001/05/10 16:46:27  pierre
   + some improovements made
 
  Revision 1.9  2001/05/07 22:22:03  pierre

+ 24 - 6
fv/fileio.pas

@@ -93,7 +93,7 @@ UNIT FileIO;
 
 USES
   {$IFDEF WIN16} WinTypes, WinProcs, {$ENDIF}         { Stardard BP units }
-  Common;                                             { Standard GFV unit }
+  FVCommon;                                           { Standard GFV unit }
 
 {***************************************************************************}
 {                             PUBLIC CONSTANTS                              }
@@ -154,7 +154,7 @@ access mode the file is opened and the file handle returned. If the
 name or mode is invalid or an error occurs the return will be zero.
 27Oct98 LdB
 ---------------------------------------------------------------------}
-FUNCTION FileOpen (Var FileName: AsciiZ; Mode: Word): THandle;
+FUNCTION FileOpen (Const FileName: AsciiZ; Mode: Word): THandle;
 
 {-SetFileSize--------------------------------------------------------
 The file opened by the handle is set the given size. If the action is
@@ -228,7 +228,21 @@ FUNCTION FileWrite (Handle: THandle; Var Buf; Count: Sw_Word; Var Actual: Sw_Wor
 {$ENDIF}
 
 {$IFDEF OS_LINUX}                                     { LINUX COMPILER }
-  USES unix;
+  USES
+    {$ifdef VER1_0}
+      linux;
+    {$else}
+      unix;
+    {$endif}
+{$ENDIF}
+
+{$IFDEF OS_FREEBSD}                                   { FREEBSD COMPILER }
+  USES
+    {$ifdef VER1_0}
+      linux;
+    {$else}
+      unix;
+    {$endif}
 {$ENDIF}
 
 {***************************************************************************}
@@ -292,7 +306,7 @@ END;
 {---------------------------------------------------------------------------}
 {  FileOpen -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 27Oct98 LdB          }
 {---------------------------------------------------------------------------}
-FUNCTION FileOpen (Var FileName: AsciiZ; Mode: Word): THandle;
+FUNCTION FileOpen (Const FileName: AsciiZ; Mode: Word): THandle;
 {$IFDEF OS_DOS}                                       { DOS/DPMI CODE }
    {$IFDEF ASM_BP}                                    { BP COMPATABLE ASM }
    ASSEMBLER;
@@ -679,7 +693,11 @@ END;
 END.
 {
  $Log$
- Revision 1.4  2001-05-03 15:55:44  pierre
+ Revision 1.5  2001-08-04 19:14:33  peter
+   * Added Makefiles
+   * added FV specific units and objects from old FV
+
+ Revision 1.4  2001/05/03 15:55:44  pierre
   + linux support for fileio contributed by Holger Schurig
 
  Revision 1.3  2001/04/10 21:29:55  pierre
@@ -689,4 +707,4 @@ END.
   * CVS log and ID tags
 
 
-}
+}

+ 430 - 0
fv/fvcommon.pas

@@ -0,0 +1,430 @@
+{ $Id$  }
+{********************[ COMMON UNIT ]***********************}
+{                                                          }
+{    System independent COMMON TYPES & DEFINITIONS         }
+{                                                          }
+{    Parts Copyright (c) 1997 by Balazs Scheidler          }
+{    [email protected]                                      }
+{                                                          }
+{    Parts Copyright (c) 1999, 2000 by Leon de Boer        }
+{    [email protected]  - primary e-mail address       }
+{    [email protected] - backup e-mail address     }
+{                                                          }
+{****************[ THIS CODE IS FREEWARE ]*****************}
+{                                                          }
+{     This sourcecode is released for the purpose to       }
+{   promote the pascal language on all platforms. You may  }
+{   redistribute it and/or modify with the following       }
+{   DISCLAIMER.                                            }
+{                                                          }
+{     This SOURCE CODE is distributed "AS IS" WITHOUT      }
+{   WARRANTIES AS TO PERFORMANCE OF MERCHANTABILITY OR     }
+{   ANY OTHER WARRANTIES WHETHER EXPRESSED OR IMPLIED.     }
+{                                                          }
+{*****************[ SUPPORTED PLATFORMS ]******************}
+{     16 and 32 Bit compilers                              }
+{        DOS      - Turbo Pascal 7.0 +      (16 Bit)       }
+{        DPMI     - Turbo Pascal 7.0 +      (16 Bit)       }
+{                 - FPC 0.9912+ (GO32V2)    (32 Bit)       }
+{        WINDOWS  - Turbo Pascal 7.0 +      (16 Bit)       }
+{                 - Delphi 1.0+             (16 Bit)       }
+{        WIN95/NT - Delphi 2.0+             (32 Bit)       }
+{                 - Virtual Pascal 2.0+     (32 Bit)       }
+{                 - Speedsoft Sybil 2.0+    (32 Bit)       }
+{                 - FPC 0.9912+             (32 Bit)       }
+{        OS2      - Virtual Pascal 1.0+     (32 Bit)       }
+{                 - Speed Pascal 1.0+       (32 Bit)       }
+{                 - C'T patch to BP         (16 Bit)       }
+{                                                          }
+{******************[ REVISION HISTORY ]********************}
+{  Version  Date      Who    Fix                           }
+{  -------  --------  ---    ----------------------------  }
+{  0.1     12 Jul 97  Bazsi  Initial implementation        }
+{  0.2     18 Jul 97  Bazsi  Linux specific error codes    }
+{  0.2.2   28 Jul 97  Bazsi  Base error code for Video     }
+{  0.2.3   29 Jul 97  Bazsi  Basic types added (PByte etc) }
+{  0.2.5   08 Aug 97  Bazsi  Error handling code added     }
+{  0.2.6   06 Sep 97  Bazsi  Base code for keyboard        }
+{  0.2.7   06 Nov 97  Bazsi  Base error code for filectrl  }
+{  0.2.8   21 Jan 99  LdB    Max data sizes added.         }
+{  0.2.9   22 Jan 99  LdB    General array types added.    }
+{  0.3.0   27 Oct 99  LdB    Delphi3+ MaxAvail, MemAvail   }
+{  0.4.0   14 Nov 00  LdB    Revamp of whole unit          }
+{**********************************************************}
+
+UNIT FVCommon;
+
+{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
+                                  INTERFACE
+{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
+
+{====Include file to sort compiler platform out =====================}
+{$I Platform.inc}
+{====================================================================}
+
+{***************************************************************************}
+{                              PUBLIC CONSTANTS                             }
+{***************************************************************************}
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{                        SYSTEM ERROR BASE CONSTANTS                        }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+{---------------------------------------------------------------------------}
+{  The following ranges have been defined for error codes:                  }
+{---------------------------------------------------------------------------}
+{        0 -  1000    OS dependant error codes                              }
+{     1000 - 10000    API reserved error codes                              }
+{    10000 -          Add-On unit error codes                               }
+{---------------------------------------------------------------------------}
+
+{---------------------------------------------------------------------------}
+{                         DEFINED BASE ERROR CONSTANTS                      }
+{---------------------------------------------------------------------------}
+CONST
+   errOk                = 0;                          { No error }
+   errVioBase           = 1000;                       { Video base offset }
+   errKbdBase           = 1010;                       { Keyboard base offset }
+   errFileCtrlBase      = 1020;                       { File IO base offset }
+   errMouseBase         = 1030;                       { Mouse base offset }
+
+{---------------------------------------------------------------------------}
+{                            MAXIUM DATA SIZES                              }
+{---------------------------------------------------------------------------}
+CONST
+{$IFDEF BIT_16}                                       { 16 BIT DEFINITION }
+   MaxBytes = 65520;                                  { Maximum data size }
+{$ENDIF}
+{$IFDEF BIT_32}                                       { 32 BIT DEFINITION }
+   MaxBytes = 128*1024*1024;                          { Maximum data size }
+{$ENDIF}
+   MaxWords = MaxBytes DIV SizeOf(Word);              { Max words }
+   MaxInts  = MaxBytes DIV SizeOf(Integer);           { Max integers }
+   MaxLongs = MaxBytes DIV SizeOf(LongInt);           { Max longints }
+   MaxPtrs  = MaxBytes DIV SizeOf(Pointer);           { Max pointers }
+   MaxReals = MaxBytes DIV SizeOf(Real);              { Max reals }
+   MaxStr   = MaxBytes DIV SizeOf(String);            { Max strings }
+
+{***************************************************************************}
+{                          PUBLIC TYPE DEFINITIONS                          }
+{***************************************************************************}
+
+{---------------------------------------------------------------------------}
+{                           CPU TYPE DEFINITIONS                            }
+{---------------------------------------------------------------------------}
+TYPE
+{$IFDEF BIT_32}                                       { 32 BIT CODE }
+   CPUWord = Longint;                                 { CPUWord is 32 bit }
+   CPUInt = Longint;                                  { CPUInt is 32 bit }
+{$ELSE}                                               { 16 BIT CODE }
+   CPUWord = Word;                                    { CPUWord is 16 bit }
+   CPUInt = Integer;                                  { CPUInt is 16 bit }
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{                     16/32 BIT SWITCHED TYPE CONSTANTS                     }
+{---------------------------------------------------------------------------}
+TYPE
+{$IFDEF BIT_16}                                       { 16 BIT DEFINITIONS }
+   Sw_Word    = Word;                                 { Standard word }
+   Sw_Integer = Integer;                              { Standard integer }
+{$ENDIF}
+{$IFDEF BIT_32}                                       { 32 BIT DEFINITIONS }
+   Sw_Word    = LongInt;                              { Long integer now }
+   Sw_Integer = LongInt;                              { Long integer now }
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{                           FILE HANDLE SIZE                                }
+{---------------------------------------------------------------------------}
+TYPE
+{$IFDEF OS_DOS}                                       { DOS DEFINITION }
+   THandle = Integer;                                 { Handles are 16 bits }
+{$ENDIF}
+{$IFDEF OS_ATARI}                                     { ATARI DEFINITION }
+   THandle = Integer;                                 { Handles are 16 bits }
+{$ENDIF}
+{$IFDEF OS_LINUX}                                     { LINUX DEFINITIONS }
+ { values are words, though the OS calls return 32-bit values }
+ { to check (CEC)                                             }
+  THandle = LongInt;                                  { Simulated 32 bits }
+{$ENDIF}
+{$IFDEF OS_AMIGA}                                     { AMIGA DEFINITIONS }
+  THandle = LongInt;                                  { Handles are 32 bits }
+{$ENDIF}
+{$IFDEF OS_WINDOWS}                                   { WIN/NT DEFINITIONS }
+  THandle = sw_Integer;                               { Can be either }
+{$ENDIF}
+{$IFDEF OS_OS2}                                       { OS2 DEFINITIONS }
+  THandle = sw_Integer;                               { Can be either }
+{$ENDIF}
+{$IFDEF OS_MAC}                                       { MACINTOSH DEFINITIONS }
+  THandle = LongInt;                                  { Handles are 32 bits }
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{                      POINTERS TO STANDARD DATA TYPES                      }
+{---------------------------------------------------------------------------}
+TYPE
+   PByte = ^Byte;                                     { Pointer to byte }
+   PWord = ^Word;                                     { Pointer to word }
+   PLongint = ^Longint;                               { Pointer to longint }
+
+{---------------------------------------------------------------------------}
+{                               GENERAL ARRAYS                              }
+{---------------------------------------------------------------------------}
+TYPE
+   TByteArray = ARRAY [0..MaxBytes-1] Of Byte;        { Byte array }
+   PByteArray = ^TByteArray;                          { Byte array pointer }
+
+   TWordArray = ARRAY [0..MaxWords-1] Of Word;        { Word array }
+   PWordArray = ^TWordArray;                          { Word array pointer }
+
+   TIntegerArray = ARRAY [0..MaxInts-1] Of Integer;   { Integer array }
+   PIntegerArray = ^TIntegerArray;                    { Integer array pointer }
+
+   TLongIntArray = ARRAY [0..MaxLongs-1] Of LongInt;  { LongInt array }
+   PLongIntArray = ^TLongIntArray;                    { LongInt array pointer }
+
+   TRealArray = Array [0..MaxReals-1] Of Real;        { Real array }
+   PRealarray = ^TRealArray;                          { Real array pointer }
+
+   TPointerArray = Array [0..MaxPtrs-1] Of Pointer;   { Pointer array }
+   PPointerArray = ^TPointerArray;                    { Pointer array ptr }
+
+   TStrArray = Array [0..MaxStr-1] Of String;         { String array }
+   PStrArray = ^TStrArray;                            { String array ptr }
+
+{***************************************************************************}
+{                            INTERFACE ROUTINES                             }
+{***************************************************************************}
+
+{-GetErrorCode-------------------------------------------------------
+Returns the last error code and resets ErrorCode to errOk.
+07/12/97 Bazsi
+---------------------------------------------------------------------}
+FUNCTION GetErrorCode: LongInt;
+
+{-GetErrorInfo-------------------------------------------------------
+Returns the info assigned to the previous error, doesn't reset the
+value to nil. Would usually only be called if ErrorCode <> errOk.
+07/12/97 Bazsi
+---------------------------------------------------------------------}
+FUNCTION GetErrorInfo: Pointer;
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{                        MINIMUM AND MAXIMUM ROUTINES                       }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+FUNCTION Min (I, J: Sw_Integer): Sw_Integer;
+FUNCTION Max (I, J: Sw_Integer): Sw_Integer;
+
+{-MinimumOf----------------------------------------------------------
+Given two real numbers returns the minimum real of the two.
+04Oct99 LdB
+---------------------------------------------------------------------}
+FUNCTION MinimumOf (A, B: Real): Real;
+
+{-MaximumOf----------------------------------------------------------
+Given two real numbers returns the maximum real of the two.
+04Oct99 LdB
+---------------------------------------------------------------------}
+FUNCTION MaximumOf (A, B: Real): Real;
+
+{-MinIntegerOf-------------------------------------------------------
+Given two integer values returns the lowest integer of the two.
+04Oct99 LdB
+---------------------------------------------------------------------}
+FUNCTION MinIntegerOf (A, B: Integer): Integer;
+
+{-MaxIntegerof-------------------------------------------------------
+Given two integer values returns the biggest integer of the two.
+04Oct99 LdB
+---------------------------------------------------------------------}
+FUNCTION MaxIntegerOf (A, B: Integer): Integer;
+
+{-MinLongIntOf-------------------------------------------------------
+Given two long integers returns the minimum longint of the two.
+04Oct99 LdB
+---------------------------------------------------------------------}
+FUNCTION MinLongIntOf (A, B: LongInt): LongInt;
+
+{-MaxLongIntOf-------------------------------------------------------
+Given two long integers returns the maximum longint of the two.
+04Oct99 LdB
+---------------------------------------------------------------------}
+FUNCTION MaxLongIntOf (A, B: LongInt): LongInt;
+
+{$IFDEF PPC_DELPHI3}                                  { DELPHI 3+ CODE }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{                          MISSING DELPHI3 ROUTINES                         }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+{ ******************************* REMARK ****************************** }
+{  Delphi 3+ does not define these standard routines so I have made     }
+{  some public functions here to complete compatability.                }
+{ ****************************** END REMARK *** Leon de Boer, 14Aug98 * }
+
+{-MemAvail-----------------------------------------------------------
+Returns the free memory available under Delphi 3+.
+14Aug98 LdB
+---------------------------------------------------------------------}
+FUNCTION MemAvail: LongInt;
+
+{-MaxAvail-----------------------------------------------------------
+Returns the max free memory block size available under Delphi 3+.
+14Aug98 LdB
+---------------------------------------------------------------------}
+FUNCTION MaxAvail: LongInt;
+{$ENDIF}
+
+{***************************************************************************}
+{                        INITIALIZED PUBLIC VARIABLES                       }
+{***************************************************************************}
+
+{---------------------------------------------------------------------------}
+{                INITIALIZED DOS/DPMI/WIN/NT/OS2 VARIABLES                  }
+{---------------------------------------------------------------------------}
+CONST
+   ErrorCode: Longint = errOk;                        { Last error code }
+   ErrorInfo: Pointer = Nil;                          { Last error info }
+
+{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
+                               IMPLEMENTATION
+{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
+
+{$IFDEF PPC_DELPHI3}                                  { DELPHI 3+ COMPILER }
+USES WinTypes, WinProcs;                              { Stardard units }
+{$ENDIF}
+
+{***************************************************************************}
+{                            INTERFACE ROUTINES                             }
+{***************************************************************************}
+
+{---------------------------------------------------------------------------}
+{  GetErrorCode -> Platforms ALL - Updated 12Jul97 Bazsi                    }
+{---------------------------------------------------------------------------}
+FUNCTION GetErrorCode: LongInt;
+BEGIN
+   GetErrorCode := ErrorCode;                         { Return last error }
+   ErrorCode := 0;                                    { Now clear errorcode }
+END;
+
+{---------------------------------------------------------------------------}
+{  GetErrorInfo -> Platforms ALL - Updated 12Jul97 Bazsi                    }
+{---------------------------------------------------------------------------}
+FUNCTION GetErrorInfo: Pointer;
+BEGIN
+   GetErrorInfo := ErrorInfo;                         { Return errorinfo ptr }
+END;
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{                        MINIMUM AND MAXIMUM ROUTINES                       }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+FUNCTION Min (I, J: Sw_Integer): Sw_Integer;
+BEGIN
+  If (I < J) Then Min := I Else Min := J;          { Select minimum }
+END;
+
+FUNCTION Max (I, J: Sw_Integer): Sw_Integer;
+BEGIN
+  If (I > J) Then Max := I Else Max := J;          { Select maximum }
+END;
+
+
+{---------------------------------------------------------------------------}
+{  MinimumOf -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB         }
+{---------------------------------------------------------------------------}
+FUNCTION MinimumOf (A, B: Real): Real;
+BEGIN
+   If (B < A) Then MinimumOf := B                     { B smaller take it }
+     Else MinimumOf := A;                             { Else take A }
+END;
+
+{---------------------------------------------------------------------------}
+{  MaximumOf -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB         }
+{---------------------------------------------------------------------------}
+FUNCTION MaximumOf (A, B: Real): Real;
+BEGIN
+   If (B > A) Then MaximumOf := B                     { B bigger take it }
+     Else MaximumOf := A;                             { Else take A }
+END;
+
+{---------------------------------------------------------------------------}
+{  MinIntegerOf -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB      }
+{---------------------------------------------------------------------------}
+FUNCTION MinIntegerOf (A, B: Integer): Integer;
+BEGIN
+   If (B < A) Then MinIntegerOf := B                  { B smaller take it }
+     Else MinIntegerOf := A;                          { Else take A }
+END;
+
+{---------------------------------------------------------------------------}
+{  MaxIntegerOf -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB      }
+{---------------------------------------------------------------------------}
+FUNCTION MaxIntegerOf (A, B: Integer): Integer;
+BEGIN
+   If (B > A) Then MaxIntegerOf := B                  { B bigger take it }
+     Else MaxIntegerOf := A;                          { Else take A }
+END;
+
+{---------------------------------------------------------------------------}
+{  MinLongIntOf -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB      }
+{---------------------------------------------------------------------------}
+FUNCTION MinLongIntOf (A, B: LongInt): LongInt;
+BEGIN
+   If (B < A) Then MinLongIntOf := B                  { B smaller take it }
+     Else MinLongIntOf := A;                          { Else take A }
+END;
+
+{---------------------------------------------------------------------------}
+{  MaxLongIntOf -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB      }
+{---------------------------------------------------------------------------}
+FUNCTION MaxLongIntOf (A, B: LongInt): LongInt;
+BEGIN
+   If (B > A) Then MaxLongIntOf := B                  { B bigger take it }
+     Else MaxLongIntOf := A;                          { Else take A }
+END;
+
+{$IFDEF PPC_DELPHI3}                                  { DELPHI 3+ CODE }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{                          MISSING DELPHI3 ROUTINES                         }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+{---------------------------------------------------------------------------}
+{  MemAvail -> Platforms WIN/NT - Updated 14Aug98 LdB                       }
+{---------------------------------------------------------------------------}
+FUNCTION MemAvail: LongInt;
+VAR Ms: TMemoryStatus;
+BEGIN
+   GlobalMemoryStatus(Ms);                            { Get memory status }
+   MemAvail := Ms.dwAvailPhys;                        { Avail physical memory }
+END;
+
+{---------------------------------------------------------------------------}
+{  MaxAvail -> Platforms WIN/NT - Updated 14Aug98 LdB                       }
+{---------------------------------------------------------------------------}
+FUNCTION MaxAvail: LongInt;
+VAR Ms: TMemoryStatus;
+BEGIN
+   GlobalMemoryStatus(Ms);                            { Get memory status }
+   MaxAvail := Ms.dwTotalPhys;                        { Max physical memory }
+END;
+{$ENDIF}
+
+END.
+{
+ $Log$
+ Revision 1.1  2001-08-04 19:14:33  peter
+   * Added Makefiles
+   * added FV specific units and objects from old FV
+
+ Revision 1.3  2001/04/10 21:29:55  pierre
+  * import of Leon de Boer's files
+
+ Revision 1.2  2000/08/24 12:00:20  marco
+  * CVS log and ID tags
+
+
+}

+ 631 - 0
fv/fvconsts.pas

@@ -0,0 +1,631 @@
+{ $Id$  }
+{********[ SOURCE FILE OF GRAPHICAL FREE VISION ]**********}
+{                                                          }
+{   System independent GRAPHICAL clone of DIALOGS.PAS      }
+{                                                          }
+{   Interface Copyright (c) 1992 Borland International     }
+{                                                          }
+{   Copyright (c) 1996, 1997, 1998, 1999 by Leon de Boer   }
+{   [email protected]  - primary e-mail addr           }
+{   [email protected] - backup e-mail addr            }
+{                                                          }
+{****************[ THIS CODE IS FREEWARE ]*****************}
+{                                                          }
+{     This sourcecode is released for the purpose to       }
+{   promote the pascal language on all platforms. You may  }
+{   redistribute it and/or modify with the following       }
+{   DISCLAIMER.                                            }
+{                                                          }
+{     This SOURCE CODE is distributed "AS IS" WITHOUT      }
+{   WARRANTIES AS TO PERFORMANCE OF MERCHANTABILITY OR     }
+{   ANY OTHER WARRANTIES WHETHER EXPRESSED OR IMPLIED.     }
+{                                                          }
+{*****************[ SUPPORTED PLATFORMS ]******************}
+{                                                          }
+{ Only Free Pascal Compiler supported                      }
+{                                                          }
+{**********************************************************}
+unit FVConsts;
+interface
+
+{
+  The ObjTypes unit declares constants for all object type IDs used in the
+  FreeVision library.  They have been moved here for easier management.  No
+  values for views declared in TV 2.0 have been changed from so that original
+  resource files may still be used.
+}
+const
+  { Views Unit }
+  idView = 1;
+  idFrame = 2;
+  idScrollBar = 3;
+  idScroller = 4;
+  idListViewer = 5;
+  idGroup = 6;
+  idWindow = 7;
+
+  { Dialogs Unit 10 - ? }
+  idDialog = 10;
+  idInputLine = 11;
+  idButton = 12;
+  idCluster = 13;
+  idRadioButtons = 14;
+  idCheckBoxes = 15;
+  idMultiCheckBoxes = 27;
+  idListBox = 16;
+  idStaticText = 17;
+  idLabel = 18;
+  idHistory = 19;
+  idParamText = 20;
+  idCommandCheckBoxes = 21;
+  idCommandRadioButtons = 22;
+  idCommandIcon = 23;
+  idBrowseButton = 24;
+  idEditListBox = 25;
+  idModalInputLine = 26;
+  idListDlg = 27;
+
+  { App Unit }
+  idBackground = 30;
+  idDesktop = 31;
+
+  { Config Unit }
+  idConfig = 32;
+  idMouseDlg = 33;
+  idVideoDlg = 34;
+  idClickTester = 35;
+
+  { Menus Unit }
+  idMenuBar = 40;
+  idMenuBox = 41;
+  idStatusLine = 42;
+  idMenuPopup = 43;
+  idMenuButton = 44;
+
+  { Objects Unit }
+  idCollection = 50;
+  idStringCollection = 51;
+  idStringList = 52;
+  idStrListMaker = 52;
+  idStrCollection = 69;
+
+  { Resource Unit }
+  idMemStringList = 52;
+
+  { StdDlg Unit }
+  idFileInputLine = 60;
+  idFileCollection = 61;
+  idFileList = 62;
+  idFileInfoPane = 63;
+  idFileDialog = 64;
+  idDirCollection = 65;
+  idDirListBox = 66;
+  idChDirDialog = 67;
+  idSortedListBox = 68;
+  idEditChDirDialog = 69;
+
+  { Editors Unit   70 - ? }
+  idEditor = 70;
+  idMemo = 71;
+  idFileEditor = 72;
+  idIndicator = 73;
+  idEditWindow = 74;
+  idEditWindowCollection = 75; { this value may need to be changed }
+  idEditorEngine = 76;
+
+  { Validate Unit }
+  idPXPictureValidator = 80;
+  idFilterValidator = 81;
+  idRangeValidator = 82;
+  idStringLookupValidator = 83;
+  idRealValidator = 84;
+  idByteValidator = 85;
+  idIntegerValidator = 86;
+  idSingleValidator = 87;
+  idWordValidator = 88;
+  idDateValidator = 89;
+  idTimeValidator = 90;
+
+  { Outline Unit }
+  idOutline = 91;
+
+  { ColorSel Unit }
+  idColorSelector = 92;
+  idMonoSelector = 93;
+  idColorDisplay = 94;
+  idColorGroupList = 95;
+  idColorItemList = 96;
+  idColorDialog = 97;
+
+  { Statuses Unit }
+  idStatus   = 300;
+  idStatusDlg = 301;
+  idStatusMessageDlg = 302;
+  idGauge = 303;
+  idArrowGauge = 304;
+  idBarGauge = 305;
+  idPercentGauge = 306;
+  idSpinnerGauge = 307;
+  idAppStatus = 308;
+  idHeapMinAvail = 309;
+  idHeapMemAvail = 310;
+
+  { FVList Unit }
+
+
+{
+ The Commands unit contains all command constants used in the FreeVision
+ library.  They have been extracted from their original units and placed here
+ for easier maintainence and modification to remove conflicts, such as Borland
+ created with the cmChangeDir constant in the StdDlg and App units.
+}
+
+const
+  { App Unit }
+  cmNew           = 30;
+  cmOpen          = 31;
+  cmSave          = 32;
+  cmSaveAs        = 33;
+  cmSaveAll       = 34;
+  cmSaveDone      = 35;
+  cmChangeDir     = 36;
+  cmDosShell      = 37;
+  cmCloseAll      = 38;
+  cmDelete        = 39;
+  cmEdit          = 40;
+  cmAbout         = 41;
+  cmDesktopLoad   = 42;
+  cmDesktopStore  = 43;
+  cmNewDesktop    = 44;
+  cmNewMenuBar    = 45;
+  cmNewStatusLine = 46;
+  cmNewVideo      = 47;
+  cmTransfer      = 48;
+
+  cmRecordHistory  = 60;
+  cmGrabDefault    = 61;
+  cmReleaseDefault = 62;
+
+  cmHelpContents  = 256;
+  cmHelpIndex     = 257;
+  cmHelpTopic     = 258;
+  cmHelpPrev      = 259;
+  cmHelpUsingHelp = 260;
+  cmHelpAbout     = 261;
+
+  cmBrowseDir     = 262;
+  cmBrowseFile    = 263;
+
+  { Views Unit }
+  cmValid   = 0;
+  cmQuit    = 1;
+  cmError   = 2;
+  cmMenu    = 3;
+  cmClose   = 4;
+  cmZoom    = 5;
+  cmResize  = 6;
+  cmNext    = 7;
+  cmPrev    = 8;
+  cmHelp    = 9;
+  cmOK      = 10;
+  cmCancel  = 11;
+  cmYes     = 12;
+  cmNo      = 13;
+  cmDefault = 14;
+  cmCut     = 20;
+  cmCopy    = 21;
+  cmPaste   = 22;
+  cmUndo    = 23;
+  cmClear   = 24;
+  cmTile    = 25;
+  cmCascade = 26;
+  cmHide    = 27;
+  cmReceivedFocus     = 50;
+  cmReleasedFocus     = 51;
+  cmCommandSetChanged = 52;
+  cmScrollBarChanged  = 53;
+  cmScrollBarClicked  = 54;
+  cmSelectWindowNum   = 55;
+  cmListItemSelected  = 56;
+
+  { ColorSel Unit }
+  cmColorForegroundChanged = 71;
+  cmColorBackgroundChanged = 72;
+  cmColorSet               = 73;
+  cmNewColorItem           = 74;
+  cmNewColorIndex          = 75;
+  cmSaveColorIndex         = 76;
+
+  { StdDlg Unit   800 - ? }
+  cmFileOpen    = 800;   { Returned from TFileDialog when Open pressed }
+  cmFileReplace = 801;   { Returned from TFileDialog when Replace pressed }
+  cmFileClear   = 802;   { Returned from TFileDialog when Clear pressed }
+  cmFileInit    = 803;   { Used by TFileDialog internally }
+  cmRevert      = 805;   { Used by TChDirDialog internally }
+  cmFileFocused = 806;    { A new file was focused in the TFileList }
+  cmFileDoubleClicked = 807;  { A file was selected in the TFileList }
+
+  { Config Unit   130-140, 900-999 }
+  cmConfigMouse       = 130; { Mouse command disabled by Init if no mouse }
+  cmConfigOpen        = 900;
+  cmConfigSave        = 901;
+  cmConfigSaveAs      = 902;
+  cmConfigMenu        = 903;
+  cmConfigColors      = 904;
+  cmConfigVideo       = 905;
+  cmConfigCO80        = 906;
+  cmConfigBW80        = 907;
+  cmConfigMono        = 908;
+  cmClock             = 909;
+  cmClockSetFormat    = 910;
+
+    { Editors Unit }
+  cmFind           = 82;
+  cmReplace        = 83;
+  cmSearchAgain    = 84;
+  cmPrint          = 85;
+  cmRedo           = 86;
+  cmJumpLine       = 87;
+  cmWindowList     = 88;
+  cmCharLeft       = 500;
+  cmCharRight      = 501;
+  cmWordLeft       = 502;
+  cmWordRight      = 503;
+  cmLineStart      = 504;
+  cmLineEnd        = 505;
+  cmLineUp         = 506;
+  cmLineDown       = 507;
+  cmPageUp         = 508;
+  cmPageDown       = 509;
+  cmTextStart      = 510;
+  cmTextEnd        = 511;
+  cmNewLine        = 512;
+  cmBackSpace      = 513;
+  cmDelChar        = 514;
+  cmDelWord        = 515;
+  cmDelStart       = 516;
+  cmDelEnd         = 517;
+  cmDelLine        = 518;
+  cmInsMode        = 519;
+  cmStartSelect    = 520;
+  cmHideSelect     = 521;
+  cmEndSelect      = 522;
+  cmIndentMode     = 523;
+  cmUpdateTitle    = 524;
+  cmReformPara     = 525;
+  cmTabKey         = 526;
+  cmInsertLine     = 527;
+  cmScrollUp       = 528;
+  cmScrollDown     = 529;
+  cmHomePage       = 530;
+  cmEndPage        = 531;
+  cmJumpMark0      = 532;
+  cmJumpMark1      = 533;
+  cmJumpMark2      = 534;
+  cmJumpMark3      = 535;
+  cmJumpMark4      = 536;
+  cmJumpMark5      = 537;
+  cmJumpMark6      = 538;
+  cmJumpMark7      = 539;
+  cmJumpMark8      = 540;
+  cmJumpMark9      = 541;
+  cmReformDoc      = 542;
+  cmSetMark0       = 543;
+  cmSetMark1       = 544;
+  cmSetMark2       = 545;
+  cmSetMark3       = 546;
+  cmSetMark4       = 547;
+  cmSetMark5       = 548;
+  cmSetMark6       = 549;
+  cmSetMark7       = 550;
+  cmSetMark8       = 551;
+  cmSetMark9       = 552;
+  cmSelectWord     = 553;
+  cmSaveExit       = 554;
+  cmCenterText     = 555;
+  cmSetTabs        = 556;
+  cmRightMargin    = 557;
+  cmWordwrap       = 558;
+  cmBludgeonStats  = 559;
+  cmPrinterSetup   = 560;
+  cmClipboard      = 561;
+  cmSpellCheck     = 562;
+  cmCopyBlock      = 563;
+  cmMoveBlock      = 564;
+  cmDelSelect      = 565;
+  cmIdentBlock     = 566;
+  cmUnidentBlock   = 567;
+  cmFileHistory    = 600;
+
+  { Statuses Unit }
+  cmStatusUpdate = 300;  { note - need to set to valid value }
+  cmStatusDone   = 301;
+  cmStatusPause  = 302;
+  cmStatusResume = 303;
+
+  cmCursorChanged = 700;
+
+
+{
+  The HelpCtx unit declares standard help contexts used in FreeVision.  By
+  placing all help contexts in one unit, duplicate help contexts are more
+  easily prevented
+}
+
+const
+
+  hcNoContext = 0;
+  hcDragging = 1;
+  hcOk = 2;
+  hcCancel = 3;
+  hcEdit   = 4;
+  hcDelete = 5;
+  hcInsert = 6;
+
+    { App Unit }
+  hcNew = 65281;        hcFileNew = hcNew;
+  hcOpen = 65282;       hcFileOpen = hcOpen;
+  hcSave = 65283;       hcFileSave = hcSave;
+  hcSaveAs = 65284;     hcFileSaveAs = hcSaveAs;
+  hcSaveAll = 65285;    hcFileSaveAll = hcSaveAll;
+  hcChangeDir = 65286;  hcFileChangeDir = hcChangeDir;
+  hcDosShell = 65287;   hcFileDOSShell = hcDosShell;
+  hcExit = 65288;       hcFileExit = hcExit;
+  hcEditMenu = 65289;
+  hcHelpMenu = 65291;
+  hcHelpContents = 65292;
+  hcHelpIndex = 65293;
+  hcHelpTopic = 65294;
+  hcHelpPrev = 65295;
+  hcHelpUsingHelp = 65296;
+  hcHelpAbout = 65297;
+  hcWindowMenu = 65298;
+  hcUndo         = $FF10;
+  hcCut          = $FF11;
+  hcCopy         = $FF12;
+  hcPaste        = $FF13;
+  hcClear        = $FF14;
+  hcTile         = $FF20;
+  hcCascade      = $FF21;
+  hcCloseAll     = $FF22;
+  hcResize       = $FF23;
+  hcZoom         = $FF24;
+  hcNext         = $FF25;
+  hcPrev         = $FF26;
+  hcClose        = $FF27;
+  hcHide         = $FF28;
+  hcFileMenu     = 65320;
+  hcSearchAndReplace =65325;
+
+    { Editors Unit }
+  hcFile_Menu            = 2100;
+{ hcOpen                 = 2101; }
+{ hcNew                  = 2102; }
+{ hcSave                 = 2103; }
+  hcSaveDone             = 2104;
+{ hcSaveAs               = 2105; }
+{ hcChangeDir            = 2106; }
+{ hcShellToDos           = 2107; }
+{ hcExit                 = 2108; }
+  hcFile_Menu_Items      = hcExit;
+
+  hcEdit_Menu            = 2200;
+{ hcUndo                 = 2201; }
+{ hcCopy                 = 2202; }
+{ hcCut                  = 2203; }
+{ hcPaste                = 2204; }
+  hcClipboard            = 2205;
+{ hcClear                = 2206; }
+  hcSpellCheck           = 2207;
+  hcEdit_Menu_Items      = hcSpellCheck;
+
+  hcSearch_Menu          = 2300;
+  hcFind                 = 2301;
+  hcReplace              = 2302;
+  hcAgain                = 2303;
+  hcSearch_Menu_Items    = hcAgain;
+
+  hcWindows_Menu         = 2400;
+{  hcResize               = 2401; }
+{  hcZoom                 = 2402; }
+{  hcPrev                 = 2403; }
+{  hcNext                 = 2404; }
+{  hcClose                = 2405; }
+{  hcTile                 = 2406; }
+{  hcCascade              = 2407; }
+  hcWindows_Menu_Items   = hcCascade;
+
+  hcDesktop_Menu         = 2500;
+  hcLoadDesktop          = 2501;
+  hcSaveDesktop          = 2502;
+  hcToggleVideo          = 2503;
+  hcDesktop_Menu_Items   = hcToggleVideo;
+
+  hcMisc_Commands        = 2600;
+  hckbShift              = 2601;
+  hckbCtrl               = 2602;
+  hckbAlt                = 2603;
+  hcMisc_Items           = hckbAlt;
+
+  hcEditor_Commands      = 2700;
+  hcCursor               = 2701;
+  hcDeleting             = 2702;
+  hcFormatting           = 2703;
+  hcMarking              = 2704;
+  hcMoving               = 2705;
+  hcSaving               = 2706;
+  hcSelecting            = 2707;
+  hcTabbing              = 2708;
+  hcBackSpace            = 2709;
+  hcCenterText           = 2710;
+  hcCharLeft             = 2711;
+  hcCharRight            = 2712;
+  hcDelChar              = 2713;
+  hcDelEnd               = 2714;
+  hcDelLine              = 2715;
+  hcDelStart             = 2716;
+  hcDelWord              = 2717;
+  hcEndPage              = 2718;
+  hcHideSelect           = 2719;
+  hcHomePage             = 2720;
+  hcIndentMode           = 2721;
+  hcInsertLine           = 2722;
+  hcInsMode              = 2723;
+  hcJumpLine             = 2724;
+  hcLineDown             = 2725;
+  hcLineEnd              = 2726;
+  hcLineStart            = 2727;
+  hcLineUp               = 2728;
+  hcNewLine              = 2729;
+  hcPageDown             = 2730;
+  hcPageUp               = 2731;
+  hcReformDoc            = 2732;
+  hcReformPara           = 2733;
+  hcRightMargin          = 2734;
+  hcScrollDown           = 2735;
+  hcScrollUp             = 2736;
+  hcSearchAgain          = 2737;
+  hcSelectWord           = 2738;
+  hcSetTabs              = 2739;
+  hcStartSelect          = 2740;
+  hcTabKey               = 2741;
+  hcTextEnd              = 2742;
+  hcTextStart            = 2743;
+  hcWordLeft             = 2744;
+  hcWordRight            = 2745;
+  hcWordWrap             = 2746;
+
+  hcJMarker_Menu         = 2750;
+  hcJumpMark1            = 2751;
+  hcJumpMark2            = 2752;
+  hcJumpMark3            = 2753;
+  hcJumpMark4            = 2754;
+  hcJumpMark5            = 2755;
+  hcJumpMark6            = 2756;
+  hcJumpMark7            = 2757;
+  hcJumpMark8            = 2758;
+  hcJumpMark9            = 2759;
+  hcJumpMark0            = 2760;
+  hcJMarker_Menu_Items   = 2761;
+
+  hcSMarker_Menu         = 2770;
+  hcSetMark1             = 2771;
+  hcSetMark2             = 2772;
+  hcSetMark3             = 2773;
+  hcSetMark4             = 2774;
+  hcSetMark5             = 2775;
+  hcSetMark6             = 2776;
+  hcSetMark7             = 2777;
+  hcSetMark8             = 2778;
+  hcSetMark9             = 2779;
+  hcSetMark0             = 2780;
+  hcSMarker_Menu_Items   = 2781;
+
+  hcEditor_Items         = hcSMarker_Menu_Items;
+
+  { Dialog }
+  hcDialogs              = 2800;
+  hcDCancel              = 2801;
+  hcDNo                  = 2802;
+  hcDOk                  = 2803;
+  hcDYes                 = 2804;
+  hcDAbout               = 2805;
+  hcDDirName             = 2806;
+  hcDDirTree             = 2807;
+  hcDChDir               = 2808;
+  hcDRevert              = 2809;
+  hcDName                = 2810;
+  hcDFiles               = 2811;
+  hcDFindText            = 2812;
+  hcDLineNumber          = 2813;
+  hcDReformDoc           = 2814;
+  hcDReplaceTExt         = 2815;
+  hcDRightMargin         = 2816;
+  hcDTabStops            = 2817;
+  hcListDlg              = 2818;
+
+  { Checkbox help }
+  hcCCaseSensitive       = 2900;
+  hcCWholeWords          = 2901;
+  hcCPromptReplace       = 2902;
+  hcCReplaceAll          = 2903;
+  hcCReformCurrent       = 2904;
+  hcCReformEntire        = 2905;
+
+    { Statuses unit }
+  hcStatusPause          = 2950;
+  hcStatusResume         = 2951;
+
+  { Glossary }
+  Glossary               = 3000;
+  GCloseIcon             = 3001;
+  GDesktop               = 3002;
+  GDialogBox             = 3003;
+  GHistoryIcon           = 3004;
+  GInputLine             = 3005;
+  GMemIndicator          = 3006;
+  GMenuBar               = 3007;
+  GPulldownMenu          = 3008;
+  GResizeCorner          = 3009;
+  GSelectedText          = 3010;
+  GStatusBar             = 3011;
+  GTitleBar              = 3012;
+  GWindowBorder          = 3013;
+  GZoomIcon              = 3014;
+  hcGlossary_Items       = GZoomIcon;
+
+    { INI Unit }
+  hcDateFormatDlg = 1;
+  hcDateParts = 1;
+  hcDateOrder = 1;
+  hcTimeFormatDlg = 1;
+  hcClockFormatDlg = 1;
+  hcClockDateParts = 1;
+  hcClockTimeFormat = 1;
+
+  hcListViewer = 1;
+
+  { Options Help Contexts }
+  hcConfigMenu          = 100;
+  hcConfigColors        = hcConfigMenu + 1;
+  hcConfigDate          = hcConfigColors + 1;
+  hcConfigEnvironment   = hcConfigDate + 1;
+  hcConfigMouse         = hcConfigEnvironment + 1;
+  hcConfigOpen          = hcConfigMouse + 1;
+  hcConfigSave          = hcConfigOpen + 1;
+  hcConfigSaveAs        = hcConfigSave + 1;
+  hcConfigTime          = hcConfigSaveAs + 1;
+  hcConfigVideo         = hcConfigTime + 1;
+  hcConfigDesktopDlg    = hcConfigVideo + 1;
+  hcConfigMouseDlg      = hcConfigDesktopDlg + 1;
+  hcConfigTimeFormatDlg = hcConfigMouseDlg + 1;
+  hcConfigTimeSeparator = hcConfigTimeFormatDlg + 1;
+  hcConfigTimeComponents = hcConfigTimeSeparator + 1;
+  hcConfigTimeStyle = hcConfigTimeComponents + 1;
+  hcConfigClock = hcConfigTimeStyle + 1;
+  hcBrowseDir = 1;
+  hcBrowseFile = 1;
+
+
+{
+  The History unit contains all history list constants used in the FreeVision
+  Library.
+}
+
+const
+  hiConfig = 1;
+  hiDirectories = 2;  { non-specific }
+  hiDesktop = 3;
+  hiCurrentDirectories = 1;
+  hiFiles = 4;
+
+implementation
+
+end.
+{
+  $Log$
+  Revision 1.1  2001-08-04 19:14:33  peter
+    * Added Makefiles
+    * added FV specific units and objects from old FV
+
+}

+ 7 - 3
fv/gadgets.pas

@@ -95,7 +95,7 @@ UNIT Gadgets;
 {$V-} { Turn off strict VAR strings }
 {====================================================================}
 
-USES Common, Time, Objects, Drivers, Views, App;      { Standard GFV units }
+USES FVConsts, Time, Objects, Drivers, Views, App;      { Standard GFV units }
 
 {***************************************************************************}
 {                        PUBLIC OBJECT DEFINITIONS                          }
@@ -226,8 +226,12 @@ END;
 END.
 {
  $Log$
- Revision 1.2  2000-08-24 12:00:21  marco
+ Revision 1.3  2001-08-04 19:14:33  peter
+   * Added Makefiles
+   * added FV specific units and objects from old FV
+
+ Revision 1.2  2000/08/24 12:00:21  marco
   * CVS log and ID tags
 
 
-}
+}

+ 30 - 7
fv/histlist.pas

@@ -76,7 +76,7 @@ UNIT HistList;
 {$V-} { Turn off strict VAR strings }
 {====================================================================}
 
-USES Common, Objects;                                 { Standard GFV units }
+USES FVCommon, Objects;                                 { Standard GFV units }
 
 {***************************************************************************}
 {                            INTERFACE ROUTINES                             }
@@ -112,7 +112,7 @@ FUNCTION HistoryCount (Id: Byte): Word;
 Returns the Index'th string in the history list with ID number Id.
 30Sep99 LdB
 ---------------------------------------------------------------------}
-FUNCTION HistoryStr (Id: Byte; Index: Integer): String;
+FUNCTION HistoryStr (Id: Byte; Index: Sw_Integer): String;
 
 {-ClearHistory-------------------------------------------------------
 Removes all strings from all history lists.
@@ -126,6 +126,8 @@ Adds the string Str to the history list indicated by Id.
 ---------------------------------------------------------------------}
 PROCEDURE HistoryAdd (Id: Byte; Const Str: String);
 
+function HistoryRemove(Id: Byte; Index: Sw_Integer): boolean;
+
 {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 {              HISTORY STREAM STORAGE AND RETREIVAL ROUTINES                }
 {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
@@ -204,7 +206,7 @@ END;
 {  DeleteString -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB      }
 {---------------------------------------------------------------------------}
 PROCEDURE DeleteString;
-VAR Len: Integer; P, P2: PChar;
+VAR Len: Sw_Integer; P, P2: PChar;
 BEGIN
    P := PChar(CurString);                             { Current string }
    P2 := PChar(CurString);                            { Current string }
@@ -307,8 +309,8 @@ END;
 {---------------------------------------------------------------------------}
 {  HistoryStr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB        }
 {---------------------------------------------------------------------------}
-FUNCTION HistoryStr(Id: Byte; Index: Integer): String;
-VAR I: Integer;
+FUNCTION HistoryStr(Id: Byte; Index: Sw_Integer): String;
+VAR I: Sw_Integer;
 BEGIN
    StartId(Id);                                       { Set to first record }
    If (HistoryBlock <> Nil) Then Begin                { History initalized }
@@ -346,6 +348,23 @@ BEGIN
    InsertString(Id, Str);                             { Add new history item }
 END;
 
+function HistoryRemove(Id: Byte; Index: Sw_Integer): boolean;
+var
+  I: Sw_Integer;
+begin
+  StartId(Id);
+  for I := 0 to Index do
+   AdvanceStringPtr;                                  { Find the string }
+  if CurString <> nil then
+    begin
+       DeleteString;
+       HistoryRemove:=true;
+    end
+  else
+    HistoryRemove:=false;
+end;
+
+
 {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 {              HISTORY STREAM STORAGE AND RETREIVAL ROUTINES                }
 {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
@@ -381,8 +400,12 @@ END.
 
 {
  $Log$
- Revision 1.2  2000-08-24 12:00:22  marco
+ Revision 1.3  2001-08-04 19:14:33  peter
+   * Added Makefiles
+   * added FV specific units and objects from old FV
+
+ Revision 1.2  2000/08/24 12:00:22  marco
   * CVS log and ID tags
 
 
-}
+}

+ 304 - 0
fv/inplong.pas

@@ -0,0 +1,304 @@
+Unit InpLong;
+
+(*--
+TInputLong is a derivitave of TInputline designed to accept LongInt
+numeric input.  Since both the upper and lower limit of acceptable numeric
+input can be set, TInputLong may be used for Integer, Word, or Byte input
+as well.  Option flag bits allow optional hex input and display.  A blank
+field may optionally be rejected or interpreted as zero.
+
+Methods
+
+constructor Init(var R : TRect; AMaxLen : Integer;
+                LowerLim, UpperLim : LongInt; Flgs : Word);
+
+Calls TInputline.Init and saves the desired limits and Flags.  Flags may
+be a combination of:
+
+ilHex          will accept hex input (preceded by '$')  as well as decimal.
+ilBlankEqZero  if set, will interpret a blank field as '0'.
+ilDisplayHex   if set, will display numeric as hex when possible.
+
+
+constructor Load(var S : TStream);
+procedure Store(var S : TStream);
+
+The usual Load and Store routines.  Be sure to call RegisterType(RInputLong)
+to register the type.
+
+
+FUNCTION DataSize : Word; virtual;
+PROCEDURE GetData(var Rec); virtual;
+PROCEDURE SetData(var Rec); virtual;
+
+The transfer methods.  DataSize is Sizeof(LongInt) and Rec should be
+the address of a LongInt.
+
+
+FUNCTION RangeCheck : Boolean; virtual;
+
+Returns True if the entered string evaluates to a number >= LowerLim and
+<= UpperLim.
+
+
+PROCEDURE Error; virtual;
+
+Error is called when RangeCheck fails.  It displays a messagebox indicating
+the label (if any) of the faulting view, as well as the allowable range.
+
+
+PROCEDURE HandleEvent(var Event : TEvent); virtual;
+
+HandleEvent filters out characters which are not appropriate to numeric
+input.  Tab and Shift Tab cause a call to RangeCheck and a call to Error
+if RangeCheck returns false.  The input must be valid to Tab from the view.
+There's no attempt made to stop moving to another view with the mouse.
+
+
+FUNCTION Valid(Cmd : Word) : Boolean; virtual;
+
+if TInputline.Valid is true and Cmd is neither cmValid or cmCancel, Valid
+then calls RangeCheck.  If RangeCheck is false, then Error is called and
+Valid returns False.
+
+----*)
+
+{$i platform.inc}
+
+{$ifdef PPC_FPC}
+  {$H-}
+{$else}
+  {$F+,O+,E+,N+}
+{$endif}
+{$X+,R-,I-,Q-,V-}
+{$ifndef OS_LINUX}
+  {$S-}
+{$endif}
+
+Interface
+uses Objects, Drivers, Views, Dialogs, MsgBox;
+
+{flags for TInputLong constructor}
+const
+  ilHex = 1;          {will enable hex input with leading '$'}
+  ilBlankEqZero = 2;  {No input (blank) will be interpreted as '0'}
+  ilDisplayHex = 4;   {Number displayed as hex when possible}
+Type
+  TInputLong = Object(TInputLine)
+    ILOptions : Word;
+    LLim, ULim : LongInt;
+    constructor Init(var R : TRect; AMaxLen : Sw_Integer;
+        LowerLim, UpperLim : LongInt; Flgs : Word);
+    constructor Load(var S : TStream);
+    procedure Store(var S : TStream);
+    FUNCTION DataSize : Sw_Word; virtual;
+    PROCEDURE GetData(var Rec); virtual;
+    PROCEDURE SetData(var Rec); virtual;
+    FUNCTION RangeCheck : Boolean; virtual;
+    PROCEDURE Error; virtual;
+    PROCEDURE HandleEvent(var Event : TEvent); virtual;
+    FUNCTION Valid(Cmd : Word) : Boolean; virtual;
+    end;
+  PInputLong = ^TInputLong;
+
+const
+  RInputLong : TStreamRec = (
+    ObjType: 711;
+    VmtLink: Ofs(Typeof(TInputLong)^);
+    Load : @TInputLong.Load;
+    Store : @TInputLong.Store);
+
+Implementation
+
+uses
+  FVConsts;
+
+{-----------------TInputLong.Init}
+constructor TInputLong.Init(var R : TRect; AMaxLen : Sw_Integer;
+        LowerLim, UpperLim : LongInt; Flgs : Word);
+begin
+if not TInputLine.Init(R, AMaxLen) then fail;
+ULim := UpperLim;
+LLim := LowerLim;
+if Flgs and ilDisplayHex <> 0 then Flgs := Flgs or ilHex;
+ILOptions := Flgs;
+if ILOptions and ilBlankEqZero <> 0 then Data^ := '0';
+end;
+
+{-------------------TInputLong.Load}
+constructor TInputLong.Load(var S : TStream);
+begin
+TInputLine.Load(S);
+S.Read(ILOptions, Sizeof(ILOptions)+Sizeof(LLim)+Sizeof(ULim));
+end;
+
+{-------------------TInputLong.Store}
+procedure TInputLong.Store(var S : TStream);
+begin
+TInputLine.Store(S);
+S.Write(ILOptions, Sizeof(ILOptions)+Sizeof(LLim)+Sizeof(ULim));
+end;
+
+{-------------------TInputLong.DataSize}
+FUNCTION TInputLong.DataSize:Sw_Word;
+begin
+DataSize := Sizeof(LongInt);
+end;
+
+{-------------------TInputLong.GetData}
+PROCEDURE TInputLong.GetData(var Rec);
+var code : Integer;
+begin
+Val(Data^, LongInt(Rec), code);
+end;
+
+FUNCTION Hex2(B : Byte) : String;
+Const
+  HexArray : array[0..15] of char = '0123456789ABCDEF';
+begin
+Hex2[0] := #2;
+Hex2[1] := HexArray[B shr 4];
+Hex2[2] := HexArray[B and $F];
+end;
+
+FUNCTION Hex4(W : Word) : String;
+begin Hex4 := Hex2(Hi(W))+Hex2(Lo(W)); end;
+
+FUNCTION Hex8(L : LongInt) : String;
+begin Hex8 := Hex4(LongRec(L).Hi)+Hex4(LongRec(L).Lo); end;
+
+function FormHexStr(L : LongInt) : String;
+var
+  Minus : boolean;
+  S : string[20];
+begin
+Minus := L < 0;
+if Minus then L := -L;
+S := Hex8(L);
+while (Length(S) > 1) and (S[1] = '0') do Delete(S, 1, 1);
+S := '$' + S;
+if Minus then System.Insert('-', S, 2);
+FormHexStr := S;
+end;
+
+{-------------------TInputLong.SetData}
+PROCEDURE TInputLong.SetData(var Rec);
+var
+  L : LongInt;
+  S : string;
+begin
+L := LongInt(Rec);
+if L > ULim then L := ULim
+else if L < LLim then L := LLim;
+if ILOptions and ilDisplayHex <> 0 then
+  S := FormHexStr(L)
+else
+  Str(L : -1, S);
+if Length(S) > MaxLen then S[0] := chr(MaxLen);
+Data^ := S;
+end;
+
+{-------------------TInputLong.RangeCheck}
+FUNCTION TInputLong.RangeCheck : Boolean;
+var
+  L : LongInt;
+  code : Integer;
+begin
+if (Data^ = '') and (ILOptions and ilBlankEqZero <> 0) then
+  Data^ := '0';
+Val(Data^, L, code);
+RangeCheck := (Code = 0) and (L >= LLim) and (L <= ULim);
+end;
+
+{-------------------TInputLong.Error}
+PROCEDURE TInputLong.Error;
+var
+  SU, SL : string[40];
+  PMyLabel : PLabel;
+  Labl : string;
+  I : Integer;
+
+  function FindIt(P : PView) : boolean;{$ifdef PPC_BP}far;{$endif}
+  begin
+  FindIt := (Typeof(P^) = Typeof(TLabel)) and (PLabel(P)^.Link = PView(@Self));
+  end;
+
+begin
+Str(LLim : -1, SL);
+Str(ULim : -1, SU);
+if ILOptions and ilHex <> 0 then
+  begin
+  SL := SL+'('+FormHexStr(LLim)+')';
+  SU := SU+'('+FormHexStr(ULim)+')';
+  end;
+if Owner <> Nil then
+  PMyLabel := PLabel(Owner^.FirstThat(@FindIt))
+else PMyLabel := Nil;
+if PMyLabel <> Nil then PMyLabel^.GetText(Labl)
+else Labl := '';
+if Labl <> '' then
+  begin
+  I := Pos('~', Labl);
+  while I > 0 do
+    begin
+    System.Delete(Labl, I, 1);
+    I := Pos('~', Labl);
+    end;
+  Labl := '"'+Labl+'"';
+  end;
+MessageBox(Labl + ^M^J'Value not within range '+SL+' to '+SU, Nil,
+                            mfError+mfOKButton);
+end;
+
+{-------------------TInputLong.HandleEvent}
+PROCEDURE TInputLong.HandleEvent(var Event : TEvent);
+begin
+if (Event.What = evKeyDown) then
+  begin
+    case Event.KeyCode of
+       kbTab, kbShiftTab
+          : if not RangeCheck then
+              begin
+              Error;
+              SelectAll(True);
+              ClearEvent(Event);
+              end;
+      end;
+  if Event.CharCode <> #0 then  {a character key}
+    begin
+    Event.Charcode := Upcase(Event.Charcode);
+    case Event.Charcode of
+      '0'..'9', #1..#$1B : ;       {acceptable}
+
+      '-'       : if (LLim >= 0) or (CurPos <> 0) then
+                        ClearEvent(Event);
+      '$'       : if ILOptions and ilHex = 0 then ClearEvent(Event);
+      'A'..'F'  : if Pos('$', Data^) = 0 then ClearEvent(Event);
+
+      else ClearEvent(Event);
+      end;
+    end;
+  end;
+TInputLine.HandleEvent(Event);
+end;
+
+{-------------------TInputLong.Valid}
+FUNCTION TInputLong.Valid(Cmd : Word) : Boolean;
+var
+  Rslt : boolean;
+begin
+Rslt := TInputLine.Valid(Cmd);
+if Rslt and (Cmd <> 0) and (Cmd <> cmCancel) then
+  begin
+  Rslt := RangeCheck;
+  if not Rslt then
+    begin
+    Error;
+    Select;
+    SelectAll(True);
+    end;
+  end;
+Valid := Rslt;
+end;
+
+end.

+ 7 - 3
fv/memory.pas

@@ -75,7 +75,7 @@ UNIT Memory;
 {$V-} { Turn off strict VAR strings }
 {====================================================================}
 
-USES Common;
+USES FVCommon;
 
 {***************************************************************************}
 {                            INTERFACE ROUTINES                             }
@@ -828,8 +828,12 @@ END.
 
 {
  $Log$
- Revision 1.2  2000-08-24 12:00:22  marco
+ Revision 1.3  2001-08-04 19:14:33  peter
+   * Added Makefiles
+   * added FV specific units and objects from old FV
+
+ Revision 1.2  2000/08/24 12:00:22  marco
   * CVS log and ID tags
 
 
-}
+}

+ 738 - 0
fv/resource.pas

@@ -0,0 +1,738 @@
+{ Resource Unit
+
+  Programmer: Brad Williams
+  BitSoft Development, L.L.C.
+  Copyright (c) 1996
+  Version 1.1
+
+Revision History
+
+1.1   (12/26/97)
+  - updated to add cdResource directive so that can use standard TStringList
+    resources created by TVRW and TVDT
+
+1.0
+  - original implementation }
+
+unit Resource;
+
+interface
+
+{
+  The Resource unit provides global variables which are used to build and
+  access resource files.  InitRez must always be called before accessing any
+  variables in the Resource unit.  The programmer should also always call
+  Done to free all file handles allocated to the program.
+}
+
+{$i platform.inc}
+
+{$ifdef PPC_FPC}
+  {$H-}
+{$else}
+  {$F+,O+,E+,N+}
+{$endif}
+{$X+,R-,I-,Q-,V-}
+{$ifndef OS_LINUX}
+  {$S-}
+{$endif}
+
+uses
+
+  FVConsts, Objects, Dos;
+
+const
+
+  RezExt: ExtStr = '.RES';
+    { The file extension used on all resource files. }
+  RezBufferSize: Word = 4096;
+    { RezBufferSize is the number of bytes to use for the resource file's
+      stream's buffer.  RezBufferSize is passed to TBufStream.Init. }
+
+    { reXXXX constants are used with resource files to retrieve the standard
+      Free Vision dialogs.  The constant is followed by the Unit in which it
+      is used and the resource which is stored separated by a period. }
+
+  reChDirDialog = 'ChDirDialog';  { StdDlg.TChDirDialog }
+  reEditChDirDialog = 'EditChDirDialog';  { StdDlg.TEditChDirDialog }
+  reFindTextDlg = 'FindTextDlg';  { Editors.CreateFindDialog }
+  reHints = 'Hints'; { Resource.Hints }
+  reJumpLineDlg = 'JumpLineDlg';  { Editors.MakeJumpLineDlg }
+  reLabels = 'Labels';  { Resource.Labels }
+  reMenuBar = 'MenuBar';  { App.MenuBar }
+  reOpenDlg = 'OpenDlg';  { StdDlg.TFileDialog - Open }
+  reReformDocDlg = 'ReformDocDlg';  { Editors.MakeReformDocDlg }
+  reReplaceDlg = 'ReplaceDlg';  { Editors.CreateReplaceDialog }
+  reRightMarginDlg = 'RightMarginDlg';  { Editors.MakeRightMarginDlg }
+  reStatusLine = 'StatusLine';  { App.StatusLine }
+  reStrings = 'Strings';  { Resource.Strings }
+  reSaveAsDlg = 'SaveAsDlg';  { StdDlg.TFileDialog - Save As }
+  reTabStopDlg = 'TabStopDlg';  { Editors.MakeTabStopDlg }
+  reWindowListDlg = 'WindowListDlg';  { Editors.MakeWindowListDlg }
+  reAboutDlg = 'About';  { App unit about dialog }
+
+  {$I str.inc}
+    { STR.INC declares all the string list constants used in the standard
+      Free Vision library units.  They are placed in a separate file as a
+      template for use by the resource file generator, MakeRez.
+
+      Applications which use resource files and need to add strings of their
+      own should use STR.INC as the start for the resource file.
+
+      See MakeRez.PAS for more information about generating resource files.}
+
+type
+
+
+  PConstant = ^TConstant;
+  TConstant = object(TObject)
+    Value: Word;
+      { The value assigned to the constant. }
+    constructor Init (AValue: Word; AText: string);
+      { Init assigns AValue to Value to AText to Text.  AText may be an empty
+        string.
+
+        If an error occurs Init fails. }
+    destructor Done; virtual;
+      { Done disposes of Text then calls the inherited destructor. }
+    procedure SetText (AText: string);
+      { SetText changes FText to the word equivalent of AText. }
+    procedure SetValue (AValue: string);
+      { SetValue changes Value to the word equivalent of AValue. }
+    function Text: string;
+      { Text returns a string equivalent to FText.  If FText is nil, an
+        empty string is returned. }
+    function ValueAsString: string;
+      { ValueAsString returns the string equivalent of Value. }
+      private
+    FText: PString;
+      { The text to display for the constant. }
+  end;  { of TConstant }
+
+
+  PMemStringList = ^TMemStringList;
+  TMemStringList = object(TSortedCollection)
+    { A TMemStringList combines the functions of a TStrListMaker and a
+      TStringList into one object, allowing generation and use of string
+      lists in the same application.  TMemStringList is fully compatible
+      with string lists created using TStrListMaker, so legacy applications
+      will work without problems.
+
+      When using a string list in the same program as it is created, a
+      resource file is not required.  This allows language independant coding
+      of units without the need for conditional defines and recompiling. }
+    constructor Init;
+      { Creates an empty, in-memory string list that is not associated with a
+        resource file. }
+    constructor Load (var S: TStream);
+      { Load creates a TStringList from which it gets its strings upon a call
+        to Get.  The strings on the resource file may be loaded into memory
+        for editing by calling LoadList.
+
+        If initialized with Load, the stream must remain valid for the life
+        of this object. }
+    destructor Done; virtual;
+      { Done deallocates the memory allocated to the string list. }
+    function Compare (Key1, Key2: Pointer): Sw_Integer; virtual;
+      { Compare assumes Key1 and Key2 are Word values and returns:
+
+            -1  if Key1 < Key2
+             0  if Key1 = Key2
+             1  if Key1 > Key2 }
+    function Get (Key: Word): String; virtual;
+      { GetKey searches for a string with a key matching Key and returns it.
+        An empty string is returned if a string with a matching Key is not
+        found.
+
+        If Count > 0, the in memory collection is searched.  If List^.Count
+        is 0, the inherited Get method is called. }
+    procedure Insert (Item: Pointer); virtual;
+      { If Item is not nil, Insert attempts to insert the item into the
+        collection.  If a collection expansion error occurs Insert disposes
+        of Item by calling FreeItem.
+
+        Item must be a pointer to a TConstant or its descendant. }
+    function KeyOf (Item: Pointer): Pointer; virtual;
+      { KeyOf returns a pointer to TConstant.Value. }
+    function LoadStrings: Sw_Integer;
+      { LoadStrings reads all strings the associated resource file into
+        memory, places them in the collection, and returns 0.
+
+        If an error occurs LoadStrings returns the stream status error code
+        or a DOS error code.  Possible DOS error codes include:
+
+               2:   no associated resource file
+               8:   out of memory }
+    function NewConstant (Value: Word; S: string): PConstant; virtual;
+      { NewConstant is called by LoadStrings. }
+    procedure Put (Key: Word; S: String); virtual;
+      { Put creates a new PConstant containing Key and Word then calls
+        Insert to place it in the collection. }
+    procedure Store (var S: TStream);
+      { Store creates a TStrListMaker, fills it with the items in List,
+        writes the TStrListMaker to the stream by calling
+        TStrListMaker.Store, then disposes of the TStrListMaker. }
+  private
+    StringList: PStringList;
+  end;  { of TMemStringList) }
+
+
+var
+
+  {$ifdef cdResource}
+  Hints: PStringList;
+  {$else}
+  Hints: PMemStringList;
+  {$endif cdResource}
+    { Hints is a string list for use within the application to provide
+      context sensitive help on the command line.  Hints is always used in
+      the application. }
+
+  {$ifdef cdResource}
+  Strings: PStringList;
+  {$else}
+  Strings: PMemStringList;
+  {$endif cdResource}
+    { Strings holds messages such as errors and general information that are
+      displayed at run-time, normally with MessageBox.  Strings is always
+      used in the application. }
+
+  {$ifdef cdResource}
+  Labels: PStringList;
+  {$else}
+  Labels: PMemStringList;
+  {$endif cdResource}
+    { Labels is a string list for use within the application when a
+      resource file is not used, or when creating a resource file.  Labels
+      contains all text used in dialog titles, labels, buttons, menus,
+      statuslines, etc., used in the application which can be burned into
+      language specific resources.  It does not contain any messages
+      displayed at run-time using MessageBox or the status line hints.
+
+      Using the Labels variable when creating views allows language
+      independant coding of views such as the MessageBox, StdDlg and Editors
+      units. }
+
+  RezFile: PResourceFile;
+    { RezFile is a global variable used when the Free Vision library
+      is compiled using the cdResource conditional define, or when creating
+      resource files.
+
+      All standard Free Vision application resources are accessed from the
+      resource file using the reXXXX constants.  Modify the STR.INC under a
+      new file name to create new language specific resource files.  See the
+      MakeRez program file for more information. }
+
+
+
+procedure DoneResource;
+  { Done destructs all objects initialized in this unit and frees all
+    allocated heap. }
+
+{$ifndef cdResource}
+function InitResource: Boolean;
+{$endif cdResource}
+  { Init initializes the Hints and Strings for use with in memory strings
+    lists.  Init should be used in applications which do not use a resource
+    file, or when creating resource files.  }
+
+{$ifdef cdResource}
+function InitRezFile (AFile: FNameStr; Mode: Word;
+                      var AResFile: PResourceFile): Sw_Integer;
+{$endif cdResource}
+  { InitRezFile initializes a new PResourceFile using the name passed in
+    AFile and the stream mode passed in Mode and returns 0.
+
+    If an error occurs InitRezFile returns the DOS error and AResFile is
+    invalid.  Possible DOS error values include:
+
+        2: file not found or other stream initialization error
+        11: invalid format - not a valid resource file }
+
+{$ifdef cdResource}
+function LoadResource (AFile: FNameStr): Boolean;
+{$endif cdResource}
+  { Load is used to open a resource file for use in the application.
+
+    For Load to return True, the resource file must be properly opened and
+    assigned to RezFile and the Hints string list must be successfully loaded
+    from the stream.  If an error occurs, Load displays an English error
+    message using PrintStr and returns False. }
+
+function MergeLists (Source, Dest: PMemStringList): Sw_Integer;
+  { MergeLists moves all key/string pairs from Source to destination,
+    deleting them from Source.  Duplicate strings are ignored. }
+
+
+const
+  RMemStringList: TStreamRec = (
+    ObjType: idMemStringList;
+    VmtLink: Ofs(TypeOf(TMemStringList)^);
+    Load: @TMemStringList.Load;
+    Store: @TMemStringList.Store);
+
+
+implementation
+
+{****************************************************************************}
+{                           Private Declarations                             }
+{****************************************************************************}
+
+uses
+  Memory, Drivers;
+
+{****************************************************************************}
+{ TConstant object                                                           }
+{****************************************************************************}
+{****************************************************************************}
+{ TConstant.Init                                                             }
+{****************************************************************************}
+constructor TConstant.Init (AValue: Word; AText: string);
+begin
+  if not inherited Init then
+    Fail;
+  Value := AValue;
+  FText := NewStr(AText);
+  if (FText = nil) and (AText <> '') then
+  begin
+    inherited Done;
+    Fail;
+  end;
+end;
+
+{****************************************************************************}
+{ TConstant.Done                                                             }
+{****************************************************************************}
+destructor TConstant.Done;
+begin
+  DisposeStr(FText);
+  inherited Done;
+end;
+
+{****************************************************************************}
+{ TConstant.SetText                                                          }
+{****************************************************************************}
+procedure TConstant.SetText (AText: string);
+begin
+  DisposeStr(FText);
+  FText := NewStr(AText);
+end;
+
+{****************************************************************************}
+{ TConstant.SetValue                                                         }
+{****************************************************************************}
+procedure TConstant.SetValue (AValue: string);
+var
+  N: Word;
+  ErrorCode: Integer;
+begin
+  Val(AValue,N,ErrorCode);
+  if ErrorCode = 0 then
+    Value := N;
+end;
+
+{****************************************************************************}
+{ TConstant.Text                                                             }
+{****************************************************************************}
+function TConstant.Text: string;
+begin
+  if (FText = nil) then
+    Text := ''
+  else Text := FText^;
+end;
+
+{****************************************************************************}
+{ TConstant.ValueAsString                                                    }
+{****************************************************************************}
+function TConstant.ValueAsString: string;
+var
+  S: string[5];
+begin
+  Str(Value,S);
+  ValueAsString := S;
+end;
+
+{****************************************************************************}
+{ TMemStringList Object                                                      }
+{****************************************************************************}
+{****************************************************************************}
+{ TMemStringList.Init                                                        }
+{****************************************************************************}
+constructor TMemStringList.Init;
+begin
+  if not inherited Init(10,10) then
+    Fail;
+  StringList := nil;
+end;
+
+{****************************************************************************}
+{ TMemStringList.Load                                                        }
+{****************************************************************************}
+constructor TMemStringList.Load (var S: TStream);
+begin
+  if not inherited Init(10,10) then
+    Fail;
+  StringList := New(PStringList,Load(S));
+end;
+
+{****************************************************************************}
+{ TMemStringList.Done                                                        }
+{****************************************************************************}
+destructor TMemStringList.Done;
+begin
+  if (StringList <> nil) then
+    Dispose(StringList,Done);
+  inherited Done;
+end;
+
+{****************************************************************************}
+{ TMemStringList.Compare                                                     }
+{****************************************************************************}
+function TMemStringList.Compare (Key1, Key2: Pointer): Sw_Integer;
+begin
+  if Word(Key1^) < Word(Key2^) then
+    Compare := -1
+  else Compare := Byte(Word(Key1^) > Word(Key2^));
+end;
+
+{****************************************************************************}
+{ TMemStringList.Get                                                         }
+{****************************************************************************}
+function TMemStringList.Get (Key: Word): string;
+var
+  i: Sw_Integer;
+  S: string;
+begin
+  if (StringList = nil) then
+  begin  { started with Init, use in memory string list }
+    if Search(@Key,i) then
+      Get := PConstant(At(i))^.Text
+    else Get := '';
+  end
+  else begin
+    S := StringList^.Get(Key);
+    Get := S;
+  end;
+end;
+
+{****************************************************************************}
+{ TMemStringList.Insert                                                      }
+{****************************************************************************}
+procedure TMemStringList.Insert (Item: Pointer);
+var
+  i: Sw_Integer;
+begin
+  if (Item <> nil) then
+  begin
+    i := Count;
+    inherited Insert(Item);
+    if (i = Count) then  { collection expansion failed }
+      Dispose(PConstant(Item),Done);
+  end;
+end;
+
+{****************************************************************************}
+{ TMemStringList.KeyOf                                                       }
+{****************************************************************************}
+function TMemStringList.KeyOf (Item: Pointer): Pointer;
+begin
+  KeyOf := @(PConstant(Item)^.Value);
+end;
+
+{****************************************************************************}
+{ TMemStringList.LoadStrings                                                 }
+{****************************************************************************}
+function TMemStringList.LoadStrings: Sw_Integer;
+  procedure MakeEditableString (var Str: string);
+  const
+    SpecialChars: array[1..3] of Char = #3#10#13;
+  var
+    i, j: Byte;
+  begin
+    for i := 1 to 3 do
+      while (Pos(SpecialChars[i],Str) <> 0) do
+      begin
+        j := Pos(SpecialChars[i],Str);
+        System.Delete(Str,j,1);
+        case i of
+          1: System.Insert('#3',Str,j);
+          2: System.Insert('#10',Str,j);
+          3: System.Insert('#13',Str,j);
+        end;
+      end;
+  end;
+var
+  Constant: PConstant;
+  i: Word;
+  S: string;
+begin
+  LoadStrings := 0;
+  if (StringList = nil) then
+  begin
+    LoadStrings := 2;
+    Exit;
+  end;
+  for i := 0 to 65535 do
+  begin
+    S := StringList^.Get(i);
+    if (S <> '') then
+    begin
+      MakeEditableString(S);
+      Constant := NewConstant(i,S);
+      if LowMemory then
+      begin
+        if (Constant <> nil) then
+          Dispose(Constant,Done);
+        LoadStrings := 8;  { out of memory }
+        Exit;
+      end;
+      Insert(Constant);
+    end;
+  end;
+end;
+
+{****************************************************************************}
+{ TMemStringList.NewConstant                                                 }
+{****************************************************************************}
+function TMemStringList.NewConstant (Value: Word; S: string): PConstant;
+begin
+  NewConstant := New(PConstant,Init(Value,S));
+end;
+
+{****************************************************************************}
+{ TMemStringList.Put                                                         }
+{****************************************************************************}
+procedure TMemStringList.Put (Key: Word; S: string);
+begin
+  Insert(New(PConstant,Init(Key,S)));
+end;
+
+{****************************************************************************}
+{ TMemStringList.Store                                                       }
+{****************************************************************************}
+procedure TMemStringList.Store (var S: TStream);
+var
+  StrList: PStrListMaker;
+  Size: Word;
+  procedure Total (Constant: PConstant);{$ifndef FPC}far;{$endif}
+  begin
+    with Constant^ do
+      Inc(Size,Succ(Length(Text)));
+  end;
+  procedure AddString (Constant: PConstant);{$ifndef FPC}far;{$endif}
+  const
+    Numbers = ['0'..'9'];
+  var
+    i, j: Byte;
+    N: Byte;
+    ErrorCode: Integer;
+    S: string;
+  begin
+    with Constant^ do
+    begin
+        { convert formatting characters }
+      S := Text;
+      while (Pos('#',S) <> 0) do
+      begin
+        i := Succ(Pos('#',S));
+        j := i;
+        if (Length(S) > j) then
+          Inc(j,Byte(S[Succ(j)] in Numbers));
+        Val(Copy(S,i,j-i+1),N,ErrorCode);
+        System.Delete(S,Pred(i),j-i+2);
+        System.Insert(Char(N),S,Pred(i));
+      end;
+      StrList^.Put(Value,Text)
+    end;
+  end;
+begin
+  Size := 0;
+  ForEach(@Total);
+  StrList := New(PStrListMaker,Init(Size,Count * 6));
+  if (StrList = nil) then
+  begin
+    S.Status := 8;  { DOS error not enough memory }
+    Exit;
+  end;
+  ForEach(@AddString);
+  StrList^.Store(S);
+  Dispose(StrList,Done);
+end;
+
+{****************************************************************************}
+{                       Public Procedures and Functions                      }
+{****************************************************************************}
+
+{****************************************************************************}
+{ Done                                                                       }
+{****************************************************************************}
+procedure DoneResource;
+begin
+  if (RezFile <> nil) then
+    begin
+      Dispose(RezFile,Done);
+      RezFile:=nil;
+    end;
+  if (Strings <> nil) then
+    begin
+      Dispose(Strings,Done);
+      Strings:=nil;
+    end;
+  if (Hints <> nil) then
+    begin
+      Dispose(Hints,Done);
+      Hints:=nil;
+    end;
+  if (Labels <> nil) then
+    begin
+      Dispose(Labels,Done);
+      Labels:=nil;
+    end;
+end;
+
+{****************************************************************************}
+{ Init                                                                       }
+{****************************************************************************}
+{$ifndef cdResource}
+
+{$I strtxt.inc}
+  { strtxt.inc contains the real strings and procedures InitRes... which
+    is converted from str.inc }
+
+function InitResource: Boolean;
+begin
+  InitResource := False;
+  Hints := New(PMemStringList,Init);
+  if (Hints = nil) then
+  begin
+    PrintStr('Fatal error.  Could not create Hints list.');
+    Exit;
+  end;
+  Strings := New(PMemStringList,Init);
+  if (Strings = nil) then
+  begin
+    DoneResource;
+    Exit;
+  end;
+  Labels := New(PMemStringList,Init);
+  if (Labels = nil) then
+  begin
+    DoneResource;
+    Exit;
+  end;
+{ now load the defaults }
+  InitResLabels;
+  InitResStrings;
+  InitResource := True;
+end;
+{$endif cdResource}
+
+{****************************************************************************}
+{ InitRezFile                                                                }
+{****************************************************************************}
+{$ifdef cdResource}
+function InitRezFile (AFile: FNameStr; Mode: Word;
+                      var AResFile: PResourceFile): Sw_Integer;
+var
+  Stream: PBufStream;
+  Result: Sw_Integer;
+begin
+  Stream := New(PBufStream,Init(AFile,Mode,RezBufferSize));
+  if (Stream = nil) then
+    Result := 2  { file not found; could also be out of memory }
+  else begin
+    AResFile := New(PResourceFile,Init(Stream));
+    if (AResFile = nil) then
+    begin
+      Dispose(Stream,Done);
+      Result := 11;
+    end
+    else Result := 0;
+  end;
+  InitRezFile := Result;
+end;
+{$endif cdResource}
+
+{****************************************************************************}
+{ Load                                                                       }
+{****************************************************************************}
+{$ifdef cdResource}
+function LoadResource (AFile: FNameStr): Boolean;
+var
+  Stream: PBufStream;
+begin
+  Load := False;
+  Stream := New(PBufStream,Init(AFile,stOpenRead,RezBufferSize));
+  if (Stream = nil) or (Stream^.Status <> 0) then
+  begin
+    Done;
+    PrintStr('Fatal error.  Could not open resource file: ' + AFile);
+    Exit;
+  end;
+  RezFile := New(PResourceFile,Init(Stream));
+  if (RezFile = nil) then
+  begin
+    Dispose(Stream,Done);
+    Done;
+    PrintStr('Fatal error.  Could not initialize resource file.');
+    Exit;
+  end;
+  Hints := PStringList(RezFile^.Get(reHints));
+  if (Hints = nil) then
+  begin
+    Done;
+    PrintStr('Fatal error.  Could not load Hints string list.');
+    Exit;
+  end;
+  Strings := PStringList(RezFile^.Get(reStrings));
+  if (Strings = nil) then
+  begin
+    Done;
+    PrintStr('Fatal error.  Could not load Strings string list.');
+    Exit;
+  end;
+  Load := True;
+end;
+{$endif cdResource}
+
+{****************************************************************************}
+{ MergeLists                                                                 }
+{****************************************************************************}
+function MergeLists (Source, Dest: PMemStringList): Sw_Integer;
+var
+  Result: Sw_Integer;
+  procedure MoveItem (Constant: PConstant);{$ifndef FPC}far;{$endif}
+  var
+    j: Sw_Integer;
+  begin
+    if (Result = 0) and (not Dest^.Search(Dest^.KeyOf(Constant),j)) then
+    begin
+      j := Dest^.Count;
+      Dest^.Insert(Constant);
+      if (j = Dest^.Count) then
+        Result := 8
+      else Source^.Delete(Constant);
+    end;
+  end;
+begin
+  if (Source = nil) or (Dest = nil) then
+  begin
+    MergeLists := 6;
+    Exit;
+  end;
+  Result := 0;
+  Source^.ForEach(@MoveItem);
+  MergeLists := Result;
+end;
+
+{****************************************************************************}
+{                            Unit Initialization                             }
+{****************************************************************************}
+
+begin
+  RezFile := nil;
+  Hints := nil;
+  Strings := nil;
+  Labels := nil;
+end.
+

+ 1402 - 0
fv/statuses.pas

@@ -0,0 +1,1402 @@
+{$V-}
+unit Statuses;
+
+{#Z+}
+{  Free Vision Status Objects Unit
+   Free VIsion
+   Written by : Brad Williams, DVM
+
+Revision History
+
+1.2.3   (96/04/13)
+  - moved Pause and Resume to methods of TStatus leaving TStatus Pause and
+    Resume "aware"
+  - eliminated many bugs
+  - moved Pause, Resume and Cancel from TStatusDlg to TStatus
+
+1.2.1    (95/12/6)
+   - minor typo corrections in opening unit documentation
+   - F+ to Z+ around stream registration records
+   - removed redundant sentence in TAppStatus definition
+   - updated CBarStatus documentation and constant
+   - removed TGauge.Init cross-reference from TSpinner.Init
+   - added THeapMemAvail and RegistertvStatus documentation
+   - numerous other documentation updates
+   - changed all calls to Send to Message
+
+1.2.0    (95/11/24)
+   - conversion to Bsd format
+
+1.1.0    (05/01/94)
+   - initial WVS release
+
+
+Known Bugs
+
+ScanHelp Errors
+   - sdXXXX constants help documentation doesn't show TStatusDlg and
+     TMessageStatusDlg
+   - ScanHelp produces garbage in evStatus help context
+
+tvStatus Bugs
+   - CAppStatus may not be correct }
+{#Z-}
+
+{ The tvStatus unit implements several views for providing information to
+the user which needs to be updated during program execution, such as a
+progress indicator, clock, heap viewer, gauges, etc.  All tvStatus views
+respond to a new message event class, evStatus.  An individual status view
+only processes an event with its associated command. }
+
+interface
+
+{$i platform.inc}
+
+{$ifdef PPC_FPC}
+  {$H-}
+{$else}
+  {$F+,O+,E+,N+}
+{$endif}
+{$X+,R-,I-,Q-,V-}
+{$ifndef OS_LINUX}
+  {$S-}
+{$endif}
+
+uses
+
+  ObjTypes, Objects, Drivers, Views, Dialogs,
+  Resource;
+
+const
+
+  evStatus = $8000;
+    { evStatus represents the event class all status views know how to
+      respond to. }
+    {#X Statuses }
+
+
+  CStatus    =  #1#2#3;
+{$ifndef cdPrintDoc}
+{#F+}
+{ÝTStatus.CStatus palette
+ßßßßßßßßßßßßßßßßßßßßßßßßß}
+{#F-}
+{$endif cdPrintDoc}
+{ Status views use the default palette, CStatus, to map onto the first three
+entries in the standard window palette. }
+{#F+}
+{              1    2    3
+           ÉÍÍÍÍÑÍÍÍÍÑÍÍÍÍ»
+ CStatus   º  1 ³  2 ³  3 º
+           ÈÍÍÑÍÏÍÍÑÍÏÍÍÑͼ
+Normal TextÄÄÄÙ    ³    ³
+OtherÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ    ³
+Highlighted TextÄÄÄÄÄÄÄÄÙ }
+{#F-}
+{#X TStatus }
+
+  CAppStatus =  #2#5#4;
+{$ifndef cdPrintDoc}
+{#F+}
+{ÝTAppStatus.CAppStatus palette
+ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß}
+{#F-}
+{$endif cdPrintDoc}
+{ Status views which are inserted into the application rather than a dialog
+or window use the default palette, CAppStatus, to map onto the application
+object's palette. }
+{#F+}
+{                 1    2    3
+              ÉÍÍÍÍÑÍÍÍÍÑÍÍÍÍ»
+ CAppStatus   º  2 ³  5 ³  4 º
+              ÈÍÍÑÍÏÍÍÑÍÏÍÍÑͼ
+Normal TextÄÄÄÄÄÄÙ    ³    ³
+OtherÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ    ³
+Highlighted TextÄÄÄÄÄÄÄÄÄÄÄÙ }
+{#F-}
+    {#X tvStatus TAppStatus }
+
+
+  CBarGauge = CStatus + #16#19;
+{$ifndef cdPrintDoc}
+{#F+}
+{ÝTBarGauge.CBarGauge palette
+ßßßßßßßßßßßßßßßßßßßßßßßßßßßßß}
+{#F-}
+{$endif cdPrintDoc}
+{ TBarGauge's use the default palette, CBarGauge, to map onto the dialog or
+window owner's palette. }
+{#F+}
+{                 1    2    3   4    5
+              ÉÍÍÍÍÑÍÍÍÍÑÍÍÍÍÑÍÍÍÍÑÍÍÍÍ»
+ CAppStatus   º  2 ³  5 ³  4 ³ 16 ³ 19 º
+              ÈÍÍÑÍÏÍÍÑÍÏÍÍÑÍÏÍÍÑÍÏÍÍÑͼ
+Normal TextÄÄÄÄÄÄÙ    ³    ³    ³    ÀÄÄÄÄ filled in bar
+OtherÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ    ³    ÀÄÄÄÄÄÄÄÄÄ empty bar
+Highlighted TextÄÄÄÄÄÄÄÄÄÄÄÙ }
+{#F-}
+    {#X tvStatus TBarGauge }
+
+
+{#T sdXXXX }
+{$ifndef cdPrintDoc}
+{#F+}
+{ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ
+Ý sdXXXX constants   (STDDLG unit) Þ
+ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß}
+{#F-}
+{$endif cdNoPrintDoc}
+{ sdXXXX constants are used to determine the types of buttons displayed in a
+#TStatusDlg# or #TStatusMessageDlg#. }
+{#F+}
+{    Constant      ³ Value ³ Meaning
+ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍØÍÍÍÍÍÍÍØÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ
+  sdNone          ³ $0000 ³ no buttons
+  sdCancelButton  ³ $0001 ³ show Cancel button
+  sdPauseButton   ³ $0002 ³ show Pause button
+  sdResumeButton  ³ $0004 ³ show Resume button
+  sdAllButtons    ³ $0008 ³ show Cancel, Pause and Resume
+                  ³       ³   buttons }
+{#Z+}
+  sdNone                 = $0000;
+  sdCancelButton         = $0001;
+  sdPauseButton          = $0002;
+  sdResumeButton         = $0004;
+  sdAllButtons           = sdCancelButton or sdPauseButton or sdResumeButton;
+{#Z-}
+  {#X tvStatus TStatusDlg TStatusMessageDlg }
+
+  SpinChars : String[4] = '³/Ä\';
+    { SpinChars are the characters used by a #TSpinnerGauge# when it is drawn.
+      Only one character is displayed at a time.  The string is cycled
+      through then started over again until the view is disposed. }
+    {#X tvStatus }
+
+  sfPause = $F000;
+    { sfPause is an additional state flag used internally by status views to
+      indicate they are in a paused state and should not respond to their
+      command. }
+
+type
+  {#Z+}
+  PStatus = ^TStatus;
+  {#Z-}
+  TStatus = Object(TParamText)
+    { TStatus is the base object type from which all status views descend.
+      Status views are used to display information that will change at
+      run-time based upon some state or process in the application, such as
+      printing.
+
+      All status views that are to be inserted into the application should
+      descend from #TAppStatus# for proper color mapping. }
+    Command : Word;
+      { Command is the only command the status view will respond to.  When
+        the status view receives an evStatus event it checks the value of the
+        Event.Command field against Command before handling the event. }
+      {#X HandleEvent }
+    constructor Init (R : TRect; ACommand : Word; AText : String;
+                      AParamCount : Integer);
+      { Init calls the inherited constructor then sets #Command# to ACommand.
+
+        If an error occurs Init fails. }
+      {#X Load }
+    constructor Load (var S : TStream);
+      { Load calls the inherited constructor then reads #Command# from the
+        stream.
+
+        If an error occurs Load fails. }
+      {#X Store Init }
+    function Cancel : Boolean; virtual;
+      { Cancel should prompt the user when necessary for validation of
+        canceling the process which the status view is displaying.  If the
+        user elects to continue the process Cancel must return False,
+        otherwise Cancel must return True. }
+      {#X Pause Resume }
+    function GetPalette : PPalette; virtual;
+      { GetPalette returns a pointer to the default status view palette,
+        #CStatus#. }
+      {#X TAppStatus CAppStatus }
+    procedure HandleEvent (var Event : TEvent); virtual;
+      { HandleEvent captures any #evStatus# messages with its command value
+        equal to #Command#, then calls #Update# with Data set to
+        Event.InfoPtr.  If the State field has its #sfPause# bit set, the
+        view ignores the event. }
+    procedure Pause; virtual;
+      { Pause sends an evStatus message to the application with Event.Command
+        set to cmStatusPause and Event.InfoPtr set to #Status#^.Command.  The
+        #Status# view's sfPause bit of the State flag is set by calling
+        SetState.  In the paused state, the status view does not respond to
+        its associated command. }
+      {#X Resume sdXXXX Cancel }
+    procedure Reset; virtual;
+      { Reset causes the status view to be reset to its beginning or default
+        value, then be redrawn.  Reset is used after an event is aborted
+        which can only be performed in its entirety. }
+    procedure Resume; virtual;
+      { Resume is called in response to pressing the Resume button.  Resume
+        sends an evStatus message to the application with Event.Command set
+        to cmStatusPause and Event.InfoPtr set to #Status#^.Command.  The
+        Status view's sfPause bit is turned off by calling SetState. }
+      {#X Pause sdXXXX Cancel }
+    procedure Store (var S : TStream); virtual;
+      { Store calls the inherited Store method then writes #Command# to the
+        stream. }
+      {#X Load }
+    procedure Update (Data : Pointer); virtual;
+      { Update changes the status' displayed text as necessary based on
+        Data. }
+      {#X Command HandleEvent }
+  end;  { of TStatus }
+
+
+  {#Z+}
+  PStatusDlg = ^TStatusDlg;
+  {#Z-}
+  TStatusDlg = Object(TDialog)
+    { A TStatusDlg displays a status view and optional buttons.  It may be
+      used to display any status message and optionally provide end user
+      cancelation or pausing of an ongoing operation, such as printing.
+
+      All status views that are to be inserted into a window or dialog should
+      descend from #TStatus# for proper color mapping. }
+    Status : PStatus;
+      { Status is the key status view for the dialog.  When a cmStatusPause
+        command is broadcast in response to pressing the pause button,
+        Event.InfoPtr is set to point to the command associated with Status. }
+      {#X TStatus cmXXXX }
+    constructor Init (ATitle : TTitleStr; AStatus : PStatus; AFlags : Word);
+      { Init calls the inherited constructor to create the dialog and sets
+        the EventMask to handle #evStatus# events.  AStatus is assigned to
+        #Status# and inserted into the dialog at position 2,2.
+
+        The dialog is anchored at AStatus^.Origin and its size is at least
+        AStatus^.Size + 2 in both dimensions.  The actual size is determined
+        by the AFlags byte.  The #sdXXXX# constants should be used to signify
+        which buttons to display.
+
+        If an error occurs Init fails. }
+      {#X TStatus.Pause TStatus.Resume }
+    constructor Load (var S : TStream);
+      { Load calls the inherited constructor then loads #Status#.
+
+        If an error occurs Load fails. }
+      {#X Store }
+    procedure Cancel (ACommand : Word); virtual;
+      { Cancel sends an evStatus message to the Application object with
+        command set to cmCancel and InfoPtr set to the calling status view's
+        command, then calls the inherited Cancel method. }
+      {#X TBSDDialog.Cancel }
+    procedure HandleEvent (var Event : TEvent); virtual;
+      { All evStatus events are accepted by the dialog and sent to each
+        subview in Z-order until cleared.
+
+        If the dialog recieves an evCommand or evBroadcast event with the
+        Command parameter set to cmCancel, HandleEvent sends an #evStatus#
+        message to the Application variable with Event.Command set to the
+        cmStatusCancel and Event.InfoPtr set to the #Status#.Command and
+        disposes of itself.
+
+        When a pause button is included, a cmStatusPause broadcast event is
+        associated with the button.  When the button is pressed a call to
+        #TStatus.Pause# results.  The status view is inactivated until it
+        receives an evStatus event with a commond of cmStatusResume and
+        Event.InfoPtr set to the status view's Command value.  When a pause
+        button is used, the application should respond to the evStatus event
+        (with Event.Command of cmStatusPause) appropriately, then dispatch a
+        cmStatusResume evStatus event when ready to resume activity. }
+      {#X TStatus.Command }
+    procedure InsertButtons (AFlags : Word); virtual;
+      { InsertButtons enlarges the dialog to the necessary size and inserts
+        the buttons specified in AFlags into the last row of the dialog. }
+    procedure Store (var S : TStream); virtual;
+      { Store calls the inherited Store method then writes #Status# to the
+        stream. }
+      {#X Load }
+  end;  { of TStatusDlg }
+
+
+  {#Z+}
+  PStatusMessageDlg = ^TStatusMessageDlg;
+  {#Z-}
+  TStatusMessageDlg = Object(TStatusDlg)
+    { A TStatusMessageDlg displays a message as static text with a status
+      view on the line below it.
+
+      All status views that are to be inserted into a window or dialog should
+      descend from #TStatus# for proper color mapping. }
+    constructor Init (ATitle : TTitleStr; AStatus : PStatus; AFlags : Word;
+                      AMessage : String);
+      { Init calls the inherited constructor then inserts a TStaticText view
+        containing AMessage at the top line of the dialog.
+
+        The size of the dialog is determined by the size of the AStatus.  The
+        dialog is anchored at AStatus^.Origin and is of at least
+        AStatus^.Size + 2 in heighth and width.  The exact width and heighth
+        are determined by AOptions.
+
+        AFlags contains flags which determine the buttons to be displayed
+        in the dialog.
+
+        If an error occurs Init fails. }
+  end;  { of TStatusMessageDlg }
+
+
+  {#Z+}
+  PGauge = ^TGauge;
+  {#Z-}
+  TGauge = Object(TStatus)
+    { A gauge is used to represent the current numerical position within a
+      range of values.  When Current equals Max a gauge dispatches an
+      #evStatus# event with the command set to cmStatusDone to the
+      Application object. }
+    Min : LongInt;
+      { Min is the minimum value which #Current# may be set to. }
+      {#X Max }
+    Max : LongInt;
+      { Max is the maximum value which #Current# may be set to. }
+      {#X Min }
+    Current : LongInt;
+      { Current is the current value represented in the gauge. }
+      {#X Max Min }
+    constructor Init (R : TRect; ACommand : Word; AMin, AMax : LongInt);
+      { Init calls the inherited constructor then sets #Min# and #Max# to
+        AMin and AMax, respectively.  #Current# is set to AMin.
+
+        If an error occurs Init fails. }
+      {#X Load }
+    constructor Load (var S : TStream);
+      { Load calls the inherited constructor then reads #Min#, #Max# and
+        #Current# from the stream.
+
+        If an error occurs Load fails. }
+      {#X Init Store }
+    procedure Draw; virtual;
+      { Draw writes the following to the screen: }
+{#F+}
+{
+Min = XXX  Max = XXX  Current = XXX }
+{#F-}
+      { where XXX are the current values of the corresponding variables. }
+    procedure GetData (var Rec); virtual;
+      { GetData assumes Rec is a #TGaugeRec# and returns the current settings
+        of the gauge. }
+      {#X SetData }
+    procedure Reset; virtual;
+      { Reset sets #Current# to #Min# then redraws the status view. }
+      {#X TStatus.Reset }
+    procedure SetData (var Rec); virtual;
+      { SetData assumes Rec is a #TGaugeRec# and sets the gauge's variables
+        accordingly. }
+      {#X GetData }
+    procedure Store (var S : TStream); virtual;
+      { Store calls the inherited Store method then writes #Min#, #Max# and
+        #Current# to the stream. }
+      {#X Load }
+    procedure Update (Data : Pointer); virtual;
+      { Update increments #Current#. }
+  end;  { of TGauge }
+
+
+  {#Z+}
+  PGaugeRec = ^TGaugeRec;
+  {#Z-}
+  TGaugeRec = record
+    { A TGaugeRec is used to set and get a #TGauge#'s variables. }
+    {#X TGauge.GetData TGauge.SetData }
+    Min, Max, Current : LongInt;
+  end;  { of TGaugeRec }
+
+
+  {#Z+}
+  PArrowGauge = ^TArrowGauge;
+  {#Z-}
+  TArrowGauge = Object(TGauge)
+    { An arrow gauge draws a progressively larger series of arrows across the
+      view.  If Right is True, the arrows are right facing, '>', and are
+      drawn from left to right.  If Right is False, the arrows are left
+      facing, '<', and are drawn from right to left. }
+    Right : Boolean;
+      { Right determines the direction of arrow used and the direction which
+        the status view is filled.  If Right is True, the arrows are right
+        facing, '>', and are drawn from left to right.  If Right is False,
+        the arrows are left facing, '<', and are drawn from right to left. }
+      {#X Draw }
+    constructor Init (R : TRect; ACommand : Word; AMin, AMax : Word;
+                      RightArrow : Boolean);
+      { Init calls the inherited constructor then sets #Right# to RightArrow.
+
+        If an error occurs Init fails. }
+      {#X Load }
+    constructor Load (var S : TStream);
+      { Load calls the inherited constructor then reads #Right# from the
+        stream.
+
+        If an error occurs Load fails. }
+      {#X Init Store }
+    procedure Draw; virtual;
+      { Draw fills the Current / Max percent of the view with arrows. }
+      {#X Right }
+    procedure GetData (var Rec); virtual;
+      { GetData assumes Rec is a #TArrowGaugeRec# and returns the current
+        settings of the views variables. }
+      {#X SetData }
+    procedure SetData (var Rec); virtual;
+      { SetData assumes Rec is a #TArrowGaugeRec# and sets the view's
+        variables accordingly. }
+      {#X GetData }
+    procedure Store (var S : TStream); virtual;
+      { Store calls the inherited Store method then writes #Right# to the
+        stream. }
+      {#X Load }
+  end;  { of TArrowGauge }
+
+
+  {#Z+}
+  PArrowGaugeRec = ^TArrowGaugeRec;
+  {#Z-}
+  TArrowGaugeRec = record
+    { A TArrowGaugeRec is used to set and get the variables of a
+      #TArrowGauge#. }
+    {#X TArrowGauge.GetData TArrowGauge.SetData }
+    Min, Max, Count : LongInt;
+    Right : Boolean;
+  end;  { of TGaugeRec }
+
+
+  {#Z+}
+  PPercentGauge = ^TPercentGauge;
+  {#Z-}
+  TPercentGauge = Object(TGauge)
+    { A TPercentGauge displays a numerical percentage as returned by
+      #Percent# followed by a '%' sign. }
+    function Percent : Integer; virtual;
+      { Percent returns the whole number value of (Current / Max) * 100. }
+      {#X TGauge.Current TGauge.Max }
+    procedure Draw; virtual;
+      { Draw writes the current percentage to the screen. }
+      {#X Percent }
+  end;  { of TPercentGauge }
+
+
+  {#Z+}
+  PBarGauge = ^TBarGauge;
+  {#Z-}
+  TBarGauge = Object(TPercentGauge)
+    { A TBarGauge displays a bar which increases in size from the left to
+      the right of the view as Current increases.  A numeric percentage
+      representing the value of (Current / Max) * 100 is displayed in the
+      center of the bar. }
+    {#x TPercentGauge.Percent }
+    procedure Draw; virtual;
+      { Draw draws the bar and percentage to the screen representing the
+        current status of the view's variables. }
+      {#X TGauge.Update }
+    function GetPalette : PPalette; virtual;
+      { GetPalette returns a pointer to the default status view palette,
+        #CBarStatus#. }
+  end;  { of TBarGauge }
+
+
+  {#Z+}
+  PSpinnerGauge = ^TSpinnerGauge;
+  {#Z-}
+  TSpinnerGauge = Object(TGauge)
+    { A TSpinnerGauge displays a series of characters in one spot on the
+      screen giving the illusion of a spinning line. }
+    constructor Init (X, Y : Integer; ACommand : Word);
+      { Init calls the inherited constructor with AMin set to 0 and AMax set
+        to 4. }
+    procedure Draw; virtual;
+      { Draw uses the #SpinChars# variable to draw the view's Current
+        character. }
+      {#X Update }
+    procedure HandleEvent (var Event : TEvent); virtual;
+      { HandleEvent calls TStatus.HandleEvent so that a cmStatusDone event
+        is not generated when Current equals Max. }
+      {#X TGauge.Current TGauge.Max }
+    procedure Update (Data : Pointer); virtual;
+      { Update increments Current until Current equals Max, when it resets
+        Current to Min. }
+      {#X Draw HandleEvent }
+  end;  { of TSpinnerGauge }
+
+
+  {#Z+}
+  PAppStatus = ^TAppStatus;
+  {#Z-}
+  TAppStatus = Object(TStatus)
+    { TAppStatus is a base object which implements color control for status
+      views that are normally inserted in the Application object. }
+    {#X TStatus }
+    function GetPalette : PPalette; virtual;
+      { GetPalette returns a pointer to the default application status view
+        palette, #CAppStatus#. }
+      {#X TStatus CStatus }
+  end;  { of TAppStatus }
+
+
+  {#Z+}
+  PHeapMaxAvail = ^THeapMaxAvail;
+  {#Z-}
+  THeapMaxAvail = Object(TAppStatus)
+    { A THeapMaxAvail displays the largest available contiguous area of heap
+      memory.  It responds to a cmStatusUpdate event by calling MaxAvail and
+      comparing the result to #Max#, then updating the view if necessary. }
+    {#X THeapMemAvail }
+    constructor Init (X, Y : Integer);
+      { Init creates the view with the following text:
+
+        MaxAvail = xxxx
+
+        where xxxx is the result returned by MaxAvail. }
+    procedure Update (Data : Pointer); virtual;
+      { Update changes #Mem# to the current MemAvail and redraws the status
+        if necessary. }
+      private
+    Max : LongInt;
+      { Max is the last reported value from MaxAvail. }
+      {#X Update }
+  end;  { of THeapMaxAvail }
+
+
+  {#Z+}
+  PHeapMemAvail = ^THeapMemAvail;
+  {#Z-}
+  THeapMemAvail = Object(TAppStatus)
+    { A THeapMemAvail displays the total amount of heap memory available to
+      the application.  It responds to a cmStatusUpdate event by calling
+      MemAvail and comparing the result to #Max#, then updating the view if
+      necessary. }
+    {#X THeapMaxAvail }
+    constructor Init (X, Y : Integer);
+      { Init creates the view with the following text:
+
+        MemAvail = xxxx
+
+        where xxxx is the result returned by MemAvail. }
+      {#X Load }
+    procedure Update (Data : Pointer); virtual;
+      { Update changes #Mem# to the current MemAvail and redraws the status
+        if necessary. }
+      private
+    Mem : LongInt;
+      { Mem is the last available value reported by MemAvail. }
+      {#X Update }
+  end;  { of THeapMemAvail }
+
+
+{$ifndef cdPrintDoc}
+{#Z+}
+{$endif cdPrintDoc}
+const
+  RStatus    : TStreamRec = (
+     ObjType : idStatus;
+     VmtLink : Ofs(TypeOf(TStatus)^);
+     Load    : @TStatus.Load;
+     Store   : @TStatus.Store);
+
+  RStatusDlg : TStreamRec = (
+     ObjType : idStatusDlg;
+     VmtLink : Ofs(TypeOf(TStatusDlg)^);
+     Load    : @TStatusDlg.Load;
+     Store   : @TStatusDlg.Store);
+
+  RStatusMessageDlg : TStreamRec = (
+     ObjType : idStatusMessageDlg;
+     VmtLink : Ofs(TypeOf(TStatusMessageDlg)^);
+     Load    : @TStatusMessageDlg.Load;
+     Store   : @TStatusMessageDlg.Store);
+
+  RGauge  : TStreamRec = (
+     ObjType : idGauge;
+     VmtLink : Ofs(TypeOf(TGauge)^);
+     Load    : @TGauge.Load;
+     Store   : @TGauge.Store);
+
+  RArrowGauge  : TStreamRec = (
+     ObjType : idArrowGauge;
+     VmtLink : Ofs(TypeOf(TArrowGauge)^);
+     Load    : @TArrowGauge.Load;
+     Store   : @TArrowGauge.Store);
+
+  RBarGauge  : TStreamRec = (
+     ObjType : idBarGauge;
+     VmtLink : Ofs(TypeOf(TBarGauge)^);
+     Load    : @TBarGauge.Load;
+     Store   : @TBarGauge.Store);
+
+  RPercentGauge  : TStreamRec = (
+     ObjType : idPercentGauge;
+     VmtLink : Ofs(TypeOf(TPercentGauge)^);
+     Load    : @TPercentGauge.Load;
+     Store   : @TPercentGauge.Store);
+
+  RSpinnerGauge  : TStreamRec = (
+     ObjType : idSpinnerGauge;
+     VmtLink : Ofs(TypeOf(TSpinnerGauge)^);
+     Load    : @TSpinnerGauge.Load;
+     Store   : @TSpinnerGauge.Store);
+
+  RAppStatus  : TStreamRec = (
+     ObjType : idAppStatus;
+     VmtLink : Ofs(TypeOf(TAppStatus)^);
+     Load    : @TAppStatus.Load;
+     Store   : @TAppStatus.Store);
+
+  RHeapMinAvail  : TStreamRec = (
+     ObjType : idHeapMinAvail;
+     VmtLink : Ofs(TypeOf(THeapMaxAvail)^);
+     Load    : @THeapMaxAvail.Load;
+     Store   : @THeapMaxAvail.Store);
+
+  RHeapMemAvail  : TStreamRec = (
+     ObjType : idHeapMemAvail;
+     VmtLink : Ofs(TypeOf(THeapMemAvail)^);
+     Load    : @THeapMemAvail.Load;
+     Store   : @THeapMemAvail.Store);
+{$ifndef cdPrintDoc}
+{#Z-}
+{$endif cdPrintDoc}
+
+procedure RegisterStatuses;
+{$ifndef cdPrintDoc}
+{#F+}
+{ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ
+ÝRegisterStatuses procedure   (Statuses unit)Þ
+ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß}
+{#F-}
+{$endif cdPrintDoc}
+  { RegisterStatuses calls RegisterType for each of the status view and
+    status dialog object types defined in the tvStatus unit.  After calling
+    RegisterStatuses, your application can read or write any of those types
+    with streams. }
+
+
+implementation
+
+uses
+  FVConsts, MsgBox, App;
+
+{****************************************************************************}
+{                    Local procedures and functions                          }
+{****************************************************************************}
+
+{****************************************************************************}
+{ TAppStatus Object                                                          }
+{****************************************************************************}
+{****************************************************************************}
+{ TAppStatus.GetPalette                                                      }
+{****************************************************************************}
+function TAppStatus.GetPalette : PPalette;
+const P : String[Length(CAppStatus)] = CAppStatus;
+begin
+  GetPalette := PPalette(@P);
+end;
+
+{****************************************************************************}
+{ TArrowGauge Object                                                         }
+{****************************************************************************}
+{****************************************************************************}
+{ TArrowGauge.Init                                                           }
+{****************************************************************************}
+constructor TArrowGauge.Init (R : TRect; ACommand : Word; AMin, AMax : Word;
+                              RightArrow : Boolean);
+begin
+  if not TGauge.Init(R,ACommand,AMin,AMax) then
+    Fail;
+  Right := RightArrow;
+end;
+
+{****************************************************************************}
+{ TArrowGauge.Load                                                           }
+{****************************************************************************}
+constructor TArrowGauge.Load (var S : TStream);
+begin
+  if not TGauge.Load(S) then
+    Fail;
+  S.Read(Right,SizeOf(Right));
+  if (S.Status <> stOk) then
+  begin
+    TGauge.Done;
+    Fail;
+  end;
+end;
+
+{****************************************************************************}
+{ TArrowGauge.Draw                                                           }
+{****************************************************************************}
+procedure TArrowGauge.Draw;
+const Arrows : array[0..1] of Char = '<>';
+var
+  B : TDrawBuffer;
+  C : Word;
+  Len : Byte;
+begin
+  C := GetColor(1);
+  Len := Round(Size.X * Current/(Max - Min));
+  MoveChar(B,' ',C,Size.X);
+  if Right then
+    MoveChar(B,Arrows[Byte(Right)],C,Len)
+  else MoveChar(B[Size.X - Len],Arrows[Byte(Right)],C,Len);
+  WriteLine(0,0,Size.X,1,B);
+end;
+
+{****************************************************************************}
+{ TArrowGauge.GetData                                                        }
+{****************************************************************************}
+procedure TArrowGauge.GetData (var Rec);
+begin
+  PArrowGaugeRec(Rec)^.Min := Min;
+  PArrowGaugeRec(Rec)^.Max := Max;
+  PArrowGaugeRec(Rec)^.Count := Current;
+  PArrowGaugeRec(Rec)^.Right := Right;
+end;
+
+{****************************************************************************}
+{ TArrowGauge.SetData                                                        }
+{****************************************************************************}
+procedure TArrowGauge.SetData (var Rec);
+begin
+  Min := PArrowGaugeRec(Rec)^.Min;
+  Max := PArrowGaugeRec(Rec)^.Max;
+  Current := PArrowGaugeRec(Rec)^.Count;
+  Right := PArrowGaugeRec(Rec)^.Right;
+end;
+
+{****************************************************************************}
+{ TArrowGauge.Store                                                          }
+{****************************************************************************}
+procedure TArrowGauge.Store (var S : TStream);
+begin
+  TGauge.Store(S);
+  S.Write(Right,SizeOf(Right));
+end;
+
+{****************************************************************************}
+{ TBarGauge Object                                                           }
+{****************************************************************************}
+{****************************************************************************}
+{ TBarGauge.Draw                                                             }
+{****************************************************************************}
+procedure TBarGauge.Draw;
+var
+  B : TDrawBuffer;
+  C : Word;
+  FillSize : Word;
+  PercentDone : LongInt;
+  S : String[4];
+begin
+  { fill entire view }
+  MoveChar(B,' ',GetColor(4),Size.X);
+  { make progress bar }
+  C := GetColor(5);
+  FillSize := Round(Size.X * (Current / Max));
+  MoveChar(B,' ',C,FillSize);
+  { display percent done }
+  PercentDone := Percent;
+  FormatStr(S,'%d%%',PercentDone);
+  if PercentDone < 50 then
+    C := GetColor(4);
+  FillSize := (Size.X - Length(S)) div 2;
+  MoveStr(B[FillSize],S,C);
+  WriteLine(0,0,Size.X,Size.Y,B);
+end;
+
+{****************************************************************************}
+{ TBarGauge.GetPalette                                                       }
+{****************************************************************************}
+function TBarGauge.GetPalette : PPalette;
+const
+  S : String[Length(CBarGauge)] = CBarGauge;
+begin
+  GetPalette := PPalette(@S);
+end;
+
+{****************************************************************************}
+{ TGauge Object                                                              }
+{****************************************************************************}
+{****************************************************************************}
+{ TGauge.Init                                                                }
+{****************************************************************************}
+constructor TGauge.Init (R : TRect; ACommand : Word; AMin, AMax : LongInt);
+begin
+  if not TStatus.Init(R,ACommand,'',1) then
+    Fail;
+  Min := AMin;
+  Max := AMax;
+  Current := Min;
+end;
+
+{****************************************************************************}
+{ TGauge.Load                                                                }
+{****************************************************************************}
+constructor TGauge.Load (var S : TStream);
+begin
+  if not TStatus.Load(S) then
+    Fail;
+  S.Read(Min,SizeOf(Min));
+  S.Read(Max,SizeOf(Max));
+  S.Read(Current,SizeOf(Current));
+  if S.Status <> stOk then
+  begin
+    TStatus.Done;
+    Fail;
+  end;
+end;
+
+{****************************************************************************}
+{ TGauge.Draw                                                                }
+{****************************************************************************}
+procedure TGauge.Draw;
+var
+  S : String;
+  B : TDrawBuffer;
+begin
+  { Blank the gauge }
+  MoveChar(B,' ',GetColor(1),Size.X);
+  WriteBuf(0,0,Size.X,Size.Y,B);
+  { write current status }
+  FormatStr(S,'%d',Current);
+  MoveStr(B,S,GetColor(1));
+  WriteBuf(0,0,Size.X,Size.Y,B);
+end;
+
+{****************************************************************************}
+{ TGauge.GetData                                                             }
+{****************************************************************************}
+procedure TGauge.GetData (var Rec);
+begin
+  TGaugeRec(Rec).Min := Min;
+  TGaugeRec(Rec).Max := Max;
+  TGaugeRec(Rec).Current := Current;
+end;
+
+{****************************************************************************}
+{ TGauge.Reset                                                               }
+{****************************************************************************}
+procedure TGauge.Reset;
+begin
+  Current := Min;
+  DrawView;
+end;
+
+{****************************************************************************}
+{ TGauge.SetData                                                             }
+{****************************************************************************}
+procedure TGauge.SetData (var Rec);
+begin
+  Min := TGaugeRec(Rec).Min;
+  Max := TGaugeRec(Rec).Max;
+  Current := TGaugeRec(Rec).Current;
+end;
+
+{****************************************************************************}
+{ TGauge.Store                                                               }
+{****************************************************************************}
+procedure TGauge.Store (var S : TStream);
+begin
+  TStatus.Store(S);
+  S.Write(Min,SizeOf(Min));
+  S.Write(Max,SizeOf(Max));
+  S.Write(Current,SizeOf(Current));
+end;
+
+{****************************************************************************}
+{ TGauge.Update                                                              }
+{****************************************************************************}
+procedure TGauge.Update (Data : Pointer);
+begin
+  if Current < Max then
+  begin
+    Inc(Current);
+    DrawView;
+  end
+  else Message(@Self,evStatus,cmStatusDone,@Self);
+end;
+
+{****************************************************************************}
+{ THeapMaxAvail Object                                                       }
+{****************************************************************************}
+{****************************************************************************}
+{ THeapMaxAvail.Init                                                         }
+{****************************************************************************}
+constructor THeapMaxAvail.Init (X, Y : Integer);
+var
+  R : TRect;
+begin
+  R.Assign(X,Y,X+20,Y+1);
+  if not TAppStatus.Init(R,cmStatusUpdate,' MaxAvail = %d',1) then
+    Fail;
+  Max := -1;
+end;
+
+{****************************************************************************}
+{ THeapMaxAvail.Update                                                       }
+{****************************************************************************}
+procedure THeapMaxAvail.Update (Data : Pointer);
+var
+  M : LongInt;
+begin
+  M := MaxAvail;
+  if (Max <> M) then
+  begin
+    Max := MaxAvail;
+    SetData(Max);
+  end;
+end;
+
+{****************************************************************************}
+{ THeapMemAvail Object                                                       }
+{****************************************************************************}
+{****************************************************************************}
+{ THeapMemAvail.Init                                                         }
+{****************************************************************************}
+constructor THeapMemAvail.Init (X, Y : Integer);
+var
+  R : TRect;
+begin
+  R.Assign(X,Y,X+20,Y+1);
+  if not TAppStatus.Init(R,cmStatusUpdate,' MemAvail = %d',1) then
+    Fail;
+  Mem := -1;
+end;
+
+{****************************************************************************}
+{ THeapMemAvail.Update                                                       }
+{****************************************************************************}
+procedure THeapMemAvail.Update (Data : Pointer);
+  { Total bytes available on the heap.  May not be contiguous. }
+var
+  M : LongInt;
+begin
+  M := MemAvail;
+  if (Mem <> M) then
+  begin
+    Mem := M;
+    SetData(Mem);
+  end;
+end;
+
+{****************************************************************************}
+{ TPercentGauge Object                                                       }
+{****************************************************************************}
+{****************************************************************************}
+{ TPercentGauge.Draw                                                         }
+{****************************************************************************}
+procedure TPercentGauge.Draw;
+var
+  B : TDrawBuffer;
+  C : Word;
+  S : String;
+  PercentDone : LongInt;
+  FillSize : Integer;
+begin
+  C := GetColor(1);
+  MoveChar(B,' ',C,Size.X);
+  WriteLine(0,0,Size.X,Size.Y,B);
+  PercentDone := Percent;
+  FormatStr(S,'%d%%',PercentDone);
+  MoveStr(B[(Size.X - Byte(S[0])) div 2],S,C);
+  WriteLine(0,0,Size.X,Size.Y,B);
+end;
+
+{****************************************************************************}
+{ TPercentGauge.Percent                                                      }
+{****************************************************************************}
+function TPercentGauge.Percent : Integer;
+  { Returns percent as a whole integer Current of Max }
+begin
+  Percent := Round((Current/Max) * 100);
+end;
+
+{****************************************************************************}
+{ TSpinnerGauge Object                                                       }
+{****************************************************************************}
+
+{****************************************************************************}
+{ TSpinnerGauge.Init                                                         }
+{****************************************************************************}
+constructor TSpinnerGauge.Init (X, Y : Integer; ACommand : Word);
+var R : TRect;
+begin
+  R.Assign(X,Y,X+1,Y+1);
+  if not TGauge.Init(R,ACommand,1,4) then
+    Fail;
+end;
+
+{****************************************************************************}
+{ TSpinnerGauge.Draw                                                         }
+{****************************************************************************}
+procedure TSpinnerGauge.Draw;
+var
+  B : TDrawBuffer;
+  C : Word;
+begin
+  C := GetColor(1);
+  MoveChar(B,' ',C,Size.X);
+  WriteLine(0,0,Size.X,Size.Y,B);
+  MoveChar(B[Size.X div 2],SpinChars[Current],C,1);
+  WriteLine(0,0,Size.X,Size.Y,B);
+end;
+
+{****************************************************************************}
+{ TSpinnerGauge.HandleEvent                                                  }
+{****************************************************************************}
+procedure TSpinnerGauge.HandleEvent (var Event : TEvent);
+begin
+  TStatus.HandleEvent(Event);
+end;
+
+{****************************************************************************}
+{ TSpinnerGauge.Update                                                       }
+{****************************************************************************}
+procedure TSpinnerGauge.Update (Data : Pointer);
+begin
+  if Current = Max then
+    Current := Min
+  else Inc(Current);
+  DrawView;
+end;
+
+{****************************************************************************}
+{ TStatus Object                                                             }
+{****************************************************************************}
+{****************************************************************************}
+{ TStatus.Init                                                               }
+{****************************************************************************}
+constructor TStatus.Init (R : TRect; ACommand : Word; AText : String;
+                          AParamCount : Integer);
+begin
+  if (not TParamText.Init(R,AText,AParamCount)) then
+    Fail;
+  EventMask := EventMask or evStatus;
+  Command := ACommand;
+end;
+
+{****************************************************************************}
+{ TStatus.Load                                                               }
+{****************************************************************************}
+constructor TStatus.Load (var S : TStream);
+begin
+  if not TParamText.Load(S) then
+    Fail;
+  S.Read(Command,SizeOf(Command));
+  if (S.Status <> stOk) then
+  begin
+    TParamText.Done;
+    Fail;
+  end;
+end;
+
+{****************************************************************************}
+{ TStatus.Cancel                                                             }
+{****************************************************************************}
+function TStatus.Cancel : Boolean;
+begin
+  Cancel := True;
+end;
+
+{****************************************************************************}
+{ TStatus.GetPalette                                                         }
+{****************************************************************************}
+function TStatus.GetPalette : PPalette;
+const
+  P : String[Length(CStatus)] = CStatus;
+begin
+  GetPalette := PPalette(@P);
+end;
+
+{****************************************************************************}
+{ TStatus.HandleEvent                                                        }
+{****************************************************************************}
+procedure TStatus.HandleEvent (var Event : TEvent);
+begin
+  if (Event.What = evCommand) and (Event.Command = cmStatusPause) then
+  begin
+    Pause;
+    ClearEvent(Event);
+  end;
+  case Event.What of
+    evStatus :
+      case Event.Command of
+        cmStatusDone :
+          if (Event.InfoPtr = @Self) then
+          begin
+            Message(Owner,evStatus,cmStatusDone,@Self);
+            ClearEvent(Event);
+          end;
+        cmStatusUpdate :
+          if (Event.InfoWord = Command) and ((State and sfPause) = 0) then
+          begin
+            Update(Event.InfoPtr);
+            { ClearEvent(Event); } { don't clear the event so multiple }
+                            { status views can respond to the same event }
+          end;
+        cmStatusResume :
+          if (Event.InfoWord = Command) and
+             ((State and sfPause) = sfPause) then
+          begin
+            Resume;
+            ClearEvent(Event);
+          end;
+        cmStatusPause :
+          if (Event.InfoWord = Command) and ((State and sfPause) = 0) then
+          begin
+            Pause;
+            ClearEvent(Event);
+          end;
+      end;
+  end;
+  TParamText.HandleEvent(Event);
+end;
+
+{****************************************************************************}
+{ TStatus.Pause                                                              }
+{****************************************************************************}
+procedure TStatus.Pause;
+begin
+  SetState(sfPause,True);
+end;
+
+{****************************************************************************}
+{ TStatus.Reset                                                              }
+{****************************************************************************}
+procedure TStatus.Reset;
+begin
+  DrawView;
+end;
+
+{****************************************************************************}
+{ TStatus.Resume                                                             }
+{****************************************************************************}
+procedure TStatus.Resume;
+begin
+  SetState(sfPause,False);
+end;
+
+{****************************************************************************}
+{ TStatus.Store                                                              }
+{****************************************************************************}
+procedure TStatus.Store (var S : TStream);
+begin
+  TParamText.Store(S);
+  S.Write(Command,SizeOf(Command));
+end;
+
+{****************************************************************************}
+{ TStatus.Update                                                             }
+{****************************************************************************}
+procedure TStatus.Update (Data : Pointer);
+begin
+  DisposeStr(Text);
+  Text := NewStr(String(Data^));
+  DrawView;
+end;
+
+{****************************************************************************}
+{ TStatusDlg Object                                                          }
+{****************************************************************************}
+{****************************************************************************}
+{ TStatusDlg.Init                                                            }
+{****************************************************************************}
+constructor TStatusDlg.Init (ATitle : TTitleStr; AStatus : PStatus;
+                             AFlags : Word);
+var
+  R : TRect;
+  i : LongInt;
+  Buttons : Byte;
+begin
+  if (AStatus = nil) then
+    Fail;
+  R.A := AStatus^.Origin;
+  R.B := AStatus^.Size;
+  Inc(R.B.Y,R.A.Y+4);
+  Inc(R.B.X,R.A.X+5);
+  if not TDialog.Init(R,ATitle) then
+    Fail;
+  EventMask := EventMask or evStatus;
+  Status := AStatus;
+  Status^.MoveTo(2,2);
+  Insert(Status);
+  InsertButtons(AFlags);
+end;
+
+{****************************************************************************}
+{ TStatusDlg.Load                                                            }
+{****************************************************************************}
+constructor TStatusDlg.Load (var S : TStream);
+begin
+  if not TDialog.Load(S) then
+    Fail;
+  GetSubViewPtr(S,Status);
+  if (S.Status <> stOk) then
+  begin
+    if (Status <> nil) then
+      Dispose(Status,Done);
+    TDialog.Done;
+    Fail;
+  end;
+end;
+
+{****************************************************************************}
+{ TStatusDlg.Cancel                                                          }
+{****************************************************************************}
+procedure TStatusDlg.Cancel (ACommand : Word);
+begin
+  if Status^.Cancel then
+    TDialog.Cancel(ACommand);
+end;
+
+{****************************************************************************}
+{ TStatusDlg.HandleEvent                                                     }
+{****************************************************************************}
+procedure TStatusDlg.HandleEvent (var Event : TEvent);
+begin
+  case Event.What of
+    evStatus :
+      case Event.Command of
+        cmStatusDone :
+          if Event.InfoPtr = Status then
+          begin
+            TDialog.Cancel(cmOk);
+            ClearEvent(Event);
+          end;
+      end;
+      { else let TDialog.HandleEvent send to all subviews for handling }
+    evBroadcast, evCommand :
+      case Event.Command of
+        cmCancel, cmClose :
+          begin
+            Cancel(cmCancel);
+            ClearEvent(Event);
+          end;
+        cmStatusPause :
+          begin
+            Status^.Pause;
+            ClearEvent(Event);
+          end;
+        cmStatusResume :
+          begin
+            Status^.Resume;
+            ClearEvent(Event);
+          end;
+      end;
+  end;
+  TDialog.HandleEvent(Event);
+end;
+
+{****************************************************************************}
+{ TStatusDlg.InsertButtons                                                   }
+{****************************************************************************}
+procedure TStatusDlg.InsertButtons (AFlags : Word);
+var
+  R : TRect;
+  P : PButton;
+  Buttons : Byte;
+  X, Y, Gap : Integer;
+  i : Word;
+begin
+  Buttons := Byte(((AFlags and sdCancelButton) = sdCancelButton));
+  { do this Inc twice, once for Pause and once for Resume buttons }
+  Inc(Buttons,2 * Byte(((AFlags and sdPauseButton) = sdPauseButton)));
+  if Buttons > 0 then
+  begin
+    Status^.GrowMode := gfGrowHiX;
+    { resize dialog to hold all requested buttons }
+    if Size.X < ((Buttons * 12) + 2) then
+      GrowTo((Buttons * 12) + 2,Size.Y + 2)
+    else GrowTo(Size.X,Size.Y + 2);
+    { find correct starting position for first button }
+    Gap := Size.X - (Buttons * 10) - 2;
+    Gap := Gap div Succ(Buttons);
+    X := Gap;
+    if X < 2 then
+      X := 2;
+    Y := Size.Y - 3;
+    { insert buttons }
+    if ((AFlags and sdCancelButton) = sdCancelButton) then
+    begin
+      P := NewButton(X,Y,10,2,'Cancel',cmCancel,hcCancel,bfDefault);
+      P^.GrowMode := gfGrowHiY or gfGrowLoY;
+      Inc(X,12 + Gap);
+    end;
+    if ((AFlags and sdPauseButton) = sdPauseButton) then
+    begin
+      P := NewButton(X,Y,10,2,'~P~ause',cmStatusPause,hcStatusPause,bfNormal);
+      P^.GrowMode := gfGrowHiY or gfGrowLoY;
+      Inc(X,12 + Gap);
+      P := NewButton(X,Y,10,2,'~R~esume',cmStatusResume,hcStatusResume,
+                     bfBroadcast);
+      P^.GrowMode := gfGrowHiY or gfGrowLoY;
+    end;
+  end;  { of if }
+  SelectNext(False);
+end;
+
+{****************************************************************************}
+{ TStatusDlg.Store                                                           }
+{****************************************************************************}
+procedure TStatusDlg.Store (var S : TStream);
+begin
+  TDialog.Store(S);
+  PutSubViewPtr(S,Status);
+end;
+
+{****************************************************************************}
+{ TStatusMessageDlg Object                                                   }
+{****************************************************************************}
+{****************************************************************************}
+{ TStatusMessageDlg.Init                                                     }
+{****************************************************************************}
+constructor TStatusMessageDlg.Init (ATitle : TTitleStr; AStatus : PStatus;
+                                    AFlags : Word; AMessage : String);
+var
+  P : PStaticText;
+  X, Y : Integer;
+  R : TRect;
+begin
+  if not TStatusDlg.Init(ATitle,AStatus,AFlags) then
+    Fail;
+  Status^.GrowMode := gfGrowLoY or gfGrowHiY;
+  GetExtent(R);
+  X := R.B.X - R.A.X;
+  if X < Size.X then
+    X := Size.X;
+  Y := R.B.Y - R.A.Y;
+  if Y < Size.Y then
+    Y := Size.Y;
+  GrowTo(X,Y);
+  R.Assign(2,2,Size.X-2,Size.Y-3);
+  P := New(PStaticText,Init(R,AMessage));
+  if (P = nil) then
+  begin
+    TStatusDlg.Done;
+    Fail;
+  end;
+  GrowTo(Size.X,Size.Y + P^.Size.Y + 1);
+  Insert(P);
+end;
+
+{****************************************************************************}
+{                    Global procedures and functions                         }
+{****************************************************************************}
+
+{****************************************************************************}
+{ RegisterStatuses                                                           }
+{****************************************************************************}
+procedure RegisterStatuses;
+begin
+{  RegisterType(RStatus);
+  RegisterType(RStatusDlg);
+  RegisterType(RGauge);
+  RegisterType(RArrowGauge);
+  RegisterType(RPercentGauge);
+  RegisterType(RBarGauge);
+  RegisterType(RSpinnerGauge); }
+end;
+
+{****************************************************************************}
+{                            Unit Initialization                             }
+{****************************************************************************}
+begin
+end.

+ 2686 - 0
fv/stddlg.pas

@@ -0,0 +1,2686 @@
+{*******************************************************}
+{ Free Vision Runtime Library                           }
+{ StdDlg Unit                                           }
+{ Version: 0.1.0                                        }
+{ Release Date: July 23, 1998                           }
+{                                                       }
+{*******************************************************}
+{                                                       }
+{ This unit is a port of Borland International's        }
+{ StdDlg.pas unit.  It is for distribution with the     }
+{ Free Pascal (FPK) Compiler as part of the 32-bit      }
+{ Free Vision library.  The unit is still fully         }
+{ functional under BP7 by using the tp compiler         }
+{ directive when rebuilding the library.                }
+{                                                       }
+{*******************************************************}
+
+{ Revision History
+
+1.1a   (97/12/29)
+  - fixed bug in TFileDialog.HandleEvent that prevented the user from being
+    able to have an action taken automatically when the FileList was
+    selected and kbEnter pressed
+
+1.1
+  - modified OpenNewFile to take a history list ID
+  - implemented OpenNewFile
+
+1.0   (1992)
+  - original implementation }
+
+unit StdDlg;
+
+{
+  This unit has been modified to make some functions global, apply patches
+  from version 3.1 of the TVBUGS list, added TEditChDirDialog, and added
+  several new global functions and procedures.
+}
+
+{$i platform.inc}
+
+{$ifdef PPC_FPC}
+  {$H-}
+{$else}
+  {$F+,O+,E+,N+}
+{$endif}
+{$X+,R-,I-,Q-,V-}
+{$ifndef OS_LINUX}
+  {$S-}
+{$endif}
+{$ifdef OS_DOS}
+  {$define HAS_DOS_DRIVES}
+{$endif}
+{$ifdef OS_WINDOWS}
+  {$define HAS_DOS_DRIVES}
+{$endif}
+{$ifdef OS_OS2}
+  {$define HAS_DOS_DRIVES}
+{$endif}
+
+interface
+
+uses
+  ObjTypes, Objects, Drivers, Views, Dialogs, Validate, Dos;
+
+const
+{$ifdef PPC_FPC}
+  MaxDir   = 255;   { Maximum length of a DirStr. }
+  MaxFName = 255; { Maximum length of a FNameStr. }
+
+  {$ifdef OS_LINUX}
+  DirSeparator : Char = '/';
+  {$else}
+  DirSeparator : Char = '\';
+  {$endif}
+
+{$else}
+  MaxDir = 67;   { Maximum length of a DirStr. }
+  MaxFName = 79; { Maximum length of a FNameStr. }
+  DirSeparator: Char = '\';
+{$endif}
+
+
+type
+  { TSearchRec }
+
+  {  Record used to store directory information by TFileDialog
+     This is a part of Dos.Searchrec for Bp !! }
+
+  TSearchRec = packed record
+    Attr: Longint;
+    Time: Longint;
+    Size: Longint;
+{$ifdef PPC_FPC}
+    Name: string[255];
+{$else not PPC_FPC}
+    Name: string[12];
+{$endif not PPC_FPC}
+  end;
+  PSearchRec = ^TSearchRec;
+
+type
+
+  { TFileInputLine is a special input line that is used by      }
+  { TFileDialog that will update its contents in response to a  }
+  { cmFileFocused command from a TFileList.          }
+
+  PFileInputLine = ^TFileInputLine;
+  TFileInputLine = object(TInputLine)
+    constructor Init(var Bounds: TRect; AMaxLen: Sw_Integer);
+    procedure HandleEvent(var Event: TEvent); virtual;
+  end;
+
+  { TFileCollection is a collection of TSearchRec's. }
+
+  PFileCollection = ^TFileCollection;
+  TFileCollection = object(TSortedCollection)
+    function Compare(Key1, Key2: Pointer): Sw_Integer; virtual;
+    procedure FreeItem(Item: Pointer); virtual;
+    function GetItem(var S: TStream): Pointer; virtual;
+    procedure PutItem(var S: TStream; Item: Pointer); virtual;
+  end;
+
+  {#Z+}
+  PFileValidator = ^TFileValidator;
+  {#Z-}
+  TFileValidator = Object(TValidator)
+  end;  { of TFileValidator }
+
+  { TSortedListBox is a TListBox that assumes it has a     }
+  { TStoredCollection instead of just a TCollection.  It will   }
+  { perform an incremental search on the contents.       }
+
+  PSortedListBox = ^TSortedListBox;
+  TSortedListBox = object(TListBox)
+    SearchPos: Byte;
+    ShiftState: Byte;
+    constructor Init(var Bounds: TRect; ANumCols: Sw_Word;
+      AScrollBar: PScrollBar);
+    procedure HandleEvent(var Event: TEvent); virtual;
+    function GetKey(var S: String): Pointer; virtual;
+    procedure NewList(AList: PCollection); virtual;
+  end;
+
+  { TFileList is a TSortedList box that assumes it contains     }
+  { a TFileCollection as its collection.  It also communicates  }
+  { through broadcast messages to TFileInput and TInfoPane      }
+  { what file is currently selected.             }
+
+  PFileList = ^TFileList;
+  TFileList = object(TSortedListBox)
+    constructor Init(var Bounds: TRect; AScrollBar: PScrollBar);
+    destructor Done; virtual;
+    function DataSize: Sw_Word; virtual;
+    procedure FocusItem(Item: Sw_Integer); virtual;
+    procedure GetData(var Rec); virtual;
+    function GetText(Item,MaxLen: Sw_Integer): String; virtual;
+    function GetKey(var S: String): Pointer; virtual;
+    procedure HandleEvent(var Event: TEvent); virtual;
+    procedure ReadDirectory(AWildCard: PathStr);
+    procedure SetData(var Rec); virtual;
+  end;
+
+  { TFileInfoPane is a TView that displays the information      }
+  { about the currently selected file in the TFileList     }
+  { of a TFileDialog.                  }
+
+  PFileInfoPane = ^TFileInfoPane;
+  TFileInfoPane = object(TView)
+    S: TSearchRec;
+    constructor Init(var Bounds: TRect);
+    procedure Draw; virtual;
+    function GetPalette: PPalette; virtual;
+    procedure HandleEvent(var Event: TEvent); virtual;
+  end;
+
+  { TFileDialog is a standard file name input dialog      }
+
+  TWildStr = PathStr;
+
+const
+  fdOkButton      = $0001;      { Put an OK button in the dialog }
+  fdOpenButton    = $0002;      { Put an Open button in the dialog }
+  fdReplaceButton = $0004;      { Put a Replace button in the dialog }
+  fdClearButton   = $0008;      { Put a Clear button in the dialog }
+  fdHelpButton    = $0010;      { Put a Help button in the dialog }
+  fdNoLoadDir     = $0100;      { Do not load the current directory }
+            { contents into the dialog at Init. }
+            { This means you intend to change the }
+            { WildCard by using SetData or store }
+            { the dialog on a stream. }
+
+type
+
+  PFileHistory = ^TFileHistory;
+  TFileHistory = object(THistory)
+    CurDir : PString;
+    procedure HandleEvent(var Event: TEvent);virtual;
+    destructor Done; virtual;
+    procedure AdaptHistoryToDir(Dir : string);
+  end;
+
+  PFileDialog = ^TFileDialog;
+  TFileDialog = object(TDialog)
+    FileName: PFileInputLine;
+    FileList: PFileList;
+    FileHistory: PFileHistory;
+    WildCard: TWildStr;
+    Directory: PString;
+    constructor Init(AWildCard: TWildStr; const ATitle,
+      InputName: String; AOptions: Word; HistoryId: Byte);
+    constructor Load(var S: TStream);
+    destructor Done; virtual;
+    procedure GetData(var Rec); virtual;
+    procedure GetFileName(var S: PathStr);
+    procedure HandleEvent(var Event: TEvent); virtual;
+    procedure SetData(var Rec); virtual;
+    procedure Store(var S: TStream);
+    function Valid(Command: Word): Boolean; virtual;
+  private
+    procedure ReadDirectory;
+  end;
+
+  { TDirEntry }
+
+  PDirEntry = ^TDirEntry;
+  TDirEntry = record
+    DisplayText: PString;
+    Directory: PString;
+  end;  { of TDirEntry }
+
+  { TDirCollection is a collection of TDirEntry's used by       }
+  { TDirListBox.                 }
+
+  PDirCollection = ^TDirCollection;
+  TDirCollection = object(TCollection)
+    function GetItem(var S: TStream): Pointer; virtual;
+    procedure FreeItem(Item: Pointer); virtual;
+    procedure PutItem(var S: TStream; Item: Pointer); virtual;
+  end;
+
+  { TDirListBox displays a tree of directories for use in the }
+  { TChDirDialog.                    }
+
+  PDirListBox = ^TDirListBox;
+  TDirListBox = object(TListBox)
+    Dir: DirStr;
+    Cur: Word;
+    constructor Init(var Bounds: TRect; AScrollBar: PScrollBar);
+    destructor Done; virtual;
+    function GetText(Item,MaxLen: Sw_Integer): String; virtual;
+    procedure HandleEvent(var Event: TEvent); virtual;
+    function IsSelected(Item: Sw_Integer): Boolean; virtual;
+    procedure NewDirectory(var ADir: DirStr);
+    procedure SetState(AState: Word; Enable: Boolean); virtual;
+  end;
+
+  { TChDirDialog is a standard change directory dialog. }
+
+const
+  cdNormal     = $0000; { Option to use dialog immediately }
+  cdNoLoadDir  = $0001; { Option to init the dialog to store on a stream }
+  cdHelpButton = $0002; { Put a help button in the dialog }
+
+type
+
+  PChDirDialog = ^TChDirDialog;
+  TChDirDialog = object(TDialog)
+    DirInput: PInputLine;
+    DirList: PDirListBox;
+    OkButton: PButton;
+    ChDirButton: PButton;
+    constructor Init(AOptions: Word; HistoryId: Sw_Word);
+    constructor Load(var S: TStream);
+    function DataSize: Sw_Word; virtual;
+    procedure GetData(var Rec); virtual;
+    procedure HandleEvent(var Event: TEvent); virtual;
+    procedure SetData(var Rec); virtual;
+    procedure Store(var S: TStream);
+    function Valid(Command: Word): Boolean; virtual;
+  private
+    procedure SetUpDialog;
+  end;
+
+  PEditChDirDialog = ^TEditChDirDialog;
+  TEditChDirDialog = Object(TChDirDialog)
+    { TEditChDirDialog allows setting/getting the starting directory.  The
+      transfer record is a DirStr. }
+    function DataSize : Sw_Word; virtual;
+    procedure GetData (var Rec); virtual;
+    procedure SetData (var Rec); virtual;
+  end;  { of TEditChDirDialog }
+
+
+  {#Z+}
+  PDirValidator = ^TDirValidator;
+  {#Z-}
+  TDirValidator = Object(TFilterValidator)
+    constructor Init;
+    function IsValid(const S: string): Boolean; virtual;
+    function IsValidInput(var S: string; SuppressFill: Boolean): Boolean;
+      virtual;
+  end;  { of TDirValidator }
+
+
+  FileConfirmFunc = function (AFile : FNameStr) : Boolean;
+    { Functions of type FileConfirmFunc's are used to prompt the end user for
+      confirmation of an operation.
+
+      FileConfirmFunc's should ask the user whether to perform the desired
+      action on the file named AFile.  If the user elects to perform the
+      function FileConfirmFunc's return True, otherwise they return False.
+
+      Using FileConfirmFunc's allows routines to be coded independant of the
+      user interface implemented.  OWL and TurboVision are supported through
+      conditional defines.  If you do not use either user interface you must
+      compile this unit with the conditional define cdNoMessages and set all
+      FileConfirmFunc variables to a valid function prior to calling any
+      routines in this unit. }
+    {#X ReplaceFile DeleteFile }
+
+
+var
+
+  ReplaceFile : FileConfirmFunc;
+    { ReplaceFile returns True if the end user elects to replace the existing
+      file with the new file, otherwise it returns False.
+
+      ReplaceFile is only called when #CheckOnReplace# is True. }
+    {#X DeleteFile }
+
+  DeleteFile : FileConfirmFunc;
+    { DeleteFile returns True if the end user elects to delete the file,
+      otherwise it returns False.
+
+       DeleteFile is only called when #CheckOnDelete# is True. }
+    {#X ReplaceFile }
+
+
+const
+
+  CInfoPane = #30;
+
+  { TStream registration records }
+
+function Contains(S1, S2: String): Boolean;
+  { Contains returns true if S1 contains any characters in S2. }
+
+function DriveValid(Drive: Char): Boolean;
+  { DriveValid returns True if Drive is a valid DOS drive.  Drive valid works
+    by attempting to change the current directory to Drive, then restoring
+    the original directory. }
+
+function ExtractDir(AFile: FNameStr): DirStr;
+  { ExtractDir returns the path of AFile terminated with a trailing '\'.  If
+    AFile contains no directory information, an empty string is returned. }
+
+function ExtractFileName(AFile: FNameStr): NameStr;
+  { ExtractFileName returns the file name without any directory or file
+    extension information. }
+
+function Equal(const S1, S2: String; Count: Sw_word): Boolean;
+  { Equal returns True if S1 equals S2 for up to Count characters.  Equal is
+    case-insensitive. }
+
+function FileExists (AFile : FNameStr) : Boolean;
+  { FileExists looks for the file specified in AFile.  If AFile is present
+    FileExists returns true, otherwise FileExists returns False.
+
+    The search is performed relative to the current system directory, but
+    other directories may be searched by prefacing a file name with a valid
+    directory path.
+
+    There is no check for a vaild file name or drive.  Errrors are handled
+    internally and not reported in DosError.  Critical errors are left to
+    the system's critical error handler. }
+  {#X OpenFile }
+
+function GetCurDir: DirStr;
+  { GetCurDir returns the current directory.  The directory returned always
+    ends with a trailing backslash '\'. }
+
+function GetCurDrive: Char;
+  { GetCurDrive returns the letter of the current drive as reported by the
+    operating system. }
+
+function IsWild(const S: String): Boolean;
+  { IsWild returns True if S contains a question mark (?) or asterix (*). }
+
+function IsList(const S: String): Boolean;
+  { IsList returns True if S contains list separator (;) char }
+
+function IsDir(const S: String): Boolean;
+  { IsDir returns True if S is a valid DOS directory. }
+
+procedure MakeResources;
+  { MakeResources places a language specific version of all resources
+    needed for the StdDlg unit to function on the RezFile using the string
+    constants and variables in the Resource unit.  The Resource unit and the
+    appropriate string lists must be initialized prior to calling this
+    procedure. }
+
+function NoWildChars(S: String): String;
+  { NoWildChars deletes the wild card characters ? and * from the string S
+    and returns the result. }
+
+function OpenFile (var AFile : FNameStr; HistoryID : Byte) : Boolean;
+  { OpenFile prompts the user to select a file using the file specifications
+    in AFile as the starting file and path.  Wildcards are accepted.  If the
+    user accepts a file OpenFile returns True, otherwise OpenFile returns
+    False.
+
+    Note: The file returned may or may not exist. }
+
+function OpenNewFile (var AFile: FNameStr; HistoryID: Byte): Boolean;
+  { OpenNewFile allows the user to select a directory from disk and enter a
+    new file name.  If the file name entered is an existing file the user is
+    optionally prompted for confirmation of replacing the file based on the
+    value in #CheckOnReplace#.  If a file name is successfully entered,
+    OpenNewFile returns True. }
+  {#X OpenFile }
+
+function PathValid(var Path: PathStr): Boolean;
+  { PathValid returns True if Path is a valid DOS path name.  Path may be a
+    file or directory name.  Trailing '\'s are removed. }
+
+procedure RegisterStdDlg;
+  { RegisterStdDlg registers all objects in the StdDlg unit for stream
+    usage. }
+
+function SaveAs (var AFile : FNameStr; HistoryID : Word) : Boolean;
+  { SaveAs prompts the user for a file name using AFile as a template.  If
+    AFile already exists and CheckOnReplace is True, the user is prompted
+    to replace the file.
+
+    If a valid file name is entered SaveAs returns True, other SaveAs returns
+    False. }
+
+function SelectDir (var ADir : DirStr; HistoryID : Byte) : Boolean;
+  { SelectDir prompts the user to select a directory using ADir as the
+    starting directory.  If a directory is selected, SelectDir returns True.
+    The directory returned is gauranteed to exist. }
+
+function ShrinkPath (AFile : FNameStr; MaxLen : Byte) : FNameStr;
+  { ShrinkPath returns a file name with a maximu length of MaxLen.
+    Internal directories are removed and replaced with elipses as needed to
+    make the file name fit in MaxLen.
+
+    AFile must be a valid path name. }
+
+function StdDeleteFile (AFile : FNameStr) : Boolean;
+  { StdDeleteFile returns True if the end user elects to delete the file,
+    otherwise it returns False.
+
+    DeleteFile is only called when CheckOnDelete is True. }
+
+function StdReplaceFile (AFile : FNameStr) : Boolean;
+  { StdReplaceFile returns True if the end user elects to replace the existing
+    AFile with the new AFile, otherwise it returns False.
+
+    ReplaceFile is only called when CheckOnReplace is True. }
+
+function ValidFileName(var FileName: PathStr): Boolean;
+  { ValidFileName returns True if FileName is a valid DOS file name. }
+
+
+const
+  CheckOnReplace : Boolean = True;
+    { CheckOnReplace is used by file functions.  If a file exists, it is
+      optionally replaced based on the value of CheckOnReplace.
+
+      If CheckOnReplace is False the file is replaced without asking the
+      user.  If CheckOnReplace is True, the end user is asked to replace the
+      file using a call to ReplaceFile.
+
+      CheckOnReplace is set to True by default. }
+
+  CheckOnDelete : Boolean = True;
+    { CheckOnDelete is used by file and directory functions.  If a file
+      exists, it is optionally deleted based on the value of CheckOnDelete.
+
+      If CheckOnDelete is False the file or directory is deleted without
+      asking the user.  If CheckOnDelete is True, the end user is asked to
+      delete the file/directory using a call to DeleteFile.
+
+      CheckOnDelete is set to True by default. }
+
+
+
+const
+  RFileInputLine: TStreamRec = (
+     ObjType: idFileInputLine;
+     VmtLink: Ofs(TypeOf(TFileInputLine)^);
+     Load:    @TFileInputLine.Load;
+     Store:   @TFileInputLine.Store
+  );
+
+  RFileCollection: TStreamRec = (
+     ObjType: idFileCollection;
+     VmtLink: Ofs(TypeOf(TFileCollection)^);
+     Load:    @TFileCollection.Load;
+     Store:   @TFileCollection.Store
+  );
+
+  RFileList: TStreamRec = (
+     ObjType: idFileList;
+     VmtLink: Ofs(TypeOf(TFileList)^);
+     Load:    @TFileList.Load;
+     Store:   @TFileList.Store
+  );
+
+  RFileInfoPane: TStreamRec = (
+     ObjType: idFileInfoPane;
+     VmtLink: Ofs(TypeOf(TFileInfoPane)^);
+     Load:    @TFileInfoPane.Load;
+     Store:   @TFileInfoPane.Store
+  );
+
+  RFileDialog: TStreamRec = (
+     ObjType: idFileDialog;
+     VmtLink: Ofs(TypeOf(TFileDialog)^);
+     Load:    @TFileDialog.Load;
+     Store:   @TFileDialog.Store
+  );
+
+  RDirCollection: TStreamRec = (
+     ObjType: idDirCollection;
+     VmtLink: Ofs(TypeOf(TDirCollection)^);
+     Load:    @TDirCollection.Load;
+     Store:   @TDirCollection.Store
+  );
+
+  RDirListBox: TStreamRec = (
+     ObjType: idDirListBox;
+     VmtLink: Ofs(TypeOf(TDirListBox)^);
+     Load:    @TDirListBox.Load;
+     Store:   @TDirListBox.Store
+  );
+
+  RChDirDialog: TStreamRec = (
+     ObjType: idChDirDialog;
+     VmtLink: Ofs(TypeOf(TChDirDialog)^);
+     Load:    @TChDirDialog.Load;
+     Store:   @TChDirDialog.Store
+  );
+
+  RSortedListBox: TStreamRec = (
+     ObjType: idSortedListBox;
+     VmtLink: Ofs(TypeOf(TSortedListBox)^);
+     Load:    @TSortedListBox.Load;
+     Store:   @TSortedListBox.Store
+  );
+
+  REditChDirDialog : TStreamRec = (
+    ObjType : idEditChDirDialog;
+    VmtLink : Ofs(TypeOf(TEditChDirDialog)^);
+    Load    : @TEditChDirDialog.Load;
+    Store   : @TEditChDirDialog.Store);
+
+
+implementation
+
+{****************************************************************************}
+{            Local Declarations              }
+{****************************************************************************}
+
+uses
+  FVConsts, App, Memory, HistList, MsgBox, Resource;
+
+type
+
+  PStringRec = record
+    { PStringRec is needed for properly displaying PStrings using
+      MessageBox. }
+    AString : PString;
+  end;
+
+{****************************************************************************}
+{ TDirValidator Object                        }
+{****************************************************************************}
+{****************************************************************************}
+{ TDirValidator.Init                    }
+{****************************************************************************}
+constructor TDirValidator.Init;
+const   { What should this list be?  The commented one doesn't allow home,
+  end, right arrow, left arrow, Ctrl+XXXX, etc. }
+  Chars: TCharSet = ['A'..'Z','a'..'z','.','~',':','_','-'];
+{  Chars: TCharSet = [#0..#255]; }
+begin
+  Chars := Chars + [DirSeparator];
+  if not inherited Init(Chars) then
+    Fail;
+end;
+
+{****************************************************************************}
+{ TDirValidator.IsValid                      }
+{****************************************************************************}
+function TDirValidator.IsValid(const S: string): Boolean;
+begin
+{  IsValid := False; }
+  IsValid := True;
+end;
+
+{****************************************************************************}
+{ TDirValidator.IsValidInput                  }
+{****************************************************************************}
+function TDirValidator.IsValidInput(var S: string; SuppressFill: Boolean): Boolean;
+begin
+{  IsValid := False; }
+  IsValidInput := True;
+end;
+
+{****************************************************************************}
+{ TFileInputLine Object                      }
+{****************************************************************************}
+{****************************************************************************}
+{ TFileInputLine.Init                     }
+{****************************************************************************}
+constructor TFileInputLine.Init(var Bounds: TRect; AMaxLen: Sw_Integer);
+begin
+  TInputLine.Init(Bounds, AMaxLen);
+  EventMask := EventMask or evBroadcast;
+end;
+
+{****************************************************************************}
+{ TFileInputLine.HandleEvent                  }
+{****************************************************************************}
+procedure TFileInputLine.HandleEvent(var Event: TEvent);
+begin
+  TInputLine.HandleEvent(Event);
+  if (Event.What = evBroadcast) and (Event.Command = cmFileFocused) and
+    (State and sfSelected = 0) then
+  begin
+     if PSearchRec(Event.InfoPtr)^.Attr and Directory <> 0 then
+       begin
+          Data^ := PSearchRec(Event.InfoPtr)^.Name + DirSeparator +
+            PFileDialog(Owner)^.WildCard;
+          { PFileDialog(Owner)^.FileHistory^.AdaptHistoryToDir(
+              PSearchRec(Event.InfoPtr)^.Name+DirSeparator);}
+       end
+     else Data^ := PSearchRec(Event.InfoPtr)^.Name;
+     DrawView;
+  end;
+end;
+
+{****************************************************************************}
+{ TFileCollection Object                       }
+{****************************************************************************}
+{****************************************************************************}
+{ TFileCollection.Compare                     }
+{****************************************************************************}
+  function uppername(const s : string) : string;
+  var
+    i  : Sw_integer;
+    in_name : boolean;
+  begin
+     in_name:=true;
+     for i:=length(s) downto 1 do
+      if in_name and (s[i] in ['a'..'z']) then
+        uppername[i]:=char(byte(s[i])-32)
+      else
+       begin
+          uppername[i]:=s[i];
+          if s[i] = DirSeparator then
+            in_name:=false;
+       end;
+     uppername[0]:=s[0];
+  end;
+
+function TFileCollection.Compare(Key1, Key2: Pointer): Sw_Integer;
+begin
+  if PSearchRec(Key1)^.Name = PSearchRec(Key2)^.Name then Compare := 0
+  else if PSearchRec(Key1)^.Name = '..' then Compare := 1
+  else if PSearchRec(Key2)^.Name = '..' then Compare := -1
+  else if (PSearchRec(Key1)^.Attr and Directory <> 0) and
+     (PSearchRec(Key2)^.Attr and Directory = 0) then Compare := 1
+  else if (PSearchRec(Key2)^.Attr and Directory <> 0) and
+     (PSearchRec(Key1)^.Attr and Directory = 0) then Compare := -1
+{$ifdef linux}
+  else if PSearchRec(Key1)^.Name > PSearchRec(Key2)^.Name then
+{$else linux}
+  else if UpperName(PSearchRec(Key1)^.Name) > UpperName(PSearchRec(Key2)^.Name) then
+{$endif def linux}
+    Compare := 1
+  else Compare := -1;
+end;
+
+{****************************************************************************}
+{ TFileCollection.FreeItem                   }
+{****************************************************************************}
+procedure TFileCollection.FreeItem(Item: Pointer);
+begin
+  Dispose(PSearchRec(Item));
+end;
+
+{****************************************************************************}
+{ TFileCollection.GetItem                     }
+{****************************************************************************}
+function TFileCollection.GetItem(var S: TStream): Pointer;
+var
+  Item: PSearchRec;
+begin
+  New(Item);
+  S.Read(Item^, SizeOf(TSearchRec));
+  GetItem := Item;
+end;
+
+{****************************************************************************}
+{ TFileCollection.PutItem                     }
+{****************************************************************************}
+procedure TFileCollection.PutItem(var S: TStream; Item: Pointer);
+begin
+  S.Write(Item^, SizeOf(TSearchRec));
+end;
+
+
+{*****************************************************************************
+               TFileList
+*****************************************************************************}
+
+const
+  ListSeparator=';';
+
+function MatchesMask(What, Mask: string): boolean;
+
+  function upper(const s : string) : string;
+  var
+    i  : Sw_integer;
+  begin
+     for i:=1 to length(s) do
+      if s[i] in ['a'..'z'] then
+       upper[i]:=char(byte(s[i])-32)
+      else
+       upper[i]:=s[i];
+     upper[0]:=s[0];
+  end;
+
+  Function CmpStr(const hstr1,hstr2:string):boolean;
+  var
+    found : boolean;
+    i1,i2 : Sw_integer;
+  begin
+    i1:=0;
+    i2:=0;
+    if hstr1='' then
+      begin
+        CmpStr:=(hstr2='');
+        exit;
+      end;
+    found:=true;
+    repeat
+      if found then
+       inc(i2);
+      inc(i1);
+      case hstr1[i1] of
+        '?' :
+          found:=true;
+        '*' :
+          begin
+            found:=true;
+            if (i1=length(hstr1)) then
+             i2:=length(hstr2)
+            else
+             if (i1<length(hstr1)) and (hstr1[i1+1]<>hstr2[i2]) then
+              begin
+                if i2<length(hstr2) then
+                 dec(i1)
+              end
+            else
+             if i2>1 then
+              dec(i2);
+          end;
+        else
+          found:=(hstr1[i1]=hstr2[i2]) or (hstr2[i2]='?');
+      end;
+    until (i1>=length(hstr1)) or (i2>length(hstr2)) or (not found);
+    if found then
+      found:=(i1>=length(hstr1)) and (i2>=length(hstr2));
+    CmpStr:=found;
+  end;
+
+var
+  D1,D2 : DirStr;
+  N1,N2 : NameStr;
+  E1,E2 : Extstr;
+begin
+{$ifdef linux}
+  FSplit(What,D1,N1,E1);
+  FSplit(Mask,D2,N2,E2);
+{$else}
+  FSplit(Upper(What),D1,N1,E1);
+  FSplit(Upper(Mask),D2,N2,E2);
+{$endif}
+  MatchesMask:=CmpStr(N2,N1) and CmpStr(E2,E1);
+end;
+
+function MatchesMaskList(What, MaskList: string): boolean;
+var P: integer;
+    Match: boolean;
+begin
+  Match:=false;
+  if What<>'' then
+  repeat
+    P:=Pos(ListSeparator, MaskList);
+    if P=0 then P:=length(MaskList)+1;
+    Match:=MatchesMask(What,copy(MaskList,1,P-1));
+    Delete(MaskList,1,P);
+  until Match or (MaskList='');
+  MatchesMaskList:=Match;
+end;
+
+constructor TFileList.Init(var Bounds: TRect; AScrollBar: PScrollBar);
+begin
+  TSortedListBox.Init(Bounds, 2, AScrollBar);
+end;
+
+destructor TFileList.Done;
+begin
+  if List <> nil then Dispose(List, Done);
+  TListBox.Done;
+end;
+
+function TFileList.DataSize: Sw_Word;
+begin
+  DataSize := 0;
+end;
+
+procedure TFileList.FocusItem(Item: Sw_Integer);
+begin
+  TSortedListBox.FocusItem(Item);
+  if (List^.Count > 0) then
+    Message(Owner, evBroadcast, cmFileFocused, List^.At(Item));
+end;
+
+procedure TFileList.GetData(var Rec);
+begin
+end;
+
+function TFileList.GetKey(var S: String): Pointer;
+const
+  SR: TSearchRec = ();
+
+procedure UpStr(var S: String);
+var
+  I: Sw_Integer;
+begin
+  for I := 1 to Length(S) do S[I] := UpCase(S[I]);
+end;
+
+begin
+  if (ShiftState and $03 <> 0) or ((S <> '') and (S[1]='.')) then
+    SR.Attr := Directory
+  else SR.Attr := 0;
+  SR.Name := S;
+{$ifndef linux}
+  UpStr(SR.Name);
+{$endif linux}
+  GetKey := @SR;
+end;
+
+function TFileList.GetText(Item,MaxLen: Sw_Integer): String;
+var
+  S: String;
+  SR: PSearchRec;
+begin
+  SR := PSearchRec(List^.At(Item));
+  S := SR^.Name;
+  if SR^.Attr and Directory <> 0 then
+  begin
+    S[Length(S)+1] := DirSeparator;
+    Inc(S[0]);
+  end;
+  GetText := S;
+end;
+
+procedure TFileList.HandleEvent(var Event: TEvent);
+var
+  S : String;
+  K : pointer;
+  Value : Sw_integer;
+begin
+  if (Event.What = evMouseDown) and (Event.Double) then
+  begin
+    Event.What := evCommand;
+    Event.Command := cmOK;
+    PutEvent(Event);
+    ClearEvent(Event);
+  end
+  else if (Event.What = evKeyDown) and (Event.CharCode='<') then
+  begin
+    { select '..' }
+      S := '..';
+      K := GetKey(S);
+      If PSortedCollection(List)^.Search(K, Value) then
+        FocusItem(Value);
+  end
+  else TSortedListBox.HandleEvent(Event);
+end;
+
+procedure TFileList.ReadDirectory(AWildCard: PathStr);
+const
+  FindAttr = ReadOnly + Archive;
+{$ifdef linux}
+  AllFiles = '*';
+{$else}
+  AllFiles = '*.*';
+{$endif}
+  PrevDir  = '..';
+var
+  S: SearchRec;
+  P: PSearchRec;
+  FileList: PFileCollection;
+  NumFiles: Word;
+  FindStr,
+  WildName : string;
+  Dir: DirStr;
+  Ext: ExtStr;
+  Name: NameStr;
+  Event : TEvent;
+  Tmp: PathStr;
+begin
+  NumFiles := 0;
+  FileList := New(PFileCollection, Init(5, 5));
+  AWildCard := FExpand(AWildCard);
+  FSplit(AWildCard, Dir, Name, Ext);
+  if pos(ListSeparator,AWildCard)>0 then
+   begin
+     WildName:=Copy(AWildCard,length(Dir)+1,255);
+     FindStr:=Dir+AllFiles;
+   end
+  else
+   begin
+     WildName:=Name+Ext;
+     FindStr:=AWildCard;
+   end;
+  FindFirst(FindStr, FindAttr, S);
+  P := PSearchRec(@P);
+  while assigned(P) and (DosError = 0) do
+   begin
+     if (S.Attr and Directory = 0) and
+        MatchesMaskList(S.Name,WildName) then
+     begin
+       P := MemAlloc(SizeOf(P^));
+       if assigned(P) then
+       begin
+         P^.Attr:=S.Attr;
+         P^.Time:=S.Time;
+         P^.Size:=S.Size;
+         P^.Name:=S.Name;
+         FileList^.Insert(P);
+       end;
+     end;
+     FindNext(S);
+   end;
+ {$ifdef fpc}
+  FindClose(S);
+ {$endif}
+
+  Tmp := Dir + AllFiles;
+  FindFirst(Tmp, Directory, S);
+  while (P <> nil) and (DosError = 0) do
+  begin
+    if (S.Attr and Directory <> 0) and (S.Name <> '.') and (S.Name <> '..') then
+    begin
+      P := MemAlloc(SizeOf(P^));
+      if P <> nil then
+      begin
+        P^.Attr:=S.Attr;
+        P^.Time:=S.Time;
+        P^.Size:=S.Size;
+        P^.Name:=S.Name;
+        FileList^.Insert(P);
+      end;
+    end;
+    FindNext(S);
+  end;
+ {$ifdef fpc}
+  FindClose(S);
+ {$endif}
+ {$ifndef linux}
+  if Length(Dir) > 4 then
+ {$endif not linux}
+  begin
+    P := MemAlloc(SizeOf(P^));
+    if P <> nil then
+    begin
+      FindFirst(Tmp, Directory, S);
+      FindNext(S);
+      if (DosError = 0) and (S.Name = PrevDir) then
+       begin
+         P^.Attr:=S.Attr;
+         P^.Time:=S.Time;
+         P^.Size:=S.Size;
+         P^.Name:=S.Name;
+       end
+      else
+       begin
+         P^.Name := PrevDir;
+         P^.Size := 0;
+         P^.Time := $210000;
+         P^.Attr := Directory;
+       end;
+      FileList^.Insert(PSearchRec(P));
+     {$ifdef fpc}
+      FindClose(S);
+     {$endif}
+    end;
+  end;
+  if P = nil then
+    MessageBox(strings^.get(sTooManyFiles), nil, mfOkButton + mfWarning);
+  NewList(FileList);
+  if List^.Count > 0 then
+  begin
+    Event.What := evBroadcast;
+    Event.Command := cmFileFocused;
+    Event.InfoPtr := List^.At(0);
+    Owner^.HandleEvent(Event);
+  end;
+end;
+
+procedure TFileList.SetData(var Rec);
+begin
+  with PFileDialog(Owner)^ do
+    Self.ReadDirectory(Directory^ + WildCard);
+end;
+
+{****************************************************************************}
+{ TFileInfoPane Object                        }
+{****************************************************************************}
+{****************************************************************************}
+{ TFileInfoPane.Init                    }
+{****************************************************************************}
+constructor TFileInfoPane.Init(var Bounds: TRect);
+begin
+  TView.Init(Bounds);
+  FillChar(S,SizeOf(S),#0);
+  EventMask := EventMask or evBroadcast;
+end;
+
+{****************************************************************************}
+{ TFileInfoPane.Draw                    }
+{****************************************************************************}
+procedure TFileInfoPane.Draw;
+var
+  B: TDrawBuffer;
+  D: String[9];
+  M: String[3];
+  PM: Boolean;
+  Color: Word;
+  Time: DateTime;
+  Path: PathStr;
+  FmtId: String;
+  Params: array[0..7] of LongInt;
+  Str: String[80];
+const
+  sDirectoryLine = ' %-12s %-9s %3s %2d, %4d  %2d:%02d%cm';
+  sFileLine      = ' %-12s %-9d %3s %2d, %4d  %2d:%02d%cm';
+  InValidFiles : array[0..2] of string[12] = ('','.','..');
+var
+  Month: array[1..12] of String[3];
+begin
+  Month[1] := Strings^.Get(smJan);
+  Month[2] := Strings^.Get(smFeb);
+  Month[3] := Strings^.Get(smMar);
+  Month[4] := Strings^.Get(smApr);
+  Month[5] := Strings^.Get(smMay);
+  Month[6] := Strings^.Get(smJun);
+  Month[7] := Strings^.Get(smJul);
+  Month[8] := Strings^.Get(smAug);
+  Month[9] := Strings^.Get(smSep);
+  Month[10] := Strings^.Get(smOct);
+  Month[11] := Strings^.Get(smNov);
+  Month[12] := Strings^.Get(smDec);
+  { Display path }
+  if (PFileDialog(Owner)^.Directory <> nil) then
+    Path := PFileDialog(Owner)^.Directory^
+  else Path := '';
+  Path := FExpand(Path+PFileDialog(Owner)^.WildCard);
+  Color := GetColor($01);
+  MoveChar(B, ' ', Color, Size.X * Size.Y); { fill with empty spaces }
+  WriteLine(0, 0, Size.X, Size.Y, B);
+  MoveStr(B[1], Path, Color);
+  WriteLine(0, 0, Size.X, 1, B);
+  if (S.Name = InValidFiles[0]) or (S.Name = InValidFiles[1]) or
+     (S.Name = InValidFiles[2]) then
+    Exit;
+
+  { Display file }
+  Params[0] := LongInt(@S.Name);
+  if S.Attr and Directory <> 0 then
+  begin
+    FmtId := sDirectoryLine;
+    D := Strings^.Get(sDirectory);
+    Params[1] := LongInt(@D);
+  end else
+  begin
+    FmtId := sFileLine;
+    Params[1] := S.Size;
+  end;
+  UnpackTime(S.Time, Time);
+  M := Month[Time.Month];
+  Params[2] := LongInt(@M);
+  Params[3] := Time.Day;
+  Params[4] := Time.Year;
+  PM := Time.Hour >= 12;
+  Time.Hour := Time.Hour mod 12;
+  if Time.Hour = 0 then Time.Hour := 12;
+  Params[5] := Time.Hour;
+  Params[6] := Time.Min;
+  if PM then
+    Params[7] := Byte('p')
+  else Params[7] := Byte('a');
+  FormatStr(Str, FmtId, Params);
+  MoveStr(B, Str, Color);
+  WriteLine(0, 1, Size.X, 1, B);
+
+  { Fill in rest of rectangle }
+  MoveChar(B, ' ', Color, Size.X);
+  WriteLine(0, 2, Size.X, Size.Y-2, B);
+end;
+
+function TFileInfoPane.GetPalette: PPalette;
+const
+  P: String[Length(CInfoPane)] = CInfoPane;
+begin
+  GetPalette := PPalette(@P);
+end;
+
+procedure TFileInfoPane.HandleEvent(var Event: TEvent);
+begin
+  TView.HandleEvent(Event);
+  if (Event.What = evBroadcast) and (Event.Command = cmFileFocused) then
+  begin
+    S := PSearchRec(Event.InfoPtr)^;
+    DrawView;
+  end;
+end;
+
+{****************************************************************************
+              TFileHistory
+****************************************************************************}
+
+  function LTrim(const S: String): String;
+  var
+    I: Sw_Integer;
+  begin
+    I := 1;
+    while (I < Length(S)) and (S[I] = ' ') do Inc(I);
+    LTrim := Copy(S, I, 255);
+  end;
+
+  function RTrim(const S: String): String;
+  var
+    I: Sw_Integer;
+  begin
+    I := Length(S);
+    while S[I] = ' ' do Dec(I);
+    RTrim := Copy(S, 1, I);
+  end;
+
+  function RelativePath(var S: PathStr): Boolean;
+  begin
+    S := LTrim(RTrim(S));
+    RelativePath := not ((S <> '') and ((S[1] = DirSeparator) or (S[2] = ':')));
+  end;
+
+{ try to reduce the length of S+dir as a file path+pattern }
+
+  function Simplify (var S,Dir : string) : string;
+    var i : sw_integer;
+  begin
+   if RelativePath(Dir) then
+     begin
+        if (S<>'') and (Copy(Dir,1,3)='..'+DirSeparator) then
+          begin
+             i:=Length(S);
+             for i:=Length(S)-1 downto 1 do
+               if S[i]=DirSeparator then
+                 break;
+             if S[i]=DirSeparator then
+               Simplify:=Copy(S,1,i)+Copy(Dir,4,255)
+             else
+               Simplify:=S+Dir;
+          end
+        else
+          Simplify:=S+Dir;
+     end
+   else
+      Simplify:=Dir;
+  end;
+
+{****************************************************************************}
+{ TFileHistory.HandleEvent                                                       }
+{****************************************************************************}
+procedure TFileHistory.HandleEvent(var Event: TEvent);
+var
+  HistoryWindow: PHistoryWindow;
+  R,P: TRect;
+  C: Word;
+  Rslt: String;
+begin
+  TView.HandleEvent(Event);
+  if (Event.What = evMouseDown) or
+     ((Event.What = evKeyDown) and (CtrlToArrow(Event.KeyCode) = kbDown) and
+      (Link^.State and sfFocused <> 0)) then
+  begin
+    if not Link^.Focus then
+    begin
+      ClearEvent(Event);
+      Exit;
+    end;
+    if assigned(CurDir) then
+     Rslt:=CurDir^
+    else
+     Rslt:='';
+    Rslt:=Simplify(Rslt,Link^.Data^);
+    If IsWild(Rslt) then
+      RecordHistory(Rslt);
+    Link^.GetBounds(R);
+    Dec(R.A.X); Inc(R.B.X); Inc(R.B.Y,7); Dec(R.A.Y,1);
+    Owner^.GetExtent(P);
+    R.Intersect(P);
+    Dec(R.B.Y,1);
+    HistoryWindow := InitHistoryWindow(R);
+    if HistoryWindow <> nil then
+    begin
+      C := Owner^.ExecView(HistoryWindow);
+      if C = cmOk then
+      begin
+        Rslt := HistoryWindow^.GetSelection;
+        if Length(Rslt) > Link^.MaxLen then Rslt[0] := Char(Link^.MaxLen);
+        Link^.Data^ := Rslt;
+        Link^.SelectAll(True);
+        Link^.DrawView;
+      end;
+      Dispose(HistoryWindow, Done);
+    end;
+    ClearEvent(Event);
+  end
+  else if (Event.What = evBroadcast) then
+    if ((Event.Command = cmReleasedFocus) and (Event.InfoPtr = Link))
+      or (Event.Command = cmRecordHistory) then
+    begin
+      if assigned(CurDir) then
+       Rslt:=CurDir^
+      else
+       Rslt:='';
+      Rslt:=Simplify(Rslt,Link^.Data^);
+      If IsWild(Rslt) then
+        RecordHistory(Rslt);
+    end;
+end;
+
+procedure TFileHistory.AdaptHistoryToDir(Dir : string);
+  var S,S2 : String;
+      i,Count : Sw_word;
+begin
+   if assigned(CurDir) then
+     begin
+        S:=CurDir^;
+        if S=Dir then
+          exit;
+        DisposeStr(CurDir);
+     end
+   else
+     S:='';
+   CurDir:=NewStr(Simplify(S,Dir));
+
+   Count:=HistoryCount(HistoryId);
+   for i:=1 to count do
+     begin
+        S2:=HistoryStr(HistoryId,1);
+        HistoryRemove(HistoryId,1);
+        if RelativePath(S2) then
+          if S<>'' then
+            S2:=S+S2
+          else
+            S2:=FExpand(S2);
+        { simply full path
+          we should simplify relative to Dir ! }
+        HistoryAdd(HistoryId,S2);
+     end;
+
+end;
+
+destructor TFileHistory.Done;
+begin
+  If assigned(CurDir) then
+    DisposeStr(CurDir);
+  Inherited Done;
+end;
+
+{****************************************************************************
+              TFileDialog
+****************************************************************************}
+
+constructor TFileDialog.Init(AWildCard: TWildStr; const ATitle,
+  InputName: String; AOptions: Word; HistoryId: Byte);
+var
+  Control: PView;
+  R: TRect;
+  Opt: Word;
+begin
+  R.Assign(15,1,64,20);
+  TDialog.Init(R, ATitle);
+  Options := Options or ofCentered;
+  WildCard := AWildCard;
+
+  R.Assign(3,3,31,4);
+  FileName := New(PFileInputLine, Init(R, 79));
+  FileName^.Data^ := WildCard;
+  Insert(FileName);
+  R.Assign(2,2,3+CStrLen(InputName),3);
+  Control := New(PLabel, Init(R, InputName, FileName));
+  Insert(Control);
+  R.Assign(31,3,34,4);
+  FileHistory := New(PFileHistory, Init(R, FileName, HistoryId));
+  Insert(FileHistory);
+
+  R.Assign(3,14,34,15);
+  Control := New(PScrollBar, Init(R));
+  Insert(Control);
+  R.Assign(3,6,34,14);
+  FileList := New(PFileList, Init(R, PScrollBar(Control)));
+  Insert(FileList);
+  R.Assign(2,5,8,6);
+  Control := New(PLabel, Init(R, labels^.get(slFiles), FileList));
+  Insert(Control);
+
+  R.Assign(35,3,46,5);
+  Opt := bfDefault;
+  if AOptions and fdOpenButton <> 0 then
+  begin
+    Insert(New(PButton, Init(R,labels^.get(slOpen), cmFileOpen, Opt)));
+    Opt := bfNormal;
+    Inc(R.A.Y,3); Inc(R.B.Y,3);
+  end;
+  if AOptions and fdOkButton <> 0 then
+  begin
+    Insert(New(PButton, Init(R,labels^.get(slOk), cmFileOpen, Opt)));
+    Opt := bfNormal;
+    Inc(R.A.Y,3); Inc(R.B.Y,3);
+  end;
+  if AOptions and fdReplaceButton <> 0 then
+  begin
+    Insert(New(PButton, Init(R, labels^.get(slReplace),cmFileReplace, Opt)));
+    Opt := bfNormal;
+    Inc(R.A.Y,3); Inc(R.B.Y,3);
+  end;
+  if AOptions and fdClearButton <> 0 then
+  begin
+    Insert(New(PButton, Init(R, labels^.get(slClear),cmFileClear, Opt)));
+    Opt := bfNormal;
+    Inc(R.A.Y,3); Inc(R.B.Y,3);
+  end;
+  Insert(New(PButton, Init(R, labels^.get(slCancel), cmCancel, bfNormal)));
+  Inc(R.A.Y,3); Inc(R.B.Y,3);
+  if AOptions and fdHelpButton <> 0 then
+  begin
+    Insert(New(PButton, Init(R,labels^.get(slHelp),cmHelp, bfNormal)));
+    Inc(R.A.Y,3); Inc(R.B.Y,3);
+  end;
+
+  R.Assign(1,16,48,18);
+  Control := New(PFileInfoPane, Init(R));
+  Insert(Control);
+
+  SelectNext(False);
+
+  if AOptions and fdNoLoadDir = 0 then ReadDirectory;
+end;
+
+constructor TFileDialog.Load(var S: TStream);
+begin
+  if not TDialog.Load(S) then
+    Fail;
+  S.Read(WildCard, SizeOf(TWildStr));
+  if (S.Status <> stOk) then
+  begin
+    TDialog.Done;
+    Fail;
+  end;
+  GetSubViewPtr(S, FileName);
+  GetSubViewPtr(S, FileList);
+  GetSubViewPtr(S, FileHistory);
+  ReadDirectory;
+  if (DosError <> 0) then
+  begin
+    TDialog.Done;
+    Fail;
+  end;
+end;
+
+destructor TFileDialog.Done;
+begin
+  DisposeStr(Directory);
+  TDialog.Done;
+end;
+
+procedure TFileDialog.GetData(var Rec);
+begin
+  GetFilename(PathStr(Rec));
+end;
+
+procedure TFileDialog.GetFileName(var S: PathStr);
+
+var
+  Path: PathStr;
+  Name: NameStr;
+  Ext: ExtStr;
+  TWild : string;
+  TPath: PathStr;
+  TName: NameStr;
+  TExt: NameStr;
+  i : Sw_integer;
+begin
+  S := FileName^.Data^;
+  if RelativePath(S) then
+    begin
+      if (Directory <> nil) then
+   S := FExpand(Directory^ + S);
+    end
+  else
+    S := FExpand(S);
+  if Pos(ListSeparator,S)=0 then
+   begin
+     If FileExists(S) then
+       exit;
+     FSplit(S, Path, Name, Ext);
+     if ((Name = '') or (Ext = '')) and not IsDir(S) then
+     begin
+       TWild:=WildCard;
+       repeat
+    i:=Pos(ListSeparator,TWild);
+    if i=0 then
+     i:=length(TWild)+1;
+    FSplit(Copy(TWild,1,i-1), TPath, TName, TExt);
+    if ((Name = '') and (Ext = '')) then
+      S := Path + TName + TExt
+    else
+      if Name = '' then
+        S := Path + TName + Ext
+      else
+        if Ext = '' then
+          begin
+       if IsWild(Name) then
+         S := Path + Name + TExt
+       else
+         S := Path + Name + NoWildChars(TExt);
+          end;
+    if FileExists(S) then
+     break;
+    System.Delete(TWild,1,i);
+       until TWild='';
+       if TWild='' then
+         S := Path + Name + Ext;
+     end;
+   end;
+end;
+
+procedure TFileDialog.HandleEvent(var Event: TEvent);
+begin
+  if (Event.What and evBroadcast <> 0) and
+     (Event.Command = cmListItemSelected) then
+  begin
+    EndModal(cmFileOpen);
+    ClearEvent(Event);
+  end;
+  TDialog.HandleEvent(Event);
+  if Event.What = evCommand then
+    case Event.Command of
+      cmFileOpen, cmFileReplace, cmFileClear:
+   begin
+     EndModal(Event.Command);
+     ClearEvent(Event);
+   end;
+    end;
+end;
+
+procedure TFileDialog.SetData(var Rec);
+begin
+  TDialog.SetData(Rec);
+  if (PathStr(Rec) <> '') and (IsWild(TWildStr(Rec))) then
+  begin
+    Valid(cmFileInit);
+    FileName^.Select;
+  end;
+end;
+
+procedure TFileDialog.ReadDirectory;
+begin
+  FileList^.ReadDirectory(WildCard);
+  FileHistory^.AdaptHistoryToDir(GetCurDir);
+  Directory := NewStr(GetCurDir);
+end;
+
+procedure TFileDialog.Store(var S: TStream);
+begin
+  TDialog.Store(S);
+  S.Write(WildCard, SizeOf(TWildStr));
+  PutSubViewPtr(S, FileName);
+  PutSubViewPtr(S, FileList);
+  PutSubViewPtr(S, FileHistory);
+end;
+
+function TFileDialog.Valid(Command: Word): Boolean;
+var
+  FName: PathStr;
+  Dir: DirStr;
+  Name: NameStr;
+  Ext: ExtStr;
+
+  function CheckDirectory(var S: PathStr): Boolean;
+  begin
+    if not PathValid(S) then
+    begin
+      MessageBox(Strings^.Get(sInvalidDriveOrDir), nil, mfError + mfOkButton);
+      FileName^.Select;
+      CheckDirectory := False;
+    end else CheckDirectory := True;
+  end;
+
+  function CompleteDir(const Path: string): string;
+  begin
+    { keep c: untouched PM }
+    if (Path<>'') and (Path[Length(Path)]<>DirSeparator) and
+       (Path[Length(Path)]<>':') then
+     CompleteDir:=Path+DirSeparator
+    else
+     CompleteDir:=Path;
+  end;
+
+  function NormalizeDir(const Path: string): string;
+  var Root: boolean;
+  begin
+    Root:=false;
+    {$ifdef Linux}
+    if Path=DirSeparator then Root:=true;
+    {$else}
+    if (length(Path)=3) and (Upcase(Path[1]) in['A'..'Z']) and
+       (Path[2]=':') and (Path[3]=DirSeparator) then
+         Root:=true;
+    {$endif}
+    if (Root=false) and (copy(Path,length(Path),1)=DirSeparator) then
+      NormalizeDir:=copy(Path,1,length(Path)-1)
+    else
+      NormalizeDir:=Path;
+  end;
+function NormalizeDirF(var S: openstring): boolean;
+begin
+  S:=NormalizeDir(S);
+  NormalizeDirF:=true;
+end;
+
+begin
+  if Command = 0 then
+  begin
+    Valid := True;
+    Exit;
+  end
+  else Valid := False;
+  if TDialog.Valid(Command) then
+  begin
+    GetFileName(FName);
+    if (Command <> cmCancel) and (Command <> cmFileClear) then
+    begin
+      if IsWild(FName) or IsList(FName) then
+      begin
+        FSplit(FName, Dir, Name, Ext);
+        if CheckDirectory(Dir) then
+        begin
+          FileHistory^.AdaptHistoryToDir(Dir);
+          DisposeStr(Directory);
+          Directory := NewStr(Dir);
+          if Pos(ListSeparator,FName)>0 then
+           WildCard:=Copy(FName,length(Dir)+1,255)
+          else
+           WildCard := Name+Ext;
+          if Command <> cmFileInit then
+            FileList^.Select;
+          FileList^.ReadDirectory(Directory^+WildCard);
+        end;
+      end
+    else
+      if NormalizeDirF(FName) then
+      { ^^ this is just a dummy if construct (the func always returns true,
+        it's just there, 'coz I don't want to rearrange the following "if"s... }
+      if IsDir(FName) then
+        begin
+          if CheckDirectory(FName) then
+          begin
+            FileHistory^.AdaptHistoryToDir(CompleteDir(FName));
+            DisposeStr(Directory);
+            Directory := NewSTr(CompleteDir(FName));
+            if Command <> cmFileInit then FileList^.Select;
+            FileList^.ReadDirectory(Directory^+WildCard);
+          end
+        end
+      else
+        if ValidFileName(FName) then
+          Valid := True
+        else
+          begin
+            MessageBox(^C + Strings^.Get(sInvalidFileName), nil, mfError + mfOkButton);
+            Valid := False;
+          end;
+    end
+    else Valid := True;
+  end;
+end;
+
+{ TDirCollection }
+
+function TDirCollection.GetItem(var S: TStream): Pointer;
+var
+  DirItem: PDirEntry;
+begin
+  New(DirItem);
+  DirItem^.DisplayText := S.ReadStr;
+  DirItem^.Directory := S.ReadStr;
+  GetItem := DirItem;
+end;
+
+procedure TDirCollection.FreeItem(Item: Pointer);
+var
+  DirItem: PDirEntry absolute Item;
+begin
+  DisposeStr(DirItem^.DisplayText);
+  DisposeStr(DirItem^.Directory);
+  Dispose(DirItem);
+end;
+
+procedure TDirCollection.PutItem(var S: TStream; Item: Pointer);
+var
+  DirItem: PDirEntry absolute Item;
+begin
+  S.WriteStr(DirItem^.DisplayText);
+  S.WriteStr(DirItem^.Directory);
+end;
+
+{ TDirListBox }
+
+const
+  DrivesS: String = '';
+  Drives: PString = @DrivesS;
+
+constructor TDirListBox.Init(var Bounds: TRect; AScrollBar:
+  PScrollBar);
+begin
+  DrivesS := strings^.get(sDrives);
+  TListBox.Init(Bounds, 1, AScrollBar);
+  Dir := '';
+end;
+
+destructor TDirListBox.Done;
+begin
+  if (List <> nil) then
+    Dispose(List,Done);
+  TListBox.Done;
+end;
+
+function TDirListBox.GetText(Item,MaxLen: Sw_Integer): String;
+begin
+  GetText := PDirEntry(List^.At(Item))^.DisplayText^;
+end;
+
+procedure TDirListBox.HandleEvent(var Event: TEvent);
+begin
+  case Event.What of
+    evMouseDown:
+      if Event.Double then
+      begin
+   Event.What := evCommand;
+   Event.Command := cmChangeDir;
+   PutEvent(Event);
+   ClearEvent(Event);
+      end;
+    evKeyboard:
+      if (Event.CharCode = ' ') and
+    (PSearchRec(List^.At(Focused))^.Name = '..') then
+   NewDirectory(PSearchRec(List^.At(Focused))^.Name);
+  end;
+  TListBox.HandleEvent(Event);
+end;
+
+function TDirListBox.IsSelected(Item: Sw_Integer): Boolean;
+begin
+  IsSelected := Item = Cur;
+end;
+
+procedure TDirListBox.NewDirectory(var ADir: DirStr);
+const
+  PathDir       = 'ÀÄÂ';
+  FirstDir     =   'ÀÂÄ';
+  MiddleDir   =   ' ÃÄ';
+  LastDir       =   ' ÀÄ';
+  IndentSize    = '  ';
+var
+  AList: PCollection;
+  NewDir, Dirct: DirStr;
+  C, OldC: Char;
+  S, Indent: String[80];
+  P: PString;
+  isFirst: Boolean;
+  SR: SearchRec;
+  I: Sw_Integer;
+
+  function NewDirEntry(const DisplayText, Directory: String): PDirEntry;{$ifdef PPC_BP}near;{$endif}
+  var
+    DirEntry: PDirEntry;
+  begin
+    New(DirEntry);
+    DirEntry^.DisplayText := NewStr(DisplayText);
+    DirEntry^.Directory := NewStr(Directory);
+    NewDirEntry := DirEntry;
+  end;
+
+begin
+  Dir := ADir;
+  AList := New(PDirCollection, Init(5,5));
+{$ifdef HAS_DOS_DRIVES}
+  AList^.Insert(NewDirEntry(Drives^,Drives^));
+  if Dir = Drives^ then
+  begin
+    isFirst := True;
+    OldC := ' ';
+    for C := 'A' to 'Z' do
+    begin
+      if (C < 'C') or DriveValid(C) then
+      begin
+   if OldC <> ' ' then
+   begin
+     if isFirst then
+     begin
+       S := FirstDir + OldC;
+       isFirst := False;
+     end
+     else S := MiddleDir + OldC;
+     AList^.Insert(NewDirEntry(S, OldC + ':' + DirSeparator));
+   end;
+   if C = GetCurDrive then Cur := AList^.Count;
+   OldC := C;
+      end;
+    end;
+    if OldC <> ' ' then
+      AList^.Insert(NewDirEntry(LastDir + OldC, OldC + ':' + DirSeparator));
+  end
+  else
+{$endif HAS_DOS_DRIVES}
+  begin
+    Indent := IndentSize;
+    NewDir := Dir;
+{$ifdef HAS_DOS_DRIVES}
+    Dirct := Copy(NewDir,1,3);
+    AList^.Insert(NewDirEntry(PathDir + Dirct, Dirct));
+    NewDir := Copy(NewDir,4,255);
+{$else HAS_DOS_DRIVES}
+    Dirct := '';
+{$endif HAS_DOS_DRIVES}
+    while NewDir <> '' do
+    begin
+      I := Pos(DirSeparator,NewDir);
+      if I <> 0 then
+      begin
+   S := Copy(NewDir,1,I-1);
+   Dirct := Dirct + S;
+   AList^.Insert(NewDirEntry(Indent + PathDir + S, Dirct));
+   NewDir := Copy(NewDir,I+1,255);
+      end
+      else
+      begin
+   Dirct := Dirct + NewDir;
+   AList^.Insert(NewDirEntry(Indent + PathDir + NewDir, Dirct));
+   NewDir := '';
+      end;
+      Indent := Indent + IndentSize;
+      Dirct := Dirct + DirSeparator;
+    end;
+    Cur := AList^.Count-1;
+    isFirst := True;
+    NewDir := Dirct + '*.*';
+    FindFirst(NewDir, Directory, SR);
+    while DosError = 0 do
+    begin
+      if (SR.Attr and Directory <> 0) and
+{$ifdef FPC}
+         (SR.Name <> '.') and (SR.Name <> '..') then
+{$else : not FPC}
+         (SR.Name[1] <> '.') then
+{$endif not FPC}
+      begin
+   if isFirst then
+   begin
+     S := FirstDir;
+     isFirst := False;
+   end else S := MiddleDir;
+   AList^.Insert(NewDirEntry(Indent + S + SR.Name, Dirct + SR.Name));
+      end;
+      FindNext(SR);
+    end;
+ {$ifdef fpc}
+  FindClose(SR);
+ {$endif}
+    P := PDirEntry(AList^.At(AList^.Count-1))^.DisplayText;
+    I := Pos('À',P^);
+    if I = 0 then
+    begin
+      I := Pos('Ã',P^);
+      if I <> 0 then P^[I] := 'À';
+    end else
+    begin
+      P^[I+1] := 'Ä';
+      P^[I+2] := 'Ä';
+    end;
+  end;
+  NewList(AList);
+  FocusItem(Cur);
+end;
+
+procedure TDirListBox.SetState(AState: Word; Enable: Boolean);
+begin
+  TListBox.SetState(AState, Enable);
+  if AState and sfFocused <> 0 then
+    PChDirDialog(Owner)^.ChDirButton^.MakeDefault(Enable);
+end;
+
+{****************************************************************************}
+{ TChDirDialog Object                     }
+{****************************************************************************}
+{****************************************************************************}
+{ TChDirDialog.Init                      }
+{****************************************************************************}
+constructor TChDirDialog.Init(AOptions: Word; HistoryId: Sw_Word);
+var
+  R: TRect;
+  Control: PView;
+begin
+  R.Assign(16, 2, 64, 20);
+  TDialog.Init(R,strings^.get(sChangeDirectory));
+
+  Options := Options or ofCentered;
+
+  R.Assign(3, 3, 30, 4);
+  DirInput := New(PInputLine, Init(R, 68));
+  Insert(DirInput);
+  R.Assign(2, 2, 17, 3);
+  Control := New(PLabel, Init(R,labels^.get(slDirectoryName), DirInput));
+  Insert(Control);
+  R.Assign(30, 3, 33, 4);
+  Control := New(PHistory, Init(R, DirInput, HistoryId));
+  Insert(Control);
+
+  R.Assign(32, 6, 33, 16);
+  Control := New(PScrollBar, Init(R));
+  Insert(Control);
+  R.Assign(3, 6, 32, 16);
+  DirList := New(PDirListBox, Init(R, PScrollBar(Control)));
+  Insert(DirList);
+  R.Assign(2, 5, 17, 6);
+  Control := New(PLabel, Init(R, labels^.get(slDirectoryTree), DirList));
+  Insert(Control);
+
+  R.Assign(35, 6, 45, 8);
+  OkButton := New(PButton, Init(R, labels^.get(slOk), cmOK, bfDefault));
+  Insert(OkButton);
+  Inc(R.A.Y,3); Inc(R.B.Y,3);
+  ChDirButton := New(PButton,Init(R,labels^.get(slChDir),cmChangeDir,
+           bfNormal));
+  Insert(ChDirButton);
+  Inc(R.A.Y,3); Inc(R.B.Y,3);
+  Insert(New(PButton, Init(R,labels^.get(slRevert), cmRevert, bfNormal)));
+  if AOptions and cdHelpButton <> 0 then
+  begin
+    Inc(R.A.Y,3); Inc(R.B.Y,3);
+    Insert(New(PButton, Init(R,labels^.get(slHelp), cmHelp, bfNormal)));
+  end;
+
+  if AOptions and cdNoLoadDir = 0 then SetUpDialog;
+
+  SelectNext(False);
+end;
+
+{****************************************************************************}
+{ TChDirDialog.Load                      }
+{****************************************************************************}
+constructor TChDirDialog.Load(var S: TStream);
+begin
+  TDialog.Load(S);
+  GetSubViewPtr(S, DirList);
+  GetSubViewPtr(S, DirInput);
+  GetSubViewPtr(S, OkButton);
+  GetSubViewPtr(S, ChDirbutton);
+  SetUpDialog;
+end;
+
+{****************************************************************************}
+{ TChDirDialog.DataSize                      }
+{****************************************************************************}
+function TChDirDialog.DataSize: Sw_Word;
+begin
+  DataSize := 0;
+end;
+
+{****************************************************************************}
+{ TChDirDialog.GetData                        }
+{****************************************************************************}
+procedure TChDirDialog.GetData(var Rec);
+begin
+end;
+
+{****************************************************************************}
+{ TChDirDialog.HandleEvent                   }
+{****************************************************************************}
+procedure TChDirDialog.HandleEvent(var Event: TEvent);
+var
+  CurDir: DirStr;
+  P: PDirEntry;
+begin
+  TDialog.HandleEvent(Event);
+  case Event.What of
+    evCommand:
+      begin
+   case Event.Command of
+     cmRevert: GetDir(0,CurDir);
+     cmChangeDir:
+       begin
+         P := DirList^.List^.At(DirList^.Focused);
+         if (P^.Directory^ = Drives^)
+            or DriveValid(P^.Directory^[1]) then
+           CurDir := P^.Directory^
+         else Exit;
+       end;
+   else
+     Exit;
+   end;
+   if (Length(CurDir) > 3) and
+      (CurDir[Length(CurDir)] = DirSeparator) then
+     CurDir := Copy(CurDir,1,Length(CurDir)-1);
+   DirList^.NewDirectory(CurDir);
+   DirInput^.Data^ := CurDir;
+   DirInput^.DrawView;
+   DirList^.Select;
+   ClearEvent(Event);
+      end;
+  end;
+end;
+
+{****************************************************************************}
+{ TChDirDialog.SetData                        }
+{****************************************************************************}
+procedure TChDirDialog.SetData(var Rec);
+begin
+end;
+
+{****************************************************************************}
+{ TChDirDialog.SetUpDialog                   }
+{****************************************************************************}
+procedure TChDirDialog.SetUpDialog;
+var
+  CurDir: DirStr;
+begin
+  if DirList <> nil then
+  begin
+    CurDir := GetCurDir;
+    DirList^.NewDirectory(CurDir);
+    if (Length(CurDir) > 3) and (CurDir[Length(CurDir)] = DirSeparator) then
+      CurDir := Copy(CurDir,1,Length(CurDir)-1);
+    if DirInput <> nil then
+    begin
+      DirInput^.Data^ := CurDir;
+      DirInput^.DrawView;
+    end;
+  end;
+end;
+
+{****************************************************************************}
+{ TChDirDialog.Store                    }
+{****************************************************************************}
+procedure TChDirDialog.Store(var S: TStream);
+begin
+  TDialog.Store(S);
+  PutSubViewPtr(S, DirList);
+  PutSubViewPtr(S, DirInput);
+  PutSubViewPtr(S, OkButton);
+  PutSubViewPtr(S, ChDirButton);
+end;
+
+{****************************************************************************}
+{ TChDirDialog.Valid                    }
+{****************************************************************************}
+function TChDirDialog.Valid(Command: Word): Boolean;
+var
+  P: PathStr;
+begin
+  Valid := True;
+  if Command = cmOk then
+  begin
+    P := FExpand(DirInput^.Data^);
+    if (Length(P) > 3) and (P[Length(P)] = DirSeparator) then
+      Dec(P[0]);
+    {$I-}
+    ChDir(P);
+    if (IOResult <> 0) then
+    begin
+      MessageBox(Strings^.Get(sInvalidDirectory), nil, mfError + mfOkButton);
+      Valid := False;
+    end;
+    {$I+}
+  end;
+end;
+
+{****************************************************************************}
+{ TEditChDirDialog Object                     }
+{****************************************************************************}
+{****************************************************************************}
+{ TEditChDirDialog.DataSize                    }
+{****************************************************************************}
+function TEditChDirDialog.DataSize : Sw_Word;
+begin
+  DataSize := SizeOf(DirStr);
+end;
+
+{****************************************************************************}
+{ TEditChDirDialog.GetData                   }
+{****************************************************************************}
+procedure TEditChDirDialog.GetData (var Rec);
+var
+  CurDir : DirStr absolute Rec;
+begin
+  if (DirInput = nil) then
+    CurDir := ''
+  else begin
+    CurDir := DirInput^.Data^;
+    if (CurDir[Length(CurDir)] <> DirSeparator) then
+      CurDir := CurDir + DirSeparator;
+  end;
+end;
+
+{****************************************************************************}
+{ TEditChDirDialog.SetData                   }
+{****************************************************************************}
+procedure TEditChDirDialog.SetData (var Rec);
+var
+  CurDir : DirStr absolute Rec;
+begin
+  if DirList <> nil then
+  begin
+    DirList^.NewDirectory(CurDir);
+    if DirInput <> nil then
+    begin
+      if (Length(CurDir) > 3) and (CurDir[Length(CurDir)] = DirSeparator) then
+   DirInput^.Data^ := Copy(CurDir,1,Length(CurDir)-1)
+      else DirInput^.Data^ := CurDir;
+      DirInput^.DrawView;
+    end;
+  end;
+end;
+
+{****************************************************************************}
+{ TSortedListBox Object                      }
+{****************************************************************************}
+{****************************************************************************}
+{ TSortedListBox.Init                     }
+{****************************************************************************}
+constructor TSortedListBox.Init(var Bounds: TRect; ANumCols: Sw_Word;
+  AScrollBar: PScrollBar);
+begin
+  TListBox.Init(Bounds, ANumCols, AScrollBar);
+  SearchPos := 0;
+  ShowCursor;
+  SetCursor(1,0);
+end;
+
+{****************************************************************************}
+{ TSortedListBox.HandleEvent                  }
+{****************************************************************************}
+procedure TSortedListBox.HandleEvent(var Event: TEvent);
+const
+  SpecialChars: set of Char = [#0,#9,#27];
+var
+  CurString, NewString: String;
+  K: Pointer;
+  Value : Sw_integer;
+  OldPos, OldValue: Sw_Integer;
+  T: Boolean;
+begin
+  OldValue := Focused;
+  TListBox.HandleEvent(Event);
+  if (OldValue <> Focused) or
+     ((Event.What = evBroadcast) and (Event.InfoPtr = @Self) and
+      (Event.Command = cmReleasedFocus)) then
+    SearchPos := 0;
+  if Event.What = evKeyDown then
+  begin
+    { patched to prevent error when no or empty list or Escape pressed }
+    if (not (Event.CharCode in SpecialChars)) and
+       (List <> nil) and (List^.Count > 0) then
+    begin
+      Value := Focused;
+      if Value < Range then CurString := GetText(Value, 255)
+      else CurString := '';
+      OldPos := SearchPos;
+      if Event.KeyCode = kbBack then
+      begin
+   if SearchPos = 0 then Exit;
+   Dec(SearchPos);
+   if SearchPos = 0 then ShiftState := GetShiftState;
+   CurString[0] := Char(SearchPos);
+      end
+      else if (Event.CharCode = '.') then SearchPos := Pos('.',CurString)
+      else
+      begin
+   Inc(SearchPos);
+   if SearchPos = 1 then ShiftState := GetShiftState;
+   CurString[0] := Char(SearchPos);
+   CurString[SearchPos] := Event.CharCode;
+      end;
+      K := GetKey(CurString);
+      T := PSortedCollection(List)^.Search(K, Value);
+      if Value < Range then
+      begin
+   if Value < Range then NewString := GetText(Value, 255)
+   else NewString := '';
+   if Equal(NewString, CurString, SearchPos) then
+   begin
+     if Value <> OldValue then
+     begin
+       FocusItem(Value);
+       { Assumes ListControl will set the cursor to the first character }
+       { of the sfFocused item }
+       SetCursor(Cursor.X+SearchPos, Cursor.Y);
+     end
+     else SetCursor(Cursor.X+(SearchPos-OldPos), Cursor.Y);
+   end
+   else SearchPos := OldPos;
+      end
+      else SearchPos := OldPos;
+      if (SearchPos <> OldPos) or (Event.CharCode in ['A'..'Z','a'..'z']) then
+   ClearEvent(Event);
+    end
+  end;
+end;
+
+function TSortedListBox.GetKey(var S: String): Pointer;
+begin
+  GetKey := @S;
+end;
+
+procedure TSortedListBox.NewList(AList: PCollection);
+begin
+  TListBox.NewList(AList);
+  SearchPos := 0;
+end;
+
+{****************************************************************************}
+{            Global Procedures and Functions          }
+{****************************************************************************}
+
+{****************************************************************************}
+{ Contains                          }
+{****************************************************************************}
+function Contains(S1, S2: String): Boolean;
+  { Contains returns true if S1 contains any characters in S2. }
+var
+  i : Byte;
+begin
+  Contains := True;
+  i := 1;
+  while ((i < Length(S2)) and (i < Length(S1))) do
+    if (Upcase(S1[i]) = Upcase(S2[i])) then
+      Exit
+    else Inc(i);
+  Contains := False;
+end;
+
+{****************************************************************************}
+{ StdDeleteFile                           }
+{****************************************************************************}
+function StdDeleteFile (AFile : FNameStr) : Boolean;
+var
+  Rec : PStringRec;
+begin
+  if CheckOnDelete then
+  begin
+    AFile := ShrinkPath(AFile,33);
+    Rec.AString := PString(@AFile);
+    StdDeleteFile := (MessageBox(^C + Strings^.Get(sDeleteFile),
+               @Rec,mfConfirmation or mfOkCancel) = cmOk);
+  end
+  else StdDeleteFile := False;
+end;
+
+{****************************************************************************}
+{ DriveValid                         }
+{****************************************************************************}
+function DriveValid(Drive: Char): Boolean;
+{$ifdef HAS_DOS_DRIVES}
+var
+  D: Char;
+begin
+  D := GetCurDrive;
+  {$I-}
+  ChDir(Drive+':');
+  if (IOResult = 0) then
+  begin
+    DriveValid := True;
+    ChDir(D+':')
+  end
+  else DriveValid := False;
+  {$I+}
+end;
+{$else HAS_DOS_DRIVES}
+begin
+  DriveValid:=true;
+end;
+{$endif HAS_DOS_DRIVES}
+
+{****************************************************************************}
+{ Equal                             }
+{****************************************************************************}
+function Equal(const S1, S2: String; Count: Sw_word): Boolean;
+var
+  i: Sw_Word;
+begin
+  Equal := False;
+  if (Length(S1) < Count) or (Length(S2) < Count) then
+    Exit;
+  for i := 1 to Count do
+    if UpCase(S1[I]) <> UpCase(S2[I]) then
+      Exit;
+  Equal := True;
+end;
+
+{****************************************************************************}
+{ ExtractDir                         }
+{****************************************************************************}
+function ExtractDir(AFile: FNameStr): DirStr;
+  { ExtractDir returns the path of AFile terminated with a trailing '\'.  If
+    AFile contains no directory information, an empty string is returned. }
+var
+  D: DirStr;
+  N: NameStr;
+  E: ExtStr;
+begin
+  FSplit(AFile,D,N,E);
+  if D = '' then
+  begin
+    ExtractDir := '';
+    Exit;
+  end;
+  if D[Byte(D[0])] <> DirSeparator then
+    D := D + DirSeparator;
+  ExtractDir := D;
+end;
+
+{****************************************************************************}
+{ ExtractFileName                       }
+{****************************************************************************}
+function ExtractFileName(AFile: FNameStr): NameStr;
+var
+  D: DirStr;
+  N: NameStr;
+  E: ExtStr;
+begin
+  FSplit(AFile,D,N,E);
+  ExtractFileName := N;
+end;
+
+{****************************************************************************}
+{ FileExists                         }
+{****************************************************************************}
+function FileExists (AFile : FNameStr) : Boolean;
+begin
+  FileExists := (FSearch(AFile,'') <> '');
+end;
+
+{****************************************************************************}
+{ GetCurDir                        }
+{****************************************************************************}
+function GetCurDir: DirStr;
+var
+  CurDir: DirStr;
+begin
+  GetDir(0, CurDir);
+  if (Length(CurDir) > 3) then
+  begin
+    Inc(CurDir[0]);
+    CurDir[Length(CurDir)] := DirSeparator;
+  end;
+  GetCurDir := CurDir;
+end;
+
+{****************************************************************************}
+{ GetCurDrive                       }
+{****************************************************************************}
+function GetCurDrive: Char;
+{$ifdef go32v2}
+var
+  Regs : Registers;
+begin
+  Regs.AH := $19;
+  Intr($21,Regs);
+  GetCurDrive := Char(Regs.AL + Byte('A'));
+end;
+{$else not go32v2}
+var
+  D : DirStr;
+begin
+  D:=GetCurDir;
+  if (Length(D)>1) and (D[2]=':') then
+    begin
+      if (D[1]>='a') and (D[1]<='z') then
+        GetCurDrive:=Char(Byte(D[1])+Byte('A')-Byte('a'))
+      else
+        GetCurDrive:=D[1];
+    end
+  else
+    GetCurDrive:='C';
+end;
+{$endif not go32v2}
+
+{****************************************************************************}
+{ IsDir                             }
+{****************************************************************************}
+function IsDir(const S: String): Boolean;
+var
+  SR: SearchRec;
+  Is: boolean;
+begin
+  Is:=false;
+{$ifdef Linux}
+  Is:=(S=DirSeparator); { handle root }
+{$else}
+  Is:=(length(S)=3) and (Upcase(S[1]) in['A'..'Z']) and (S[2]=':') and (S[3]=DirSeparator);
+  { handle root dirs }
+{$endif}
+  if Is=false then
+  begin
+    FindFirst(S, Directory, SR);
+    if DosError = 0 then
+      Is := (SR.Attr and Directory) <> 0
+    else
+      Is := False;
+   {$ifdef fpc}
+    FindClose(SR);
+   {$endif}
+  end;
+  IsDir:=Is;
+end;
+
+{****************************************************************************}
+{ IsWild                           }
+{****************************************************************************}
+function IsWild(const S: String): Boolean;
+begin
+  IsWild := (Pos('?',S) > 0) or (Pos('*',S) > 0);
+end;
+
+{****************************************************************************}
+{ IsList                           }
+{****************************************************************************}
+function IsList(const S: String): Boolean;
+begin
+  IsList := (Pos(ListSeparator,S) > 0);
+end;
+
+{****************************************************************************}
+{ MakeResources                           }
+{****************************************************************************}
+procedure MakeResources;
+var
+  Dlg : PDialog;
+  Key : String;
+  i : Word;
+begin
+  for i := 0 to 1 do
+  begin
+    case i of
+      0 : begin
+       Key := reOpenDlg;
+       Dlg := New(PFileDialog,Init('*.*',strings^.get(sOpen),
+             labels^.get(slName),
+             fdOkButton or fdHelpButton or fdNoLoadDir,0));
+     end;
+      1 : begin
+       Key := reSaveAsDlg;
+       Dlg := New(PFileDialog,Init('*.*',strings^.get(sSaveAs),
+             labels^.get(slName),
+             fdOkButton or fdHelpButton or fdNoLoadDir,0));
+     end;
+      2 : begin
+       Key := reEditChDirDialog;
+       Dlg := New(PEditChDirDialog,Init(cdHelpButton,
+             hiCurrentDirectories));
+     end;
+    end;
+    if Dlg = nil then
+    begin
+       PrintStr('Error initializing dialog ' + Key);
+       Halt;
+    end
+    else begin
+      RezFile^.Put(Dlg,Key);
+      if (RezFile^.Stream^.Status <> stOk) then
+      begin
+   PrintStr('Error writing dialog ' + Key + ' to the resource file.');
+   Halt;
+      end;
+    end;
+  end;
+end;
+
+{****************************************************************************}
+{ NoWildChars                       }
+{****************************************************************************}
+function NoWildChars(S: String): String;
+const
+  WildChars : array[0..1] of Char = ('?','*');
+var
+  i : Sw_Word;
+begin
+  repeat
+    i := Pos('?',S);
+    if (i > 0) then
+      System.Delete(S,i,1);
+  until (i = 0);
+  repeat
+    i := Pos('*',S);
+    if (i > 0) then
+      System.Delete(S,i,1);
+  until (i = 0);
+  NoWildChars:=S;
+end;
+
+{****************************************************************************}
+{ OpenFile                          }
+{****************************************************************************}
+function OpenFile (var AFile : FNameStr; HistoryID : Byte) : Boolean;
+var
+  Dlg : PFileDialog;
+begin
+  {$ifdef cdResource}
+  Dlg := PFileDialog(RezFile^.Get(reOpenDlg));
+  {$else}
+  Dlg := New(PFileDialog,Init('*.*',strings^.get(sOpen),labels^.get(slName),
+        fdOkButton or fdHelpButton,0));
+  {$endif cdResource}
+    { this might not work }
+  PHistory(Dlg^.FileName^.Next^.Next)^.HistoryID := HistoryID;
+  OpenFile := (Application^.ExecuteDialog(Dlg,@AFile) = cmFileOpen);
+end;
+
+{****************************************************************************}
+{ OpenNewFile                       }
+{****************************************************************************}
+function OpenNewFile (var AFile: FNameStr; HistoryID: Byte): Boolean;
+  { OpenNewFile allows the user to select a directory from disk and enter a
+    new file name.  If the file name entered is an existing file the user is
+    optionally prompted for confirmation of replacing the file based on the
+    value in #CheckOnReplace#.  If a file name is successfully entered,
+    OpenNewFile returns True. }
+  {#X OpenFile }
+begin
+  OpenNewFile := False;
+  if OpenFile(AFile,HistoryID) then
+  begin
+    if not ValidFileName(AFile) then
+      Exit;
+    if FileExists(AFile) then
+      if (not CheckOnReplace) or (not ReplaceFile(AFile)) then
+   Exit;
+    OpenNewFile := True;
+  end;
+end;
+
+{****************************************************************************}
+{ PathValid                        }
+{****************************************************************************}
+{$ifdef go32v2}
+{$define NetDrive}
+{$endif go32v2}
+{$ifdef win32}
+{$define NetDrive}
+{$endif win32}
+function PathValid (var Path: PathStr): Boolean;
+var
+  ExpPath: PathStr;
+  SR: SearchRec;
+begin
+  ExpPath := FExpand(Path);
+{$ifdef HAS_DOS_DRIVES}
+  if (Length(ExpPath) <= 3) then
+    PathValid := DriveValid(ExpPath[1])
+  else
+{$endif}
+  begin
+    { do not change '/' into '' }
+    if (Length(ExpPath)>1) and (ExpPath[Length(ExpPath)] = DirSeparator) then
+      Dec(ExpPath[0]);
+    FindFirst(ExpPath, Directory, SR);
+    PathValid := (DosError = 0) and (SR.Attr and Directory <> 0);
+{$ifdef NetDrive}
+    if DosError=66 then
+      begin
+      {$ifdef fpc}
+        FindClose(SR);
+      {$endif}
+        FindFirst(ExpPath+'\*',AnyFile,SR);
+        PathValid:=(DosError = 0);
+      end;
+{$endif NetDrive}
+    {$ifdef fpc}
+    FindClose(SR);
+   {$endif}
+  end;
+end;
+
+{****************************************************************************}
+{ RegisterStdDlg                         }
+{****************************************************************************}
+procedure RegisterStdDlg;
+begin
+  RegisterType(RFileInputLine);
+  RegisterType(RFileCollection);
+  RegisterType(RFileList);
+  RegisterType(RFileInfoPane);
+  RegisterType(RFileDialog);
+  RegisterType(RDirCollection);
+  RegisterType(RDirListBox);
+  RegisterType(RSortedListBox);
+  RegisterType(RChDirDialog);
+end;
+
+{****************************************************************************}
+{ StdReplaceFile                         }
+{****************************************************************************}
+function StdReplaceFile (AFile : FNameStr) : Boolean;
+var
+  Rec : PStringRec;
+begin
+  if CheckOnReplace then
+  begin
+    AFile := ShrinkPath(AFile,33);
+    Rec.AString := PString(@AFile);
+    StdReplaceFile :=
+       (MessageBox(^C + Strings^.Get(sReplaceFile),
+         @Rec,mfConfirmation or mfOkCancel) = cmOk);
+  end
+  else StdReplaceFile := True;
+end;
+
+{****************************************************************************}
+{ SaveAs                           }
+{****************************************************************************}
+function SaveAs (var AFile : FNameStr; HistoryID : Word) : Boolean;
+var
+  Dlg : PFileDialog;
+begin
+  SaveAs := False;
+  {$ifdef cdResource}
+  Dlg := PFileDialog(RezFile^.Get(reSaveAsDlg));
+  {$else}
+  Dlg := New(PFileDialog,Init('*.*',strings^.get(sSaveAs),
+        labels^.get(slSaveAs),
+        fdOkButton or fdHelpButton,0));
+  {$endif cdResource}
+    { this might not work }
+  PHistory(Dlg^.FileName^.Next^.Next)^.HistoryID := HistoryID;
+  Dlg^.HelpCtx := hcSaveAs;
+  if (Application^.ExecuteDialog(Dlg,@AFile) = cmFileOpen) and
+     ((not FileExists(AFile)) or ReplaceFile(AFile)) then
+    SaveAs := True;
+end;
+
+{****************************************************************************}
+{ SelectDir                        }
+{****************************************************************************}
+function SelectDir (var ADir : DirStr; HistoryID : Byte) : Boolean;
+var
+  Dir: DirStr;
+  Dlg : PEditChDirDialog;
+  Rec : DirStr;
+begin
+  {$I-}
+  GetDir(0,Dir);
+  {$I+}
+  Rec := FExpand(ADir);
+  {$ifdef cdResource}
+  Dlg := PEditChDirDialog(RezFile^.Get(reEditChDirDialog));
+  {$else}
+  Dlg := New(PEditChDirDialog,Init(cdHelpButton,HistoryID));
+  {$endif cdResource}
+  if (Application^.ExecuteDialog(Dlg,@Rec) = cmOk) then
+  begin
+    SelectDir := True;
+    ADir := Rec;
+  end
+  else SelectDir := False;
+  {$I-}
+  ChDir(Dir);
+  {$I+}
+end;
+
+{****************************************************************************}
+{ ShrinkPath                         }
+{****************************************************************************}
+function ShrinkPath (AFile : FNameStr; MaxLen : Byte) : FNameStr;
+var
+  Filler: string;
+  D1 : DirStr;
+  N1 : NameStr;
+  E1 : ExtStr;
+  i  : Sw_Word;
+
+begin
+  if Length(AFile) > MaxLen then
+  begin
+    FSplit(FExpand(AFile),D1,N1,E1);
+    AFile := Copy(D1,1,3) + '..' + DirSeparator;
+    i := Pred(Length(D1));
+    while (i > 0) and (D1[i] <> DirSeparator) do
+      Dec(i);
+    if (i = 0) then
+      AFile := AFile + D1
+    else AFile := AFile + Copy(D1,Succ(i),Length(D1)-i);
+    if AFile[Length(AFile)] <> DirSeparator then
+      AFile := AFile + DirSeparator;
+    if Length(AFile)+Length(N1)+Length(E1) <= MaxLen then
+      AFile := AFile + N1 + E1
+    else
+      begin
+        Filler := '...' + DirSeparator;
+        AFile:=Copy(Afile,1,MaxLen-Length(Filler)-Length(N1)-Length(E1))
+                +Filler+N1+E1;
+      end;
+  end;
+  ShrinkPath := AFile;
+end;
+
+{****************************************************************************}
+{ ValidFileName                           }
+{****************************************************************************}
+function ValidFileName(var FileName: PathStr): Boolean;
+var
+  IllegalChars: string[12];
+  Dir: DirStr;
+  Name: NameStr;
+  Ext: ExtStr;
+begin
+{$ifdef PPC_FPC}
+{$ifdef go32v2}
+  { spaces are allowed if LFN is supported }
+  if LFNSupport then
+    IllegalChars := ';,=+<>|"[]'+DirSeparator
+  else
+    IllegalChars := ';,=+<>|"[] '+DirSeparator;
+{$else not go32v2}
+{$ifdef win32}
+    IllegalChars := ';,=+<>|"[]'+DirSeparator;
+{$else not go32v2 and not win32 }
+    IllegalChars := ';,=+<>|"[] '+DirSeparator;
+{$endif not win32}
+{$endif not go32v2}
+{$else not PPC_FPC}
+  IllegalChars := ';,=+<>|"[] '+DirSeparator;
+{$endif PPC_FPC}
+  ValidFileName := True;
+  FSplit(FileName, Dir, Name, Ext);
+  if not ((Dir = '') or PathValid(Dir)) or
+     Contains(Name, IllegalChars) or
+     Contains(Dir, IllegalChars) then
+    ValidFileName := False;
+end;
+
+{****************************************************************************}
+{        Unit Initialization Section                                         }
+{****************************************************************************}
+begin
+{$ifdef PPC_BP}
+  ReplaceFile := StdReplaceFile;
+  DeleteFile := StdDeleteFile;
+{$else}
+  ReplaceFile := @StdReplaceFile;
+  DeleteFile := @StdDeleteFile;
+{$endif PPC_BP}
+end.

+ 530 - 0
fv/tabs.pas

@@ -0,0 +1,530 @@
+unit tabs;
+interface
+
+uses
+  objects,drivers,views;
+
+type
+    PTabItem = ^TTabItem;
+    TTabItem = record
+      Next : PTabItem;
+      View : PView;
+      Dis  : boolean;
+    end;
+
+    PTabDef = ^TTabDef;
+    TTabDef = record
+      Next     : PTabDef;
+      Name     : PString;
+      Items    : PTabItem;
+      DefItem  : PView;
+      ShortCut : char;
+    end;
+
+    PTab = ^TTab;
+    TTab = object(TGroup)
+      TabDefs   : PTabDef;
+      ActiveDef : integer;
+      DefCount  : word;
+      constructor Init(var Bounds: TRect; ATabDef: PTabDef);
+      function    AtTab(Index: integer): PTabDef; virtual;
+      procedure   SelectTab(Index: integer); virtual;
+      function    TabCount: integer;
+      function    Valid(Command: Word): Boolean; virtual;
+      procedure   ChangeBounds(var Bounds: TRect); virtual;
+      procedure   HandleEvent(var Event: TEvent); virtual;
+      function    GetPalette: PPalette; virtual;
+      procedure   Draw; virtual;
+      procedure   SetData(var Rec);virtual;
+      procedure   GetData(var Rec);virtual;
+      procedure   SetState(AState: Word; Enable: Boolean); virtual;
+      destructor  Done; virtual;
+    private
+      InDraw: boolean;
+    end;
+
+function  NewTabItem(AView: PView; ANext: PTabItem): PTabItem;
+procedure DisposeTabItem(P: PTabItem);
+function  NewTabDef(AName: string; ADefItem: PView; AItems: PTabItem; ANext: PTabDef): PTabDef;
+procedure DisposeTabDef(P: PTabDef);
+
+
+implementation
+
+uses
+  FvCommon,dialogs;
+
+constructor TTab.Init(var Bounds: TRect; ATabDef: PTabDef);
+begin
+  inherited Init(Bounds);
+  Options:=Options or ofSelectable or ofFirstClick or ofPreProcess or ofPostProcess;
+  GrowMode:=gfGrowHiX+gfGrowHiY+gfGrowRel;
+  TabDefs:=ATabDef;
+  ActiveDef:=-1;
+  SelectTab(0);
+  ReDraw;
+end;
+
+function TTab.TabCount: integer;
+var i: integer;
+    P: PTabDef;
+begin
+  I:=0; P:=TabDefs;
+  while (P<>nil) do
+    begin
+      Inc(I);
+      P:=P^.Next;
+    end;
+  TabCount:=I;
+end;
+
+
+function TTab.AtTab(Index: integer): PTabDef;
+var i: integer;
+    P: PTabDef;
+begin
+  i:=0; P:=TabDefs;
+  while (I<Index) do
+    begin
+      if P=nil then RunError($AA);
+      P:=P^.Next;
+      Inc(i);
+    end;
+  AtTab:=P;
+end;
+
+procedure TTab.SelectTab(Index: integer);
+var P: PTabItem;
+    V: PView;
+begin
+  if ActiveDef<>Index then
+  begin
+    if Owner<>nil then Owner^.Lock;
+    Lock;
+    { --- Update --- }
+    if TabDefs<>nil then
+       begin
+         DefCount:=1;
+         while AtTab(DefCount-1)^.Next<>nil do Inc(DefCount);
+       end
+       else DefCount:=0;
+    if ActiveDef<>-1 then
+    begin
+      P:=AtTab(ActiveDef)^.Items;
+      while P<>nil do
+        begin
+          if P^.View<>nil then Delete(P^.View);
+          P:=P^.Next;
+        end;
+    end;
+    ActiveDef:=Index;
+    P:=AtTab(ActiveDef)^.Items;
+    while P<>nil do
+      begin
+        if P^.View<>nil then Insert(P^.View);
+        P:=P^.Next;
+      end;
+    V:=AtTab(ActiveDef)^.DefItem;
+    if V<>nil then V^.Select;
+    ReDraw;
+    { --- Update --- }
+    UnLock;
+    if Owner<>nil then Owner^.UnLock;
+    DrawView;
+  end;
+end;
+
+procedure TTab.ChangeBounds(var Bounds: TRect);
+var D: TPoint;
+procedure DoCalcChange(P: PView); {$ifndef FPC}far;{$endif}
+var
+  R: TRect;
+begin
+  if P^.Owner=nil then Exit; { it think this is a bug in TV }
+  P^.CalcBounds(R, D);
+  P^.ChangeBounds(R);
+end;
+var
+    P: PTabItem;
+    I: integer;
+begin
+  D.X := Bounds.B.X - Bounds.A.X - Size.X;
+  D.Y := Bounds.B.Y - Bounds.A.Y - Size.Y;
+  inherited ChangeBounds(Bounds);
+  for I:=0 to TabCount-1 do
+  if I<>ActiveDef then
+    begin
+      P:=AtTab(I)^.Items;
+      while P<>nil do
+        begin
+          if P^.View<>nil then DoCalcChange(P^.View);
+          P:=P^.Next;
+        end;
+    end;
+end;
+
+procedure TTab.HandleEvent(var Event: TEvent);
+var Index : integer;
+    I     : integer;
+    X     : integer;
+    Len   : byte;
+    P     : TPoint;
+    V     : PView;
+    CallOrig: boolean;
+    LastV : PView;
+    FirstV: PView;
+function FirstSelectable: PView;
+var
+    FV : PView;
+begin
+  FV := First;
+  while (FV<>nil) and ((FV^.Options and ofSelectable)=0) and (FV<>Last) do
+        FV:=FV^.Next;
+  if FV<>nil then
+    if (FV^.Options and ofSelectable)=0 then FV:=nil;
+  FirstSelectable:=FV;
+end;
+function LastSelectable: PView;
+var
+    LV : PView;
+begin
+  LV := Last;
+  while (LV<>nil) and ((LV^.Options and ofSelectable)=0) and (LV<>First) do
+        LV:=LV^.Prev;
+  if LV<>nil then
+    if (LV^.Options and ofSelectable)=0 then LV:=nil;
+  LastSelectable:=LV;
+end;
+begin
+  if (Event.What and evMouseDown)<>0 then
+     begin
+       MakeLocal(Event.Where,P);
+       if P.Y<3 then
+          begin
+            Index:=-1; X:=1;
+            for i:=0 to DefCount-1 do
+                begin
+                  Len:=CStrLen(AtTab(i)^.Name^);
+                  if (P.X>=X) and (P.X<=X+Len+1) then Index:=i;
+                  X:=X+Len+3;
+                end;
+            if Index<>-1 then
+               SelectTab(Index);
+          end;
+     end;
+  if Event.What=evKeyDown then
+     begin
+       Index:=-1;
+       case Event.KeyCode of
+            kbTab,kbShiftTab  :
+              if GetState(sfSelected) then
+                 begin
+                   if Current<>nil then
+                   begin
+                   LastV:=LastSelectable; FirstV:=FirstSelectable;
+                   if ((Current=LastV) or (Current=PLabel(LastV)^.Link)) and (Event.KeyCode=kbShiftTab) then
+                      begin
+                        if Owner<>nil then Owner^.SelectNext(true);
+                      end else
+                   if ((Current=FirstV) or (Current=PLabel(FirstV)^.Link)) and (Event.KeyCode=kbTab) then
+                      begin
+                        Lock;
+                        if Owner<>nil then Owner^.SelectNext(false);
+                        UnLock;
+                      end else
+                   SelectNext(Event.KeyCode=kbShiftTab);
+                   ClearEvent(Event);
+                   end;
+                 end;
+       else
+       for I:=0 to DefCount-1 do
+           begin
+             if Upcase(GetAltChar(Event.KeyCode))=AtTab(I)^.ShortCut
+                then begin
+                       Index:=I;
+                       ClearEvent(Event);
+                       Break;
+                     end;
+           end;
+       end;
+       if Index<>-1 then
+          begin
+            Select;
+            SelectTab(Index);
+            V:=AtTab(ActiveDef)^.DefItem;
+            if V<>nil then V^.Focus;
+          end;
+     end;
+  CallOrig:=true;
+  if Event.What=evKeyDown then
+     begin
+     if ((Owner<>nil) and (Owner^.Phase=phPostProcess) and (GetAltChar(Event.KeyCode)<>#0)) or GetState(sfFocused)
+        then
+        else CallOrig:=false;
+     end;
+  if CallOrig then inherited HandleEvent(Event);
+end;
+
+function TTab.GetPalette: PPalette;
+begin
+  GetPalette:=nil;
+end;
+
+procedure TTab.Draw;
+var B     : TDrawBuffer;
+    i     : integer;
+    C1,C2,C3,C : word;
+    HeaderLen  : integer;
+    X,X2       : integer;
+    Name       : PString;
+    ActiveKPos : integer;
+    ActiveVPos : integer;
+    FC   : char;
+procedure SWriteBuf(X,Y,W,H: integer; var Buf);
+var i: integer;
+begin
+  if Y+H>Size.Y then H:=Size.Y-Y;
+  if X+W>Size.X then W:=Size.X-X;
+  if Buffer=nil then WriteBuf(X,Y,W,H,Buf)
+                else for i:=1 to H do
+                         Move(Buf,Buffer^[X+(Y+i-1)*Size.X],W*2);
+end;
+procedure ClearBuf;
+begin
+  MoveChar(B,' ',C1,Size.X);
+end;
+begin
+  if InDraw then Exit;
+  InDraw:=true;
+  { - Start of TGroup.Draw - }
+{  if Buffer = nil then
+  begin
+    GetBuffer;
+  end; }
+  { - Start of TGroup.Draw - }
+
+  C1:=GetColor(1);
+  C2:=(GetColor(7) and $f0 or $08)+GetColor(9)*256;
+  C3:=GetColor(8)+GetColor({9}8)*256;
+
+  { Calculate the size of the headers }
+  HeaderLen:=0;
+  for i:=0 to DefCount-1 do
+    HeaderLen:=HeaderLen+CStrLen(AtTab(i)^.Name^)+3;
+  Dec(HeaderLen);
+  if HeaderLen>Size.X-2 then HeaderLen:=Size.X-2;
+
+  { --- 1. sor --- }
+  ClearBuf; MoveChar(B[0],'³',C1,1); MoveChar(B[HeaderLen+1],'³',C1,1);
+  X:=1;
+  for i:=0 to DefCount-1 do
+      begin
+        Name:=AtTab(i)^.Name; X2:=CStrLen(Name^);
+        if i=ActiveDef
+           then begin
+                  ActiveKPos:=X-1;
+                  ActiveVPos:=X+X2+2;
+                  if GetState(sfFocused) then C:=C3 else C:=C2;
+                end
+           else C:=C2;
+        MoveCStr(B[X],' '+Name^+' ',C); X:=X+X2+3;
+        MoveChar(B[X-1],'³',C1,1);
+      end;
+  SWriteBuf(0,1,Size.X,1,B);
+
+  { --- 0. sor --- }
+  ClearBuf; MoveChar(B[0],'Ú',C1,1);
+  X:=1;
+  for i:=0 to DefCount-1 do
+      begin
+        if I<ActiveDef then FC:='Ú'
+                       else FC:='¿';
+        X2:=CStrLen(AtTab(i)^.Name^)+2;
+        MoveChar(B[X+X2],{'Â'}FC,C1,1);
+        if i=DefCount-1 then X2:=X2+1;
+        if X2>0 then
+        MoveChar(B[X],'Ä',C1,X2);
+        X:=X+X2+1;
+      end;
+  MoveChar(B[HeaderLen+1],'¿',C1,1);
+  MoveChar(B[ActiveKPos],'Ú',C1,1); MoveChar(B[ActiveVPos],'¿',C1,1);
+  SWriteBuf(0,0,Size.X,1,B);
+
+  { --- 2. sor --- }
+  MoveChar(B[1],'Ä',C1,Max(HeaderLen,0)); MoveChar(B[HeaderLen+2],'Ä',C1,Max(Size.X-HeaderLen-3,0));
+  MoveChar(B[Size.X-1],'¿',C1,1);
+  MoveChar(B[ActiveKPos],'Ù',C1,1);
+  if ActiveDef=0 then MoveChar(B[0],'³',C1,1)
+                 else MoveChar(B[0],{'Ã'}'Ú',C1,1);
+  MoveChar(B[HeaderLen+1],'Ä'{'Á'},C1,1); MoveChar(B[ActiveVPos],'À',C1,1);
+  MoveChar(B[ActiveKPos+1],' ',C1,Max(ActiveVPos-ActiveKPos-1,0));
+  SWriteBuf(0,2,Size.X,1,B);
+
+  { --- marad‚k sor --- }
+  ClearBuf; MoveChar(B[0],'³',C1,1); MoveChar(B[Size.X-1],'³',C1,1);
+  SWriteBuf(0,3,Size.X,Size.Y-4,B);
+
+  { --- Size.X . sor --- }
+  MoveChar(B[0],'À',C1,1); MoveChar(B[1],'Ä',C1,Max(Size.X-2,0)); MoveChar(B[Size.X-1],'Ù',C1,1);
+  SWriteBuf(0,Size.Y-1,Size.X,1,B);
+
+  { - End of TGroup.Draw - }
+  if Buffer <> nil then
+  begin
+    Lock;
+    Redraw;
+    UnLock;
+  end;
+  if Buffer <> nil then
+    WriteBuf(0, 0, Size.X, Size.Y, Buffer^)
+  else
+    Redraw;
+  { - End of TGroup.Draw - }
+  InDraw:=false;
+end;
+
+function TTab.Valid(Command: Word): Boolean;
+var PT : PTabDef;
+    PI : PTabItem;
+    OK : boolean;
+begin
+  OK:=true;
+  PT:=TabDefs;
+  while (PT<>nil) and (OK=true) do
+        begin
+          PI:=PT^.Items;
+          while (PI<>nil) and (OK=true) do
+                begin
+                  if PI^.View<>nil then OK:=OK and PI^.View^.Valid(Command);
+                  PI:=PI^.Next;
+                end;
+          PT:=PT^.Next;
+        end;
+  Valid:=OK;
+end;
+
+
+procedure TTab.SetData(var Rec);
+type
+  Bytes = array[0..65534] of Byte;
+var
+  I: Sw_Word;
+  PT : PTabDef;
+  PI : PTabItem;
+begin
+  I := 0;
+  PT:=TabDefs;
+  while (PT<>nil) do
+   begin
+     PI:=PT^.Items;
+     while (PI<>nil) do
+      begin
+        if PI^.View<>nil then
+         begin
+           PI^.View^.SetData(Bytes(Rec)[I]);
+           Inc(I, PI^.View^.DataSize);
+         end;
+        PI:=PI^.Next;
+      end;
+     PT:=PT^.Next;
+   end;
+end;
+
+
+procedure TTab.GetData(var Rec);
+type
+  Bytes = array[0..65534] of Byte;
+var
+  I: Sw_Word;
+  PT : PTabDef;
+  PI : PTabItem;
+begin
+  I := 0;
+  PT:=TabDefs;
+  while (PT<>nil) do
+   begin
+     PI:=PT^.Items;
+     while (PI<>nil) do
+      begin
+        if PI^.View<>nil then
+         begin
+           PI^.View^.GetData(Bytes(Rec)[I]);
+           Inc(I, PI^.View^.DataSize);
+         end;
+        PI:=PI^.Next;
+      end;
+     PT:=PT^.Next;
+   end;
+end;
+
+
+procedure TTab.SetState(AState: Word; Enable: Boolean);
+begin
+  inherited SetState(AState,Enable);
+  if (AState and sfFocused)<>0 then DrawView;
+end;
+
+destructor TTab.Done;
+var P,X: PTabDef;
+procedure DeleteViews(P: PView); {$ifndef FPC}far;{$endif}
+begin
+  if P<>nil then Delete(P);
+end;
+begin
+  ForEach(@DeleteViews);
+  inherited Done;
+  P:=TabDefs;
+  while P<>nil do
+        begin
+          X:=P^.Next;
+          DisposeTabDef(P);
+          P:=X;
+        end;
+end;
+
+
+function NewTabItem(AView: PView; ANext: PTabItem): PTabItem;
+var P: PTabItem;
+begin
+  New(P); FillChar(P^,SizeOf(P^),0);
+  P^.Next:=ANext; P^.View:=AView;
+  NewTabItem:=P;
+end;
+
+procedure DisposeTabItem(P: PTabItem);
+begin
+  if P<>nil then
+  begin
+    if P^.View<>nil then Dispose(P^.View, Done);
+    Dispose(P);
+  end;
+end;
+
+function NewTabDef(AName: string; ADefItem: PView; AItems: PTabItem; ANext: PTabDef): PTabDef;
+var P: PTabDef;
+    x: byte;
+begin
+  New(P);
+  P^.Next:=ANext; P^.Name:=NewStr(AName); P^.Items:=AItems;
+  x:=pos('~',AName);
+  if (x<>0) and (x<length(AName)) then P^.ShortCut:=Upcase(AName[x+1])
+                                  else P^.ShortCut:=#0;
+  P^.DefItem:=ADefItem;
+  NewTabDef:=P;
+end;
+
+procedure DisposeTabDef(P: PTabDef);
+var PI,X: PTabItem;
+begin
+  DisposeStr(P^.Name);
+  PI:=P^.Items;
+  while PI<>nil do
+    begin
+      X:=PI^.Next;
+      DisposeTabItem(PI);
+      PI:=X;
+    end;
+  Dispose(P);
+end;
+
+end.

+ 955 - 0
fv/test/Makefile

@@ -0,0 +1,955 @@
+#
+# Don't edit, this file is generated by FPCMake Version 1.1 [2001/08/02]
+#
+default: all
+override PATH:=$(subst \,/,$(PATH))
+ifeq ($(findstring ;,$(PATH)),)
+inUnix=1
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+SEARCHPATH:=$(subst ;, ,$(PATH))
+endif
+PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH))))
+ifeq ($(PWD),)
+PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH))))
+ifeq ($(PWD),)
+nopwd:
+	@echo You need the GNU utils package to use this Makefile!
+	@echo Get ftp://ftp.freepascal.org/pub/fpc/dist/go32v2/utilgo32.zip
+	@exit
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=
+endif
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=.exe
+endif
+ifndef inUnix
+ifeq ($(OS),Windows_NT)
+inWinNT=1
+else
+ifdef OS2_SHELL
+inOS2=1
+endif
+endif
+else
+ifneq ($(findstring cygwin,$(MACHTYPE)),)
+inCygWin=1
+endif
+endif
+ifdef inUnix
+BATCHEXT=.sh
+else
+ifdef inOS2
+BATCHEXT=.cmd
+else
+BATCHEXT=.bat
+endif
+endif
+ifdef inUnix
+PATHSEP=/
+else
+PATHSEP:=$(subst /,\,/)
+endif
+ifdef PWD
+BASEDIR:=$(subst \,/,$(shell $(PWD)))
+ifdef inCygWin
+ifneq ($(findstring /cygdrive/,$(BASEDIR)),)
+BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR))
+BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR)))
+BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR))
+endif
+endif
+else
+BASEDIR=.
+endif
+ifndef FPC
+ifdef PP
+FPC=$(PP)
+else
+ifdef inUnix
+CPU_SOURCE=$(shell uname -m)
+ifeq (m68k,$(CPU_SOURCE))
+FPC=ppc68k
+else
+FPC=ppc386
+endif
+else
+FPC=ppc386
+endif
+endif
+endif
+override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
+override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
+ifndef OS_TARGET
+OS_TARGET:=$(shell $(FPC) -iTO)
+endif
+ifndef OS_SOURCE
+OS_SOURCE:=$(shell $(FPC) -iSO)
+endif
+ifndef CPU_TARGET
+CPU_TARGET:=$(shell $(FPC) -iTP)
+endif
+ifndef CPU_SOURCE
+CPU_SOURCE:=$(shell $(FPC) -iSP)
+endif
+ifndef FPC_VERSION
+FPC_VERSION:=$(shell $(FPC) -iV)
+endif
+export FPC OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FPC_VERSION
+ifdef FPCDIR
+override FPCDIR:=$(subst \,/,$(FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+else
+override FPCDIR=wrong
+endif
+ifeq ($(FPCDIR),wrong)
+override FPCDIR=../..
+ifeq ($(wildcard $(FPCDIR)/rtl),)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=wrong
+endif
+endif
+endif
+ifeq ($(FPCDIR),wrong)
+ifdef inUnix
+override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=/usr/lib/fpc/$(FPC_VERSION)
+endif
+else
+override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))))
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=c:/pp
+endif
+endif
+endif
+endif
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
+PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages)
+override TARGET_PROGRAMS+=tfileio testapp
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO=
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+ifndef DATE
+DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE=
+else
+DATE:=$(firstword $(DATE))
+endif
+else
+DATE:=$(firstword $(DATE))
+endif
+endif
+export DATE
+ifndef GINSTALL
+GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL=
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+endif
+export GINSTALL
+ifndef CPPROG
+CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(CPPROG),)
+CPPROG=
+else
+CPPROG:=$(firstword $(CPPROG))
+endif
+endif
+export CPPROG
+ifndef RMPROG
+RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(RMPROG),)
+RMPROG=
+else
+RMPROG:=$(firstword $(RMPROG))
+endif
+endif
+export RMPROG
+ifndef MVPROG
+MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MVPROG),)
+MVPROG=
+else
+MVPROG:=$(firstword $(MVPROG))
+endif
+endif
+export MVPROG
+ifndef ECHOREDIR
+ECHOREDIR:=$(subst /,$(PATHSEP),$(ECHO))
+endif
+ifndef COPY
+COPY:=$(CPPROG) -fp
+endif
+ifndef COPYTREE
+COPYTREE:=$(CPPROG) -rfp
+endif
+ifndef MOVE
+MOVE:=$(MVPROG) -f
+endif
+ifndef DEL
+DEL:=$(RMPROG) -f
+endif
+ifndef DELTREE
+DELTREE:=$(RMPROG) -rf
+endif
+ifndef INSTALL
+ifdef inUnix
+INSTALL:=$(GINSTALL) -c -m 644
+else
+INSTALL:=$(COPY)
+endif
+endif
+ifndef INSTALLEXE
+ifdef inUnix
+INSTALLEXE:=$(GINSTALL) -c -m 755
+else
+INSTALLEXE:=$(COPY)
+endif
+endif
+ifndef MKDIR
+MKDIR:=$(GINSTALL) -m 755 -d
+endif
+export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
+ifndef PPUMOVE
+PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(PPUMOVE),)
+PPUMOVE=
+else
+PPUMOVE:=$(firstword $(PPUMOVE))
+endif
+endif
+export PPUMOVE
+ifndef FPCMAKE
+FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(FPCMAKE),)
+FPCMAKE=
+else
+FPCMAKE:=$(firstword $(FPCMAKE))
+endif
+endif
+export FPCMAKE
+ifndef ZIPPROG
+ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ZIPPROG),)
+ZIPPROG=
+else
+ZIPPROG:=$(firstword $(ZIPPROG))
+endif
+endif
+export ZIPPROG
+ifndef TARPROG
+TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(TARPROG),)
+TARPROG=
+else
+TARPROG:=$(firstword $(TARPROG))
+endif
+endif
+export TARPROG
+ifndef AS
+AS=as
+endif
+ifndef LD
+LD=ld
+endif
+ifndef RC
+RC=rc
+endif
+PPAS=ppas$(BATCHEXT)
+ifdef inUnix
+LDCONFIG=ldconfig
+else
+LDCONFIG=
+endif
+ifdef DATE
+DATESTR:=$(shell $(DATE) +%Y%m%d)
+else
+DATESTR=
+endif
+ifndef UPXPROG
+ifeq ($(OS_TARGET),go32v2)
+UPXPROG:=1
+endif
+ifeq ($(OS_TARGET),win32)
+UPXPROG:=1
+endif
+ifdef UPXPROG
+UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(UPXPROG),)
+UPXPROG=
+else
+UPXPROG:=$(firstword $(UPXPROG))
+endif
+else
+UPXPROG=
+endif
+endif
+export UPXPROG
+ZIPOPT=-9
+ZIPEXT=.zip
+ifeq ($(USETAR),bz2)
+TAROPT=vI
+TAREXT=.tar.bz2
+else
+TAROPT=vz
+TAREXT=.tar.gz
+endif
+LOADEREXT=.as
+EXEEXT=.exe
+PPLEXT=.ppl
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.so
+STATICLIBPREFIX=libp
+RSTEXT=.rst
+FPCMADE=fpcmade
+ifeq ($(OS_TARGET),go32v1)
+PPUEXT=.pp1
+OEXT=.o1
+ASMEXT=.s1
+SMARTEXT=.sl1
+STATICLIBEXT=.a1
+SHAREDLIBEXT=.so1
+STATICLIBPREFIX=
+FPCMADE=fpcmade.v1
+PACKAGESUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+FPCMADE=fpcmade.dos
+ZIPSUFFIX=go32
+endif
+ifeq ($(OS_TARGET),linux)
+EXEEXT=
+HASSHAREDLIB=1
+FPCMADE=fpcmade.lnx
+ZIPSUFFIX=linux
+endif
+ifeq ($(OS_TARGET),freebsd)
+EXEEXT=
+HASSHAREDLIB=1
+FPCMADE=fpcmade.freebsd
+ZIPSUFFIX=freebsd
+endif
+ifeq ($(OS_TARGET),win32)
+PPUEXT=.ppw
+OEXT=.ow
+ASMEXT=.sw
+SMARTEXT=.slw
+STATICLIBEXT=.aw
+SHAREDLIBEXT=.dll
+FPCMADE=fpcmade.w32
+ZIPSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+PPUEXT=.ppo
+ASMEXT=.so2
+OEXT=.oo2
+AOUTEXT=.out
+SMARTEXT=.so
+STATICLIBEXT=.ao2
+SHAREDLIBEXT=.dll
+FPCMADE=fpcmade.os2
+ZIPSUFFIX=emx
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+PPUEXT=.ppa
+ASMEXT=.asm
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.library
+FPCMADE=fpcmade.amg
+endif
+ifeq ($(OS_TARGET),atari)
+PPUEXT=.ppt
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=.ttp
+FPCMADE=fpcmade.ata
+endif
+ifdef REQUIRE_UNITSDIR
+override UNITSDIR+=$(REQUIRE_UNITSDIR)
+endif
+ifdef REQUIRE_PACKAGESDIR
+override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR)
+endif
+ifdef ZIPINSTALL
+ifeq ($(OS_TARGET),linux)
+UNIXINSTALLDIR=1
+endif
+ifeq ($(OS_TARGET),freebsd)
+UNIXINSTALLDIR=1
+endif
+else
+ifeq ($(OS_SOURCE),linux)
+UNIXINSTALLDIR=1
+endif
+ifeq ($(OS_SOURCE),freebsd)
+UNIXINSTALLDIR=1
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef UNIXINSTALLDIR
+INSTALL_PREFIX=/usr/local
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=/pp
+else
+INSTALL_BASEDIR:=/$(PACKAGE_NAME)
+endif
+endif
+endif
+export INSTALL_PREFIX
+ifndef DIST_DESTDIR
+DIST_DESTDIR:=$(BASEDIR)
+endif
+export DIST_DESTDIR
+ifndef INSTALL_BASEDIR
+ifdef UNIXINSTALLDIR
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION)
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/$(PACKAGE_NAME)
+endif
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)
+endif
+endif
+ifndef INSTALL_BINDIR
+ifdef UNIXINSTALLDIR
+INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin
+else
+INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(OS_TARGET)
+endif
+endif
+endif
+ifndef INSTALL_UNITDIR
+INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(OS_TARGET)
+ifdef INSTALL_FPCPACKAGE
+ifdef PACKAGE_NAME
+INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME)
+endif
+endif
+endif
+ifndef INSTALL_LIBDIR
+ifdef UNIXINSTALLDIR
+INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib
+else
+INSTALL_LIBDIR:=$(INSTALL_UNITDIR)
+endif
+endif
+ifndef INSTALL_SOURCEDIR
+ifdef UNIXINSTALLDIR
+ifdef INSTALL_FPCPACKAGE
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/src/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/src/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIRL:=$(INSTALL_BASEDIR)/source
+endif
+endif
+endif
+ifndef INSTALL_DOCDIR
+ifdef UNIXINSTALLDIR
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc
+endif
+endif
+endif
+ifndef INSTALL_EXAMPLEDIR
+ifdef UNIXINSTALLDIR
+ifdef INSTALL_FPCPACKAGE
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples
+endif
+endif
+endif
+ifndef INSTALL_DATADIR
+INSTALL_DATADIR=$(INSTALL_BASEDIR)
+endif
+ifeq ($(OS_TARGET),linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_FV=1
+endif
+ifeq ($(OS_TARGET),go32v2)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_FV=1
+endif
+ifeq ($(OS_TARGET),win32)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_FV=1
+endif
+ifeq ($(OS_TARGET),os2)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_FV=1
+endif
+ifeq ($(OS_TARGET),freebsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_FV=1
+endif
+ifeq ($(OS_TARGET),beos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_FV=1
+endif
+ifeq ($(OS_TARGET),amiga)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_FV=1
+endif
+ifeq ($(OS_TARGET),atari)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_FV=1
+endif
+ifdef REQUIRE_PACKAGES_RTL
+PACKAGEDIR_RTL:=$(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR)))))
+ifneq ($(PACKAGEDIR_RTL),)
+PACKAGEDIR_RTL:=$(firstword $(PACKAGEDIR_RTL))
+ifeq ($(wildcard $(PACKAGEDIR_RTL)/$(FPCMADE)),)
+override COMPILEPACKAGES+=package_rtl
+package_rtl:
+	$(MAKE) -C $(PACKAGEDIR_RTL) all
+endif
+ifneq ($(wildcard $(PACKAGEDIR_RTL)/$(OS_TARGET)),)
+UNITDIR_RTL=$(PACKAGEDIR_RTL)/$(OS_TARGET)
+else
+UNITDIR_RTL=$(PACKAGEDIR_RTL)
+endif
+else
+PACKAGEDIR_RTL=
+UNITDIR_RTL:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /rtl/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_RTL),)
+UNITDIR_RTL:=$(firstword $(UNITDIR_RTL))
+else
+UNITDIR_RTL=
+endif
+endif
+ifdef UNITDIR_RTL
+override COMPILER_UNITDIR+=$(UNITDIR_RTL)
+endif
+endif
+ifdef REQUIRE_PACKAGES_FV
+PACKAGEDIR_FV:=$(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /fv/Makefile.fpc,$(PACKAGESDIR)))))
+ifneq ($(PACKAGEDIR_FV),)
+PACKAGEDIR_FV:=$(firstword $(PACKAGEDIR_FV))
+ifeq ($(wildcard $(PACKAGEDIR_FV)/$(FPCMADE)),)
+override COMPILEPACKAGES+=package_fv
+package_fv:
+	$(MAKE) -C $(PACKAGEDIR_FV) all
+endif
+ifneq ($(wildcard $(PACKAGEDIR_FV)/$(OS_TARGET)),)
+UNITDIR_FV=$(PACKAGEDIR_FV)/$(OS_TARGET)
+else
+UNITDIR_FV=$(PACKAGEDIR_FV)
+endif
+else
+PACKAGEDIR_FV=
+UNITDIR_FV:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /fv/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_FV),)
+UNITDIR_FV:=$(firstword $(UNITDIR_FV))
+else
+UNITDIR_FV=
+endif
+endif
+ifdef UNITDIR_FV
+override COMPILER_UNITDIR+=$(UNITDIR_FV)
+endif
+endif
+.PHONY: package_rtl package_fv
+override FPCOPTDEF=$(CPU_TARGET)
+ifneq ($(OS_TARGET),$(OS_SOURCE))
+override FPCOPT+=-T$(OS_TARGET)
+endif
+ifdef UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
+endif
+ifdef LIBDIR
+override FPCOPT+=$(addprefix -Fl,$(LIBDIR))
+endif
+ifdef OBJDIR
+override FPCOPT+=$(addprefix -Fo,$(OBJDIR))
+endif
+ifdef INCDIR
+override FPCOPT+=$(addprefix -Fi,$(INCDIR))
+endif
+ifdef LINKSMART
+override FPCOPT+=-XX
+endif
+ifdef CREATESMART
+override FPCOPT+=-CX
+endif
+ifdef DEBUG
+override FPCOPT+=-gl
+override FPCOPTDEF+=DEBUG
+endif
+ifdef RELEASE
+override FPCOPT+=-Xs -OG2p3 -n
+override FPCOPTDEF+=RELEASE
+endif
+ifdef STRIP
+override FPCOPT+=-Xs
+endif
+ifdef OPTIMIZE
+override FPCOPT+=-OG2p3
+endif
+ifdef VERBOSE
+override FPCOPT+=-vwni
+endif
+ifdef COMPILER_OPTIONS
+override FPCOPT+=$(COMPILER_OPTIONS)
+endif
+ifdef COMPILER_UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR))
+endif
+ifdef COMPILER_LIBRARYDIR
+override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR))
+endif
+ifdef COMPILER_OBJECTDIR
+override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR))
+endif
+ifdef COMPILER_INCLUDEDIR
+override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR))
+endif
+ifdef COMPILER_TARGETDIR
+override FPCOPT+=-FE$(COMPILER_TARGETDIR)
+ifeq ($(COMPILER_TARGETDIR),.)
+override TARGETDIRPREFIX=
+else
+override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
+endif
+endif
+ifdef COMPILER_UNITTARGETDIR
+override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR)
+ifeq ($(COMPILER_UNITTARGETDIR),.)
+override UNITTARGETDIRPREFIX=
+else
+override UNITTARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
+endif
+else
+ifdef COMPILER_TARGETDIR
+override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR)
+override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)
+endif
+endif
+ifdef OPT
+override FPCOPT+=$(OPT)
+endif
+ifdef FPCOPTDEF
+override FPCOPT+=$(addprefix -d,$(FPCOPTDEF))
+endif
+ifdef CFGFILE
+override FPCOPT+=@$(CFGFILE)
+endif
+ifdef USEENV
+override FPCEXTCMD:=$(FPCOPT)
+override FPCOPT:=!FPCEXTCMD
+export FPCEXTCMD
+endif
+override COMPILER:=$(FPC) $(FPCOPT)
+ifeq (,$(findstring -s ,$(COMPILER)))
+EXECPPAS=
+else
+ifeq ($(OS_SOURCE),$(OS_TARGET))
+EXECPPAS:=@$(PPAS)
+endif
+endif
+.PHONY: fpc_exes
+ifdef TARGET_PROGRAMS
+override EXEFILES=$(addsuffix $(EXEEXT),$(TARGET_PROGRAMS))
+override EXEOFILES:=$(addsuffix $(OEXT),$(TARGET_PROGRAMS)) $(addprefix $(STATICLIBPREFIX),$(addsuffix $(STATICLIBEXT),$(TARGET_PROGRAMS)))
+override ALLTARGET+=fpc_exes
+override INSTALLEXEFILES+=$(EXEFILES)
+override CLEANEXEFILES+=$(EXEFILES) $(EXEOFILES)
+ifeq ($(OS_TARGET),os2)
+override CLEANEXEFILES+=$(addsuffix $(AOUTEXT),$(TARGET_PROGRAMS))
+endif
+endif
+fpc_exes: $(EXEFILES)
+ifdef TARGET_RSTS
+override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS))
+override CLEANRSTFILES+=$(RSTFILES)
+endif
+.PHONY: fpc_packages fpc_all fpc_smart fpc_debug
+$(FPCMADE): $(ALLTARGET)
+	@$(ECHOREDIR) Compiled > $(FPCMADE)
+fpc_packages: $(COMPILEPACKAGES)
+fpc_all: fpc_packages $(FPCMADE)
+fpc_smart:
+	$(MAKE) all LINKSMART=1 CREATESMART=1
+fpc_debug:
+	$(MAKE) all DEBUG=1
+.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .pp
+%$(PPUEXT): %.pp
+	$(COMPILER) $<
+	$(EXECPPAS)
+%$(PPUEXT): %.pas
+	$(COMPILER) $<
+	$(EXECPPAS)
+%$(EXEEXT): %.pp
+	$(COMPILER) $<
+	$(EXECPPAS)
+%$(EXEEXT): %.pas
+	$(COMPILER) $<
+	$(EXECPPAS)
+vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR)
+.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall
+ifdef INSTALL_UNITS
+override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS))
+endif
+ifdef INSTALLPPUFILES
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(INSTALLPPUFILES))
+override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(INSTALLPPULINKFILES)))
+override INSTALL_CREATEPACKAGEFPC=1
+endif
+ifdef INSTALLEXEFILES
+override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(INSTALLEXEFILES))
+endif
+fpc_install: $(INSTALLTARGET)
+ifdef INSTALLEXEFILES
+	$(MKDIR) $(INSTALL_BINDIR)
+ifdef UPXPROG
+	-$(UPXPROG) $(INSTALLEXEFILES)
+endif
+	$(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR)
+endif
+ifdef INSTALL_CREATEPACKAGEFPC
+ifdef FPCMAKE
+ifdef PACKAGE_VERSION
+ifneq ($(wildcard Makefile.fpc),)
+	$(FPCMAKE) -p -T$(OS_TARGET) Makefile.fpc
+	$(MKDIR) $(INSTALL_UNITDIR)
+	$(INSTALL) Package.fpc $(INSTALL_UNITDIR)
+endif
+endif
+endif
+endif
+ifdef INSTALLPPUFILES
+	$(MKDIR) $(INSTALL_UNITDIR)
+	$(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR)
+ifneq ($(INSTALLPPULINKFILES),)
+	$(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR)
+endif
+ifneq ($(wildcard $(LIB_FULLNAME)),)
+	$(MKDIR) $(INSTALL_LIBDIR)
+	$(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR)
+ifdef inUnix
+	ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME)
+endif
+endif
+endif
+ifdef INSTALL_FILES
+	$(MKDIR) $(INSTALL_DATADIR)
+	$(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR)
+endif
+fpc_sourceinstall: distclean
+	$(MKDIR) $(INSTALL_SOURCEDIR)
+	$(COPYTREE) $(BASEDIR) $(INSTALL_SOURCEDIR)
+fpc_exampleinstall: $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS))
+ifdef HASEXAMPLES
+	$(MKDIR) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef EXAMPLESOURCEFILES
+	$(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef TARGET_EXAMPLEDIRS
+	$(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EXAMPLEDIR)
+endif
+.PHONY: fpc_clean fpc_cleanall fpc_distclean
+ifdef EXEFILES
+override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES))
+endif
+ifdef CLEAN_UNITS
+override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
+endif
+ifdef CLEANPPUFILES
+override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))
+override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES))
+override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES)))
+endif
+fpc_clean: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+	-$(DEL) $(CLEANEXEFILES)
+endif
+ifdef CLEANPPUFILES
+	-$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+	-$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+	-$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+ifdef CLEAN_FILES
+	-$(DEL) $(CLEAN_FILES)
+endif
+ifdef LIB_NAME
+	-$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
+endif
+	-$(DEL) $(FPCMADE) Package.fpc $(PPAS) link.res $(FPCEXTFILE) $(REDIRFILE)
+fpc_distclean: clean
+ifdef COMPILER_UNITTARGETDIR
+TARGETDIRCLEAN=fpc_clean
+endif
+fpc_cleanall: $(CLEANTARGET) $(TARGETDIRCLEAN)
+ifdef CLEANEXEFILES
+	-$(DEL) $(CLEANEXEFILES)
+endif
+	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
+	-$(DELTREE) *$(SMARTEXT)
+	-$(DEL) $(FPCMADE) $(PPAS) link.res $(FPCEXTFILE) $(REDIRFILE)
+ifdef AOUTEXT
+	-$(DEL) *$(AOUTEXT)
+endif
+.PHONY: fpc_info
+fpc_info:
+	@$(ECHO)
+	@$(ECHO)  == Package info ==
+	@$(ECHO)  Package Name..... $(PACKAGE_NAME)
+	@$(ECHO)  Package Version.. $(PACKAGE_VERSION)
+	@$(ECHO)
+	@$(ECHO)  == Configuration info ==
+	@$(ECHO)
+	@$(ECHO)  FPC.......... $(FPC)
+	@$(ECHO)  FPC Version.. $(FPC_VERSION)
+	@$(ECHO)  Source CPU... $(CPU_SOURCE)
+	@$(ECHO)  Target CPU... $(CPU_TARGET)
+	@$(ECHO)  Source OS.... $(OS_SOURCE)
+	@$(ECHO)  Target OS.... $(OS_TARGET)
+	@$(ECHO)
+	@$(ECHO)  == Directory info ==
+	@$(ECHO)
+	@$(ECHO)  Basedir......... $(BASEDIR)
+	@$(ECHO)  FPCDir.......... $(FPCDIR)
+	@$(ECHO)  UnitsDir........ $(UNITSDIR)
+	@$(ECHO)  PackagesDir..... $(PACKAGESDIR)
+	@$(ECHO)
+	@$(ECHO)  GCC library..... $(GCCLIBDIR)
+	@$(ECHO)  Other library... $(OTHERLIBDIR)
+	@$(ECHO)
+	@$(ECHO)  == Tools info ==
+	@$(ECHO)
+	@$(ECHO)  Pwd....... $(PWD)
+	@$(ECHO)  Mv........ $(MVPROG)
+	@$(ECHO)  Cp........ $(CPPROG)
+	@$(ECHO)  Rm........ $(RMPROG)
+	@$(ECHO)  GInstall.. $(GINSTALL)
+	@$(ECHO)  Echo...... $(ECHO)
+	@$(ECHO)  Date...... $(DATE)
+	@$(ECHO)  FPCMake... $(FPCMAKE)
+	@$(ECHO)  PPUMove... $(PPUMOVE)
+	@$(ECHO)  Upx....... $(UPXPROG)
+	@$(ECHO)  Zip....... $(ZIPPROG)
+	@$(ECHO)
+	@$(ECHO)  == Object info ==
+	@$(ECHO)
+	@$(ECHO)  Target Loaders...... $(TARGET_LOADERS)
+	@$(ECHO)  Target Units........ $(TARGET_UNITS)
+	@$(ECHO)  Target Programs..... $(TARGET_PROGRAMS)
+	@$(ECHO)  Target Dirs......... $(TARGET_DIRS)
+	@$(ECHO)  Target Examples..... $(TARGET_EXAMPLES)
+	@$(ECHO)  Target ExampleDirs.. $(TARGET_EXAMPLEDIRS)
+	@$(ECHO)
+	@$(ECHO)  Clean Units......... $(CLEAN_UNITS)
+	@$(ECHO)  Clean Files......... $(CLEAN_FILES)
+	@$(ECHO)
+	@$(ECHO)  Install Units....... $(INSTALL_UNITS)
+	@$(ECHO)  Install Files....... $(INSTALL_FILES)
+	@$(ECHO)
+	@$(ECHO)  == Install info ==
+	@$(ECHO)
+	@$(ECHO)  DateStr.............. $(DATESTR)
+	@$(ECHO)  ZipPrefix............ $(ZIPPREFIX)
+	@$(ECHO)  ZipSuffix............ $(ZIPSUFFIX)
+	@$(ECHO)  Install FPC Package.. $(INSTALL_FPCPACKAGE)
+	@$(ECHO)
+	@$(ECHO)  Install base dir..... $(INSTALL_BASEDIR)
+	@$(ECHO)  Install binary dir... $(INSTALL_BINDIR)
+	@$(ECHO)  Install library dir.. $(INSTALL_LIBDIR)
+	@$(ECHO)  Install units dir.... $(INSTALL_UNITDIR)
+	@$(ECHO)  Install source dir... $(INSTALL_SOURCEDIR)
+	@$(ECHO)  Install doc dir...... $(INSTALL_DOCDIR)
+	@$(ECHO)  Install example dir.. $(INSTALL_EXAMPLEDIR)
+	@$(ECHO)  Install data dir..... $(INSTALL_DATADIR)
+	@$(ECHO)
+	@$(ECHO)  Dist destination dir. $(DIST_DESTDIR)
+	@$(ECHO)  Dist zip name........ $(DIST_ZIPNAME)
+	@$(ECHO)
+all: fpc_all
+debug: fpc_debug
+smart: fpc_smart
+examples:
+shared:
+install: fpc_install
+sourceinstall: fpc_sourceinstall
+exampleinstall: fpc_exampleinstall
+distinstall:
+zipinstall:
+zipsourceinstall:
+zipexampleinstall:
+zipdistinstall:
+clean: fpc_clean
+distclean: fpc_distclean
+cleanall: fpc_cleanall
+info: fpc_info
+.PHONY: all debug smart examples shared install sourceinstall exampleinstall distinstall zipinstall zipsourceinstall zipexampleinstall zipdistinstall clean distclean cleanall info
+ifneq ($(wildcard fpcmake.loc),)
+include fpcmake.loc
+endif

+ 12 - 0
fv/test/Makefile.fpc

@@ -0,0 +1,12 @@
+#
+#   Makefile.fpc for Free Vision Test/Examples
+#
+
+[target]
+programs=tfileio testapp
+
+[require]
+packages=fv
+
+[default]
+fpcdir=../..

+ 390 - 0
fv/test/platform.inc

@@ -0,0 +1,390 @@
+{ $Id$ }
+{***************[ PLATFORM INCLUDE UNIT ]******************}
+{                                                          }
+{    System independent INCLUDE file to sort PLATFORMS     }
+{                                                          }
+{    Parts Copyright (c) 1997 by Balazs Scheidler          }
+{    [email protected]                                     }
+{                                                          }
+{    Parts Copyright (c) 1999, 2000 by Leon de Boer        }
+{    [email protected]  - primary e-mail address       }
+{    [email protected] - backup e-mail address     }
+{                                                          }
+{****************[ THIS CODE IS FREEWARE ]*****************}
+{                                                          }
+{     This sourcecode is released for the purpose to       }
+{   promote the pascal language on all platforms. You may  }
+{   redistribute it and/or modify with the following       }
+{   DISCLAIMER.                                            }
+{                                                          }
+{     This SOURCE CODE is distributed "AS IS" WITHOUT      }
+{   WARRANTIES AS TO PERFORMANCE OF MERCHANTABILITY OR     }
+{   ANY OTHER WARRANTIES WHETHER EXPRESSED OR IMPLIED.     }
+{                                                          }
+{*****************[ SUPPORTED PLATFORMS ]******************}
+{     16 and 32 Bit compilers                              }
+{        DOS      - Turbo Pascal 7.0 +      (16 Bit)       }
+{        DPMI     - Turbo Pascal 7.0 +      (16 Bit)       }
+{                 - FPC 0.9912+ (GO32V2)    (32 Bit)       }
+{        WINDOWS  - Turbo Pascal 7.0 +      (16 Bit)       }
+{                 - Delphi 1.0+             (16 Bit)       }
+{        WIN95/NT - Delphi 2.0+             (32 Bit)       }
+{                 - Virtual Pascal 2.0+     (32 Bit)       }
+{                 - Speedsoft Sybil 2.0+    (32 Bit)       }
+{                 - FPC 0.9912+             (32 Bit)       }
+{        OS2      - Virtual Pascal 1.0+     (32 Bit)       }
+{                 - C'T patch to BP         (16 Bit)       }
+{        LINUX    - FPC 0.9912+             (32 Bit)       }
+{                                                          }
+{******************[ REVISION HISTORY ]********************}
+{  Version  Date      Who    Fix                           }
+{  -------  --------  ---    ----------------------------  }
+{  0.1     02 Jul 97  Bazsi  Initial implementation        }
+{  0.2     28 Aug 97  LdB    Fixed OS2 platform sort       }
+{  0.3     29 Aug 97  LdB    Added assembler type changes  }
+{  0.4     29 Aug 97  LdB    OS_DOS removed from WINDOWS   }
+{  0.5     23 Oct 97  LdB    Delphi & speed compilers      }
+{  0.6     05 May 98  LdB    Virtual Pascal 2.0 added      }
+{  0.7     19 May 98  LdB    Delphi 2/3 definitions added  }
+{  0.8     06 Aug 98  CEC    FPC only support fixed WIN32  }
+{  0.9     10 Aug 98  LdB    BP_VMTLink def/Undef added    }
+{  1.0     27 Aug 98  LdB    Atari, Mac etc not undef dos  }
+{  1.1     25 Oct 98  PfV    Delphi 4 definitions added    }
+{  1.2     06 Jun 99  LdB    Sybil 2.0 support added       }
+{  1.3     13 Jun 99  LdB    Sybil 2.0 undef BP_VMT link   }
+{  1.31    03 Nov 99  LdB    FPC windows defines WIN32     }
+{  1.32    04 Nov 99  LdB    Delphi 5 definitions added    }
+{  1.33    16 Oct 00  LdB    WIN32/WIN16 defines added     }
+{**********************************************************}
+
+{ ****************************************************************************
+
+   This include file defines some conditional defines to allow us to select
+   the compiler/platform/target in a consequent way.
+
+    OS_XXXX         The operating system used (XXXX may be one of:
+                       DOS, OS2, Linux, Windows, Go32)
+    PPC_XXXX        The compiler used: BP, FPK, Virtual, Speed
+    BIT_XX          The number of bits of the target platform: 16 or 32
+    PROC_XXXX       The mode of the target processor (Real or Protected)
+                    This shouldn't be used, except for i386 specific parts.
+    ASM_XXXX        This is the assembler type: BP, ISO-ANSI, FPK
+
+ ****************************************************************************
+
+    This is how the IFDEF and UNDEF statements below should translate.
+
+
+ PLATFORM  SYSTEM    COMPILER  COMP ID      CPU MODE        BITS    ASSEMBLER
+ --------  ------    --------  -------      --------        ----    ---------
+
+ DOS      OS_DOS      BP/TP7   PPC_BP       PROC_Real       BIT_16  ASM_BP
+
+ DPMI     OS_DOS      BP/TP7   PPC_BP       PROC_Protected  BIT_16  ASM_BP
+                      FPC      PPC_FPC      PROC_Protected  BIT_32  ASM_FPC
+
+ LINUX    OS_LINUX    FPC      PPC_FPC      PROC_Protected  BIT_32  ASM_FPC
+
+ WINDOWS  OS_WINDOWS  BP/TP7   PPC_BP       PROC_Protected  BIT_16  ASM_BP
+                      DELPHI   PPC_DELPHI   PROC_Protected  BIT_16  ASM_BP
+                      DELPHI2  PPC_DELPHI2  PROC_Protected  BIT_16  ASM_BP
+
+ WIN95/NT OS_WINDOWS  DELPHI2  PPC_DELPHI2  PROC_Protected  BIT_32  ASM_BP
+                      DELPHI3  PPC_DELPHI3  PROC_Protected  BIT_32  ASM_BP
+                      DELPHI4  PPC_DELPHI3  PROC_Protected  BIT_32  ASM_BP
+                      DELPHI5  PPC_DELPHI3  PROC_Protected  BIT_32  ASM_BP
+                      VIRTUAL  PPC_VIRTUAL  PROC_Protected  BIT 32  ASM_BP
+                      SYBIL2   PPC_SPEED    PROC_Protected  BIT_32  ASM_BP
+                      FPC      PPC_FPC      PROC_Protected  BIT_32  ASM_FPC
+
+ OS2      OS_OS2      BPOS2    PPC_BPOS2    PROC_Protected  BIT_16  ASM_BP
+                      VIRTUAL  PPC_VIRTUAL  PROC_Protected  BIT_32  ASM_BP
+                      SPEED    PPC_SPEED    PROC_Protected  BIT_32  ASM_BP
+                      SYBIL2   PPC_SPEED    PROC_Protected  BIT_32  ASM_BP
+                      FPC      PPC_FPC      PROC_Protected  BIT_32  ASM_FPC
+ ****************************************************************************}
+{****************************************************************************
+
+FOR ALL COMPILERS BP_VMTLink defined but FPC and Delphi3/Delphi4 undefine it
+
+ ****************************************************************************}
+{****************************************************************************
+
+FOR FPC THESE ARE THE TRANSLATIONS
+
+  PLATFORM  SYSTEM    COMPILER  HANDLE SIZE      ASM          CPU
+ --------  ------    --------  -----------      ----         ---
+
+ DOS      OS_DOS,OS_GO32 FPC     32-bit         AT&T         CPU86
+
+ WIN32    OS_WINDOWS   FPC     32-bit           AT&T         ----
+
+ LINUX    OS_LINUX     FPC     32-bit           AT&T         ----
+
+ OS2      OS_OS2       FPC     ?????            AT&T         CPU86
+
+ ATARI    OS_ATARI     FPC     32-bit           Internal     CPU68
+
+ MACOS    OS_MAC       FPC     ?????            Internal     CPU68
+
+ AMIGA    OS_AMIGA     FPC     32-bit           Internal     CPU68
+
+ ****************************************************************************}
+
+{---------------------------------------------------------------------------}
+{  Initial assume BORLAND 16 BIT DOS COMPILER - Updated 27Aug98 LdB         }
+{---------------------------------------------------------------------------}
+{$DEFINE OS_DOS}
+{$DEFINE PROC_Real}
+{$DEFINE BIT_16}
+{$DEFINE PPC_BP}
+{$DEFINE ASM_BP}
+{$DEFINE BP_VMTLink}
+{$DEFINE CPU86}
+
+{---------------------------------------------------------------------------}
+{  BORLAND 16 BIT DPMI changes protected mode - Updated 27Aug98 LdB         }
+{---------------------------------------------------------------------------}
+{$IFDEF DPMI}
+  {$UNDEF PROC_Real}
+  {$DEFINE PROC_Protected}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  FPC 32 BIT COMPILER changes ASM, 32 bits etc - Updated 27Aug98 LdB       }
+{---------------------------------------------------------------------------}
+{$IFDEF FPC}
+  {$UNDEF PROC_Real}
+  {$DEFINE PROC_Protected}
+  {$UNDEF BIT_16}
+  {$DEFINE BIT_32}
+  {$UNDEF PPC_BP}
+  {$DEFINE PPC_FPC}
+  {$UNDEF ASM_BP}
+  {$DEFINE ASM_FPC}
+  {$UNDEF BP_VMTLink}
+  {$DEFINE Use_API}
+  {$DEFINE NO_WINDOW}
+{$ENDIF}
+
+{$IFDEF NoAPI}
+{$UNDEF Use_API}
+{$UNDEF NO_WINDOW}
+{$ENDIF UseAPI}
+
+
+{---------------------------------------------------------------------------}
+{  FPC LINUX COMPILER changes operating system - Updated 27Aug98 LdB        }
+{  Note: Other linux compilers would need to change other details           }
+{---------------------------------------------------------------------------}
+{$IFDEF LINUX}
+  {$UNDEF OS_DOS}
+  {$DEFINE OS_LINUX}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  FPC GO32V2 COMPILER changes operating system - Updated 27Aug98 LdB       }
+{---------------------------------------------------------------------------}
+{$IFDEF GO32V2}
+  {$DEFINE OS_GO32}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  32 BIT WINDOWS COMPILERS changes bit size - Updated 27Aug98 LdB          }
+{---------------------------------------------------------------------------}
+{$IFDEF WIN32}
+  {$IFNDEF WINDOWS}
+    {$DEFINE WINDOWS}
+  {$ENDIF}
+  {$UNDEF BIT_16}
+  {$DEFINE BIT_32}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  WINDOWS COMPILERS change op system and proc mode - Updated 03Nov99 LdB   }
+{---------------------------------------------------------------------------}
+{$IFDEF WINDOWS}
+  {$UNDEF OS_DOS}
+  {$DEFINE OS_WINDOWS}
+  {$UNDEF PROC_Real}
+  {$DEFINE PROC_Protected}
+  {$IFDEF FPC}
+    {$DEFINE WIN32}
+  {$ENDIF}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  DELPHI1 COMPILER changes compiler type - Updated 27Aug98 LdB             }
+{---------------------------------------------------------------------------}
+{$IFDEF VER80}
+  {$UNDEF PPC_BP}
+  {$DEFINE PPC_DELPHI}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  DELPHI2 COMPILER changes compiler type - Updated 27Aug98 LdB             }
+{---------------------------------------------------------------------------}
+{$IFDEF VER90}
+  {$UNDEF PPC_BP}
+  {$DEFINE PPC_DELPHI}
+  {$DEFINE PPC_DELPHI2}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  DELPHI3 COMPILER changes compiler type - Updated 27Aug98 LdB             }
+{---------------------------------------------------------------------------}
+{$IFDEF VER100}
+  {$UNDEF PPC_BP}
+  {$DEFINE PPC_DELPHI}
+  {$DEFINE PPC_DELPHI3}
+  {$UNDEF BP_VMTLink}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  DELPHI4 COMPILER changes compiler type - Updated 25Oct98 pfv             }
+{---------------------------------------------------------------------------}
+{$IFDEF VER120}
+  {$UNDEF PPC_BP}
+  {$DEFINE PPC_DELPHI}
+  {$DEFINE PPC_DELPHI3}
+  {$DEFINE PPC_DELPHI4}
+  {$UNDEF BP_VMTLink}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  DELPHI5 COMPILER changes compiler type - Updated 04Nov99 pfv             }
+{---------------------------------------------------------------------------}
+{$IFDEF VER130}
+  {$UNDEF PPC_BP}
+  {$DEFINE PPC_DELPHI}
+  {$DEFINE PPC_DELPHI3}
+  {$DEFINE PPC_DELPHI4}
+  {$DEFINE PPC_DELPHI5}
+  {$UNDEF BP_VMTLink}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  OS2 COMPILERS change compiler type and mode - Updated 27Aug98 LdB        }
+{  Note: Assumes BPOS2 16BIT OS2 patch except for FPC which undefines this  }
+{---------------------------------------------------------------------------}
+{$IFDEF OS2}
+  {$UNDEF OS_DOS}
+  {$DEFINE OS_OS2}
+  {$UNDEF PROC_Real}
+  {$DEFINE PROC_Protected}
+  {$UNDEF PPC_BP}
+  {$DEFINE PPC_BPOS2}
+  {$IFDEF FPC}
+    {$UNDEF PPC_BPOS2}
+  {$ENDIF}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  VIRTUAL PASCAL changes compiler type/32 bit - Updated 27Aug98 LdB        }
+{  Note: VP2 can compile win 32 code so changes op system as needed         }
+{---------------------------------------------------------------------------}
+{$IFDEF VirtualPascal}
+  {$UNDEF BIT_16}
+  {$DEFINE BIT_32}
+  {$IFDEF PPC_BPOS2}
+    {$UNDEF PPC_BPOS2}
+  {$ENDIF}
+  {$DEFINE PPC_VIRTUAL}
+  {$IFDEF WIN32}
+    {$UNDEF PPC_BP}
+    {$UNDEF OS_OS2}
+    {$DEFINE OS_WINDOWS}
+  {$ENDIF}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  SPEED COMPILER changes compiler type/32 bit  - Updated 27Aug98 LdB       }
+{---------------------------------------------------------------------------}
+{$IFDEF Speed}
+  {$UNDEF BIT_16}
+  {$DEFINE BIT_32}
+  {$UNDEF PPC_BPOS2}
+  {$DEFINE PPC_SPEED}
+  {$UNDEF BP_VMTLink}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  FPC AMIGA COMPILER changes op system and CPU type - Updated 27Aug98 LdB  }
+{---------------------------------------------------------------------------}
+{$IFDEF AMIGA}
+  {$UNDEF OS_DOS}
+  {$DEFINE OS_AMIGA}
+  {$IFDEF CPU86}
+    {$UNDEF CPU86}
+  {$ENDIF}
+  {$IFNDEF CPU68}
+    {$DEFINE CPU68}
+  {$ENDIF}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  FPC ATARI COMPILER changes op system and CPU type - Updated 27Aug98 LdB  }
+{---------------------------------------------------------------------------}
+{$IFDEF ATARI}
+  {$UNDEF OS_DOS}
+  {$DEFINE OS_ATARI}
+  {$IFDEF CPU86}
+    {$UNDEF CPU86}
+  {$ENDIF}
+  {$IFNDEF CPU68}
+    {$DEFINE CPU68}
+  {$ENDIF}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  FPC MAC COMPILER changes op system and CPU type - Updated 27Aug98 LdB    }
+{---------------------------------------------------------------------------}
+{$IFDEF MACOS}
+  {$UNDEF OS_DOS}
+  {$DEFINE OS_MAC}
+  {$IFDEF CPU86}
+    {$UNDEF CPU86}
+  {$ENDIF}
+  {$IFNDEF CPU68}
+    {$DEFINE CPU68}
+  {$ENDIF}
+{$ENDIF}
+
+{$IFDEF OS_DOS}
+  {$DEFINE NO_WINDOW}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  WIN16 AND WIN32 set if in windows - Updated 16Oct2000 LdB                }
+{---------------------------------------------------------------------------}
+{$IFDEF OS_WINDOWS}                                   { WINDOWS SYSTEM }
+  {$IFDEF BIT_16}
+    {$DEFINE WIN16}                                   { 16 BIT WINDOWS }
+  {$ENDIF}
+  {$IFDEF BIT_32}
+    {$DEFINE WIN32}                                   { 32 BIT WINDOWS }
+  {$ENDIF}
+{$ENDIF}
+
+
+{
+ $Log$
+ Revision 1.1  2001-08-04 19:14:34  peter
+   * Added Makefiles
+   * added FV specific units and objects from old FV
+
+ Revision 1.5  2001/05/03 22:32:52  pierre
+  new bunch of changes, displays something for dos at least
+
+ Revision 1.4  2001/04/10 21:57:56  pierre
+  + first adds for Use_API define
+
+ Revision 1.3  2001/04/10 21:29:55  pierre
+  * import of Leon de Boer's files
+
+ Revision 1.2  2000/08/24 12:00:22  marco
+  * CVS log and ID tags
+
+
+}
+

+ 6 - 2
fvision/testapp.pas → fv/test/testapp.pas

@@ -122,8 +122,8 @@ begin
      end
    else
       WasSet:=false;
-{$endif DEBUG}
    if WriteDebugInfo then
+{$endif DEBUG}
   Clock^.Update;
   Heap^.Update;
 {$ifdef DEBUG}
@@ -353,7 +353,11 @@ END.
 
 {
  $Log$
- Revision 1.6  2001-05-31 21:40:10  pierre
+ Revision 1.1  2001-08-04 19:14:34  peter
+   * Added Makefiles
+   * added FV specific units and objects from old FV
+
+ Revision 1.6  2001/05/31 21:40:10  pierre
   * some debug stuff changed
 
  Revision 1.5  2001/05/04 15:43:46  pierre

+ 2 - 2
fv/test/tfileio.pas

@@ -1,10 +1,10 @@
 USES
-  Common,FileIO;
+  FVCommon,FileIO;
 
 VAR
   Handle : THandle;
   buf    : ARRAY[0..255] OF CHAR;
-  n 	 : Longint;
+  n      : Longint;
 BEGIN
   Handle := FileOpen(AsciiZ('test'), fa_Create);
   writeln('FileOpen: ',Handle);

+ 6 - 2
fv/validate.pas

@@ -74,7 +74,7 @@ UNIT Validate;
 {$V-} { Turn off strict VAR strings }
 {====================================================================}
 
-USES Common, Objects;                                 { GFV standard units }
+USES FVCommon, Objects;                                 { GFV standard units }
 
 {***************************************************************************}
 {                              PUBLIC CONSTANTS                             }
@@ -1058,7 +1058,11 @@ END.
 
 {
  $Log$
- Revision 1.4  2001-05-03 22:32:52  pierre
+ Revision 1.5  2001-08-04 19:14:33  peter
+   * Added Makefiles
+   * added FV specific units and objects from old FV
+
+ Revision 1.4  2001/05/03 22:32:52  pierre
   new bunch of changes, displays something for dos at least
 
  Revision 1.3  2001/04/10 21:29:55  pierre

Diff do ficheiro suprimidas por serem muito extensas
+ 164 - 174
fv/views.pas


+ 1057 - 0
fvision/Makefile

@@ -0,0 +1,1057 @@
+#
+# Don't edit, this file is generated by FPCMake Version 1.1 [2001/08/02]
+#
+default: all
+override PATH:=$(subst \,/,$(PATH))
+ifeq ($(findstring ;,$(PATH)),)
+inUnix=1
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+SEARCHPATH:=$(subst ;, ,$(PATH))
+endif
+PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH))))
+ifeq ($(PWD),)
+PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH))))
+ifeq ($(PWD),)
+nopwd:
+	@echo You need the GNU utils package to use this Makefile!
+	@echo Get ftp://ftp.freepascal.org/pub/fpc/dist/go32v2/utilgo32.zip
+	@exit
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=
+endif
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=.exe
+endif
+ifndef inUnix
+ifeq ($(OS),Windows_NT)
+inWinNT=1
+else
+ifdef OS2_SHELL
+inOS2=1
+endif
+endif
+else
+ifneq ($(findstring cygwin,$(MACHTYPE)),)
+inCygWin=1
+endif
+endif
+ifdef inUnix
+BATCHEXT=.sh
+else
+ifdef inOS2
+BATCHEXT=.cmd
+else
+BATCHEXT=.bat
+endif
+endif
+ifdef inUnix
+PATHSEP=/
+else
+PATHSEP:=$(subst /,\,/)
+endif
+ifdef PWD
+BASEDIR:=$(subst \,/,$(shell $(PWD)))
+ifdef inCygWin
+ifneq ($(findstring /cygdrive/,$(BASEDIR)),)
+BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR))
+BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR)))
+BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR))
+endif
+endif
+else
+BASEDIR=.
+endif
+ifndef FPC
+ifdef PP
+FPC=$(PP)
+else
+ifdef inUnix
+CPU_SOURCE=$(shell uname -m)
+ifeq (m68k,$(CPU_SOURCE))
+FPC=ppc68k
+else
+FPC=ppc386
+endif
+else
+FPC=ppc386
+endif
+endif
+endif
+override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
+override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
+ifndef OS_TARGET
+OS_TARGET:=$(shell $(FPC) -iTO)
+endif
+ifndef OS_SOURCE
+OS_SOURCE:=$(shell $(FPC) -iSO)
+endif
+ifndef CPU_TARGET
+CPU_TARGET:=$(shell $(FPC) -iTP)
+endif
+ifndef CPU_SOURCE
+CPU_SOURCE:=$(shell $(FPC) -iSP)
+endif
+ifndef FPC_VERSION
+FPC_VERSION:=$(shell $(FPC) -iV)
+endif
+export FPC OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FPC_VERSION
+ifdef FPCDIR
+override FPCDIR:=$(subst \,/,$(FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+else
+override FPCDIR=wrong
+endif
+ifeq ($(FPCDIR),wrong)
+override FPCDIR=..
+ifeq ($(wildcard $(FPCDIR)/rtl),)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=wrong
+endif
+endif
+endif
+ifeq ($(FPCDIR),wrong)
+ifdef inUnix
+override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=/usr/lib/fpc/$(FPC_VERSION)
+endif
+else
+override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))))
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=c:/pp
+endif
+endif
+endif
+endif
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
+PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages)
+override PACKAGE_NAME=fv
+override PACKAGE_VERSION=1.0.5
+override TARGET_UNITS+=buildfv
+override TARGET_EXAMPLEDIRS+=test
+override CLEAN_UNITS+=$(subst $(PPUEXT),,$(wildcard *$(PPUEXT)))
+override INSTALL_UNITS+=$(subst $(PPUEXT),,$(wildcard *$(PPUEXT)))
+override INSTALL_FPCPACKAGE=y
+override COMPILER_TARGETDIR+=.
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO=
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+ifndef DATE
+DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE=
+else
+DATE:=$(firstword $(DATE))
+endif
+else
+DATE:=$(firstword $(DATE))
+endif
+endif
+export DATE
+ifndef GINSTALL
+GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL=
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+endif
+export GINSTALL
+ifndef CPPROG
+CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(CPPROG),)
+CPPROG=
+else
+CPPROG:=$(firstword $(CPPROG))
+endif
+endif
+export CPPROG
+ifndef RMPROG
+RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(RMPROG),)
+RMPROG=
+else
+RMPROG:=$(firstword $(RMPROG))
+endif
+endif
+export RMPROG
+ifndef MVPROG
+MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MVPROG),)
+MVPROG=
+else
+MVPROG:=$(firstword $(MVPROG))
+endif
+endif
+export MVPROG
+ifndef ECHOREDIR
+ECHOREDIR:=$(subst /,$(PATHSEP),$(ECHO))
+endif
+ifndef COPY
+COPY:=$(CPPROG) -fp
+endif
+ifndef COPYTREE
+COPYTREE:=$(CPPROG) -rfp
+endif
+ifndef MOVE
+MOVE:=$(MVPROG) -f
+endif
+ifndef DEL
+DEL:=$(RMPROG) -f
+endif
+ifndef DELTREE
+DELTREE:=$(RMPROG) -rf
+endif
+ifndef INSTALL
+ifdef inUnix
+INSTALL:=$(GINSTALL) -c -m 644
+else
+INSTALL:=$(COPY)
+endif
+endif
+ifndef INSTALLEXE
+ifdef inUnix
+INSTALLEXE:=$(GINSTALL) -c -m 755
+else
+INSTALLEXE:=$(COPY)
+endif
+endif
+ifndef MKDIR
+MKDIR:=$(GINSTALL) -m 755 -d
+endif
+export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
+ifndef PPUMOVE
+PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(PPUMOVE),)
+PPUMOVE=
+else
+PPUMOVE:=$(firstword $(PPUMOVE))
+endif
+endif
+export PPUMOVE
+ifndef FPCMAKE
+FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(FPCMAKE),)
+FPCMAKE=
+else
+FPCMAKE:=$(firstword $(FPCMAKE))
+endif
+endif
+export FPCMAKE
+ifndef ZIPPROG
+ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ZIPPROG),)
+ZIPPROG=
+else
+ZIPPROG:=$(firstword $(ZIPPROG))
+endif
+endif
+export ZIPPROG
+ifndef TARPROG
+TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(TARPROG),)
+TARPROG=
+else
+TARPROG:=$(firstword $(TARPROG))
+endif
+endif
+export TARPROG
+ifndef AS
+AS=as
+endif
+ifndef LD
+LD=ld
+endif
+ifndef RC
+RC=rc
+endif
+PPAS=ppas$(BATCHEXT)
+ifdef inUnix
+LDCONFIG=ldconfig
+else
+LDCONFIG=
+endif
+ifdef DATE
+DATESTR:=$(shell $(DATE) +%Y%m%d)
+else
+DATESTR=
+endif
+ifndef UPXPROG
+ifeq ($(OS_TARGET),go32v2)
+UPXPROG:=1
+endif
+ifeq ($(OS_TARGET),win32)
+UPXPROG:=1
+endif
+ifdef UPXPROG
+UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(UPXPROG),)
+UPXPROG=
+else
+UPXPROG:=$(firstword $(UPXPROG))
+endif
+else
+UPXPROG=
+endif
+endif
+export UPXPROG
+ZIPOPT=-9
+ZIPEXT=.zip
+ifeq ($(USETAR),bz2)
+TAROPT=vI
+TAREXT=.tar.bz2
+else
+TAROPT=vz
+TAREXT=.tar.gz
+endif
+LOADEREXT=.as
+EXEEXT=.exe
+PPLEXT=.ppl
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.so
+STATICLIBPREFIX=libp
+RSTEXT=.rst
+FPCMADE=fpcmade
+ifeq ($(OS_TARGET),go32v1)
+PPUEXT=.pp1
+OEXT=.o1
+ASMEXT=.s1
+SMARTEXT=.sl1
+STATICLIBEXT=.a1
+SHAREDLIBEXT=.so1
+STATICLIBPREFIX=
+FPCMADE=fpcmade.v1
+PACKAGESUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+FPCMADE=fpcmade.dos
+ZIPSUFFIX=go32
+endif
+ifeq ($(OS_TARGET),linux)
+EXEEXT=
+HASSHAREDLIB=1
+FPCMADE=fpcmade.lnx
+ZIPSUFFIX=linux
+endif
+ifeq ($(OS_TARGET),freebsd)
+EXEEXT=
+HASSHAREDLIB=1
+FPCMADE=fpcmade.freebsd
+ZIPSUFFIX=freebsd
+endif
+ifeq ($(OS_TARGET),win32)
+PPUEXT=.ppw
+OEXT=.ow
+ASMEXT=.sw
+SMARTEXT=.slw
+STATICLIBEXT=.aw
+SHAREDLIBEXT=.dll
+FPCMADE=fpcmade.w32
+ZIPSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+PPUEXT=.ppo
+ASMEXT=.so2
+OEXT=.oo2
+AOUTEXT=.out
+SMARTEXT=.so
+STATICLIBEXT=.ao2
+SHAREDLIBEXT=.dll
+FPCMADE=fpcmade.os2
+ZIPSUFFIX=emx
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+PPUEXT=.ppa
+ASMEXT=.asm
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.library
+FPCMADE=fpcmade.amg
+endif
+ifeq ($(OS_TARGET),atari)
+PPUEXT=.ppt
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=.ttp
+FPCMADE=fpcmade.ata
+endif
+ifdef REQUIRE_UNITSDIR
+override UNITSDIR+=$(REQUIRE_UNITSDIR)
+endif
+ifdef REQUIRE_PACKAGESDIR
+override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR)
+endif
+ifdef ZIPINSTALL
+ifeq ($(OS_TARGET),linux)
+UNIXINSTALLDIR=1
+endif
+ifeq ($(OS_TARGET),freebsd)
+UNIXINSTALLDIR=1
+endif
+else
+ifeq ($(OS_SOURCE),linux)
+UNIXINSTALLDIR=1
+endif
+ifeq ($(OS_SOURCE),freebsd)
+UNIXINSTALLDIR=1
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef UNIXINSTALLDIR
+INSTALL_PREFIX=/usr/local
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=/pp
+else
+INSTALL_BASEDIR:=/$(PACKAGE_NAME)
+endif
+endif
+endif
+export INSTALL_PREFIX
+ifndef DIST_DESTDIR
+DIST_DESTDIR:=$(BASEDIR)
+endif
+export DIST_DESTDIR
+ifndef INSTALL_BASEDIR
+ifdef UNIXINSTALLDIR
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION)
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/$(PACKAGE_NAME)
+endif
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)
+endif
+endif
+ifndef INSTALL_BINDIR
+ifdef UNIXINSTALLDIR
+INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin
+else
+INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(OS_TARGET)
+endif
+endif
+endif
+ifndef INSTALL_UNITDIR
+INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(OS_TARGET)
+ifdef INSTALL_FPCPACKAGE
+ifdef PACKAGE_NAME
+INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME)
+endif
+endif
+endif
+ifndef INSTALL_LIBDIR
+ifdef UNIXINSTALLDIR
+INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib
+else
+INSTALL_LIBDIR:=$(INSTALL_UNITDIR)
+endif
+endif
+ifndef INSTALL_SOURCEDIR
+ifdef UNIXINSTALLDIR
+ifdef INSTALL_FPCPACKAGE
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/src/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/src/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIRL:=$(INSTALL_BASEDIR)/source
+endif
+endif
+endif
+ifndef INSTALL_DOCDIR
+ifdef UNIXINSTALLDIR
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc
+endif
+endif
+endif
+ifndef INSTALL_EXAMPLEDIR
+ifdef UNIXINSTALLDIR
+ifdef INSTALL_FPCPACKAGE
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples
+endif
+endif
+endif
+ifndef INSTALL_DATADIR
+INSTALL_DATADIR=$(INSTALL_BASEDIR)
+endif
+ifeq ($(OS_TARGET),linux)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(OS_TARGET),go32v2)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(OS_TARGET),win32)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(OS_TARGET),os2)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(OS_TARGET),freebsd)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(OS_TARGET),beos)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(OS_TARGET),amiga)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(OS_TARGET),atari)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifdef REQUIRE_PACKAGES_RTL
+PACKAGEDIR_RTL:=$(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR)))))
+ifneq ($(PACKAGEDIR_RTL),)
+PACKAGEDIR_RTL:=$(firstword $(PACKAGEDIR_RTL))
+ifeq ($(wildcard $(PACKAGEDIR_RTL)/$(FPCMADE)),)
+override COMPILEPACKAGES+=package_rtl
+package_rtl:
+	$(MAKE) -C $(PACKAGEDIR_RTL) all
+endif
+ifneq ($(wildcard $(PACKAGEDIR_RTL)/$(OS_TARGET)),)
+UNITDIR_RTL=$(PACKAGEDIR_RTL)/$(OS_TARGET)
+else
+UNITDIR_RTL=$(PACKAGEDIR_RTL)
+endif
+else
+PACKAGEDIR_RTL=
+UNITDIR_RTL:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /rtl/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_RTL),)
+UNITDIR_RTL:=$(firstword $(UNITDIR_RTL))
+else
+UNITDIR_RTL=
+endif
+endif
+ifdef UNITDIR_RTL
+override COMPILER_UNITDIR+=$(UNITDIR_RTL)
+endif
+endif
+.PHONY: package_rtl
+override FPCOPTDEF=$(CPU_TARGET)
+ifneq ($(OS_TARGET),$(OS_SOURCE))
+override FPCOPT+=-T$(OS_TARGET)
+endif
+ifdef UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
+endif
+ifdef LIBDIR
+override FPCOPT+=$(addprefix -Fl,$(LIBDIR))
+endif
+ifdef OBJDIR
+override FPCOPT+=$(addprefix -Fo,$(OBJDIR))
+endif
+ifdef INCDIR
+override FPCOPT+=$(addprefix -Fi,$(INCDIR))
+endif
+ifdef LINKSMART
+override FPCOPT+=-XX
+endif
+ifdef CREATESMART
+override FPCOPT+=-CX
+endif
+ifdef DEBUG
+override FPCOPT+=-gl
+override FPCOPTDEF+=DEBUG
+endif
+ifdef RELEASE
+override FPCOPT+=-Xs -OG2p3 -n
+override FPCOPTDEF+=RELEASE
+endif
+ifdef STRIP
+override FPCOPT+=-Xs
+endif
+ifdef OPTIMIZE
+override FPCOPT+=-OG2p3
+endif
+ifdef VERBOSE
+override FPCOPT+=-vwni
+endif
+ifdef COMPILER_OPTIONS
+override FPCOPT+=$(COMPILER_OPTIONS)
+endif
+ifdef COMPILER_UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR))
+endif
+ifdef COMPILER_LIBRARYDIR
+override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR))
+endif
+ifdef COMPILER_OBJECTDIR
+override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR))
+endif
+ifdef COMPILER_INCLUDEDIR
+override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR))
+endif
+ifdef COMPILER_TARGETDIR
+override FPCOPT+=-FE$(COMPILER_TARGETDIR)
+ifeq ($(COMPILER_TARGETDIR),.)
+override TARGETDIRPREFIX=
+else
+override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
+endif
+endif
+ifdef COMPILER_UNITTARGETDIR
+override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR)
+ifeq ($(COMPILER_UNITTARGETDIR),.)
+override UNITTARGETDIRPREFIX=
+else
+override UNITTARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
+endif
+else
+ifdef COMPILER_TARGETDIR
+override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR)
+override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)
+endif
+endif
+ifdef OPT
+override FPCOPT+=$(OPT)
+endif
+ifdef FPCOPTDEF
+override FPCOPT+=$(addprefix -d,$(FPCOPTDEF))
+endif
+ifdef CFGFILE
+override FPCOPT+=@$(CFGFILE)
+endif
+ifdef USEENV
+override FPCEXTCMD:=$(FPCOPT)
+override FPCOPT:=!FPCEXTCMD
+export FPCEXTCMD
+endif
+override COMPILER:=$(FPC) $(FPCOPT)
+ifeq (,$(findstring -s ,$(COMPILER)))
+EXECPPAS=
+else
+ifeq ($(OS_SOURCE),$(OS_TARGET))
+EXECPPAS:=@$(PPAS)
+endif
+endif
+.PHONY: fpc_units
+ifdef TARGET_UNITS
+override ALLTARGET+=fpc_units
+override UNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_UNITS))
+override INSTALLPPUFILES+=$(UNITPPUFILES)
+override CLEANPPUFILES+=$(UNITPPUFILES)
+endif
+fpc_units: $(UNITPPUFILES)
+ifdef TARGET_RSTS
+override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS))
+override CLEANRSTFILES+=$(RSTFILES)
+endif
+.PHONY: fpc_examples
+ifdef TARGET_EXAMPLES
+HASEXAMPLES=1
+override EXAMPLESOURCEFILES:=$(wildcard $(addsuffix .pp,$(TARGET_EXAMPLES)) $(addsuffix .pas,$(TARGET_EXAMPLES)))
+override EXAMPLEFILES:=$(addsuffix $(EXEEXT),$(TARGET_EXAMPLES))
+override EXAMPLEOFILES:=$(addsuffix $(OEXT),$(TARGET_EXAMPLES)) $(addprefix $(STATICLIBPREFIX),$(addsuffix $(STATICLIBEXT),$(TARGET_EXAMPLES)))
+override CLEANEXEFILES+=$(EXAMPLEFILES) $(EXAMPLEOFILES)
+ifeq ($(OS_TARGET),os2)
+override CLEANEXEFILES+=$(addsuffix $(AOUTEXT),$(TARGET_EXAMPLES))
+endif
+endif
+ifdef TARGET_EXAMPLEDIRS
+HASEXAMPLES=1
+endif
+fpc_examples: all $(EXAMPLEFILES) $(addsuffix _all,$(TARGET_EXAMPLEDIRS))
+.PHONY: fpc_packages fpc_all fpc_smart fpc_debug
+$(FPCMADE): $(ALLTARGET)
+	@$(ECHOREDIR) Compiled > $(FPCMADE)
+fpc_packages: $(COMPILEPACKAGES)
+fpc_all: fpc_packages $(FPCMADE)
+fpc_smart:
+	$(MAKE) all LINKSMART=1 CREATESMART=1
+fpc_debug:
+	$(MAKE) all DEBUG=1
+.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .pp
+%$(PPUEXT): %.pp
+	$(COMPILER) $<
+	$(EXECPPAS)
+%$(PPUEXT): %.pas
+	$(COMPILER) $<
+	$(EXECPPAS)
+%$(EXEEXT): %.pp
+	$(COMPILER) $<
+	$(EXECPPAS)
+%$(EXEEXT): %.pas
+	$(COMPILER) $<
+	$(EXECPPAS)
+vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR)
+.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall
+ifdef INSTALL_UNITS
+override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS))
+endif
+ifdef INSTALLPPUFILES
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(INSTALLPPUFILES))
+override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(INSTALLPPULINKFILES)))
+override INSTALL_CREATEPACKAGEFPC=1
+endif
+ifdef INSTALLEXEFILES
+override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(INSTALLEXEFILES))
+endif
+fpc_install: $(INSTALLTARGET)
+ifdef INSTALLEXEFILES
+	$(MKDIR) $(INSTALL_BINDIR)
+ifdef UPXPROG
+	-$(UPXPROG) $(INSTALLEXEFILES)
+endif
+	$(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR)
+endif
+ifdef INSTALL_CREATEPACKAGEFPC
+ifdef FPCMAKE
+ifdef PACKAGE_VERSION
+ifneq ($(wildcard Makefile.fpc),)
+	$(FPCMAKE) -p -T$(OS_TARGET) Makefile.fpc
+	$(MKDIR) $(INSTALL_UNITDIR)
+	$(INSTALL) Package.fpc $(INSTALL_UNITDIR)
+endif
+endif
+endif
+endif
+ifdef INSTALLPPUFILES
+	$(MKDIR) $(INSTALL_UNITDIR)
+	$(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR)
+ifneq ($(INSTALLPPULINKFILES),)
+	$(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR)
+endif
+ifneq ($(wildcard $(LIB_FULLNAME)),)
+	$(MKDIR) $(INSTALL_LIBDIR)
+	$(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR)
+ifdef inUnix
+	ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME)
+endif
+endif
+endif
+ifdef INSTALL_FILES
+	$(MKDIR) $(INSTALL_DATADIR)
+	$(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR)
+endif
+fpc_sourceinstall: distclean
+	$(MKDIR) $(INSTALL_SOURCEDIR)
+	$(COPYTREE) $(BASEDIR) $(INSTALL_SOURCEDIR)
+fpc_exampleinstall: $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS))
+ifdef HASEXAMPLES
+	$(MKDIR) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef EXAMPLESOURCEFILES
+	$(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef TARGET_EXAMPLEDIRS
+	$(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EXAMPLEDIR)
+endif
+.PHONY: fpc_distinstall
+fpc_distinstall: install exampleinstall
+.PHONY: fpc_zipinstall fpc_zipsourceinstall fpc_zipexampleinstall
+ifndef PACKDIR
+ifndef inUnix
+PACKDIR=$(BASEDIR)/../fpc-pack
+else
+PACKDIR=/tmp/fpc-pack
+endif
+endif
+ifndef ZIPNAME
+ifdef DIST_ZIPNAME
+ZIPNAME=$(DIST_ZIPNAME)
+else
+ZIPNAME=$(ZIPPREFIX)$(PACKAGE_NAME)$(ZIPSUFFIX)
+endif
+endif
+ifndef ZIPTARGET
+ifdef DIST_ZIPTARGET
+ZIPTARGET=DIST_ZIPTARGET
+else
+ZIPTARGET=install
+endif
+endif
+ifndef USEZIP
+ifdef inUnix
+USETAR=1
+endif
+endif
+ifndef inUnix
+USEZIPWRAPPER=1
+endif
+ifdef USEZIPWRAPPER
+ZIPPATHSEP=$(PATHSEP)
+ZIPWRAPPER=$(subst /,$(PATHSEP),$(DIST_DESTDIR)/fpczip$(BATCHEXT))
+else
+ZIPPATHSEP=/
+endif
+ZIPCMD_CDPACK:=cd $(subst /,$(ZIPPATHSEP),$(PACKDIR))
+ZIPCMD_CDBASE:=cd $(subst /,$(ZIPPATHSEP),$(BASEDIR))
+ifdef USETAR
+ZIPDESTFILE:=$(DIST_DESTDIR)/$(ZIPNAME)$(TAREXT)
+ZIPCMD_ZIP:=$(TARPROG) cf$(TAROPT) $(ZIPDESTFILE) *
+else
+ZIPDESTFILE:=$(DIST_DESTDIR)/$(ZIPNAME)$(ZIPEXT)
+ZIPCMD_ZIP:=$(subst /,$(ZIPPATHSEP),$(ZIPPROG)) -Dr $(ZIPOPT) $(ZIPDESTFILE) *
+endif
+fpc_zipinstall:
+	$(MAKE) $(ZIPTARGET) INSTALL_PREFIX=$(PACKDIR) ZIPINSTALL=1
+	$(DEL) $(ZIPDESTFILE)
+ifdef USEZIPWRAPPER
+ifneq ($(ECHOREDIR),echo)
+	$(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_CDPACK))" > $(ZIPWRAPPER)
+	$(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_ZIP))" >> $(ZIPWRAPPER)
+	$(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_CDBASE))" >> $(ZIPWRAPPER)
+else
+	echo $(ZIPCMD_CDPACK) > $(ZIPWRAPPER)
+	echo $(ZIPCMD_ZIP) >> $(ZIPWRAPPER)
+	echo $(ZIPCMD_CDBASE) >> $(ZIPWRAPPER)
+endif
+ifdef inUnix
+	/bin/sh $(ZIPWRAPPER)
+else
+	$(ZIPWRAPPER)
+endif
+	$(DEL) $(ZIPWRAPPER)
+else
+	$(ZIPCMD_CDPACK) ; $(ZIPCMD_ZIP) ; $(ZIPCMD_CDBASE)
+endif
+	$(DELTREE) $(PACKDIR)
+fpc_zipsourceinstall:
+	$(MAKE) fpc_zipinstall ZIPTARGET=sourceinstall ZIPSUFFIX=src
+fpc_zipexampleinstall:
+ifdef HASEXAMPLES
+	$(MAKE) fpc_zipinstall ZIPTARGET=exampleinstall ZIPSUFFIX=exm
+endif
+fpc_zipdistinstall:
+	$(MAKE) fpc_zipinstall ZIPTARGET=distinstall
+.PHONY: fpc_clean fpc_cleanall fpc_distclean
+ifdef EXEFILES
+override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES))
+endif
+ifdef CLEAN_UNITS
+override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
+endif
+ifdef CLEANPPUFILES
+override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))
+override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES))
+override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES)))
+endif
+fpc_clean: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+	-$(DEL) $(CLEANEXEFILES)
+endif
+ifdef CLEANPPUFILES
+	-$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+	-$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+	-$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+ifdef CLEAN_FILES
+	-$(DEL) $(CLEAN_FILES)
+endif
+ifdef LIB_NAME
+	-$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
+endif
+	-$(DEL) $(FPCMADE) Package.fpc $(PPAS) link.res $(FPCEXTFILE) $(REDIRFILE)
+fpc_distclean: clean
+ifdef COMPILER_UNITTARGETDIR
+TARGETDIRCLEAN=fpc_clean
+endif
+fpc_cleanall: $(CLEANTARGET) $(TARGETDIRCLEAN)
+ifdef CLEANEXEFILES
+	-$(DEL) $(CLEANEXEFILES)
+endif
+	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
+	-$(DELTREE) *$(SMARTEXT)
+	-$(DEL) $(FPCMADE) $(PPAS) link.res $(FPCEXTFILE) $(REDIRFILE)
+ifdef AOUTEXT
+	-$(DEL) *$(AOUTEXT)
+endif
+.PHONY: fpc_info
+fpc_info:
+	@$(ECHO)
+	@$(ECHO)  == Package info ==
+	@$(ECHO)  Package Name..... $(PACKAGE_NAME)
+	@$(ECHO)  Package Version.. $(PACKAGE_VERSION)
+	@$(ECHO)
+	@$(ECHO)  == Configuration info ==
+	@$(ECHO)
+	@$(ECHO)  FPC.......... $(FPC)
+	@$(ECHO)  FPC Version.. $(FPC_VERSION)
+	@$(ECHO)  Source CPU... $(CPU_SOURCE)
+	@$(ECHO)  Target CPU... $(CPU_TARGET)
+	@$(ECHO)  Source OS.... $(OS_SOURCE)
+	@$(ECHO)  Target OS.... $(OS_TARGET)
+	@$(ECHO)
+	@$(ECHO)  == Directory info ==
+	@$(ECHO)
+	@$(ECHO)  Basedir......... $(BASEDIR)
+	@$(ECHO)  FPCDir.......... $(FPCDIR)
+	@$(ECHO)  UnitsDir........ $(UNITSDIR)
+	@$(ECHO)  PackagesDir..... $(PACKAGESDIR)
+	@$(ECHO)
+	@$(ECHO)  GCC library..... $(GCCLIBDIR)
+	@$(ECHO)  Other library... $(OTHERLIBDIR)
+	@$(ECHO)
+	@$(ECHO)  == Tools info ==
+	@$(ECHO)
+	@$(ECHO)  Pwd....... $(PWD)
+	@$(ECHO)  Mv........ $(MVPROG)
+	@$(ECHO)  Cp........ $(CPPROG)
+	@$(ECHO)  Rm........ $(RMPROG)
+	@$(ECHO)  GInstall.. $(GINSTALL)
+	@$(ECHO)  Echo...... $(ECHO)
+	@$(ECHO)  Date...... $(DATE)
+	@$(ECHO)  FPCMake... $(FPCMAKE)
+	@$(ECHO)  PPUMove... $(PPUMOVE)
+	@$(ECHO)  Upx....... $(UPXPROG)
+	@$(ECHO)  Zip....... $(ZIPPROG)
+	@$(ECHO)
+	@$(ECHO)  == Object info ==
+	@$(ECHO)
+	@$(ECHO)  Target Loaders...... $(TARGET_LOADERS)
+	@$(ECHO)  Target Units........ $(TARGET_UNITS)
+	@$(ECHO)  Target Programs..... $(TARGET_PROGRAMS)
+	@$(ECHO)  Target Dirs......... $(TARGET_DIRS)
+	@$(ECHO)  Target Examples..... $(TARGET_EXAMPLES)
+	@$(ECHO)  Target ExampleDirs.. $(TARGET_EXAMPLEDIRS)
+	@$(ECHO)
+	@$(ECHO)  Clean Units......... $(CLEAN_UNITS)
+	@$(ECHO)  Clean Files......... $(CLEAN_FILES)
+	@$(ECHO)
+	@$(ECHO)  Install Units....... $(INSTALL_UNITS)
+	@$(ECHO)  Install Files....... $(INSTALL_FILES)
+	@$(ECHO)
+	@$(ECHO)  == Install info ==
+	@$(ECHO)
+	@$(ECHO)  DateStr.............. $(DATESTR)
+	@$(ECHO)  ZipPrefix............ $(ZIPPREFIX)
+	@$(ECHO)  ZipSuffix............ $(ZIPSUFFIX)
+	@$(ECHO)  Install FPC Package.. $(INSTALL_FPCPACKAGE)
+	@$(ECHO)
+	@$(ECHO)  Install base dir..... $(INSTALL_BASEDIR)
+	@$(ECHO)  Install binary dir... $(INSTALL_BINDIR)
+	@$(ECHO)  Install library dir.. $(INSTALL_LIBDIR)
+	@$(ECHO)  Install units dir.... $(INSTALL_UNITDIR)
+	@$(ECHO)  Install source dir... $(INSTALL_SOURCEDIR)
+	@$(ECHO)  Install doc dir...... $(INSTALL_DOCDIR)
+	@$(ECHO)  Install example dir.. $(INSTALL_EXAMPLEDIR)
+	@$(ECHO)  Install data dir..... $(INSTALL_DATADIR)
+	@$(ECHO)
+	@$(ECHO)  Dist destination dir. $(DIST_DESTDIR)
+	@$(ECHO)  Dist zip name........ $(DIST_ZIPNAME)
+	@$(ECHO)
+TARGET_EXAMPLEDIRS_TEST=1
+ifdef TARGET_EXAMPLEDIRS_TEST
+test_all:
+	$(MAKE) -C test all
+test_debug:
+	$(MAKE) -C test debug
+test_smart:
+	$(MAKE) -C test smart
+test_examples:
+	$(MAKE) -C test examples
+test_shared:
+	$(MAKE) -C test shared
+test_install:
+	$(MAKE) -C test install
+test_sourceinstall:
+	$(MAKE) -C test sourceinstall
+test_exampleinstall:
+	$(MAKE) -C test exampleinstall
+test_distinstall:
+	$(MAKE) -C test distinstall
+test_zipinstall:
+	$(MAKE) -C test zipinstall
+test_zipsourceinstall:
+	$(MAKE) -C test zipsourceinstall
+test_zipexampleinstall:
+	$(MAKE) -C test zipexampleinstall
+test_zipdistinstall:
+	$(MAKE) -C test zipdistinstall
+test_clean:
+	$(MAKE) -C test clean
+test_distclean:
+	$(MAKE) -C test distclean
+test_cleanall:
+	$(MAKE) -C test cleanall
+test_info:
+	$(MAKE) -C test info
+test:
+	$(MAKE) -C test all
+.PHONY: test_all test_debug test_smart test_examples test_shared test_install test_sourceinstall test_exampleinstall test_distinstall test_zipinstall test_zipsourceinstall test_zipexampleinstall test_zipdistinstall test_clean test_distclean test_cleanall test_info test
+endif
+all: fpc_all
+debug: fpc_debug
+smart: fpc_smart
+examples: fpc_examples
+shared:
+install: fpc_install
+sourceinstall: fpc_sourceinstall
+exampleinstall: fpc_exampleinstall
+distinstall: fpc_distinstall
+zipinstall: fpc_zipinstall
+zipsourceinstall: fpc_zipsourceinstall
+zipexampleinstall: fpc_zipexampleinstall
+zipdistinstall: fpc_zipdistinstall
+clean: fpc_clean $(addsuffix _clean,$(TARGET_EXAMPLEDIRS))
+distclean: fpc_distclean
+cleanall: fpc_cleanall
+info: fpc_info
+.PHONY: all debug smart examples shared install sourceinstall exampleinstall distinstall zipinstall zipsourceinstall zipexampleinstall zipdistinstall clean distclean cleanall info
+ifneq ($(wildcard fpcmake.loc),)
+include fpcmake.loc
+endif
+buildfv$(PPUEXT): $(wildcard *.pas *.inc)

+ 31 - 0
fvision/Makefile.fpc

@@ -0,0 +1,31 @@
+#
+#   Makefile.fpc for Free Vision for Free Pascal
+#
+
+[package]
+name=fv
+version=1.0.5
+
+[target]
+units=buildfv
+exampledirs=test
+
+[libs]
+libname=libfpfv.so
+libversion=1.0
+
+[compiler]
+targetdir=.
+
+[install]
+units=$(subst $(PPUEXT),,$(wildcard *$(PPUEXT)))
+fpcpackage=y
+
+[clean]
+units=$(subst $(PPUEXT),,$(wildcard *$(PPUEXT)))
+
+[default]
+fpcdir=..
+
+[rules]
+buildfv$(PPUEXT): $(wildcard *.pas *.inc)

+ 6 - 2
fvision/app.pas

@@ -57,7 +57,7 @@ USES
    {$ENDIF}
 
    GFVGraph,                                          { GFV standard unit }
-   Common, Memory,                                    { GFV standard units }
+   FVCommon, Memory,                                    { GFV standard units }
    Objects, Drivers, Views, Menus, HistList, Dialogs; { GFV standard units }
 
 {***************************************************************************}
@@ -1088,7 +1088,11 @@ END;
 END.
 {
  $Log$
- Revision 1.11  2001-05-31 21:39:11  pierre
+ Revision 1.12  2001-08-04 19:14:32  peter
+   * Added Makefiles
+   * added FV specific units and objects from old FV
+
+ Revision 1.11  2001/05/31 21:39:11  pierre
   + AltF12 to force Redraw of Application
 
  Revision 1.10  2001/05/31 12:15:24  pierre

+ 42 - 0
fvision/buildfv.pas

@@ -0,0 +1,42 @@
+{
+  $Id$
+
+  Unit to build all units of Free Vision
+}
+unit buildfv;
+interface
+uses
+  fvcommon,
+  objects,
+  drivers,
+  fileio,
+  memory,
+  gfvgraph,
+
+  fvconsts,
+  resource,
+  views,
+  validate,
+  msgbox,
+  dialogs,
+  menus,
+  app,
+  stddlg,
+
+  tabs,
+  statuses,
+  histlist,
+  inplong,
+  gadgets,
+  time;
+
+implementation
+
+end.
+{
+  $Log$
+  Revision 1.1  2001-08-04 19:14:32  peter
+    * Added Makefiles
+    * added FV specific units and objects from old FV
+
+}

Diff do ficheiro suprimidas por serem muito extensas
+ 630 - 71
fvision/dialogs.pas


+ 73 - 69
fvision/drivers.pas

@@ -78,7 +78,7 @@ USES
 
    video,
    GFVGraph,                                          { GFV graphics unit }
-   Common, Objects;                                   { GFV standard units }
+   FVCommon, Objects;                                 { GFV standard units }
 
 {***************************************************************************}
 {                              PUBLIC CONSTANTS                             }
@@ -231,28 +231,28 @@ CONST
 {---------------------------------------------------------------------------}
 TYPE
    TEvent = PACKED RECORD
-      What: Word;                                     { Event type }
-      Case Word Of
+      What: Sw_Word;                                     { Event type }
+      Case Sw_Word Of
         evNothing: ();                                { ** NO EVENT ** }
         evMouse: (
           Buttons: Byte;                              { Mouse buttons }
           Double: Boolean;                            { Double click state }
           Where: TPoint);                             { Mouse position }
         evKeyDown: (                                  { ** KEY EVENT ** }
-          Case Integer Of
-            0: (KeyCode: Word);                       { Full key code }
+          Case Sw_Integer Of
+            0: (KeyCode: Sw_Word);                       { Full key code }
             1: (CharCode: Char;                       { Char code }
                 ScanCode: Byte;                       { Scan code }
                 KeyShift: byte));                     { Shift states }
         evMessage: (                                  { ** MESSAGE EVENT ** }
-          Command: Word;                              { Message command }
-          Id     : Word;                              { Message id }
+          Command: Sw_Word;                              { Message command }
+          Id     : Sw_Word;                              { Message id }
           Data   : Real;                              { Message data }
-          Case Word Of
+          Case Sw_Word Of
             0: (InfoPtr: Pointer);                    { Message pointer }
             1: (InfoLong: Longint);                   { Message longint }
-            2: (InfoWord: Word);                      { Message word }
-            3: (InfoInt: Integer);                    { Message integer }
+            2: (InfoWord: Word);                      { Message Sw_Word }
+            3: (InfoInt: Integer);                    { Message Sw_Integer }
             4: (InfoByte: Byte);                      { Message byte }
             5: (InfoChar: Char));                     { Message character }
    END;
@@ -262,7 +262,7 @@ TYPE
 {                    ERROR HANDLER FUNCTION DEFINITION                      }
 {---------------------------------------------------------------------------}
 TYPE
-   TSysErrorFunc = FUNCTION (ErrorCode: Integer; Drive: Byte): Integer;
+   TSysErrorFunc = FUNCTION (ErrorCode: Sw_Integer; Drive: Byte): Sw_Integer;
 
 {***************************************************************************}
 {                            INTERFACE ROUTINES                             }
@@ -283,13 +283,13 @@ the screen. For example, given the string '~B~roccoli' as its
 parameter, CStrLen returns 8.
 25May96 LdB
 ---------------------------------------------------------------------}
-FUNCTION CStrLen (Const S: String): Integer;
+FUNCTION CStrLen (Const S: String): Sw_Integer;
 
 {-MoveStr------------------------------------------------------------
 Moves a string into a buffer for use with a view's WriteBuf or WriteLine.
-Dest must be a TDrawBuffer (or an equivalent array of words). The
-characters in Str are moved into the low bytes of corresponding words
-in Dest. The high bytes of the words are set to Attr, or remain
+Dest must be a TDrawBuffer (or an equivalent array of Sw_Words). The
+characters in Str are moved into the low bytes of corresponding Sw_Words
+in Dest. The high bytes of the Sw_Words are set to Attr, or remain
 unchanged if Attr is zero.
 25May96 LdB
 ---------------------------------------------------------------------}
@@ -297,30 +297,30 @@ PROCEDURE MoveStr (Var Dest; Const Str: String; Attr: Byte);
 
 {-MoveCStr-----------------------------------------------------------
 The characters in Str are moved into the low bytes of corresponding
-words in Dest. The high bytes of the words are set to Lo(Attr) or
+Sw_Words in Dest. The high bytes of the Sw_Words are set to Lo(Attr) or
 Hi(Attr). Tilde characters (~) in the string toggle between the two
-attribute bytes passed in the Attr word.
+attribute bytes passed in the Attr Sw_Word.
 25May96 LdB
 ---------------------------------------------------------------------}
 PROCEDURE MoveCStr (Var Dest; Const Str: String; Attrs: Word);
 
 {-MoveBuf------------------------------------------------------------
 Count bytes are moved from Source into the low bytes of corresponding
-words in Dest. The high bytes of the words in Dest are set to Attr,
+Sw_Words in Dest. The high bytes of the Sw_Words in Dest are set to Attr,
 or remain unchanged if Attr is zero.
 25May96 LdB
 ---------------------------------------------------------------------}
-PROCEDURE MoveBuf (Var Dest, Source; Attr: Byte; Count: Word);
+PROCEDURE MoveBuf (Var Dest, Source; Attr: Byte; Count: Sw_Word);
 
 {-MoveChar------------------------------------------------------------
 Moves characters into a buffer for use with a view's WriteBuf or
-WriteLine. Dest must be a TDrawBuffer (or an equivalent array of words).
-The low bytes of the first Count words of Dest are set to C, or
-remain unchanged if Ord(C) is zero. The high bytes of the words are
+WriteLine. Dest must be a TDrawBuffer (or an equivalent array of Sw_Words).
+The low bytes of the first Count Sw_Words of Dest are set to C, or
+remain unchanged if Ord(C) is zero. The high bytes of the Sw_Words are
 set to Attr, or remain unchanged if Attr is zero.
 25May96 LdB
 ---------------------------------------------------------------------}
-PROCEDURE MoveChar (Var Dest; C: Char; Attr: Byte; Count: Word);
+PROCEDURE MoveChar (Var Dest; C: Char; Attr: Byte; Count: Sw_Word);
 
 {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 {                        KEYBOARD SUPPORT ROUTINES                          }
@@ -351,7 +351,7 @@ Returns the ascii character for the Ctrl+Key scancode that was given.
 FUNCTION GetCtrlChar (KeyCode: Word): Char;
 
 {-CtrlToArrow--------------------------------------------------------
-Converts a WordStar-compatible control key code to the corresponding
+Converts a Sw_WordStar-compatible control key code to the corresponding
 cursor key code.
 25May96 LdB
 ---------------------------------------------------------------------}
@@ -449,7 +449,7 @@ PROCEDURE ClearScreen;
 Does nothing provided for compatability purposes only.
 04Jan97 LdB
 ---------------------------------------------------------------------}
-PROCEDURE SetVideoMode (Mode: Word);
+PROCEDURE SetVideoMode (Mode: Sw_Word);
 
 {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 {                           ERROR CONTROL ROUTINES                          }
@@ -473,7 +473,7 @@ PROCEDURE DoneSysError;
 Error handling is not yet implemented so this simply drops through.
 20May98 LdB
 ---------------------------------------------------------------------}
-FUNCTION SystemError (ErrorCode: Integer; Drive: Byte): Integer;
+FUNCTION SystemError (ErrorCode: Sw_Integer; Drive: Byte): Sw_Integer;
 
 {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 {                           STRING FORMAT ROUTINES                          }
@@ -532,25 +532,25 @@ CONST
    SysErrActive : Boolean = False;                    { Compatability only }
    FailSysErrors: Boolean = False;                    { Compatability only }
    ButtonCount  : Byte = 0;                           { Mouse button count }
-   DoubleDelay  : Word = 8;                           { Double click delay }
-   RepeatDelay  : Word = 8;                           { Auto mouse delay }
-   SysColorAttr : Word = $4E4F;                       { System colour attr }
-   SysMonoAttr  : Word = $7070;                       { System mono attr }
-   StartupMode  : Word = $FFFF;                       { Compatability only }
-   CursorLines  : Word = $FFFF;                       { Compatability only }
+   DoubleDelay  : Sw_Word = 8;                           { Double click delay }
+   RepeatDelay  : Sw_Word = 8;                           { Auto mouse delay }
+   SysColorAttr : Sw_Word = $4E4F;                       { System colour attr }
+   SysMonoAttr  : Sw_Word = $7070;                       { System mono attr }
+   StartupMode  : Sw_Word = $FFFF;                       { Compatability only }
+   CursorLines  : Sw_Word = $FFFF;                       { Compatability only }
    ScreenBuffer : Pointer = Nil;                      { Compatability only }
    SaveInt09    : Pointer = Nil;                      { Compatability only }
-   SysErrorFunc : TSysErrorFunc = SystemError;        { System error ptr }
+   SysErrorFunc : TSysErrorFunc = {$ifdef FPC}@{$endif}SystemError; { System error ptr }
 
 {---------------------------------------------------------------------------}
 {          >>> NEW INITIALIZED DOS/DPMI/WIN/NT/OS2 VARIABLES <<<            }
 {---------------------------------------------------------------------------}
 CONST
    TextModeGFV    : Boolean = False;                  { DOS/DPMI textmode op }
-   DefLineNum     : Integer = 25;                     { Default line number }
-   DefFontHeight  : Integer = 0;                      { Default font height }
-   SysFontWidth   : Integer = 8;                      { System font width }
-   SysFontHeight  : Integer = 16;                     { System font height }
+   DefLineNum     : Sw_Integer = 25;                     { Default line number }
+   DefFontHeight  : Sw_Integer = 0;                      { Default font height }
+   SysFontWidth   : Sw_Integer = 8;                      { System font width }
+   SysFontHeight  : Sw_Integer = 16;                     { System font height }
 
 {***************************************************************************}
 {                      UNINITIALIZED PUBLIC VARIABLES                       }
@@ -565,7 +565,7 @@ VAR
    ScreenWidth : Byte;                                { Screen text width }
    ScreenHeight: Byte;                                { Screen text height }
 {$ifdef GRAPH_API}
-   ScreenMode  : Word;                                { Screen mode }
+   ScreenMode  : Sw_Word;                                { Screen mode }
 {$else not GRAPH_API}
    ScreenMode  : TVideoMode;                         { Screen mode }
 {$endif GRAPH_API}
@@ -628,10 +628,10 @@ CONST AltCodes: Array [0..127] Of Byte = (
 {                           NEW CONTROL VARIABLES                           }
 {---------------------------------------------------------------------------}
 CONST
-   HideCount : Integer = 0;                           { Cursor hide count }
-   QueueCount: Word = 0;                              { Queued message count }
-   QueueHead : Word = 0;                              { Queue head pointer }
-   QueueTail : Word = 0;                              { Queue tail pointer }
+   HideCount : Sw_Integer = 0;                           { Cursor hide count }
+   QueueCount: Sw_Word = 0;                              { Queued message count }
+   QueueHead : Sw_Word = 0;                              { Queue head pointer }
+   QueueTail : Sw_Word = 0;                              { Queue tail pointer }
 
 {***************************************************************************}
 {                 PRIVATE INTERNAL UNINITIALIZED VARIABLES                  }
@@ -644,14 +644,14 @@ VAR
    LastDouble : Boolean;                              { Last double buttons }
    LastButtons: Byte;                                 { Last button state }
    DownButtons: Byte;                                 { Last down buttons }
-   EventCount : Word;                                 { Events in queue }
-   AutoDelay  : Word;                                 { Delay time count }
-   DownTicks  : Word;                                 { Down key tick count }
-   AutoTicks  : Word;                                 { Held key tick count }
-   LastWhereX : Word;                                 { Last x position }
-   LastWhereY : Word;                                 { Last y position }
-   DownWhereX : Word;                                 { Last x position }
-   DownWhereY : Word;                                 { Last y position }
+   EventCount : Sw_Word;                                 { Events in queue }
+   AutoDelay  : Sw_Word;                                 { Delay time count }
+   DownTicks  : Sw_Word;                                 { Down key tick count }
+   AutoTicks  : Sw_Word;                                 { Held key tick count }
+   LastWhereX : Sw_Word;                                 { Last x position }
+   LastWhereY : Sw_Word;                                 { Last y position }
+   DownWhereX : Sw_Word;                                 { Last x position }
+   DownWhereY : Sw_Word;                                 { Last y position }
    LastWhere  : TPoint;                               { Last mouse position }
    DownWhere  : TPoint;                               { Last down position }
    EventQHead : Pointer;                              { Head of queue }
@@ -865,8 +865,8 @@ end;
 {---------------------------------------------------------------------------}
 {  CStrLen -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25May96 LdB           }
 {---------------------------------------------------------------------------}
-FUNCTION CStrLen (Const S: String): Integer;
-VAR I, J: Integer;
+FUNCTION CStrLen (Const S: String): Sw_Integer;
+VAR I, J: Sw_Integer;
 BEGIN
    J := 0;                                            { Set result to zero }
    For I := 1 To Length(S) Do
@@ -881,7 +881,7 @@ PROCEDURE MoveStr (Var Dest; Const Str: String; Attr: Byte);
 VAR I: Word; P: PWord;
 BEGIN
    For I := 1 To Length(Str) Do Begin                 { For each character }
-     P := @TWordArray(Dest)[I-1];                     { Pointer to word }
+     P := @TWordArray(Dest)[I-1];                     { Pointer to Sw_Word }
      If (Attr <> 0) Then WordRec(P^).Hi := Attr;      { Copy attribute }
      WordRec(P^).Lo := Byte(Str[I]);                  { Copy string char }
    End;
@@ -891,12 +891,12 @@ END;
 {  MoveCStr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 10Jul99 LdB          }
 {---------------------------------------------------------------------------}
 PROCEDURE MoveCStr (Var Dest; Const Str: String; Attrs: Word);
-VAR B: Byte; I, J: Word; P: PWord;
+VAR B: Byte; I, J: Sw_Word; P: PWord;
 BEGIN
    J := 0;                                            { Start position }
    For I := 1 To Length(Str) Do Begin                 { For each character }
      If (Str[I] <> '~') Then Begin                    { Not tilde character }
-       P := @TWordArray(Dest)[J];                     { Pointer to word }
+       P := @TWordArray(Dest)[J];                     { Pointer to Sw_Word }
        If (Lo(Attrs) <> 0) Then
          WordRec(P^).Hi := Lo(Attrs);                 { Copy attribute }
        WordRec(P^).Lo := Byte(Str[I]);                { Copy string char }
@@ -912,11 +912,11 @@ END;
 {---------------------------------------------------------------------------}
 {  MoveBuf -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 10Jul99 LdB           }
 {---------------------------------------------------------------------------}
-PROCEDURE MoveBuf (Var Dest, Source; Attr: Byte; Count: Word);
+PROCEDURE MoveBuf (Var Dest, Source; Attr: Byte; Count: Sw_Word);
 VAR I: Word; P: PWord;
 BEGIN
    For I := 1 To Count Do Begin
-     P := @TWordArray(Dest)[I-1];                     { Pointer to word }
+     P := @TWordArray(Dest)[I-1];                     { Pointer to Sw_Word }
      If (Attr <> 0) Then WordRec(P^).Hi := Attr;      { Copy attribute }
      WordRec(P^).Lo := TByteArray(Source)[I-1];       { Copy source data }
    End;
@@ -925,11 +925,11 @@ END;
 {---------------------------------------------------------------------------}
 {  MoveChar -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 10Jul99 LdB          }
 {---------------------------------------------------------------------------}
-PROCEDURE MoveChar (Var Dest; C: Char; Attr: Byte; Count: Word);
+PROCEDURE MoveChar (Var Dest; C: Char; Attr: Byte; Count: Sw_Word);
 VAR I: Word; P: PWord;
 BEGIN
    For I := 1 To Count Do Begin
-     P := @TWordArray(Dest)[I-1];                     { Pointer to word }
+     P := @TWordArray(Dest)[I-1];                     { Pointer to Sw_Word }
      If (Attr <> 0) Then WordRec(P^).Hi := Attr;      { Copy attribute }
      If (Ord(C) <> 0) Then WordRec(P^).Lo := Byte(C); { Copy character }
    End;
@@ -964,7 +964,7 @@ END;
 {  GetAltChar -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25May96 LdB        }
 {---------------------------------------------------------------------------}
 FUNCTION GetAltChar (KeyCode: Word): Char;
-VAR I: Integer;
+VAR I: Sw_Integer;
 BEGIN
    GetAltChar := #0;                                  { Preset fail return }
    If (Lo(KeyCode) = 0) Then Begin                    { Extended key }
@@ -997,10 +997,10 @@ FUNCTION CtrlToArrow (KeyCode: Word): Word;
 CONST NumCodes = 11;
       CtrlCodes : Array [0..NumCodes-1] Of Char =
         (#19, #4, #5, #24, #1, #6, #7, #22, #18, #3, #8);
-      ArrowCodes: Array [0..NumCodes-1] Of Word =
+      ArrowCodes: Array [0..NumCodes-1] Of Sw_Word =
        (kbLeft, kbRight, kbUp, kbDown, kbHome, kbEnd, kbDel, kbIns,
         kbPgUp, kbPgDn, kbBack);
-VAR I: Integer;
+VAR I: Sw_Integer;
 BEGIN
    CtrlToArrow := KeyCode;                            { Preset key return }
    For I := 0 To NumCodes - 1 Do
@@ -1029,7 +1029,7 @@ end;
 procedure GetKeyEvent (Var Event: TEvent);
 var
   key      : TKeyEvent;
-  keycode  : word;
+  keycode  : Word;
   keyshift : byte;
 begin
   if Keyboard.PollKeyEvent<>0 then
@@ -1205,11 +1205,11 @@ END;
 {  InitVideo -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Nov99 LdB         }
 {---------------------------------------------------------------------------}
 PROCEDURE InitVideo;
-VAR {$ifdef Use_API}I, J: Integer;
+VAR {$ifdef Use_API}I, J: Sw_Integer;
     {$else not Use_API}
-    {$IFDEF OS_DOS} I, J: Integer;Ts: TextSettingsType;{$ENDIF}
+    {$IFDEF OS_DOS} I, J: Sw_Integer;Ts: TextSettingsType;{$ENDIF}
     {$IFDEF OS_WINDOWS} Dc, Mem: HDc; TempFont: TLogFont; Tm: TTextmetric; {$ENDIF}
-    {$IFDEF OS_OS2} Ts, Fs: Integer; Ps: HPs; Tm: FontMetrics; {$ENDIF}
+    {$IFDEF OS_OS2} Ts, Fs: Sw_Integer; Ps: HPs; Tm: FontMetrics; {$ENDIF}
     {$ENDIF}
 BEGIN
 {$ifdef GRAPH_API}
@@ -1271,7 +1271,7 @@ END;
 {---------------------------------------------------------------------------}
 {  SetVideoMode -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 10Nov99 LdB      }
 {---------------------------------------------------------------------------}
-PROCEDURE SetVideoMode (Mode: Word);
+PROCEDURE SetVideoMode (Mode: Sw_Word);
 BEGIN
    If (Mode > $100) Then DefLineNum := 50             { 50 line mode request }
      Else DefLineNum := 24;                           { Normal 24 line mode }
@@ -1300,7 +1300,7 @@ END;
 {---------------------------------------------------------------------------}
 {  SystemError -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 20May98 LdB       }
 {---------------------------------------------------------------------------}
-FUNCTION SystemError (ErrorCode: Integer; Drive: Byte): Integer;
+FUNCTION SystemError (ErrorCode: Sw_Integer; Drive: Byte): Sw_Integer;
 BEGIN
    If (FailSysErrors = False) Then Begin              { Check error ignore }
 
@@ -1474,7 +1474,11 @@ BEGIN
 END.
 {
  $Log$
- Revision 1.10  2001-05-10 16:46:27  pierre
+ Revision 1.11  2001-08-04 19:14:33  peter
+   * Added Makefiles
+   * added FV specific units and objects from old FV
+
+ Revision 1.10  2001/05/10 16:46:27  pierre
   + some improovements made
 
  Revision 1.9  2001/05/07 22:22:03  pierre

+ 24 - 6
fvision/fileio.pas

@@ -93,7 +93,7 @@ UNIT FileIO;
 
 USES
   {$IFDEF WIN16} WinTypes, WinProcs, {$ENDIF}         { Stardard BP units }
-  Common;                                             { Standard GFV unit }
+  FVCommon;                                           { Standard GFV unit }
 
 {***************************************************************************}
 {                             PUBLIC CONSTANTS                              }
@@ -154,7 +154,7 @@ access mode the file is opened and the file handle returned. If the
 name or mode is invalid or an error occurs the return will be zero.
 27Oct98 LdB
 ---------------------------------------------------------------------}
-FUNCTION FileOpen (Var FileName: AsciiZ; Mode: Word): THandle;
+FUNCTION FileOpen (Const FileName: AsciiZ; Mode: Word): THandle;
 
 {-SetFileSize--------------------------------------------------------
 The file opened by the handle is set the given size. If the action is
@@ -228,7 +228,21 @@ FUNCTION FileWrite (Handle: THandle; Var Buf; Count: Sw_Word; Var Actual: Sw_Wor
 {$ENDIF}
 
 {$IFDEF OS_LINUX}                                     { LINUX COMPILER }
-  USES unix;
+  USES
+    {$ifdef VER1_0}
+      linux;
+    {$else}
+      unix;
+    {$endif}
+{$ENDIF}
+
+{$IFDEF OS_FREEBSD}                                   { FREEBSD COMPILER }
+  USES
+    {$ifdef VER1_0}
+      linux;
+    {$else}
+      unix;
+    {$endif}
 {$ENDIF}
 
 {***************************************************************************}
@@ -292,7 +306,7 @@ END;
 {---------------------------------------------------------------------------}
 {  FileOpen -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 27Oct98 LdB          }
 {---------------------------------------------------------------------------}
-FUNCTION FileOpen (Var FileName: AsciiZ; Mode: Word): THandle;
+FUNCTION FileOpen (Const FileName: AsciiZ; Mode: Word): THandle;
 {$IFDEF OS_DOS}                                       { DOS/DPMI CODE }
    {$IFDEF ASM_BP}                                    { BP COMPATABLE ASM }
    ASSEMBLER;
@@ -679,7 +693,11 @@ END;
 END.
 {
  $Log$
- Revision 1.4  2001-05-03 15:55:44  pierre
+ Revision 1.5  2001-08-04 19:14:33  peter
+   * Added Makefiles
+   * added FV specific units and objects from old FV
+
+ Revision 1.4  2001/05/03 15:55:44  pierre
   + linux support for fileio contributed by Holger Schurig
 
  Revision 1.3  2001/04/10 21:29:55  pierre
@@ -689,4 +707,4 @@ END.
   * CVS log and ID tags
 
 
-}
+}

+ 430 - 0
fvision/fvcommon.pas

@@ -0,0 +1,430 @@
+{ $Id$  }
+{********************[ COMMON UNIT ]***********************}
+{                                                          }
+{    System independent COMMON TYPES & DEFINITIONS         }
+{                                                          }
+{    Parts Copyright (c) 1997 by Balazs Scheidler          }
+{    [email protected]                                      }
+{                                                          }
+{    Parts Copyright (c) 1999, 2000 by Leon de Boer        }
+{    [email protected]  - primary e-mail address       }
+{    [email protected] - backup e-mail address     }
+{                                                          }
+{****************[ THIS CODE IS FREEWARE ]*****************}
+{                                                          }
+{     This sourcecode is released for the purpose to       }
+{   promote the pascal language on all platforms. You may  }
+{   redistribute it and/or modify with the following       }
+{   DISCLAIMER.                                            }
+{                                                          }
+{     This SOURCE CODE is distributed "AS IS" WITHOUT      }
+{   WARRANTIES AS TO PERFORMANCE OF MERCHANTABILITY OR     }
+{   ANY OTHER WARRANTIES WHETHER EXPRESSED OR IMPLIED.     }
+{                                                          }
+{*****************[ SUPPORTED PLATFORMS ]******************}
+{     16 and 32 Bit compilers                              }
+{        DOS      - Turbo Pascal 7.0 +      (16 Bit)       }
+{        DPMI     - Turbo Pascal 7.0 +      (16 Bit)       }
+{                 - FPC 0.9912+ (GO32V2)    (32 Bit)       }
+{        WINDOWS  - Turbo Pascal 7.0 +      (16 Bit)       }
+{                 - Delphi 1.0+             (16 Bit)       }
+{        WIN95/NT - Delphi 2.0+             (32 Bit)       }
+{                 - Virtual Pascal 2.0+     (32 Bit)       }
+{                 - Speedsoft Sybil 2.0+    (32 Bit)       }
+{                 - FPC 0.9912+             (32 Bit)       }
+{        OS2      - Virtual Pascal 1.0+     (32 Bit)       }
+{                 - Speed Pascal 1.0+       (32 Bit)       }
+{                 - C'T patch to BP         (16 Bit)       }
+{                                                          }
+{******************[ REVISION HISTORY ]********************}
+{  Version  Date      Who    Fix                           }
+{  -------  --------  ---    ----------------------------  }
+{  0.1     12 Jul 97  Bazsi  Initial implementation        }
+{  0.2     18 Jul 97  Bazsi  Linux specific error codes    }
+{  0.2.2   28 Jul 97  Bazsi  Base error code for Video     }
+{  0.2.3   29 Jul 97  Bazsi  Basic types added (PByte etc) }
+{  0.2.5   08 Aug 97  Bazsi  Error handling code added     }
+{  0.2.6   06 Sep 97  Bazsi  Base code for keyboard        }
+{  0.2.7   06 Nov 97  Bazsi  Base error code for filectrl  }
+{  0.2.8   21 Jan 99  LdB    Max data sizes added.         }
+{  0.2.9   22 Jan 99  LdB    General array types added.    }
+{  0.3.0   27 Oct 99  LdB    Delphi3+ MaxAvail, MemAvail   }
+{  0.4.0   14 Nov 00  LdB    Revamp of whole unit          }
+{**********************************************************}
+
+UNIT FVCommon;
+
+{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
+                                  INTERFACE
+{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
+
+{====Include file to sort compiler platform out =====================}
+{$I Platform.inc}
+{====================================================================}
+
+{***************************************************************************}
+{                              PUBLIC CONSTANTS                             }
+{***************************************************************************}
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{                        SYSTEM ERROR BASE CONSTANTS                        }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+{---------------------------------------------------------------------------}
+{  The following ranges have been defined for error codes:                  }
+{---------------------------------------------------------------------------}
+{        0 -  1000    OS dependant error codes                              }
+{     1000 - 10000    API reserved error codes                              }
+{    10000 -          Add-On unit error codes                               }
+{---------------------------------------------------------------------------}
+
+{---------------------------------------------------------------------------}
+{                         DEFINED BASE ERROR CONSTANTS                      }
+{---------------------------------------------------------------------------}
+CONST
+   errOk                = 0;                          { No error }
+   errVioBase           = 1000;                       { Video base offset }
+   errKbdBase           = 1010;                       { Keyboard base offset }
+   errFileCtrlBase      = 1020;                       { File IO base offset }
+   errMouseBase         = 1030;                       { Mouse base offset }
+
+{---------------------------------------------------------------------------}
+{                            MAXIUM DATA SIZES                              }
+{---------------------------------------------------------------------------}
+CONST
+{$IFDEF BIT_16}                                       { 16 BIT DEFINITION }
+   MaxBytes = 65520;                                  { Maximum data size }
+{$ENDIF}
+{$IFDEF BIT_32}                                       { 32 BIT DEFINITION }
+   MaxBytes = 128*1024*1024;                          { Maximum data size }
+{$ENDIF}
+   MaxWords = MaxBytes DIV SizeOf(Word);              { Max words }
+   MaxInts  = MaxBytes DIV SizeOf(Integer);           { Max integers }
+   MaxLongs = MaxBytes DIV SizeOf(LongInt);           { Max longints }
+   MaxPtrs  = MaxBytes DIV SizeOf(Pointer);           { Max pointers }
+   MaxReals = MaxBytes DIV SizeOf(Real);              { Max reals }
+   MaxStr   = MaxBytes DIV SizeOf(String);            { Max strings }
+
+{***************************************************************************}
+{                          PUBLIC TYPE DEFINITIONS                          }
+{***************************************************************************}
+
+{---------------------------------------------------------------------------}
+{                           CPU TYPE DEFINITIONS                            }
+{---------------------------------------------------------------------------}
+TYPE
+{$IFDEF BIT_32}                                       { 32 BIT CODE }
+   CPUWord = Longint;                                 { CPUWord is 32 bit }
+   CPUInt = Longint;                                  { CPUInt is 32 bit }
+{$ELSE}                                               { 16 BIT CODE }
+   CPUWord = Word;                                    { CPUWord is 16 bit }
+   CPUInt = Integer;                                  { CPUInt is 16 bit }
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{                     16/32 BIT SWITCHED TYPE CONSTANTS                     }
+{---------------------------------------------------------------------------}
+TYPE
+{$IFDEF BIT_16}                                       { 16 BIT DEFINITIONS }
+   Sw_Word    = Word;                                 { Standard word }
+   Sw_Integer = Integer;                              { Standard integer }
+{$ENDIF}
+{$IFDEF BIT_32}                                       { 32 BIT DEFINITIONS }
+   Sw_Word    = LongInt;                              { Long integer now }
+   Sw_Integer = LongInt;                              { Long integer now }
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{                           FILE HANDLE SIZE                                }
+{---------------------------------------------------------------------------}
+TYPE
+{$IFDEF OS_DOS}                                       { DOS DEFINITION }
+   THandle = Integer;                                 { Handles are 16 bits }
+{$ENDIF}
+{$IFDEF OS_ATARI}                                     { ATARI DEFINITION }
+   THandle = Integer;                                 { Handles are 16 bits }
+{$ENDIF}
+{$IFDEF OS_LINUX}                                     { LINUX DEFINITIONS }
+ { values are words, though the OS calls return 32-bit values }
+ { to check (CEC)                                             }
+  THandle = LongInt;                                  { Simulated 32 bits }
+{$ENDIF}
+{$IFDEF OS_AMIGA}                                     { AMIGA DEFINITIONS }
+  THandle = LongInt;                                  { Handles are 32 bits }
+{$ENDIF}
+{$IFDEF OS_WINDOWS}                                   { WIN/NT DEFINITIONS }
+  THandle = sw_Integer;                               { Can be either }
+{$ENDIF}
+{$IFDEF OS_OS2}                                       { OS2 DEFINITIONS }
+  THandle = sw_Integer;                               { Can be either }
+{$ENDIF}
+{$IFDEF OS_MAC}                                       { MACINTOSH DEFINITIONS }
+  THandle = LongInt;                                  { Handles are 32 bits }
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{                      POINTERS TO STANDARD DATA TYPES                      }
+{---------------------------------------------------------------------------}
+TYPE
+   PByte = ^Byte;                                     { Pointer to byte }
+   PWord = ^Word;                                     { Pointer to word }
+   PLongint = ^Longint;                               { Pointer to longint }
+
+{---------------------------------------------------------------------------}
+{                               GENERAL ARRAYS                              }
+{---------------------------------------------------------------------------}
+TYPE
+   TByteArray = ARRAY [0..MaxBytes-1] Of Byte;        { Byte array }
+   PByteArray = ^TByteArray;                          { Byte array pointer }
+
+   TWordArray = ARRAY [0..MaxWords-1] Of Word;        { Word array }
+   PWordArray = ^TWordArray;                          { Word array pointer }
+
+   TIntegerArray = ARRAY [0..MaxInts-1] Of Integer;   { Integer array }
+   PIntegerArray = ^TIntegerArray;                    { Integer array pointer }
+
+   TLongIntArray = ARRAY [0..MaxLongs-1] Of LongInt;  { LongInt array }
+   PLongIntArray = ^TLongIntArray;                    { LongInt array pointer }
+
+   TRealArray = Array [0..MaxReals-1] Of Real;        { Real array }
+   PRealarray = ^TRealArray;                          { Real array pointer }
+
+   TPointerArray = Array [0..MaxPtrs-1] Of Pointer;   { Pointer array }
+   PPointerArray = ^TPointerArray;                    { Pointer array ptr }
+
+   TStrArray = Array [0..MaxStr-1] Of String;         { String array }
+   PStrArray = ^TStrArray;                            { String array ptr }
+
+{***************************************************************************}
+{                            INTERFACE ROUTINES                             }
+{***************************************************************************}
+
+{-GetErrorCode-------------------------------------------------------
+Returns the last error code and resets ErrorCode to errOk.
+07/12/97 Bazsi
+---------------------------------------------------------------------}
+FUNCTION GetErrorCode: LongInt;
+
+{-GetErrorInfo-------------------------------------------------------
+Returns the info assigned to the previous error, doesn't reset the
+value to nil. Would usually only be called if ErrorCode <> errOk.
+07/12/97 Bazsi
+---------------------------------------------------------------------}
+FUNCTION GetErrorInfo: Pointer;
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{                        MINIMUM AND MAXIMUM ROUTINES                       }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+FUNCTION Min (I, J: Sw_Integer): Sw_Integer;
+FUNCTION Max (I, J: Sw_Integer): Sw_Integer;
+
+{-MinimumOf----------------------------------------------------------
+Given two real numbers returns the minimum real of the two.
+04Oct99 LdB
+---------------------------------------------------------------------}
+FUNCTION MinimumOf (A, B: Real): Real;
+
+{-MaximumOf----------------------------------------------------------
+Given two real numbers returns the maximum real of the two.
+04Oct99 LdB
+---------------------------------------------------------------------}
+FUNCTION MaximumOf (A, B: Real): Real;
+
+{-MinIntegerOf-------------------------------------------------------
+Given two integer values returns the lowest integer of the two.
+04Oct99 LdB
+---------------------------------------------------------------------}
+FUNCTION MinIntegerOf (A, B: Integer): Integer;
+
+{-MaxIntegerof-------------------------------------------------------
+Given two integer values returns the biggest integer of the two.
+04Oct99 LdB
+---------------------------------------------------------------------}
+FUNCTION MaxIntegerOf (A, B: Integer): Integer;
+
+{-MinLongIntOf-------------------------------------------------------
+Given two long integers returns the minimum longint of the two.
+04Oct99 LdB
+---------------------------------------------------------------------}
+FUNCTION MinLongIntOf (A, B: LongInt): LongInt;
+
+{-MaxLongIntOf-------------------------------------------------------
+Given two long integers returns the maximum longint of the two.
+04Oct99 LdB
+---------------------------------------------------------------------}
+FUNCTION MaxLongIntOf (A, B: LongInt): LongInt;
+
+{$IFDEF PPC_DELPHI3}                                  { DELPHI 3+ CODE }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{                          MISSING DELPHI3 ROUTINES                         }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+{ ******************************* REMARK ****************************** }
+{  Delphi 3+ does not define these standard routines so I have made     }
+{  some public functions here to complete compatability.                }
+{ ****************************** END REMARK *** Leon de Boer, 14Aug98 * }
+
+{-MemAvail-----------------------------------------------------------
+Returns the free memory available under Delphi 3+.
+14Aug98 LdB
+---------------------------------------------------------------------}
+FUNCTION MemAvail: LongInt;
+
+{-MaxAvail-----------------------------------------------------------
+Returns the max free memory block size available under Delphi 3+.
+14Aug98 LdB
+---------------------------------------------------------------------}
+FUNCTION MaxAvail: LongInt;
+{$ENDIF}
+
+{***************************************************************************}
+{                        INITIALIZED PUBLIC VARIABLES                       }
+{***************************************************************************}
+
+{---------------------------------------------------------------------------}
+{                INITIALIZED DOS/DPMI/WIN/NT/OS2 VARIABLES                  }
+{---------------------------------------------------------------------------}
+CONST
+   ErrorCode: Longint = errOk;                        { Last error code }
+   ErrorInfo: Pointer = Nil;                          { Last error info }
+
+{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
+                               IMPLEMENTATION
+{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
+
+{$IFDEF PPC_DELPHI3}                                  { DELPHI 3+ COMPILER }
+USES WinTypes, WinProcs;                              { Stardard units }
+{$ENDIF}
+
+{***************************************************************************}
+{                            INTERFACE ROUTINES                             }
+{***************************************************************************}
+
+{---------------------------------------------------------------------------}
+{  GetErrorCode -> Platforms ALL - Updated 12Jul97 Bazsi                    }
+{---------------------------------------------------------------------------}
+FUNCTION GetErrorCode: LongInt;
+BEGIN
+   GetErrorCode := ErrorCode;                         { Return last error }
+   ErrorCode := 0;                                    { Now clear errorcode }
+END;
+
+{---------------------------------------------------------------------------}
+{  GetErrorInfo -> Platforms ALL - Updated 12Jul97 Bazsi                    }
+{---------------------------------------------------------------------------}
+FUNCTION GetErrorInfo: Pointer;
+BEGIN
+   GetErrorInfo := ErrorInfo;                         { Return errorinfo ptr }
+END;
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{                        MINIMUM AND MAXIMUM ROUTINES                       }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+FUNCTION Min (I, J: Sw_Integer): Sw_Integer;
+BEGIN
+  If (I < J) Then Min := I Else Min := J;          { Select minimum }
+END;
+
+FUNCTION Max (I, J: Sw_Integer): Sw_Integer;
+BEGIN
+  If (I > J) Then Max := I Else Max := J;          { Select maximum }
+END;
+
+
+{---------------------------------------------------------------------------}
+{  MinimumOf -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB         }
+{---------------------------------------------------------------------------}
+FUNCTION MinimumOf (A, B: Real): Real;
+BEGIN
+   If (B < A) Then MinimumOf := B                     { B smaller take it }
+     Else MinimumOf := A;                             { Else take A }
+END;
+
+{---------------------------------------------------------------------------}
+{  MaximumOf -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB         }
+{---------------------------------------------------------------------------}
+FUNCTION MaximumOf (A, B: Real): Real;
+BEGIN
+   If (B > A) Then MaximumOf := B                     { B bigger take it }
+     Else MaximumOf := A;                             { Else take A }
+END;
+
+{---------------------------------------------------------------------------}
+{  MinIntegerOf -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB      }
+{---------------------------------------------------------------------------}
+FUNCTION MinIntegerOf (A, B: Integer): Integer;
+BEGIN
+   If (B < A) Then MinIntegerOf := B                  { B smaller take it }
+     Else MinIntegerOf := A;                          { Else take A }
+END;
+
+{---------------------------------------------------------------------------}
+{  MaxIntegerOf -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB      }
+{---------------------------------------------------------------------------}
+FUNCTION MaxIntegerOf (A, B: Integer): Integer;
+BEGIN
+   If (B > A) Then MaxIntegerOf := B                  { B bigger take it }
+     Else MaxIntegerOf := A;                          { Else take A }
+END;
+
+{---------------------------------------------------------------------------}
+{  MinLongIntOf -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB      }
+{---------------------------------------------------------------------------}
+FUNCTION MinLongIntOf (A, B: LongInt): LongInt;
+BEGIN
+   If (B < A) Then MinLongIntOf := B                  { B smaller take it }
+     Else MinLongIntOf := A;                          { Else take A }
+END;
+
+{---------------------------------------------------------------------------}
+{  MaxLongIntOf -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB      }
+{---------------------------------------------------------------------------}
+FUNCTION MaxLongIntOf (A, B: LongInt): LongInt;
+BEGIN
+   If (B > A) Then MaxLongIntOf := B                  { B bigger take it }
+     Else MaxLongIntOf := A;                          { Else take A }
+END;
+
+{$IFDEF PPC_DELPHI3}                                  { DELPHI 3+ CODE }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{                          MISSING DELPHI3 ROUTINES                         }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+{---------------------------------------------------------------------------}
+{  MemAvail -> Platforms WIN/NT - Updated 14Aug98 LdB                       }
+{---------------------------------------------------------------------------}
+FUNCTION MemAvail: LongInt;
+VAR Ms: TMemoryStatus;
+BEGIN
+   GlobalMemoryStatus(Ms);                            { Get memory status }
+   MemAvail := Ms.dwAvailPhys;                        { Avail physical memory }
+END;
+
+{---------------------------------------------------------------------------}
+{  MaxAvail -> Platforms WIN/NT - Updated 14Aug98 LdB                       }
+{---------------------------------------------------------------------------}
+FUNCTION MaxAvail: LongInt;
+VAR Ms: TMemoryStatus;
+BEGIN
+   GlobalMemoryStatus(Ms);                            { Get memory status }
+   MaxAvail := Ms.dwTotalPhys;                        { Max physical memory }
+END;
+{$ENDIF}
+
+END.
+{
+ $Log$
+ Revision 1.1  2001-08-04 19:14:33  peter
+   * Added Makefiles
+   * added FV specific units and objects from old FV
+
+ Revision 1.3  2001/04/10 21:29:55  pierre
+  * import of Leon de Boer's files
+
+ Revision 1.2  2000/08/24 12:00:20  marco
+  * CVS log and ID tags
+
+
+}

+ 631 - 0
fvision/fvconsts.pas

@@ -0,0 +1,631 @@
+{ $Id$  }
+{********[ SOURCE FILE OF GRAPHICAL FREE VISION ]**********}
+{                                                          }
+{   System independent GRAPHICAL clone of DIALOGS.PAS      }
+{                                                          }
+{   Interface Copyright (c) 1992 Borland International     }
+{                                                          }
+{   Copyright (c) 1996, 1997, 1998, 1999 by Leon de Boer   }
+{   [email protected]  - primary e-mail addr           }
+{   [email protected] - backup e-mail addr            }
+{                                                          }
+{****************[ THIS CODE IS FREEWARE ]*****************}
+{                                                          }
+{     This sourcecode is released for the purpose to       }
+{   promote the pascal language on all platforms. You may  }
+{   redistribute it and/or modify with the following       }
+{   DISCLAIMER.                                            }
+{                                                          }
+{     This SOURCE CODE is distributed "AS IS" WITHOUT      }
+{   WARRANTIES AS TO PERFORMANCE OF MERCHANTABILITY OR     }
+{   ANY OTHER WARRANTIES WHETHER EXPRESSED OR IMPLIED.     }
+{                                                          }
+{*****************[ SUPPORTED PLATFORMS ]******************}
+{                                                          }
+{ Only Free Pascal Compiler supported                      }
+{                                                          }
+{**********************************************************}
+unit FVConsts;
+interface
+
+{
+  The ObjTypes unit declares constants for all object type IDs used in the
+  FreeVision library.  They have been moved here for easier management.  No
+  values for views declared in TV 2.0 have been changed from so that original
+  resource files may still be used.
+}
+const
+  { Views Unit }
+  idView = 1;
+  idFrame = 2;
+  idScrollBar = 3;
+  idScroller = 4;
+  idListViewer = 5;
+  idGroup = 6;
+  idWindow = 7;
+
+  { Dialogs Unit 10 - ? }
+  idDialog = 10;
+  idInputLine = 11;
+  idButton = 12;
+  idCluster = 13;
+  idRadioButtons = 14;
+  idCheckBoxes = 15;
+  idMultiCheckBoxes = 27;
+  idListBox = 16;
+  idStaticText = 17;
+  idLabel = 18;
+  idHistory = 19;
+  idParamText = 20;
+  idCommandCheckBoxes = 21;
+  idCommandRadioButtons = 22;
+  idCommandIcon = 23;
+  idBrowseButton = 24;
+  idEditListBox = 25;
+  idModalInputLine = 26;
+  idListDlg = 27;
+
+  { App Unit }
+  idBackground = 30;
+  idDesktop = 31;
+
+  { Config Unit }
+  idConfig = 32;
+  idMouseDlg = 33;
+  idVideoDlg = 34;
+  idClickTester = 35;
+
+  { Menus Unit }
+  idMenuBar = 40;
+  idMenuBox = 41;
+  idStatusLine = 42;
+  idMenuPopup = 43;
+  idMenuButton = 44;
+
+  { Objects Unit }
+  idCollection = 50;
+  idStringCollection = 51;
+  idStringList = 52;
+  idStrListMaker = 52;
+  idStrCollection = 69;
+
+  { Resource Unit }
+  idMemStringList = 52;
+
+  { StdDlg Unit }
+  idFileInputLine = 60;
+  idFileCollection = 61;
+  idFileList = 62;
+  idFileInfoPane = 63;
+  idFileDialog = 64;
+  idDirCollection = 65;
+  idDirListBox = 66;
+  idChDirDialog = 67;
+  idSortedListBox = 68;
+  idEditChDirDialog = 69;
+
+  { Editors Unit   70 - ? }
+  idEditor = 70;
+  idMemo = 71;
+  idFileEditor = 72;
+  idIndicator = 73;
+  idEditWindow = 74;
+  idEditWindowCollection = 75; { this value may need to be changed }
+  idEditorEngine = 76;
+
+  { Validate Unit }
+  idPXPictureValidator = 80;
+  idFilterValidator = 81;
+  idRangeValidator = 82;
+  idStringLookupValidator = 83;
+  idRealValidator = 84;
+  idByteValidator = 85;
+  idIntegerValidator = 86;
+  idSingleValidator = 87;
+  idWordValidator = 88;
+  idDateValidator = 89;
+  idTimeValidator = 90;
+
+  { Outline Unit }
+  idOutline = 91;
+
+  { ColorSel Unit }
+  idColorSelector = 92;
+  idMonoSelector = 93;
+  idColorDisplay = 94;
+  idColorGroupList = 95;
+  idColorItemList = 96;
+  idColorDialog = 97;
+
+  { Statuses Unit }
+  idStatus   = 300;
+  idStatusDlg = 301;
+  idStatusMessageDlg = 302;
+  idGauge = 303;
+  idArrowGauge = 304;
+  idBarGauge = 305;
+  idPercentGauge = 306;
+  idSpinnerGauge = 307;
+  idAppStatus = 308;
+  idHeapMinAvail = 309;
+  idHeapMemAvail = 310;
+
+  { FVList Unit }
+
+
+{
+ The Commands unit contains all command constants used in the FreeVision
+ library.  They have been extracted from their original units and placed here
+ for easier maintainence and modification to remove conflicts, such as Borland
+ created with the cmChangeDir constant in the StdDlg and App units.
+}
+
+const
+  { App Unit }
+  cmNew           = 30;
+  cmOpen          = 31;
+  cmSave          = 32;
+  cmSaveAs        = 33;
+  cmSaveAll       = 34;
+  cmSaveDone      = 35;
+  cmChangeDir     = 36;
+  cmDosShell      = 37;
+  cmCloseAll      = 38;
+  cmDelete        = 39;
+  cmEdit          = 40;
+  cmAbout         = 41;
+  cmDesktopLoad   = 42;
+  cmDesktopStore  = 43;
+  cmNewDesktop    = 44;
+  cmNewMenuBar    = 45;
+  cmNewStatusLine = 46;
+  cmNewVideo      = 47;
+  cmTransfer      = 48;
+
+  cmRecordHistory  = 60;
+  cmGrabDefault    = 61;
+  cmReleaseDefault = 62;
+
+  cmHelpContents  = 256;
+  cmHelpIndex     = 257;
+  cmHelpTopic     = 258;
+  cmHelpPrev      = 259;
+  cmHelpUsingHelp = 260;
+  cmHelpAbout     = 261;
+
+  cmBrowseDir     = 262;
+  cmBrowseFile    = 263;
+
+  { Views Unit }
+  cmValid   = 0;
+  cmQuit    = 1;
+  cmError   = 2;
+  cmMenu    = 3;
+  cmClose   = 4;
+  cmZoom    = 5;
+  cmResize  = 6;
+  cmNext    = 7;
+  cmPrev    = 8;
+  cmHelp    = 9;
+  cmOK      = 10;
+  cmCancel  = 11;
+  cmYes     = 12;
+  cmNo      = 13;
+  cmDefault = 14;
+  cmCut     = 20;
+  cmCopy    = 21;
+  cmPaste   = 22;
+  cmUndo    = 23;
+  cmClear   = 24;
+  cmTile    = 25;
+  cmCascade = 26;
+  cmHide    = 27;
+  cmReceivedFocus     = 50;
+  cmReleasedFocus     = 51;
+  cmCommandSetChanged = 52;
+  cmScrollBarChanged  = 53;
+  cmScrollBarClicked  = 54;
+  cmSelectWindowNum   = 55;
+  cmListItemSelected  = 56;
+
+  { ColorSel Unit }
+  cmColorForegroundChanged = 71;
+  cmColorBackgroundChanged = 72;
+  cmColorSet               = 73;
+  cmNewColorItem           = 74;
+  cmNewColorIndex          = 75;
+  cmSaveColorIndex         = 76;
+
+  { StdDlg Unit   800 - ? }
+  cmFileOpen    = 800;   { Returned from TFileDialog when Open pressed }
+  cmFileReplace = 801;   { Returned from TFileDialog when Replace pressed }
+  cmFileClear   = 802;   { Returned from TFileDialog when Clear pressed }
+  cmFileInit    = 803;   { Used by TFileDialog internally }
+  cmRevert      = 805;   { Used by TChDirDialog internally }
+  cmFileFocused = 806;    { A new file was focused in the TFileList }
+  cmFileDoubleClicked = 807;  { A file was selected in the TFileList }
+
+  { Config Unit   130-140, 900-999 }
+  cmConfigMouse       = 130; { Mouse command disabled by Init if no mouse }
+  cmConfigOpen        = 900;
+  cmConfigSave        = 901;
+  cmConfigSaveAs      = 902;
+  cmConfigMenu        = 903;
+  cmConfigColors      = 904;
+  cmConfigVideo       = 905;
+  cmConfigCO80        = 906;
+  cmConfigBW80        = 907;
+  cmConfigMono        = 908;
+  cmClock             = 909;
+  cmClockSetFormat    = 910;
+
+    { Editors Unit }
+  cmFind           = 82;
+  cmReplace        = 83;
+  cmSearchAgain    = 84;
+  cmPrint          = 85;
+  cmRedo           = 86;
+  cmJumpLine       = 87;
+  cmWindowList     = 88;
+  cmCharLeft       = 500;
+  cmCharRight      = 501;
+  cmWordLeft       = 502;
+  cmWordRight      = 503;
+  cmLineStart      = 504;
+  cmLineEnd        = 505;
+  cmLineUp         = 506;
+  cmLineDown       = 507;
+  cmPageUp         = 508;
+  cmPageDown       = 509;
+  cmTextStart      = 510;
+  cmTextEnd        = 511;
+  cmNewLine        = 512;
+  cmBackSpace      = 513;
+  cmDelChar        = 514;
+  cmDelWord        = 515;
+  cmDelStart       = 516;
+  cmDelEnd         = 517;
+  cmDelLine        = 518;
+  cmInsMode        = 519;
+  cmStartSelect    = 520;
+  cmHideSelect     = 521;
+  cmEndSelect      = 522;
+  cmIndentMode     = 523;
+  cmUpdateTitle    = 524;
+  cmReformPara     = 525;
+  cmTabKey         = 526;
+  cmInsertLine     = 527;
+  cmScrollUp       = 528;
+  cmScrollDown     = 529;
+  cmHomePage       = 530;
+  cmEndPage        = 531;
+  cmJumpMark0      = 532;
+  cmJumpMark1      = 533;
+  cmJumpMark2      = 534;
+  cmJumpMark3      = 535;
+  cmJumpMark4      = 536;
+  cmJumpMark5      = 537;
+  cmJumpMark6      = 538;
+  cmJumpMark7      = 539;
+  cmJumpMark8      = 540;
+  cmJumpMark9      = 541;
+  cmReformDoc      = 542;
+  cmSetMark0       = 543;
+  cmSetMark1       = 544;
+  cmSetMark2       = 545;
+  cmSetMark3       = 546;
+  cmSetMark4       = 547;
+  cmSetMark5       = 548;
+  cmSetMark6       = 549;
+  cmSetMark7       = 550;
+  cmSetMark8       = 551;
+  cmSetMark9       = 552;
+  cmSelectWord     = 553;
+  cmSaveExit       = 554;
+  cmCenterText     = 555;
+  cmSetTabs        = 556;
+  cmRightMargin    = 557;
+  cmWordwrap       = 558;
+  cmBludgeonStats  = 559;
+  cmPrinterSetup   = 560;
+  cmClipboard      = 561;
+  cmSpellCheck     = 562;
+  cmCopyBlock      = 563;
+  cmMoveBlock      = 564;
+  cmDelSelect      = 565;
+  cmIdentBlock     = 566;
+  cmUnidentBlock   = 567;
+  cmFileHistory    = 600;
+
+  { Statuses Unit }
+  cmStatusUpdate = 300;  { note - need to set to valid value }
+  cmStatusDone   = 301;
+  cmStatusPause  = 302;
+  cmStatusResume = 303;
+
+  cmCursorChanged = 700;
+
+
+{
+  The HelpCtx unit declares standard help contexts used in FreeVision.  By
+  placing all help contexts in one unit, duplicate help contexts are more
+  easily prevented
+}
+
+const
+
+  hcNoContext = 0;
+  hcDragging = 1;
+  hcOk = 2;
+  hcCancel = 3;
+  hcEdit   = 4;
+  hcDelete = 5;
+  hcInsert = 6;
+
+    { App Unit }
+  hcNew = 65281;        hcFileNew = hcNew;
+  hcOpen = 65282;       hcFileOpen = hcOpen;
+  hcSave = 65283;       hcFileSave = hcSave;
+  hcSaveAs = 65284;     hcFileSaveAs = hcSaveAs;
+  hcSaveAll = 65285;    hcFileSaveAll = hcSaveAll;
+  hcChangeDir = 65286;  hcFileChangeDir = hcChangeDir;
+  hcDosShell = 65287;   hcFileDOSShell = hcDosShell;
+  hcExit = 65288;       hcFileExit = hcExit;
+  hcEditMenu = 65289;
+  hcHelpMenu = 65291;
+  hcHelpContents = 65292;
+  hcHelpIndex = 65293;
+  hcHelpTopic = 65294;
+  hcHelpPrev = 65295;
+  hcHelpUsingHelp = 65296;
+  hcHelpAbout = 65297;
+  hcWindowMenu = 65298;
+  hcUndo         = $FF10;
+  hcCut          = $FF11;
+  hcCopy         = $FF12;
+  hcPaste        = $FF13;
+  hcClear        = $FF14;
+  hcTile         = $FF20;
+  hcCascade      = $FF21;
+  hcCloseAll     = $FF22;
+  hcResize       = $FF23;
+  hcZoom         = $FF24;
+  hcNext         = $FF25;
+  hcPrev         = $FF26;
+  hcClose        = $FF27;
+  hcHide         = $FF28;
+  hcFileMenu     = 65320;
+  hcSearchAndReplace =65325;
+
+    { Editors Unit }
+  hcFile_Menu            = 2100;
+{ hcOpen                 = 2101; }
+{ hcNew                  = 2102; }
+{ hcSave                 = 2103; }
+  hcSaveDone             = 2104;
+{ hcSaveAs               = 2105; }
+{ hcChangeDir            = 2106; }
+{ hcShellToDos           = 2107; }
+{ hcExit                 = 2108; }
+  hcFile_Menu_Items      = hcExit;
+
+  hcEdit_Menu            = 2200;
+{ hcUndo                 = 2201; }
+{ hcCopy                 = 2202; }
+{ hcCut                  = 2203; }
+{ hcPaste                = 2204; }
+  hcClipboard            = 2205;
+{ hcClear                = 2206; }
+  hcSpellCheck           = 2207;
+  hcEdit_Menu_Items      = hcSpellCheck;
+
+  hcSearch_Menu          = 2300;
+  hcFind                 = 2301;
+  hcReplace              = 2302;
+  hcAgain                = 2303;
+  hcSearch_Menu_Items    = hcAgain;
+
+  hcWindows_Menu         = 2400;
+{  hcResize               = 2401; }
+{  hcZoom                 = 2402; }
+{  hcPrev                 = 2403; }
+{  hcNext                 = 2404; }
+{  hcClose                = 2405; }
+{  hcTile                 = 2406; }
+{  hcCascade              = 2407; }
+  hcWindows_Menu_Items   = hcCascade;
+
+  hcDesktop_Menu         = 2500;
+  hcLoadDesktop          = 2501;
+  hcSaveDesktop          = 2502;
+  hcToggleVideo          = 2503;
+  hcDesktop_Menu_Items   = hcToggleVideo;
+
+  hcMisc_Commands        = 2600;
+  hckbShift              = 2601;
+  hckbCtrl               = 2602;
+  hckbAlt                = 2603;
+  hcMisc_Items           = hckbAlt;
+
+  hcEditor_Commands      = 2700;
+  hcCursor               = 2701;
+  hcDeleting             = 2702;
+  hcFormatting           = 2703;
+  hcMarking              = 2704;
+  hcMoving               = 2705;
+  hcSaving               = 2706;
+  hcSelecting            = 2707;
+  hcTabbing              = 2708;
+  hcBackSpace            = 2709;
+  hcCenterText           = 2710;
+  hcCharLeft             = 2711;
+  hcCharRight            = 2712;
+  hcDelChar              = 2713;
+  hcDelEnd               = 2714;
+  hcDelLine              = 2715;
+  hcDelStart             = 2716;
+  hcDelWord              = 2717;
+  hcEndPage              = 2718;
+  hcHideSelect           = 2719;
+  hcHomePage             = 2720;
+  hcIndentMode           = 2721;
+  hcInsertLine           = 2722;
+  hcInsMode              = 2723;
+  hcJumpLine             = 2724;
+  hcLineDown             = 2725;
+  hcLineEnd              = 2726;
+  hcLineStart            = 2727;
+  hcLineUp               = 2728;
+  hcNewLine              = 2729;
+  hcPageDown             = 2730;
+  hcPageUp               = 2731;
+  hcReformDoc            = 2732;
+  hcReformPara           = 2733;
+  hcRightMargin          = 2734;
+  hcScrollDown           = 2735;
+  hcScrollUp             = 2736;
+  hcSearchAgain          = 2737;
+  hcSelectWord           = 2738;
+  hcSetTabs              = 2739;
+  hcStartSelect          = 2740;
+  hcTabKey               = 2741;
+  hcTextEnd              = 2742;
+  hcTextStart            = 2743;
+  hcWordLeft             = 2744;
+  hcWordRight            = 2745;
+  hcWordWrap             = 2746;
+
+  hcJMarker_Menu         = 2750;
+  hcJumpMark1            = 2751;
+  hcJumpMark2            = 2752;
+  hcJumpMark3            = 2753;
+  hcJumpMark4            = 2754;
+  hcJumpMark5            = 2755;
+  hcJumpMark6            = 2756;
+  hcJumpMark7            = 2757;
+  hcJumpMark8            = 2758;
+  hcJumpMark9            = 2759;
+  hcJumpMark0            = 2760;
+  hcJMarker_Menu_Items   = 2761;
+
+  hcSMarker_Menu         = 2770;
+  hcSetMark1             = 2771;
+  hcSetMark2             = 2772;
+  hcSetMark3             = 2773;
+  hcSetMark4             = 2774;
+  hcSetMark5             = 2775;
+  hcSetMark6             = 2776;
+  hcSetMark7             = 2777;
+  hcSetMark8             = 2778;
+  hcSetMark9             = 2779;
+  hcSetMark0             = 2780;
+  hcSMarker_Menu_Items   = 2781;
+
+  hcEditor_Items         = hcSMarker_Menu_Items;
+
+  { Dialog }
+  hcDialogs              = 2800;
+  hcDCancel              = 2801;
+  hcDNo                  = 2802;
+  hcDOk                  = 2803;
+  hcDYes                 = 2804;
+  hcDAbout               = 2805;
+  hcDDirName             = 2806;
+  hcDDirTree             = 2807;
+  hcDChDir               = 2808;
+  hcDRevert              = 2809;
+  hcDName                = 2810;
+  hcDFiles               = 2811;
+  hcDFindText            = 2812;
+  hcDLineNumber          = 2813;
+  hcDReformDoc           = 2814;
+  hcDReplaceTExt         = 2815;
+  hcDRightMargin         = 2816;
+  hcDTabStops            = 2817;
+  hcListDlg              = 2818;
+
+  { Checkbox help }
+  hcCCaseSensitive       = 2900;
+  hcCWholeWords          = 2901;
+  hcCPromptReplace       = 2902;
+  hcCReplaceAll          = 2903;
+  hcCReformCurrent       = 2904;
+  hcCReformEntire        = 2905;
+
+    { Statuses unit }
+  hcStatusPause          = 2950;
+  hcStatusResume         = 2951;
+
+  { Glossary }
+  Glossary               = 3000;
+  GCloseIcon             = 3001;
+  GDesktop               = 3002;
+  GDialogBox             = 3003;
+  GHistoryIcon           = 3004;
+  GInputLine             = 3005;
+  GMemIndicator          = 3006;
+  GMenuBar               = 3007;
+  GPulldownMenu          = 3008;
+  GResizeCorner          = 3009;
+  GSelectedText          = 3010;
+  GStatusBar             = 3011;
+  GTitleBar              = 3012;
+  GWindowBorder          = 3013;
+  GZoomIcon              = 3014;
+  hcGlossary_Items       = GZoomIcon;
+
+    { INI Unit }
+  hcDateFormatDlg = 1;
+  hcDateParts = 1;
+  hcDateOrder = 1;
+  hcTimeFormatDlg = 1;
+  hcClockFormatDlg = 1;
+  hcClockDateParts = 1;
+  hcClockTimeFormat = 1;
+
+  hcListViewer = 1;
+
+  { Options Help Contexts }
+  hcConfigMenu          = 100;
+  hcConfigColors        = hcConfigMenu + 1;
+  hcConfigDate          = hcConfigColors + 1;
+  hcConfigEnvironment   = hcConfigDate + 1;
+  hcConfigMouse         = hcConfigEnvironment + 1;
+  hcConfigOpen          = hcConfigMouse + 1;
+  hcConfigSave          = hcConfigOpen + 1;
+  hcConfigSaveAs        = hcConfigSave + 1;
+  hcConfigTime          = hcConfigSaveAs + 1;
+  hcConfigVideo         = hcConfigTime + 1;
+  hcConfigDesktopDlg    = hcConfigVideo + 1;
+  hcConfigMouseDlg      = hcConfigDesktopDlg + 1;
+  hcConfigTimeFormatDlg = hcConfigMouseDlg + 1;
+  hcConfigTimeSeparator = hcConfigTimeFormatDlg + 1;
+  hcConfigTimeComponents = hcConfigTimeSeparator + 1;
+  hcConfigTimeStyle = hcConfigTimeComponents + 1;
+  hcConfigClock = hcConfigTimeStyle + 1;
+  hcBrowseDir = 1;
+  hcBrowseFile = 1;
+
+
+{
+  The History unit contains all history list constants used in the FreeVision
+  Library.
+}
+
+const
+  hiConfig = 1;
+  hiDirectories = 2;  { non-specific }
+  hiDesktop = 3;
+  hiCurrentDirectories = 1;
+  hiFiles = 4;
+
+implementation
+
+end.
+{
+  $Log$
+  Revision 1.1  2001-08-04 19:14:33  peter
+    * Added Makefiles
+    * added FV specific units and objects from old FV
+
+}

+ 7 - 3
fvision/gadgets.pas

@@ -95,7 +95,7 @@ UNIT Gadgets;
 {$V-} { Turn off strict VAR strings }
 {====================================================================}
 
-USES Common, Time, Objects, Drivers, Views, App;      { Standard GFV units }
+USES FVConsts, Time, Objects, Drivers, Views, App;      { Standard GFV units }
 
 {***************************************************************************}
 {                        PUBLIC OBJECT DEFINITIONS                          }
@@ -226,8 +226,12 @@ END;
 END.
 {
  $Log$
- Revision 1.2  2000-08-24 12:00:21  marco
+ Revision 1.3  2001-08-04 19:14:33  peter
+   * Added Makefiles
+   * added FV specific units and objects from old FV
+
+ Revision 1.2  2000/08/24 12:00:21  marco
   * CVS log and ID tags
 
 
-}
+}

+ 30 - 7
fvision/histlist.pas

@@ -76,7 +76,7 @@ UNIT HistList;
 {$V-} { Turn off strict VAR strings }
 {====================================================================}
 
-USES Common, Objects;                                 { Standard GFV units }
+USES FVCommon, Objects;                                 { Standard GFV units }
 
 {***************************************************************************}
 {                            INTERFACE ROUTINES                             }
@@ -112,7 +112,7 @@ FUNCTION HistoryCount (Id: Byte): Word;
 Returns the Index'th string in the history list with ID number Id.
 30Sep99 LdB
 ---------------------------------------------------------------------}
-FUNCTION HistoryStr (Id: Byte; Index: Integer): String;
+FUNCTION HistoryStr (Id: Byte; Index: Sw_Integer): String;
 
 {-ClearHistory-------------------------------------------------------
 Removes all strings from all history lists.
@@ -126,6 +126,8 @@ Adds the string Str to the history list indicated by Id.
 ---------------------------------------------------------------------}
 PROCEDURE HistoryAdd (Id: Byte; Const Str: String);
 
+function HistoryRemove(Id: Byte; Index: Sw_Integer): boolean;
+
 {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 {              HISTORY STREAM STORAGE AND RETREIVAL ROUTINES                }
 {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
@@ -204,7 +206,7 @@ END;
 {  DeleteString -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB      }
 {---------------------------------------------------------------------------}
 PROCEDURE DeleteString;
-VAR Len: Integer; P, P2: PChar;
+VAR Len: Sw_Integer; P, P2: PChar;
 BEGIN
    P := PChar(CurString);                             { Current string }
    P2 := PChar(CurString);                            { Current string }
@@ -307,8 +309,8 @@ END;
 {---------------------------------------------------------------------------}
 {  HistoryStr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB        }
 {---------------------------------------------------------------------------}
-FUNCTION HistoryStr(Id: Byte; Index: Integer): String;
-VAR I: Integer;
+FUNCTION HistoryStr(Id: Byte; Index: Sw_Integer): String;
+VAR I: Sw_Integer;
 BEGIN
    StartId(Id);                                       { Set to first record }
    If (HistoryBlock <> Nil) Then Begin                { History initalized }
@@ -346,6 +348,23 @@ BEGIN
    InsertString(Id, Str);                             { Add new history item }
 END;
 
+function HistoryRemove(Id: Byte; Index: Sw_Integer): boolean;
+var
+  I: Sw_Integer;
+begin
+  StartId(Id);
+  for I := 0 to Index do
+   AdvanceStringPtr;                                  { Find the string }
+  if CurString <> nil then
+    begin
+       DeleteString;
+       HistoryRemove:=true;
+    end
+  else
+    HistoryRemove:=false;
+end;
+
+
 {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 {              HISTORY STREAM STORAGE AND RETREIVAL ROUTINES                }
 {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
@@ -381,8 +400,12 @@ END.
 
 {
  $Log$
- Revision 1.2  2000-08-24 12:00:22  marco
+ Revision 1.3  2001-08-04 19:14:33  peter
+   * Added Makefiles
+   * added FV specific units and objects from old FV
+
+ Revision 1.2  2000/08/24 12:00:22  marco
   * CVS log and ID tags
 
 
-}
+}

+ 304 - 0
fvision/inplong.pas

@@ -0,0 +1,304 @@
+Unit InpLong;
+
+(*--
+TInputLong is a derivitave of TInputline designed to accept LongInt
+numeric input.  Since both the upper and lower limit of acceptable numeric
+input can be set, TInputLong may be used for Integer, Word, or Byte input
+as well.  Option flag bits allow optional hex input and display.  A blank
+field may optionally be rejected or interpreted as zero.
+
+Methods
+
+constructor Init(var R : TRect; AMaxLen : Integer;
+                LowerLim, UpperLim : LongInt; Flgs : Word);
+
+Calls TInputline.Init and saves the desired limits and Flags.  Flags may
+be a combination of:
+
+ilHex          will accept hex input (preceded by '$')  as well as decimal.
+ilBlankEqZero  if set, will interpret a blank field as '0'.
+ilDisplayHex   if set, will display numeric as hex when possible.
+
+
+constructor Load(var S : TStream);
+procedure Store(var S : TStream);
+
+The usual Load and Store routines.  Be sure to call RegisterType(RInputLong)
+to register the type.
+
+
+FUNCTION DataSize : Word; virtual;
+PROCEDURE GetData(var Rec); virtual;
+PROCEDURE SetData(var Rec); virtual;
+
+The transfer methods.  DataSize is Sizeof(LongInt) and Rec should be
+the address of a LongInt.
+
+
+FUNCTION RangeCheck : Boolean; virtual;
+
+Returns True if the entered string evaluates to a number >= LowerLim and
+<= UpperLim.
+
+
+PROCEDURE Error; virtual;
+
+Error is called when RangeCheck fails.  It displays a messagebox indicating
+the label (if any) of the faulting view, as well as the allowable range.
+
+
+PROCEDURE HandleEvent(var Event : TEvent); virtual;
+
+HandleEvent filters out characters which are not appropriate to numeric
+input.  Tab and Shift Tab cause a call to RangeCheck and a call to Error
+if RangeCheck returns false.  The input must be valid to Tab from the view.
+There's no attempt made to stop moving to another view with the mouse.
+
+
+FUNCTION Valid(Cmd : Word) : Boolean; virtual;
+
+if TInputline.Valid is true and Cmd is neither cmValid or cmCancel, Valid
+then calls RangeCheck.  If RangeCheck is false, then Error is called and
+Valid returns False.
+
+----*)
+
+{$i platform.inc}
+
+{$ifdef PPC_FPC}
+  {$H-}
+{$else}
+  {$F+,O+,E+,N+}
+{$endif}
+{$X+,R-,I-,Q-,V-}
+{$ifndef OS_LINUX}
+  {$S-}
+{$endif}
+
+Interface
+uses Objects, Drivers, Views, Dialogs, MsgBox;
+
+{flags for TInputLong constructor}
+const
+  ilHex = 1;          {will enable hex input with leading '$'}
+  ilBlankEqZero = 2;  {No input (blank) will be interpreted as '0'}
+  ilDisplayHex = 4;   {Number displayed as hex when possible}
+Type
+  TInputLong = Object(TInputLine)
+    ILOptions : Word;
+    LLim, ULim : LongInt;
+    constructor Init(var R : TRect; AMaxLen : Sw_Integer;
+        LowerLim, UpperLim : LongInt; Flgs : Word);
+    constructor Load(var S : TStream);
+    procedure Store(var S : TStream);
+    FUNCTION DataSize : Sw_Word; virtual;
+    PROCEDURE GetData(var Rec); virtual;
+    PROCEDURE SetData(var Rec); virtual;
+    FUNCTION RangeCheck : Boolean; virtual;
+    PROCEDURE Error; virtual;
+    PROCEDURE HandleEvent(var Event : TEvent); virtual;
+    FUNCTION Valid(Cmd : Word) : Boolean; virtual;
+    end;
+  PInputLong = ^TInputLong;
+
+const
+  RInputLong : TStreamRec = (
+    ObjType: 711;
+    VmtLink: Ofs(Typeof(TInputLong)^);
+    Load : @TInputLong.Load;
+    Store : @TInputLong.Store);
+
+Implementation
+
+uses
+  FVConsts;
+
+{-----------------TInputLong.Init}
+constructor TInputLong.Init(var R : TRect; AMaxLen : Sw_Integer;
+        LowerLim, UpperLim : LongInt; Flgs : Word);
+begin
+if not TInputLine.Init(R, AMaxLen) then fail;
+ULim := UpperLim;
+LLim := LowerLim;
+if Flgs and ilDisplayHex <> 0 then Flgs := Flgs or ilHex;
+ILOptions := Flgs;
+if ILOptions and ilBlankEqZero <> 0 then Data^ := '0';
+end;
+
+{-------------------TInputLong.Load}
+constructor TInputLong.Load(var S : TStream);
+begin
+TInputLine.Load(S);
+S.Read(ILOptions, Sizeof(ILOptions)+Sizeof(LLim)+Sizeof(ULim));
+end;
+
+{-------------------TInputLong.Store}
+procedure TInputLong.Store(var S : TStream);
+begin
+TInputLine.Store(S);
+S.Write(ILOptions, Sizeof(ILOptions)+Sizeof(LLim)+Sizeof(ULim));
+end;
+
+{-------------------TInputLong.DataSize}
+FUNCTION TInputLong.DataSize:Sw_Word;
+begin
+DataSize := Sizeof(LongInt);
+end;
+
+{-------------------TInputLong.GetData}
+PROCEDURE TInputLong.GetData(var Rec);
+var code : Integer;
+begin
+Val(Data^, LongInt(Rec), code);
+end;
+
+FUNCTION Hex2(B : Byte) : String;
+Const
+  HexArray : array[0..15] of char = '0123456789ABCDEF';
+begin
+Hex2[0] := #2;
+Hex2[1] := HexArray[B shr 4];
+Hex2[2] := HexArray[B and $F];
+end;
+
+FUNCTION Hex4(W : Word) : String;
+begin Hex4 := Hex2(Hi(W))+Hex2(Lo(W)); end;
+
+FUNCTION Hex8(L : LongInt) : String;
+begin Hex8 := Hex4(LongRec(L).Hi)+Hex4(LongRec(L).Lo); end;
+
+function FormHexStr(L : LongInt) : String;
+var
+  Minus : boolean;
+  S : string[20];
+begin
+Minus := L < 0;
+if Minus then L := -L;
+S := Hex8(L);
+while (Length(S) > 1) and (S[1] = '0') do Delete(S, 1, 1);
+S := '$' + S;
+if Minus then System.Insert('-', S, 2);
+FormHexStr := S;
+end;
+
+{-------------------TInputLong.SetData}
+PROCEDURE TInputLong.SetData(var Rec);
+var
+  L : LongInt;
+  S : string;
+begin
+L := LongInt(Rec);
+if L > ULim then L := ULim
+else if L < LLim then L := LLim;
+if ILOptions and ilDisplayHex <> 0 then
+  S := FormHexStr(L)
+else
+  Str(L : -1, S);
+if Length(S) > MaxLen then S[0] := chr(MaxLen);
+Data^ := S;
+end;
+
+{-------------------TInputLong.RangeCheck}
+FUNCTION TInputLong.RangeCheck : Boolean;
+var
+  L : LongInt;
+  code : Integer;
+begin
+if (Data^ = '') and (ILOptions and ilBlankEqZero <> 0) then
+  Data^ := '0';
+Val(Data^, L, code);
+RangeCheck := (Code = 0) and (L >= LLim) and (L <= ULim);
+end;
+
+{-------------------TInputLong.Error}
+PROCEDURE TInputLong.Error;
+var
+  SU, SL : string[40];
+  PMyLabel : PLabel;
+  Labl : string;
+  I : Integer;
+
+  function FindIt(P : PView) : boolean;{$ifdef PPC_BP}far;{$endif}
+  begin
+  FindIt := (Typeof(P^) = Typeof(TLabel)) and (PLabel(P)^.Link = PView(@Self));
+  end;
+
+begin
+Str(LLim : -1, SL);
+Str(ULim : -1, SU);
+if ILOptions and ilHex <> 0 then
+  begin
+  SL := SL+'('+FormHexStr(LLim)+')';
+  SU := SU+'('+FormHexStr(ULim)+')';
+  end;
+if Owner <> Nil then
+  PMyLabel := PLabel(Owner^.FirstThat(@FindIt))
+else PMyLabel := Nil;
+if PMyLabel <> Nil then PMyLabel^.GetText(Labl)
+else Labl := '';
+if Labl <> '' then
+  begin
+  I := Pos('~', Labl);
+  while I > 0 do
+    begin
+    System.Delete(Labl, I, 1);
+    I := Pos('~', Labl);
+    end;
+  Labl := '"'+Labl+'"';
+  end;
+MessageBox(Labl + ^M^J'Value not within range '+SL+' to '+SU, Nil,
+                            mfError+mfOKButton);
+end;
+
+{-------------------TInputLong.HandleEvent}
+PROCEDURE TInputLong.HandleEvent(var Event : TEvent);
+begin
+if (Event.What = evKeyDown) then
+  begin
+    case Event.KeyCode of
+       kbTab, kbShiftTab
+          : if not RangeCheck then
+              begin
+              Error;
+              SelectAll(True);
+              ClearEvent(Event);
+              end;
+      end;
+  if Event.CharCode <> #0 then  {a character key}
+    begin
+    Event.Charcode := Upcase(Event.Charcode);
+    case Event.Charcode of
+      '0'..'9', #1..#$1B : ;       {acceptable}
+
+      '-'       : if (LLim >= 0) or (CurPos <> 0) then
+                        ClearEvent(Event);
+      '$'       : if ILOptions and ilHex = 0 then ClearEvent(Event);
+      'A'..'F'  : if Pos('$', Data^) = 0 then ClearEvent(Event);
+
+      else ClearEvent(Event);
+      end;
+    end;
+  end;
+TInputLine.HandleEvent(Event);
+end;
+
+{-------------------TInputLong.Valid}
+FUNCTION TInputLong.Valid(Cmd : Word) : Boolean;
+var
+  Rslt : boolean;
+begin
+Rslt := TInputLine.Valid(Cmd);
+if Rslt and (Cmd <> 0) and (Cmd <> cmCancel) then
+  begin
+  Rslt := RangeCheck;
+  if not Rslt then
+    begin
+    Error;
+    Select;
+    SelectAll(True);
+    end;
+  end;
+Valid := Rslt;
+end;
+
+end.

+ 7 - 3
fvision/memory.pas

@@ -75,7 +75,7 @@ UNIT Memory;
 {$V-} { Turn off strict VAR strings }
 {====================================================================}
 
-USES Common;
+USES FVCommon;
 
 {***************************************************************************}
 {                            INTERFACE ROUTINES                             }
@@ -828,8 +828,12 @@ END.
 
 {
  $Log$
- Revision 1.2  2000-08-24 12:00:22  marco
+ Revision 1.3  2001-08-04 19:14:33  peter
+   * Added Makefiles
+   * added FV specific units and objects from old FV
+
+ Revision 1.2  2000/08/24 12:00:22  marco
   * CVS log and ID tags
 
 
-}
+}

+ 738 - 0
fvision/resource.pas

@@ -0,0 +1,738 @@
+{ Resource Unit
+
+  Programmer: Brad Williams
+  BitSoft Development, L.L.C.
+  Copyright (c) 1996
+  Version 1.1
+
+Revision History
+
+1.1   (12/26/97)
+  - updated to add cdResource directive so that can use standard TStringList
+    resources created by TVRW and TVDT
+
+1.0
+  - original implementation }
+
+unit Resource;
+
+interface
+
+{
+  The Resource unit provides global variables which are used to build and
+  access resource files.  InitRez must always be called before accessing any
+  variables in the Resource unit.  The programmer should also always call
+  Done to free all file handles allocated to the program.
+}
+
+{$i platform.inc}
+
+{$ifdef PPC_FPC}
+  {$H-}
+{$else}
+  {$F+,O+,E+,N+}
+{$endif}
+{$X+,R-,I-,Q-,V-}
+{$ifndef OS_LINUX}
+  {$S-}
+{$endif}
+
+uses
+
+  FVConsts, Objects, Dos;
+
+const
+
+  RezExt: ExtStr = '.RES';
+    { The file extension used on all resource files. }
+  RezBufferSize: Word = 4096;
+    { RezBufferSize is the number of bytes to use for the resource file's
+      stream's buffer.  RezBufferSize is passed to TBufStream.Init. }
+
+    { reXXXX constants are used with resource files to retrieve the standard
+      Free Vision dialogs.  The constant is followed by the Unit in which it
+      is used and the resource which is stored separated by a period. }
+
+  reChDirDialog = 'ChDirDialog';  { StdDlg.TChDirDialog }
+  reEditChDirDialog = 'EditChDirDialog';  { StdDlg.TEditChDirDialog }
+  reFindTextDlg = 'FindTextDlg';  { Editors.CreateFindDialog }
+  reHints = 'Hints'; { Resource.Hints }
+  reJumpLineDlg = 'JumpLineDlg';  { Editors.MakeJumpLineDlg }
+  reLabels = 'Labels';  { Resource.Labels }
+  reMenuBar = 'MenuBar';  { App.MenuBar }
+  reOpenDlg = 'OpenDlg';  { StdDlg.TFileDialog - Open }
+  reReformDocDlg = 'ReformDocDlg';  { Editors.MakeReformDocDlg }
+  reReplaceDlg = 'ReplaceDlg';  { Editors.CreateReplaceDialog }
+  reRightMarginDlg = 'RightMarginDlg';  { Editors.MakeRightMarginDlg }
+  reStatusLine = 'StatusLine';  { App.StatusLine }
+  reStrings = 'Strings';  { Resource.Strings }
+  reSaveAsDlg = 'SaveAsDlg';  { StdDlg.TFileDialog - Save As }
+  reTabStopDlg = 'TabStopDlg';  { Editors.MakeTabStopDlg }
+  reWindowListDlg = 'WindowListDlg';  { Editors.MakeWindowListDlg }
+  reAboutDlg = 'About';  { App unit about dialog }
+
+  {$I str.inc}
+    { STR.INC declares all the string list constants used in the standard
+      Free Vision library units.  They are placed in a separate file as a
+      template for use by the resource file generator, MakeRez.
+
+      Applications which use resource files and need to add strings of their
+      own should use STR.INC as the start for the resource file.
+
+      See MakeRez.PAS for more information about generating resource files.}
+
+type
+
+
+  PConstant = ^TConstant;
+  TConstant = object(TObject)
+    Value: Word;
+      { The value assigned to the constant. }
+    constructor Init (AValue: Word; AText: string);
+      { Init assigns AValue to Value to AText to Text.  AText may be an empty
+        string.
+
+        If an error occurs Init fails. }
+    destructor Done; virtual;
+      { Done disposes of Text then calls the inherited destructor. }
+    procedure SetText (AText: string);
+      { SetText changes FText to the word equivalent of AText. }
+    procedure SetValue (AValue: string);
+      { SetValue changes Value to the word equivalent of AValue. }
+    function Text: string;
+      { Text returns a string equivalent to FText.  If FText is nil, an
+        empty string is returned. }
+    function ValueAsString: string;
+      { ValueAsString returns the string equivalent of Value. }
+      private
+    FText: PString;
+      { The text to display for the constant. }
+  end;  { of TConstant }
+
+
+  PMemStringList = ^TMemStringList;
+  TMemStringList = object(TSortedCollection)
+    { A TMemStringList combines the functions of a TStrListMaker and a
+      TStringList into one object, allowing generation and use of string
+      lists in the same application.  TMemStringList is fully compatible
+      with string lists created using TStrListMaker, so legacy applications
+      will work without problems.
+
+      When using a string list in the same program as it is created, a
+      resource file is not required.  This allows language independant coding
+      of units without the need for conditional defines and recompiling. }
+    constructor Init;
+      { Creates an empty, in-memory string list that is not associated with a
+        resource file. }
+    constructor Load (var S: TStream);
+      { Load creates a TStringList from which it gets its strings upon a call
+        to Get.  The strings on the resource file may be loaded into memory
+        for editing by calling LoadList.
+
+        If initialized with Load, the stream must remain valid for the life
+        of this object. }
+    destructor Done; virtual;
+      { Done deallocates the memory allocated to the string list. }
+    function Compare (Key1, Key2: Pointer): Sw_Integer; virtual;
+      { Compare assumes Key1 and Key2 are Word values and returns:
+
+            -1  if Key1 < Key2
+             0  if Key1 = Key2
+             1  if Key1 > Key2 }
+    function Get (Key: Word): String; virtual;
+      { GetKey searches for a string with a key matching Key and returns it.
+        An empty string is returned if a string with a matching Key is not
+        found.
+
+        If Count > 0, the in memory collection is searched.  If List^.Count
+        is 0, the inherited Get method is called. }
+    procedure Insert (Item: Pointer); virtual;
+      { If Item is not nil, Insert attempts to insert the item into the
+        collection.  If a collection expansion error occurs Insert disposes
+        of Item by calling FreeItem.
+
+        Item must be a pointer to a TConstant or its descendant. }
+    function KeyOf (Item: Pointer): Pointer; virtual;
+      { KeyOf returns a pointer to TConstant.Value. }
+    function LoadStrings: Sw_Integer;
+      { LoadStrings reads all strings the associated resource file into
+        memory, places them in the collection, and returns 0.
+
+        If an error occurs LoadStrings returns the stream status error code
+        or a DOS error code.  Possible DOS error codes include:
+
+               2:   no associated resource file
+               8:   out of memory }
+    function NewConstant (Value: Word; S: string): PConstant; virtual;
+      { NewConstant is called by LoadStrings. }
+    procedure Put (Key: Word; S: String); virtual;
+      { Put creates a new PConstant containing Key and Word then calls
+        Insert to place it in the collection. }
+    procedure Store (var S: TStream);
+      { Store creates a TStrListMaker, fills it with the items in List,
+        writes the TStrListMaker to the stream by calling
+        TStrListMaker.Store, then disposes of the TStrListMaker. }
+  private
+    StringList: PStringList;
+  end;  { of TMemStringList) }
+
+
+var
+
+  {$ifdef cdResource}
+  Hints: PStringList;
+  {$else}
+  Hints: PMemStringList;
+  {$endif cdResource}
+    { Hints is a string list for use within the application to provide
+      context sensitive help on the command line.  Hints is always used in
+      the application. }
+
+  {$ifdef cdResource}
+  Strings: PStringList;
+  {$else}
+  Strings: PMemStringList;
+  {$endif cdResource}
+    { Strings holds messages such as errors and general information that are
+      displayed at run-time, normally with MessageBox.  Strings is always
+      used in the application. }
+
+  {$ifdef cdResource}
+  Labels: PStringList;
+  {$else}
+  Labels: PMemStringList;
+  {$endif cdResource}
+    { Labels is a string list for use within the application when a
+      resource file is not used, or when creating a resource file.  Labels
+      contains all text used in dialog titles, labels, buttons, menus,
+      statuslines, etc., used in the application which can be burned into
+      language specific resources.  It does not contain any messages
+      displayed at run-time using MessageBox or the status line hints.
+
+      Using the Labels variable when creating views allows language
+      independant coding of views such as the MessageBox, StdDlg and Editors
+      units. }
+
+  RezFile: PResourceFile;
+    { RezFile is a global variable used when the Free Vision library
+      is compiled using the cdResource conditional define, or when creating
+      resource files.
+
+      All standard Free Vision application resources are accessed from the
+      resource file using the reXXXX constants.  Modify the STR.INC under a
+      new file name to create new language specific resource files.  See the
+      MakeRez program file for more information. }
+
+
+
+procedure DoneResource;
+  { Done destructs all objects initialized in this unit and frees all
+    allocated heap. }
+
+{$ifndef cdResource}
+function InitResource: Boolean;
+{$endif cdResource}
+  { Init initializes the Hints and Strings for use with in memory strings
+    lists.  Init should be used in applications which do not use a resource
+    file, or when creating resource files.  }
+
+{$ifdef cdResource}
+function InitRezFile (AFile: FNameStr; Mode: Word;
+                      var AResFile: PResourceFile): Sw_Integer;
+{$endif cdResource}
+  { InitRezFile initializes a new PResourceFile using the name passed in
+    AFile and the stream mode passed in Mode and returns 0.
+
+    If an error occurs InitRezFile returns the DOS error and AResFile is
+    invalid.  Possible DOS error values include:
+
+        2: file not found or other stream initialization error
+        11: invalid format - not a valid resource file }
+
+{$ifdef cdResource}
+function LoadResource (AFile: FNameStr): Boolean;
+{$endif cdResource}
+  { Load is used to open a resource file for use in the application.
+
+    For Load to return True, the resource file must be properly opened and
+    assigned to RezFile and the Hints string list must be successfully loaded
+    from the stream.  If an error occurs, Load displays an English error
+    message using PrintStr and returns False. }
+
+function MergeLists (Source, Dest: PMemStringList): Sw_Integer;
+  { MergeLists moves all key/string pairs from Source to destination,
+    deleting them from Source.  Duplicate strings are ignored. }
+
+
+const
+  RMemStringList: TStreamRec = (
+    ObjType: idMemStringList;
+    VmtLink: Ofs(TypeOf(TMemStringList)^);
+    Load: @TMemStringList.Load;
+    Store: @TMemStringList.Store);
+
+
+implementation
+
+{****************************************************************************}
+{                           Private Declarations                             }
+{****************************************************************************}
+
+uses
+  Memory, Drivers;
+
+{****************************************************************************}
+{ TConstant object                                                           }
+{****************************************************************************}
+{****************************************************************************}
+{ TConstant.Init                                                             }
+{****************************************************************************}
+constructor TConstant.Init (AValue: Word; AText: string);
+begin
+  if not inherited Init then
+    Fail;
+  Value := AValue;
+  FText := NewStr(AText);
+  if (FText = nil) and (AText <> '') then
+  begin
+    inherited Done;
+    Fail;
+  end;
+end;
+
+{****************************************************************************}
+{ TConstant.Done                                                             }
+{****************************************************************************}
+destructor TConstant.Done;
+begin
+  DisposeStr(FText);
+  inherited Done;
+end;
+
+{****************************************************************************}
+{ TConstant.SetText                                                          }
+{****************************************************************************}
+procedure TConstant.SetText (AText: string);
+begin
+  DisposeStr(FText);
+  FText := NewStr(AText);
+end;
+
+{****************************************************************************}
+{ TConstant.SetValue                                                         }
+{****************************************************************************}
+procedure TConstant.SetValue (AValue: string);
+var
+  N: Word;
+  ErrorCode: Integer;
+begin
+  Val(AValue,N,ErrorCode);
+  if ErrorCode = 0 then
+    Value := N;
+end;
+
+{****************************************************************************}
+{ TConstant.Text                                                             }
+{****************************************************************************}
+function TConstant.Text: string;
+begin
+  if (FText = nil) then
+    Text := ''
+  else Text := FText^;
+end;
+
+{****************************************************************************}
+{ TConstant.ValueAsString                                                    }
+{****************************************************************************}
+function TConstant.ValueAsString: string;
+var
+  S: string[5];
+begin
+  Str(Value,S);
+  ValueAsString := S;
+end;
+
+{****************************************************************************}
+{ TMemStringList Object                                                      }
+{****************************************************************************}
+{****************************************************************************}
+{ TMemStringList.Init                                                        }
+{****************************************************************************}
+constructor TMemStringList.Init;
+begin
+  if not inherited Init(10,10) then
+    Fail;
+  StringList := nil;
+end;
+
+{****************************************************************************}
+{ TMemStringList.Load                                                        }
+{****************************************************************************}
+constructor TMemStringList.Load (var S: TStream);
+begin
+  if not inherited Init(10,10) then
+    Fail;
+  StringList := New(PStringList,Load(S));
+end;
+
+{****************************************************************************}
+{ TMemStringList.Done                                                        }
+{****************************************************************************}
+destructor TMemStringList.Done;
+begin
+  if (StringList <> nil) then
+    Dispose(StringList,Done);
+  inherited Done;
+end;
+
+{****************************************************************************}
+{ TMemStringList.Compare                                                     }
+{****************************************************************************}
+function TMemStringList.Compare (Key1, Key2: Pointer): Sw_Integer;
+begin
+  if Word(Key1^) < Word(Key2^) then
+    Compare := -1
+  else Compare := Byte(Word(Key1^) > Word(Key2^));
+end;
+
+{****************************************************************************}
+{ TMemStringList.Get                                                         }
+{****************************************************************************}
+function TMemStringList.Get (Key: Word): string;
+var
+  i: Sw_Integer;
+  S: string;
+begin
+  if (StringList = nil) then
+  begin  { started with Init, use in memory string list }
+    if Search(@Key,i) then
+      Get := PConstant(At(i))^.Text
+    else Get := '';
+  end
+  else begin
+    S := StringList^.Get(Key);
+    Get := S;
+  end;
+end;
+
+{****************************************************************************}
+{ TMemStringList.Insert                                                      }
+{****************************************************************************}
+procedure TMemStringList.Insert (Item: Pointer);
+var
+  i: Sw_Integer;
+begin
+  if (Item <> nil) then
+  begin
+    i := Count;
+    inherited Insert(Item);
+    if (i = Count) then  { collection expansion failed }
+      Dispose(PConstant(Item),Done);
+  end;
+end;
+
+{****************************************************************************}
+{ TMemStringList.KeyOf                                                       }
+{****************************************************************************}
+function TMemStringList.KeyOf (Item: Pointer): Pointer;
+begin
+  KeyOf := @(PConstant(Item)^.Value);
+end;
+
+{****************************************************************************}
+{ TMemStringList.LoadStrings                                                 }
+{****************************************************************************}
+function TMemStringList.LoadStrings: Sw_Integer;
+  procedure MakeEditableString (var Str: string);
+  const
+    SpecialChars: array[1..3] of Char = #3#10#13;
+  var
+    i, j: Byte;
+  begin
+    for i := 1 to 3 do
+      while (Pos(SpecialChars[i],Str) <> 0) do
+      begin
+        j := Pos(SpecialChars[i],Str);
+        System.Delete(Str,j,1);
+        case i of
+          1: System.Insert('#3',Str,j);
+          2: System.Insert('#10',Str,j);
+          3: System.Insert('#13',Str,j);
+        end;
+      end;
+  end;
+var
+  Constant: PConstant;
+  i: Word;
+  S: string;
+begin
+  LoadStrings := 0;
+  if (StringList = nil) then
+  begin
+    LoadStrings := 2;
+    Exit;
+  end;
+  for i := 0 to 65535 do
+  begin
+    S := StringList^.Get(i);
+    if (S <> '') then
+    begin
+      MakeEditableString(S);
+      Constant := NewConstant(i,S);
+      if LowMemory then
+      begin
+        if (Constant <> nil) then
+          Dispose(Constant,Done);
+        LoadStrings := 8;  { out of memory }
+        Exit;
+      end;
+      Insert(Constant);
+    end;
+  end;
+end;
+
+{****************************************************************************}
+{ TMemStringList.NewConstant                                                 }
+{****************************************************************************}
+function TMemStringList.NewConstant (Value: Word; S: string): PConstant;
+begin
+  NewConstant := New(PConstant,Init(Value,S));
+end;
+
+{****************************************************************************}
+{ TMemStringList.Put                                                         }
+{****************************************************************************}
+procedure TMemStringList.Put (Key: Word; S: string);
+begin
+  Insert(New(PConstant,Init(Key,S)));
+end;
+
+{****************************************************************************}
+{ TMemStringList.Store                                                       }
+{****************************************************************************}
+procedure TMemStringList.Store (var S: TStream);
+var
+  StrList: PStrListMaker;
+  Size: Word;
+  procedure Total (Constant: PConstant);{$ifndef FPC}far;{$endif}
+  begin
+    with Constant^ do
+      Inc(Size,Succ(Length(Text)));
+  end;
+  procedure AddString (Constant: PConstant);{$ifndef FPC}far;{$endif}
+  const
+    Numbers = ['0'..'9'];
+  var
+    i, j: Byte;
+    N: Byte;
+    ErrorCode: Integer;
+    S: string;
+  begin
+    with Constant^ do
+    begin
+        { convert formatting characters }
+      S := Text;
+      while (Pos('#',S) <> 0) do
+      begin
+        i := Succ(Pos('#',S));
+        j := i;
+        if (Length(S) > j) then
+          Inc(j,Byte(S[Succ(j)] in Numbers));
+        Val(Copy(S,i,j-i+1),N,ErrorCode);
+        System.Delete(S,Pred(i),j-i+2);
+        System.Insert(Char(N),S,Pred(i));
+      end;
+      StrList^.Put(Value,Text)
+    end;
+  end;
+begin
+  Size := 0;
+  ForEach(@Total);
+  StrList := New(PStrListMaker,Init(Size,Count * 6));
+  if (StrList = nil) then
+  begin
+    S.Status := 8;  { DOS error not enough memory }
+    Exit;
+  end;
+  ForEach(@AddString);
+  StrList^.Store(S);
+  Dispose(StrList,Done);
+end;
+
+{****************************************************************************}
+{                       Public Procedures and Functions                      }
+{****************************************************************************}
+
+{****************************************************************************}
+{ Done                                                                       }
+{****************************************************************************}
+procedure DoneResource;
+begin
+  if (RezFile <> nil) then
+    begin
+      Dispose(RezFile,Done);
+      RezFile:=nil;
+    end;
+  if (Strings <> nil) then
+    begin
+      Dispose(Strings,Done);
+      Strings:=nil;
+    end;
+  if (Hints <> nil) then
+    begin
+      Dispose(Hints,Done);
+      Hints:=nil;
+    end;
+  if (Labels <> nil) then
+    begin
+      Dispose(Labels,Done);
+      Labels:=nil;
+    end;
+end;
+
+{****************************************************************************}
+{ Init                                                                       }
+{****************************************************************************}
+{$ifndef cdResource}
+
+{$I strtxt.inc}
+  { strtxt.inc contains the real strings and procedures InitRes... which
+    is converted from str.inc }
+
+function InitResource: Boolean;
+begin
+  InitResource := False;
+  Hints := New(PMemStringList,Init);
+  if (Hints = nil) then
+  begin
+    PrintStr('Fatal error.  Could not create Hints list.');
+    Exit;
+  end;
+  Strings := New(PMemStringList,Init);
+  if (Strings = nil) then
+  begin
+    DoneResource;
+    Exit;
+  end;
+  Labels := New(PMemStringList,Init);
+  if (Labels = nil) then
+  begin
+    DoneResource;
+    Exit;
+  end;
+{ now load the defaults }
+  InitResLabels;
+  InitResStrings;
+  InitResource := True;
+end;
+{$endif cdResource}
+
+{****************************************************************************}
+{ InitRezFile                                                                }
+{****************************************************************************}
+{$ifdef cdResource}
+function InitRezFile (AFile: FNameStr; Mode: Word;
+                      var AResFile: PResourceFile): Sw_Integer;
+var
+  Stream: PBufStream;
+  Result: Sw_Integer;
+begin
+  Stream := New(PBufStream,Init(AFile,Mode,RezBufferSize));
+  if (Stream = nil) then
+    Result := 2  { file not found; could also be out of memory }
+  else begin
+    AResFile := New(PResourceFile,Init(Stream));
+    if (AResFile = nil) then
+    begin
+      Dispose(Stream,Done);
+      Result := 11;
+    end
+    else Result := 0;
+  end;
+  InitRezFile := Result;
+end;
+{$endif cdResource}
+
+{****************************************************************************}
+{ Load                                                                       }
+{****************************************************************************}
+{$ifdef cdResource}
+function LoadResource (AFile: FNameStr): Boolean;
+var
+  Stream: PBufStream;
+begin
+  Load := False;
+  Stream := New(PBufStream,Init(AFile,stOpenRead,RezBufferSize));
+  if (Stream = nil) or (Stream^.Status <> 0) then
+  begin
+    Done;
+    PrintStr('Fatal error.  Could not open resource file: ' + AFile);
+    Exit;
+  end;
+  RezFile := New(PResourceFile,Init(Stream));
+  if (RezFile = nil) then
+  begin
+    Dispose(Stream,Done);
+    Done;
+    PrintStr('Fatal error.  Could not initialize resource file.');
+    Exit;
+  end;
+  Hints := PStringList(RezFile^.Get(reHints));
+  if (Hints = nil) then
+  begin
+    Done;
+    PrintStr('Fatal error.  Could not load Hints string list.');
+    Exit;
+  end;
+  Strings := PStringList(RezFile^.Get(reStrings));
+  if (Strings = nil) then
+  begin
+    Done;
+    PrintStr('Fatal error.  Could not load Strings string list.');
+    Exit;
+  end;
+  Load := True;
+end;
+{$endif cdResource}
+
+{****************************************************************************}
+{ MergeLists                                                                 }
+{****************************************************************************}
+function MergeLists (Source, Dest: PMemStringList): Sw_Integer;
+var
+  Result: Sw_Integer;
+  procedure MoveItem (Constant: PConstant);{$ifndef FPC}far;{$endif}
+  var
+    j: Sw_Integer;
+  begin
+    if (Result = 0) and (not Dest^.Search(Dest^.KeyOf(Constant),j)) then
+    begin
+      j := Dest^.Count;
+      Dest^.Insert(Constant);
+      if (j = Dest^.Count) then
+        Result := 8
+      else Source^.Delete(Constant);
+    end;
+  end;
+begin
+  if (Source = nil) or (Dest = nil) then
+  begin
+    MergeLists := 6;
+    Exit;
+  end;
+  Result := 0;
+  Source^.ForEach(@MoveItem);
+  MergeLists := Result;
+end;
+
+{****************************************************************************}
+{                            Unit Initialization                             }
+{****************************************************************************}
+
+begin
+  RezFile := nil;
+  Hints := nil;
+  Strings := nil;
+  Labels := nil;
+end.
+

+ 1402 - 0
fvision/statuses.pas

@@ -0,0 +1,1402 @@
+{$V-}
+unit Statuses;
+
+{#Z+}
+{  Free Vision Status Objects Unit
+   Free VIsion
+   Written by : Brad Williams, DVM
+
+Revision History
+
+1.2.3   (96/04/13)
+  - moved Pause and Resume to methods of TStatus leaving TStatus Pause and
+    Resume "aware"
+  - eliminated many bugs
+  - moved Pause, Resume and Cancel from TStatusDlg to TStatus
+
+1.2.1    (95/12/6)
+   - minor typo corrections in opening unit documentation
+   - F+ to Z+ around stream registration records
+   - removed redundant sentence in TAppStatus definition
+   - updated CBarStatus documentation and constant
+   - removed TGauge.Init cross-reference from TSpinner.Init
+   - added THeapMemAvail and RegistertvStatus documentation
+   - numerous other documentation updates
+   - changed all calls to Send to Message
+
+1.2.0    (95/11/24)
+   - conversion to Bsd format
+
+1.1.0    (05/01/94)
+   - initial WVS release
+
+
+Known Bugs
+
+ScanHelp Errors
+   - sdXXXX constants help documentation doesn't show TStatusDlg and
+     TMessageStatusDlg
+   - ScanHelp produces garbage in evStatus help context
+
+tvStatus Bugs
+   - CAppStatus may not be correct }
+{#Z-}
+
+{ The tvStatus unit implements several views for providing information to
+the user which needs to be updated during program execution, such as a
+progress indicator, clock, heap viewer, gauges, etc.  All tvStatus views
+respond to a new message event class, evStatus.  An individual status view
+only processes an event with its associated command. }
+
+interface
+
+{$i platform.inc}
+
+{$ifdef PPC_FPC}
+  {$H-}
+{$else}
+  {$F+,O+,E+,N+}
+{$endif}
+{$X+,R-,I-,Q-,V-}
+{$ifndef OS_LINUX}
+  {$S-}
+{$endif}
+
+uses
+
+  ObjTypes, Objects, Drivers, Views, Dialogs,
+  Resource;
+
+const
+
+  evStatus = $8000;
+    { evStatus represents the event class all status views know how to
+      respond to. }
+    {#X Statuses }
+
+
+  CStatus    =  #1#2#3;
+{$ifndef cdPrintDoc}
+{#F+}
+{ÝTStatus.CStatus palette
+ßßßßßßßßßßßßßßßßßßßßßßßßß}
+{#F-}
+{$endif cdPrintDoc}
+{ Status views use the default palette, CStatus, to map onto the first three
+entries in the standard window palette. }
+{#F+}
+{              1    2    3
+           ÉÍÍÍÍÑÍÍÍÍÑÍÍÍÍ»
+ CStatus   º  1 ³  2 ³  3 º
+           ÈÍÍÑÍÏÍÍÑÍÏÍÍÑͼ
+Normal TextÄÄÄÙ    ³    ³
+OtherÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ    ³
+Highlighted TextÄÄÄÄÄÄÄÄÙ }
+{#F-}
+{#X TStatus }
+
+  CAppStatus =  #2#5#4;
+{$ifndef cdPrintDoc}
+{#F+}
+{ÝTAppStatus.CAppStatus palette
+ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß}
+{#F-}
+{$endif cdPrintDoc}
+{ Status views which are inserted into the application rather than a dialog
+or window use the default palette, CAppStatus, to map onto the application
+object's palette. }
+{#F+}
+{                 1    2    3
+              ÉÍÍÍÍÑÍÍÍÍÑÍÍÍÍ»
+ CAppStatus   º  2 ³  5 ³  4 º
+              ÈÍÍÑÍÏÍÍÑÍÏÍÍÑͼ
+Normal TextÄÄÄÄÄÄÙ    ³    ³
+OtherÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ    ³
+Highlighted TextÄÄÄÄÄÄÄÄÄÄÄÙ }
+{#F-}
+    {#X tvStatus TAppStatus }
+
+
+  CBarGauge = CStatus + #16#19;
+{$ifndef cdPrintDoc}
+{#F+}
+{ÝTBarGauge.CBarGauge palette
+ßßßßßßßßßßßßßßßßßßßßßßßßßßßßß}
+{#F-}
+{$endif cdPrintDoc}
+{ TBarGauge's use the default palette, CBarGauge, to map onto the dialog or
+window owner's palette. }
+{#F+}
+{                 1    2    3   4    5
+              ÉÍÍÍÍÑÍÍÍÍÑÍÍÍÍÑÍÍÍÍÑÍÍÍÍ»
+ CAppStatus   º  2 ³  5 ³  4 ³ 16 ³ 19 º
+              ÈÍÍÑÍÏÍÍÑÍÏÍÍÑÍÏÍÍÑÍÏÍÍÑͼ
+Normal TextÄÄÄÄÄÄÙ    ³    ³    ³    ÀÄÄÄÄ filled in bar
+OtherÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ    ³    ÀÄÄÄÄÄÄÄÄÄ empty bar
+Highlighted TextÄÄÄÄÄÄÄÄÄÄÄÙ }
+{#F-}
+    {#X tvStatus TBarGauge }
+
+
+{#T sdXXXX }
+{$ifndef cdPrintDoc}
+{#F+}
+{ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ
+Ý sdXXXX constants   (STDDLG unit) Þ
+ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß}
+{#F-}
+{$endif cdNoPrintDoc}
+{ sdXXXX constants are used to determine the types of buttons displayed in a
+#TStatusDlg# or #TStatusMessageDlg#. }
+{#F+}
+{    Constant      ³ Value ³ Meaning
+ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍØÍÍÍÍÍÍÍØÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ
+  sdNone          ³ $0000 ³ no buttons
+  sdCancelButton  ³ $0001 ³ show Cancel button
+  sdPauseButton   ³ $0002 ³ show Pause button
+  sdResumeButton  ³ $0004 ³ show Resume button
+  sdAllButtons    ³ $0008 ³ show Cancel, Pause and Resume
+                  ³       ³   buttons }
+{#Z+}
+  sdNone                 = $0000;
+  sdCancelButton         = $0001;
+  sdPauseButton          = $0002;
+  sdResumeButton         = $0004;
+  sdAllButtons           = sdCancelButton or sdPauseButton or sdResumeButton;
+{#Z-}
+  {#X tvStatus TStatusDlg TStatusMessageDlg }
+
+  SpinChars : String[4] = '³/Ä\';
+    { SpinChars are the characters used by a #TSpinnerGauge# when it is drawn.
+      Only one character is displayed at a time.  The string is cycled
+      through then started over again until the view is disposed. }
+    {#X tvStatus }
+
+  sfPause = $F000;
+    { sfPause is an additional state flag used internally by status views to
+      indicate they are in a paused state and should not respond to their
+      command. }
+
+type
+  {#Z+}
+  PStatus = ^TStatus;
+  {#Z-}
+  TStatus = Object(TParamText)
+    { TStatus is the base object type from which all status views descend.
+      Status views are used to display information that will change at
+      run-time based upon some state or process in the application, such as
+      printing.
+
+      All status views that are to be inserted into the application should
+      descend from #TAppStatus# for proper color mapping. }
+    Command : Word;
+      { Command is the only command the status view will respond to.  When
+        the status view receives an evStatus event it checks the value of the
+        Event.Command field against Command before handling the event. }
+      {#X HandleEvent }
+    constructor Init (R : TRect; ACommand : Word; AText : String;
+                      AParamCount : Integer);
+      { Init calls the inherited constructor then sets #Command# to ACommand.
+
+        If an error occurs Init fails. }
+      {#X Load }
+    constructor Load (var S : TStream);
+      { Load calls the inherited constructor then reads #Command# from the
+        stream.
+
+        If an error occurs Load fails. }
+      {#X Store Init }
+    function Cancel : Boolean; virtual;
+      { Cancel should prompt the user when necessary for validation of
+        canceling the process which the status view is displaying.  If the
+        user elects to continue the process Cancel must return False,
+        otherwise Cancel must return True. }
+      {#X Pause Resume }
+    function GetPalette : PPalette; virtual;
+      { GetPalette returns a pointer to the default status view palette,
+        #CStatus#. }
+      {#X TAppStatus CAppStatus }
+    procedure HandleEvent (var Event : TEvent); virtual;
+      { HandleEvent captures any #evStatus# messages with its command value
+        equal to #Command#, then calls #Update# with Data set to
+        Event.InfoPtr.  If the State field has its #sfPause# bit set, the
+        view ignores the event. }
+    procedure Pause; virtual;
+      { Pause sends an evStatus message to the application with Event.Command
+        set to cmStatusPause and Event.InfoPtr set to #Status#^.Command.  The
+        #Status# view's sfPause bit of the State flag is set by calling
+        SetState.  In the paused state, the status view does not respond to
+        its associated command. }
+      {#X Resume sdXXXX Cancel }
+    procedure Reset; virtual;
+      { Reset causes the status view to be reset to its beginning or default
+        value, then be redrawn.  Reset is used after an event is aborted
+        which can only be performed in its entirety. }
+    procedure Resume; virtual;
+      { Resume is called in response to pressing the Resume button.  Resume
+        sends an evStatus message to the application with Event.Command set
+        to cmStatusPause and Event.InfoPtr set to #Status#^.Command.  The
+        Status view's sfPause bit is turned off by calling SetState. }
+      {#X Pause sdXXXX Cancel }
+    procedure Store (var S : TStream); virtual;
+      { Store calls the inherited Store method then writes #Command# to the
+        stream. }
+      {#X Load }
+    procedure Update (Data : Pointer); virtual;
+      { Update changes the status' displayed text as necessary based on
+        Data. }
+      {#X Command HandleEvent }
+  end;  { of TStatus }
+
+
+  {#Z+}
+  PStatusDlg = ^TStatusDlg;
+  {#Z-}
+  TStatusDlg = Object(TDialog)
+    { A TStatusDlg displays a status view and optional buttons.  It may be
+      used to display any status message and optionally provide end user
+      cancelation or pausing of an ongoing operation, such as printing.
+
+      All status views that are to be inserted into a window or dialog should
+      descend from #TStatus# for proper color mapping. }
+    Status : PStatus;
+      { Status is the key status view for the dialog.  When a cmStatusPause
+        command is broadcast in response to pressing the pause button,
+        Event.InfoPtr is set to point to the command associated with Status. }
+      {#X TStatus cmXXXX }
+    constructor Init (ATitle : TTitleStr; AStatus : PStatus; AFlags : Word);
+      { Init calls the inherited constructor to create the dialog and sets
+        the EventMask to handle #evStatus# events.  AStatus is assigned to
+        #Status# and inserted into the dialog at position 2,2.
+
+        The dialog is anchored at AStatus^.Origin and its size is at least
+        AStatus^.Size + 2 in both dimensions.  The actual size is determined
+        by the AFlags byte.  The #sdXXXX# constants should be used to signify
+        which buttons to display.
+
+        If an error occurs Init fails. }
+      {#X TStatus.Pause TStatus.Resume }
+    constructor Load (var S : TStream);
+      { Load calls the inherited constructor then loads #Status#.
+
+        If an error occurs Load fails. }
+      {#X Store }
+    procedure Cancel (ACommand : Word); virtual;
+      { Cancel sends an evStatus message to the Application object with
+        command set to cmCancel and InfoPtr set to the calling status view's
+        command, then calls the inherited Cancel method. }
+      {#X TBSDDialog.Cancel }
+    procedure HandleEvent (var Event : TEvent); virtual;
+      { All evStatus events are accepted by the dialog and sent to each
+        subview in Z-order until cleared.
+
+        If the dialog recieves an evCommand or evBroadcast event with the
+        Command parameter set to cmCancel, HandleEvent sends an #evStatus#
+        message to the Application variable with Event.Command set to the
+        cmStatusCancel and Event.InfoPtr set to the #Status#.Command and
+        disposes of itself.
+
+        When a pause button is included, a cmStatusPause broadcast event is
+        associated with the button.  When the button is pressed a call to
+        #TStatus.Pause# results.  The status view is inactivated until it
+        receives an evStatus event with a commond of cmStatusResume and
+        Event.InfoPtr set to the status view's Command value.  When a pause
+        button is used, the application should respond to the evStatus event
+        (with Event.Command of cmStatusPause) appropriately, then dispatch a
+        cmStatusResume evStatus event when ready to resume activity. }
+      {#X TStatus.Command }
+    procedure InsertButtons (AFlags : Word); virtual;
+      { InsertButtons enlarges the dialog to the necessary size and inserts
+        the buttons specified in AFlags into the last row of the dialog. }
+    procedure Store (var S : TStream); virtual;
+      { Store calls the inherited Store method then writes #Status# to the
+        stream. }
+      {#X Load }
+  end;  { of TStatusDlg }
+
+
+  {#Z+}
+  PStatusMessageDlg = ^TStatusMessageDlg;
+  {#Z-}
+  TStatusMessageDlg = Object(TStatusDlg)
+    { A TStatusMessageDlg displays a message as static text with a status
+      view on the line below it.
+
+      All status views that are to be inserted into a window or dialog should
+      descend from #TStatus# for proper color mapping. }
+    constructor Init (ATitle : TTitleStr; AStatus : PStatus; AFlags : Word;
+                      AMessage : String);
+      { Init calls the inherited constructor then inserts a TStaticText view
+        containing AMessage at the top line of the dialog.
+
+        The size of the dialog is determined by the size of the AStatus.  The
+        dialog is anchored at AStatus^.Origin and is of at least
+        AStatus^.Size + 2 in heighth and width.  The exact width and heighth
+        are determined by AOptions.
+
+        AFlags contains flags which determine the buttons to be displayed
+        in the dialog.
+
+        If an error occurs Init fails. }
+  end;  { of TStatusMessageDlg }
+
+
+  {#Z+}
+  PGauge = ^TGauge;
+  {#Z-}
+  TGauge = Object(TStatus)
+    { A gauge is used to represent the current numerical position within a
+      range of values.  When Current equals Max a gauge dispatches an
+      #evStatus# event with the command set to cmStatusDone to the
+      Application object. }
+    Min : LongInt;
+      { Min is the minimum value which #Current# may be set to. }
+      {#X Max }
+    Max : LongInt;
+      { Max is the maximum value which #Current# may be set to. }
+      {#X Min }
+    Current : LongInt;
+      { Current is the current value represented in the gauge. }
+      {#X Max Min }
+    constructor Init (R : TRect; ACommand : Word; AMin, AMax : LongInt);
+      { Init calls the inherited constructor then sets #Min# and #Max# to
+        AMin and AMax, respectively.  #Current# is set to AMin.
+
+        If an error occurs Init fails. }
+      {#X Load }
+    constructor Load (var S : TStream);
+      { Load calls the inherited constructor then reads #Min#, #Max# and
+        #Current# from the stream.
+
+        If an error occurs Load fails. }
+      {#X Init Store }
+    procedure Draw; virtual;
+      { Draw writes the following to the screen: }
+{#F+}
+{
+Min = XXX  Max = XXX  Current = XXX }
+{#F-}
+      { where XXX are the current values of the corresponding variables. }
+    procedure GetData (var Rec); virtual;
+      { GetData assumes Rec is a #TGaugeRec# and returns the current settings
+        of the gauge. }
+      {#X SetData }
+    procedure Reset; virtual;
+      { Reset sets #Current# to #Min# then redraws the status view. }
+      {#X TStatus.Reset }
+    procedure SetData (var Rec); virtual;
+      { SetData assumes Rec is a #TGaugeRec# and sets the gauge's variables
+        accordingly. }
+      {#X GetData }
+    procedure Store (var S : TStream); virtual;
+      { Store calls the inherited Store method then writes #Min#, #Max# and
+        #Current# to the stream. }
+      {#X Load }
+    procedure Update (Data : Pointer); virtual;
+      { Update increments #Current#. }
+  end;  { of TGauge }
+
+
+  {#Z+}
+  PGaugeRec = ^TGaugeRec;
+  {#Z-}
+  TGaugeRec = record
+    { A TGaugeRec is used to set and get a #TGauge#'s variables. }
+    {#X TGauge.GetData TGauge.SetData }
+    Min, Max, Current : LongInt;
+  end;  { of TGaugeRec }
+
+
+  {#Z+}
+  PArrowGauge = ^TArrowGauge;
+  {#Z-}
+  TArrowGauge = Object(TGauge)
+    { An arrow gauge draws a progressively larger series of arrows across the
+      view.  If Right is True, the arrows are right facing, '>', and are
+      drawn from left to right.  If Right is False, the arrows are left
+      facing, '<', and are drawn from right to left. }
+    Right : Boolean;
+      { Right determines the direction of arrow used and the direction which
+        the status view is filled.  If Right is True, the arrows are right
+        facing, '>', and are drawn from left to right.  If Right is False,
+        the arrows are left facing, '<', and are drawn from right to left. }
+      {#X Draw }
+    constructor Init (R : TRect; ACommand : Word; AMin, AMax : Word;
+                      RightArrow : Boolean);
+      { Init calls the inherited constructor then sets #Right# to RightArrow.
+
+        If an error occurs Init fails. }
+      {#X Load }
+    constructor Load (var S : TStream);
+      { Load calls the inherited constructor then reads #Right# from the
+        stream.
+
+        If an error occurs Load fails. }
+      {#X Init Store }
+    procedure Draw; virtual;
+      { Draw fills the Current / Max percent of the view with arrows. }
+      {#X Right }
+    procedure GetData (var Rec); virtual;
+      { GetData assumes Rec is a #TArrowGaugeRec# and returns the current
+        settings of the views variables. }
+      {#X SetData }
+    procedure SetData (var Rec); virtual;
+      { SetData assumes Rec is a #TArrowGaugeRec# and sets the view's
+        variables accordingly. }
+      {#X GetData }
+    procedure Store (var S : TStream); virtual;
+      { Store calls the inherited Store method then writes #Right# to the
+        stream. }
+      {#X Load }
+  end;  { of TArrowGauge }
+
+
+  {#Z+}
+  PArrowGaugeRec = ^TArrowGaugeRec;
+  {#Z-}
+  TArrowGaugeRec = record
+    { A TArrowGaugeRec is used to set and get the variables of a
+      #TArrowGauge#. }
+    {#X TArrowGauge.GetData TArrowGauge.SetData }
+    Min, Max, Count : LongInt;
+    Right : Boolean;
+  end;  { of TGaugeRec }
+
+
+  {#Z+}
+  PPercentGauge = ^TPercentGauge;
+  {#Z-}
+  TPercentGauge = Object(TGauge)
+    { A TPercentGauge displays a numerical percentage as returned by
+      #Percent# followed by a '%' sign. }
+    function Percent : Integer; virtual;
+      { Percent returns the whole number value of (Current / Max) * 100. }
+      {#X TGauge.Current TGauge.Max }
+    procedure Draw; virtual;
+      { Draw writes the current percentage to the screen. }
+      {#X Percent }
+  end;  { of TPercentGauge }
+
+
+  {#Z+}
+  PBarGauge = ^TBarGauge;
+  {#Z-}
+  TBarGauge = Object(TPercentGauge)
+    { A TBarGauge displays a bar which increases in size from the left to
+      the right of the view as Current increases.  A numeric percentage
+      representing the value of (Current / Max) * 100 is displayed in the
+      center of the bar. }
+    {#x TPercentGauge.Percent }
+    procedure Draw; virtual;
+      { Draw draws the bar and percentage to the screen representing the
+        current status of the view's variables. }
+      {#X TGauge.Update }
+    function GetPalette : PPalette; virtual;
+      { GetPalette returns a pointer to the default status view palette,
+        #CBarStatus#. }
+  end;  { of TBarGauge }
+
+
+  {#Z+}
+  PSpinnerGauge = ^TSpinnerGauge;
+  {#Z-}
+  TSpinnerGauge = Object(TGauge)
+    { A TSpinnerGauge displays a series of characters in one spot on the
+      screen giving the illusion of a spinning line. }
+    constructor Init (X, Y : Integer; ACommand : Word);
+      { Init calls the inherited constructor with AMin set to 0 and AMax set
+        to 4. }
+    procedure Draw; virtual;
+      { Draw uses the #SpinChars# variable to draw the view's Current
+        character. }
+      {#X Update }
+    procedure HandleEvent (var Event : TEvent); virtual;
+      { HandleEvent calls TStatus.HandleEvent so that a cmStatusDone event
+        is not generated when Current equals Max. }
+      {#X TGauge.Current TGauge.Max }
+    procedure Update (Data : Pointer); virtual;
+      { Update increments Current until Current equals Max, when it resets
+        Current to Min. }
+      {#X Draw HandleEvent }
+  end;  { of TSpinnerGauge }
+
+
+  {#Z+}
+  PAppStatus = ^TAppStatus;
+  {#Z-}
+  TAppStatus = Object(TStatus)
+    { TAppStatus is a base object which implements color control for status
+      views that are normally inserted in the Application object. }
+    {#X TStatus }
+    function GetPalette : PPalette; virtual;
+      { GetPalette returns a pointer to the default application status view
+        palette, #CAppStatus#. }
+      {#X TStatus CStatus }
+  end;  { of TAppStatus }
+
+
+  {#Z+}
+  PHeapMaxAvail = ^THeapMaxAvail;
+  {#Z-}
+  THeapMaxAvail = Object(TAppStatus)
+    { A THeapMaxAvail displays the largest available contiguous area of heap
+      memory.  It responds to a cmStatusUpdate event by calling MaxAvail and
+      comparing the result to #Max#, then updating the view if necessary. }
+    {#X THeapMemAvail }
+    constructor Init (X, Y : Integer);
+      { Init creates the view with the following text:
+
+        MaxAvail = xxxx
+
+        where xxxx is the result returned by MaxAvail. }
+    procedure Update (Data : Pointer); virtual;
+      { Update changes #Mem# to the current MemAvail and redraws the status
+        if necessary. }
+      private
+    Max : LongInt;
+      { Max is the last reported value from MaxAvail. }
+      {#X Update }
+  end;  { of THeapMaxAvail }
+
+
+  {#Z+}
+  PHeapMemAvail = ^THeapMemAvail;
+  {#Z-}
+  THeapMemAvail = Object(TAppStatus)
+    { A THeapMemAvail displays the total amount of heap memory available to
+      the application.  It responds to a cmStatusUpdate event by calling
+      MemAvail and comparing the result to #Max#, then updating the view if
+      necessary. }
+    {#X THeapMaxAvail }
+    constructor Init (X, Y : Integer);
+      { Init creates the view with the following text:
+
+        MemAvail = xxxx
+
+        where xxxx is the result returned by MemAvail. }
+      {#X Load }
+    procedure Update (Data : Pointer); virtual;
+      { Update changes #Mem# to the current MemAvail and redraws the status
+        if necessary. }
+      private
+    Mem : LongInt;
+      { Mem is the last available value reported by MemAvail. }
+      {#X Update }
+  end;  { of THeapMemAvail }
+
+
+{$ifndef cdPrintDoc}
+{#Z+}
+{$endif cdPrintDoc}
+const
+  RStatus    : TStreamRec = (
+     ObjType : idStatus;
+     VmtLink : Ofs(TypeOf(TStatus)^);
+     Load    : @TStatus.Load;
+     Store   : @TStatus.Store);
+
+  RStatusDlg : TStreamRec = (
+     ObjType : idStatusDlg;
+     VmtLink : Ofs(TypeOf(TStatusDlg)^);
+     Load    : @TStatusDlg.Load;
+     Store   : @TStatusDlg.Store);
+
+  RStatusMessageDlg : TStreamRec = (
+     ObjType : idStatusMessageDlg;
+     VmtLink : Ofs(TypeOf(TStatusMessageDlg)^);
+     Load    : @TStatusMessageDlg.Load;
+     Store   : @TStatusMessageDlg.Store);
+
+  RGauge  : TStreamRec = (
+     ObjType : idGauge;
+     VmtLink : Ofs(TypeOf(TGauge)^);
+     Load    : @TGauge.Load;
+     Store   : @TGauge.Store);
+
+  RArrowGauge  : TStreamRec = (
+     ObjType : idArrowGauge;
+     VmtLink : Ofs(TypeOf(TArrowGauge)^);
+     Load    : @TArrowGauge.Load;
+     Store   : @TArrowGauge.Store);
+
+  RBarGauge  : TStreamRec = (
+     ObjType : idBarGauge;
+     VmtLink : Ofs(TypeOf(TBarGauge)^);
+     Load    : @TBarGauge.Load;
+     Store   : @TBarGauge.Store);
+
+  RPercentGauge  : TStreamRec = (
+     ObjType : idPercentGauge;
+     VmtLink : Ofs(TypeOf(TPercentGauge)^);
+     Load    : @TPercentGauge.Load;
+     Store   : @TPercentGauge.Store);
+
+  RSpinnerGauge  : TStreamRec = (
+     ObjType : idSpinnerGauge;
+     VmtLink : Ofs(TypeOf(TSpinnerGauge)^);
+     Load    : @TSpinnerGauge.Load;
+     Store   : @TSpinnerGauge.Store);
+
+  RAppStatus  : TStreamRec = (
+     ObjType : idAppStatus;
+     VmtLink : Ofs(TypeOf(TAppStatus)^);
+     Load    : @TAppStatus.Load;
+     Store   : @TAppStatus.Store);
+
+  RHeapMinAvail  : TStreamRec = (
+     ObjType : idHeapMinAvail;
+     VmtLink : Ofs(TypeOf(THeapMaxAvail)^);
+     Load    : @THeapMaxAvail.Load;
+     Store   : @THeapMaxAvail.Store);
+
+  RHeapMemAvail  : TStreamRec = (
+     ObjType : idHeapMemAvail;
+     VmtLink : Ofs(TypeOf(THeapMemAvail)^);
+     Load    : @THeapMemAvail.Load;
+     Store   : @THeapMemAvail.Store);
+{$ifndef cdPrintDoc}
+{#Z-}
+{$endif cdPrintDoc}
+
+procedure RegisterStatuses;
+{$ifndef cdPrintDoc}
+{#F+}
+{ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ
+ÝRegisterStatuses procedure   (Statuses unit)Þ
+ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß}
+{#F-}
+{$endif cdPrintDoc}
+  { RegisterStatuses calls RegisterType for each of the status view and
+    status dialog object types defined in the tvStatus unit.  After calling
+    RegisterStatuses, your application can read or write any of those types
+    with streams. }
+
+
+implementation
+
+uses
+  FVConsts, MsgBox, App;
+
+{****************************************************************************}
+{                    Local procedures and functions                          }
+{****************************************************************************}
+
+{****************************************************************************}
+{ TAppStatus Object                                                          }
+{****************************************************************************}
+{****************************************************************************}
+{ TAppStatus.GetPalette                                                      }
+{****************************************************************************}
+function TAppStatus.GetPalette : PPalette;
+const P : String[Length(CAppStatus)] = CAppStatus;
+begin
+  GetPalette := PPalette(@P);
+end;
+
+{****************************************************************************}
+{ TArrowGauge Object                                                         }
+{****************************************************************************}
+{****************************************************************************}
+{ TArrowGauge.Init                                                           }
+{****************************************************************************}
+constructor TArrowGauge.Init (R : TRect; ACommand : Word; AMin, AMax : Word;
+                              RightArrow : Boolean);
+begin
+  if not TGauge.Init(R,ACommand,AMin,AMax) then
+    Fail;
+  Right := RightArrow;
+end;
+
+{****************************************************************************}
+{ TArrowGauge.Load                                                           }
+{****************************************************************************}
+constructor TArrowGauge.Load (var S : TStream);
+begin
+  if not TGauge.Load(S) then
+    Fail;
+  S.Read(Right,SizeOf(Right));
+  if (S.Status <> stOk) then
+  begin
+    TGauge.Done;
+    Fail;
+  end;
+end;
+
+{****************************************************************************}
+{ TArrowGauge.Draw                                                           }
+{****************************************************************************}
+procedure TArrowGauge.Draw;
+const Arrows : array[0..1] of Char = '<>';
+var
+  B : TDrawBuffer;
+  C : Word;
+  Len : Byte;
+begin
+  C := GetColor(1);
+  Len := Round(Size.X * Current/(Max - Min));
+  MoveChar(B,' ',C,Size.X);
+  if Right then
+    MoveChar(B,Arrows[Byte(Right)],C,Len)
+  else MoveChar(B[Size.X - Len],Arrows[Byte(Right)],C,Len);
+  WriteLine(0,0,Size.X,1,B);
+end;
+
+{****************************************************************************}
+{ TArrowGauge.GetData                                                        }
+{****************************************************************************}
+procedure TArrowGauge.GetData (var Rec);
+begin
+  PArrowGaugeRec(Rec)^.Min := Min;
+  PArrowGaugeRec(Rec)^.Max := Max;
+  PArrowGaugeRec(Rec)^.Count := Current;
+  PArrowGaugeRec(Rec)^.Right := Right;
+end;
+
+{****************************************************************************}
+{ TArrowGauge.SetData                                                        }
+{****************************************************************************}
+procedure TArrowGauge.SetData (var Rec);
+begin
+  Min := PArrowGaugeRec(Rec)^.Min;
+  Max := PArrowGaugeRec(Rec)^.Max;
+  Current := PArrowGaugeRec(Rec)^.Count;
+  Right := PArrowGaugeRec(Rec)^.Right;
+end;
+
+{****************************************************************************}
+{ TArrowGauge.Store                                                          }
+{****************************************************************************}
+procedure TArrowGauge.Store (var S : TStream);
+begin
+  TGauge.Store(S);
+  S.Write(Right,SizeOf(Right));
+end;
+
+{****************************************************************************}
+{ TBarGauge Object                                                           }
+{****************************************************************************}
+{****************************************************************************}
+{ TBarGauge.Draw                                                             }
+{****************************************************************************}
+procedure TBarGauge.Draw;
+var
+  B : TDrawBuffer;
+  C : Word;
+  FillSize : Word;
+  PercentDone : LongInt;
+  S : String[4];
+begin
+  { fill entire view }
+  MoveChar(B,' ',GetColor(4),Size.X);
+  { make progress bar }
+  C := GetColor(5);
+  FillSize := Round(Size.X * (Current / Max));
+  MoveChar(B,' ',C,FillSize);
+  { display percent done }
+  PercentDone := Percent;
+  FormatStr(S,'%d%%',PercentDone);
+  if PercentDone < 50 then
+    C := GetColor(4);
+  FillSize := (Size.X - Length(S)) div 2;
+  MoveStr(B[FillSize],S,C);
+  WriteLine(0,0,Size.X,Size.Y,B);
+end;
+
+{****************************************************************************}
+{ TBarGauge.GetPalette                                                       }
+{****************************************************************************}
+function TBarGauge.GetPalette : PPalette;
+const
+  S : String[Length(CBarGauge)] = CBarGauge;
+begin
+  GetPalette := PPalette(@S);
+end;
+
+{****************************************************************************}
+{ TGauge Object                                                              }
+{****************************************************************************}
+{****************************************************************************}
+{ TGauge.Init                                                                }
+{****************************************************************************}
+constructor TGauge.Init (R : TRect; ACommand : Word; AMin, AMax : LongInt);
+begin
+  if not TStatus.Init(R,ACommand,'',1) then
+    Fail;
+  Min := AMin;
+  Max := AMax;
+  Current := Min;
+end;
+
+{****************************************************************************}
+{ TGauge.Load                                                                }
+{****************************************************************************}
+constructor TGauge.Load (var S : TStream);
+begin
+  if not TStatus.Load(S) then
+    Fail;
+  S.Read(Min,SizeOf(Min));
+  S.Read(Max,SizeOf(Max));
+  S.Read(Current,SizeOf(Current));
+  if S.Status <> stOk then
+  begin
+    TStatus.Done;
+    Fail;
+  end;
+end;
+
+{****************************************************************************}
+{ TGauge.Draw                                                                }
+{****************************************************************************}
+procedure TGauge.Draw;
+var
+  S : String;
+  B : TDrawBuffer;
+begin
+  { Blank the gauge }
+  MoveChar(B,' ',GetColor(1),Size.X);
+  WriteBuf(0,0,Size.X,Size.Y,B);
+  { write current status }
+  FormatStr(S,'%d',Current);
+  MoveStr(B,S,GetColor(1));
+  WriteBuf(0,0,Size.X,Size.Y,B);
+end;
+
+{****************************************************************************}
+{ TGauge.GetData                                                             }
+{****************************************************************************}
+procedure TGauge.GetData (var Rec);
+begin
+  TGaugeRec(Rec).Min := Min;
+  TGaugeRec(Rec).Max := Max;
+  TGaugeRec(Rec).Current := Current;
+end;
+
+{****************************************************************************}
+{ TGauge.Reset                                                               }
+{****************************************************************************}
+procedure TGauge.Reset;
+begin
+  Current := Min;
+  DrawView;
+end;
+
+{****************************************************************************}
+{ TGauge.SetData                                                             }
+{****************************************************************************}
+procedure TGauge.SetData (var Rec);
+begin
+  Min := TGaugeRec(Rec).Min;
+  Max := TGaugeRec(Rec).Max;
+  Current := TGaugeRec(Rec).Current;
+end;
+
+{****************************************************************************}
+{ TGauge.Store                                                               }
+{****************************************************************************}
+procedure TGauge.Store (var S : TStream);
+begin
+  TStatus.Store(S);
+  S.Write(Min,SizeOf(Min));
+  S.Write(Max,SizeOf(Max));
+  S.Write(Current,SizeOf(Current));
+end;
+
+{****************************************************************************}
+{ TGauge.Update                                                              }
+{****************************************************************************}
+procedure TGauge.Update (Data : Pointer);
+begin
+  if Current < Max then
+  begin
+    Inc(Current);
+    DrawView;
+  end
+  else Message(@Self,evStatus,cmStatusDone,@Self);
+end;
+
+{****************************************************************************}
+{ THeapMaxAvail Object                                                       }
+{****************************************************************************}
+{****************************************************************************}
+{ THeapMaxAvail.Init                                                         }
+{****************************************************************************}
+constructor THeapMaxAvail.Init (X, Y : Integer);
+var
+  R : TRect;
+begin
+  R.Assign(X,Y,X+20,Y+1);
+  if not TAppStatus.Init(R,cmStatusUpdate,' MaxAvail = %d',1) then
+    Fail;
+  Max := -1;
+end;
+
+{****************************************************************************}
+{ THeapMaxAvail.Update                                                       }
+{****************************************************************************}
+procedure THeapMaxAvail.Update (Data : Pointer);
+var
+  M : LongInt;
+begin
+  M := MaxAvail;
+  if (Max <> M) then
+  begin
+    Max := MaxAvail;
+    SetData(Max);
+  end;
+end;
+
+{****************************************************************************}
+{ THeapMemAvail Object                                                       }
+{****************************************************************************}
+{****************************************************************************}
+{ THeapMemAvail.Init                                                         }
+{****************************************************************************}
+constructor THeapMemAvail.Init (X, Y : Integer);
+var
+  R : TRect;
+begin
+  R.Assign(X,Y,X+20,Y+1);
+  if not TAppStatus.Init(R,cmStatusUpdate,' MemAvail = %d',1) then
+    Fail;
+  Mem := -1;
+end;
+
+{****************************************************************************}
+{ THeapMemAvail.Update                                                       }
+{****************************************************************************}
+procedure THeapMemAvail.Update (Data : Pointer);
+  { Total bytes available on the heap.  May not be contiguous. }
+var
+  M : LongInt;
+begin
+  M := MemAvail;
+  if (Mem <> M) then
+  begin
+    Mem := M;
+    SetData(Mem);
+  end;
+end;
+
+{****************************************************************************}
+{ TPercentGauge Object                                                       }
+{****************************************************************************}
+{****************************************************************************}
+{ TPercentGauge.Draw                                                         }
+{****************************************************************************}
+procedure TPercentGauge.Draw;
+var
+  B : TDrawBuffer;
+  C : Word;
+  S : String;
+  PercentDone : LongInt;
+  FillSize : Integer;
+begin
+  C := GetColor(1);
+  MoveChar(B,' ',C,Size.X);
+  WriteLine(0,0,Size.X,Size.Y,B);
+  PercentDone := Percent;
+  FormatStr(S,'%d%%',PercentDone);
+  MoveStr(B[(Size.X - Byte(S[0])) div 2],S,C);
+  WriteLine(0,0,Size.X,Size.Y,B);
+end;
+
+{****************************************************************************}
+{ TPercentGauge.Percent                                                      }
+{****************************************************************************}
+function TPercentGauge.Percent : Integer;
+  { Returns percent as a whole integer Current of Max }
+begin
+  Percent := Round((Current/Max) * 100);
+end;
+
+{****************************************************************************}
+{ TSpinnerGauge Object                                                       }
+{****************************************************************************}
+
+{****************************************************************************}
+{ TSpinnerGauge.Init                                                         }
+{****************************************************************************}
+constructor TSpinnerGauge.Init (X, Y : Integer; ACommand : Word);
+var R : TRect;
+begin
+  R.Assign(X,Y,X+1,Y+1);
+  if not TGauge.Init(R,ACommand,1,4) then
+    Fail;
+end;
+
+{****************************************************************************}
+{ TSpinnerGauge.Draw                                                         }
+{****************************************************************************}
+procedure TSpinnerGauge.Draw;
+var
+  B : TDrawBuffer;
+  C : Word;
+begin
+  C := GetColor(1);
+  MoveChar(B,' ',C,Size.X);
+  WriteLine(0,0,Size.X,Size.Y,B);
+  MoveChar(B[Size.X div 2],SpinChars[Current],C,1);
+  WriteLine(0,0,Size.X,Size.Y,B);
+end;
+
+{****************************************************************************}
+{ TSpinnerGauge.HandleEvent                                                  }
+{****************************************************************************}
+procedure TSpinnerGauge.HandleEvent (var Event : TEvent);
+begin
+  TStatus.HandleEvent(Event);
+end;
+
+{****************************************************************************}
+{ TSpinnerGauge.Update                                                       }
+{****************************************************************************}
+procedure TSpinnerGauge.Update (Data : Pointer);
+begin
+  if Current = Max then
+    Current := Min
+  else Inc(Current);
+  DrawView;
+end;
+
+{****************************************************************************}
+{ TStatus Object                                                             }
+{****************************************************************************}
+{****************************************************************************}
+{ TStatus.Init                                                               }
+{****************************************************************************}
+constructor TStatus.Init (R : TRect; ACommand : Word; AText : String;
+                          AParamCount : Integer);
+begin
+  if (not TParamText.Init(R,AText,AParamCount)) then
+    Fail;
+  EventMask := EventMask or evStatus;
+  Command := ACommand;
+end;
+
+{****************************************************************************}
+{ TStatus.Load                                                               }
+{****************************************************************************}
+constructor TStatus.Load (var S : TStream);
+begin
+  if not TParamText.Load(S) then
+    Fail;
+  S.Read(Command,SizeOf(Command));
+  if (S.Status <> stOk) then
+  begin
+    TParamText.Done;
+    Fail;
+  end;
+end;
+
+{****************************************************************************}
+{ TStatus.Cancel                                                             }
+{****************************************************************************}
+function TStatus.Cancel : Boolean;
+begin
+  Cancel := True;
+end;
+
+{****************************************************************************}
+{ TStatus.GetPalette                                                         }
+{****************************************************************************}
+function TStatus.GetPalette : PPalette;
+const
+  P : String[Length(CStatus)] = CStatus;
+begin
+  GetPalette := PPalette(@P);
+end;
+
+{****************************************************************************}
+{ TStatus.HandleEvent                                                        }
+{****************************************************************************}
+procedure TStatus.HandleEvent (var Event : TEvent);
+begin
+  if (Event.What = evCommand) and (Event.Command = cmStatusPause) then
+  begin
+    Pause;
+    ClearEvent(Event);
+  end;
+  case Event.What of
+    evStatus :
+      case Event.Command of
+        cmStatusDone :
+          if (Event.InfoPtr = @Self) then
+          begin
+            Message(Owner,evStatus,cmStatusDone,@Self);
+            ClearEvent(Event);
+          end;
+        cmStatusUpdate :
+          if (Event.InfoWord = Command) and ((State and sfPause) = 0) then
+          begin
+            Update(Event.InfoPtr);
+            { ClearEvent(Event); } { don't clear the event so multiple }
+                            { status views can respond to the same event }
+          end;
+        cmStatusResume :
+          if (Event.InfoWord = Command) and
+             ((State and sfPause) = sfPause) then
+          begin
+            Resume;
+            ClearEvent(Event);
+          end;
+        cmStatusPause :
+          if (Event.InfoWord = Command) and ((State and sfPause) = 0) then
+          begin
+            Pause;
+            ClearEvent(Event);
+          end;
+      end;
+  end;
+  TParamText.HandleEvent(Event);
+end;
+
+{****************************************************************************}
+{ TStatus.Pause                                                              }
+{****************************************************************************}
+procedure TStatus.Pause;
+begin
+  SetState(sfPause,True);
+end;
+
+{****************************************************************************}
+{ TStatus.Reset                                                              }
+{****************************************************************************}
+procedure TStatus.Reset;
+begin
+  DrawView;
+end;
+
+{****************************************************************************}
+{ TStatus.Resume                                                             }
+{****************************************************************************}
+procedure TStatus.Resume;
+begin
+  SetState(sfPause,False);
+end;
+
+{****************************************************************************}
+{ TStatus.Store                                                              }
+{****************************************************************************}
+procedure TStatus.Store (var S : TStream);
+begin
+  TParamText.Store(S);
+  S.Write(Command,SizeOf(Command));
+end;
+
+{****************************************************************************}
+{ TStatus.Update                                                             }
+{****************************************************************************}
+procedure TStatus.Update (Data : Pointer);
+begin
+  DisposeStr(Text);
+  Text := NewStr(String(Data^));
+  DrawView;
+end;
+
+{****************************************************************************}
+{ TStatusDlg Object                                                          }
+{****************************************************************************}
+{****************************************************************************}
+{ TStatusDlg.Init                                                            }
+{****************************************************************************}
+constructor TStatusDlg.Init (ATitle : TTitleStr; AStatus : PStatus;
+                             AFlags : Word);
+var
+  R : TRect;
+  i : LongInt;
+  Buttons : Byte;
+begin
+  if (AStatus = nil) then
+    Fail;
+  R.A := AStatus^.Origin;
+  R.B := AStatus^.Size;
+  Inc(R.B.Y,R.A.Y+4);
+  Inc(R.B.X,R.A.X+5);
+  if not TDialog.Init(R,ATitle) then
+    Fail;
+  EventMask := EventMask or evStatus;
+  Status := AStatus;
+  Status^.MoveTo(2,2);
+  Insert(Status);
+  InsertButtons(AFlags);
+end;
+
+{****************************************************************************}
+{ TStatusDlg.Load                                                            }
+{****************************************************************************}
+constructor TStatusDlg.Load (var S : TStream);
+begin
+  if not TDialog.Load(S) then
+    Fail;
+  GetSubViewPtr(S,Status);
+  if (S.Status <> stOk) then
+  begin
+    if (Status <> nil) then
+      Dispose(Status,Done);
+    TDialog.Done;
+    Fail;
+  end;
+end;
+
+{****************************************************************************}
+{ TStatusDlg.Cancel                                                          }
+{****************************************************************************}
+procedure TStatusDlg.Cancel (ACommand : Word);
+begin
+  if Status^.Cancel then
+    TDialog.Cancel(ACommand);
+end;
+
+{****************************************************************************}
+{ TStatusDlg.HandleEvent                                                     }
+{****************************************************************************}
+procedure TStatusDlg.HandleEvent (var Event : TEvent);
+begin
+  case Event.What of
+    evStatus :
+      case Event.Command of
+        cmStatusDone :
+          if Event.InfoPtr = Status then
+          begin
+            TDialog.Cancel(cmOk);
+            ClearEvent(Event);
+          end;
+      end;
+      { else let TDialog.HandleEvent send to all subviews for handling }
+    evBroadcast, evCommand :
+      case Event.Command of
+        cmCancel, cmClose :
+          begin
+            Cancel(cmCancel);
+            ClearEvent(Event);
+          end;
+        cmStatusPause :
+          begin
+            Status^.Pause;
+            ClearEvent(Event);
+          end;
+        cmStatusResume :
+          begin
+            Status^.Resume;
+            ClearEvent(Event);
+          end;
+      end;
+  end;
+  TDialog.HandleEvent(Event);
+end;
+
+{****************************************************************************}
+{ TStatusDlg.InsertButtons                                                   }
+{****************************************************************************}
+procedure TStatusDlg.InsertButtons (AFlags : Word);
+var
+  R : TRect;
+  P : PButton;
+  Buttons : Byte;
+  X, Y, Gap : Integer;
+  i : Word;
+begin
+  Buttons := Byte(((AFlags and sdCancelButton) = sdCancelButton));
+  { do this Inc twice, once for Pause and once for Resume buttons }
+  Inc(Buttons,2 * Byte(((AFlags and sdPauseButton) = sdPauseButton)));
+  if Buttons > 0 then
+  begin
+    Status^.GrowMode := gfGrowHiX;
+    { resize dialog to hold all requested buttons }
+    if Size.X < ((Buttons * 12) + 2) then
+      GrowTo((Buttons * 12) + 2,Size.Y + 2)
+    else GrowTo(Size.X,Size.Y + 2);
+    { find correct starting position for first button }
+    Gap := Size.X - (Buttons * 10) - 2;
+    Gap := Gap div Succ(Buttons);
+    X := Gap;
+    if X < 2 then
+      X := 2;
+    Y := Size.Y - 3;
+    { insert buttons }
+    if ((AFlags and sdCancelButton) = sdCancelButton) then
+    begin
+      P := NewButton(X,Y,10,2,'Cancel',cmCancel,hcCancel,bfDefault);
+      P^.GrowMode := gfGrowHiY or gfGrowLoY;
+      Inc(X,12 + Gap);
+    end;
+    if ((AFlags and sdPauseButton) = sdPauseButton) then
+    begin
+      P := NewButton(X,Y,10,2,'~P~ause',cmStatusPause,hcStatusPause,bfNormal);
+      P^.GrowMode := gfGrowHiY or gfGrowLoY;
+      Inc(X,12 + Gap);
+      P := NewButton(X,Y,10,2,'~R~esume',cmStatusResume,hcStatusResume,
+                     bfBroadcast);
+      P^.GrowMode := gfGrowHiY or gfGrowLoY;
+    end;
+  end;  { of if }
+  SelectNext(False);
+end;
+
+{****************************************************************************}
+{ TStatusDlg.Store                                                           }
+{****************************************************************************}
+procedure TStatusDlg.Store (var S : TStream);
+begin
+  TDialog.Store(S);
+  PutSubViewPtr(S,Status);
+end;
+
+{****************************************************************************}
+{ TStatusMessageDlg Object                                                   }
+{****************************************************************************}
+{****************************************************************************}
+{ TStatusMessageDlg.Init                                                     }
+{****************************************************************************}
+constructor TStatusMessageDlg.Init (ATitle : TTitleStr; AStatus : PStatus;
+                                    AFlags : Word; AMessage : String);
+var
+  P : PStaticText;
+  X, Y : Integer;
+  R : TRect;
+begin
+  if not TStatusDlg.Init(ATitle,AStatus,AFlags) then
+    Fail;
+  Status^.GrowMode := gfGrowLoY or gfGrowHiY;
+  GetExtent(R);
+  X := R.B.X - R.A.X;
+  if X < Size.X then
+    X := Size.X;
+  Y := R.B.Y - R.A.Y;
+  if Y < Size.Y then
+    Y := Size.Y;
+  GrowTo(X,Y);
+  R.Assign(2,2,Size.X-2,Size.Y-3);
+  P := New(PStaticText,Init(R,AMessage));
+  if (P = nil) then
+  begin
+    TStatusDlg.Done;
+    Fail;
+  end;
+  GrowTo(Size.X,Size.Y + P^.Size.Y + 1);
+  Insert(P);
+end;
+
+{****************************************************************************}
+{                    Global procedures and functions                         }
+{****************************************************************************}
+
+{****************************************************************************}
+{ RegisterStatuses                                                           }
+{****************************************************************************}
+procedure RegisterStatuses;
+begin
+{  RegisterType(RStatus);
+  RegisterType(RStatusDlg);
+  RegisterType(RGauge);
+  RegisterType(RArrowGauge);
+  RegisterType(RPercentGauge);
+  RegisterType(RBarGauge);
+  RegisterType(RSpinnerGauge); }
+end;
+
+{****************************************************************************}
+{                            Unit Initialization                             }
+{****************************************************************************}
+begin
+end.

+ 2686 - 0
fvision/stddlg.pas

@@ -0,0 +1,2686 @@
+{*******************************************************}
+{ Free Vision Runtime Library                           }
+{ StdDlg Unit                                           }
+{ Version: 0.1.0                                        }
+{ Release Date: July 23, 1998                           }
+{                                                       }
+{*******************************************************}
+{                                                       }
+{ This unit is a port of Borland International's        }
+{ StdDlg.pas unit.  It is for distribution with the     }
+{ Free Pascal (FPK) Compiler as part of the 32-bit      }
+{ Free Vision library.  The unit is still fully         }
+{ functional under BP7 by using the tp compiler         }
+{ directive when rebuilding the library.                }
+{                                                       }
+{*******************************************************}
+
+{ Revision History
+
+1.1a   (97/12/29)
+  - fixed bug in TFileDialog.HandleEvent that prevented the user from being
+    able to have an action taken automatically when the FileList was
+    selected and kbEnter pressed
+
+1.1
+  - modified OpenNewFile to take a history list ID
+  - implemented OpenNewFile
+
+1.0   (1992)
+  - original implementation }
+
+unit StdDlg;
+
+{
+  This unit has been modified to make some functions global, apply patches
+  from version 3.1 of the TVBUGS list, added TEditChDirDialog, and added
+  several new global functions and procedures.
+}
+
+{$i platform.inc}
+
+{$ifdef PPC_FPC}
+  {$H-}
+{$else}
+  {$F+,O+,E+,N+}
+{$endif}
+{$X+,R-,I-,Q-,V-}
+{$ifndef OS_LINUX}
+  {$S-}
+{$endif}
+{$ifdef OS_DOS}
+  {$define HAS_DOS_DRIVES}
+{$endif}
+{$ifdef OS_WINDOWS}
+  {$define HAS_DOS_DRIVES}
+{$endif}
+{$ifdef OS_OS2}
+  {$define HAS_DOS_DRIVES}
+{$endif}
+
+interface
+
+uses
+  ObjTypes, Objects, Drivers, Views, Dialogs, Validate, Dos;
+
+const
+{$ifdef PPC_FPC}
+  MaxDir   = 255;   { Maximum length of a DirStr. }
+  MaxFName = 255; { Maximum length of a FNameStr. }
+
+  {$ifdef OS_LINUX}
+  DirSeparator : Char = '/';
+  {$else}
+  DirSeparator : Char = '\';
+  {$endif}
+
+{$else}
+  MaxDir = 67;   { Maximum length of a DirStr. }
+  MaxFName = 79; { Maximum length of a FNameStr. }
+  DirSeparator: Char = '\';
+{$endif}
+
+
+type
+  { TSearchRec }
+
+  {  Record used to store directory information by TFileDialog
+     This is a part of Dos.Searchrec for Bp !! }
+
+  TSearchRec = packed record
+    Attr: Longint;
+    Time: Longint;
+    Size: Longint;
+{$ifdef PPC_FPC}
+    Name: string[255];
+{$else not PPC_FPC}
+    Name: string[12];
+{$endif not PPC_FPC}
+  end;
+  PSearchRec = ^TSearchRec;
+
+type
+
+  { TFileInputLine is a special input line that is used by      }
+  { TFileDialog that will update its contents in response to a  }
+  { cmFileFocused command from a TFileList.          }
+
+  PFileInputLine = ^TFileInputLine;
+  TFileInputLine = object(TInputLine)
+    constructor Init(var Bounds: TRect; AMaxLen: Sw_Integer);
+    procedure HandleEvent(var Event: TEvent); virtual;
+  end;
+
+  { TFileCollection is a collection of TSearchRec's. }
+
+  PFileCollection = ^TFileCollection;
+  TFileCollection = object(TSortedCollection)
+    function Compare(Key1, Key2: Pointer): Sw_Integer; virtual;
+    procedure FreeItem(Item: Pointer); virtual;
+    function GetItem(var S: TStream): Pointer; virtual;
+    procedure PutItem(var S: TStream; Item: Pointer); virtual;
+  end;
+
+  {#Z+}
+  PFileValidator = ^TFileValidator;
+  {#Z-}
+  TFileValidator = Object(TValidator)
+  end;  { of TFileValidator }
+
+  { TSortedListBox is a TListBox that assumes it has a     }
+  { TStoredCollection instead of just a TCollection.  It will   }
+  { perform an incremental search on the contents.       }
+
+  PSortedListBox = ^TSortedListBox;
+  TSortedListBox = object(TListBox)
+    SearchPos: Byte;
+    ShiftState: Byte;
+    constructor Init(var Bounds: TRect; ANumCols: Sw_Word;
+      AScrollBar: PScrollBar);
+    procedure HandleEvent(var Event: TEvent); virtual;
+    function GetKey(var S: String): Pointer; virtual;
+    procedure NewList(AList: PCollection); virtual;
+  end;
+
+  { TFileList is a TSortedList box that assumes it contains     }
+  { a TFileCollection as its collection.  It also communicates  }
+  { through broadcast messages to TFileInput and TInfoPane      }
+  { what file is currently selected.             }
+
+  PFileList = ^TFileList;
+  TFileList = object(TSortedListBox)
+    constructor Init(var Bounds: TRect; AScrollBar: PScrollBar);
+    destructor Done; virtual;
+    function DataSize: Sw_Word; virtual;
+    procedure FocusItem(Item: Sw_Integer); virtual;
+    procedure GetData(var Rec); virtual;
+    function GetText(Item,MaxLen: Sw_Integer): String; virtual;
+    function GetKey(var S: String): Pointer; virtual;
+    procedure HandleEvent(var Event: TEvent); virtual;
+    procedure ReadDirectory(AWildCard: PathStr);
+    procedure SetData(var Rec); virtual;
+  end;
+
+  { TFileInfoPane is a TView that displays the information      }
+  { about the currently selected file in the TFileList     }
+  { of a TFileDialog.                  }
+
+  PFileInfoPane = ^TFileInfoPane;
+  TFileInfoPane = object(TView)
+    S: TSearchRec;
+    constructor Init(var Bounds: TRect);
+    procedure Draw; virtual;
+    function GetPalette: PPalette; virtual;
+    procedure HandleEvent(var Event: TEvent); virtual;
+  end;
+
+  { TFileDialog is a standard file name input dialog      }
+
+  TWildStr = PathStr;
+
+const
+  fdOkButton      = $0001;      { Put an OK button in the dialog }
+  fdOpenButton    = $0002;      { Put an Open button in the dialog }
+  fdReplaceButton = $0004;      { Put a Replace button in the dialog }
+  fdClearButton   = $0008;      { Put a Clear button in the dialog }
+  fdHelpButton    = $0010;      { Put a Help button in the dialog }
+  fdNoLoadDir     = $0100;      { Do not load the current directory }
+            { contents into the dialog at Init. }
+            { This means you intend to change the }
+            { WildCard by using SetData or store }
+            { the dialog on a stream. }
+
+type
+
+  PFileHistory = ^TFileHistory;
+  TFileHistory = object(THistory)
+    CurDir : PString;
+    procedure HandleEvent(var Event: TEvent);virtual;
+    destructor Done; virtual;
+    procedure AdaptHistoryToDir(Dir : string);
+  end;
+
+  PFileDialog = ^TFileDialog;
+  TFileDialog = object(TDialog)
+    FileName: PFileInputLine;
+    FileList: PFileList;
+    FileHistory: PFileHistory;
+    WildCard: TWildStr;
+    Directory: PString;
+    constructor Init(AWildCard: TWildStr; const ATitle,
+      InputName: String; AOptions: Word; HistoryId: Byte);
+    constructor Load(var S: TStream);
+    destructor Done; virtual;
+    procedure GetData(var Rec); virtual;
+    procedure GetFileName(var S: PathStr);
+    procedure HandleEvent(var Event: TEvent); virtual;
+    procedure SetData(var Rec); virtual;
+    procedure Store(var S: TStream);
+    function Valid(Command: Word): Boolean; virtual;
+  private
+    procedure ReadDirectory;
+  end;
+
+  { TDirEntry }
+
+  PDirEntry = ^TDirEntry;
+  TDirEntry = record
+    DisplayText: PString;
+    Directory: PString;
+  end;  { of TDirEntry }
+
+  { TDirCollection is a collection of TDirEntry's used by       }
+  { TDirListBox.                 }
+
+  PDirCollection = ^TDirCollection;
+  TDirCollection = object(TCollection)
+    function GetItem(var S: TStream): Pointer; virtual;
+    procedure FreeItem(Item: Pointer); virtual;
+    procedure PutItem(var S: TStream; Item: Pointer); virtual;
+  end;
+
+  { TDirListBox displays a tree of directories for use in the }
+  { TChDirDialog.                    }
+
+  PDirListBox = ^TDirListBox;
+  TDirListBox = object(TListBox)
+    Dir: DirStr;
+    Cur: Word;
+    constructor Init(var Bounds: TRect; AScrollBar: PScrollBar);
+    destructor Done; virtual;
+    function GetText(Item,MaxLen: Sw_Integer): String; virtual;
+    procedure HandleEvent(var Event: TEvent); virtual;
+    function IsSelected(Item: Sw_Integer): Boolean; virtual;
+    procedure NewDirectory(var ADir: DirStr);
+    procedure SetState(AState: Word; Enable: Boolean); virtual;
+  end;
+
+  { TChDirDialog is a standard change directory dialog. }
+
+const
+  cdNormal     = $0000; { Option to use dialog immediately }
+  cdNoLoadDir  = $0001; { Option to init the dialog to store on a stream }
+  cdHelpButton = $0002; { Put a help button in the dialog }
+
+type
+
+  PChDirDialog = ^TChDirDialog;
+  TChDirDialog = object(TDialog)
+    DirInput: PInputLine;
+    DirList: PDirListBox;
+    OkButton: PButton;
+    ChDirButton: PButton;
+    constructor Init(AOptions: Word; HistoryId: Sw_Word);
+    constructor Load(var S: TStream);
+    function DataSize: Sw_Word; virtual;
+    procedure GetData(var Rec); virtual;
+    procedure HandleEvent(var Event: TEvent); virtual;
+    procedure SetData(var Rec); virtual;
+    procedure Store(var S: TStream);
+    function Valid(Command: Word): Boolean; virtual;
+  private
+    procedure SetUpDialog;
+  end;
+
+  PEditChDirDialog = ^TEditChDirDialog;
+  TEditChDirDialog = Object(TChDirDialog)
+    { TEditChDirDialog allows setting/getting the starting directory.  The
+      transfer record is a DirStr. }
+    function DataSize : Sw_Word; virtual;
+    procedure GetData (var Rec); virtual;
+    procedure SetData (var Rec); virtual;
+  end;  { of TEditChDirDialog }
+
+
+  {#Z+}
+  PDirValidator = ^TDirValidator;
+  {#Z-}
+  TDirValidator = Object(TFilterValidator)
+    constructor Init;
+    function IsValid(const S: string): Boolean; virtual;
+    function IsValidInput(var S: string; SuppressFill: Boolean): Boolean;
+      virtual;
+  end;  { of TDirValidator }
+
+
+  FileConfirmFunc = function (AFile : FNameStr) : Boolean;
+    { Functions of type FileConfirmFunc's are used to prompt the end user for
+      confirmation of an operation.
+
+      FileConfirmFunc's should ask the user whether to perform the desired
+      action on the file named AFile.  If the user elects to perform the
+      function FileConfirmFunc's return True, otherwise they return False.
+
+      Using FileConfirmFunc's allows routines to be coded independant of the
+      user interface implemented.  OWL and TurboVision are supported through
+      conditional defines.  If you do not use either user interface you must
+      compile this unit with the conditional define cdNoMessages and set all
+      FileConfirmFunc variables to a valid function prior to calling any
+      routines in this unit. }
+    {#X ReplaceFile DeleteFile }
+
+
+var
+
+  ReplaceFile : FileConfirmFunc;
+    { ReplaceFile returns True if the end user elects to replace the existing
+      file with the new file, otherwise it returns False.
+
+      ReplaceFile is only called when #CheckOnReplace# is True. }
+    {#X DeleteFile }
+
+  DeleteFile : FileConfirmFunc;
+    { DeleteFile returns True if the end user elects to delete the file,
+      otherwise it returns False.
+
+       DeleteFile is only called when #CheckOnDelete# is True. }
+    {#X ReplaceFile }
+
+
+const
+
+  CInfoPane = #30;
+
+  { TStream registration records }
+
+function Contains(S1, S2: String): Boolean;
+  { Contains returns true if S1 contains any characters in S2. }
+
+function DriveValid(Drive: Char): Boolean;
+  { DriveValid returns True if Drive is a valid DOS drive.  Drive valid works
+    by attempting to change the current directory to Drive, then restoring
+    the original directory. }
+
+function ExtractDir(AFile: FNameStr): DirStr;
+  { ExtractDir returns the path of AFile terminated with a trailing '\'.  If
+    AFile contains no directory information, an empty string is returned. }
+
+function ExtractFileName(AFile: FNameStr): NameStr;
+  { ExtractFileName returns the file name without any directory or file
+    extension information. }
+
+function Equal(const S1, S2: String; Count: Sw_word): Boolean;
+  { Equal returns True if S1 equals S2 for up to Count characters.  Equal is
+    case-insensitive. }
+
+function FileExists (AFile : FNameStr) : Boolean;
+  { FileExists looks for the file specified in AFile.  If AFile is present
+    FileExists returns true, otherwise FileExists returns False.
+
+    The search is performed relative to the current system directory, but
+    other directories may be searched by prefacing a file name with a valid
+    directory path.
+
+    There is no check for a vaild file name or drive.  Errrors are handled
+    internally and not reported in DosError.  Critical errors are left to
+    the system's critical error handler. }
+  {#X OpenFile }
+
+function GetCurDir: DirStr;
+  { GetCurDir returns the current directory.  The directory returned always
+    ends with a trailing backslash '\'. }
+
+function GetCurDrive: Char;
+  { GetCurDrive returns the letter of the current drive as reported by the
+    operating system. }
+
+function IsWild(const S: String): Boolean;
+  { IsWild returns True if S contains a question mark (?) or asterix (*). }
+
+function IsList(const S: String): Boolean;
+  { IsList returns True if S contains list separator (;) char }
+
+function IsDir(const S: String): Boolean;
+  { IsDir returns True if S is a valid DOS directory. }
+
+procedure MakeResources;
+  { MakeResources places a language specific version of all resources
+    needed for the StdDlg unit to function on the RezFile using the string
+    constants and variables in the Resource unit.  The Resource unit and the
+    appropriate string lists must be initialized prior to calling this
+    procedure. }
+
+function NoWildChars(S: String): String;
+  { NoWildChars deletes the wild card characters ? and * from the string S
+    and returns the result. }
+
+function OpenFile (var AFile : FNameStr; HistoryID : Byte) : Boolean;
+  { OpenFile prompts the user to select a file using the file specifications
+    in AFile as the starting file and path.  Wildcards are accepted.  If the
+    user accepts a file OpenFile returns True, otherwise OpenFile returns
+    False.
+
+    Note: The file returned may or may not exist. }
+
+function OpenNewFile (var AFile: FNameStr; HistoryID: Byte): Boolean;
+  { OpenNewFile allows the user to select a directory from disk and enter a
+    new file name.  If the file name entered is an existing file the user is
+    optionally prompted for confirmation of replacing the file based on the
+    value in #CheckOnReplace#.  If a file name is successfully entered,
+    OpenNewFile returns True. }
+  {#X OpenFile }
+
+function PathValid(var Path: PathStr): Boolean;
+  { PathValid returns True if Path is a valid DOS path name.  Path may be a
+    file or directory name.  Trailing '\'s are removed. }
+
+procedure RegisterStdDlg;
+  { RegisterStdDlg registers all objects in the StdDlg unit for stream
+    usage. }
+
+function SaveAs (var AFile : FNameStr; HistoryID : Word) : Boolean;
+  { SaveAs prompts the user for a file name using AFile as a template.  If
+    AFile already exists and CheckOnReplace is True, the user is prompted
+    to replace the file.
+
+    If a valid file name is entered SaveAs returns True, other SaveAs returns
+    False. }
+
+function SelectDir (var ADir : DirStr; HistoryID : Byte) : Boolean;
+  { SelectDir prompts the user to select a directory using ADir as the
+    starting directory.  If a directory is selected, SelectDir returns True.
+    The directory returned is gauranteed to exist. }
+
+function ShrinkPath (AFile : FNameStr; MaxLen : Byte) : FNameStr;
+  { ShrinkPath returns a file name with a maximu length of MaxLen.
+    Internal directories are removed and replaced with elipses as needed to
+    make the file name fit in MaxLen.
+
+    AFile must be a valid path name. }
+
+function StdDeleteFile (AFile : FNameStr) : Boolean;
+  { StdDeleteFile returns True if the end user elects to delete the file,
+    otherwise it returns False.
+
+    DeleteFile is only called when CheckOnDelete is True. }
+
+function StdReplaceFile (AFile : FNameStr) : Boolean;
+  { StdReplaceFile returns True if the end user elects to replace the existing
+    AFile with the new AFile, otherwise it returns False.
+
+    ReplaceFile is only called when CheckOnReplace is True. }
+
+function ValidFileName(var FileName: PathStr): Boolean;
+  { ValidFileName returns True if FileName is a valid DOS file name. }
+
+
+const
+  CheckOnReplace : Boolean = True;
+    { CheckOnReplace is used by file functions.  If a file exists, it is
+      optionally replaced based on the value of CheckOnReplace.
+
+      If CheckOnReplace is False the file is replaced without asking the
+      user.  If CheckOnReplace is True, the end user is asked to replace the
+      file using a call to ReplaceFile.
+
+      CheckOnReplace is set to True by default. }
+
+  CheckOnDelete : Boolean = True;
+    { CheckOnDelete is used by file and directory functions.  If a file
+      exists, it is optionally deleted based on the value of CheckOnDelete.
+
+      If CheckOnDelete is False the file or directory is deleted without
+      asking the user.  If CheckOnDelete is True, the end user is asked to
+      delete the file/directory using a call to DeleteFile.
+
+      CheckOnDelete is set to True by default. }
+
+
+
+const
+  RFileInputLine: TStreamRec = (
+     ObjType: idFileInputLine;
+     VmtLink: Ofs(TypeOf(TFileInputLine)^);
+     Load:    @TFileInputLine.Load;
+     Store:   @TFileInputLine.Store
+  );
+
+  RFileCollection: TStreamRec = (
+     ObjType: idFileCollection;
+     VmtLink: Ofs(TypeOf(TFileCollection)^);
+     Load:    @TFileCollection.Load;
+     Store:   @TFileCollection.Store
+  );
+
+  RFileList: TStreamRec = (
+     ObjType: idFileList;
+     VmtLink: Ofs(TypeOf(TFileList)^);
+     Load:    @TFileList.Load;
+     Store:   @TFileList.Store
+  );
+
+  RFileInfoPane: TStreamRec = (
+     ObjType: idFileInfoPane;
+     VmtLink: Ofs(TypeOf(TFileInfoPane)^);
+     Load:    @TFileInfoPane.Load;
+     Store:   @TFileInfoPane.Store
+  );
+
+  RFileDialog: TStreamRec = (
+     ObjType: idFileDialog;
+     VmtLink: Ofs(TypeOf(TFileDialog)^);
+     Load:    @TFileDialog.Load;
+     Store:   @TFileDialog.Store
+  );
+
+  RDirCollection: TStreamRec = (
+     ObjType: idDirCollection;
+     VmtLink: Ofs(TypeOf(TDirCollection)^);
+     Load:    @TDirCollection.Load;
+     Store:   @TDirCollection.Store
+  );
+
+  RDirListBox: TStreamRec = (
+     ObjType: idDirListBox;
+     VmtLink: Ofs(TypeOf(TDirListBox)^);
+     Load:    @TDirListBox.Load;
+     Store:   @TDirListBox.Store
+  );
+
+  RChDirDialog: TStreamRec = (
+     ObjType: idChDirDialog;
+     VmtLink: Ofs(TypeOf(TChDirDialog)^);
+     Load:    @TChDirDialog.Load;
+     Store:   @TChDirDialog.Store
+  );
+
+  RSortedListBox: TStreamRec = (
+     ObjType: idSortedListBox;
+     VmtLink: Ofs(TypeOf(TSortedListBox)^);
+     Load:    @TSortedListBox.Load;
+     Store:   @TSortedListBox.Store
+  );
+
+  REditChDirDialog : TStreamRec = (
+    ObjType : idEditChDirDialog;
+    VmtLink : Ofs(TypeOf(TEditChDirDialog)^);
+    Load    : @TEditChDirDialog.Load;
+    Store   : @TEditChDirDialog.Store);
+
+
+implementation
+
+{****************************************************************************}
+{            Local Declarations              }
+{****************************************************************************}
+
+uses
+  FVConsts, App, Memory, HistList, MsgBox, Resource;
+
+type
+
+  PStringRec = record
+    { PStringRec is needed for properly displaying PStrings using
+      MessageBox. }
+    AString : PString;
+  end;
+
+{****************************************************************************}
+{ TDirValidator Object                        }
+{****************************************************************************}
+{****************************************************************************}
+{ TDirValidator.Init                    }
+{****************************************************************************}
+constructor TDirValidator.Init;
+const   { What should this list be?  The commented one doesn't allow home,
+  end, right arrow, left arrow, Ctrl+XXXX, etc. }
+  Chars: TCharSet = ['A'..'Z','a'..'z','.','~',':','_','-'];
+{  Chars: TCharSet = [#0..#255]; }
+begin
+  Chars := Chars + [DirSeparator];
+  if not inherited Init(Chars) then
+    Fail;
+end;
+
+{****************************************************************************}
+{ TDirValidator.IsValid                      }
+{****************************************************************************}
+function TDirValidator.IsValid(const S: string): Boolean;
+begin
+{  IsValid := False; }
+  IsValid := True;
+end;
+
+{****************************************************************************}
+{ TDirValidator.IsValidInput                  }
+{****************************************************************************}
+function TDirValidator.IsValidInput(var S: string; SuppressFill: Boolean): Boolean;
+begin
+{  IsValid := False; }
+  IsValidInput := True;
+end;
+
+{****************************************************************************}
+{ TFileInputLine Object                      }
+{****************************************************************************}
+{****************************************************************************}
+{ TFileInputLine.Init                     }
+{****************************************************************************}
+constructor TFileInputLine.Init(var Bounds: TRect; AMaxLen: Sw_Integer);
+begin
+  TInputLine.Init(Bounds, AMaxLen);
+  EventMask := EventMask or evBroadcast;
+end;
+
+{****************************************************************************}
+{ TFileInputLine.HandleEvent                  }
+{****************************************************************************}
+procedure TFileInputLine.HandleEvent(var Event: TEvent);
+begin
+  TInputLine.HandleEvent(Event);
+  if (Event.What = evBroadcast) and (Event.Command = cmFileFocused) and
+    (State and sfSelected = 0) then
+  begin
+     if PSearchRec(Event.InfoPtr)^.Attr and Directory <> 0 then
+       begin
+          Data^ := PSearchRec(Event.InfoPtr)^.Name + DirSeparator +
+            PFileDialog(Owner)^.WildCard;
+          { PFileDialog(Owner)^.FileHistory^.AdaptHistoryToDir(
+              PSearchRec(Event.InfoPtr)^.Name+DirSeparator);}
+       end
+     else Data^ := PSearchRec(Event.InfoPtr)^.Name;
+     DrawView;
+  end;
+end;
+
+{****************************************************************************}
+{ TFileCollection Object                       }
+{****************************************************************************}
+{****************************************************************************}
+{ TFileCollection.Compare                     }
+{****************************************************************************}
+  function uppername(const s : string) : string;
+  var
+    i  : Sw_integer;
+    in_name : boolean;
+  begin
+     in_name:=true;
+     for i:=length(s) downto 1 do
+      if in_name and (s[i] in ['a'..'z']) then
+        uppername[i]:=char(byte(s[i])-32)
+      else
+       begin
+          uppername[i]:=s[i];
+          if s[i] = DirSeparator then
+            in_name:=false;
+       end;
+     uppername[0]:=s[0];
+  end;
+
+function TFileCollection.Compare(Key1, Key2: Pointer): Sw_Integer;
+begin
+  if PSearchRec(Key1)^.Name = PSearchRec(Key2)^.Name then Compare := 0
+  else if PSearchRec(Key1)^.Name = '..' then Compare := 1
+  else if PSearchRec(Key2)^.Name = '..' then Compare := -1
+  else if (PSearchRec(Key1)^.Attr and Directory <> 0) and
+     (PSearchRec(Key2)^.Attr and Directory = 0) then Compare := 1
+  else if (PSearchRec(Key2)^.Attr and Directory <> 0) and
+     (PSearchRec(Key1)^.Attr and Directory = 0) then Compare := -1
+{$ifdef linux}
+  else if PSearchRec(Key1)^.Name > PSearchRec(Key2)^.Name then
+{$else linux}
+  else if UpperName(PSearchRec(Key1)^.Name) > UpperName(PSearchRec(Key2)^.Name) then
+{$endif def linux}
+    Compare := 1
+  else Compare := -1;
+end;
+
+{****************************************************************************}
+{ TFileCollection.FreeItem                   }
+{****************************************************************************}
+procedure TFileCollection.FreeItem(Item: Pointer);
+begin
+  Dispose(PSearchRec(Item));
+end;
+
+{****************************************************************************}
+{ TFileCollection.GetItem                     }
+{****************************************************************************}
+function TFileCollection.GetItem(var S: TStream): Pointer;
+var
+  Item: PSearchRec;
+begin
+  New(Item);
+  S.Read(Item^, SizeOf(TSearchRec));
+  GetItem := Item;
+end;
+
+{****************************************************************************}
+{ TFileCollection.PutItem                     }
+{****************************************************************************}
+procedure TFileCollection.PutItem(var S: TStream; Item: Pointer);
+begin
+  S.Write(Item^, SizeOf(TSearchRec));
+end;
+
+
+{*****************************************************************************
+               TFileList
+*****************************************************************************}
+
+const
+  ListSeparator=';';
+
+function MatchesMask(What, Mask: string): boolean;
+
+  function upper(const s : string) : string;
+  var
+    i  : Sw_integer;
+  begin
+     for i:=1 to length(s) do
+      if s[i] in ['a'..'z'] then
+       upper[i]:=char(byte(s[i])-32)
+      else
+       upper[i]:=s[i];
+     upper[0]:=s[0];
+  end;
+
+  Function CmpStr(const hstr1,hstr2:string):boolean;
+  var
+    found : boolean;
+    i1,i2 : Sw_integer;
+  begin
+    i1:=0;
+    i2:=0;
+    if hstr1='' then
+      begin
+        CmpStr:=(hstr2='');
+        exit;
+      end;
+    found:=true;
+    repeat
+      if found then
+       inc(i2);
+      inc(i1);
+      case hstr1[i1] of
+        '?' :
+          found:=true;
+        '*' :
+          begin
+            found:=true;
+            if (i1=length(hstr1)) then
+             i2:=length(hstr2)
+            else
+             if (i1<length(hstr1)) and (hstr1[i1+1]<>hstr2[i2]) then
+              begin
+                if i2<length(hstr2) then
+                 dec(i1)
+              end
+            else
+             if i2>1 then
+              dec(i2);
+          end;
+        else
+          found:=(hstr1[i1]=hstr2[i2]) or (hstr2[i2]='?');
+      end;
+    until (i1>=length(hstr1)) or (i2>length(hstr2)) or (not found);
+    if found then
+      found:=(i1>=length(hstr1)) and (i2>=length(hstr2));
+    CmpStr:=found;
+  end;
+
+var
+  D1,D2 : DirStr;
+  N1,N2 : NameStr;
+  E1,E2 : Extstr;
+begin
+{$ifdef linux}
+  FSplit(What,D1,N1,E1);
+  FSplit(Mask,D2,N2,E2);
+{$else}
+  FSplit(Upper(What),D1,N1,E1);
+  FSplit(Upper(Mask),D2,N2,E2);
+{$endif}
+  MatchesMask:=CmpStr(N2,N1) and CmpStr(E2,E1);
+end;
+
+function MatchesMaskList(What, MaskList: string): boolean;
+var P: integer;
+    Match: boolean;
+begin
+  Match:=false;
+  if What<>'' then
+  repeat
+    P:=Pos(ListSeparator, MaskList);
+    if P=0 then P:=length(MaskList)+1;
+    Match:=MatchesMask(What,copy(MaskList,1,P-1));
+    Delete(MaskList,1,P);
+  until Match or (MaskList='');
+  MatchesMaskList:=Match;
+end;
+
+constructor TFileList.Init(var Bounds: TRect; AScrollBar: PScrollBar);
+begin
+  TSortedListBox.Init(Bounds, 2, AScrollBar);
+end;
+
+destructor TFileList.Done;
+begin
+  if List <> nil then Dispose(List, Done);
+  TListBox.Done;
+end;
+
+function TFileList.DataSize: Sw_Word;
+begin
+  DataSize := 0;
+end;
+
+procedure TFileList.FocusItem(Item: Sw_Integer);
+begin
+  TSortedListBox.FocusItem(Item);
+  if (List^.Count > 0) then
+    Message(Owner, evBroadcast, cmFileFocused, List^.At(Item));
+end;
+
+procedure TFileList.GetData(var Rec);
+begin
+end;
+
+function TFileList.GetKey(var S: String): Pointer;
+const
+  SR: TSearchRec = ();
+
+procedure UpStr(var S: String);
+var
+  I: Sw_Integer;
+begin
+  for I := 1 to Length(S) do S[I] := UpCase(S[I]);
+end;
+
+begin
+  if (ShiftState and $03 <> 0) or ((S <> '') and (S[1]='.')) then
+    SR.Attr := Directory
+  else SR.Attr := 0;
+  SR.Name := S;
+{$ifndef linux}
+  UpStr(SR.Name);
+{$endif linux}
+  GetKey := @SR;
+end;
+
+function TFileList.GetText(Item,MaxLen: Sw_Integer): String;
+var
+  S: String;
+  SR: PSearchRec;
+begin
+  SR := PSearchRec(List^.At(Item));
+  S := SR^.Name;
+  if SR^.Attr and Directory <> 0 then
+  begin
+    S[Length(S)+1] := DirSeparator;
+    Inc(S[0]);
+  end;
+  GetText := S;
+end;
+
+procedure TFileList.HandleEvent(var Event: TEvent);
+var
+  S : String;
+  K : pointer;
+  Value : Sw_integer;
+begin
+  if (Event.What = evMouseDown) and (Event.Double) then
+  begin
+    Event.What := evCommand;
+    Event.Command := cmOK;
+    PutEvent(Event);
+    ClearEvent(Event);
+  end
+  else if (Event.What = evKeyDown) and (Event.CharCode='<') then
+  begin
+    { select '..' }
+      S := '..';
+      K := GetKey(S);
+      If PSortedCollection(List)^.Search(K, Value) then
+        FocusItem(Value);
+  end
+  else TSortedListBox.HandleEvent(Event);
+end;
+
+procedure TFileList.ReadDirectory(AWildCard: PathStr);
+const
+  FindAttr = ReadOnly + Archive;
+{$ifdef linux}
+  AllFiles = '*';
+{$else}
+  AllFiles = '*.*';
+{$endif}
+  PrevDir  = '..';
+var
+  S: SearchRec;
+  P: PSearchRec;
+  FileList: PFileCollection;
+  NumFiles: Word;
+  FindStr,
+  WildName : string;
+  Dir: DirStr;
+  Ext: ExtStr;
+  Name: NameStr;
+  Event : TEvent;
+  Tmp: PathStr;
+begin
+  NumFiles := 0;
+  FileList := New(PFileCollection, Init(5, 5));
+  AWildCard := FExpand(AWildCard);
+  FSplit(AWildCard, Dir, Name, Ext);
+  if pos(ListSeparator,AWildCard)>0 then
+   begin
+     WildName:=Copy(AWildCard,length(Dir)+1,255);
+     FindStr:=Dir+AllFiles;
+   end
+  else
+   begin
+     WildName:=Name+Ext;
+     FindStr:=AWildCard;
+   end;
+  FindFirst(FindStr, FindAttr, S);
+  P := PSearchRec(@P);
+  while assigned(P) and (DosError = 0) do
+   begin
+     if (S.Attr and Directory = 0) and
+        MatchesMaskList(S.Name,WildName) then
+     begin
+       P := MemAlloc(SizeOf(P^));
+       if assigned(P) then
+       begin
+         P^.Attr:=S.Attr;
+         P^.Time:=S.Time;
+         P^.Size:=S.Size;
+         P^.Name:=S.Name;
+         FileList^.Insert(P);
+       end;
+     end;
+     FindNext(S);
+   end;
+ {$ifdef fpc}
+  FindClose(S);
+ {$endif}
+
+  Tmp := Dir + AllFiles;
+  FindFirst(Tmp, Directory, S);
+  while (P <> nil) and (DosError = 0) do
+  begin
+    if (S.Attr and Directory <> 0) and (S.Name <> '.') and (S.Name <> '..') then
+    begin
+      P := MemAlloc(SizeOf(P^));
+      if P <> nil then
+      begin
+        P^.Attr:=S.Attr;
+        P^.Time:=S.Time;
+        P^.Size:=S.Size;
+        P^.Name:=S.Name;
+        FileList^.Insert(P);
+      end;
+    end;
+    FindNext(S);
+  end;
+ {$ifdef fpc}
+  FindClose(S);
+ {$endif}
+ {$ifndef linux}
+  if Length(Dir) > 4 then
+ {$endif not linux}
+  begin
+    P := MemAlloc(SizeOf(P^));
+    if P <> nil then
+    begin
+      FindFirst(Tmp, Directory, S);
+      FindNext(S);
+      if (DosError = 0) and (S.Name = PrevDir) then
+       begin
+         P^.Attr:=S.Attr;
+         P^.Time:=S.Time;
+         P^.Size:=S.Size;
+         P^.Name:=S.Name;
+       end
+      else
+       begin
+         P^.Name := PrevDir;
+         P^.Size := 0;
+         P^.Time := $210000;
+         P^.Attr := Directory;
+       end;
+      FileList^.Insert(PSearchRec(P));
+     {$ifdef fpc}
+      FindClose(S);
+     {$endif}
+    end;
+  end;
+  if P = nil then
+    MessageBox(strings^.get(sTooManyFiles), nil, mfOkButton + mfWarning);
+  NewList(FileList);
+  if List^.Count > 0 then
+  begin
+    Event.What := evBroadcast;
+    Event.Command := cmFileFocused;
+    Event.InfoPtr := List^.At(0);
+    Owner^.HandleEvent(Event);
+  end;
+end;
+
+procedure TFileList.SetData(var Rec);
+begin
+  with PFileDialog(Owner)^ do
+    Self.ReadDirectory(Directory^ + WildCard);
+end;
+
+{****************************************************************************}
+{ TFileInfoPane Object                        }
+{****************************************************************************}
+{****************************************************************************}
+{ TFileInfoPane.Init                    }
+{****************************************************************************}
+constructor TFileInfoPane.Init(var Bounds: TRect);
+begin
+  TView.Init(Bounds);
+  FillChar(S,SizeOf(S),#0);
+  EventMask := EventMask or evBroadcast;
+end;
+
+{****************************************************************************}
+{ TFileInfoPane.Draw                    }
+{****************************************************************************}
+procedure TFileInfoPane.Draw;
+var
+  B: TDrawBuffer;
+  D: String[9];
+  M: String[3];
+  PM: Boolean;
+  Color: Word;
+  Time: DateTime;
+  Path: PathStr;
+  FmtId: String;
+  Params: array[0..7] of LongInt;
+  Str: String[80];
+const
+  sDirectoryLine = ' %-12s %-9s %3s %2d, %4d  %2d:%02d%cm';
+  sFileLine      = ' %-12s %-9d %3s %2d, %4d  %2d:%02d%cm';
+  InValidFiles : array[0..2] of string[12] = ('','.','..');
+var
+  Month: array[1..12] of String[3];
+begin
+  Month[1] := Strings^.Get(smJan);
+  Month[2] := Strings^.Get(smFeb);
+  Month[3] := Strings^.Get(smMar);
+  Month[4] := Strings^.Get(smApr);
+  Month[5] := Strings^.Get(smMay);
+  Month[6] := Strings^.Get(smJun);
+  Month[7] := Strings^.Get(smJul);
+  Month[8] := Strings^.Get(smAug);
+  Month[9] := Strings^.Get(smSep);
+  Month[10] := Strings^.Get(smOct);
+  Month[11] := Strings^.Get(smNov);
+  Month[12] := Strings^.Get(smDec);
+  { Display path }
+  if (PFileDialog(Owner)^.Directory <> nil) then
+    Path := PFileDialog(Owner)^.Directory^
+  else Path := '';
+  Path := FExpand(Path+PFileDialog(Owner)^.WildCard);
+  Color := GetColor($01);
+  MoveChar(B, ' ', Color, Size.X * Size.Y); { fill with empty spaces }
+  WriteLine(0, 0, Size.X, Size.Y, B);
+  MoveStr(B[1], Path, Color);
+  WriteLine(0, 0, Size.X, 1, B);
+  if (S.Name = InValidFiles[0]) or (S.Name = InValidFiles[1]) or
+     (S.Name = InValidFiles[2]) then
+    Exit;
+
+  { Display file }
+  Params[0] := LongInt(@S.Name);
+  if S.Attr and Directory <> 0 then
+  begin
+    FmtId := sDirectoryLine;
+    D := Strings^.Get(sDirectory);
+    Params[1] := LongInt(@D);
+  end else
+  begin
+    FmtId := sFileLine;
+    Params[1] := S.Size;
+  end;
+  UnpackTime(S.Time, Time);
+  M := Month[Time.Month];
+  Params[2] := LongInt(@M);
+  Params[3] := Time.Day;
+  Params[4] := Time.Year;
+  PM := Time.Hour >= 12;
+  Time.Hour := Time.Hour mod 12;
+  if Time.Hour = 0 then Time.Hour := 12;
+  Params[5] := Time.Hour;
+  Params[6] := Time.Min;
+  if PM then
+    Params[7] := Byte('p')
+  else Params[7] := Byte('a');
+  FormatStr(Str, FmtId, Params);
+  MoveStr(B, Str, Color);
+  WriteLine(0, 1, Size.X, 1, B);
+
+  { Fill in rest of rectangle }
+  MoveChar(B, ' ', Color, Size.X);
+  WriteLine(0, 2, Size.X, Size.Y-2, B);
+end;
+
+function TFileInfoPane.GetPalette: PPalette;
+const
+  P: String[Length(CInfoPane)] = CInfoPane;
+begin
+  GetPalette := PPalette(@P);
+end;
+
+procedure TFileInfoPane.HandleEvent(var Event: TEvent);
+begin
+  TView.HandleEvent(Event);
+  if (Event.What = evBroadcast) and (Event.Command = cmFileFocused) then
+  begin
+    S := PSearchRec(Event.InfoPtr)^;
+    DrawView;
+  end;
+end;
+
+{****************************************************************************
+              TFileHistory
+****************************************************************************}
+
+  function LTrim(const S: String): String;
+  var
+    I: Sw_Integer;
+  begin
+    I := 1;
+    while (I < Length(S)) and (S[I] = ' ') do Inc(I);
+    LTrim := Copy(S, I, 255);
+  end;
+
+  function RTrim(const S: String): String;
+  var
+    I: Sw_Integer;
+  begin
+    I := Length(S);
+    while S[I] = ' ' do Dec(I);
+    RTrim := Copy(S, 1, I);
+  end;
+
+  function RelativePath(var S: PathStr): Boolean;
+  begin
+    S := LTrim(RTrim(S));
+    RelativePath := not ((S <> '') and ((S[1] = DirSeparator) or (S[2] = ':')));
+  end;
+
+{ try to reduce the length of S+dir as a file path+pattern }
+
+  function Simplify (var S,Dir : string) : string;
+    var i : sw_integer;
+  begin
+   if RelativePath(Dir) then
+     begin
+        if (S<>'') and (Copy(Dir,1,3)='..'+DirSeparator) then
+          begin
+             i:=Length(S);
+             for i:=Length(S)-1 downto 1 do
+               if S[i]=DirSeparator then
+                 break;
+             if S[i]=DirSeparator then
+               Simplify:=Copy(S,1,i)+Copy(Dir,4,255)
+             else
+               Simplify:=S+Dir;
+          end
+        else
+          Simplify:=S+Dir;
+     end
+   else
+      Simplify:=Dir;
+  end;
+
+{****************************************************************************}
+{ TFileHistory.HandleEvent                                                       }
+{****************************************************************************}
+procedure TFileHistory.HandleEvent(var Event: TEvent);
+var
+  HistoryWindow: PHistoryWindow;
+  R,P: TRect;
+  C: Word;
+  Rslt: String;
+begin
+  TView.HandleEvent(Event);
+  if (Event.What = evMouseDown) or
+     ((Event.What = evKeyDown) and (CtrlToArrow(Event.KeyCode) = kbDown) and
+      (Link^.State and sfFocused <> 0)) then
+  begin
+    if not Link^.Focus then
+    begin
+      ClearEvent(Event);
+      Exit;
+    end;
+    if assigned(CurDir) then
+     Rslt:=CurDir^
+    else
+     Rslt:='';
+    Rslt:=Simplify(Rslt,Link^.Data^);
+    If IsWild(Rslt) then
+      RecordHistory(Rslt);
+    Link^.GetBounds(R);
+    Dec(R.A.X); Inc(R.B.X); Inc(R.B.Y,7); Dec(R.A.Y,1);
+    Owner^.GetExtent(P);
+    R.Intersect(P);
+    Dec(R.B.Y,1);
+    HistoryWindow := InitHistoryWindow(R);
+    if HistoryWindow <> nil then
+    begin
+      C := Owner^.ExecView(HistoryWindow);
+      if C = cmOk then
+      begin
+        Rslt := HistoryWindow^.GetSelection;
+        if Length(Rslt) > Link^.MaxLen then Rslt[0] := Char(Link^.MaxLen);
+        Link^.Data^ := Rslt;
+        Link^.SelectAll(True);
+        Link^.DrawView;
+      end;
+      Dispose(HistoryWindow, Done);
+    end;
+    ClearEvent(Event);
+  end
+  else if (Event.What = evBroadcast) then
+    if ((Event.Command = cmReleasedFocus) and (Event.InfoPtr = Link))
+      or (Event.Command = cmRecordHistory) then
+    begin
+      if assigned(CurDir) then
+       Rslt:=CurDir^
+      else
+       Rslt:='';
+      Rslt:=Simplify(Rslt,Link^.Data^);
+      If IsWild(Rslt) then
+        RecordHistory(Rslt);
+    end;
+end;
+
+procedure TFileHistory.AdaptHistoryToDir(Dir : string);
+  var S,S2 : String;
+      i,Count : Sw_word;
+begin
+   if assigned(CurDir) then
+     begin
+        S:=CurDir^;
+        if S=Dir then
+          exit;
+        DisposeStr(CurDir);
+     end
+   else
+     S:='';
+   CurDir:=NewStr(Simplify(S,Dir));
+
+   Count:=HistoryCount(HistoryId);
+   for i:=1 to count do
+     begin
+        S2:=HistoryStr(HistoryId,1);
+        HistoryRemove(HistoryId,1);
+        if RelativePath(S2) then
+          if S<>'' then
+            S2:=S+S2
+          else
+            S2:=FExpand(S2);
+        { simply full path
+          we should simplify relative to Dir ! }
+        HistoryAdd(HistoryId,S2);
+     end;
+
+end;
+
+destructor TFileHistory.Done;
+begin
+  If assigned(CurDir) then
+    DisposeStr(CurDir);
+  Inherited Done;
+end;
+
+{****************************************************************************
+              TFileDialog
+****************************************************************************}
+
+constructor TFileDialog.Init(AWildCard: TWildStr; const ATitle,
+  InputName: String; AOptions: Word; HistoryId: Byte);
+var
+  Control: PView;
+  R: TRect;
+  Opt: Word;
+begin
+  R.Assign(15,1,64,20);
+  TDialog.Init(R, ATitle);
+  Options := Options or ofCentered;
+  WildCard := AWildCard;
+
+  R.Assign(3,3,31,4);
+  FileName := New(PFileInputLine, Init(R, 79));
+  FileName^.Data^ := WildCard;
+  Insert(FileName);
+  R.Assign(2,2,3+CStrLen(InputName),3);
+  Control := New(PLabel, Init(R, InputName, FileName));
+  Insert(Control);
+  R.Assign(31,3,34,4);
+  FileHistory := New(PFileHistory, Init(R, FileName, HistoryId));
+  Insert(FileHistory);
+
+  R.Assign(3,14,34,15);
+  Control := New(PScrollBar, Init(R));
+  Insert(Control);
+  R.Assign(3,6,34,14);
+  FileList := New(PFileList, Init(R, PScrollBar(Control)));
+  Insert(FileList);
+  R.Assign(2,5,8,6);
+  Control := New(PLabel, Init(R, labels^.get(slFiles), FileList));
+  Insert(Control);
+
+  R.Assign(35,3,46,5);
+  Opt := bfDefault;
+  if AOptions and fdOpenButton <> 0 then
+  begin
+    Insert(New(PButton, Init(R,labels^.get(slOpen), cmFileOpen, Opt)));
+    Opt := bfNormal;
+    Inc(R.A.Y,3); Inc(R.B.Y,3);
+  end;
+  if AOptions and fdOkButton <> 0 then
+  begin
+    Insert(New(PButton, Init(R,labels^.get(slOk), cmFileOpen, Opt)));
+    Opt := bfNormal;
+    Inc(R.A.Y,3); Inc(R.B.Y,3);
+  end;
+  if AOptions and fdReplaceButton <> 0 then
+  begin
+    Insert(New(PButton, Init(R, labels^.get(slReplace),cmFileReplace, Opt)));
+    Opt := bfNormal;
+    Inc(R.A.Y,3); Inc(R.B.Y,3);
+  end;
+  if AOptions and fdClearButton <> 0 then
+  begin
+    Insert(New(PButton, Init(R, labels^.get(slClear),cmFileClear, Opt)));
+    Opt := bfNormal;
+    Inc(R.A.Y,3); Inc(R.B.Y,3);
+  end;
+  Insert(New(PButton, Init(R, labels^.get(slCancel), cmCancel, bfNormal)));
+  Inc(R.A.Y,3); Inc(R.B.Y,3);
+  if AOptions and fdHelpButton <> 0 then
+  begin
+    Insert(New(PButton, Init(R,labels^.get(slHelp),cmHelp, bfNormal)));
+    Inc(R.A.Y,3); Inc(R.B.Y,3);
+  end;
+
+  R.Assign(1,16,48,18);
+  Control := New(PFileInfoPane, Init(R));
+  Insert(Control);
+
+  SelectNext(False);
+
+  if AOptions and fdNoLoadDir = 0 then ReadDirectory;
+end;
+
+constructor TFileDialog.Load(var S: TStream);
+begin
+  if not TDialog.Load(S) then
+    Fail;
+  S.Read(WildCard, SizeOf(TWildStr));
+  if (S.Status <> stOk) then
+  begin
+    TDialog.Done;
+    Fail;
+  end;
+  GetSubViewPtr(S, FileName);
+  GetSubViewPtr(S, FileList);
+  GetSubViewPtr(S, FileHistory);
+  ReadDirectory;
+  if (DosError <> 0) then
+  begin
+    TDialog.Done;
+    Fail;
+  end;
+end;
+
+destructor TFileDialog.Done;
+begin
+  DisposeStr(Directory);
+  TDialog.Done;
+end;
+
+procedure TFileDialog.GetData(var Rec);
+begin
+  GetFilename(PathStr(Rec));
+end;
+
+procedure TFileDialog.GetFileName(var S: PathStr);
+
+var
+  Path: PathStr;
+  Name: NameStr;
+  Ext: ExtStr;
+  TWild : string;
+  TPath: PathStr;
+  TName: NameStr;
+  TExt: NameStr;
+  i : Sw_integer;
+begin
+  S := FileName^.Data^;
+  if RelativePath(S) then
+    begin
+      if (Directory <> nil) then
+   S := FExpand(Directory^ + S);
+    end
+  else
+    S := FExpand(S);
+  if Pos(ListSeparator,S)=0 then
+   begin
+     If FileExists(S) then
+       exit;
+     FSplit(S, Path, Name, Ext);
+     if ((Name = '') or (Ext = '')) and not IsDir(S) then
+     begin
+       TWild:=WildCard;
+       repeat
+    i:=Pos(ListSeparator,TWild);
+    if i=0 then
+     i:=length(TWild)+1;
+    FSplit(Copy(TWild,1,i-1), TPath, TName, TExt);
+    if ((Name = '') and (Ext = '')) then
+      S := Path + TName + TExt
+    else
+      if Name = '' then
+        S := Path + TName + Ext
+      else
+        if Ext = '' then
+          begin
+       if IsWild(Name) then
+         S := Path + Name + TExt
+       else
+         S := Path + Name + NoWildChars(TExt);
+          end;
+    if FileExists(S) then
+     break;
+    System.Delete(TWild,1,i);
+       until TWild='';
+       if TWild='' then
+         S := Path + Name + Ext;
+     end;
+   end;
+end;
+
+procedure TFileDialog.HandleEvent(var Event: TEvent);
+begin
+  if (Event.What and evBroadcast <> 0) and
+     (Event.Command = cmListItemSelected) then
+  begin
+    EndModal(cmFileOpen);
+    ClearEvent(Event);
+  end;
+  TDialog.HandleEvent(Event);
+  if Event.What = evCommand then
+    case Event.Command of
+      cmFileOpen, cmFileReplace, cmFileClear:
+   begin
+     EndModal(Event.Command);
+     ClearEvent(Event);
+   end;
+    end;
+end;
+
+procedure TFileDialog.SetData(var Rec);
+begin
+  TDialog.SetData(Rec);
+  if (PathStr(Rec) <> '') and (IsWild(TWildStr(Rec))) then
+  begin
+    Valid(cmFileInit);
+    FileName^.Select;
+  end;
+end;
+
+procedure TFileDialog.ReadDirectory;
+begin
+  FileList^.ReadDirectory(WildCard);
+  FileHistory^.AdaptHistoryToDir(GetCurDir);
+  Directory := NewStr(GetCurDir);
+end;
+
+procedure TFileDialog.Store(var S: TStream);
+begin
+  TDialog.Store(S);
+  S.Write(WildCard, SizeOf(TWildStr));
+  PutSubViewPtr(S, FileName);
+  PutSubViewPtr(S, FileList);
+  PutSubViewPtr(S, FileHistory);
+end;
+
+function TFileDialog.Valid(Command: Word): Boolean;
+var
+  FName: PathStr;
+  Dir: DirStr;
+  Name: NameStr;
+  Ext: ExtStr;
+
+  function CheckDirectory(var S: PathStr): Boolean;
+  begin
+    if not PathValid(S) then
+    begin
+      MessageBox(Strings^.Get(sInvalidDriveOrDir), nil, mfError + mfOkButton);
+      FileName^.Select;
+      CheckDirectory := False;
+    end else CheckDirectory := True;
+  end;
+
+  function CompleteDir(const Path: string): string;
+  begin
+    { keep c: untouched PM }
+    if (Path<>'') and (Path[Length(Path)]<>DirSeparator) and
+       (Path[Length(Path)]<>':') then
+     CompleteDir:=Path+DirSeparator
+    else
+     CompleteDir:=Path;
+  end;
+
+  function NormalizeDir(const Path: string): string;
+  var Root: boolean;
+  begin
+    Root:=false;
+    {$ifdef Linux}
+    if Path=DirSeparator then Root:=true;
+    {$else}
+    if (length(Path)=3) and (Upcase(Path[1]) in['A'..'Z']) and
+       (Path[2]=':') and (Path[3]=DirSeparator) then
+         Root:=true;
+    {$endif}
+    if (Root=false) and (copy(Path,length(Path),1)=DirSeparator) then
+      NormalizeDir:=copy(Path,1,length(Path)-1)
+    else
+      NormalizeDir:=Path;
+  end;
+function NormalizeDirF(var S: openstring): boolean;
+begin
+  S:=NormalizeDir(S);
+  NormalizeDirF:=true;
+end;
+
+begin
+  if Command = 0 then
+  begin
+    Valid := True;
+    Exit;
+  end
+  else Valid := False;
+  if TDialog.Valid(Command) then
+  begin
+    GetFileName(FName);
+    if (Command <> cmCancel) and (Command <> cmFileClear) then
+    begin
+      if IsWild(FName) or IsList(FName) then
+      begin
+        FSplit(FName, Dir, Name, Ext);
+        if CheckDirectory(Dir) then
+        begin
+          FileHistory^.AdaptHistoryToDir(Dir);
+          DisposeStr(Directory);
+          Directory := NewStr(Dir);
+          if Pos(ListSeparator,FName)>0 then
+           WildCard:=Copy(FName,length(Dir)+1,255)
+          else
+           WildCard := Name+Ext;
+          if Command <> cmFileInit then
+            FileList^.Select;
+          FileList^.ReadDirectory(Directory^+WildCard);
+        end;
+      end
+    else
+      if NormalizeDirF(FName) then
+      { ^^ this is just a dummy if construct (the func always returns true,
+        it's just there, 'coz I don't want to rearrange the following "if"s... }
+      if IsDir(FName) then
+        begin
+          if CheckDirectory(FName) then
+          begin
+            FileHistory^.AdaptHistoryToDir(CompleteDir(FName));
+            DisposeStr(Directory);
+            Directory := NewSTr(CompleteDir(FName));
+            if Command <> cmFileInit then FileList^.Select;
+            FileList^.ReadDirectory(Directory^+WildCard);
+          end
+        end
+      else
+        if ValidFileName(FName) then
+          Valid := True
+        else
+          begin
+            MessageBox(^C + Strings^.Get(sInvalidFileName), nil, mfError + mfOkButton);
+            Valid := False;
+          end;
+    end
+    else Valid := True;
+  end;
+end;
+
+{ TDirCollection }
+
+function TDirCollection.GetItem(var S: TStream): Pointer;
+var
+  DirItem: PDirEntry;
+begin
+  New(DirItem);
+  DirItem^.DisplayText := S.ReadStr;
+  DirItem^.Directory := S.ReadStr;
+  GetItem := DirItem;
+end;
+
+procedure TDirCollection.FreeItem(Item: Pointer);
+var
+  DirItem: PDirEntry absolute Item;
+begin
+  DisposeStr(DirItem^.DisplayText);
+  DisposeStr(DirItem^.Directory);
+  Dispose(DirItem);
+end;
+
+procedure TDirCollection.PutItem(var S: TStream; Item: Pointer);
+var
+  DirItem: PDirEntry absolute Item;
+begin
+  S.WriteStr(DirItem^.DisplayText);
+  S.WriteStr(DirItem^.Directory);
+end;
+
+{ TDirListBox }
+
+const
+  DrivesS: String = '';
+  Drives: PString = @DrivesS;
+
+constructor TDirListBox.Init(var Bounds: TRect; AScrollBar:
+  PScrollBar);
+begin
+  DrivesS := strings^.get(sDrives);
+  TListBox.Init(Bounds, 1, AScrollBar);
+  Dir := '';
+end;
+
+destructor TDirListBox.Done;
+begin
+  if (List <> nil) then
+    Dispose(List,Done);
+  TListBox.Done;
+end;
+
+function TDirListBox.GetText(Item,MaxLen: Sw_Integer): String;
+begin
+  GetText := PDirEntry(List^.At(Item))^.DisplayText^;
+end;
+
+procedure TDirListBox.HandleEvent(var Event: TEvent);
+begin
+  case Event.What of
+    evMouseDown:
+      if Event.Double then
+      begin
+   Event.What := evCommand;
+   Event.Command := cmChangeDir;
+   PutEvent(Event);
+   ClearEvent(Event);
+      end;
+    evKeyboard:
+      if (Event.CharCode = ' ') and
+    (PSearchRec(List^.At(Focused))^.Name = '..') then
+   NewDirectory(PSearchRec(List^.At(Focused))^.Name);
+  end;
+  TListBox.HandleEvent(Event);
+end;
+
+function TDirListBox.IsSelected(Item: Sw_Integer): Boolean;
+begin
+  IsSelected := Item = Cur;
+end;
+
+procedure TDirListBox.NewDirectory(var ADir: DirStr);
+const
+  PathDir       = 'ÀÄÂ';
+  FirstDir     =   'ÀÂÄ';
+  MiddleDir   =   ' ÃÄ';
+  LastDir       =   ' ÀÄ';
+  IndentSize    = '  ';
+var
+  AList: PCollection;
+  NewDir, Dirct: DirStr;
+  C, OldC: Char;
+  S, Indent: String[80];
+  P: PString;
+  isFirst: Boolean;
+  SR: SearchRec;
+  I: Sw_Integer;
+
+  function NewDirEntry(const DisplayText, Directory: String): PDirEntry;{$ifdef PPC_BP}near;{$endif}
+  var
+    DirEntry: PDirEntry;
+  begin
+    New(DirEntry);
+    DirEntry^.DisplayText := NewStr(DisplayText);
+    DirEntry^.Directory := NewStr(Directory);
+    NewDirEntry := DirEntry;
+  end;
+
+begin
+  Dir := ADir;
+  AList := New(PDirCollection, Init(5,5));
+{$ifdef HAS_DOS_DRIVES}
+  AList^.Insert(NewDirEntry(Drives^,Drives^));
+  if Dir = Drives^ then
+  begin
+    isFirst := True;
+    OldC := ' ';
+    for C := 'A' to 'Z' do
+    begin
+      if (C < 'C') or DriveValid(C) then
+      begin
+   if OldC <> ' ' then
+   begin
+     if isFirst then
+     begin
+       S := FirstDir + OldC;
+       isFirst := False;
+     end
+     else S := MiddleDir + OldC;
+     AList^.Insert(NewDirEntry(S, OldC + ':' + DirSeparator));
+   end;
+   if C = GetCurDrive then Cur := AList^.Count;
+   OldC := C;
+      end;
+    end;
+    if OldC <> ' ' then
+      AList^.Insert(NewDirEntry(LastDir + OldC, OldC + ':' + DirSeparator));
+  end
+  else
+{$endif HAS_DOS_DRIVES}
+  begin
+    Indent := IndentSize;
+    NewDir := Dir;
+{$ifdef HAS_DOS_DRIVES}
+    Dirct := Copy(NewDir,1,3);
+    AList^.Insert(NewDirEntry(PathDir + Dirct, Dirct));
+    NewDir := Copy(NewDir,4,255);
+{$else HAS_DOS_DRIVES}
+    Dirct := '';
+{$endif HAS_DOS_DRIVES}
+    while NewDir <> '' do
+    begin
+      I := Pos(DirSeparator,NewDir);
+      if I <> 0 then
+      begin
+   S := Copy(NewDir,1,I-1);
+   Dirct := Dirct + S;
+   AList^.Insert(NewDirEntry(Indent + PathDir + S, Dirct));
+   NewDir := Copy(NewDir,I+1,255);
+      end
+      else
+      begin
+   Dirct := Dirct + NewDir;
+   AList^.Insert(NewDirEntry(Indent + PathDir + NewDir, Dirct));
+   NewDir := '';
+      end;
+      Indent := Indent + IndentSize;
+      Dirct := Dirct + DirSeparator;
+    end;
+    Cur := AList^.Count-1;
+    isFirst := True;
+    NewDir := Dirct + '*.*';
+    FindFirst(NewDir, Directory, SR);
+    while DosError = 0 do
+    begin
+      if (SR.Attr and Directory <> 0) and
+{$ifdef FPC}
+         (SR.Name <> '.') and (SR.Name <> '..') then
+{$else : not FPC}
+         (SR.Name[1] <> '.') then
+{$endif not FPC}
+      begin
+   if isFirst then
+   begin
+     S := FirstDir;
+     isFirst := False;
+   end else S := MiddleDir;
+   AList^.Insert(NewDirEntry(Indent + S + SR.Name, Dirct + SR.Name));
+      end;
+      FindNext(SR);
+    end;
+ {$ifdef fpc}
+  FindClose(SR);
+ {$endif}
+    P := PDirEntry(AList^.At(AList^.Count-1))^.DisplayText;
+    I := Pos('À',P^);
+    if I = 0 then
+    begin
+      I := Pos('Ã',P^);
+      if I <> 0 then P^[I] := 'À';
+    end else
+    begin
+      P^[I+1] := 'Ä';
+      P^[I+2] := 'Ä';
+    end;
+  end;
+  NewList(AList);
+  FocusItem(Cur);
+end;
+
+procedure TDirListBox.SetState(AState: Word; Enable: Boolean);
+begin
+  TListBox.SetState(AState, Enable);
+  if AState and sfFocused <> 0 then
+    PChDirDialog(Owner)^.ChDirButton^.MakeDefault(Enable);
+end;
+
+{****************************************************************************}
+{ TChDirDialog Object                     }
+{****************************************************************************}
+{****************************************************************************}
+{ TChDirDialog.Init                      }
+{****************************************************************************}
+constructor TChDirDialog.Init(AOptions: Word; HistoryId: Sw_Word);
+var
+  R: TRect;
+  Control: PView;
+begin
+  R.Assign(16, 2, 64, 20);
+  TDialog.Init(R,strings^.get(sChangeDirectory));
+
+  Options := Options or ofCentered;
+
+  R.Assign(3, 3, 30, 4);
+  DirInput := New(PInputLine, Init(R, 68));
+  Insert(DirInput);
+  R.Assign(2, 2, 17, 3);
+  Control := New(PLabel, Init(R,labels^.get(slDirectoryName), DirInput));
+  Insert(Control);
+  R.Assign(30, 3, 33, 4);
+  Control := New(PHistory, Init(R, DirInput, HistoryId));
+  Insert(Control);
+
+  R.Assign(32, 6, 33, 16);
+  Control := New(PScrollBar, Init(R));
+  Insert(Control);
+  R.Assign(3, 6, 32, 16);
+  DirList := New(PDirListBox, Init(R, PScrollBar(Control)));
+  Insert(DirList);
+  R.Assign(2, 5, 17, 6);
+  Control := New(PLabel, Init(R, labels^.get(slDirectoryTree), DirList));
+  Insert(Control);
+
+  R.Assign(35, 6, 45, 8);
+  OkButton := New(PButton, Init(R, labels^.get(slOk), cmOK, bfDefault));
+  Insert(OkButton);
+  Inc(R.A.Y,3); Inc(R.B.Y,3);
+  ChDirButton := New(PButton,Init(R,labels^.get(slChDir),cmChangeDir,
+           bfNormal));
+  Insert(ChDirButton);
+  Inc(R.A.Y,3); Inc(R.B.Y,3);
+  Insert(New(PButton, Init(R,labels^.get(slRevert), cmRevert, bfNormal)));
+  if AOptions and cdHelpButton <> 0 then
+  begin
+    Inc(R.A.Y,3); Inc(R.B.Y,3);
+    Insert(New(PButton, Init(R,labels^.get(slHelp), cmHelp, bfNormal)));
+  end;
+
+  if AOptions and cdNoLoadDir = 0 then SetUpDialog;
+
+  SelectNext(False);
+end;
+
+{****************************************************************************}
+{ TChDirDialog.Load                      }
+{****************************************************************************}
+constructor TChDirDialog.Load(var S: TStream);
+begin
+  TDialog.Load(S);
+  GetSubViewPtr(S, DirList);
+  GetSubViewPtr(S, DirInput);
+  GetSubViewPtr(S, OkButton);
+  GetSubViewPtr(S, ChDirbutton);
+  SetUpDialog;
+end;
+
+{****************************************************************************}
+{ TChDirDialog.DataSize                      }
+{****************************************************************************}
+function TChDirDialog.DataSize: Sw_Word;
+begin
+  DataSize := 0;
+end;
+
+{****************************************************************************}
+{ TChDirDialog.GetData                        }
+{****************************************************************************}
+procedure TChDirDialog.GetData(var Rec);
+begin
+end;
+
+{****************************************************************************}
+{ TChDirDialog.HandleEvent                   }
+{****************************************************************************}
+procedure TChDirDialog.HandleEvent(var Event: TEvent);
+var
+  CurDir: DirStr;
+  P: PDirEntry;
+begin
+  TDialog.HandleEvent(Event);
+  case Event.What of
+    evCommand:
+      begin
+   case Event.Command of
+     cmRevert: GetDir(0,CurDir);
+     cmChangeDir:
+       begin
+         P := DirList^.List^.At(DirList^.Focused);
+         if (P^.Directory^ = Drives^)
+            or DriveValid(P^.Directory^[1]) then
+           CurDir := P^.Directory^
+         else Exit;
+       end;
+   else
+     Exit;
+   end;
+   if (Length(CurDir) > 3) and
+      (CurDir[Length(CurDir)] = DirSeparator) then
+     CurDir := Copy(CurDir,1,Length(CurDir)-1);
+   DirList^.NewDirectory(CurDir);
+   DirInput^.Data^ := CurDir;
+   DirInput^.DrawView;
+   DirList^.Select;
+   ClearEvent(Event);
+      end;
+  end;
+end;
+
+{****************************************************************************}
+{ TChDirDialog.SetData                        }
+{****************************************************************************}
+procedure TChDirDialog.SetData(var Rec);
+begin
+end;
+
+{****************************************************************************}
+{ TChDirDialog.SetUpDialog                   }
+{****************************************************************************}
+procedure TChDirDialog.SetUpDialog;
+var
+  CurDir: DirStr;
+begin
+  if DirList <> nil then
+  begin
+    CurDir := GetCurDir;
+    DirList^.NewDirectory(CurDir);
+    if (Length(CurDir) > 3) and (CurDir[Length(CurDir)] = DirSeparator) then
+      CurDir := Copy(CurDir,1,Length(CurDir)-1);
+    if DirInput <> nil then
+    begin
+      DirInput^.Data^ := CurDir;
+      DirInput^.DrawView;
+    end;
+  end;
+end;
+
+{****************************************************************************}
+{ TChDirDialog.Store                    }
+{****************************************************************************}
+procedure TChDirDialog.Store(var S: TStream);
+begin
+  TDialog.Store(S);
+  PutSubViewPtr(S, DirList);
+  PutSubViewPtr(S, DirInput);
+  PutSubViewPtr(S, OkButton);
+  PutSubViewPtr(S, ChDirButton);
+end;
+
+{****************************************************************************}
+{ TChDirDialog.Valid                    }
+{****************************************************************************}
+function TChDirDialog.Valid(Command: Word): Boolean;
+var
+  P: PathStr;
+begin
+  Valid := True;
+  if Command = cmOk then
+  begin
+    P := FExpand(DirInput^.Data^);
+    if (Length(P) > 3) and (P[Length(P)] = DirSeparator) then
+      Dec(P[0]);
+    {$I-}
+    ChDir(P);
+    if (IOResult <> 0) then
+    begin
+      MessageBox(Strings^.Get(sInvalidDirectory), nil, mfError + mfOkButton);
+      Valid := False;
+    end;
+    {$I+}
+  end;
+end;
+
+{****************************************************************************}
+{ TEditChDirDialog Object                     }
+{****************************************************************************}
+{****************************************************************************}
+{ TEditChDirDialog.DataSize                    }
+{****************************************************************************}
+function TEditChDirDialog.DataSize : Sw_Word;
+begin
+  DataSize := SizeOf(DirStr);
+end;
+
+{****************************************************************************}
+{ TEditChDirDialog.GetData                   }
+{****************************************************************************}
+procedure TEditChDirDialog.GetData (var Rec);
+var
+  CurDir : DirStr absolute Rec;
+begin
+  if (DirInput = nil) then
+    CurDir := ''
+  else begin
+    CurDir := DirInput^.Data^;
+    if (CurDir[Length(CurDir)] <> DirSeparator) then
+      CurDir := CurDir + DirSeparator;
+  end;
+end;
+
+{****************************************************************************}
+{ TEditChDirDialog.SetData                   }
+{****************************************************************************}
+procedure TEditChDirDialog.SetData (var Rec);
+var
+  CurDir : DirStr absolute Rec;
+begin
+  if DirList <> nil then
+  begin
+    DirList^.NewDirectory(CurDir);
+    if DirInput <> nil then
+    begin
+      if (Length(CurDir) > 3) and (CurDir[Length(CurDir)] = DirSeparator) then
+   DirInput^.Data^ := Copy(CurDir,1,Length(CurDir)-1)
+      else DirInput^.Data^ := CurDir;
+      DirInput^.DrawView;
+    end;
+  end;
+end;
+
+{****************************************************************************}
+{ TSortedListBox Object                      }
+{****************************************************************************}
+{****************************************************************************}
+{ TSortedListBox.Init                     }
+{****************************************************************************}
+constructor TSortedListBox.Init(var Bounds: TRect; ANumCols: Sw_Word;
+  AScrollBar: PScrollBar);
+begin
+  TListBox.Init(Bounds, ANumCols, AScrollBar);
+  SearchPos := 0;
+  ShowCursor;
+  SetCursor(1,0);
+end;
+
+{****************************************************************************}
+{ TSortedListBox.HandleEvent                  }
+{****************************************************************************}
+procedure TSortedListBox.HandleEvent(var Event: TEvent);
+const
+  SpecialChars: set of Char = [#0,#9,#27];
+var
+  CurString, NewString: String;
+  K: Pointer;
+  Value : Sw_integer;
+  OldPos, OldValue: Sw_Integer;
+  T: Boolean;
+begin
+  OldValue := Focused;
+  TListBox.HandleEvent(Event);
+  if (OldValue <> Focused) or
+     ((Event.What = evBroadcast) and (Event.InfoPtr = @Self) and
+      (Event.Command = cmReleasedFocus)) then
+    SearchPos := 0;
+  if Event.What = evKeyDown then
+  begin
+    { patched to prevent error when no or empty list or Escape pressed }
+    if (not (Event.CharCode in SpecialChars)) and
+       (List <> nil) and (List^.Count > 0) then
+    begin
+      Value := Focused;
+      if Value < Range then CurString := GetText(Value, 255)
+      else CurString := '';
+      OldPos := SearchPos;
+      if Event.KeyCode = kbBack then
+      begin
+   if SearchPos = 0 then Exit;
+   Dec(SearchPos);
+   if SearchPos = 0 then ShiftState := GetShiftState;
+   CurString[0] := Char(SearchPos);
+      end
+      else if (Event.CharCode = '.') then SearchPos := Pos('.',CurString)
+      else
+      begin
+   Inc(SearchPos);
+   if SearchPos = 1 then ShiftState := GetShiftState;
+   CurString[0] := Char(SearchPos);
+   CurString[SearchPos] := Event.CharCode;
+      end;
+      K := GetKey(CurString);
+      T := PSortedCollection(List)^.Search(K, Value);
+      if Value < Range then
+      begin
+   if Value < Range then NewString := GetText(Value, 255)
+   else NewString := '';
+   if Equal(NewString, CurString, SearchPos) then
+   begin
+     if Value <> OldValue then
+     begin
+       FocusItem(Value);
+       { Assumes ListControl will set the cursor to the first character }
+       { of the sfFocused item }
+       SetCursor(Cursor.X+SearchPos, Cursor.Y);
+     end
+     else SetCursor(Cursor.X+(SearchPos-OldPos), Cursor.Y);
+   end
+   else SearchPos := OldPos;
+      end
+      else SearchPos := OldPos;
+      if (SearchPos <> OldPos) or (Event.CharCode in ['A'..'Z','a'..'z']) then
+   ClearEvent(Event);
+    end
+  end;
+end;
+
+function TSortedListBox.GetKey(var S: String): Pointer;
+begin
+  GetKey := @S;
+end;
+
+procedure TSortedListBox.NewList(AList: PCollection);
+begin
+  TListBox.NewList(AList);
+  SearchPos := 0;
+end;
+
+{****************************************************************************}
+{            Global Procedures and Functions          }
+{****************************************************************************}
+
+{****************************************************************************}
+{ Contains                          }
+{****************************************************************************}
+function Contains(S1, S2: String): Boolean;
+  { Contains returns true if S1 contains any characters in S2. }
+var
+  i : Byte;
+begin
+  Contains := True;
+  i := 1;
+  while ((i < Length(S2)) and (i < Length(S1))) do
+    if (Upcase(S1[i]) = Upcase(S2[i])) then
+      Exit
+    else Inc(i);
+  Contains := False;
+end;
+
+{****************************************************************************}
+{ StdDeleteFile                           }
+{****************************************************************************}
+function StdDeleteFile (AFile : FNameStr) : Boolean;
+var
+  Rec : PStringRec;
+begin
+  if CheckOnDelete then
+  begin
+    AFile := ShrinkPath(AFile,33);
+    Rec.AString := PString(@AFile);
+    StdDeleteFile := (MessageBox(^C + Strings^.Get(sDeleteFile),
+               @Rec,mfConfirmation or mfOkCancel) = cmOk);
+  end
+  else StdDeleteFile := False;
+end;
+
+{****************************************************************************}
+{ DriveValid                         }
+{****************************************************************************}
+function DriveValid(Drive: Char): Boolean;
+{$ifdef HAS_DOS_DRIVES}
+var
+  D: Char;
+begin
+  D := GetCurDrive;
+  {$I-}
+  ChDir(Drive+':');
+  if (IOResult = 0) then
+  begin
+    DriveValid := True;
+    ChDir(D+':')
+  end
+  else DriveValid := False;
+  {$I+}
+end;
+{$else HAS_DOS_DRIVES}
+begin
+  DriveValid:=true;
+end;
+{$endif HAS_DOS_DRIVES}
+
+{****************************************************************************}
+{ Equal                             }
+{****************************************************************************}
+function Equal(const S1, S2: String; Count: Sw_word): Boolean;
+var
+  i: Sw_Word;
+begin
+  Equal := False;
+  if (Length(S1) < Count) or (Length(S2) < Count) then
+    Exit;
+  for i := 1 to Count do
+    if UpCase(S1[I]) <> UpCase(S2[I]) then
+      Exit;
+  Equal := True;
+end;
+
+{****************************************************************************}
+{ ExtractDir                         }
+{****************************************************************************}
+function ExtractDir(AFile: FNameStr): DirStr;
+  { ExtractDir returns the path of AFile terminated with a trailing '\'.  If
+    AFile contains no directory information, an empty string is returned. }
+var
+  D: DirStr;
+  N: NameStr;
+  E: ExtStr;
+begin
+  FSplit(AFile,D,N,E);
+  if D = '' then
+  begin
+    ExtractDir := '';
+    Exit;
+  end;
+  if D[Byte(D[0])] <> DirSeparator then
+    D := D + DirSeparator;
+  ExtractDir := D;
+end;
+
+{****************************************************************************}
+{ ExtractFileName                       }
+{****************************************************************************}
+function ExtractFileName(AFile: FNameStr): NameStr;
+var
+  D: DirStr;
+  N: NameStr;
+  E: ExtStr;
+begin
+  FSplit(AFile,D,N,E);
+  ExtractFileName := N;
+end;
+
+{****************************************************************************}
+{ FileExists                         }
+{****************************************************************************}
+function FileExists (AFile : FNameStr) : Boolean;
+begin
+  FileExists := (FSearch(AFile,'') <> '');
+end;
+
+{****************************************************************************}
+{ GetCurDir                        }
+{****************************************************************************}
+function GetCurDir: DirStr;
+var
+  CurDir: DirStr;
+begin
+  GetDir(0, CurDir);
+  if (Length(CurDir) > 3) then
+  begin
+    Inc(CurDir[0]);
+    CurDir[Length(CurDir)] := DirSeparator;
+  end;
+  GetCurDir := CurDir;
+end;
+
+{****************************************************************************}
+{ GetCurDrive                       }
+{****************************************************************************}
+function GetCurDrive: Char;
+{$ifdef go32v2}
+var
+  Regs : Registers;
+begin
+  Regs.AH := $19;
+  Intr($21,Regs);
+  GetCurDrive := Char(Regs.AL + Byte('A'));
+end;
+{$else not go32v2}
+var
+  D : DirStr;
+begin
+  D:=GetCurDir;
+  if (Length(D)>1) and (D[2]=':') then
+    begin
+      if (D[1]>='a') and (D[1]<='z') then
+        GetCurDrive:=Char(Byte(D[1])+Byte('A')-Byte('a'))
+      else
+        GetCurDrive:=D[1];
+    end
+  else
+    GetCurDrive:='C';
+end;
+{$endif not go32v2}
+
+{****************************************************************************}
+{ IsDir                             }
+{****************************************************************************}
+function IsDir(const S: String): Boolean;
+var
+  SR: SearchRec;
+  Is: boolean;
+begin
+  Is:=false;
+{$ifdef Linux}
+  Is:=(S=DirSeparator); { handle root }
+{$else}
+  Is:=(length(S)=3) and (Upcase(S[1]) in['A'..'Z']) and (S[2]=':') and (S[3]=DirSeparator);
+  { handle root dirs }
+{$endif}
+  if Is=false then
+  begin
+    FindFirst(S, Directory, SR);
+    if DosError = 0 then
+      Is := (SR.Attr and Directory) <> 0
+    else
+      Is := False;
+   {$ifdef fpc}
+    FindClose(SR);
+   {$endif}
+  end;
+  IsDir:=Is;
+end;
+
+{****************************************************************************}
+{ IsWild                           }
+{****************************************************************************}
+function IsWild(const S: String): Boolean;
+begin
+  IsWild := (Pos('?',S) > 0) or (Pos('*',S) > 0);
+end;
+
+{****************************************************************************}
+{ IsList                           }
+{****************************************************************************}
+function IsList(const S: String): Boolean;
+begin
+  IsList := (Pos(ListSeparator,S) > 0);
+end;
+
+{****************************************************************************}
+{ MakeResources                           }
+{****************************************************************************}
+procedure MakeResources;
+var
+  Dlg : PDialog;
+  Key : String;
+  i : Word;
+begin
+  for i := 0 to 1 do
+  begin
+    case i of
+      0 : begin
+       Key := reOpenDlg;
+       Dlg := New(PFileDialog,Init('*.*',strings^.get(sOpen),
+             labels^.get(slName),
+             fdOkButton or fdHelpButton or fdNoLoadDir,0));
+     end;
+      1 : begin
+       Key := reSaveAsDlg;
+       Dlg := New(PFileDialog,Init('*.*',strings^.get(sSaveAs),
+             labels^.get(slName),
+             fdOkButton or fdHelpButton or fdNoLoadDir,0));
+     end;
+      2 : begin
+       Key := reEditChDirDialog;
+       Dlg := New(PEditChDirDialog,Init(cdHelpButton,
+             hiCurrentDirectories));
+     end;
+    end;
+    if Dlg = nil then
+    begin
+       PrintStr('Error initializing dialog ' + Key);
+       Halt;
+    end
+    else begin
+      RezFile^.Put(Dlg,Key);
+      if (RezFile^.Stream^.Status <> stOk) then
+      begin
+   PrintStr('Error writing dialog ' + Key + ' to the resource file.');
+   Halt;
+      end;
+    end;
+  end;
+end;
+
+{****************************************************************************}
+{ NoWildChars                       }
+{****************************************************************************}
+function NoWildChars(S: String): String;
+const
+  WildChars : array[0..1] of Char = ('?','*');
+var
+  i : Sw_Word;
+begin
+  repeat
+    i := Pos('?',S);
+    if (i > 0) then
+      System.Delete(S,i,1);
+  until (i = 0);
+  repeat
+    i := Pos('*',S);
+    if (i > 0) then
+      System.Delete(S,i,1);
+  until (i = 0);
+  NoWildChars:=S;
+end;
+
+{****************************************************************************}
+{ OpenFile                          }
+{****************************************************************************}
+function OpenFile (var AFile : FNameStr; HistoryID : Byte) : Boolean;
+var
+  Dlg : PFileDialog;
+begin
+  {$ifdef cdResource}
+  Dlg := PFileDialog(RezFile^.Get(reOpenDlg));
+  {$else}
+  Dlg := New(PFileDialog,Init('*.*',strings^.get(sOpen),labels^.get(slName),
+        fdOkButton or fdHelpButton,0));
+  {$endif cdResource}
+    { this might not work }
+  PHistory(Dlg^.FileName^.Next^.Next)^.HistoryID := HistoryID;
+  OpenFile := (Application^.ExecuteDialog(Dlg,@AFile) = cmFileOpen);
+end;
+
+{****************************************************************************}
+{ OpenNewFile                       }
+{****************************************************************************}
+function OpenNewFile (var AFile: FNameStr; HistoryID: Byte): Boolean;
+  { OpenNewFile allows the user to select a directory from disk and enter a
+    new file name.  If the file name entered is an existing file the user is
+    optionally prompted for confirmation of replacing the file based on the
+    value in #CheckOnReplace#.  If a file name is successfully entered,
+    OpenNewFile returns True. }
+  {#X OpenFile }
+begin
+  OpenNewFile := False;
+  if OpenFile(AFile,HistoryID) then
+  begin
+    if not ValidFileName(AFile) then
+      Exit;
+    if FileExists(AFile) then
+      if (not CheckOnReplace) or (not ReplaceFile(AFile)) then
+   Exit;
+    OpenNewFile := True;
+  end;
+end;
+
+{****************************************************************************}
+{ PathValid                        }
+{****************************************************************************}
+{$ifdef go32v2}
+{$define NetDrive}
+{$endif go32v2}
+{$ifdef win32}
+{$define NetDrive}
+{$endif win32}
+function PathValid (var Path: PathStr): Boolean;
+var
+  ExpPath: PathStr;
+  SR: SearchRec;
+begin
+  ExpPath := FExpand(Path);
+{$ifdef HAS_DOS_DRIVES}
+  if (Length(ExpPath) <= 3) then
+    PathValid := DriveValid(ExpPath[1])
+  else
+{$endif}
+  begin
+    { do not change '/' into '' }
+    if (Length(ExpPath)>1) and (ExpPath[Length(ExpPath)] = DirSeparator) then
+      Dec(ExpPath[0]);
+    FindFirst(ExpPath, Directory, SR);
+    PathValid := (DosError = 0) and (SR.Attr and Directory <> 0);
+{$ifdef NetDrive}
+    if DosError=66 then
+      begin
+      {$ifdef fpc}
+        FindClose(SR);
+      {$endif}
+        FindFirst(ExpPath+'\*',AnyFile,SR);
+        PathValid:=(DosError = 0);
+      end;
+{$endif NetDrive}
+    {$ifdef fpc}
+    FindClose(SR);
+   {$endif}
+  end;
+end;
+
+{****************************************************************************}
+{ RegisterStdDlg                         }
+{****************************************************************************}
+procedure RegisterStdDlg;
+begin
+  RegisterType(RFileInputLine);
+  RegisterType(RFileCollection);
+  RegisterType(RFileList);
+  RegisterType(RFileInfoPane);
+  RegisterType(RFileDialog);
+  RegisterType(RDirCollection);
+  RegisterType(RDirListBox);
+  RegisterType(RSortedListBox);
+  RegisterType(RChDirDialog);
+end;
+
+{****************************************************************************}
+{ StdReplaceFile                         }
+{****************************************************************************}
+function StdReplaceFile (AFile : FNameStr) : Boolean;
+var
+  Rec : PStringRec;
+begin
+  if CheckOnReplace then
+  begin
+    AFile := ShrinkPath(AFile,33);
+    Rec.AString := PString(@AFile);
+    StdReplaceFile :=
+       (MessageBox(^C + Strings^.Get(sReplaceFile),
+         @Rec,mfConfirmation or mfOkCancel) = cmOk);
+  end
+  else StdReplaceFile := True;
+end;
+
+{****************************************************************************}
+{ SaveAs                           }
+{****************************************************************************}
+function SaveAs (var AFile : FNameStr; HistoryID : Word) : Boolean;
+var
+  Dlg : PFileDialog;
+begin
+  SaveAs := False;
+  {$ifdef cdResource}
+  Dlg := PFileDialog(RezFile^.Get(reSaveAsDlg));
+  {$else}
+  Dlg := New(PFileDialog,Init('*.*',strings^.get(sSaveAs),
+        labels^.get(slSaveAs),
+        fdOkButton or fdHelpButton,0));
+  {$endif cdResource}
+    { this might not work }
+  PHistory(Dlg^.FileName^.Next^.Next)^.HistoryID := HistoryID;
+  Dlg^.HelpCtx := hcSaveAs;
+  if (Application^.ExecuteDialog(Dlg,@AFile) = cmFileOpen) and
+     ((not FileExists(AFile)) or ReplaceFile(AFile)) then
+    SaveAs := True;
+end;
+
+{****************************************************************************}
+{ SelectDir                        }
+{****************************************************************************}
+function SelectDir (var ADir : DirStr; HistoryID : Byte) : Boolean;
+var
+  Dir: DirStr;
+  Dlg : PEditChDirDialog;
+  Rec : DirStr;
+begin
+  {$I-}
+  GetDir(0,Dir);
+  {$I+}
+  Rec := FExpand(ADir);
+  {$ifdef cdResource}
+  Dlg := PEditChDirDialog(RezFile^.Get(reEditChDirDialog));
+  {$else}
+  Dlg := New(PEditChDirDialog,Init(cdHelpButton,HistoryID));
+  {$endif cdResource}
+  if (Application^.ExecuteDialog(Dlg,@Rec) = cmOk) then
+  begin
+    SelectDir := True;
+    ADir := Rec;
+  end
+  else SelectDir := False;
+  {$I-}
+  ChDir(Dir);
+  {$I+}
+end;
+
+{****************************************************************************}
+{ ShrinkPath                         }
+{****************************************************************************}
+function ShrinkPath (AFile : FNameStr; MaxLen : Byte) : FNameStr;
+var
+  Filler: string;
+  D1 : DirStr;
+  N1 : NameStr;
+  E1 : ExtStr;
+  i  : Sw_Word;
+
+begin
+  if Length(AFile) > MaxLen then
+  begin
+    FSplit(FExpand(AFile),D1,N1,E1);
+    AFile := Copy(D1,1,3) + '..' + DirSeparator;
+    i := Pred(Length(D1));
+    while (i > 0) and (D1[i] <> DirSeparator) do
+      Dec(i);
+    if (i = 0) then
+      AFile := AFile + D1
+    else AFile := AFile + Copy(D1,Succ(i),Length(D1)-i);
+    if AFile[Length(AFile)] <> DirSeparator then
+      AFile := AFile + DirSeparator;
+    if Length(AFile)+Length(N1)+Length(E1) <= MaxLen then
+      AFile := AFile + N1 + E1
+    else
+      begin
+        Filler := '...' + DirSeparator;
+        AFile:=Copy(Afile,1,MaxLen-Length(Filler)-Length(N1)-Length(E1))
+                +Filler+N1+E1;
+      end;
+  end;
+  ShrinkPath := AFile;
+end;
+
+{****************************************************************************}
+{ ValidFileName                           }
+{****************************************************************************}
+function ValidFileName(var FileName: PathStr): Boolean;
+var
+  IllegalChars: string[12];
+  Dir: DirStr;
+  Name: NameStr;
+  Ext: ExtStr;
+begin
+{$ifdef PPC_FPC}
+{$ifdef go32v2}
+  { spaces are allowed if LFN is supported }
+  if LFNSupport then
+    IllegalChars := ';,=+<>|"[]'+DirSeparator
+  else
+    IllegalChars := ';,=+<>|"[] '+DirSeparator;
+{$else not go32v2}
+{$ifdef win32}
+    IllegalChars := ';,=+<>|"[]'+DirSeparator;
+{$else not go32v2 and not win32 }
+    IllegalChars := ';,=+<>|"[] '+DirSeparator;
+{$endif not win32}
+{$endif not go32v2}
+{$else not PPC_FPC}
+  IllegalChars := ';,=+<>|"[] '+DirSeparator;
+{$endif PPC_FPC}
+  ValidFileName := True;
+  FSplit(FileName, Dir, Name, Ext);
+  if not ((Dir = '') or PathValid(Dir)) or
+     Contains(Name, IllegalChars) or
+     Contains(Dir, IllegalChars) then
+    ValidFileName := False;
+end;
+
+{****************************************************************************}
+{        Unit Initialization Section                                         }
+{****************************************************************************}
+begin
+{$ifdef PPC_BP}
+  ReplaceFile := StdReplaceFile;
+  DeleteFile := StdDeleteFile;
+{$else}
+  ReplaceFile := @StdReplaceFile;
+  DeleteFile := @StdDeleteFile;
+{$endif PPC_BP}
+end.

+ 530 - 0
fvision/tabs.pas

@@ -0,0 +1,530 @@
+unit tabs;
+interface
+
+uses
+  objects,drivers,views;
+
+type
+    PTabItem = ^TTabItem;
+    TTabItem = record
+      Next : PTabItem;
+      View : PView;
+      Dis  : boolean;
+    end;
+
+    PTabDef = ^TTabDef;
+    TTabDef = record
+      Next     : PTabDef;
+      Name     : PString;
+      Items    : PTabItem;
+      DefItem  : PView;
+      ShortCut : char;
+    end;
+
+    PTab = ^TTab;
+    TTab = object(TGroup)
+      TabDefs   : PTabDef;
+      ActiveDef : integer;
+      DefCount  : word;
+      constructor Init(var Bounds: TRect; ATabDef: PTabDef);
+      function    AtTab(Index: integer): PTabDef; virtual;
+      procedure   SelectTab(Index: integer); virtual;
+      function    TabCount: integer;
+      function    Valid(Command: Word): Boolean; virtual;
+      procedure   ChangeBounds(var Bounds: TRect); virtual;
+      procedure   HandleEvent(var Event: TEvent); virtual;
+      function    GetPalette: PPalette; virtual;
+      procedure   Draw; virtual;
+      procedure   SetData(var Rec);virtual;
+      procedure   GetData(var Rec);virtual;
+      procedure   SetState(AState: Word; Enable: Boolean); virtual;
+      destructor  Done; virtual;
+    private
+      InDraw: boolean;
+    end;
+
+function  NewTabItem(AView: PView; ANext: PTabItem): PTabItem;
+procedure DisposeTabItem(P: PTabItem);
+function  NewTabDef(AName: string; ADefItem: PView; AItems: PTabItem; ANext: PTabDef): PTabDef;
+procedure DisposeTabDef(P: PTabDef);
+
+
+implementation
+
+uses
+  FvCommon,dialogs;
+
+constructor TTab.Init(var Bounds: TRect; ATabDef: PTabDef);
+begin
+  inherited Init(Bounds);
+  Options:=Options or ofSelectable or ofFirstClick or ofPreProcess or ofPostProcess;
+  GrowMode:=gfGrowHiX+gfGrowHiY+gfGrowRel;
+  TabDefs:=ATabDef;
+  ActiveDef:=-1;
+  SelectTab(0);
+  ReDraw;
+end;
+
+function TTab.TabCount: integer;
+var i: integer;
+    P: PTabDef;
+begin
+  I:=0; P:=TabDefs;
+  while (P<>nil) do
+    begin
+      Inc(I);
+      P:=P^.Next;
+    end;
+  TabCount:=I;
+end;
+
+
+function TTab.AtTab(Index: integer): PTabDef;
+var i: integer;
+    P: PTabDef;
+begin
+  i:=0; P:=TabDefs;
+  while (I<Index) do
+    begin
+      if P=nil then RunError($AA);
+      P:=P^.Next;
+      Inc(i);
+    end;
+  AtTab:=P;
+end;
+
+procedure TTab.SelectTab(Index: integer);
+var P: PTabItem;
+    V: PView;
+begin
+  if ActiveDef<>Index then
+  begin
+    if Owner<>nil then Owner^.Lock;
+    Lock;
+    { --- Update --- }
+    if TabDefs<>nil then
+       begin
+         DefCount:=1;
+         while AtTab(DefCount-1)^.Next<>nil do Inc(DefCount);
+       end
+       else DefCount:=0;
+    if ActiveDef<>-1 then
+    begin
+      P:=AtTab(ActiveDef)^.Items;
+      while P<>nil do
+        begin
+          if P^.View<>nil then Delete(P^.View);
+          P:=P^.Next;
+        end;
+    end;
+    ActiveDef:=Index;
+    P:=AtTab(ActiveDef)^.Items;
+    while P<>nil do
+      begin
+        if P^.View<>nil then Insert(P^.View);
+        P:=P^.Next;
+      end;
+    V:=AtTab(ActiveDef)^.DefItem;
+    if V<>nil then V^.Select;
+    ReDraw;
+    { --- Update --- }
+    UnLock;
+    if Owner<>nil then Owner^.UnLock;
+    DrawView;
+  end;
+end;
+
+procedure TTab.ChangeBounds(var Bounds: TRect);
+var D: TPoint;
+procedure DoCalcChange(P: PView); {$ifndef FPC}far;{$endif}
+var
+  R: TRect;
+begin
+  if P^.Owner=nil then Exit; { it think this is a bug in TV }
+  P^.CalcBounds(R, D);
+  P^.ChangeBounds(R);
+end;
+var
+    P: PTabItem;
+    I: integer;
+begin
+  D.X := Bounds.B.X - Bounds.A.X - Size.X;
+  D.Y := Bounds.B.Y - Bounds.A.Y - Size.Y;
+  inherited ChangeBounds(Bounds);
+  for I:=0 to TabCount-1 do
+  if I<>ActiveDef then
+    begin
+      P:=AtTab(I)^.Items;
+      while P<>nil do
+        begin
+          if P^.View<>nil then DoCalcChange(P^.View);
+          P:=P^.Next;
+        end;
+    end;
+end;
+
+procedure TTab.HandleEvent(var Event: TEvent);
+var Index : integer;
+    I     : integer;
+    X     : integer;
+    Len   : byte;
+    P     : TPoint;
+    V     : PView;
+    CallOrig: boolean;
+    LastV : PView;
+    FirstV: PView;
+function FirstSelectable: PView;
+var
+    FV : PView;
+begin
+  FV := First;
+  while (FV<>nil) and ((FV^.Options and ofSelectable)=0) and (FV<>Last) do
+        FV:=FV^.Next;
+  if FV<>nil then
+    if (FV^.Options and ofSelectable)=0 then FV:=nil;
+  FirstSelectable:=FV;
+end;
+function LastSelectable: PView;
+var
+    LV : PView;
+begin
+  LV := Last;
+  while (LV<>nil) and ((LV^.Options and ofSelectable)=0) and (LV<>First) do
+        LV:=LV^.Prev;
+  if LV<>nil then
+    if (LV^.Options and ofSelectable)=0 then LV:=nil;
+  LastSelectable:=LV;
+end;
+begin
+  if (Event.What and evMouseDown)<>0 then
+     begin
+       MakeLocal(Event.Where,P);
+       if P.Y<3 then
+          begin
+            Index:=-1; X:=1;
+            for i:=0 to DefCount-1 do
+                begin
+                  Len:=CStrLen(AtTab(i)^.Name^);
+                  if (P.X>=X) and (P.X<=X+Len+1) then Index:=i;
+                  X:=X+Len+3;
+                end;
+            if Index<>-1 then
+               SelectTab(Index);
+          end;
+     end;
+  if Event.What=evKeyDown then
+     begin
+       Index:=-1;
+       case Event.KeyCode of
+            kbTab,kbShiftTab  :
+              if GetState(sfSelected) then
+                 begin
+                   if Current<>nil then
+                   begin
+                   LastV:=LastSelectable; FirstV:=FirstSelectable;
+                   if ((Current=LastV) or (Current=PLabel(LastV)^.Link)) and (Event.KeyCode=kbShiftTab) then
+                      begin
+                        if Owner<>nil then Owner^.SelectNext(true);
+                      end else
+                   if ((Current=FirstV) or (Current=PLabel(FirstV)^.Link)) and (Event.KeyCode=kbTab) then
+                      begin
+                        Lock;
+                        if Owner<>nil then Owner^.SelectNext(false);
+                        UnLock;
+                      end else
+                   SelectNext(Event.KeyCode=kbShiftTab);
+                   ClearEvent(Event);
+                   end;
+                 end;
+       else
+       for I:=0 to DefCount-1 do
+           begin
+             if Upcase(GetAltChar(Event.KeyCode))=AtTab(I)^.ShortCut
+                then begin
+                       Index:=I;
+                       ClearEvent(Event);
+                       Break;
+                     end;
+           end;
+       end;
+       if Index<>-1 then
+          begin
+            Select;
+            SelectTab(Index);
+            V:=AtTab(ActiveDef)^.DefItem;
+            if V<>nil then V^.Focus;
+          end;
+     end;
+  CallOrig:=true;
+  if Event.What=evKeyDown then
+     begin
+     if ((Owner<>nil) and (Owner^.Phase=phPostProcess) and (GetAltChar(Event.KeyCode)<>#0)) or GetState(sfFocused)
+        then
+        else CallOrig:=false;
+     end;
+  if CallOrig then inherited HandleEvent(Event);
+end;
+
+function TTab.GetPalette: PPalette;
+begin
+  GetPalette:=nil;
+end;
+
+procedure TTab.Draw;
+var B     : TDrawBuffer;
+    i     : integer;
+    C1,C2,C3,C : word;
+    HeaderLen  : integer;
+    X,X2       : integer;
+    Name       : PString;
+    ActiveKPos : integer;
+    ActiveVPos : integer;
+    FC   : char;
+procedure SWriteBuf(X,Y,W,H: integer; var Buf);
+var i: integer;
+begin
+  if Y+H>Size.Y then H:=Size.Y-Y;
+  if X+W>Size.X then W:=Size.X-X;
+  if Buffer=nil then WriteBuf(X,Y,W,H,Buf)
+                else for i:=1 to H do
+                         Move(Buf,Buffer^[X+(Y+i-1)*Size.X],W*2);
+end;
+procedure ClearBuf;
+begin
+  MoveChar(B,' ',C1,Size.X);
+end;
+begin
+  if InDraw then Exit;
+  InDraw:=true;
+  { - Start of TGroup.Draw - }
+{  if Buffer = nil then
+  begin
+    GetBuffer;
+  end; }
+  { - Start of TGroup.Draw - }
+
+  C1:=GetColor(1);
+  C2:=(GetColor(7) and $f0 or $08)+GetColor(9)*256;
+  C3:=GetColor(8)+GetColor({9}8)*256;
+
+  { Calculate the size of the headers }
+  HeaderLen:=0;
+  for i:=0 to DefCount-1 do
+    HeaderLen:=HeaderLen+CStrLen(AtTab(i)^.Name^)+3;
+  Dec(HeaderLen);
+  if HeaderLen>Size.X-2 then HeaderLen:=Size.X-2;
+
+  { --- 1. sor --- }
+  ClearBuf; MoveChar(B[0],'³',C1,1); MoveChar(B[HeaderLen+1],'³',C1,1);
+  X:=1;
+  for i:=0 to DefCount-1 do
+      begin
+        Name:=AtTab(i)^.Name; X2:=CStrLen(Name^);
+        if i=ActiveDef
+           then begin
+                  ActiveKPos:=X-1;
+                  ActiveVPos:=X+X2+2;
+                  if GetState(sfFocused) then C:=C3 else C:=C2;
+                end
+           else C:=C2;
+        MoveCStr(B[X],' '+Name^+' ',C); X:=X+X2+3;
+        MoveChar(B[X-1],'³',C1,1);
+      end;
+  SWriteBuf(0,1,Size.X,1,B);
+
+  { --- 0. sor --- }
+  ClearBuf; MoveChar(B[0],'Ú',C1,1);
+  X:=1;
+  for i:=0 to DefCount-1 do
+      begin
+        if I<ActiveDef then FC:='Ú'
+                       else FC:='¿';
+        X2:=CStrLen(AtTab(i)^.Name^)+2;
+        MoveChar(B[X+X2],{'Â'}FC,C1,1);
+        if i=DefCount-1 then X2:=X2+1;
+        if X2>0 then
+        MoveChar(B[X],'Ä',C1,X2);
+        X:=X+X2+1;
+      end;
+  MoveChar(B[HeaderLen+1],'¿',C1,1);
+  MoveChar(B[ActiveKPos],'Ú',C1,1); MoveChar(B[ActiveVPos],'¿',C1,1);
+  SWriteBuf(0,0,Size.X,1,B);
+
+  { --- 2. sor --- }
+  MoveChar(B[1],'Ä',C1,Max(HeaderLen,0)); MoveChar(B[HeaderLen+2],'Ä',C1,Max(Size.X-HeaderLen-3,0));
+  MoveChar(B[Size.X-1],'¿',C1,1);
+  MoveChar(B[ActiveKPos],'Ù',C1,1);
+  if ActiveDef=0 then MoveChar(B[0],'³',C1,1)
+                 else MoveChar(B[0],{'Ã'}'Ú',C1,1);
+  MoveChar(B[HeaderLen+1],'Ä'{'Á'},C1,1); MoveChar(B[ActiveVPos],'À',C1,1);
+  MoveChar(B[ActiveKPos+1],' ',C1,Max(ActiveVPos-ActiveKPos-1,0));
+  SWriteBuf(0,2,Size.X,1,B);
+
+  { --- marad‚k sor --- }
+  ClearBuf; MoveChar(B[0],'³',C1,1); MoveChar(B[Size.X-1],'³',C1,1);
+  SWriteBuf(0,3,Size.X,Size.Y-4,B);
+
+  { --- Size.X . sor --- }
+  MoveChar(B[0],'À',C1,1); MoveChar(B[1],'Ä',C1,Max(Size.X-2,0)); MoveChar(B[Size.X-1],'Ù',C1,1);
+  SWriteBuf(0,Size.Y-1,Size.X,1,B);
+
+  { - End of TGroup.Draw - }
+  if Buffer <> nil then
+  begin
+    Lock;
+    Redraw;
+    UnLock;
+  end;
+  if Buffer <> nil then
+    WriteBuf(0, 0, Size.X, Size.Y, Buffer^)
+  else
+    Redraw;
+  { - End of TGroup.Draw - }
+  InDraw:=false;
+end;
+
+function TTab.Valid(Command: Word): Boolean;
+var PT : PTabDef;
+    PI : PTabItem;
+    OK : boolean;
+begin
+  OK:=true;
+  PT:=TabDefs;
+  while (PT<>nil) and (OK=true) do
+        begin
+          PI:=PT^.Items;
+          while (PI<>nil) and (OK=true) do
+                begin
+                  if PI^.View<>nil then OK:=OK and PI^.View^.Valid(Command);
+                  PI:=PI^.Next;
+                end;
+          PT:=PT^.Next;
+        end;
+  Valid:=OK;
+end;
+
+
+procedure TTab.SetData(var Rec);
+type
+  Bytes = array[0..65534] of Byte;
+var
+  I: Sw_Word;
+  PT : PTabDef;
+  PI : PTabItem;
+begin
+  I := 0;
+  PT:=TabDefs;
+  while (PT<>nil) do
+   begin
+     PI:=PT^.Items;
+     while (PI<>nil) do
+      begin
+        if PI^.View<>nil then
+         begin
+           PI^.View^.SetData(Bytes(Rec)[I]);
+           Inc(I, PI^.View^.DataSize);
+         end;
+        PI:=PI^.Next;
+      end;
+     PT:=PT^.Next;
+   end;
+end;
+
+
+procedure TTab.GetData(var Rec);
+type
+  Bytes = array[0..65534] of Byte;
+var
+  I: Sw_Word;
+  PT : PTabDef;
+  PI : PTabItem;
+begin
+  I := 0;
+  PT:=TabDefs;
+  while (PT<>nil) do
+   begin
+     PI:=PT^.Items;
+     while (PI<>nil) do
+      begin
+        if PI^.View<>nil then
+         begin
+           PI^.View^.GetData(Bytes(Rec)[I]);
+           Inc(I, PI^.View^.DataSize);
+         end;
+        PI:=PI^.Next;
+      end;
+     PT:=PT^.Next;
+   end;
+end;
+
+
+procedure TTab.SetState(AState: Word; Enable: Boolean);
+begin
+  inherited SetState(AState,Enable);
+  if (AState and sfFocused)<>0 then DrawView;
+end;
+
+destructor TTab.Done;
+var P,X: PTabDef;
+procedure DeleteViews(P: PView); {$ifndef FPC}far;{$endif}
+begin
+  if P<>nil then Delete(P);
+end;
+begin
+  ForEach(@DeleteViews);
+  inherited Done;
+  P:=TabDefs;
+  while P<>nil do
+        begin
+          X:=P^.Next;
+          DisposeTabDef(P);
+          P:=X;
+        end;
+end;
+
+
+function NewTabItem(AView: PView; ANext: PTabItem): PTabItem;
+var P: PTabItem;
+begin
+  New(P); FillChar(P^,SizeOf(P^),0);
+  P^.Next:=ANext; P^.View:=AView;
+  NewTabItem:=P;
+end;
+
+procedure DisposeTabItem(P: PTabItem);
+begin
+  if P<>nil then
+  begin
+    if P^.View<>nil then Dispose(P^.View, Done);
+    Dispose(P);
+  end;
+end;
+
+function NewTabDef(AName: string; ADefItem: PView; AItems: PTabItem; ANext: PTabDef): PTabDef;
+var P: PTabDef;
+    x: byte;
+begin
+  New(P);
+  P^.Next:=ANext; P^.Name:=NewStr(AName); P^.Items:=AItems;
+  x:=pos('~',AName);
+  if (x<>0) and (x<length(AName)) then P^.ShortCut:=Upcase(AName[x+1])
+                                  else P^.ShortCut:=#0;
+  P^.DefItem:=ADefItem;
+  NewTabDef:=P;
+end;
+
+procedure DisposeTabDef(P: PTabDef);
+var PI,X: PTabItem;
+begin
+  DisposeStr(P^.Name);
+  PI:=P^.Items;
+  while PI<>nil do
+    begin
+      X:=PI^.Next;
+      DisposeTabItem(PI);
+      PI:=X;
+    end;
+  Dispose(P);
+end;
+
+end.

+ 955 - 0
fvision/test/Makefile

@@ -0,0 +1,955 @@
+#
+# Don't edit, this file is generated by FPCMake Version 1.1 [2001/08/02]
+#
+default: all
+override PATH:=$(subst \,/,$(PATH))
+ifeq ($(findstring ;,$(PATH)),)
+inUnix=1
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+SEARCHPATH:=$(subst ;, ,$(PATH))
+endif
+PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH))))
+ifeq ($(PWD),)
+PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH))))
+ifeq ($(PWD),)
+nopwd:
+	@echo You need the GNU utils package to use this Makefile!
+	@echo Get ftp://ftp.freepascal.org/pub/fpc/dist/go32v2/utilgo32.zip
+	@exit
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=
+endif
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=.exe
+endif
+ifndef inUnix
+ifeq ($(OS),Windows_NT)
+inWinNT=1
+else
+ifdef OS2_SHELL
+inOS2=1
+endif
+endif
+else
+ifneq ($(findstring cygwin,$(MACHTYPE)),)
+inCygWin=1
+endif
+endif
+ifdef inUnix
+BATCHEXT=.sh
+else
+ifdef inOS2
+BATCHEXT=.cmd
+else
+BATCHEXT=.bat
+endif
+endif
+ifdef inUnix
+PATHSEP=/
+else
+PATHSEP:=$(subst /,\,/)
+endif
+ifdef PWD
+BASEDIR:=$(subst \,/,$(shell $(PWD)))
+ifdef inCygWin
+ifneq ($(findstring /cygdrive/,$(BASEDIR)),)
+BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR))
+BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR)))
+BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR))
+endif
+endif
+else
+BASEDIR=.
+endif
+ifndef FPC
+ifdef PP
+FPC=$(PP)
+else
+ifdef inUnix
+CPU_SOURCE=$(shell uname -m)
+ifeq (m68k,$(CPU_SOURCE))
+FPC=ppc68k
+else
+FPC=ppc386
+endif
+else
+FPC=ppc386
+endif
+endif
+endif
+override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
+override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
+ifndef OS_TARGET
+OS_TARGET:=$(shell $(FPC) -iTO)
+endif
+ifndef OS_SOURCE
+OS_SOURCE:=$(shell $(FPC) -iSO)
+endif
+ifndef CPU_TARGET
+CPU_TARGET:=$(shell $(FPC) -iTP)
+endif
+ifndef CPU_SOURCE
+CPU_SOURCE:=$(shell $(FPC) -iSP)
+endif
+ifndef FPC_VERSION
+FPC_VERSION:=$(shell $(FPC) -iV)
+endif
+export FPC OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FPC_VERSION
+ifdef FPCDIR
+override FPCDIR:=$(subst \,/,$(FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+else
+override FPCDIR=wrong
+endif
+ifeq ($(FPCDIR),wrong)
+override FPCDIR=../..
+ifeq ($(wildcard $(FPCDIR)/rtl),)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=wrong
+endif
+endif
+endif
+ifeq ($(FPCDIR),wrong)
+ifdef inUnix
+override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=/usr/lib/fpc/$(FPC_VERSION)
+endif
+else
+override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))))
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=c:/pp
+endif
+endif
+endif
+endif
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
+PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages)
+override TARGET_PROGRAMS+=tfileio testapp
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO=
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+ifndef DATE
+DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE=
+else
+DATE:=$(firstword $(DATE))
+endif
+else
+DATE:=$(firstword $(DATE))
+endif
+endif
+export DATE
+ifndef GINSTALL
+GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL=
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+endif
+export GINSTALL
+ifndef CPPROG
+CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(CPPROG),)
+CPPROG=
+else
+CPPROG:=$(firstword $(CPPROG))
+endif
+endif
+export CPPROG
+ifndef RMPROG
+RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(RMPROG),)
+RMPROG=
+else
+RMPROG:=$(firstword $(RMPROG))
+endif
+endif
+export RMPROG
+ifndef MVPROG
+MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MVPROG),)
+MVPROG=
+else
+MVPROG:=$(firstword $(MVPROG))
+endif
+endif
+export MVPROG
+ifndef ECHOREDIR
+ECHOREDIR:=$(subst /,$(PATHSEP),$(ECHO))
+endif
+ifndef COPY
+COPY:=$(CPPROG) -fp
+endif
+ifndef COPYTREE
+COPYTREE:=$(CPPROG) -rfp
+endif
+ifndef MOVE
+MOVE:=$(MVPROG) -f
+endif
+ifndef DEL
+DEL:=$(RMPROG) -f
+endif
+ifndef DELTREE
+DELTREE:=$(RMPROG) -rf
+endif
+ifndef INSTALL
+ifdef inUnix
+INSTALL:=$(GINSTALL) -c -m 644
+else
+INSTALL:=$(COPY)
+endif
+endif
+ifndef INSTALLEXE
+ifdef inUnix
+INSTALLEXE:=$(GINSTALL) -c -m 755
+else
+INSTALLEXE:=$(COPY)
+endif
+endif
+ifndef MKDIR
+MKDIR:=$(GINSTALL) -m 755 -d
+endif
+export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
+ifndef PPUMOVE
+PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(PPUMOVE),)
+PPUMOVE=
+else
+PPUMOVE:=$(firstword $(PPUMOVE))
+endif
+endif
+export PPUMOVE
+ifndef FPCMAKE
+FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(FPCMAKE),)
+FPCMAKE=
+else
+FPCMAKE:=$(firstword $(FPCMAKE))
+endif
+endif
+export FPCMAKE
+ifndef ZIPPROG
+ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ZIPPROG),)
+ZIPPROG=
+else
+ZIPPROG:=$(firstword $(ZIPPROG))
+endif
+endif
+export ZIPPROG
+ifndef TARPROG
+TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(TARPROG),)
+TARPROG=
+else
+TARPROG:=$(firstword $(TARPROG))
+endif
+endif
+export TARPROG
+ifndef AS
+AS=as
+endif
+ifndef LD
+LD=ld
+endif
+ifndef RC
+RC=rc
+endif
+PPAS=ppas$(BATCHEXT)
+ifdef inUnix
+LDCONFIG=ldconfig
+else
+LDCONFIG=
+endif
+ifdef DATE
+DATESTR:=$(shell $(DATE) +%Y%m%d)
+else
+DATESTR=
+endif
+ifndef UPXPROG
+ifeq ($(OS_TARGET),go32v2)
+UPXPROG:=1
+endif
+ifeq ($(OS_TARGET),win32)
+UPXPROG:=1
+endif
+ifdef UPXPROG
+UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(UPXPROG),)
+UPXPROG=
+else
+UPXPROG:=$(firstword $(UPXPROG))
+endif
+else
+UPXPROG=
+endif
+endif
+export UPXPROG
+ZIPOPT=-9
+ZIPEXT=.zip
+ifeq ($(USETAR),bz2)
+TAROPT=vI
+TAREXT=.tar.bz2
+else
+TAROPT=vz
+TAREXT=.tar.gz
+endif
+LOADEREXT=.as
+EXEEXT=.exe
+PPLEXT=.ppl
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.so
+STATICLIBPREFIX=libp
+RSTEXT=.rst
+FPCMADE=fpcmade
+ifeq ($(OS_TARGET),go32v1)
+PPUEXT=.pp1
+OEXT=.o1
+ASMEXT=.s1
+SMARTEXT=.sl1
+STATICLIBEXT=.a1
+SHAREDLIBEXT=.so1
+STATICLIBPREFIX=
+FPCMADE=fpcmade.v1
+PACKAGESUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+FPCMADE=fpcmade.dos
+ZIPSUFFIX=go32
+endif
+ifeq ($(OS_TARGET),linux)
+EXEEXT=
+HASSHAREDLIB=1
+FPCMADE=fpcmade.lnx
+ZIPSUFFIX=linux
+endif
+ifeq ($(OS_TARGET),freebsd)
+EXEEXT=
+HASSHAREDLIB=1
+FPCMADE=fpcmade.freebsd
+ZIPSUFFIX=freebsd
+endif
+ifeq ($(OS_TARGET),win32)
+PPUEXT=.ppw
+OEXT=.ow
+ASMEXT=.sw
+SMARTEXT=.slw
+STATICLIBEXT=.aw
+SHAREDLIBEXT=.dll
+FPCMADE=fpcmade.w32
+ZIPSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+PPUEXT=.ppo
+ASMEXT=.so2
+OEXT=.oo2
+AOUTEXT=.out
+SMARTEXT=.so
+STATICLIBEXT=.ao2
+SHAREDLIBEXT=.dll
+FPCMADE=fpcmade.os2
+ZIPSUFFIX=emx
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+PPUEXT=.ppa
+ASMEXT=.asm
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.library
+FPCMADE=fpcmade.amg
+endif
+ifeq ($(OS_TARGET),atari)
+PPUEXT=.ppt
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=.ttp
+FPCMADE=fpcmade.ata
+endif
+ifdef REQUIRE_UNITSDIR
+override UNITSDIR+=$(REQUIRE_UNITSDIR)
+endif
+ifdef REQUIRE_PACKAGESDIR
+override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR)
+endif
+ifdef ZIPINSTALL
+ifeq ($(OS_TARGET),linux)
+UNIXINSTALLDIR=1
+endif
+ifeq ($(OS_TARGET),freebsd)
+UNIXINSTALLDIR=1
+endif
+else
+ifeq ($(OS_SOURCE),linux)
+UNIXINSTALLDIR=1
+endif
+ifeq ($(OS_SOURCE),freebsd)
+UNIXINSTALLDIR=1
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef UNIXINSTALLDIR
+INSTALL_PREFIX=/usr/local
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=/pp
+else
+INSTALL_BASEDIR:=/$(PACKAGE_NAME)
+endif
+endif
+endif
+export INSTALL_PREFIX
+ifndef DIST_DESTDIR
+DIST_DESTDIR:=$(BASEDIR)
+endif
+export DIST_DESTDIR
+ifndef INSTALL_BASEDIR
+ifdef UNIXINSTALLDIR
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION)
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/$(PACKAGE_NAME)
+endif
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)
+endif
+endif
+ifndef INSTALL_BINDIR
+ifdef UNIXINSTALLDIR
+INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin
+else
+INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(OS_TARGET)
+endif
+endif
+endif
+ifndef INSTALL_UNITDIR
+INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(OS_TARGET)
+ifdef INSTALL_FPCPACKAGE
+ifdef PACKAGE_NAME
+INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME)
+endif
+endif
+endif
+ifndef INSTALL_LIBDIR
+ifdef UNIXINSTALLDIR
+INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib
+else
+INSTALL_LIBDIR:=$(INSTALL_UNITDIR)
+endif
+endif
+ifndef INSTALL_SOURCEDIR
+ifdef UNIXINSTALLDIR
+ifdef INSTALL_FPCPACKAGE
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/src/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/src/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIRL:=$(INSTALL_BASEDIR)/source
+endif
+endif
+endif
+ifndef INSTALL_DOCDIR
+ifdef UNIXINSTALLDIR
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc
+endif
+endif
+endif
+ifndef INSTALL_EXAMPLEDIR
+ifdef UNIXINSTALLDIR
+ifdef INSTALL_FPCPACKAGE
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples
+endif
+endif
+endif
+ifndef INSTALL_DATADIR
+INSTALL_DATADIR=$(INSTALL_BASEDIR)
+endif
+ifeq ($(OS_TARGET),linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_FV=1
+endif
+ifeq ($(OS_TARGET),go32v2)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_FV=1
+endif
+ifeq ($(OS_TARGET),win32)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_FV=1
+endif
+ifeq ($(OS_TARGET),os2)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_FV=1
+endif
+ifeq ($(OS_TARGET),freebsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_FV=1
+endif
+ifeq ($(OS_TARGET),beos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_FV=1
+endif
+ifeq ($(OS_TARGET),amiga)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_FV=1
+endif
+ifeq ($(OS_TARGET),atari)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_FV=1
+endif
+ifdef REQUIRE_PACKAGES_RTL
+PACKAGEDIR_RTL:=$(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR)))))
+ifneq ($(PACKAGEDIR_RTL),)
+PACKAGEDIR_RTL:=$(firstword $(PACKAGEDIR_RTL))
+ifeq ($(wildcard $(PACKAGEDIR_RTL)/$(FPCMADE)),)
+override COMPILEPACKAGES+=package_rtl
+package_rtl:
+	$(MAKE) -C $(PACKAGEDIR_RTL) all
+endif
+ifneq ($(wildcard $(PACKAGEDIR_RTL)/$(OS_TARGET)),)
+UNITDIR_RTL=$(PACKAGEDIR_RTL)/$(OS_TARGET)
+else
+UNITDIR_RTL=$(PACKAGEDIR_RTL)
+endif
+else
+PACKAGEDIR_RTL=
+UNITDIR_RTL:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /rtl/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_RTL),)
+UNITDIR_RTL:=$(firstword $(UNITDIR_RTL))
+else
+UNITDIR_RTL=
+endif
+endif
+ifdef UNITDIR_RTL
+override COMPILER_UNITDIR+=$(UNITDIR_RTL)
+endif
+endif
+ifdef REQUIRE_PACKAGES_FV
+PACKAGEDIR_FV:=$(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /fv/Makefile.fpc,$(PACKAGESDIR)))))
+ifneq ($(PACKAGEDIR_FV),)
+PACKAGEDIR_FV:=$(firstword $(PACKAGEDIR_FV))
+ifeq ($(wildcard $(PACKAGEDIR_FV)/$(FPCMADE)),)
+override COMPILEPACKAGES+=package_fv
+package_fv:
+	$(MAKE) -C $(PACKAGEDIR_FV) all
+endif
+ifneq ($(wildcard $(PACKAGEDIR_FV)/$(OS_TARGET)),)
+UNITDIR_FV=$(PACKAGEDIR_FV)/$(OS_TARGET)
+else
+UNITDIR_FV=$(PACKAGEDIR_FV)
+endif
+else
+PACKAGEDIR_FV=
+UNITDIR_FV:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /fv/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_FV),)
+UNITDIR_FV:=$(firstword $(UNITDIR_FV))
+else
+UNITDIR_FV=
+endif
+endif
+ifdef UNITDIR_FV
+override COMPILER_UNITDIR+=$(UNITDIR_FV)
+endif
+endif
+.PHONY: package_rtl package_fv
+override FPCOPTDEF=$(CPU_TARGET)
+ifneq ($(OS_TARGET),$(OS_SOURCE))
+override FPCOPT+=-T$(OS_TARGET)
+endif
+ifdef UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
+endif
+ifdef LIBDIR
+override FPCOPT+=$(addprefix -Fl,$(LIBDIR))
+endif
+ifdef OBJDIR
+override FPCOPT+=$(addprefix -Fo,$(OBJDIR))
+endif
+ifdef INCDIR
+override FPCOPT+=$(addprefix -Fi,$(INCDIR))
+endif
+ifdef LINKSMART
+override FPCOPT+=-XX
+endif
+ifdef CREATESMART
+override FPCOPT+=-CX
+endif
+ifdef DEBUG
+override FPCOPT+=-gl
+override FPCOPTDEF+=DEBUG
+endif
+ifdef RELEASE
+override FPCOPT+=-Xs -OG2p3 -n
+override FPCOPTDEF+=RELEASE
+endif
+ifdef STRIP
+override FPCOPT+=-Xs
+endif
+ifdef OPTIMIZE
+override FPCOPT+=-OG2p3
+endif
+ifdef VERBOSE
+override FPCOPT+=-vwni
+endif
+ifdef COMPILER_OPTIONS
+override FPCOPT+=$(COMPILER_OPTIONS)
+endif
+ifdef COMPILER_UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR))
+endif
+ifdef COMPILER_LIBRARYDIR
+override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR))
+endif
+ifdef COMPILER_OBJECTDIR
+override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR))
+endif
+ifdef COMPILER_INCLUDEDIR
+override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR))
+endif
+ifdef COMPILER_TARGETDIR
+override FPCOPT+=-FE$(COMPILER_TARGETDIR)
+ifeq ($(COMPILER_TARGETDIR),.)
+override TARGETDIRPREFIX=
+else
+override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
+endif
+endif
+ifdef COMPILER_UNITTARGETDIR
+override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR)
+ifeq ($(COMPILER_UNITTARGETDIR),.)
+override UNITTARGETDIRPREFIX=
+else
+override UNITTARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
+endif
+else
+ifdef COMPILER_TARGETDIR
+override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR)
+override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)
+endif
+endif
+ifdef OPT
+override FPCOPT+=$(OPT)
+endif
+ifdef FPCOPTDEF
+override FPCOPT+=$(addprefix -d,$(FPCOPTDEF))
+endif
+ifdef CFGFILE
+override FPCOPT+=@$(CFGFILE)
+endif
+ifdef USEENV
+override FPCEXTCMD:=$(FPCOPT)
+override FPCOPT:=!FPCEXTCMD
+export FPCEXTCMD
+endif
+override COMPILER:=$(FPC) $(FPCOPT)
+ifeq (,$(findstring -s ,$(COMPILER)))
+EXECPPAS=
+else
+ifeq ($(OS_SOURCE),$(OS_TARGET))
+EXECPPAS:=@$(PPAS)
+endif
+endif
+.PHONY: fpc_exes
+ifdef TARGET_PROGRAMS
+override EXEFILES=$(addsuffix $(EXEEXT),$(TARGET_PROGRAMS))
+override EXEOFILES:=$(addsuffix $(OEXT),$(TARGET_PROGRAMS)) $(addprefix $(STATICLIBPREFIX),$(addsuffix $(STATICLIBEXT),$(TARGET_PROGRAMS)))
+override ALLTARGET+=fpc_exes
+override INSTALLEXEFILES+=$(EXEFILES)
+override CLEANEXEFILES+=$(EXEFILES) $(EXEOFILES)
+ifeq ($(OS_TARGET),os2)
+override CLEANEXEFILES+=$(addsuffix $(AOUTEXT),$(TARGET_PROGRAMS))
+endif
+endif
+fpc_exes: $(EXEFILES)
+ifdef TARGET_RSTS
+override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS))
+override CLEANRSTFILES+=$(RSTFILES)
+endif
+.PHONY: fpc_packages fpc_all fpc_smart fpc_debug
+$(FPCMADE): $(ALLTARGET)
+	@$(ECHOREDIR) Compiled > $(FPCMADE)
+fpc_packages: $(COMPILEPACKAGES)
+fpc_all: fpc_packages $(FPCMADE)
+fpc_smart:
+	$(MAKE) all LINKSMART=1 CREATESMART=1
+fpc_debug:
+	$(MAKE) all DEBUG=1
+.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .pp
+%$(PPUEXT): %.pp
+	$(COMPILER) $<
+	$(EXECPPAS)
+%$(PPUEXT): %.pas
+	$(COMPILER) $<
+	$(EXECPPAS)
+%$(EXEEXT): %.pp
+	$(COMPILER) $<
+	$(EXECPPAS)
+%$(EXEEXT): %.pas
+	$(COMPILER) $<
+	$(EXECPPAS)
+vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR)
+.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall
+ifdef INSTALL_UNITS
+override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS))
+endif
+ifdef INSTALLPPUFILES
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(INSTALLPPUFILES))
+override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(INSTALLPPULINKFILES)))
+override INSTALL_CREATEPACKAGEFPC=1
+endif
+ifdef INSTALLEXEFILES
+override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(INSTALLEXEFILES))
+endif
+fpc_install: $(INSTALLTARGET)
+ifdef INSTALLEXEFILES
+	$(MKDIR) $(INSTALL_BINDIR)
+ifdef UPXPROG
+	-$(UPXPROG) $(INSTALLEXEFILES)
+endif
+	$(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR)
+endif
+ifdef INSTALL_CREATEPACKAGEFPC
+ifdef FPCMAKE
+ifdef PACKAGE_VERSION
+ifneq ($(wildcard Makefile.fpc),)
+	$(FPCMAKE) -p -T$(OS_TARGET) Makefile.fpc
+	$(MKDIR) $(INSTALL_UNITDIR)
+	$(INSTALL) Package.fpc $(INSTALL_UNITDIR)
+endif
+endif
+endif
+endif
+ifdef INSTALLPPUFILES
+	$(MKDIR) $(INSTALL_UNITDIR)
+	$(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR)
+ifneq ($(INSTALLPPULINKFILES),)
+	$(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR)
+endif
+ifneq ($(wildcard $(LIB_FULLNAME)),)
+	$(MKDIR) $(INSTALL_LIBDIR)
+	$(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR)
+ifdef inUnix
+	ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME)
+endif
+endif
+endif
+ifdef INSTALL_FILES
+	$(MKDIR) $(INSTALL_DATADIR)
+	$(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR)
+endif
+fpc_sourceinstall: distclean
+	$(MKDIR) $(INSTALL_SOURCEDIR)
+	$(COPYTREE) $(BASEDIR) $(INSTALL_SOURCEDIR)
+fpc_exampleinstall: $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS))
+ifdef HASEXAMPLES
+	$(MKDIR) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef EXAMPLESOURCEFILES
+	$(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef TARGET_EXAMPLEDIRS
+	$(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EXAMPLEDIR)
+endif
+.PHONY: fpc_clean fpc_cleanall fpc_distclean
+ifdef EXEFILES
+override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES))
+endif
+ifdef CLEAN_UNITS
+override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
+endif
+ifdef CLEANPPUFILES
+override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))
+override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES))
+override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES)))
+endif
+fpc_clean: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+	-$(DEL) $(CLEANEXEFILES)
+endif
+ifdef CLEANPPUFILES
+	-$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+	-$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+	-$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+ifdef CLEAN_FILES
+	-$(DEL) $(CLEAN_FILES)
+endif
+ifdef LIB_NAME
+	-$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
+endif
+	-$(DEL) $(FPCMADE) Package.fpc $(PPAS) link.res $(FPCEXTFILE) $(REDIRFILE)
+fpc_distclean: clean
+ifdef COMPILER_UNITTARGETDIR
+TARGETDIRCLEAN=fpc_clean
+endif
+fpc_cleanall: $(CLEANTARGET) $(TARGETDIRCLEAN)
+ifdef CLEANEXEFILES
+	-$(DEL) $(CLEANEXEFILES)
+endif
+	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
+	-$(DELTREE) *$(SMARTEXT)
+	-$(DEL) $(FPCMADE) $(PPAS) link.res $(FPCEXTFILE) $(REDIRFILE)
+ifdef AOUTEXT
+	-$(DEL) *$(AOUTEXT)
+endif
+.PHONY: fpc_info
+fpc_info:
+	@$(ECHO)
+	@$(ECHO)  == Package info ==
+	@$(ECHO)  Package Name..... $(PACKAGE_NAME)
+	@$(ECHO)  Package Version.. $(PACKAGE_VERSION)
+	@$(ECHO)
+	@$(ECHO)  == Configuration info ==
+	@$(ECHO)
+	@$(ECHO)  FPC.......... $(FPC)
+	@$(ECHO)  FPC Version.. $(FPC_VERSION)
+	@$(ECHO)  Source CPU... $(CPU_SOURCE)
+	@$(ECHO)  Target CPU... $(CPU_TARGET)
+	@$(ECHO)  Source OS.... $(OS_SOURCE)
+	@$(ECHO)  Target OS.... $(OS_TARGET)
+	@$(ECHO)
+	@$(ECHO)  == Directory info ==
+	@$(ECHO)
+	@$(ECHO)  Basedir......... $(BASEDIR)
+	@$(ECHO)  FPCDir.......... $(FPCDIR)
+	@$(ECHO)  UnitsDir........ $(UNITSDIR)
+	@$(ECHO)  PackagesDir..... $(PACKAGESDIR)
+	@$(ECHO)
+	@$(ECHO)  GCC library..... $(GCCLIBDIR)
+	@$(ECHO)  Other library... $(OTHERLIBDIR)
+	@$(ECHO)
+	@$(ECHO)  == Tools info ==
+	@$(ECHO)
+	@$(ECHO)  Pwd....... $(PWD)
+	@$(ECHO)  Mv........ $(MVPROG)
+	@$(ECHO)  Cp........ $(CPPROG)
+	@$(ECHO)  Rm........ $(RMPROG)
+	@$(ECHO)  GInstall.. $(GINSTALL)
+	@$(ECHO)  Echo...... $(ECHO)
+	@$(ECHO)  Date...... $(DATE)
+	@$(ECHO)  FPCMake... $(FPCMAKE)
+	@$(ECHO)  PPUMove... $(PPUMOVE)
+	@$(ECHO)  Upx....... $(UPXPROG)
+	@$(ECHO)  Zip....... $(ZIPPROG)
+	@$(ECHO)
+	@$(ECHO)  == Object info ==
+	@$(ECHO)
+	@$(ECHO)  Target Loaders...... $(TARGET_LOADERS)
+	@$(ECHO)  Target Units........ $(TARGET_UNITS)
+	@$(ECHO)  Target Programs..... $(TARGET_PROGRAMS)
+	@$(ECHO)  Target Dirs......... $(TARGET_DIRS)
+	@$(ECHO)  Target Examples..... $(TARGET_EXAMPLES)
+	@$(ECHO)  Target ExampleDirs.. $(TARGET_EXAMPLEDIRS)
+	@$(ECHO)
+	@$(ECHO)  Clean Units......... $(CLEAN_UNITS)
+	@$(ECHO)  Clean Files......... $(CLEAN_FILES)
+	@$(ECHO)
+	@$(ECHO)  Install Units....... $(INSTALL_UNITS)
+	@$(ECHO)  Install Files....... $(INSTALL_FILES)
+	@$(ECHO)
+	@$(ECHO)  == Install info ==
+	@$(ECHO)
+	@$(ECHO)  DateStr.............. $(DATESTR)
+	@$(ECHO)  ZipPrefix............ $(ZIPPREFIX)
+	@$(ECHO)  ZipSuffix............ $(ZIPSUFFIX)
+	@$(ECHO)  Install FPC Package.. $(INSTALL_FPCPACKAGE)
+	@$(ECHO)
+	@$(ECHO)  Install base dir..... $(INSTALL_BASEDIR)
+	@$(ECHO)  Install binary dir... $(INSTALL_BINDIR)
+	@$(ECHO)  Install library dir.. $(INSTALL_LIBDIR)
+	@$(ECHO)  Install units dir.... $(INSTALL_UNITDIR)
+	@$(ECHO)  Install source dir... $(INSTALL_SOURCEDIR)
+	@$(ECHO)  Install doc dir...... $(INSTALL_DOCDIR)
+	@$(ECHO)  Install example dir.. $(INSTALL_EXAMPLEDIR)
+	@$(ECHO)  Install data dir..... $(INSTALL_DATADIR)
+	@$(ECHO)
+	@$(ECHO)  Dist destination dir. $(DIST_DESTDIR)
+	@$(ECHO)  Dist zip name........ $(DIST_ZIPNAME)
+	@$(ECHO)
+all: fpc_all
+debug: fpc_debug
+smart: fpc_smart
+examples:
+shared:
+install: fpc_install
+sourceinstall: fpc_sourceinstall
+exampleinstall: fpc_exampleinstall
+distinstall:
+zipinstall:
+zipsourceinstall:
+zipexampleinstall:
+zipdistinstall:
+clean: fpc_clean
+distclean: fpc_distclean
+cleanall: fpc_cleanall
+info: fpc_info
+.PHONY: all debug smart examples shared install sourceinstall exampleinstall distinstall zipinstall zipsourceinstall zipexampleinstall zipdistinstall clean distclean cleanall info
+ifneq ($(wildcard fpcmake.loc),)
+include fpcmake.loc
+endif

+ 12 - 0
fvision/test/Makefile.fpc

@@ -0,0 +1,12 @@
+#
+#   Makefile.fpc for Free Vision Test/Examples
+#
+
+[target]
+programs=tfileio testapp
+
+[require]
+packages=fv
+
+[default]
+fpcdir=../..

+ 390 - 0
fvision/test/platform.inc

@@ -0,0 +1,390 @@
+{ $Id$ }
+{***************[ PLATFORM INCLUDE UNIT ]******************}
+{                                                          }
+{    System independent INCLUDE file to sort PLATFORMS     }
+{                                                          }
+{    Parts Copyright (c) 1997 by Balazs Scheidler          }
+{    [email protected]                                     }
+{                                                          }
+{    Parts Copyright (c) 1999, 2000 by Leon de Boer        }
+{    [email protected]  - primary e-mail address       }
+{    [email protected] - backup e-mail address     }
+{                                                          }
+{****************[ THIS CODE IS FREEWARE ]*****************}
+{                                                          }
+{     This sourcecode is released for the purpose to       }
+{   promote the pascal language on all platforms. You may  }
+{   redistribute it and/or modify with the following       }
+{   DISCLAIMER.                                            }
+{                                                          }
+{     This SOURCE CODE is distributed "AS IS" WITHOUT      }
+{   WARRANTIES AS TO PERFORMANCE OF MERCHANTABILITY OR     }
+{   ANY OTHER WARRANTIES WHETHER EXPRESSED OR IMPLIED.     }
+{                                                          }
+{*****************[ SUPPORTED PLATFORMS ]******************}
+{     16 and 32 Bit compilers                              }
+{        DOS      - Turbo Pascal 7.0 +      (16 Bit)       }
+{        DPMI     - Turbo Pascal 7.0 +      (16 Bit)       }
+{                 - FPC 0.9912+ (GO32V2)    (32 Bit)       }
+{        WINDOWS  - Turbo Pascal 7.0 +      (16 Bit)       }
+{                 - Delphi 1.0+             (16 Bit)       }
+{        WIN95/NT - Delphi 2.0+             (32 Bit)       }
+{                 - Virtual Pascal 2.0+     (32 Bit)       }
+{                 - Speedsoft Sybil 2.0+    (32 Bit)       }
+{                 - FPC 0.9912+             (32 Bit)       }
+{        OS2      - Virtual Pascal 1.0+     (32 Bit)       }
+{                 - C'T patch to BP         (16 Bit)       }
+{        LINUX    - FPC 0.9912+             (32 Bit)       }
+{                                                          }
+{******************[ REVISION HISTORY ]********************}
+{  Version  Date      Who    Fix                           }
+{  -------  --------  ---    ----------------------------  }
+{  0.1     02 Jul 97  Bazsi  Initial implementation        }
+{  0.2     28 Aug 97  LdB    Fixed OS2 platform sort       }
+{  0.3     29 Aug 97  LdB    Added assembler type changes  }
+{  0.4     29 Aug 97  LdB    OS_DOS removed from WINDOWS   }
+{  0.5     23 Oct 97  LdB    Delphi & speed compilers      }
+{  0.6     05 May 98  LdB    Virtual Pascal 2.0 added      }
+{  0.7     19 May 98  LdB    Delphi 2/3 definitions added  }
+{  0.8     06 Aug 98  CEC    FPC only support fixed WIN32  }
+{  0.9     10 Aug 98  LdB    BP_VMTLink def/Undef added    }
+{  1.0     27 Aug 98  LdB    Atari, Mac etc not undef dos  }
+{  1.1     25 Oct 98  PfV    Delphi 4 definitions added    }
+{  1.2     06 Jun 99  LdB    Sybil 2.0 support added       }
+{  1.3     13 Jun 99  LdB    Sybil 2.0 undef BP_VMT link   }
+{  1.31    03 Nov 99  LdB    FPC windows defines WIN32     }
+{  1.32    04 Nov 99  LdB    Delphi 5 definitions added    }
+{  1.33    16 Oct 00  LdB    WIN32/WIN16 defines added     }
+{**********************************************************}
+
+{ ****************************************************************************
+
+   This include file defines some conditional defines to allow us to select
+   the compiler/platform/target in a consequent way.
+
+    OS_XXXX         The operating system used (XXXX may be one of:
+                       DOS, OS2, Linux, Windows, Go32)
+    PPC_XXXX        The compiler used: BP, FPK, Virtual, Speed
+    BIT_XX          The number of bits of the target platform: 16 or 32
+    PROC_XXXX       The mode of the target processor (Real or Protected)
+                    This shouldn't be used, except for i386 specific parts.
+    ASM_XXXX        This is the assembler type: BP, ISO-ANSI, FPK
+
+ ****************************************************************************
+
+    This is how the IFDEF and UNDEF statements below should translate.
+
+
+ PLATFORM  SYSTEM    COMPILER  COMP ID      CPU MODE        BITS    ASSEMBLER
+ --------  ------    --------  -------      --------        ----    ---------
+
+ DOS      OS_DOS      BP/TP7   PPC_BP       PROC_Real       BIT_16  ASM_BP
+
+ DPMI     OS_DOS      BP/TP7   PPC_BP       PROC_Protected  BIT_16  ASM_BP
+                      FPC      PPC_FPC      PROC_Protected  BIT_32  ASM_FPC
+
+ LINUX    OS_LINUX    FPC      PPC_FPC      PROC_Protected  BIT_32  ASM_FPC
+
+ WINDOWS  OS_WINDOWS  BP/TP7   PPC_BP       PROC_Protected  BIT_16  ASM_BP
+                      DELPHI   PPC_DELPHI   PROC_Protected  BIT_16  ASM_BP
+                      DELPHI2  PPC_DELPHI2  PROC_Protected  BIT_16  ASM_BP
+
+ WIN95/NT OS_WINDOWS  DELPHI2  PPC_DELPHI2  PROC_Protected  BIT_32  ASM_BP
+                      DELPHI3  PPC_DELPHI3  PROC_Protected  BIT_32  ASM_BP
+                      DELPHI4  PPC_DELPHI3  PROC_Protected  BIT_32  ASM_BP
+                      DELPHI5  PPC_DELPHI3  PROC_Protected  BIT_32  ASM_BP
+                      VIRTUAL  PPC_VIRTUAL  PROC_Protected  BIT 32  ASM_BP
+                      SYBIL2   PPC_SPEED    PROC_Protected  BIT_32  ASM_BP
+                      FPC      PPC_FPC      PROC_Protected  BIT_32  ASM_FPC
+
+ OS2      OS_OS2      BPOS2    PPC_BPOS2    PROC_Protected  BIT_16  ASM_BP
+                      VIRTUAL  PPC_VIRTUAL  PROC_Protected  BIT_32  ASM_BP
+                      SPEED    PPC_SPEED    PROC_Protected  BIT_32  ASM_BP
+                      SYBIL2   PPC_SPEED    PROC_Protected  BIT_32  ASM_BP
+                      FPC      PPC_FPC      PROC_Protected  BIT_32  ASM_FPC
+ ****************************************************************************}
+{****************************************************************************
+
+FOR ALL COMPILERS BP_VMTLink defined but FPC and Delphi3/Delphi4 undefine it
+
+ ****************************************************************************}
+{****************************************************************************
+
+FOR FPC THESE ARE THE TRANSLATIONS
+
+  PLATFORM  SYSTEM    COMPILER  HANDLE SIZE      ASM          CPU
+ --------  ------    --------  -----------      ----         ---
+
+ DOS      OS_DOS,OS_GO32 FPC     32-bit         AT&T         CPU86
+
+ WIN32    OS_WINDOWS   FPC     32-bit           AT&T         ----
+
+ LINUX    OS_LINUX     FPC     32-bit           AT&T         ----
+
+ OS2      OS_OS2       FPC     ?????            AT&T         CPU86
+
+ ATARI    OS_ATARI     FPC     32-bit           Internal     CPU68
+
+ MACOS    OS_MAC       FPC     ?????            Internal     CPU68
+
+ AMIGA    OS_AMIGA     FPC     32-bit           Internal     CPU68
+
+ ****************************************************************************}
+
+{---------------------------------------------------------------------------}
+{  Initial assume BORLAND 16 BIT DOS COMPILER - Updated 27Aug98 LdB         }
+{---------------------------------------------------------------------------}
+{$DEFINE OS_DOS}
+{$DEFINE PROC_Real}
+{$DEFINE BIT_16}
+{$DEFINE PPC_BP}
+{$DEFINE ASM_BP}
+{$DEFINE BP_VMTLink}
+{$DEFINE CPU86}
+
+{---------------------------------------------------------------------------}
+{  BORLAND 16 BIT DPMI changes protected mode - Updated 27Aug98 LdB         }
+{---------------------------------------------------------------------------}
+{$IFDEF DPMI}
+  {$UNDEF PROC_Real}
+  {$DEFINE PROC_Protected}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  FPC 32 BIT COMPILER changes ASM, 32 bits etc - Updated 27Aug98 LdB       }
+{---------------------------------------------------------------------------}
+{$IFDEF FPC}
+  {$UNDEF PROC_Real}
+  {$DEFINE PROC_Protected}
+  {$UNDEF BIT_16}
+  {$DEFINE BIT_32}
+  {$UNDEF PPC_BP}
+  {$DEFINE PPC_FPC}
+  {$UNDEF ASM_BP}
+  {$DEFINE ASM_FPC}
+  {$UNDEF BP_VMTLink}
+  {$DEFINE Use_API}
+  {$DEFINE NO_WINDOW}
+{$ENDIF}
+
+{$IFDEF NoAPI}
+{$UNDEF Use_API}
+{$UNDEF NO_WINDOW}
+{$ENDIF UseAPI}
+
+
+{---------------------------------------------------------------------------}
+{  FPC LINUX COMPILER changes operating system - Updated 27Aug98 LdB        }
+{  Note: Other linux compilers would need to change other details           }
+{---------------------------------------------------------------------------}
+{$IFDEF LINUX}
+  {$UNDEF OS_DOS}
+  {$DEFINE OS_LINUX}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  FPC GO32V2 COMPILER changes operating system - Updated 27Aug98 LdB       }
+{---------------------------------------------------------------------------}
+{$IFDEF GO32V2}
+  {$DEFINE OS_GO32}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  32 BIT WINDOWS COMPILERS changes bit size - Updated 27Aug98 LdB          }
+{---------------------------------------------------------------------------}
+{$IFDEF WIN32}
+  {$IFNDEF WINDOWS}
+    {$DEFINE WINDOWS}
+  {$ENDIF}
+  {$UNDEF BIT_16}
+  {$DEFINE BIT_32}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  WINDOWS COMPILERS change op system and proc mode - Updated 03Nov99 LdB   }
+{---------------------------------------------------------------------------}
+{$IFDEF WINDOWS}
+  {$UNDEF OS_DOS}
+  {$DEFINE OS_WINDOWS}
+  {$UNDEF PROC_Real}
+  {$DEFINE PROC_Protected}
+  {$IFDEF FPC}
+    {$DEFINE WIN32}
+  {$ENDIF}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  DELPHI1 COMPILER changes compiler type - Updated 27Aug98 LdB             }
+{---------------------------------------------------------------------------}
+{$IFDEF VER80}
+  {$UNDEF PPC_BP}
+  {$DEFINE PPC_DELPHI}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  DELPHI2 COMPILER changes compiler type - Updated 27Aug98 LdB             }
+{---------------------------------------------------------------------------}
+{$IFDEF VER90}
+  {$UNDEF PPC_BP}
+  {$DEFINE PPC_DELPHI}
+  {$DEFINE PPC_DELPHI2}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  DELPHI3 COMPILER changes compiler type - Updated 27Aug98 LdB             }
+{---------------------------------------------------------------------------}
+{$IFDEF VER100}
+  {$UNDEF PPC_BP}
+  {$DEFINE PPC_DELPHI}
+  {$DEFINE PPC_DELPHI3}
+  {$UNDEF BP_VMTLink}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  DELPHI4 COMPILER changes compiler type - Updated 25Oct98 pfv             }
+{---------------------------------------------------------------------------}
+{$IFDEF VER120}
+  {$UNDEF PPC_BP}
+  {$DEFINE PPC_DELPHI}
+  {$DEFINE PPC_DELPHI3}
+  {$DEFINE PPC_DELPHI4}
+  {$UNDEF BP_VMTLink}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  DELPHI5 COMPILER changes compiler type - Updated 04Nov99 pfv             }
+{---------------------------------------------------------------------------}
+{$IFDEF VER130}
+  {$UNDEF PPC_BP}
+  {$DEFINE PPC_DELPHI}
+  {$DEFINE PPC_DELPHI3}
+  {$DEFINE PPC_DELPHI4}
+  {$DEFINE PPC_DELPHI5}
+  {$UNDEF BP_VMTLink}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  OS2 COMPILERS change compiler type and mode - Updated 27Aug98 LdB        }
+{  Note: Assumes BPOS2 16BIT OS2 patch except for FPC which undefines this  }
+{---------------------------------------------------------------------------}
+{$IFDEF OS2}
+  {$UNDEF OS_DOS}
+  {$DEFINE OS_OS2}
+  {$UNDEF PROC_Real}
+  {$DEFINE PROC_Protected}
+  {$UNDEF PPC_BP}
+  {$DEFINE PPC_BPOS2}
+  {$IFDEF FPC}
+    {$UNDEF PPC_BPOS2}
+  {$ENDIF}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  VIRTUAL PASCAL changes compiler type/32 bit - Updated 27Aug98 LdB        }
+{  Note: VP2 can compile win 32 code so changes op system as needed         }
+{---------------------------------------------------------------------------}
+{$IFDEF VirtualPascal}
+  {$UNDEF BIT_16}
+  {$DEFINE BIT_32}
+  {$IFDEF PPC_BPOS2}
+    {$UNDEF PPC_BPOS2}
+  {$ENDIF}
+  {$DEFINE PPC_VIRTUAL}
+  {$IFDEF WIN32}
+    {$UNDEF PPC_BP}
+    {$UNDEF OS_OS2}
+    {$DEFINE OS_WINDOWS}
+  {$ENDIF}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  SPEED COMPILER changes compiler type/32 bit  - Updated 27Aug98 LdB       }
+{---------------------------------------------------------------------------}
+{$IFDEF Speed}
+  {$UNDEF BIT_16}
+  {$DEFINE BIT_32}
+  {$UNDEF PPC_BPOS2}
+  {$DEFINE PPC_SPEED}
+  {$UNDEF BP_VMTLink}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  FPC AMIGA COMPILER changes op system and CPU type - Updated 27Aug98 LdB  }
+{---------------------------------------------------------------------------}
+{$IFDEF AMIGA}
+  {$UNDEF OS_DOS}
+  {$DEFINE OS_AMIGA}
+  {$IFDEF CPU86}
+    {$UNDEF CPU86}
+  {$ENDIF}
+  {$IFNDEF CPU68}
+    {$DEFINE CPU68}
+  {$ENDIF}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  FPC ATARI COMPILER changes op system and CPU type - Updated 27Aug98 LdB  }
+{---------------------------------------------------------------------------}
+{$IFDEF ATARI}
+  {$UNDEF OS_DOS}
+  {$DEFINE OS_ATARI}
+  {$IFDEF CPU86}
+    {$UNDEF CPU86}
+  {$ENDIF}
+  {$IFNDEF CPU68}
+    {$DEFINE CPU68}
+  {$ENDIF}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  FPC MAC COMPILER changes op system and CPU type - Updated 27Aug98 LdB    }
+{---------------------------------------------------------------------------}
+{$IFDEF MACOS}
+  {$UNDEF OS_DOS}
+  {$DEFINE OS_MAC}
+  {$IFDEF CPU86}
+    {$UNDEF CPU86}
+  {$ENDIF}
+  {$IFNDEF CPU68}
+    {$DEFINE CPU68}
+  {$ENDIF}
+{$ENDIF}
+
+{$IFDEF OS_DOS}
+  {$DEFINE NO_WINDOW}
+{$ENDIF}
+
+{---------------------------------------------------------------------------}
+{  WIN16 AND WIN32 set if in windows - Updated 16Oct2000 LdB                }
+{---------------------------------------------------------------------------}
+{$IFDEF OS_WINDOWS}                                   { WINDOWS SYSTEM }
+  {$IFDEF BIT_16}
+    {$DEFINE WIN16}                                   { 16 BIT WINDOWS }
+  {$ENDIF}
+  {$IFDEF BIT_32}
+    {$DEFINE WIN32}                                   { 32 BIT WINDOWS }
+  {$ENDIF}
+{$ENDIF}
+
+
+{
+ $Log$
+ Revision 1.1  2001-08-04 19:14:34  peter
+   * Added Makefiles
+   * added FV specific units and objects from old FV
+
+ Revision 1.5  2001/05/03 22:32:52  pierre
+  new bunch of changes, displays something for dos at least
+
+ Revision 1.4  2001/04/10 21:57:56  pierre
+  + first adds for Use_API define
+
+ Revision 1.3  2001/04/10 21:29:55  pierre
+  * import of Leon de Boer's files
+
+ Revision 1.2  2000/08/24 12:00:22  marco
+  * CVS log and ID tags
+
+
+}
+

+ 376 - 0
fvision/test/testapp.pas

@@ -0,0 +1,376 @@
+{ $Id$ }
+PROGRAM TestApp;
+
+{&PMTYPE PM}                                          { FULL GUI MODE }
+
+{ ******************************* REMARK ****************************** }
+{  This is a basic test program to test the app framework. In use will  }
+{  be menus, statuslines, windows, dialogs, scrollbars, statictext,     }
+{  radiobuttons, check boxes, list boxes and input lines.               }
+{                                                                       }
+{  Working compilers:                                                   }
+{     WINDOWS BPW, VP2, Delphi1, FPC WIN (0.9912)                       }
+{     DOS has draw bugs but works for BP and FPC DOS (GO32V2)           }
+{     OS2 dows not work still some PM bits to do                        }
+{                                                                       }
+{  Not working:                                                         }
+{     Delphi3, Delphi5 (sus 4) will compile but Tgroup.ForEach etc U/S. }
+{     Sybil2 Win32 should work but to big for demo mode so unsure!      }
+{                                                                       }
+{  Special things to try out:                                           }
+{    Check out the standard windows minimize etc icons.                 }
+{                                                                       }
+{                                                                       }
+{  Comments:                                                            }
+{    There is alot that may seem more complex than it needs to but      }
+{    I have much more elaborate objects operating such as bitmaps,      }
+{    bitmap buttons, percentage bars etc and they need these hooks.     }
+{    Basically the intention is to be able to port existing TV apps     }
+{    as a start point and then start to optimize and use the new        }
+{    GUI specific objects. I will try to get some documentation         }
+{    done on how everything works because some things are hard to       }
+{    follow in windows.                                                 }
+{ ****************************** END REMARK *** Leon de Boer, 06Nov99 * }
+
+{$I Platform.inc}
+  USES
+     {$IFDEF OS_OS2} Os2Def, os2PmApi,  {$ENDIF}
+     Objects, Drivers, Views, Menus, Dialogs, App,             { Standard GFV units }
+     {$ifdef TEST}
+     AsciiTab,
+     {$endif TEST}
+     {$ifdef DEBUG}
+     Gfvgraph,
+     {$endif DEBUG}
+     Gadgets;
+
+
+CONST cmAppToolbar = 1000;
+      cmWindow1    = 1001;
+      cmWindow2    = 1002;
+      cmWindow3    = 1003;
+      cmAscii      = 1010;
+      cmCloseWindow1    = 1101;
+      cmCloseWindow2    = 1102;
+      cmCloseWindow3    = 1103;
+
+{---------------------------------------------------------------------------}
+{          TTestAppp OBJECT - STANDARD APPLICATION WITH MENU                }
+{---------------------------------------------------------------------------}
+TYPE
+   PTVDemo = ^TTVDemo;
+   TTVDemo = OBJECT (TApplication)
+        Clock: PClockView;
+        Heap: PHeapView;
+        P1,P2,P3 : PGroup;
+     {$ifdef TEST}
+        ASCIIChart : PAsciiChart;
+     {$endif TEST}
+      CONSTRUCTOR Init;
+      PROCEDURE Idle; Virtual;
+      PROCEDURE HandleEvent(var Event : TEvent);virtual;
+      PROCEDURE InitMenuBar; Virtual;
+      PROCEDURE InitDeskTop; Virtual;
+      PROCEDURE Window1;
+      PROCEDURE Window2;
+      PROCEDURE Window3;
+      PROCEDURE AsciiWindow;
+      PROCEDURE CloseWindow(var P : PGroup);
+    End;
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{                           TTvDemo OBJECT METHODS                          }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+CONSTRUCTOR TTvDemo.Init;
+VAR R: TRect;
+BEGIN
+  Inherited Init;
+  { Initialize demo gadgets }
+
+  GetExtent(R);
+  R.A.X := R.B.X - 9; R.B.Y := R.A.Y + 1;
+  Clock := New(PClockView, Init(R));
+  Insert(Clock);
+
+  GetExtent(R);
+  Dec(R.B.X);
+  R.A.X := R.B.X - 12; R.A.Y := R.B.Y - 1;
+  Heap := New(PHeapView, Init(R));
+  Insert(Heap);
+END;
+
+procedure TTVDemo.Idle;
+
+function IsTileable(P: PView): Boolean; far;
+begin
+  IsTileable := (P^.Options and ofTileable <> 0) and
+    (P^.State and sfVisible <> 0);
+end;
+
+{$ifdef DEBUG}
+Var
+   WasSet : boolean;
+{$endif DEBUG}
+begin
+  inherited Idle;
+{$ifdef DEBUG}
+   if WriteDebugInfo then
+     begin
+      WasSet:=true;
+      WriteDebugInfo:=false;
+     end
+   else
+      WasSet:=false;
+   if WriteDebugInfo then
+{$endif DEBUG}
+  Clock^.Update;
+  Heap^.Update;
+{$ifdef DEBUG}
+   if WasSet then
+     WriteDebugInfo:=true;
+{$endif DEBUG}
+  if Desktop^.FirstThat(@IsTileable) <> nil then
+    EnableCommands([cmTile, cmCascade])
+  else
+    DisableCommands([cmTile, cmCascade]);
+end;
+
+PROCEDURE TTVDemo.HandleEvent(var Event : TEvent);
+BEGIN
+   Inherited HandleEvent(Event);                      { Call ancestor }
+   If (Event.What = evCommand) Then Begin
+     Case Event.Command Of
+       cmWindow1 : Window1;
+       cmWindow2 : Window2;
+       cmWindow3 : Window3;
+       cmAscii   : AsciiWindow;
+       cmCloseWindow1 : CloseWindow(P1);
+       cmCloseWindow2 : CloseWindow(P2);
+       cmCloseWindow3 : CloseWindow(P3);
+       Else Exit;                                     { Unhandled exit }
+     End;
+   End;
+   ClearEvent(Event);
+END;
+
+{--TTvDemo------------------------------------------------------------------}
+{  InitMenuBar -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05Nov99 LdB       }
+{---------------------------------------------------------------------------}
+PROCEDURE TTVDemo.InitMenuBar;
+VAR R: TRect;
+BEGIN
+   GetExtent(R);                                      { Get view extents }
+   R.B.Y := R.A.Y + 1;                                { One line high  }
+   MenuBar := New(PMenuBar, Init(R, NewMenu(
+    NewSubMenu('~F~ile', 0, NewMenu(
+      StdFileMenuItems(Nil)),                         { Standard file menu }
+    NewSubMenu('~E~dit', 0, NewMenu(
+      StdEditMenuItems(Nil)),                         { Standard edit menu }
+    NewSubMenu('~T~est', 0, NewMenu(
+      NewItem('Ascii Chart','',kbNoKey,cmAscii,hcNoContext,
+      NewItem('Window 1','',kbNoKey,cmWindow1,hcNoContext,
+      NewItem('Window 2','',kbNoKey,cmWindow2,hcNoContext,
+      NewItem('Window 3','',kbNoKey,cmWindow3,hcNoContext,
+      NewItem('Close Window 1','',kbNoKey,cmCloseWindow1,hcNoContext,
+      NewItem('Close Window 2','',kbNoKey,cmCloseWindow2,hcNoContext,
+      NewItem('Close Window 3','',kbNoKey,cmCloseWindow3,hcNoContext,
+      Nil)))))))),
+    NewSubMenu('~W~indow', 0, NewMenu(
+      StdWindowMenuItems(Nil)), Nil)))))));            { Standard window  menu }
+END;
+
+{--TTvDemo------------------------------------------------------------------}
+{  InitDesktop -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 08Nov99 LdB       }
+{---------------------------------------------------------------------------}
+PROCEDURE TTvDemo.InitDesktop;
+VAR R: TRect; {ToolBar: PToolBar;}
+BEGIN
+   GetExtent(R);                                      { Get app extents }
+   Inc(R.A.Y);               { Adjust top down }
+   Dec(R.B.Y);            { Adjust bottom up }
+(*   ToolBar := New(PToolBar, Init(R.A.X*FontWidth,
+     R.A.Y*FontHeight, (R.B.X-R.A.X)*FontWidth, 20,
+     cmAppToolBar));
+   If (ToolBar <> Nil) Then Begin
+     R.A.X := R.A.X*FontWidth;
+     R.A.Y := R.A.Y*FontHeight + 25;
+     R.B.X := -R.B.X*FontWidth;
+     R.B.Y := -R.B.Y*Fontheight;
+     ToolBar^.AddTool(NewToolEntry(cmQuit, True,
+       '20X20EXIT', 'ToolBar.Res'));
+     ToolBar^.AddTool(NewToolEntry(cmNew, True,
+       '20X20NEW', 'ToolBar.Res'));
+     ToolBar^.AddTool(NewToolEntry(cmOpen, True,
+       '20X20LOAD', 'ToolBar.Res'));
+     Insert(ToolBar);
+   End;*)
+   Desktop := New(PDeskTop, Init(R));
+END;
+
+PROCEDURE TTvDemo.Window1;
+VAR R: TRect; P: PGroup;
+BEGIN
+   { Create a basic window with static text and radio }
+   { buttons. The buttons should be orange and white  }
+   R.Assign(5, 1, 35, 16);                            { Assign area }
+   P := New(PWindow, Init(R, 'TEST WINDOW 1', 1));    { Create a window }
+   If (P <> Nil) Then Begin                           { Window valid }
+     R.Assign(5, 5, 20, 6);                           { Assign area }
+     P^.Insert(New(PInputLine, Init(R, 30)));
+     R.Assign(5, 8, 20, 9);                           { Assign area }
+     P^.Insert(New(PRadioButtons, Init(R,
+       NewSItem('Test',
+       NewSITem('Item 2', Nil)))));                   { Red radio button }
+     R.Assign(5, 10, 28, 11);                         { Assign area }
+     P^.Insert(New(PStaticText, Init(R,
+       'SOME STATIC TEXT')));                         { Insert static text }
+   End;
+   Desktop^.Insert(P);                                { Insert into desktop }
+   P1:=P;
+END;
+
+PROCEDURE TTvDemo.AsciiWindow;
+begin
+{$ifdef TEST}
+  if ASCIIChart=nil then
+    begin
+      New(ASCIIChart, Init);
+      Desktop^.Insert(ASCIIChart);
+    end
+  else
+    ASCIIChart^.Focus;
+{$endif TEST}
+end;
+
+
+PROCEDURE TTvDemo.CloseWindow(var P : PGroup);
+BEGIN
+  If Assigned(P) then
+    BEGIN
+      Desktop^.Delete(P);
+      Dispose(P,Done);
+      P:=Nil;
+    END;
+END;
+PROCEDURE TTvDemo.Window2;
+VAR R: TRect; P: PGroup;
+BEGIN
+   { Create a basic window with check boxes. The  }
+   { check boxes should be orange and white       }
+   R.Assign(15, 3, 45, 18);                           { Assign area }
+   P := New(PWindow, Init(R, 'TEST WINDOW 2', 2));    { Create window 2 }
+   If (P <> Nil) Then Begin                           { Window valid }
+     R.Assign(5, 5, 20, 7);                           { Assign area }
+     P^.Insert(New(PCheckBoxes, Init(R,
+       NewSItem('Test check',
+       NewSITem('Item 2', Nil)))));                   { Create check box }
+   End;
+   Desktop^.Insert(P);                                { Insert into desktop }
+   P2:=P;
+END;
+
+PROCEDURE TTvDemo.Window3;
+VAR R: TRect; P: PGroup; B: PScrollBar;
+    List: PStrCollection; Lb: PListBox;
+BEGIN
+   { Create a basic dialog box. In it are buttons,  }
+   { list boxes, scrollbars, inputlines, checkboxes }
+   R.Assign(32, 2, 77, 18);                           { Assign screen area }
+   P := New(PDialog, Init(R, 'TEST DIALOG'));         { Create dialog }
+   If (P <> Nil) Then Begin                           { Dialog valid }
+     R.Assign(5, 5, 20, 7);                          { Allocate area }
+     P^.Insert(New(PCheckBoxes, Init(R,
+       NewSItem('Test',
+       NewSITem('Item 2', Nil)))));                   { Insert check box }
+     R.Assign(5, 2, 20, 3);                           { Assign area }
+     B := New(PScrollBar, Init(R));                   { Insert scroll bar }
+     If (B <> Nil) Then Begin                         { Scrollbar valid }
+       B^.SetRange(0, 100);                           { Set scrollbar range }
+       B^.SetValue(50);                               { Set position }
+       P^.Insert(B);                                  { Insert scrollbar }
+     End;
+     R.Assign(5, 10, 20, 11);                         { Assign area }
+     P^.Insert(New(PInputLine, Init(R, 60)));         { Create input line }
+     R.Assign(5, 13, 20, 14);                         { Assign area }
+     P^.Insert(New(PInputLine, Init(R, 60)));         { Create input line }
+     R.Assign(40, 8, 41, 14);                         { Assign area }
+     B := New(PScrollBar, Init(R));                   { Create scrollbar }
+     P^.Insert(B);                                    { Insert scrollbar }
+     R.Assign(25, 8, 40, 14);                         { Assign area }
+     Lb := New(PListBox, Init(R, 1, B));              { Create listbox }
+     P^.Insert(Lb);                                   { Insert listbox }
+     List := New(PStrCollection, Init(10, 5));        { Create string list }
+     List^.AtInsert(0, NewStr('Zebra'));              { Insert text }
+     List^.AtInsert(1, NewStr('Apple'));              { Insert text }
+     List^.AtInsert(2, NewStr('Third'));              { Insert text }
+     List^.AtInsert(3, NewStr('Peach'));              { Insert text }
+     List^.AtInsert(4, NewStr('Rabbit'));             { Insert text }
+     List^.AtInsert(5, NewStr('Item six'));           { Insert text }
+     List^.AtInsert(6, NewStr('Jaguar'));             { Insert text }
+     List^.AtInsert(7, NewStr('Melon'));              { Insert text }
+     List^.AtInsert(8, NewStr('Ninth'));              { Insert text }
+     List^.AtInsert(9, NewStr('Last item'));          { Insert text }
+     Lb^.Newlist(List);                               { Give list to listbox }
+     R.Assign(30, 2, 40, 4);                          { Assign area }
+     P^.Insert(New(PButton, Init(R, '~O~k', 100, bfGrabFocus)));{ Create okay button }
+     R.Assign(30, 15, 40, 17);                        { Assign area }
+     Desktop^.Insert(P);                              { Insert dialog }
+     P3:=P;
+   End;
+END;
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{                             MAIN PROGRAM START                            }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+VAR I: Integer; R: TRect; P: PGroup; MyApp: TTvDemo;
+    {$IFDEF OS_OS2} Message: QMSg; Event: TEvent; {$ENDIF}
+BEGIN
+   (*SystemPalette := CreateRGBPalette(256);            { Create palette }
+   For I := 0 To 15 Do Begin
+     GetSystemRGBEntry(I, RGB);                       { Get palette entry }
+     AddToRGBPalette(RGB, SystemPalette);             { Add entry to palette }
+   End;*)
+
+   MyApp.Init;                                        { Initialize app }
+
+
+   MyApp.Run;                                         { Run the app }
+   {$IFDEF OS_OS2}
+   while (MyApp.EndState = 0)
+   AND WinGetMsg(Anchor, Message, 0, 0, 0) Do Begin
+       WinDispatchMsg(Anchor, Message);
+       NextQueuedEvent(Event);
+       If (event.What <>  evNothing)
+         Then MyApp.handleEvent(Event);
+   End;
+   {$ENDIF}
+   MyApp.Done;                                        { Dispose of app }
+
+   {DisposeRGBPalette(SystemPalette);}
+END.
+
+
+{
+ $Log$
+ Revision 1.1  2001-08-04 19:14:34  peter
+   * Added Makefiles
+   * added FV specific units and objects from old FV
+
+ Revision 1.6  2001/05/31 21:40:10  pierre
+  * some debug stuff changed
+
+ Revision 1.5  2001/05/04 15:43:46  pierre
+  * several more fixes
+
+ Revision 1.4  2001/05/04 10:46:02  pierre
+  * various fixes  for win32 api mode
+
+ Revision 1.3  2001/05/04 08:42:55  pierre
+  * some corrections for linux
+
+ Revision 1.2  2000/08/24 12:00:22  marco
+  * CVS log and ID tags
+
+
+}

+ 2 - 2
fvision/test/tfileio.pas

@@ -1,10 +1,10 @@
 USES
-  Common,FileIO;
+  FVCommon,FileIO;
 
 VAR
   Handle : THandle;
   buf    : ARRAY[0..255] OF CHAR;
-  n 	 : Longint;
+  n      : Longint;
 BEGIN
   Handle := FileOpen(AsciiZ('test'), fa_Create);
   writeln('FileOpen: ',Handle);

+ 6 - 2
fvision/validate.pas

@@ -74,7 +74,7 @@ UNIT Validate;
 {$V-} { Turn off strict VAR strings }
 {====================================================================}
 
-USES Common, Objects;                                 { GFV standard units }
+USES FVCommon, Objects;                                 { GFV standard units }
 
 {***************************************************************************}
 {                              PUBLIC CONSTANTS                             }
@@ -1058,7 +1058,11 @@ END.
 
 {
  $Log$
- Revision 1.4  2001-05-03 22:32:52  pierre
+ Revision 1.5  2001-08-04 19:14:33  peter
+   * Added Makefiles
+   * added FV specific units and objects from old FV
+
+ Revision 1.4  2001/05/03 22:32:52  pierre
   new bunch of changes, displays something for dos at least
 
  Revision 1.3  2001/04/10 21:29:55  pierre

Diff do ficheiro suprimidas por serem muito extensas
+ 164 - 174
fvision/views.pas


Alguns ficheiros não foram mostrados porque muitos ficheiros mudaram neste diff