From 1e00430227e56fd2691f8374418f352c171039b1 Mon Sep 17 00:00:00 2001 From: graemeg Date: Mon, 23 Jul 2007 08:54:39 +0000 Subject: The first part of removing the obsolete fpGUI and replacing it with the new multi-handle design from the prototypes directory. --- gui/Makefile | 2014 ---------------------------------------------- gui/Makefile.fpc | 41 - gui/db/Makefile | 1373 ------------------------------- gui/db/Makefile.fpc | 20 - gui/db/fpgui_db.pas | 299 ------- gui/defimpl/defstyle.inc | 60 -- gui/fpgui.pas | 363 --------- gui/fpgui.rst | 60 -- gui/fpguibin.inc | 111 --- gui/fpguibuttons.inc | 155 ---- gui/fpguicheckbox.inc | 127 --- gui/fpguicolors.inc | 229 ------ gui/fpguicombobox.inc | 288 ------- gui/fpguicontainer.inc | 88 -- gui/fpguidialogs.inc | 199 ----- gui/fpguiedit.inc | 430 ---------- gui/fpguiform.inc | 587 -------------- gui/fpguigrid.inc | 657 --------------- gui/fpguigroupbox.inc | 106 --- gui/fpguilabel.inc | 104 --- gui/fpguilayouts.inc | 1088 ------------------------- gui/fpguilistbox.inc | 430 ---------- gui/fpguimemo.inc | 295 ------- gui/fpguimenus.inc | 246 ------ gui/fpguipackage.lpk | 79 -- gui/fpguipackage.pas | 14 - gui/fpguipanel.inc | 126 --- gui/fpguipopupwindow.inc | 57 -- gui/fpguiprogressbar.inc | 159 ---- gui/fpguiradiobutton.inc | 139 ---- gui/fpguiscrollbar.inc | 723 ----------------- gui/fpguiscrollbox.inc | 428 ---------- gui/fpguiseparator.inc | 103 --- gui/fpguistyle.inc | 834 ------------------- gui/fpguiwidget.inc | 1368 ------------------------------- gui/motifstyle.pas | 174 ---- gui/opensoftstyle.pas | 327 -------- gui/stylemanager.pas | 220 ----- gui/win32/defstyle.inc | 47 -- gui/windowsstyle.pas | 111 --- 40 files changed, 14279 deletions(-) delete mode 100644 gui/Makefile delete mode 100644 gui/Makefile.fpc delete mode 100644 gui/db/Makefile delete mode 100644 gui/db/Makefile.fpc delete mode 100644 gui/db/fpgui_db.pas delete mode 100644 gui/defimpl/defstyle.inc delete mode 100644 gui/fpgui.pas delete mode 100644 gui/fpgui.rst delete mode 100644 gui/fpguibin.inc delete mode 100644 gui/fpguibuttons.inc delete mode 100644 gui/fpguicheckbox.inc delete mode 100644 gui/fpguicolors.inc delete mode 100644 gui/fpguicombobox.inc delete mode 100644 gui/fpguicontainer.inc delete mode 100644 gui/fpguidialogs.inc delete mode 100644 gui/fpguiedit.inc delete mode 100644 gui/fpguiform.inc delete mode 100644 gui/fpguigrid.inc delete mode 100644 gui/fpguigroupbox.inc delete mode 100644 gui/fpguilabel.inc delete mode 100644 gui/fpguilayouts.inc delete mode 100644 gui/fpguilistbox.inc delete mode 100644 gui/fpguimemo.inc delete mode 100644 gui/fpguimenus.inc delete mode 100644 gui/fpguipackage.lpk delete mode 100644 gui/fpguipackage.pas delete mode 100644 gui/fpguipanel.inc delete mode 100644 gui/fpguipopupwindow.inc delete mode 100644 gui/fpguiprogressbar.inc delete mode 100644 gui/fpguiradiobutton.inc delete mode 100644 gui/fpguiscrollbar.inc delete mode 100644 gui/fpguiscrollbox.inc delete mode 100644 gui/fpguiseparator.inc delete mode 100644 gui/fpguistyle.inc delete mode 100644 gui/fpguiwidget.inc delete mode 100644 gui/motifstyle.pas delete mode 100644 gui/opensoftstyle.pas delete mode 100644 gui/stylemanager.pas delete mode 100644 gui/win32/defstyle.inc delete mode 100644 gui/windowsstyle.pas (limited to 'gui') diff --git a/gui/Makefile b/gui/Makefile deleted file mode 100644 index 8fbc78c3..00000000 --- a/gui/Makefile +++ /dev/null @@ -1,2014 +0,0 @@ -# -# Don't edit, this file is generated by FPCMake Version 2.0.0 [2006/08/31] -# -default: all -MAKEFILETARGETS=i386-linux -BSDs = freebsd netbsd openbsd darwin -UNIXs = linux $(BSDs) solaris qnx -LIMIT83fs = go32v2 os2 emx watcom -FORCE: -.PHONY: FORCE -override PATH:=$(patsubst %/,%,$(subst \,/,$(PATH))) -ifneq ($(findstring darwin,$(OSTYPE)),) -inUnix=1 #darwin -SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH))) -else -ifeq ($(findstring ;,$(PATH)),) -inUnix=1 -SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH))) -else -SEARCHPATH:=$(subst ;, ,$(PATH)) -endif -endif -SEARCHPATH+=$(patsubst %/,%,$(subst \,/,$(dir $(MAKE)))) -PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH)))) -ifeq ($(PWD),) -PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH)))) -ifeq ($(PWD),) -$(error You need the GNU utils package to use this Makefile) -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 cygdrive,$(PATH)),) -inCygWin=1 -endif -endif -ifdef inUnix -SRCBATCHEXT=.sh -else -ifdef inOS2 -SRCBATCHEXT=.cmd -else -SRCBATCHEXT=.bat -endif -endif -ifdef inUnix -PATHSEP=/ -else -PATHSEP:=$(subst /,\,/) -ifdef inCygWin -PATHSEP=/ -endif -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 -ifdef inOS2 -ifndef ECHO -ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(ECHO),) -ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(ECHO),) -ECHO=echo -else -ECHO:=$(firstword $(ECHO)) -endif -else -ECHO:=$(firstword $(ECHO)) -endif -endif -export ECHO -endif -override DEFAULT_FPCDIR=/opt/fpc/src -ifndef FPC -ifdef PP -FPC=$(PP) -endif -endif -ifndef FPC -FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH)))) -ifneq ($(FPCPROG),) -FPCPROG:=$(firstword $(FPCPROG)) -FPC:=$(shell $(FPCPROG) -PB) -ifneq ($(findstring Error,$(FPC)),) -override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH))))) -endif -else -override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH))))) -endif -endif -override FPC:=$(subst $(SRCEXEEXT),,$(FPC)) -override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT) -FOUNDFPC:=$(strip $(wildcard $(FPC))) -ifeq ($(FOUNDFPC),) -FOUNDFPC=$(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH)))) -ifeq ($(FOUNDFPC),) -$(error Compiler $(FPC) not found) -endif -endif -ifndef FPC_COMPILERINFO -FPC_COMPILERINFO:=$(shell $(FPC) -iVSPTPSOTO) -endif -ifndef FPC_VERSION -FPC_VERSION:=$(word 1,$(FPC_COMPILERINFO)) -endif -export FPC FPC_VERSION FPC_COMPILERINFO -unexport CHECKDEPEND ALLDEPENDENCIES -ifndef CPU_TARGET -ifdef CPU_TARGET_DEFAULT -CPU_TARGET=$(CPU_TARGET_DEFAULT) -endif -endif -ifndef OS_TARGET -ifdef OS_TARGET_DEFAULT -OS_TARGET=$(OS_TARGET_DEFAULT) -endif -endif -ifneq ($(words $(FPC_COMPILERINFO)),5) -FPC_COMPILERINFO+=$(shell $(FPC) -iSP) -FPC_COMPILERINFO+=$(shell $(FPC) -iTP) -FPC_COMPILERINFO+=$(shell $(FPC) -iSO) -FPC_COMPILERINFO+=$(shell $(FPC) -iTO) -endif -ifndef CPU_SOURCE -CPU_SOURCE:=$(word 2,$(FPC_COMPILERINFO)) -endif -ifndef CPU_TARGET -CPU_TARGET:=$(word 3,$(FPC_COMPILERINFO)) -endif -ifndef OS_SOURCE -OS_SOURCE:=$(word 4,$(FPC_COMPILERINFO)) -endif -ifndef OS_TARGET -OS_TARGET:=$(word 5,$(FPC_COMPILERINFO)) -endif -FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET) -FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE) -ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),) -TARGETSUFFIX=$(OS_TARGET) -SOURCESUFFIX=$(OS_SOURCE) -else -TARGETSUFFIX=$(FULL_TARGET) -SOURCESUFFIX=$(FULL_SOURCE) -endif -ifneq ($(FULL_TARGET),$(FULL_SOURCE)) -CROSSCOMPILE=1 -endif -ifeq ($(findstring makefile,$(MAKECMDGOALS)),) -ifeq ($(findstring $(FULL_TARGET),$(MAKEFILETARGETS)),) -$(error The Makefile doesn't support target $(FULL_TARGET), please run fpcmake first) -endif -endif -ifneq ($(findstring $(OS_TARGET),$(BSDs)),) -BSDhier=1 -endif -ifeq ($(OS_TARGET),linux) -linuxHier=1 -endif -export OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FULL_TARGET FULL_SOURCE TARGETSUFFIX SOURCESUFFIX CROSSCOMPILE -ifdef FPCDIR -override FPCDIR:=$(subst \,/,$(FPCDIR)) -ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),) -override FPCDIR=wrong -endif -else -override FPCDIR=wrong -endif -ifdef DEFAULT_FPCDIR -ifeq ($(FPCDIR),wrong) -override FPCDIR:=$(subst \,/,$(DEFAULT_FPCDIR)) -ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl 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:=$(BASEDIR) -ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),) -override FPCDIR=c:/pp -endif -endif -endif -endif -endif -ifndef CROSSBINDIR -CROSSBINDIR:=$(wildcard $(FPCDIR)/bin/$(TARGETSUFFIX)) -endif -ifndef BINUTILSPREFIX -ifndef CROSSBINDIR -ifdef CROSSCOMPILE -BINUTILSPREFIX=$(CPU_TARGET)-$(OS_TARGET)- -endif -endif -endif -UNITSDIR:=$(wildcard $(FPCDIR)/units/$(TARGETSUFFIX)) -ifeq ($(UNITSDIR),) -UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET)) -endif -PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/extra) -override PACKAGE_NAME=fpgui -override PACKAGE_VERSION=0.2 -ifeq ($(FULL_TARGET),i386-linux) -override TARGET_UNITS+=fpgui -endif -override INSTALL_BUILDUNIT=fpgui -override INSTALL_FPCPACKAGE=y -ifeq ($(FULL_TARGET),i386-linux) -override COMPILER_OPTIONS+=-S2h -endif -ifeq ($(FULL_TARGET),i386-linux) -override COMPILER_INCLUDEDIR+=defimpl -endif -ifeq ($(FULL_TARGET),i386-linux) -override COMPILER_UNITTARGETDIR+=units -endif -ifdef REQUIRE_UNITSDIR -override UNITSDIR+=$(REQUIRE_UNITSDIR) -endif -ifdef REQUIRE_PACKAGESDIR -override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR) -endif -ifdef ZIPINSTALL -ifneq ($(findstring $(OS_TARGET),$(UNIXs)),) -UNIXHier=1 -endif -else -ifneq ($(findstring $(OS_SOURCE),$(UNIXs)),) -UNIXHier=1 -endif -endif -ifndef INSTALL_PREFIX -ifdef PREFIX -INSTALL_PREFIX=$(PREFIX) -endif -endif -ifndef INSTALL_PREFIX -ifdef UNIXHier -INSTALL_PREFIX=/usr/local -else -ifdef INSTALL_FPCPACKAGE -INSTALL_BASEDIR:=/pp -else -INSTALL_BASEDIR:=/$(PACKAGE_NAME) -endif -endif -endif -export INSTALL_PREFIX -ifdef INSTALL_FPCSUBDIR -export INSTALL_FPCSUBDIR -endif -ifndef DIST_DESTDIR -DIST_DESTDIR:=$(BASEDIR) -endif -export DIST_DESTDIR -ifndef COMPILER_UNITTARGETDIR -ifdef PACKAGEDIR_MAIN -COMPILER_UNITTARGETDIR=$(PACKAGEDIR_MAIN)/units/$(TARGETSUFFIX) -else -COMPILER_UNITTARGETDIR=units/$(TARGETSUFFIX) -endif -endif -ifndef COMPILER_TARGETDIR -COMPILER_TARGETDIR=. -endif -ifndef INSTALL_BASEDIR -ifdef UNIXHier -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 UNIXHier -INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin -else -INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin -ifdef INSTALL_FPCPACKAGE -ifdef CROSSCOMPILE -ifdef CROSSINSTALL -INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(SOURCESUFFIX) -else -INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX) -endif -else -INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX) -endif -endif -endif -endif -ifndef INSTALL_UNITDIR -INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(TARGETSUFFIX) -ifdef INSTALL_FPCPACKAGE -ifdef PACKAGE_NAME -INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME) -endif -endif -endif -ifndef INSTALL_LIBDIR -ifdef UNIXHier -INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib -else -INSTALL_LIBDIR:=$(INSTALL_UNITDIR) -endif -endif -ifndef INSTALL_SOURCEDIR -ifdef UNIXHier -ifdef BSDhier -SRCPREFIXDIR=share/src -else -ifdef linuxHier -SRCPREFIXDIR=share/src -else -SRCPREFIXDIR=src -endif -endif -ifdef INSTALL_FPCPACKAGE -ifdef INSTALL_FPCSUBDIR -INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME) -else -INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME) -endif -else -INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION) -endif -else -ifdef INSTALL_FPCPACKAGE -ifdef INSTALL_FPCSUBDIR -INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME) -else -INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME) -endif -else -INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source -endif -endif -endif -ifndef INSTALL_DOCDIR -ifdef UNIXHier -ifdef BSDhier -DOCPREFIXDIR=share/doc -else -ifdef linuxHier -DOCPREFIXDIR=share/doc -else -DOCPREFIXDIR=doc -endif -endif -ifdef INSTALL_FPCPACKAGE -INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME) -else -INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/$(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 UNIXHier -ifdef INSTALL_FPCPACKAGE -ifdef BSDhier -INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/fpc-$(FPC_VERSION)/$(PACKAGE_NAME) -else -ifdef linuxHier -INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples -else -INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME) -endif -endif -else -ifdef BSDhier -INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION) -else -ifdef linuxHier -INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION) -else -INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION) -endif -endif -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 -ifndef INSTALL_SHAREDDIR -INSTALL_SHAREDDIR=$(INSTALL_PREFIX)/lib -endif -ifdef CROSSCOMPILE -ifndef CROSSBINDIR -CROSSBINDIR:=$(wildcard $(CROSSTARGETDIR)/bin/$(SOURCESUFFIX)) -ifeq ($(CROSSBINDIR),) -CROSSBINDIR:=$(wildcard $(INSTALL_BASEDIR)/cross/$(TARGETSUFFIX)/bin/$(FULL_SOURCE)) -endif -endif -else -CROSSBINDIR= -endif -ifeq ($(OS_SOURCE),linux) -ifndef GCCLIBDIR -ifeq ($(CPU_TARGET),i386) -ifneq ($(findstring x86_64,$(shell uname -a)),) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) -endif -endif -endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif -endif -ifndef GCCLIBDIR -CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) -ifneq ($(CROSSGCC),) -GCCLIBDIR:=$(shell dirname `$(CROSSGCC) -print-libgcc-file-name`) -endif -endif -ifndef OTHERLIBDIR -OTHERLIBDIR:=$(shell grep -v "^\#" /etc/ld.so.conf | awk '{ ORS=" "; print $1 }') -endif -endif -ifdef inUnix -ifeq ($(OS_SOURCE),netbsd) -OTHERLIBDIR+=/usr/pkg/lib -endif -export GCCLIBDIR OTHERLIB -endif -BATCHEXT=.bat -LOADEREXT=.as -EXEEXT=.exe -PPLEXT=.ppl -PPUEXT=.ppu -OEXT=.o -ASMEXT=.s -SMARTEXT=.sl -STATICLIBEXT=.a -SHAREDLIBEXT=.so -SHAREDLIBPREFIX=libfp -STATICLIBPREFIX=libp -IMPORTLIBPREFIX=libimp -RSTEXT=.rst -ifeq ($(findstring 1.0.,$(FPC_VERSION)),) -ifeq ($(OS_TARGET),go32v1) -STATICLIBPREFIX= -SHORTSUFFIX=v1 -endif -ifeq ($(OS_TARGET),go32v2) -STATICLIBPREFIX= -SHORTSUFFIX=dos -endif -ifeq ($(OS_TARGET),watcom) -STATICLIBPREFIX= -OEXT=.obj -ASMEXT=.asm -SHAREDLIBEXT=.dll -SHORTSUFFIX=wat -endif -ifeq ($(OS_TARGET),linux) -BATCHEXT=.sh -EXEEXT= -HASSHAREDLIB=1 -SHORTSUFFIX=lnx -endif -ifeq ($(OS_TARGET),freebsd) -BATCHEXT=.sh -EXEEXT= -HASSHAREDLIB=1 -SHORTSUFFIX=fbs -endif -ifeq ($(OS_TARGET),netbsd) -BATCHEXT=.sh -EXEEXT= -HASSHAREDLIB=1 -SHORTSUFFIX=nbs -endif -ifeq ($(OS_TARGET),openbsd) -BATCHEXT=.sh -EXEEXT= -HASSHAREDLIB=1 -SHORTSUFFIX=obs -endif -ifeq ($(OS_TARGET),win32) -SHAREDLIBEXT=.dll -SHORTSUFFIX=w32 -endif -ifeq ($(OS_TARGET),os2) -BATCHEXT=.cmd -AOUTEXT=.out -STATICLIBPREFIX= -SHAREDLIBEXT=.dll -SHORTSUFFIX=os2 -ECHO=echo -endif -ifeq ($(OS_TARGET),emx) -BATCHEXT=.cmd -AOUTEXT=.out -STATICLIBPREFIX= -SHAREDLIBEXT=.dll -SHORTSUFFIX=emx -ECHO=echo -endif -ifeq ($(OS_TARGET),amiga) -EXEEXT= -SHAREDLIBEXT=.library -SHORTSUFFIX=amg -endif -ifeq ($(OS_TARGET),morphos) -EXEEXT= -SHAREDLIBEXT=.library -SHORTSUFFIX=mos -endif -ifeq ($(OS_TARGET),atari) -EXEEXT=.ttp -SHORTSUFFIX=ata -endif -ifeq ($(OS_TARGET),beos) -BATCHEXT=.sh -EXEEXT= -SHORTSUFFIX=be -endif -ifeq ($(OS_TARGET),solaris) -BATCHEXT=.sh -EXEEXT= -SHORTSUFFIX=sun -endif -ifeq ($(OS_TARGET),qnx) -BATCHEXT=.sh -EXEEXT= -SHORTSUFFIX=qnx -endif -ifeq ($(OS_TARGET),netware) -EXEEXT=.nlm -STATICLIBPREFIX= -SHORTSUFFIX=nw -endif -ifeq ($(OS_TARGET),netwlibc) -EXEEXT=.nlm -STATICLIBPREFIX= -SHORTSUFFIX=nwl -endif -ifeq ($(OS_TARGET),macos) -BATCHEXT= -EXEEXT= -DEBUGSYMEXT=.xcoff -SHORTSUFFIX=mac -endif -ifeq ($(OS_TARGET),darwin) -BATCHEXT=.sh -EXEEXT= -HASSHAREDLIB=1 -SHORTSUFFIX=dwn -endif -ifeq ($(OS_TARGET),gba) -EXEEXT=.gba -SHAREDLIBEXT=.so -SHORTSUFFIX=gba -endif -else -ifeq ($(OS_TARGET),go32v1) -PPUEXT=.pp1 -OEXT=.o1 -ASMEXT=.s1 -SMARTEXT=.sl1 -STATICLIBEXT=.a1 -SHAREDLIBEXT=.so1 -STATICLIBPREFIX= -SHORTSUFFIX=v1 -endif -ifeq ($(OS_TARGET),go32v2) -STATICLIBPREFIX= -SHORTSUFFIX=dos -endif -ifeq ($(OS_TARGET),watcom) -STATICLIBPREFIX= -SHORTSUFFIX=wat -endif -ifeq ($(OS_TARGET),linux) -BATCHEXT=.sh -EXEEXT= -HASSHAREDLIB=1 -SHORTSUFFIX=lnx -endif -ifeq ($(OS_TARGET),freebsd) -BATCHEXT=.sh -EXEEXT= -HASSHAREDLIB=1 -SHORTSUFFIX=fbs -endif -ifeq ($(OS_TARGET),netbsd) -BATCHEXT=.sh -EXEEXT= -HASSHAREDLIB=1 -SHORTSUFFIX=nbs -endif -ifeq ($(OS_TARGET),openbsd) -BATCHEXT=.sh -EXEEXT= -HASSHAREDLIB=1 -SHORTSUFFIX=obs -endif -ifeq ($(OS_TARGET),win32) -PPUEXT=.ppw -OEXT=.ow -ASMEXT=.sw -SMARTEXT=.slw -STATICLIBEXT=.aw -SHAREDLIBEXT=.dll -SHORTSUFFIX=w32 -endif -ifeq ($(OS_TARGET),os2) -BATCHEXT=.cmd -PPUEXT=.ppo -ASMEXT=.so2 -OEXT=.oo2 -AOUTEXT=.out -SMARTEXT=.sl2 -STATICLIBPREFIX= -STATICLIBEXT=.ao2 -SHAREDLIBEXT=.dll -SHORTSUFFIX=os2 -ECHO=echo -endif -ifeq ($(OS_TARGET),amiga) -EXEEXT= -PPUEXT=.ppu -ASMEXT=.s -OEXT=.o -SMARTEXT=.sl -STATICLIBEXT=.a -SHAREDLIBEXT=.library -SHORTSUFFIX=amg -endif -ifeq ($(OS_TARGET),atari) -PPUEXT=.ppu -ASMEXT=.s -OEXT=.o -SMARTEXT=.sl -STATICLIBEXT=.a -EXEEXT=.ttp -SHORTSUFFIX=ata -endif -ifeq ($(OS_TARGET),beos) -BATCHEXT=.sh -PPUEXT=.ppu -ASMEXT=.s -OEXT=.o -SMARTEXT=.sl -STATICLIBEXT=.a -EXEEXT= -SHORTSUFFIX=be -endif -ifeq ($(OS_TARGET),solaris) -BATCHEXT=.sh -PPUEXT=.ppu -ASMEXT=.s -OEXT=.o -SMARTEXT=.sl -STATICLIBEXT=.a -EXEEXT= -SHORTSUFFIX=sun -endif -ifeq ($(OS_TARGET),qnx) -BATCHEXT=.sh -PPUEXT=.ppu -ASMEXT=.s -OEXT=.o -SMARTEXT=.sl -STATICLIBEXT=.a -EXEEXT= -SHORTSUFFIX=qnx -endif -ifeq ($(OS_TARGET),netware) -STATICLIBPREFIX= -PPUEXT=.ppu -OEXT=.o -ASMEXT=.s -SMARTEXT=.sl -STATICLIBEXT=.a -SHAREDLIBEXT=.nlm -EXEEXT=.nlm -SHORTSUFFIX=nw -endif -ifeq ($(OS_TARGET),netwlibc) -STATICLIBPREFIX= -PPUEXT=.ppu -OEXT=.o -ASMEXT=.s -SMARTEXT=.sl -STATICLIBEXT=.a -SHAREDLIBEXT=.nlm -EXEEXT=.nlm -SHORTSUFFIX=nwl -endif -ifeq ($(OS_TARGET),macos) -BATCHEXT= -PPUEXT=.ppu -ASMEXT=.s -OEXT=.o -SMARTEXT=.sl -STATICLIBEXT=.a -EXEEXT= -DEBUGSYMEXT=.xcoff -SHORTSUFFIX=mac -endif -endif -ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),) -FPCMADE=fpcmade.$(SHORTSUFFIX) -ZIPSUFFIX=$(SHORTSUFFIX) -ZIPCROSSPREFIX= -ZIPSOURCESUFFIX=src -ZIPEXAMPLESUFFIX=exm -else -FPCMADE=fpcmade.$(TARGETSUFFIX) -ZIPSOURCESUFFIX=.source -ZIPEXAMPLESUFFIX=.examples -ifdef CROSSCOMPILE -ZIPSUFFIX=.$(SOURCESUFFIX) -ZIPCROSSPREFIX=$(TARGETSUFFIX)- -else -ZIPSUFFIX=.$(TARGETSUFFIX) -ZIPCROSSPREFIX= -endif -endif -ifndef ECHO -ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(ECHO),) -ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(ECHO),) -ECHO= __missing_command_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= __missing_command_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= __missing_command_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= __missing_command_CPPROG -else -CPPROG:=$(firstword $(CPPROG)) -endif -endif -export CPPROG -ifndef RMPROG -RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(RMPROG),) -RMPROG= __missing_command_RMPROG -else -RMPROG:=$(firstword $(RMPROG)) -endif -endif -export RMPROG -ifndef MVPROG -MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(MVPROG),) -MVPROG= __missing_command_MVPROG -else -MVPROG:=$(firstword $(MVPROG)) -endif -endif -export MVPROG -ifndef MKDIRPROG -MKDIRPROG:=$(strip $(wildcard $(addsuffix /gmkdir$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(MKDIRPROG),) -MKDIRPROG:=$(strip $(wildcard $(addsuffix /mkdir$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(MKDIRPROG),) -MKDIRPROG= __missing_command_MKDIRPROG -else -MKDIRPROG:=$(firstword $(MKDIRPROG)) -endif -else -MKDIRPROG:=$(firstword $(MKDIRPROG)) -endif -endif -export MKDIRPROG -ifndef ECHOREDIR -ifndef inUnix -ECHOREDIR=echo -else -ECHOREDIR=$(ECHO) -endif -endif -ifndef COPY -COPY:=$(CPPROG) -fp -endif -ifndef COPYTREE -COPYTREE:=$(CPPROG) -Rfp -endif -ifndef MKDIRTREE -MKDIRTREE:=$(MKDIRPROG) -p -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= __missing_command_PPUMOVE -else -PPUMOVE:=$(firstword $(PPUMOVE)) -endif -endif -export PPUMOVE -ifndef FPCMAKE -FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(FPCMAKE),) -FPCMAKE= __missing_command_FPCMAKE -else -FPCMAKE:=$(firstword $(FPCMAKE)) -endif -endif -export FPCMAKE -ifndef ZIPPROG -ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(ZIPPROG),) -ZIPPROG= __missing_command_ZIPPROG -else -ZIPPROG:=$(firstword $(ZIPPROG)) -endif -endif -export ZIPPROG -ifndef TARPROG -TARPROG:=$(strip $(wildcard $(addsuffix /gtar$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(TARPROG),) -TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(TARPROG),) -TARPROG= __missing_command_TARPROG -else -TARPROG:=$(firstword $(TARPROG)) -endif -else -TARPROG:=$(firstword $(TARPROG)) -endif -endif -export TARPROG -ASNAME=$(BINUTILSPREFIX)as -LDNAME=$(BINUTILSPREFIX)ld -ARNAME=$(BINUTILSPREFIX)ar -RCNAME=$(BINUTILSPREFIX)rc -ifneq ($(findstring 1.0.,$(FPC_VERSION)),) -ifeq ($(OS_TARGET),win32) -ifeq ($(CROSSBINDIR),) -ASNAME=asw -LDNAME=ldw -ARNAME=arw -endif -endif -endif -ifndef ASPROG -ifdef CROSSBINDIR -ASPROG=$(CROSSBINDIR)/$(ASNAME)$(SRCEXEEXT) -else -ASPROG=$(ASNAME) -endif -endif -ifndef LDPROG -ifdef CROSSBINDIR -LDPROG=$(CROSSBINDIR)/$(LDNAME)$(SRCEXEEXT) -else -LDPROG=$(LDNAME) -endif -endif -ifndef RCPROG -ifdef CROSSBINDIR -RCPROG=$(CROSSBINDIR)/$(RCNAME)$(SRCEXEEXT) -else -RCPROG=$(RCNAME) -endif -endif -ifndef ARPROG -ifdef CROSSBINDIR -ARPROG=$(CROSSBINDIR)/$(ARNAME)$(SRCEXEEXT) -else -ARPROG=$(ARNAME) -endif -endif -AS=$(ASPROG) -LD=$(LDPROG) -RC=$(RCPROG) -AR=$(ARPROG) -PPAS=ppas$(SRCBATCHEXT) -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=vj -TAREXT=.tar.bz2 -else -TAROPT=vz -TAREXT=.tar.gz -endif -override REQUIRE_PACKAGES=rtl fcl fpgfx -ifeq ($(FULL_TARGET),i386-linux) -REQUIRE_PACKAGES_RTL=1 -REQUIRE_PACKAGES_HASH=1 -REQUIRE_PACKAGES_PASZLIB=1 -REQUIRE_PACKAGES_NETDB=1 -REQUIRE_PACKAGES_LIBASYNC=1 -REQUIRE_PACKAGES_PTHREADS=1 -REQUIRE_PACKAGES_FCL=1 -REQUIRE_PACKAGES_FPGFX=1 -REQUIRE_PACKAGES_PASJPEG=1 -REQUIRE_PACKAGES_IBASE=1 -REQUIRE_PACKAGES_POSTGRES=1 -REQUIRE_PACKAGES_MYSQL=1 -REQUIRE_PACKAGES_ODBC=1 -REQUIRE_PACKAGES_ORACLE=1 -REQUIRE_PACKAGES_SQLITE=1 -endif -ifdef REQUIRE_PACKAGES_RTL -PACKAGEDIR_RTL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR)))))) -ifneq ($(PACKAGEDIR_RTL),) -ifneq ($(wildcard $(PACKAGEDIR_RTL)/units/$(TARGETSUFFIX)),) -UNITDIR_RTL=$(PACKAGEDIR_RTL)/units/$(TARGETSUFFIX) -else -UNITDIR_RTL=$(PACKAGEDIR_RTL) -endif -ifdef CHECKDEPEND -$(PACKAGEDIR_RTL)/$(FPCMADE): - $(MAKE) -C $(PACKAGEDIR_RTL) $(FPCMADE) -override ALLDEPENDENCIES+=$(PACKAGEDIR_RTL)/$(FPCMADE) -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_HASH -PACKAGEDIR_HASH:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /hash/Makefile.fpc,$(PACKAGESDIR)))))) -ifneq ($(PACKAGEDIR_HASH),) -ifneq ($(wildcard $(PACKAGEDIR_HASH)/units/$(TARGETSUFFIX)),) -UNITDIR_HASH=$(PACKAGEDIR_HASH)/units/$(TARGETSUFFIX) -else -UNITDIR_HASH=$(PACKAGEDIR_HASH) -endif -ifdef CHECKDEPEND -$(PACKAGEDIR_HASH)/$(FPCMADE): - $(MAKE) -C $(PACKAGEDIR_HASH) $(FPCMADE) -override ALLDEPENDENCIES+=$(PACKAGEDIR_HASH)/$(FPCMADE) -endif -else -PACKAGEDIR_HASH= -UNITDIR_HASH:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /hash/Package.fpc,$(UNITSDIR))))) -ifneq ($(UNITDIR_HASH),) -UNITDIR_HASH:=$(firstword $(UNITDIR_HASH)) -else -UNITDIR_HASH= -endif -endif -ifdef UNITDIR_HASH -override COMPILER_UNITDIR+=$(UNITDIR_HASH) -endif -endif -ifdef REQUIRE_PACKAGES_PASZLIB -PACKAGEDIR_PASZLIB:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /paszlib/Makefile.fpc,$(PACKAGESDIR)))))) -ifneq ($(PACKAGEDIR_PASZLIB),) -ifneq ($(wildcard $(PACKAGEDIR_PASZLIB)/units/$(TARGETSUFFIX)),) -UNITDIR_PASZLIB=$(PACKAGEDIR_PASZLIB)/units/$(TARGETSUFFIX) -else -UNITDIR_PASZLIB=$(PACKAGEDIR_PASZLIB) -endif -ifdef CHECKDEPEND -$(PACKAGEDIR_PASZLIB)/$(FPCMADE): - $(MAKE) -C $(PACKAGEDIR_PASZLIB) $(FPCMADE) -override ALLDEPENDENCIES+=$(PACKAGEDIR_PASZLIB)/$(FPCMADE) -endif -else -PACKAGEDIR_PASZLIB= -UNITDIR_PASZLIB:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /paszlib/Package.fpc,$(UNITSDIR))))) -ifneq ($(UNITDIR_PASZLIB),) -UNITDIR_PASZLIB:=$(firstword $(UNITDIR_PASZLIB)) -else -UNITDIR_PASZLIB= -endif -endif -ifdef UNITDIR_PASZLIB -override COMPILER_UNITDIR+=$(UNITDIR_PASZLIB) -endif -endif -ifdef REQUIRE_PACKAGES_NETDB -PACKAGEDIR_NETDB:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /netdb/Makefile.fpc,$(PACKAGESDIR)))))) -ifneq ($(PACKAGEDIR_NETDB),) -ifneq ($(wildcard $(PACKAGEDIR_NETDB)/units/$(TARGETSUFFIX)),) -UNITDIR_NETDB=$(PACKAGEDIR_NETDB)/units/$(TARGETSUFFIX) -else -UNITDIR_NETDB=$(PACKAGEDIR_NETDB) -endif -ifdef CHECKDEPEND -$(PACKAGEDIR_NETDB)/$(FPCMADE): - $(MAKE) -C $(PACKAGEDIR_NETDB) $(FPCMADE) -override ALLDEPENDENCIES+=$(PACKAGEDIR_NETDB)/$(FPCMADE) -endif -else -PACKAGEDIR_NETDB= -UNITDIR_NETDB:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /netdb/Package.fpc,$(UNITSDIR))))) -ifneq ($(UNITDIR_NETDB),) -UNITDIR_NETDB:=$(firstword $(UNITDIR_NETDB)) -else -UNITDIR_NETDB= -endif -endif -ifdef UNITDIR_NETDB -override COMPILER_UNITDIR+=$(UNITDIR_NETDB) -endif -endif -ifdef REQUIRE_PACKAGES_LIBASYNC -PACKAGEDIR_LIBASYNC:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /libasync/Makefile.fpc,$(PACKAGESDIR)))))) -ifneq ($(PACKAGEDIR_LIBASYNC),) -ifneq ($(wildcard $(PACKAGEDIR_LIBASYNC)/units/$(TARGETSUFFIX)),) -UNITDIR_LIBASYNC=$(PACKAGEDIR_LIBASYNC)/units/$(TARGETSUFFIX) -else -UNITDIR_LIBASYNC=$(PACKAGEDIR_LIBASYNC) -endif -ifdef CHECKDEPEND -$(PACKAGEDIR_LIBASYNC)/$(FPCMADE): - $(MAKE) -C $(PACKAGEDIR_LIBASYNC) $(FPCMADE) -override ALLDEPENDENCIES+=$(PACKAGEDIR_LIBASYNC)/$(FPCMADE) -endif -else -PACKAGEDIR_LIBASYNC= -UNITDIR_LIBASYNC:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /libasync/Package.fpc,$(UNITSDIR))))) -ifneq ($(UNITDIR_LIBASYNC),) -UNITDIR_LIBASYNC:=$(firstword $(UNITDIR_LIBASYNC)) -else -UNITDIR_LIBASYNC= -endif -endif -ifdef UNITDIR_LIBASYNC -override COMPILER_UNITDIR+=$(UNITDIR_LIBASYNC) -endif -endif -ifdef REQUIRE_PACKAGES_PTHREADS -PACKAGEDIR_PTHREADS:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /pthreads/Makefile.fpc,$(PACKAGESDIR)))))) -ifneq ($(PACKAGEDIR_PTHREADS),) -ifneq ($(wildcard $(PACKAGEDIR_PTHREADS)/units/$(TARGETSUFFIX)),) -UNITDIR_PTHREADS=$(PACKAGEDIR_PTHREADS)/units/$(TARGETSUFFIX) -else -UNITDIR_PTHREADS=$(PACKAGEDIR_PTHREADS) -endif -ifdef CHECKDEPEND -$(PACKAGEDIR_PTHREADS)/$(FPCMADE): - $(MAKE) -C $(PACKAGEDIR_PTHREADS) $(FPCMADE) -override ALLDEPENDENCIES+=$(PACKAGEDIR_PTHREADS)/$(FPCMADE) -endif -else -PACKAGEDIR_PTHREADS= -UNITDIR_PTHREADS:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /pthreads/Package.fpc,$(UNITSDIR))))) -ifneq ($(UNITDIR_PTHREADS),) -UNITDIR_PTHREADS:=$(firstword $(UNITDIR_PTHREADS)) -else -UNITDIR_PTHREADS= -endif -endif -ifdef UNITDIR_PTHREADS -override COMPILER_UNITDIR+=$(UNITDIR_PTHREADS) -endif -endif -ifdef REQUIRE_PACKAGES_FCL -PACKAGEDIR_FCL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /fcl/Makefile.fpc,$(PACKAGESDIR)))))) -ifneq ($(PACKAGEDIR_FCL),) -ifneq ($(wildcard $(PACKAGEDIR_FCL)/units/$(TARGETSUFFIX)),) -UNITDIR_FCL=$(PACKAGEDIR_FCL)/units/$(TARGETSUFFIX) -else -UNITDIR_FCL=$(PACKAGEDIR_FCL) -endif -ifdef CHECKDEPEND -$(PACKAGEDIR_FCL)/$(FPCMADE): - $(MAKE) -C $(PACKAGEDIR_FCL) $(FPCMADE) -override ALLDEPENDENCIES+=$(PACKAGEDIR_FCL)/$(FPCMADE) -endif -else -PACKAGEDIR_FCL= -UNITDIR_FCL:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /fcl/Package.fpc,$(UNITSDIR))))) -ifneq ($(UNITDIR_FCL),) -UNITDIR_FCL:=$(firstword $(UNITDIR_FCL)) -else -UNITDIR_FCL= -endif -endif -ifdef UNITDIR_FCL -override COMPILER_UNITDIR+=$(UNITDIR_FCL) -endif -endif -ifdef REQUIRE_PACKAGES_FPGFX -PACKAGEDIR_FPGFX:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /fpgfx/Makefile.fpc,$(PACKAGESDIR)))))) -ifneq ($(PACKAGEDIR_FPGFX),) -ifneq ($(wildcard $(PACKAGEDIR_FPGFX)/units/$(TARGETSUFFIX)),) -UNITDIR_FPGFX=$(PACKAGEDIR_FPGFX)/units/$(TARGETSUFFIX) -else -UNITDIR_FPGFX=$(PACKAGEDIR_FPGFX) -endif -ifdef CHECKDEPEND -$(PACKAGEDIR_FPGFX)/$(FPCMADE): - $(MAKE) -C $(PACKAGEDIR_FPGFX) $(FPCMADE) -override ALLDEPENDENCIES+=$(PACKAGEDIR_FPGFX)/$(FPCMADE) -endif -else -PACKAGEDIR_FPGFX= -UNITDIR_FPGFX:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /fpgfx/Package.fpc,$(UNITSDIR))))) -ifneq ($(UNITDIR_FPGFX),) -UNITDIR_FPGFX:=$(firstword $(UNITDIR_FPGFX)) -else -UNITDIR_FPGFX= -endif -endif -ifdef UNITDIR_FPGFX -override COMPILER_UNITDIR+=$(UNITDIR_FPGFX) -endif -endif -ifdef REQUIRE_PACKAGES_PASJPEG -PACKAGEDIR_PASJPEG:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /pasjpeg/Makefile.fpc,$(PACKAGESDIR)))))) -ifneq ($(PACKAGEDIR_PASJPEG),) -ifneq ($(wildcard $(PACKAGEDIR_PASJPEG)/units/$(TARGETSUFFIX)),) -UNITDIR_PASJPEG=$(PACKAGEDIR_PASJPEG)/units/$(TARGETSUFFIX) -else -UNITDIR_PASJPEG=$(PACKAGEDIR_PASJPEG) -endif -ifdef CHECKDEPEND -$(PACKAGEDIR_PASJPEG)/$(FPCMADE): - $(MAKE) -C $(PACKAGEDIR_PASJPEG) $(FPCMADE) -override ALLDEPENDENCIES+=$(PACKAGEDIR_PASJPEG)/$(FPCMADE) -endif -else -PACKAGEDIR_PASJPEG= -UNITDIR_PASJPEG:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /pasjpeg/Package.fpc,$(UNITSDIR))))) -ifneq ($(UNITDIR_PASJPEG),) -UNITDIR_PASJPEG:=$(firstword $(UNITDIR_PASJPEG)) -else -UNITDIR_PASJPEG= -endif -endif -ifdef UNITDIR_PASJPEG -override COMPILER_UNITDIR+=$(UNITDIR_PASJPEG) -endif -endif -ifdef REQUIRE_PACKAGES_IBASE -PACKAGEDIR_IBASE:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /ibase/Makefile.fpc,$(PACKAGESDIR)))))) -ifneq ($(PACKAGEDIR_IBASE),) -ifneq ($(wildcard $(PACKAGEDIR_IBASE)/units/$(TARGETSUFFIX)),) -UNITDIR_IBASE=$(PACKAGEDIR_IBASE)/units/$(TARGETSUFFIX) -else -UNITDIR_IBASE=$(PACKAGEDIR_IBASE) -endif -ifdef CHECKDEPEND -$(PACKAGEDIR_IBASE)/$(FPCMADE): - $(MAKE) -C $(PACKAGEDIR_IBASE) $(FPCMADE) -override ALLDEPENDENCIES+=$(PACKAGEDIR_IBASE)/$(FPCMADE) -endif -else -PACKAGEDIR_IBASE= -UNITDIR_IBASE:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /ibase/Package.fpc,$(UNITSDIR))))) -ifneq ($(UNITDIR_IBASE),) -UNITDIR_IBASE:=$(firstword $(UNITDIR_IBASE)) -else -UNITDIR_IBASE= -endif -endif -ifdef UNITDIR_IBASE -override COMPILER_UNITDIR+=$(UNITDIR_IBASE) -endif -endif -ifdef REQUIRE_PACKAGES_POSTGRES -PACKAGEDIR_POSTGRES:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /postgres/Makefile.fpc,$(PACKAGESDIR)))))) -ifneq ($(PACKAGEDIR_POSTGRES),) -ifneq ($(wildcard $(PACKAGEDIR_POSTGRES)/units/$(TARGETSUFFIX)),) -UNITDIR_POSTGRES=$(PACKAGEDIR_POSTGRES)/units/$(TARGETSUFFIX) -else -UNITDIR_POSTGRES=$(PACKAGEDIR_POSTGRES) -endif -ifdef CHECKDEPEND -$(PACKAGEDIR_POSTGRES)/$(FPCMADE): - $(MAKE) -C $(PACKAGEDIR_POSTGRES) $(FPCMADE) -override ALLDEPENDENCIES+=$(PACKAGEDIR_POSTGRES)/$(FPCMADE) -endif -else -PACKAGEDIR_POSTGRES= -UNITDIR_POSTGRES:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /postgres/Package.fpc,$(UNITSDIR))))) -ifneq ($(UNITDIR_POSTGRES),) -UNITDIR_POSTGRES:=$(firstword $(UNITDIR_POSTGRES)) -else -UNITDIR_POSTGRES= -endif -endif -ifdef UNITDIR_POSTGRES -override COMPILER_UNITDIR+=$(UNITDIR_POSTGRES) -endif -endif -ifdef REQUIRE_PACKAGES_MYSQL -PACKAGEDIR_MYSQL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /mysql/Makefile.fpc,$(PACKAGESDIR)))))) -ifneq ($(PACKAGEDIR_MYSQL),) -ifneq ($(wildcard $(PACKAGEDIR_MYSQL)/units/$(TARGETSUFFIX)),) -UNITDIR_MYSQL=$(PACKAGEDIR_MYSQL)/units/$(TARGETSUFFIX) -else -UNITDIR_MYSQL=$(PACKAGEDIR_MYSQL) -endif -ifdef CHECKDEPEND -$(PACKAGEDIR_MYSQL)/$(FPCMADE): - $(MAKE) -C $(PACKAGEDIR_MYSQL) $(FPCMADE) -override ALLDEPENDENCIES+=$(PACKAGEDIR_MYSQL)/$(FPCMADE) -endif -else -PACKAGEDIR_MYSQL= -UNITDIR_MYSQL:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /mysql/Package.fpc,$(UNITSDIR))))) -ifneq ($(UNITDIR_MYSQL),) -UNITDIR_MYSQL:=$(firstword $(UNITDIR_MYSQL)) -else -UNITDIR_MYSQL= -endif -endif -ifdef UNITDIR_MYSQL -override COMPILER_UNITDIR+=$(UNITDIR_MYSQL) -endif -endif -ifdef REQUIRE_PACKAGES_ODBC -PACKAGEDIR_ODBC:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /odbc/Makefile.fpc,$(PACKAGESDIR)))))) -ifneq ($(PACKAGEDIR_ODBC),) -ifneq ($(wildcard $(PACKAGEDIR_ODBC)/units/$(TARGETSUFFIX)),) -UNITDIR_ODBC=$(PACKAGEDIR_ODBC)/units/$(TARGETSUFFIX) -else -UNITDIR_ODBC=$(PACKAGEDIR_ODBC) -endif -ifdef CHECKDEPEND -$(PACKAGEDIR_ODBC)/$(FPCMADE): - $(MAKE) -C $(PACKAGEDIR_ODBC) $(FPCMADE) -override ALLDEPENDENCIES+=$(PACKAGEDIR_ODBC)/$(FPCMADE) -endif -else -PACKAGEDIR_ODBC= -UNITDIR_ODBC:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /odbc/Package.fpc,$(UNITSDIR))))) -ifneq ($(UNITDIR_ODBC),) -UNITDIR_ODBC:=$(firstword $(UNITDIR_ODBC)) -else -UNITDIR_ODBC= -endif -endif -ifdef UNITDIR_ODBC -override COMPILER_UNITDIR+=$(UNITDIR_ODBC) -endif -endif -ifdef REQUIRE_PACKAGES_ORACLE -PACKAGEDIR_ORACLE:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /oracle/Makefile.fpc,$(PACKAGESDIR)))))) -ifneq ($(PACKAGEDIR_ORACLE),) -ifneq ($(wildcard $(PACKAGEDIR_ORACLE)/units/$(TARGETSUFFIX)),) -UNITDIR_ORACLE=$(PACKAGEDIR_ORACLE)/units/$(TARGETSUFFIX) -else -UNITDIR_ORACLE=$(PACKAGEDIR_ORACLE) -endif -ifdef CHECKDEPEND -$(PACKAGEDIR_ORACLE)/$(FPCMADE): - $(MAKE) -C $(PACKAGEDIR_ORACLE) $(FPCMADE) -override ALLDEPENDENCIES+=$(PACKAGEDIR_ORACLE)/$(FPCMADE) -endif -else -PACKAGEDIR_ORACLE= -UNITDIR_ORACLE:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /oracle/Package.fpc,$(UNITSDIR))))) -ifneq ($(UNITDIR_ORACLE),) -UNITDIR_ORACLE:=$(firstword $(UNITDIR_ORACLE)) -else -UNITDIR_ORACLE= -endif -endif -ifdef UNITDIR_ORACLE -override COMPILER_UNITDIR+=$(UNITDIR_ORACLE) -endif -endif -ifdef REQUIRE_PACKAGES_SQLITE -PACKAGEDIR_SQLITE:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /sqlite/Makefile.fpc,$(PACKAGESDIR)))))) -ifneq ($(PACKAGEDIR_SQLITE),) -ifneq ($(wildcard $(PACKAGEDIR_SQLITE)/units/$(TARGETSUFFIX)),) -UNITDIR_SQLITE=$(PACKAGEDIR_SQLITE)/units/$(TARGETSUFFIX) -else -UNITDIR_SQLITE=$(PACKAGEDIR_SQLITE) -endif -ifdef CHECKDEPEND -$(PACKAGEDIR_SQLITE)/$(FPCMADE): - $(MAKE) -C $(PACKAGEDIR_SQLITE) $(FPCMADE) -override ALLDEPENDENCIES+=$(PACKAGEDIR_SQLITE)/$(FPCMADE) -endif -else -PACKAGEDIR_SQLITE= -UNITDIR_SQLITE:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /sqlite/Package.fpc,$(UNITSDIR))))) -ifneq ($(UNITDIR_SQLITE),) -UNITDIR_SQLITE:=$(firstword $(UNITDIR_SQLITE)) -else -UNITDIR_SQLITE= -endif -endif -ifdef UNITDIR_SQLITE -override COMPILER_UNITDIR+=$(UNITDIR_SQLITE) -endif -endif -ifndef NOCPUDEF -override FPCOPTDEF=$(CPU_TARGET) -endif -ifneq ($(OS_TARGET),$(OS_SOURCE)) -override FPCOPT+=-T$(OS_TARGET) -endif -ifneq ($(CPU_TARGET),$(CPU_SOURCE)) -override FPCOPT+=-P$(CPU_TARGET) -endif -ifeq ($(OS_SOURCE),openbsd) -override FPCOPT+=-FD$(NEW_BINUTILS_PATH) -endif -ifndef CROSSBOOTSTRAP -ifneq ($(BINUTILSPREFIX),) -override FPCOPT+=-XP$(BINUTILSPREFIX) -Xc -endif -ifneq ($(BINUTILSPREFIX),) -override FPCOPT+=-Xr$(RLINKPATH) -endif -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 -ifneq ($(findstring 2.0.,$(FPC_VERSION)),) -ifeq ($(CPU_TARGET),i386) -FPCCPUOPT:=-OG2p3 -endif -ifeq ($(CPU_TARGET),powerpc) -FPCCPUOPT:=-O1r -endif -else -FPCCPUOPT:=-O1r -endif -override FPCOPT+=-Ur -Xs $(FPCCPUOPT) -n -override FPCOPTDEF+=RELEASE -endif -ifdef STRIP -override FPCOPT+=-Xs -endif -ifdef OPTIMIZE -override FPCOPT+=-O2 -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 CROSSBINDIR -override FPCOPT+=-FD$(CROSSBINDIR) -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_UNITTARGETDIR)/ -endif -else -ifdef COMPILER_TARGETDIR -override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR) -override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX) -endif -endif -ifdef CREATESHARED -override FPCOPT+=-Cg -ifeq ($(CPU_TARGET),i386) -override FPCOPT+=-Aas -endif -endif -ifdef LINKSHARED -endif -ifdef GCCLIBDIR -override FPCOPT+=-Fl$(GCCLIBDIR) -endif -ifdef OTHERLIBDIR -override FPCOPT+=$(addprefix -Fl,$(OTHERLIBDIR)) -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 AFULL_TARGET=$(CPU_TARGET)-$(OS_TARGET) -override AFULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE) -ifneq ($(AFULL_TARGET),$(AFULL_SOURCE)) -override ACROSSCOMPILE=1 -endif -ifdef ACROSSCOMPILE -override FPCOPT+=$(CROSSOPT) -endif -override COMPILER:=$(FPC) $(FPCOPT) -ifeq (,$(findstring -s ,$(COMPILER))) -EXECPPAS= -else -ifeq ($(FULL_SOURCE),$(FULL_TARGET)) -EXECPPAS:=@$(PPAS) -endif -endif -.PHONY: fpc_units -ifneq ($(TARGET_UNITS),) -override ALLTARGET+=fpc_units -override UNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_UNITS)) -override IMPLICITUNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_IMPLICITUNITS)) -override INSTALLPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES) -override CLEANPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES) -endif -fpc_units: $(COMPILER_UNITTARGETDIR) $(UNITPPUFILES) -ifdef TARGET_RSTS -override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS)) -override CLEANRSTFILES+=$(RSTFILES) -endif -.PHONY: fpc_all fpc_smart fpc_debug fpc_release fpc_shared -$(FPCMADE): $(ALLDEPENDENCIES) $(ALLTARGET) - @$(ECHOREDIR) Compiled > $(FPCMADE) -fpc_all: $(FPCMADE) -fpc_smart: - $(MAKE) all LINKSMART=1 CREATESMART=1 -fpc_debug: - $(MAKE) all DEBUG=1 -fpc_release: - $(MAKE) all RELEASE=1 -.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .lpr .dpr .pp .rc .res -$(COMPILER_UNITTARGETDIR): - $(MKDIRTREE) $(COMPILER_UNITTARGETDIR) -$(COMPILER_TARGETDIR): - $(MKDIRTREE) $(COMPILER_TARGETDIR) -%$(PPUEXT): %.pp - $(COMPILER) $< - $(EXECPPAS) -%$(PPUEXT): %.pas - $(COMPILER) $< - $(EXECPPAS) -%$(EXEEXT): %.pp - $(COMPILER) $< - $(EXECPPAS) -%$(EXEEXT): %.pas - $(COMPILER) $< - $(EXECPPAS) -%$(EXEEXT): %.lpr - $(COMPILER) $< - $(EXECPPAS) -%$(EXEEXT): %.dpr - $(COMPILER) $< - $(EXECPPAS) -%.res: %.rc - windres -i $< -o $@ -vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR) -vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR) -vpath %.lpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR) -vpath %.dpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR) -vpath %$(OEXT) $(COMPILER_UNITTARGETDIR) -vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR) -.PHONY: fpc_shared -override INSTALLTARGET+=fpc_shared_install -ifndef SHARED_LIBVERSION -SHARED_LIBVERSION=$(FPC_VERSION) -endif -ifndef SHARED_LIBNAME -SHARED_LIBNAME=$(PACKAGE_NAME) -endif -ifndef SHARED_FULLNAME -SHARED_FULLNAME=$(SHAREDLIBPREFIX)$(SHARED_LIBNAME)-$(SHARED_LIBVERSION)$(SHAREDLIBEXT) -endif -ifndef SHARED_LIBUNITS -SHARED_LIBUNITS:=$(TARGET_UNITS) $(TARGET_IMPLICITUNITS) -override SHARED_LIBUNITS:=$(filter-out $(INSTALL_BUILDUNIT),$(SHARED_LIBUNITS)) -endif -fpc_shared: -ifdef HASSHAREDLIB - $(MAKE) all CREATESHARED=1 LINKSHARED=1 CREATESMART=1 -ifneq ($(SHARED_BUILD),n) - $(PPUMOVE) -q $(SHARED_LIBUNITS) -i$(COMPILER_UNITTARGETDIR) -o$(SHARED_FULLNAME) -d$(COMPILER_UNITTARGETDIR) -endif -else - @$(ECHO) Shared Libraries not supported -endif -fpc_shared_install: -ifneq ($(SHARED_BUILD),n) -ifneq ($(SHARED_LIBUNITS),) -ifneq ($(wildcard $(COMPILER_UNITTARGETDIR)/$(SHARED_FULLNAME)),) - $(INSTALL) $(COMPILER_UNITTARGETDIR)/$(SHARED_FULLNAME) $(INSTALL_SHAREDDIR) -endif -endif -endif -.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall -ifdef INSTALL_UNITS -override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS)) -endif -ifdef INSTALL_BUILDUNIT -override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPPUFILES)) -endif -ifdef INSTALLPPUFILES -override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES))) $(addprefix $(IMPORTLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES))) -ifneq ($(UNITTARGETDIRPREFIX),) -override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPUFILES))) -override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPULINKFILES)))) -endif -override INSTALL_CREATEPACKAGEFPC=1 -endif -ifdef INSTALLEXEFILES -ifneq ($(TARGETDIRPREFIX),) -override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(notdir $(INSTALLEXEFILES))) -endif -endif -fpc_install: all $(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$(CPU_TARGET)-$(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=$(PACKAGE_NAME) -endif -endif -ifndef FULLZIPNAME -FULLZIPNAME=$(ZIPCROSSPREFIX)$(ZIPPREFIX)$(ZIPNAME)$(ZIPSUFFIX) -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$(SRCBATCHEXT)) -else -ZIPPATHSEP=/ -endif -ZIPCMD_CDPACK:=cd $(subst /,$(ZIPPATHSEP),$(PACKDIR)) -ZIPCMD_CDBASE:=cd $(subst /,$(ZIPPATHSEP),$(BASEDIR)) -ifdef USETAR -ZIPDESTFILE:=$(DIST_DESTDIR)/$(FULLZIPNAME)$(TAREXT) -ZIPCMD_ZIP:=$(TARPROG) cf$(TAROPT) $(ZIPDESTFILE) * -else -ZIPDESTFILE:=$(DIST_DESTDIR)/$(FULLZIPNAME)$(ZIPEXT) -ZIPCMD_ZIP:=$(subst /,$(ZIPPATHSEP),$(ZIPPROG)) -Dr $(ZIPOPT) $(ZIPDESTFILE) * -endif -fpc_zipinstall: - $(MAKE) $(ZIPTARGET) INSTALL_PREFIX=$(PACKDIR) ZIPINSTALL=1 - $(MKDIR) $(DIST_DESTDIR) - $(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=$(ZIPSOURCESUFFIX) -fpc_zipexampleinstall: -ifdef HASEXAMPLES - $(MAKE) fpc_zipinstall ZIPTARGET=exampleinstall ZIPSUFFIX=$(ZIPEXAMPLESUFFIX) -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))) $(addprefix $(IMPORTLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES))) -ifdef DEBUGSYMEXT -override CLEANPPULINKFILES+=$(subst $(PPUEXT),$(DEBUGSYMEXT),$(CLEANPPUFILES)) -endif -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) script.res link.res $(FPCEXTFILE) $(REDIRFILE) - -$(DEL) *$(ASMEXT) *_ppas$(BATCHEXT) -fpc_cleanall: $(CLEANTARGET) -ifdef CLEANEXEFILES - -$(DEL) $(CLEANEXEFILES) -endif -ifdef COMPILER_UNITTARGETDIR -ifdef CLEANPPUFILES - -$(DEL) $(CLEANPPUFILES) -endif -ifneq ($(CLEANPPULINKFILES),) - -$(DEL) $(CLEANPPULINKFILES) -endif -ifdef CLEANRSTFILES - -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES)) -endif -endif - -$(DELTREE) units - -$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT) -ifneq ($(PPUEXT),.ppu) - -$(DEL) *.o *.ppu *.a -endif - -$(DELTREE) *$(SMARTEXT) - -$(DEL) fpcmade.* Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE) - -$(DEL) *_ppas$(BATCHEXT) -ifdef AOUTEXT - -$(DEL) *$(AOUTEXT) -endif -ifdef DEBUGSYMEXT - -$(DEL) *$(DEBUGSYMEXT) -endif -fpc_distclean: cleanall -.PHONY: fpc_baseinfo -override INFORULES+=fpc_baseinfo -fpc_baseinfo: - @$(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) Full Source.. $(FULL_SOURCE) - @$(ECHO) Full Target.. $(FULL_TARGET) - @$(ECHO) SourceSuffix. $(SOURCESUFFIX) - @$(ECHO) TargetSuffix. $(TARGETSUFFIX) - @$(ECHO) - @$(ECHO) == Directory info == - @$(ECHO) - @$(ECHO) Required pkgs... $(REQUIRE_PACKAGES) - @$(ECHO) - @$(ECHO) Basedir......... $(BASEDIR) - @$(ECHO) FPCDir.......... $(FPCDIR) - @$(ECHO) CrossBinDir..... $(CROSSBINDIR) - @$(ECHO) UnitsDir........ $(UNITSDIR) - @$(ECHO) PackagesDir..... $(PACKAGESDIR) - @$(ECHO) - @$(ECHO) GCC library..... $(GCCLIBDIR) - @$(ECHO) Other library... $(OTHERLIBDIR) - @$(ECHO) - @$(ECHO) == Tools info == - @$(ECHO) - @$(ECHO) As........ $(AS) - @$(ECHO) Ld........ $(LD) - @$(ECHO) Ar........ $(AR) - @$(ECHO) Rc........ $(RC) - @$(ECHO) - @$(ECHO) Mv........ $(MVPROG) - @$(ECHO) Cp........ $(CPPROG) - @$(ECHO) Rm........ $(RMPROG) - @$(ECHO) GInstall.. $(GINSTALL) - @$(ECHO) Echo...... $(ECHO) - @$(ECHO) Shell..... $(SHELL) - @$(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 Implicit Units. $(TARGET_IMPLICITUNITS) - @$(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) ZipName.............. $(ZIPNAME) - @$(ECHO) ZipPrefix............ $(ZIPPREFIX) - @$(ECHO) ZipCrossPrefix....... $(ZIPCROSSPREFIX) - @$(ECHO) ZipSuffix............ $(ZIPSUFFIX) - @$(ECHO) FullZipName.......... $(FULLZIPNAME) - @$(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) -.PHONY: fpc_info -fpc_info: $(INFORULES) -.PHONY: fpc_makefile fpc_makefiles fpc_makefile_sub1 fpc_makefile_sub2 \ - fpc_makefile_dirs -fpc_makefile: - $(FPCMAKE) -w -T$(OS_TARGET) Makefile.fpc -fpc_makefile_sub1: -ifdef TARGET_DIRS - $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_DIRS)) -endif -ifdef TARGET_EXAMPLEDIRS - $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_EXAMPLEDIRS)) -endif -fpc_makefile_sub2: $(addsuffix _makefile_dirs,$(TARGET_DIRS) $(TARGET_EXAMPLEDIRS)) -fpc_makefile_dirs: fpc_makefile_sub1 fpc_makefile_sub2 -fpc_makefiles: fpc_makefile fpc_makefile_dirs -all: fpc_all -debug: fpc_debug -smart: fpc_smart -release: fpc_release -units: fpc_units -examples: -shared: fpc_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 -distclean: fpc_distclean -cleanall: fpc_cleanall -info: fpc_info -makefiles: fpc_makefiles -.PHONY: all debug smart release units examples shared install sourceinstall exampleinstall distinstall zipinstall zipsourceinstall zipexampleinstall zipdistinstall clean distclean cleanall info makefiles -ifneq ($(wildcard fpcmake.loc),) -include fpcmake.loc -endif -fpgui$(PPUEXT): $(wildcard *.pp *.inc) diff --git a/gui/Makefile.fpc b/gui/Makefile.fpc deleted file mode 100644 index c3c7f032..00000000 --- a/gui/Makefile.fpc +++ /dev/null @@ -1,41 +0,0 @@ -# -# Makefile.fpc for fpGUI -# - -[package] -name=fpgui -version=0.3 - -[require] -packages=fcl fpgfx - -[target] -units=fpgui stylemanager -#dirs=db - -#[dirs] -#incdir=defimpl -#incdir_win32=win32 - -[compiler] -unittargetdir=units -#targetdir=. -options=-S2h -includedir_linux=defimpl -includedir_freebsd=defimpl -includedir_netbsd=defimpl -includedir_win32=win32 - -[install] -#buildunit=fpgui -fpcpackage=y - -[default] -fpcdir=/opt/fpc/src - -[rules] -fpgui$(PPUEXT): $(wildcard *.pas *.inc) - -[libs] -libname=libfpgui.so -libversion=0.3 diff --git a/gui/db/Makefile b/gui/db/Makefile deleted file mode 100644 index 5485f240..00000000 --- a/gui/db/Makefile +++ /dev/null @@ -1,1373 +0,0 @@ -# -# Makefile generated by fpcmake v1.00 [2000/12/25] -# - -defaultrule: all - -##################################################################### -# Autodetect OS (Linux or Dos or Windows NT or OS/2) -# define inUnix when running under Unix (Linux,FreeBSD) -# define inWinNT when running under WinNT -# define inOS2 when running under OS/2 -##################################################################### - -# We need only / in the path -override PATH:=$(subst \,/,$(PATH)) - -# Search for PWD and determine also if we are under linux -PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(subst ;, ,$(PATH))))) -ifeq ($(PWD),) -PWD:=$(strip $(wildcard $(addsuffix /pwd,$(subst :, ,$(PATH))))) -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 -inUnix=1 -PWD:=$(firstword $(PWD)) -endif -else -PWD:=$(firstword $(PWD)) -endif - -# Detect NT - NT sets OS to Windows_NT -# Detect OS/2 - OS/2 has OS2_SHELL defined -ifndef inUnix -ifeq ($(OS),Windows_NT) -inWinNT=1 -else -ifdef OS2_SHELL -inOS2=1 -endif -endif -endif - -# The extension of executables -ifdef inUnix -SRCEXEEXT= -else -SRCEXEEXT=.exe -endif - -# The extension of batch files / scripts -ifdef inUnix -BATCHEXT=.sh -else -ifdef inOS2 -BATCHEXT=.cmd -else -BATCHEXT=.bat -endif -endif - -# Path Separator, the subst trick is necessary for the \ that can't exists -# at the end of a line -ifdef inUnix -PATHSEP=/ -else -PATHSEP=$(subst /,\,/) -endif - -# The path which is searched separated by spaces -ifdef inUnix -SEARCHPATH=$(subst :, ,$(PATH)) -else -SEARCHPATH=$(subst ;, ,$(PATH)) -endif - -# Base dir -ifdef PWD -BASEDIR:=$(shell $(PWD)) -else -BASEDIR=. -endif - -##################################################################### -# FPC version/target Detection -##################################################################### - -# What compiler to use ? -ifndef FPC -# Compatibility with old makefiles -ifdef PP -FPC=$(PP) -else -FPC=ppc386 -endif -endif -override FPC:=$(subst $(SRCEXEEXT),,$(FPC)) -override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT) - -# Target OS -ifndef OS_TARGET -OS_TARGET:=$(shell $(FPC) -iTO) -endif - -# Source OS -ifndef OS_SOURCE -OS_SOURCE:=$(shell $(FPC) -iSO) -endif - -# Target CPU -ifndef CPU_TARGET -CPU_TARGET:=$(shell $(FPC) -iTP) -endif - -# Source CPU -ifndef CPU_SOURCE -CPU_SOURCE:=$(shell $(FPC) -iSP) -endif - -# FPC version -ifndef FPC_VERSION -FPC_VERSION:=$(shell $(FPC) -iV) -endif - -export FPC OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FPC_VERSION - -##################################################################### -# FPCDIR Setting -##################################################################### - -# Test FPCDIR to look if the RTL dir exists -ifdef FPCDIR -override FPCDIR:=$(subst \,/,$(FPCDIR)) -ifeq ($(wildcard $(FPCDIR)/rtl),) -ifeq ($(wildcard $(FPCDIR)/units),) -override FPCDIR=wrong -endif -endif -else -override FPCDIR=wrong -endif - -# Default FPCDIR -ifeq ($(FPCDIR),wrong) -override FPCDIR=../../../.. -ifeq ($(wildcard $(FPCDIR)/rtl),) -ifeq ($(wildcard $(FPCDIR)/units),) -override FPCDIR=wrong -endif -endif -endif - -# Detect FPCDIR -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 $(FPCDIR)/rtl),) -ifeq ($(wildcard $(FPCDIR)/units),) -override FPCDIR:=$(FPCDIR)/.. -ifeq ($(wildcard $(FPCDIR)/rtl),) -ifeq ($(wildcard $(FPCDIR)/units),) -override FPCDIR=c:/pp -endif -endif -endif -endif -endif -endif - -ifndef PACKAGESDIR -PACKAGESDIR=$(FPCDIR)/packages -endif -ifndef TOOLKITSDIR -TOOLKITSDIR= -endif -ifndef COMPONENTSDIR -COMPONENTSDIR= -endif - -# Create units dir -ifneq ($(FPCDIR),.) -UNITSDIR=$(FPCDIR)/units/$(OS_TARGET) -endif - -##################################################################### -# User Settings -##################################################################### - - -# Targets - -override UNITOBJECTS+=fpgui_db - -# Clean - - -# Install - -ZIPTARGET=install - -# Defaults - -override NEEDOPT=-S2h - -# Directories - -override NEEDUNITDIR=.. - -# Packages - -override PACKAGES+=rtl fcl fpgfx fpgui - -# Libraries - - -# Info - -INFOTARGET=fpc_infocfg fpc_infoobjects fpc_infoinstall - -##################################################################### -# Shell tools -##################################################################### - -# echo -ifndef ECHO -ECHO:=$(strip $(wildcard $(addsuffix /gecho$(EXEEXT),$(SEARCHPATH)))) -ifeq ($(ECHO),) -ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(ECHO),) -ECHO:=echo -ECHOE:=echo -else -ECHO:=$(firstword $(ECHO)) -ECHOE=$(ECHO) -E -endif -else -ECHO:=$(firstword $(ECHO)) -ECHOE=$(ECHO) -E -endif -endif - -# To copy pograms -ifndef COPY -COPY:=cp -fp -endif - -# Copy a whole tree -ifndef COPYTREE -COPYTREE:=cp -rfp -endif - -# To move pograms -ifndef MOVE -MOVE:=mv -f -endif - -# Check delete program -ifndef DEL -DEL:=rm -f -endif - -# Check deltree program -ifndef DELTREE -DELTREE:=rm -rf -endif - -# To install files -ifndef INSTALL -ifdef inUnix -INSTALL:=install -c -m 644 -else -INSTALL:=$(COPY) -endif -endif - -# To install programs -ifndef INSTALLEXE -ifdef inUnix -INSTALLEXE:=install -c -m 755 -else -INSTALLEXE:=$(COPY) -endif -endif - -# To make a directory. -ifndef MKDIR -ifdef inUnix -MKDIR:=install -m 755 -d -else -MKDIR:=ginstall -m 755 -d -endif -endif - -export ECHO ECHOE COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR - -##################################################################### -# Default Tools -##################################################################### - -# assembler, redefine it if cross compiling -ifndef AS -AS=as -endif - -# linker, but probably not used -ifndef LD -LD=ld -endif - -# ppas.bat / ppas.sh -PPAS=ppas$(BATCHEXT) - -# ldconfig to rebuild .so cache -ifdef inUnix -LDCONFIG=ldconfig -else -LDCONFIG= -endif - -# ppumove -ifndef PPUMOVE -PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(PPUMOVE),) -PPUMOVE= -else -PPUMOVE:=$(firstword $(PPUMOVE)) -endif -endif -export PPUMOVE - -# ppufiles -ifndef PPUFILES -PPUFILES:=$(strip $(wildcard $(addsuffix /ppufiles$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(PPUFILES),) -PPUFILES= -else -PPUFILES:=$(firstword $(PPUFILES)) -endif -endif -export PPUFILES - -# Look if UPX is found for go32v2 and win32. We can't use $UPX becuase -# upx uses that one itself (PFV) -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 - -# ZipProg, you can't use Zip as the var name (PFV) -ifndef ZIPPROG -ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(ZIPPROG),) -ZIPPROG= -else -ZIPPROG:=$(firstword $(ZIPPROG)) -endif -endif -export ZIPPROG - -ZIPOPT=-9 -ZIPEXT=.zip - -# Tar -ifndef TARPROG -TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(TARPROG),) -TARPROG= -else -TARPROG:=$(firstword $(TARPROG)) -endif -endif -export TARPROG - -ifeq ($(USETAR),bz2) -TAROPT=vI -TAREXT=.tar.bz2 -else -TAROPT=vz -TAREXT=.tar.gz -endif - -##################################################################### -# Default extensions -##################################################################### - -# Default needed extensions (Go32v2,Linux) -LOADEREXT=.as -EXEEXT=.exe -PPLEXT=.ppl -PPUEXT=.ppu -OEXT=.o -ASMEXT=.s -SMARTEXT=.sl -STATICLIBEXT=.a -SHAREDLIBEXT=.so -RSTEXT=.rst -FPCMADE=fpcmade - -# Go32v1 -ifeq ($(OS_TARGET),go32v1) -PPUEXT=.pp1 -OEXT=.o1 -ASMEXT=.s1 -SMARTEXT=.sl1 -STATICLIBEXT=.a1 -SHAREDLIBEXT=.so1 -FPCMADE=fpcmade.v1 -endif - -# Go32v2 -ifeq ($(OS_TARGET),go32v2) -FPCMADE=fpcmade.dos -endif - -# Linux -ifeq ($(OS_TARGET),linux) -EXEEXT= -HASSHAREDLIB=1 -FPCMADE=fpcmade.lnx -endif - -# Linux -ifeq ($(OS_TARGET),freebsd) -EXEEXT= -HASSHAREDLIB=1 -FPCMADE=fpcmade.freebsd -endif - -# Win32 -ifeq ($(OS_TARGET),win32) -PPUEXT=.ppw -OEXT=.ow -ASMEXT=.sw -SMARTEXT=.slw -STATICLIBEXT=.aw -SHAREDLIBEXT=.dll -FPCMADE=fpcmade.w32 -endif - -# OS/2 -ifeq ($(OS_TARGET),os2) -PPUEXT=.ppo -ASMEXT=.so2 -OEXT=.oo2 -SMARTEXT=.so -STATICLIBEXT=.ao2 -SHAREDLIBEXT=.dll -FPCMADE=fpcmade.os2 -endif - -# library prefix -LIBPREFIX=lib -ifeq ($(OS_TARGET),go32v2) -LIBPREFIX= -endif -ifeq ($(OS_TARGET),go32v1) -LIBPREFIX= -endif - -# determine which .pas extension is used -ifndef PASEXT -ifdef EXEOBJECTS -override TESTPAS:=$(strip $(wildcard $(addsuffix .pas,$(firstword $(EXEOBJECTS))))) -else -override TESTPAS:=$(strip $(wildcard $(addsuffix .pas,$(firstword $(UNITOBJECTS))))) -endif -ifeq ($(TESTPAS),) -PASEXT=.pp -else -PASEXT=.pas -endif -endif - - -# Check if the dirs really exists, else turn it off -ifeq ($(wildcard $(UNITSDIR)),) -UNITSDIR= -endif -ifeq ($(wildcard $(TOOLKITSDIR)),) -TOOLKITSDIR= -endif -ifeq ($(wildcard $(PACKAGESDIR)),) -PACKAGESDIR= -endif -ifeq ($(wildcard $(COMPONENTSDIR)),) -COMPONENTSDIR= -endif - - -# PACKAGESDIR packages - -PACKAGERTL=1 -PACKAGEFCL=1 -PACKAGEFPGFX=1 -PACKAGEFPGUI=1 - -ifdef PACKAGERTL -ifneq ($(wildcard $(FPCDIR)/rtl),) -ifneq ($(wildcard $(FPCDIR)/rtl/$(OS_TARGET)),) -PACKAGEDIR_RTL=$(FPCDIR)/rtl/$(OS_TARGET) -else -PACKAGEDIR_RTL=$(FPCDIR)/rtl -endif -ifeq ($(wildcard $(PACKAGEDIR_RTL)/$(FPCMADE)),) -override COMPILEPACKAGES+=package_rtl -package_rtl: - $(MAKE) -C $(PACKAGEDIR_RTL) all -endif -UNITDIR_RTL=$(PACKAGEDIR_RTL) -else -PACKAGEDIR_RTL= -ifneq ($(wildcard $(UNITSDIR)/rtl),) -ifneq ($(wildcard $(UNITSDIR)/rtl/$(OS_TARGET)),) -UNITDIR_RTL=$(UNITSDIR)/rtl/$(OS_TARGET) -else -UNITDIR_RTL=$(UNITSDIR)/rtl -endif -else -UNITDIR_RTL= -endif -endif -ifdef UNITDIR_RTL -override NEEDUNITDIR+=$(UNITDIR_RTL) -endif -endif -ifdef PACKAGEFCL -ifneq ($(wildcard $(FPCDIR)/fcl),) -ifneq ($(wildcard $(FPCDIR)/fcl/$(OS_TARGET)),) -PACKAGEDIR_FCL=$(FPCDIR)/fcl/$(OS_TARGET) -else -PACKAGEDIR_FCL=$(FPCDIR)/fcl -endif -ifeq ($(wildcard $(PACKAGEDIR_FCL)/$(FPCMADE)),) -override COMPILEPACKAGES+=package_fcl -package_fcl: - $(MAKE) -C $(PACKAGEDIR_FCL) all -endif -UNITDIR_FCL=$(PACKAGEDIR_FCL) -else -PACKAGEDIR_FCL= -ifneq ($(wildcard $(UNITSDIR)/fcl),) -ifneq ($(wildcard $(UNITSDIR)/fcl/$(OS_TARGET)),) -UNITDIR_FCL=$(UNITSDIR)/fcl/$(OS_TARGET) -else -UNITDIR_FCL=$(UNITSDIR)/fcl -endif -else -UNITDIR_FCL= -endif -endif -ifdef UNITDIR_FCL -override NEEDUNITDIR+=$(UNITDIR_FCL) -endif -endif -ifdef PACKAGEFPGFX -ifneq ($(wildcard $(PACKAGESDIR)/fpgfx),) -ifneq ($(wildcard $(PACKAGESDIR)/fpgfx/$(OS_TARGET)),) -PACKAGEDIR_FPGFX=$(PACKAGESDIR)/fpgfx/$(OS_TARGET) -else -PACKAGEDIR_FPGFX=$(PACKAGESDIR)/fpgfx -endif -ifeq ($(wildcard $(PACKAGEDIR_FPGFX)/$(FPCMADE)),) -override COMPILEPACKAGES+=package_fpgfx -package_fpgfx: - $(MAKE) -C $(PACKAGEDIR_FPGFX) all -endif -UNITDIR_FPGFX=$(PACKAGEDIR_FPGFX) -else -PACKAGEDIR_FPGFX= -ifneq ($(wildcard $(UNITSDIR)/fpgfx),) -ifneq ($(wildcard $(UNITSDIR)/fpgfx/$(OS_TARGET)),) -UNITDIR_FPGFX=$(UNITSDIR)/fpgfx/$(OS_TARGET) -else -UNITDIR_FPGFX=$(UNITSDIR)/fpgfx -endif -else -UNITDIR_FPGFX= -endif -endif -ifdef UNITDIR_FPGFX -override NEEDUNITDIR+=$(UNITDIR_FPGFX) -endif -endif -ifdef PACKAGEFPGUI -ifneq ($(wildcard $(PACKAGESDIR)/fpgui),) -ifneq ($(wildcard $(PACKAGESDIR)/fpgui/$(OS_TARGET)),) -PACKAGEDIR_FPGUI=$(PACKAGESDIR)/fpgui/$(OS_TARGET) -else -PACKAGEDIR_FPGUI=$(PACKAGESDIR)/fpgui -endif -ifeq ($(wildcard $(PACKAGEDIR_FPGUI)/$(FPCMADE)),) -override COMPILEPACKAGES+=package_fpgui -package_fpgui: - $(MAKE) -C $(PACKAGEDIR_FPGUI) all -endif -UNITDIR_FPGUI=$(PACKAGEDIR_FPGUI) -else -PACKAGEDIR_FPGUI= -ifneq ($(wildcard $(UNITSDIR)/fpgui),) -ifneq ($(wildcard $(UNITSDIR)/fpgui/$(OS_TARGET)),) -UNITDIR_FPGUI=$(UNITSDIR)/fpgui/$(OS_TARGET) -else -UNITDIR_FPGUI=$(UNITSDIR)/fpgui -endif -else -UNITDIR_FPGUI= -endif -endif -ifdef UNITDIR_FPGUI -override NEEDUNITDIR+=$(UNITDIR_FPGUI) -endif -endif - - -##################################################################### -# Default Directories -##################################################################### - -# Linux and freebsd use unix dirs with /usr/bin, /usr/lib -# When zipping use the target as default, when normal install then -# use the source os as default -ifdef ZIPNAME -# Zipinstall -ifeq ($(OS_TARGET),linux) -UNIXINSTALLDIR=1 -endif -ifeq ($(OS_TARGET),freebsd) -UNIXINSTALLDIR=1 -endif -else -# Normal install -ifeq ($(OS_SOURCE),linux) -UNIXINSTALLDIR=1 -endif -ifeq ($(OS_SOURCE),freebsd) -UNIXINSTALLDIR=1 -endif -endif - -# set the prefix directory where to install everything -ifndef PREFIXINSTALLDIR -ifdef UNIXINSTALLDIR -PREFIXINSTALLDIR=/usr -else -PREFIXINSTALLDIR=/pp -endif -endif -export PREFIXINSTALLDIR - -# Where to place the resulting zip files -ifndef DESTZIPDIR -DESTZIPDIR:=$(BASEDIR) -endif -export DESTZIPDIR - -##################################################################### -# Install Directories -##################################################################### - -# set the base directory where to install everything -ifndef BASEINSTALLDIR -ifdef UNIXINSTALLDIR -BASEINSTALLDIR=$(PREFIXINSTALLDIR)/lib/fpc/$(FPC_VERSION) -else -BASEINSTALLDIR=$(PREFIXINSTALLDIR) -endif -endif - -# set the directory where to install the binaries -ifndef BININSTALLDIR -ifdef UNIXINSTALLDIR -BININSTALLDIR=$(PREFIXINSTALLDIR)/bin -else -BININSTALLDIR=$(BASEINSTALLDIR)/bin/$(OS_TARGET) -endif -endif - -# set the directory where to install the units. -ifndef UNITINSTALLDIR -UNITINSTALLDIR=$(BASEINSTALLDIR)/units/$(OS_TARGET) -ifdef UNITSUBDIR -UNITINSTALLDIR:=$(UNITINSTALLDIR)/$(UNITSUBDIR) -endif -endif - -# Where to install shared libraries -ifndef LIBINSTALLDIR -ifdef UNIXINSTALLDIR -LIBINSTALLDIR=$(PREFIXINSTALLDIR)/lib -else -LIBINSTALLDIR=$(UNITINSTALLDIR) -endif -endif - -# Where the source files will be stored -ifndef SOURCEINSTALLDIR -ifdef UNIXINSTALLDIR -SOURCEINSTALLDIR=$(PREFIXINSTALLDIR)/src/fpc-$(FPC_VERSION) -else -SOURCEINSTALLDIR=$(BASEINSTALLDIR)/source -endif -ifdef SOURCESUBDIR -SOURCEINSTALLDIR:=$(SOURCEINSTALLDIR)/$(SOURCESUBDIR) -endif -endif - -# Where the doc files will be stored -ifndef DOCINSTALLDIR -ifdef UNIXINSTALLDIR -DOCINSTALLDIR=$(PREFIXINSTALLDIR)/doc/fpc-$(FPC_VERSION) -else -DOCINSTALLDIR=$(BASEINSTALLDIR)/doc -endif -endif - -# Where to install the examples, under linux we use the doc dir -# because the copytree command will create a subdir itself -ifndef EXAMPLEINSTALLDIR -ifdef UNIXINSTALLDIR -EXAMPLEINSTALLDIR=$(DOCINSTALLDIR)/examples -else -EXAMPLEINSTALLDIR=$(BASEINSTALLDIR)/examples -endif -ifdef EXAMPLESUBDIR -EXAMPLEINSTALLDIR:=$(EXAMPLEINSTALLDIR)/$(EXAMPLESUBDIR) -endif -endif - -# Where the some extra (data)files will be stored -ifndef DATAINSTALLDIR -DATAINSTALLDIR=$(BASEINSTALLDIR) -endif - -##################################################################### -# Redirection -##################################################################### - -ifndef REDIRFILE -REDIRFILE=log -endif - -ifdef REDIR -ifndef inUnix -override FPC=redir -eo $(FPC) -endif -# set the verbosity to max -override FPCOPT+=-va -override REDIR:= >> $(REDIRFILE) -endif - - -##################################################################### -# Compiler Command Line -##################################################################### - -# Load commandline OPTDEF and add FPC_CPU define -override FPCOPTDEF:=-d$(CPU_TARGET) - -# Load commandline OPT and add target and unit dir to be sure -ifneq ($(OS_TARGET),$(OS_SOURCE)) -override FPCOPT+=-T$(OS_TARGET) -endif - -# User dirs should be first, so they are looked at first -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 - -# Smartlinking -ifdef LINKSMART -override FPCOPT+=-XX -endif - -# Smartlinking creation -ifdef CREATESMART -override FPCOPT+=-CX -endif - -# Debug -ifdef DEBUG -override FPCOPT+=-gl -dDEBUG -endif - -# Release mode (strip, optimize and don't load ppc386.cfg) -# 0.99.12b has a bug in the optimizer so don't use it by default -ifdef RELEASE -ifeq ($(FPC_VERSION),0.99.12) -override FPCOPT+=-Xs -OGp3 -n -else -override FPCOPT+=-Xs -OG2p3 -n -endif -endif - -# Strip -ifdef STRIP -override FPCOPT+=-Xs -endif - -# Optimizer -ifdef OPTIMIZE -override FPCOPT+=-OG2p3 -endif - -# Verbose settings (warning,note,info) -ifdef VERBOSE -override FPCOPT+=-vwni -endif - -ifdef NEEDOPT -override FPCOPT+=$(NEEDOPT) -endif - -ifdef NEEDUNITDIR -override FPCOPT+=$(addprefix -Fu,$(NEEDUNITDIR)) -endif - -ifdef UNITSDIR -override FPCOPT+=-Fu$(UNITSDIR) -endif - -# Target dirs and the prefix to use for clean/install -ifdef TARGETDIR -override FPCOPT+=-FE$(TARGETDIR) -ifeq ($(TARGETDIR),.) -override TARGETDIRPREFIX= -else -override TARGETDIRPREFIX=$(TARGETDIR)/ -endif -endif -ifdef UNITTARGETDIR -override FPCOPT+=-FU$(UNITTARGETDIR) -ifeq ($(UNITTARGETDIR),.) -override UNITTARGETDIRPREFIX= -else -override UNITTARGETDIRPREFIX=$(TARGETDIR)/ -endif -else -ifdef TARGETDIR -override UNITTARGETDIR=$(TARGETDIR) -override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX) -endif -endif - -# Add commandline options last so they can override -ifdef OPT -override FPCOPT+=$(OPT) -endif - -# Add defines from FPCOPTDEF to FPCOPT -ifdef FPCOPTDEF -override FPCOPT+=$(FPCOPTDEF) -endif - -# Error file ? -ifdef ERRORFILE -override FPCOPT+=-Fr$(ERRORFILE) -endif - -# Was a config file specified ? -ifdef CFGFILE -override FPCOPT+=@$(CFGFILE) -endif - -# For win32 the options are passed using the environment FPCEXTCMD -ifeq ($(OS_SOURCE),win32) -override FPCEXTCMD:=$(FPCOPT) -override FPCOPT:=!FPCEXTCMD -export FPCEXTCMD -endif - -# Compiler commandline -override COMPILER:=$(FPC) $(FPCOPT) - -# also call ppas if with command option -s -# but only if the OS_SOURCE and OS_TARGE are equal -ifeq (,$(findstring -s ,$(COMPILER))) -EXECPPAS= -else -ifeq ($(OS_SOURCE),$(OS_TARGET)) -EXECPPAS:=@$(PPAS) -endif -endif - -##################################################################### -# Standard rules -##################################################################### - -all: fpc_all - -debug: fpc_debug - -smart: fpc_smart - -shared: fpc_shared - -showinstall: fpc_showinstall - -install: fpc_install - -sourceinstall: fpc_sourceinstall - -exampleinstall: fpc_exampleinstall - -zipinstall: fpc_zipinstall - -zipsourceinstall: fpc_zipsourceinstall - -zipexampleinstall: fpc_zipexampleinstall - -clean: fpc_clean - -distclean: fpc_distclean - -cleanall: fpc_cleanall - -info: fpc_info - -.PHONY: all debug smart shared showinstall install sourceinstall exampleinstall zipinstall zipsourceinstall zipexampleinstall clean distclean cleanall info - -##################################################################### -# Units -##################################################################### - -.PHONY: fpc_units - -override ALLTARGET+=fpc_units - -override UNITPPUFILES=$(addsuffix $(PPUEXT),$(UNITOBJECTS)) -override INSTALLPPUFILES+=$(UNITPPUFILES) -override CLEANPPUFILES+=$(UNITPPUFILES) - -fpc_units: $(UNITPPUFILES) - -##################################################################### -# General compile rules -##################################################################### - -.PHONY: fpc_packages fpc_all fpc_debug - -$(FPCMADE): $(ALLTARGET) - @$(ECHO) Compiled > $(FPCMADE) - -fpc_packages: $(COMPILEPACKAGES) - -fpc_all: fpc_packages $(FPCMADE) - -fpc_debug: - $(MAKE) all DEBUG=1 - -# Search paths for .ppu if targetdir is set -ifdef UNITTARGETDIR -vpath %$(PPUEXT) $(UNITTARGETDIR) -endif - -# General compile rules, available for both possible PASEXT - -.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .pp - -%$(PPUEXT): %.pp - $(COMPILER) $< $(REDIR) - $(EXECPPAS) - -%$(PPUEXT): %.pas - $(COMPILER) $< $(REDIR) - $(EXECPPAS) - -%$(EXEEXT): %.pp - $(COMPILER) $< $(REDIR) - $(EXECPPAS) - -%$(EXEEXT): %.pas - $(COMPILER) $< $(REDIR) - $(EXECPPAS) - -##################################################################### -# Library -##################################################################### - -.PHONY: fpc_smart fpc_shared - -ifdef LIBVERSION -LIBFULLNAME=$(LIBNAME).$(LIBVERSION) -else -LIBFULLNAME=$(LIBNAME) -endif - -# Default sharedlib units are all unit objects -ifndef SHAREDLIBUNITOBJECTS -SHAREDLIBUNITOBJECTS:=$(UNITOBJECTS) -endif - -fpc_smart: - $(MAKE) all LINKSMART=1 CREATESMART=1 - -fpc_shared: all -ifdef HASSHAREDLIB -ifndef LIBNAME - @$(ECHO) "LIBNAME not set" -else - $(PPUMOVE) $(SHAREDLIBUNITOBJECTS) -o$(LIBFULLNAME) -endif -else - @$(ECHO) "Shared Libraries not supported" -endif - -##################################################################### -# Install rules -##################################################################### - -.PHONY: fpc_showinstall fpc_install - -ifdef EXTRAINSTALLUNITS -override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(EXTRAINSTALLUNITS)) -endif - -ifdef INSTALLPPUFILES -override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(INSTALLPPUFILES)) -ifdef PPUFILES -INSTALLPPULINKFILES:=$(shell $(PPUFILES) -S -O $(INSTALLPPUFILES)) -else -INSTALLPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(LIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))) -endif -override INSTALLPPULINKFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(INSTALLPPULINKFILES)) -endif - -ifdef INSTALLEXEFILES -override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(INSTALLEXEFILES)) -endif - -fpc_showinstall: $(SHOWINSTALLTARGET) -ifdef INSTALLEXEFILES - @$(ECHO) -e $(addprefix "\n"$(BININSTALLDIR)/,$(INSTALLEXEFILES)) -endif -ifdef INSTALLPPUFILES - @$(ECHO) -e $(addprefix "\n"$(UNITINSTALLDIR)/,$(INSTALLPPUFILES)) -ifneq ($(INSTALLPPULINKFILES),) - @$(ECHO) -e $(addprefix "\n"$(UNITINSTALLDIR)/,$(INSTALLPPULINKFILES)) -endif -ifneq ($(wildcard $(LIBFULLNAME)),) - @$(ECHO) $(LIBINSTALLDIR)/$(LIBFULLNAME) -ifdef HASSHAREDLIB - @$(ECHO) $(LIBINSTALLDIR)/$(LIBNAME) -endif -endif -endif -ifdef EXTRAINSTALLFILES - @$(ECHO) -e $(addprefix "\n"$(DATAINSTALLDIR)/,$(EXTRAINSTALLFILES)) -endif - -fpc_install: $(INSTALLTARGET) -# Create UnitInstallFiles -ifdef INSTALLEXEFILES - $(MKDIR) $(BININSTALLDIR) -# Compress the exes if upx is defined -ifdef UPXPROG - -$(UPXPROG) $(INSTALLEXEFILES) -endif - $(INSTALLEXE) $(INSTALLEXEFILES) $(BININSTALLDIR) -endif -ifdef INSTALLPPUFILES - $(MKDIR) $(UNITINSTALLDIR) - $(INSTALL) $(INSTALLPPUFILES) $(UNITINSTALLDIR) -ifneq ($(INSTALLPPULINKFILES),) - $(INSTALL) $(INSTALLPPULINKFILES) $(UNITINSTALLDIR) -endif -ifneq ($(wildcard $(LIBFULLNAME)),) - $(MKDIR) $(LIBINSTALLDIR) - $(INSTALL) $(LIBFULLNAME) $(LIBINSTALLDIR) -ifdef inUnix - ln -sf $(LIBFULLNAME) $(LIBINSTALLDIR)/$(LIBNAME) -endif -endif -endif -ifdef EXTRAINSTALLFILES - $(MKDIR) $(DATAINSTALLDIR) - $(INSTALL) $(EXTRAINSTALLFILES) $(DATAINSTALLDIR) -endif - -##################################################################### -# SourceInstall rules -##################################################################### - -.PHONY: fpc_sourceinstall - -ifndef SOURCETOPDIR -SOURCETOPDIR=$(BASEDIR) -endif - -fpc_sourceinstall: clean - $(MKDIR) $(SOURCEINSTALLDIR) - $(COPYTREE) $(SOURCETOPDIR) $(SOURCEINSTALLDIR) - -##################################################################### -# exampleinstall rules -##################################################################### - -.PHONY: fpc_exampleinstall - -fpc_exampleinstall: $(addsuffix _clean,$(EXAMPLEDIROBJECTS)) -ifdef EXAMPLESOURCEFILES - $(MKDIR) $(EXAMPLEINSTALLDIR) - $(COPY) $(EXAMPLESOURCEFILES) $(EXAMPLEINSTALLDIR) -endif -ifdef EXAMPLEDIROBJECTS -ifndef EXAMPLESOURCEFILES - $(MKDIR) $(EXAMPLEINSTALLDIR) -endif - $(COPYTREE) $(addsuffix /*,$(EXAMPLEDIROBJECTS)) $(EXAMPLEINSTALLDIR) -endif - -##################################################################### -# Zip -##################################################################### - -.PHONY: fpc_zipinstall - -# Create suffix to add -ifndef PACKAGESUFFIX -PACKAGESUFFIX=$(OS_TARGET) -ifeq ($(OS_TARGET),go32v2) -PACKAGESUFFIX=go32 -endif -ifeq ($(OS_TARGET),win32) -PACKAGESUFFIX=w32 -endif -ifeq ($(OS_TARGET),os2) -PACKAGESUFFIX=emx -endif -endif - -# Temporary path to pack a file -ifndef PACKDIR -ifndef inUnix -PACKDIR=$(BASEDIR)/pack_tmp -else -PACKDIR=/tmp/fpc-pack -endif -endif - -# Maybe create default zipname from packagename -ifndef ZIPNAME -ifdef PACKAGENAME -ZIPNAME=$(PACKAGEPREFIX)$(PACKAGENAME)$(PACKAGESUFFIX) -endif -endif - -# Use tar by default under linux -ifndef USEZIP -ifdef inUnix -USETAR=1 -endif -endif - -# Use a wrapper script by default for OS/2 -ifdef inOS2 -USEZIPWRAPPER=1 -endif - -# Create commands to create the zip/tar file -ZIPWRAPPER=$(DESTZIPDIR)/fpczip$(BATCHEXT) -ZIPCMD_CDPACK:=cd $(subst /,$(PATHSEP),$(PACKDIR)) -ZIPCMD_CDBASE:=cd $(subst /,$(PATHSEP),$(BASEDIR)) -ifdef USETAR -ZIPDESTFILE:=$(DESTZIPDIR)/$(ZIPNAME)$(TAREXT) -ZIPCMD_ZIP:=$(TARPROG) cf$(TAROPT) $(ZIPDESTFILE) * -else -ZIPDESTFILE:=$(DESTZIPDIR)/$(ZIPNAME)$(ZIPEXT) -ZIPCMD_ZIP:=$(subst /,$(PATHSEP),$(ZIPPROG)) -Dr $(ZIPOPT) $(ZIPDESTFILE) * -endif - -fpc_zipinstall: -ifndef ZIPNAME - @$(ECHO) "Please specify ZIPNAME!" - @exit 1 -else - $(MAKE) $(ZIPTARGET) PREFIXINSTALLDIR=$(PACKDIR) - $(DEL) $(ZIPDESTFILE) -ifdef USEZIPWRAPPER -ifneq ($(ECHO),echo) - $(ECHO) "$(ZIPCMD_CDPACK)" > $(ZIPWRAPPER) - $(ECHO) "$(ZIPCMD_ZIP)" >> $(ZIPWRAPPER) - $(ECHO) "$(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) -endif - -.PHONY: fpc_zipsourceinstall - -fpc_zipsourceinstall: - $(MAKE) fpc_zipinstall ZIPTARGET=sourceinstall PACKAGESUFFIX=src - -.PHONY: fpc_zipexampleinstall - -fpc_zipexampleinstall: - $(MAKE) fpc_zipinstall ZIPTARGET=exampleinstall PACKAGESUFFIX=exm - -##################################################################### -# Clean rules -##################################################################### - -.PHONY: fpc_clean fpc_cleanall fpc_distclean - -ifdef EXEFILES -override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES)) -endif - -ifdef EXTRACLEANUNITS -override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(EXTRACLEANUNITS)) -endif - -ifdef CLEANPPUFILES -override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES)) -# Get the .o and .a files created for the units -ifdef PPUFILES -CLEANPPULINKFILES:=$(shell $(PPUFILES) $(CLEANPPUFILES)) -else -CLEANPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(LIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))) -endif -override CLEANPPULINKFILES:=$(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 EXTRACLEANFILES - -$(DEL) $(EXTRACLEANFILES) -endif -ifdef LIBNAME - -$(DEL) $(LIBNAME) $(LIBFULLNAME) -endif - -$(DEL) $(FPCMADE) $(PPAS) link.res $(FPCEXTFILE) $(REDIRFILE) - -fpc_distclean: fpc_clean - -# Also run clean first if targetdir is set. Unittargetdir is always -# set if targetdir or unittargetdir is specified -ifdef 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) - -##################################################################### -# Info rules -##################################################################### - -.PHONY: fpc_info fpc_cfginfo fpc_objectinfo fpc_toolsinfo fpc_installinfo \ - fpc_dirinfo - -fpc_info: $(INFOTARGET) - -fpc_infocfg: - @$(ECHO) - @$(ECHO) == Configuration info == - @$(ECHO) - @$(ECHO) FPC....... $(FPC) - @$(ECHO) Version... $(FPC_VERSION) - @$(ECHO) CPU....... $(CPU_TARGET) - @$(ECHO) Source.... $(OS_SOURCE) - @$(ECHO) Target.... $(OS_TARGET) - @$(ECHO) - -fpc_infoobjects: - @$(ECHO) - @$(ECHO) == Object info == - @$(ECHO) - @$(ECHO) LoaderObjects..... $(LOADEROBJECTS) - @$(ECHO) UnitObjects....... $(UNITOBJECTS) - @$(ECHO) ExeObjects........ $(EXEOBJECTS) - @$(ECHO) - @$(ECHO) ExtraCleanUnits... $(EXTRACLEANUNITS) - @$(ECHO) ExtraCleanFiles... $(EXTRACLEANFILES) - @$(ECHO) - @$(ECHO) ExtraInstallUnits. $(EXTRAINSTALLUNITS) - @$(ECHO) ExtraInstallFiles. $(EXTRAINSTALLFILES) - @$(ECHO) - -fpc_infoinstall: - @$(ECHO) - @$(ECHO) == Install info == - @$(ECHO) -ifdef DATE - @$(ECHO) DateStr.............. $(DATESTR) -endif -ifdef PACKAGEPREFIX - @$(ECHO) PackagePrefix........ $(PACKAGEPREFIX) -endif -ifdef PACKAGENAME - @$(ECHO) PackageName.......... $(PACKAGENAME) -endif - @$(ECHO) PackageSuffix........ $(PACKAGESUFFIX) - @$(ECHO) - @$(ECHO) BaseInstallDir....... $(BASEINSTALLDIR) - @$(ECHO) BinInstallDir........ $(BININSTALLDIR) - @$(ECHO) LibInstallDir........ $(LIBINSTALLDIR) - @$(ECHO) UnitInstallDir....... $(UNITINSTALLDIR) - @$(ECHO) SourceInstallDir..... $(SOURCEINSTALLDIR) - @$(ECHO) DocInstallDir........ $(DOCINSTALLDIR) - @$(ECHO) DataInstallDir....... $(DATAINSTALLDIR) - @$(ECHO) - @$(ECHO) DestZipDir........... $(DESTZIPDIR) - @$(ECHO) ZipName.............. $(ZIPNAME) - @$(ECHO) - -##################################################################### -# Local Makefile -##################################################################### - -ifneq ($(wildcard fpcmake.loc),) -include fpcmake.loc -endif - diff --git a/gui/db/Makefile.fpc b/gui/db/Makefile.fpc deleted file mode 100644 index 144acce4..00000000 --- a/gui/db/Makefile.fpc +++ /dev/null @@ -1,20 +0,0 @@ -# -# Makefile.fpc for fpGUI database support -# - -[targets] -units=fpgui_db - -[require] -options=-S2h -packages=fcl fpgfx fpgui - -#[libs] -#libname=fpgui - -[install] -subdir= - -[dirs] -fpcdir=../../../.. -unitdir=.. diff --git a/gui/db/fpgui_db.pas b/gui/db/fpgui_db.pas deleted file mode 100644 index 0f4f03f9..00000000 --- a/gui/db/fpgui_db.pas +++ /dev/null @@ -1,299 +0,0 @@ -{ - fpGUI - Free Pascal GUI Library - - Database support classes - - Copyright (C) 2000 - 2007 See the file AUTHORS.txt, included in this - distribution, for details of the copyright. - - See the file COPYING.modifiedLGPL, included in this distribution, - for details about redistributing fpGUI. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -} - -unit fpGUI_DB; - -{$IFDEF Debug} - {$ASSERTIONS On} -{$ENDIF} - -interface - -uses - Classes - ,fpGUI - ,DB - ; - -type - - { TFieldDataLink } - - TFieldDataLink = class(TDataLink) - private - FWidget: TFWidget; - FField: TField; - FFieldName: string; - FOnDataChange: TNotifyEvent; - function GetCanModify: Boolean; - procedure SetFieldName(const AFieldName: string); - procedure UpdateField; - protected - procedure ActiveChanged; override; - procedure RecordChanged(AField: TField); override; - public - constructor Create(AWidget: TFWidget); - property CanModify: Boolean read GetCanModify; - property Field: TField read FField; - property FieldName: string read FFieldName write SetFieldName; - property Widget: TFWidget read FWidget write FWidget; - property OnDataChange: TNotifyEvent read FOnDataChange write FOnDataChange; - end; - - - { TDBText } - - TDBText = class(TFCustomLabel) - private - FDataLink: TFieldDataLink; - function GetDataField: String; - function GetField: TField; - procedure SetDataField(const ADataField: String); - function GetDataSource: TDataSource; - procedure SetDataSource(ADataSource: TDataSource); - procedure DataChange(Sender: TObject); - public - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - property Field: TField read GetField; - published - property Alignment default taLeftJustify; - property CanExpandWidth; - property DataField: string read GetDataField write SetDataField; - property DataSource: TDataSource read GetDataSource write SetDataSource; - property Enabled; - property FontColor; - property Text; - end; - - - { TDBEdit } - - TDBEdit = class(TFCustomEdit) - private - FDataLink: TFieldDataLink; - function GetDataField: string; - function GetDataSource: TDataSource; - function GetField: TField; - function GetReadOnly: Boolean; - procedure SetDataField(const ADataField: string); - procedure SetDataSource(const ADataSource: TDataSource); - procedure DataChange(Sender: TObject); - procedure SetReadOnly(const AValue: Boolean); - protected - procedure EvKeyPressed(Key: Word; Shift: TShiftState); override; - procedure EvKeyChar(KeyChar: Char); override; - public - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - property Field: TField read GetField; - published - property BorderStyle; - property CanExpandWidth; - property DataField: string read GetDataField write SetDataField; - property DataSource: TDataSource read GetDataSource write SetDataSource; - property Enabled; - property FontColor; - property Text; - property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False; - end; - - -implementation - - -{ TFieldDataLink } - -constructor TFieldDataLink.Create(AWidget: TFWidget); -begin - inherited Create; - FWidget := AWidget; -end; - -procedure TFieldDataLink.ActiveChanged; -begin - UpdateField; -end; - -procedure TFieldDataLink.RecordChanged(AField: TField); -begin - if Assigned(OnDataChange) then - OnDataChange(Self); -end; - -procedure TFieldDataLink.SetFieldName(const AFieldName: string); -begin - if AFieldName <> FieldName then - begin - FFieldName := AFieldName; - UpdateField; - end; -end; - -function TFieldDataLink.GetCanModify: Boolean; -begin - Result := not ReadOnly and (Field <> nil) and Field.CanModify; -end; - -procedure TFieldDataLink.UpdateField; -begin - {$IFDEF DEBUG} WriteLn('## UpdateField. DataSet: ', DataSource.DataSet.ClassName); {$ENDIF} - FField := DataSource.DataSet.FindField(FieldName); - if Assigned(OnDataChange) then - OnDataChange(Self); -end; - - -{ TDBText } - -constructor TDBText.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - FDataLink := TFieldDataLink.Create(Self); - FDataLink.OnDataChange := @DataChange; -end; - -destructor TDBText.Destroy; -begin - FDataLink.Free; - inherited Destroy; -end; - -function TDBText.GetDataField: String; -begin - Result := FDataLink.FieldName; -end; - -function TDBText.GetField: TField; -begin - Result := FDataLink.Field; -end; - -procedure TDBText.SetDataField(const ADataField: String); -begin - FDataLink.FieldName := ADataField; -end; - -function TDBText.GetDataSource: TDataSource; -begin - Result := FDataLink.DataSource; -end; - -procedure TDBText.SetDataSource(ADataSource: TDataSource); -begin - FDataLink.DataSource := ADataSource; -end; - -procedure TDBText.DataChange(Sender: TObject); -begin - {$IFDEF DEBUG} Write(Classname + '.DataChange'); {$ENDIF} - if Assigned(FDataLink.Field) then - begin - Text := FDataLink.Field.DisplayText; - {$IFDEF DEBUG} WriteLn(' new text: "', Text, '"'); {$ENDIF} - end - else - begin - Text := ''; - {$IFDEF DEBUG} WriteLn('DataLink has no data'); {$ENDIF} - end; -end; - - -{ TDBEdit } - -function TDBEdit.GetDataField: string; -begin - Result := FDataLink.FieldName; -end; - -function TDBEdit.GetDataSource: TDataSource; -begin - Result := FDataLink.DataSource; -end; - -function TDBEdit.GetField: TField; -begin - Result := FDataLink.Field; -end; - -function TDBEdit.GetReadOnly: Boolean; -begin - Result := inherited ReadOnly; -// Result := FDataLink.ReadOnly; { will add this in later } -end; - -procedure TDBEdit.SetDataField(const ADataField: string); -begin - FDataLink.FieldName := ADataField; -end; - -procedure TDBEdit.SetDataSource(const ADataSource: TDataSource); -begin - FDataLink.DataSource := ADataSource; -end; - -procedure TDBEdit.DataChange(Sender: TObject); -begin - {$IFDEF DEBUG} Write(Classname + '.DataChange'); {$ENDIF} - if Assigned(FDataLink.Field) then - begin - Text := FDataLink.Field.DisplayText; - {$IFDEF DEBUG} WriteLn(' new text: "', Text, '"'); {$ENDIF} - end - else - begin - Text := ''; - {$IFDEF DEBUG} WriteLn('DataLink has no data'); {$ENDIF} - end; -end; - -procedure TDBEdit.SetReadOnly(const AValue: Boolean); -begin - inherited ReadOnly := AValue; -// FDataLink.ReadOnly := AValue; { will add this in later } -end; - -procedure TDBEdit.EvKeyPressed(Key: Word; Shift: TShiftState); -begin -// if ReadOnly then -// Exit; //==> - inherited EvKeyPressed(Key, Shift); -end; - -procedure TDBEdit.EvKeyChar(KeyChar: Char); -begin - if ReadOnly then - Exit; //==> - inherited EvKeyChar(KeyChar); -end; - -constructor TDBEdit.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - inherited ReadOnly := True; - FDataLink := TFieldDataLink.Create(Self); - FDataLink.OnDataChange := @DataChange; -end; - -destructor TDBEdit.Destroy; -begin - FDataLink.Free; - inherited Destroy; -end; - -end. - diff --git a/gui/defimpl/defstyle.inc b/gui/defimpl/defstyle.inc deleted file mode 100644 index 26dd6512..00000000 --- a/gui/defimpl/defstyle.inc +++ /dev/null @@ -1,60 +0,0 @@ -{ - fpGUI - Free Pascal GUI Library - - Basic Style class declarations - - Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this - distribution, for details of the copyright. - - See the file COPYING.modifiedLGPL, included in this distribution, - for details about redistributing fpGUI. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -} - -{$IFNDEF Has_DefaultStyle_GetGUIColor} - -function TBasicStyle.GetGUIColor(Color: TColor): TGfxColor; -begin - case Color of - // UI element colors - clScrollBar: Result := GetUIColor(clSilver); - clMenu: Result := GetUIColor(clSilver); - clWindow: Result := GetUIColor(clWhite); - clMenuText: Result := GetUIColor(clBlack); - clWindowText: Result := GetUIColor(clBlack); - clAppWorkSpace: Result := GetUIColor(clGray); - clHighlight: Result := GetUIColor(clNavy); - clHighlightText: Result := GetUIColor(clWhite); - cl3DFace: Result := GetUIColor(clSilver); - cl3DShadow: Result := GetUIColor(clGray); - clGrayText: Result := GetUIColor(clGray); - clBtnText: Result := GetUIColor(clBlack); - cl3DHighlight: Result := GetUIColor(clWhite); - cl3DDkShadow: Result := GetUIColor(clBlack); - cl3DLight: Result := rgbaDkWhite; - clInfoText: Result := GetUIColor(clBlack); - clInfoBk: Result := GetUIColor(clLightYellow); - - else Result := GetUIColor(clWhite); - end; -end; - -{$ENDIF} - - -{$IFNDEF Has_DefaultStyle_DrawFocusRect} - -procedure TBasicStyle.DrawFocusRect(Canvas: TFCanvas; const ARect: TRect); -begin - Canvas.SetColor(GetUIColor(cl3DDkShadow)); - Canvas.SetLineStyle(lsDot); - Canvas.DrawRect(ARect); - Canvas.SetLineStyle(lsSolid); -end; - -{$ENDIF} - - diff --git a/gui/fpgui.pas b/gui/fpgui.pas deleted file mode 100644 index 0a39bf42..00000000 --- a/gui/fpgui.pas +++ /dev/null @@ -1,363 +0,0 @@ -{ - fpGUI - Free Pascal GUI Library - - fpGUI master file - - Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this - distribution, for details of the copyright. - - See the file COPYING.modifiedLGPL, included in this distribution, - for details about redistributing fpGUI. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. - - Description: - It is fully object-oriented; its main goal is to provide its services - independent of any operating system or graphics environment. All painting - is done using fpGFX, while fpGUI provides a comfortable widget set and - other high-level classes. -} - - -unit fpGUI; - -{.$DEFINE LAYOUTTRACES} -{.$DEFINE TRACEEVENTS} - -{$IFDEF Debug} - {$ASSERTIONS On} -{$ENDIF} - -{$IFDEF FPC} - {$mode objfpc}{$h+} -{$ENDIF} - -interface - -uses -{$IFDEF mswindows} - // used for system theme color detection - Windows, GFX_GDI, // This must be removed!!! -{$ENDIF} - SysUtils - ,Classes - ,GFXBase - ,fpGFX -// ,Types - ; - - -const - - InfiniteSize = 16383; - -// Insert loads of named colors -{$I fpguicolors.inc} - - -resourcestring - mbText_Yes = 'Yes'; - mbText_No = 'No'; - mbText_Ok = 'Ok'; - mbText_Cancel = 'Cancel'; - mbText_Apply = 'Apply'; - mbText_Abort = 'Abort'; - mbText_Retry = 'Retry'; - mbText_Ignore = 'Ignore'; - mbText_All = 'All'; - mbText_NoToAll = 'No to all'; - mbText_YesToAll = 'Yes to all'; - mbText_Help = 'Help'; - - -type - TFWidget = class; - TEventObj = class; - TFCustomForm = class; - - - TFWidgetState = set of ( - wsEnabled, - wsIsVisible, - wsSizeIsForced, - wsHasFocus, - wsMouseInside, - wsClicked - ); - - - TOrientation = (Horizontal, Vertical); - - - // The following flags are used for styles - - TFButtonFlags = set of (btnIsEmbedded, btnIsDefault, btnIsPressed, - btnIsSelected, btnHasFocus, btnHasParentColor); - - TFCheckboxFlags = set of (cbIsPressed, cbHasFocus, cbIsEnabled, cbIsChecked); - - - // Other stuff - - TMsgDlgBtn = (mbYes, mbNo, mbOK, mbCancel, mbApply, mbAbort, mbRetry, - mbIgnore, mbAll, mbNoToAll, mbYesToAll, mbHelp); - TMsgDlgButtons = set of TMsgDlgBtn; - - - // Panel & Frame types - - TBevelStyle = (bsPlain, bsLowered, bsRaised); - - TBevelShape = (bsNoFrame, bsBox, bsFrame, bsBottomLine, bsLeftLine, - bsRightLine, bsTopLine); - - - -{ This lets us use a single include file for both the Interface and - Implementation sections. } -{$define read_interface} -{$undef read_implementation} - - -{$I fpguistyle.inc} -{$I fpguiwidget.inc} -{$I fpguicontainer.inc} -{$I fpguibin.inc} -{$I fpguilayouts.inc} -{$I fpguiform.inc} -{$I fpguipopupwindow.inc} -{$I fpguilabel.inc} -{$I fpguiedit.inc} -{$I fpguibuttons.inc} -{$I fpguiscrollbar.inc} -{$I fpguiscrollbox.inc} -{$I fpguicheckbox.inc} -{$I fpguiradiobutton.inc} -{$I fpguiseparator.inc} -{$I fpguigroupbox.inc} -{$I fpguilistbox.inc} -{$I fpguicombobox.inc} -{$I fpguigrid.inc} -{$I fpguidialogs.inc} -{$I fpguipanel.inc} -{$I fpguimenus.inc} -{$I fpguiprogressbar.inc} -{$I fpguimemo.inc} - - -function ClipMinMax(val, min, max: Integer): Integer; - -{ This will change at a later date! } -procedure LoadForm(AForm: TComponent); -procedure SaveForm(AForm: TComponent); -procedure ShowMessage(const AMessage: string); - - -implementation -uses - Math - ,StyleManager - ,fpUTF8Utils - ; - - -resourcestring - sListIndexError = 'List index exceeds bounds (%d)'; - - -{$IFDEF TraceEvents} -var - EventNestingLevel: Integer; -{$ENDIF} - - -function ClipMinMax(val, min, max: Integer): Integer; -begin - if val < min then - Result := min - else if val > max then - begin - Result := max; - if Result < min then - Result := min; - end else - Result := val; -end; - -procedure LoadForm(AForm: TComponent); -type - PForm = ^TFCustomForm; -var - lForm: PForm; - Filename: string; - TextStream, BinStream: TStream; -begin - Filename := LowerCase(Copy(AForm.ClassName, 2, 255)) + '.frm'; - TextStream := TFileStream.Create(Filename, fmOpenRead); - BinStream := TMemoryStream.Create; - ObjectTextToBinary(TextStream, BinStream); - TextStream.Free; - - lForm := @AForm; - BinStream.Position := 0; - BinStream.ReadComponent(lForm^); - BinStream.Free; -end; - -// graeme: still work in progress (2007-04-25) -procedure SaveForm(AForm: TComponent); -var - f, f2: TStream; - Filename: string; - TextStream, BinStream: TStream; -begin - Filename := LowerCase(Copy(AForm.ClassName, 2, 255)) + '.frm'; -// Filename := 'test.frm'; - BinStream := TMemoryStream.Create; - TextStream := TFileStream.Create(Filename, fmCreate); - BinStream.WriteComponent(AForm); - BinStream.Position := 0; - ObjectBinaryToText(BinStream, TextStream); - - TextStream.Free; - BinStream.Free; -end; - -// graeme: still work in progress (2007-05-01) -procedure ShowMessage(const AMessage: string); -var - frm: TFStandardDialog; -begin - frm := TFStandardDialog.Create(GFApplication); - try - frm.Text := 'ShowMessage'; - frm.Buttons := [mbOk]; -// frm.Buttons := [mbYes, mbNo, mbCancel, mbHelp]; - frm.Message := AMessage; - frm.ShowModal; - finally -// frm.Free; - end -end; - - -{$IFDEF LAYOUTTRACES} -procedure LAYOUTTRACE(const Position: String; const args: array of const); -{$IFDEF TraceEvents} -var - i: Integer; -{$ENDIF} -begin - {$IFDEF TraceEvents} - for i := 1 to EventNestingLevel do - Write(' '); - {$ENDIF} - WriteLn(Format(Position, args)); -end; -{$ELSE} -procedure LAYOUTTRACE(const Position: String; const args: array of const); -begin -end; -{$ENDIF} - -function InflateRect(var Rect: TRect; dx: Integer; dy: Integer): Boolean; -begin - if Assigned(@Rect) then - begin - with Rect do - begin - dec(Left, dx); - dec(Top, dy); - inc(Right, dx); - inc(Bottom, dy); - end; - Result := True; - end - else - Result := False; -end; - -function OffsetRect(var Rect : TRect;DX : Integer;DY : Integer) : Boolean; -begin - if assigned(@Rect) then - begin - with Rect do - begin - inc(Left,dx); - inc(Top,dy); - inc(Right,dx); - inc(Bottom,dy); - end; - OffsetRect := True; - end - else - OffsetRect := False; -end; - -function CenterPoint(const Rect: TRect): TPoint; -begin - with Rect do - begin - Result.X := (Left+Right) div 2; - Result.Y := (Top+Bottom) div 2; - end; -end; - -{ This lets us use a single include file for both the Interface and - Implementation sections. } -{$undef read_interface} -{$define read_implementation} - - -{$I fpguistyle.inc} -{$I fpguiwidget.inc} -{$I fpguicontainer.inc} -{$I fpguibin.inc} -{$I fpguilayouts.inc} -{$I fpguiform.inc} -{$I fpguipopupwindow.inc} -{$I fpguilabel.inc} -{$I fpguiedit.inc} -{$I fpguibuttons.inc} -{$I fpguiscrollbar.inc} -{$I fpguiscrollbox.inc} -{$I fpguicheckbox.inc} -{$I fpguiradiobutton.inc} -{$I fpguiseparator.inc} -{$I fpguigroupbox.inc} -{$I fpguilistbox.inc} -{$I fpguicombobox.inc} -{$I fpguigrid.inc} -{$I fpguidialogs.inc} -{$I fpguipanel.inc} -{$I fpguimenus.inc} -{$I fpguiprogressbar.inc} -{$I fpguimemo.inc} - - -const - Orientations: array[TOrientation] of TIdentMapEntry = ( - (Value: Ord(Horizontal); Name: 'Horizontal'), - (Value: Ord(Vertical); Name: 'Vertical') - ); - - -function IdentToOrientation(const Ident: String; var Orientation: LongInt): Boolean; -begin - Result := IdentToInt(Ident, Orientation, Orientations); -end; - -function OrientationToIdent(Orientation: LongInt; var Ident: String): Boolean; -begin - Result := IntToIdent(Orientation, Ident, Orientations); -end; - - -initialization - RegisterIntegerConsts(TypeInfo(TOrientation), - @IdentToOrientation, @OrientationToIdent); - -end. - diff --git a/gui/fpgui.rst b/gui/fpgui.rst deleted file mode 100644 index ad20464a..00000000 --- a/gui/fpgui.rst +++ /dev/null @@ -1,60 +0,0 @@ - -# hash value = 24515 -fpgui.mbtext_yes='Yes' - - -# hash value = 1359 -fpgui.mbtext_no='No' - - -# hash value = 1371 -fpgui.mbtext_ok='Ok' - - -# hash value = 77089212 -fpgui.mbtext_cancel='Cancel' - - -# hash value = 4749113 -fpgui.mbtext_apply='Apply' - - -# hash value = 4691604 -fpgui.mbtext_abort='Abort' - - -# hash value = 5819289 -fpgui.mbtext_retry='Retry' - - -# hash value = 83777157 -fpgui.mbtext_ignore='Ignore' - - -# hash value = 18476 -fpgui.mbtext_all='All' - - -# hash value = 129053500 -fpgui.mbtext_notoall='No to all' - - -# hash value = 129277052 -fpgui.mbtext_yestoall='Yes to all' - - -# hash value = 322608 -fpgui.mbtext_help='Help' - - -# hash value = 162403993 -fpgui.slistindexerror='List index exceeds bounds (%d)' - - -# hash value = 100314660 -fpgui.slayoutwidgetnotfound='Layout child widget not found' - - -# hash value = 165560901 -fpgui.sgridindexoutofrange='Grid index out of range' - diff --git a/gui/fpguibin.inc b/gui/fpguibin.inc deleted file mode 100644 index 529b7534..00000000 --- a/gui/fpguibin.inc +++ /dev/null @@ -1,111 +0,0 @@ -{ - fpGUI - Free Pascal GUI Library - - Bin widget declarations - - Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this - distribution, for details of the copyright. - - See the file COPYING.modifiedLGPL, included in this distribution, - for details about redistributing fpGUI. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -} - -{%mainunit fpgui.pas} - -{$IFDEF read_interface} - - { Bin widget declarations } - TFBinWidget = class(TFContainerWidget) - protected - FChild: TFWidget; - procedure SetChild(AChild: TFWidget); - function GetChildCount: Integer; override; - function GetChild(Index: Integer): TFWidget; override; - procedure CalcSizes; override; - public // !!!: temporarily - property Child: TFWidget read FChild write SetChild; - // really public :) - function ContainsChild(AChild: TFWidget): Boolean; override; - procedure InsertChild(AChild: TFWidget); override; - procedure RemoveChild(AChild: TFWidget); override; - end; - -{$ENDIF read_interface} - - - -{$IFDEF read_implementation} - - - -// =================================================================== -// TFBinWidget -// =================================================================== - -function TFBinWidget.ContainsChild(AChild: TFWidget): Boolean; -begin - Result := Assigned(AChild) and (FChild = AChild); -end; - - -procedure TFBinWidget.InsertChild(AChild: TFWidget); -begin - if FChild <> AChild then - begin - if Assigned(FChild) then - FChild.Parent := nil; - FChild := AChild; - FChild.Parent := Self; - end; -end; - - -procedure TFBinWidget.RemoveChild(AChild: TFWidget); -begin - if FChild = AChild then - begin - FChild := nil; - AChild.Parent := nil; - end; -end; - - -function TFBinWidget.GetChildCount: Integer; -begin - Result := Ord(Assigned(Child)); -end; - - -function TFBinWidget.GetChild(Index: Integer): TFWidget; -begin - if (Index = 0) and Assigned(Child) then - Result := Child - else - TList.Error(SListIndexError, Index); -end; - - -procedure TFBinWidget.CalcSizes; -begin - LAYOUTTRACE('TBinWidget.CalcSizes for %s:%s', [Name, ClassName]); - if Assigned(Child) then - begin - FMinSize := Child.MinSize; - FMaxSize := Child.MaxSize; - FDefSize := Child.DefSize; - end; -end; - - -procedure TFBinWidget.SetChild(AChild: TFWidget); -begin - InsertChild(AChild); -end; - - -{$ENDIF read_implementation} - diff --git a/gui/fpguibuttons.inc b/gui/fpguibuttons.inc deleted file mode 100644 index f8281491..00000000 --- a/gui/fpguibuttons.inc +++ /dev/null @@ -1,155 +0,0 @@ -{ - fpGUI - Free Pascal GUI Library - - Button class declarations - - Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this - distribution, for details of the copyright. - - See the file COPYING.modifiedLGPL, included in this distribution, - for details about redistributing fpGUI. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -} - -{%mainunit fpgui.pas} - - -{$IFDEF read_interface} - - TFGenericButton = class(TFWidget) - protected - FEmbedded: Boolean; - procedure Paint(Canvas: TFCanvas); override; - public - constructor Create(AOwner: TComponent); override; - property Embedded: Boolean read FEmbedded write FEmbedded default False; - end; - - - TFCustomButton = class(TFGenericButton) - protected - procedure Paint(Canvas: TFCanvas); override; - procedure CalcSizes; override; - public - constructor Create(const pText: string; pOwner: TComponent); overload; - end; - - - TFButton = class(TFCustomButton) - published - property CanExpandWidth; - property CanExpandHeight; - property Enabled; - property Text; - property OnClick; - end; - -{ - TCustomImageButton = class(TFGenericButton) - protected - procedure Paint(Canvas: TGfxCanvas); override; - procedure EvRecalcLayout; override; - end; - - TImageButton = class(TCustomImageButton) - published - property Enabled; - property Image; - property OnClick; - end; -} - -{$ENDIF read_interface} - - - -{$IFDEF read_implementation} - -// =================================================================== -// TFGenericButton -// =================================================================== - -constructor TFGenericButton.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - WidgetStyle := WidgetStyle + [wsCaptureMouse, wsClickable, wsOpaque]; - // default size - FDefSize := Size(18, 18); -end; - - -procedure TFGenericButton.Paint(Canvas: TFCanvas); -var - Flags: TFButtonFlags; -begin - if Embedded then - Flags := [btnIsEmbedded] - else - Flags := []; - if (wsClicked in WidgetState) and (wsMouseInside in WidgetState) then - Include(Flags, btnIsPressed); - if (wsHasFocus in WidgetState) and not Embedded then - begin - Include(Flags, btnIsSelected); - if FindForm.IsActive then - Include(Flags, btnHasFocus); - end; - - Style.DrawButtonFace(Canvas, Rect(0, 0, BoundsSize.cx, BoundsSize.cy), Flags); -end; - -// =================================================================== -// TFCustomButton -// =================================================================== - -procedure TFCustomButton.Paint(Canvas: TFCanvas); -var - Pt: TPoint; - Borders: TRect; -begin - inherited Paint(Canvas); - - Borders := Style.GetButtonBorders; - // setup the clip rectangle - Canvas.IntersectClipRect(Rect(Borders.Left, Borders.Top, - BoundsSize.cx - Borders.Right, BoundsSize.cy - Borders.Bottom)); - - Canvas.SetColor(Style.GetUIColor(clBtnText)); - Pt.x := (BoundsSize.cx - Canvas.TextWidth(Text)) div 2; - Pt.y := (BoundsSize.cy - Canvas.FontCellHeight) div 2; - if (wsClicked in WidgetState) and (wsMouseInside in WidgetState) then - Pt := Pt + Point(1, 1); - Style.DrawText(Canvas, Pt, Text, WidgetState); -end; - - -procedure TFCustomButton.CalcSizes; -var - Borders: TRect; -begin - LAYOUTTRACE('TFCustomButton.CalcSizes for %s:%s', [Name, ClassName]); - Borders := Style.GetButtonBorders; - with FindForm.Wnd.Canvas do - begin - FMinSize.cx := Borders.Left + Borders.Right + TextWidth(Text); - if FMinSize.cx < 75 then - FMinSize.cx := 75; // apply default button width - FMinSize.cy := Borders.Top + Borders.Bottom + FontCellHeight; - end; - FDefSize := FMinSize + gfxbase.Size(20, 2); -end; - -constructor TFCustomButton.Create(const pText: string; pOwner: TComponent); -begin - Create(pOwner); - // default size - FDefSize := Size(75, 25); - Text := pText; -end; - - -{$ENDIF read_implementation} - diff --git a/gui/fpguicheckbox.inc b/gui/fpguicheckbox.inc deleted file mode 100644 index 7bfd40c9..00000000 --- a/gui/fpguicheckbox.inc +++ /dev/null @@ -1,127 +0,0 @@ -{ - fpGUI - Free Pascal GUI Library - - Checkbox class declarations - - Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this - distribution, for details of the copyright. - - See the file COPYING.modifiedLGPL, included in this distribution, - for details about redistributing fpGUI. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -} - -{%mainunit fpgui.pas} - -{$IFDEF read_interface} - - { TFCustomCheckbox } - - TFCustomCheckbox = class(TFWidget) - private - procedure SetChecked(AChecked: Boolean); - protected - FChecked: Boolean; - FLabelPos: TPoint; - procedure Click; override; - procedure Paint(Canvas: TFCanvas); override; - procedure CalcSizes; override; - property Checked: Boolean read FChecked write SetChecked; - public - constructor Create(AOwner: TComponent); override; - constructor Create(const pText: string; pOwner: TComponent); overload; - end; - - - TFCheckbox = class(TFCustomCheckbox) - published - property Enabled; - property CanExpandHeight; - property CanExpandWidth; - property Checked; - property Text; - property OnClick; - end; - -{$ENDIF read_interface} - - - -{$IFDEF read_implementation} - -// =================================================================== -// TFCustomCheckbox -// =================================================================== - -constructor TFCustomCheckbox.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - WidgetStyle := WidgetStyle + [wsCaptureMouse, wsClickable, wsOpaque]; -end; - - -constructor TFCustomCheckbox.Create(const pText: string; pOwner: TComponent); -begin - Create(pOwner); - Text := pText; -end; - - -procedure TFCustomCheckbox.Click; -begin - FChecked := not FChecked; - inherited Click; -end; - - -procedure TFCustomCheckbox.Paint(Canvas: TFCanvas); -var - FontHeight: Integer; - LabelRect: TRect; - Flags: TFCheckboxFlags; -begin - FontHeight := Canvas.FontCellHeight; - LabelRect.Left := FLabelPos.x; - LabelRect.Top := FLabelPos.y + (Height - MinSize.cy) div 2; - LabelRect.Right := LabelRect.Left + Canvas.TextWidth(Text); - LabelRect.Bottom := LabelRect.Top + FontHeight; - - Flags := []; - if (wsClicked in WidgetState) and (wsMouseInside in WidgetState) then - Include(Flags, cbIsPressed); - if (wsHasFocus in WidgetState) and FindForm.IsActive then - Include(Flags, cbHasFocus); - if wsEnabled in WidgetState then - Include(Flags, cbIsEnabled); - if Checked then - Include(Flags, cbIsChecked); - - Style.DrawCheckbox(Canvas, Rect(0, 0, Width, Height), LabelRect, Flags); - Canvas.SetColor(Style.GetUIColor(clWindowText)); - Style.DrawText(Canvas, LabelRect.TopLeft, Text, WidgetState); -end; - - -procedure TFCustomCheckbox.CalcSizes; -begin - with FindForm.Wnd.Canvas do - Style.GetCheckboxLayout(gfxbase.Size(TextWidth(Text), FontCellHeight), - FMinSize, FLabelPos); -end; - - -procedure TFCustomCheckbox.SetChecked(AChecked: Boolean); -begin - if AChecked <> Checked then - begin - FChecked := AChecked; - Redraw; - end; -end; - - -{$ENDIF read_implementation} - diff --git a/gui/fpguicolors.inc b/gui/fpguicolors.inc deleted file mode 100644 index 98785467..00000000 --- a/gui/fpguicolors.inc +++ /dev/null @@ -1,229 +0,0 @@ - -{%mainunit fpgui.pp} - - - { NOTE: - The colors commented out below are not applicable to systems other than - Windows. For this reason I don't see the need to define them. Under Linux, - the Windows Manager theme will draw those parts anyway and we have no - control over that or the colors used. } - - // UI element colors - clScrollBar = TColor($80000000); -// clBackground = TColor($80000001); -// clActiveCaption = TColor($80000002); -// clInactiveCaption = TColor($80000003); - clMenu = TColor($80000004); - clWindow = TColor($80000005); -// clWindowFrame = TColor($80000006); - clMenuText = TColor($80000007); - clWindowText = TColor($80000008); -// clCaptionText = TColor($80000009); -// clActiveBorder = TColor($8000000a); -// clInactiveBorder = TColor($8000000b); - clAppWorkSpace = TColor($8000000c); - clHighlight = TColor($8000000d); - clHighlightText = TColor($8000000e); - cl3DFace = TColor($8000000f); - cl3DShadow = TColor($80000010); - clGrayText = TColor($80000011); - clBtnText = TColor($80000012); -// clInactiveCaptionText = TColor($80000013); - cl3DHighlight = TColor($80000014); - cl3DDkShadow = TColor($80000015); - cl3DLight = TColor($80000016); - clInfoText = TColor($80000017); - clInfoBk = TColor($80000018); - - // The following colors match the predefined Delphi Colors - clBlack = TColor($000000); - clMaroon = TColor($000080); - clGreen = TColor($008000); - clOlive = TColor($008080); - clNavy = TColor($800000); - clPurple = TColor($800080); - clTeal = TColor($808000); - clGray = TColor($808080); - clSilver = TColor($C0C0C0); - clRed = TColor($0000FF); - clLime = TColor($00FF00); - clYellow = TColor($00FFFF); - clBlue = TColor($FF0000); - clFuchsia = TColor($FF00FF); - clAqua = TColor($FFFF00); - clLtGray = TColor($C0C0C0); - clDkGray = TColor($808080); - clWhite = TColor($FFFFFF); - clCream = TColor($F0FBFF); - clMoneyGreen = TColor($C0DCC0); - clSkyBlue = TColor($F0CAA6); -// clNone = TColor($1FFFFFFF); -// clDefault = TColor($20000000); - - // alias color names - clBtnFace = cl3DFace; - clBtnShadow = cl3DShadow; - clBtnHighlight = cl3DHighlight; - clCyan = clAqua; - clMagenta = clFuchsia; - - // web/html named colors - De-facto NS & MSIE recognized HTML color names - clAliceBlue = TColor($FFF8F0); - clAntiqueWhite = TColor($D7EBFA); -// clAqua = TColor($FFFF00); - clAquamarine = TColor($D4FF7F); - clAzure = TColor($FFFFF0); - clBeige = TColor($DCF5F5); - clBisque = TColor($C4E4FF); -// clBlack = TColor($000000); - clBlanchedAlmond = TColor($CDEBFF); -// clBlue #0000ff - clBlueViolet = TColor($E22B8A); - clBrown = TColor($2A2AA5); - clBurlyWood = TColor($87B8DE); - clCadetBlue = TColor($A09E5F); - clChartreuse = TColor($00FF7F); - clChocolate = TColor($1E69D2); - - - clMedGray = TColor($A4A0A0); - clForestGreen = TColor($228B22); - clRoyalBlue = TColor($E16941); - clLightYellow = TColor($E0FFFF); - clCornsilk = TColor($DCF8FF); - clMidnightBlue = TColor($701919); - clDarkWhite = TColor($E0E0E0); - -{ -# De-facto NS & MSIE recognized HTML color names -Coral #ff7f50 -CornflowerBlue #6495ed -Cornsilk #fff8dc -Crimson #dc143c -Cyan #00ffff -DarkBlue #00008b -DarkCyan #008b8b -DarkGoldenrod #b8860b -DarkGray #a9a9a9 -DarkGreen #006400 -DarkKhaki #bdb76b -DarkMagenta #8b008b -DarkOliveGreen #556b2f -DarkOrange #ff8c00 -DarkOrchid #9932cc -DarkRed #8b0000 -DarkSalmon #e9967a -DarkSeaGreen #8fbc8f -DarkSlateBlue #483d8b -DarkSlateGray #2f4f4f -DarkTurquoise #00ced1 -DarkViolet #9400d3 -DeepPink #ff1493 -DeepSkyBlue #00bfff -DimGray #696969 -DodgerBlue #1e90ff -FireBrick #b22222 -FloralWhite #fffaf0 -ForestGreen #228b22 -Fuchsia #ff00ff -Gainsboro #dcdcdc -GhostWhite #f8f8ff -Gold #ffd700 -Goldenrod #daa520 -Gray #808080 -Green #008000 -GreenYellow #adff2f -Honeydew #f0fff0 -HotPink #ff69b4 -IndianRed #cd5c5c -Indigo #4b0082 -Ivory #fffff0 -Khaki #f0e68c -Lavender #e6e6fa -LavenderBlush #fff0f5 -LawnGreen #7cfc00 -} - clLemonChiffon = TColor($CDFAFF); // #fffacd -{ -LightBlue #add8e6 -LightCoral #f08080 -LightCyan #e0ffff -LightGoldenrodYellow #fafad2 -LightGreen #90ee90 -} - clLightGrey = TColor($D3D3D3); // #d3d3d3 -{ -LightPink #ffb6c1 -LightSalmon #ffa07a -LightSeaGreen #20b2aa -LightSkyBlue #87cefa -LightSlateGray #778899 -LightSteelBlue #b0c4de -LightYellow #ffffe0 -Lime #00ff00 -LimeGreen #32cd32 -Linen #faf0e6 -Magenta #ff00ff -Maroon #800000 -MediumAquamarine #66cdaa -MediumBlue #0000cd -MediumOrchid #ba55d3 -MediumPurple #9370db -MediumSeaGreen #3cb371 -MediumSlateBlue #7b68ee -MediumSpringGreen #00fa9a -MediumTurquoise #48d1cc -MediumVioletRed #c71585 -MidnightBlue #191970 -MintCream #f5fffa -MistyRose #ffe4e1 -Moccasin #ffe4b5 -NavajoWhite #ffdead -Navy #000080 -OldLace #fdf5e6 -Olive #808000 -OliveDrab #6b8e23 -Orange #ffa500 -OrangeRed #ff4500 -Orchid #da70d6 -PaleGoldenrod #eee8aa -PaleGreen #98fb98 -PaleTurquoise #afeeee -PaleVioletRed #db7093 -PapayaWhip #ffefd5 -PeachPuff #ffdab9 -Peru #cd853f -Pink #ffc0cb -Plum #dda0dd -PowderBlue #b0e0e6 -Purple #800080 -Red #ff0000 -RosyBrown #bc8f8f -RoyalBlue #4169e1 -SaddleBrown #8b4513 -Salmon #fa8072 -SandyBrown #f4a460 -SeaGreen #2e8b57 -Seashell #fff5ee -Sienna #a0522d -Silver #c0c0c0 -SkyBlue #87ceeb -SlateBlue #6a5acd -SlateGray #708090 -Snow #fffafa -SpringGreen #00ff7f -SteelBlue #4682b4 -Tan #d2b48c -Teal #008080 -Thistle #d8bfd8 -Tomato #ff6347 -Turquoise #40e0d0 -Violet #ee82ee -Wheat #f5deb3 -White #ffffff -WhiteSmoke #f5f5f5 -Yellow #ffff00 -YellowGreen #9acd32 -} - - diff --git a/gui/fpguicombobox.inc b/gui/fpguicombobox.inc deleted file mode 100644 index 371113aa..00000000 --- a/gui/fpguicombobox.inc +++ /dev/null @@ -1,288 +0,0 @@ -{ - fpGUI - Free Pascal GUI Library - - ComboBox class declarations - - Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this - distribution, for details of the copyright. - - See the file COPYING.modifiedLGPL, included in this distribution, - for details about redistributing fpGUI. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -} - -{%mainunit fpgui.pas} - -{$IFDEF read_interface} - - { Combobox widget declarations } - - TFComboBoxPopup = class(TFPopupWindow) - private - FLayout: TFBoxLayout; - FListBox: TFListBox; - public - constructor Create(AOwner: TComponent); override; - property ListBox: TFListBox read FListBox; - end; - - - TFCustomComboBox = class(TFWidget) - private - FItemIndex: Integer; - FItems: TStrings; - FOnChange: TNotifyEvent; - procedure ComboBoxButtonClick(Sender: TObject); - procedure DropDownDeactivate(Sender: TObject); - procedure DropDownDestroy(Sender: TObject); - procedure SetItemIndex(const AValue: Integer); - protected - ComboBoxButton: TFGenericButton; - FDropDown: TFComboBoxPopup; - lbl: TFLabel; - procedure Click; override; - procedure Paint(Canvas: TFCanvas); override; - procedure CalcSizes; override; - procedure Resized; override; - function DistributeEvent(Event: TEventObj): Boolean; override; - property CanExpandWidth default True; -// property DropDownCount: integer read FDropDownCount write FDropDownCount; - property ItemIndex: Integer read FItemIndex write SetItemIndex default -1; - property OnChange: TNotifyEvent read FOnChange write FOnChange; - public - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - property Items: TStrings read FItems write FItems; - end; - - - TFComboBox = class(TFCustomComboBox) - published - property CanExpandWidth; - property CanExpandHeight; - property Enabled; - property Text; - property ItemIndex; - property OnChange; - end; - -{$ENDIF read_interface} - - - -{$IFDEF read_implementation} - - -{ Combobox widget implementation } - -type - TFArrowButton = class(TFGenericButton) - protected - procedure Paint(Canvas: TFCanvas); override; - procedure CalcSizes; override; - end; - - -procedure TFArrowButton.Paint(Canvas: TFCanvas); -begin - inherited Paint(Canvas); - Style.DrawComboBoxArrow(Canvas, Rect(0, 0, Width, Height), - (wsClicked in WidgetState) and (wsMouseInside in WidgetState), - wsEnabled in WidgetState); -end; - -procedure TFArrowButton.CalcSizes; -begin - FMinSize := Style.GetComboBoxBtnSize; -end; - -constructor TFComboBoxPopup.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - WidgetStyle := WidgetStyle + [wsCaptureMouse, wsClickable, wsOpaque]; - BorderWidth := 1; - Color := clBlack; - Name := '_ComboBoxPopup'; - - FLayout := TFBoxLayout.Create(self); - FLayout.Name := '_VBoxLayout'; - FLayout.Orientation := Vertical; - FLayout.Spacing := 0; - InsertChild(FLayout); - - FListBox := TFListBox.Create(self); - FListBox.Name := '_Listbox'; - FListBox.HotTrack := True; - FLayout.InsertChild(FListBox); -end; - - -// ------------------------------------------------------------------- -// TCustomComboBox -// ------------------------------------------------------------------- - -constructor TFCustomComboBox.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - FCanExpandWidth := True; - WidgetStyle := WidgetStyle + [wsCaptureMouse, wsClickable, wsOpaque]; - FItems := TStringList.Create; - FItemIndex := -1; - - ComboBoxButton := TFArrowButton.Create(Self); - ComboBoxButton.Name := '_ComboBoxButton'; - ComboBoxButton.Embedded := True; - ComboBoxButton.CanExpandWidth := False; - ComboBoxButton.CanExpandHeight := False; - ComboBoxButton.OnClick := @ComboBoxButtonClick; - ComboBoxButton.SetEmbeddedParent(Self); -end; - -destructor TFCustomComboBox.Destroy; -begin - FDropDown.Free; - inherited Destroy; -end; - -procedure TFCustomComboBox.Paint(Canvas: TFCanvas); -var - Pt: TPoint; - ItemRect: TRect; - ItemFlags: TItemFlags; - c: TFCanvas; - r: TRect; -begin - ItemFlags := []; - Style.DrawEditBox(Canvas, Rect(0, 0, Width, Height)); - - if Text <> '' then - begin - Style.SetUIColor(Canvas, clWindowText); - Pt.x := 4; - Pt.y := (BoundsSize.cy - Canvas.FontCellHeight) div 2; - - if (wsHasFocus in WidgetState) and FindForm.IsActive then - begin - Include(ItemFlags, ifFocused); - Include(ItemFlags, ifSelected); - end; - - ItemRect := Rect(0, 0, (Width - ComboBoxButton.Width), Height); -// InflateRect(ItemRect, -1, -1); - ItemRect.TopLeft := ItemRect.TopLeft + 1; - ItemRect.BottomRight := ItemRect.BottomRight - 2; - - { Text must be clipped before reaching the button } -// try -// Canvas.SaveState; -// writeln(Format('Canvas size Before %d:%d', [Canvas.Width, Canvas.Height])); -// r := Canvas.Transform(ComboBoxButton.BoundsRect); -// writeln(Format(' Bounding rectangle (%d:%d)x(%d:%d)', [BoundsRect.Top, BoundsRect.Left, BoundsRect.Bottom, BoundsRect.Right])); -// writeln(Format(' Canvas rectangle (%d:%d)x(%d:%d)', [Canvas.GetClipRect.Top, Canvas.GetClipRect.Left, Canvas.GetClipRect.Bottom, Canvas.GetClipRect.Right])); -// writeln(Format(' ComboButton rectangle (%d:%d)x(%d:%d)', [r.Top, r.Left, r.Bottom, r.Right])); -// Canvas.IntersectClipRect(r); -// writeln(Format('Canvas size After %d:%d', [Canvas.Width, Canvas.Height])); - - Style.DrawItemBefore(Canvas, ItemRect, ItemFlags); - Style.DrawText(Canvas, Pt, Text, WidgetState); - Style.DrawItemAfter(Canvas, ItemRect, ItemFlags); -// finally -// Canvas.RestoreState; -// end; - end - else - begin - if (wsHasFocus in WidgetState) and FindForm.IsActive then - Style.DrawFocusRect(Canvas, Rect(0, 0, Width, Height)); - end; -end; - -procedure TFCustomComboBox.CalcSizes; -begin - with Style.GetEditBoxBorders do - FMinSize := Size(ComboBoxButton.MinSize.cx, - Max(FindForm.Wnd.Canvas.FontCellHeight, ComboBoxButton.MinSize.cy)) + - TopLeft + BottomRight; -end; - -procedure TFCustomComboBox.Resized; -begin - with Style.GetEditBoxBorders do - ComboBoxButton.SetBounds( - Point(Width - Right - ComboBoxButton.MinSize.cx, Top), - ComboBoxButton.MinSize); -end; - -function TFCustomComboBox.DistributeEvent(Event: TEventObj): Boolean; -begin - Result := Event.SendToChild(ComboBoxButton); -// or inherited DistributeEvent(Event); -end; - -procedure TFCustomComboBox.ComboBoxButtonClick(Sender: TObject); -begin - if Assigned(FDropDown) and FDropDown.Visible then - begin - FDropDown.Close; - Exit; //==> - end; - - if not Assigned(FDropDown) then - begin - FDropDown := TFComboBoxPopup.Create(Self); - FDropDown.OnDestroy := @DropDownDestroy; - FDropDown.ListBox.Items.Text := FItems.Text; - FDropDown.ListBox.FItemIndex := FItemIndex; - FDropDown.ListBox.OnClick := @DropDownDeactivate; - end; - - FDropDown.SetPosition(ClientToScreen(Point(0, Height))); - FDropDown.Show; - FDropDown.Wnd.SetMinMaxClientSize(MaxSize, MaxSize); -end; - -procedure TFCustomComboBox.DropDownDeactivate(Sender: TObject); -begin - LAYOUTTRACE('TCustomComboBox.DropDownDestroy for %s:%s', [Name, ClassName]); - ItemIndex := FDropDown.ListBox.ItemIndex; - FDropDown.Close; - SetFocus; -end; - -procedure TFCustomComboBox.DropDownDestroy(Sender: TObject); -begin - LAYOUTTRACE('TCustomComboBox.DropDownDestroy for %s:%s', [Name, ClassName]); - FDropDown := nil; -end; - -procedure TFCustomComboBox.SetItemIndex(const AValue: Integer); -begin - if FItemIndex <> AValue then - begin - if AValue < FItems.Count then - FItemIndex := AValue; - if FItemIndex = -1 then - Text := '' - else - Text := FItems[FItemIndex]; - - // fire event - if Assigned(OnChange) then - OnChange(Self); - end; -end; - -{ This event causes the combobox to drop open when you click anywhere in the - component, or press the spacebar key. } -procedure TFCustomComboBox.Click; -begin - ComboBoxButtonClick(nil); - inherited Click; -end; - - -{$ENDIF read_implementation} - diff --git a/gui/fpguicontainer.inc b/gui/fpguicontainer.inc deleted file mode 100644 index dbe87d25..00000000 --- a/gui/fpguicontainer.inc +++ /dev/null @@ -1,88 +0,0 @@ -{ - fpGUI - Free Pascal GUI Library - - Container class declarations - - Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this - distribution, for details of the copyright. - - See the file COPYING.modifiedLGPL, included in this distribution, - for details about redistributing fpGUI. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -} - -{%mainunit fpgui.pas} - -{$IFDEF read_interface} - - { Container widget declarations } - - TFContainerWidget = class(TFWidget) - protected - function DistributeEvent(Event: TEventObj): Boolean; override; - function GetChildCount: Integer; virtual; abstract; - function GetChild(Index: Integer): TFWidget; virtual; abstract; - property ChildCount: Integer read GetChildCount; - property Children[Index: Integer]: TFWidget read GetChild; - // Move to public in decendant classes, if you want them visible - procedure InsertChild(AChild: TFWidget); dynamic; virtual; - procedure RemoveChild(AChild: TFWidget); dynamic; virtual; - public - function GetChildAt(APoint: TPoint): TFWidget; - function ContainsChild(AChild: TFWidget): Boolean; dynamic; abstract; - end; - -{$ENDIF read_interface} - - - -{$IFDEF read_implementation} - -// =================================================================== -// TContainerWidget -// =================================================================== - -function TFContainerWidget.GetChildAt(APoint: TPoint): TFWidget; -var - i: Integer; -begin - for i := 0 to ChildCount - 1 do - begin - Result := Children[i]; - if PtInRect(Result.BoundsRect, APoint) then - exit; - end; - Result := nil; -end; - -function TFContainerWidget.DistributeEvent(Event: TEventObj): Boolean; -var - i: Integer; -begin - // Propagate the event to all children - for i := 0 to ChildCount - 1 do - if Event.SendToChild(Children[i]) then - begin - Result := True; - exit; - end; - // The event hasn't been processed by any child: - Result := inherited DistributeEvent(Event); -end; - -procedure TFContainerWidget.InsertChild(AChild: TFWidget); -begin - // do nothing -end; - -procedure TFContainerWidget.RemoveChild(AChild: TFWidget); -begin - // do nothing -end; - - -{$ENDIF read_implementation} - diff --git a/gui/fpguidialogs.inc b/gui/fpguidialogs.inc deleted file mode 100644 index 97932917..00000000 --- a/gui/fpguidialogs.inc +++ /dev/null @@ -1,199 +0,0 @@ -{ - fpGUI - Free Pascal GUI Library - - Dialogs class declarations - - Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this - distribution, for details of the copyright. - - See the file COPYING.modifiedLGPL, included in this distribution, - for details about redistributing fpGUI. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -} - -{%mainunit fpgui.pas} - - -{$IFDEF read_interface} - - { TFCustomStandardDialog } - - TFCustomStandardDialog = class(TFCustomForm) - private - function GetMessage: string; - procedure SetMessage(const AValue: string); - procedure StdBtnClicked(Sender: TObject); - protected - FButtons: TMsgDlgButtons; - MainLayout, BtnLayout: TFBoxLayout; - Separator: TSeparator; - FMessage: TFLabel; - function ProcessEvent(Event: TEventObj): Boolean; override; - function DistributeEvent(Event: TEventObj): Boolean; override; - procedure CalcSizes; override; - procedure Resized; override; - procedure SetButtons(AButtons: TMsgDlgButtons); - property Buttons: TMsgDlgButtons read FButtons write SetButtons default [mbOk, mbCancel]; - public - constructor Create(AOwner: TComponent); override; - property Message: string read GetMessage write SetMessage; - end; - - - TFStandardDialog = class(TFCustomStandardDialog) - published - property Text; - property OnCreate; - property Buttons; - end; - - - -{$ENDIF read_interface} - - - -{$IFDEF read_implementation} - - - -// =================================================================== -// TFCustomStandardDialog -// =================================================================== - -// public methods - -constructor TFCustomStandardDialog.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - FButtons := [mbOk, mbCancel]; - FBorderWidth := 4; - - MainLayout := TFBoxLayout.Create(Self); - MainLayout.Orientation := Vertical; - Child := MainLayout; - - FMessage := TFLabel.Create(self); - FMessage.CanExpandWidth := True; - MainLayout.InsertChild(FMessage); - - Separator := TSeparator.Create(Self); - MainLayout.InsertChild(Separator); - - BtnLayout := TFBoxLayout.Create(Self); - BtnLayout.Orientation := Horizontal; - BtnLayout.HorzAlign := horzRight; - BtnLayout.VertAlign := vertCenter; - BtnLayout.CanExpandHeight := False; - MainLayout.InsertChild(BtnLayout); - - SetButtons(FButtons); -end; - - -// protected methods - -function TFCustomStandardDialog.ProcessEvent(Event: TEventObj): Boolean; -begin - Result := MainLayout.ProcessEvent(Event) or inherited ProcessEvent(Event); -end; - -function TFCustomStandardDialog.DistributeEvent(Event: TEventObj): Boolean; -begin - Result := Event.SendToChild(MainLayout) or inherited DistributeEvent(Event); -end; - -procedure TFCustomStandardDialog.CalcSizes; -begin - if Assigned(Child) then - begin - FMinSize := Child.MinSize + 2 * BorderWidth; - FDefSize := Child.DefSize + 2 * BorderWidth; - FMaxSize.cx := Min(InfiniteSize, Child.MaxSize.cx + 2 * BorderWidth); - FMaxSize.cy := Min(InfiniteSize, Child.MaxSize.cy + 2 * BorderWidth); - end; - - FMinSize.cx := Max(MinSize.cx, MainLayout.MinSize.cx + 2 * BorderWidth); - Inc(FMinSize.cy, MainLayout.DefSize.cy + BorderWidth); - FDefSize.cx := Max(DefSize.cx, MainLayout.DefSize.cx + 2 * BorderWidth); - FDefSize.cy := Min(InfiniteSize, DefSize.cy); - FMaxSize.cx := Min(MaxSize.cx, MainLayout.MaxSize.cx + 2 * BorderWidth); - FMaxSize.cy := Min(InfiniteSize, MaxSize.cy + MainLayout.DefSize.cy); -end; - -procedure TFCustomStandardDialog.Resized; -begin - if Assigned(Child) then - Child.SetBounds(Point(BorderWidth, BorderWidth), - Size(Width - 2 * BorderWidth, - Height - MainLayout.DefSize.cy - 2 * BorderWidth)); - MainLayout.SetBounds( - Point(BorderWidth, Height - MainLayout.DefSize.cy - BorderWidth), - Size(Width - 2 * BorderWidth, MainLayout.DefSize.cy - BorderWidth)); -end; - -procedure TFCustomStandardDialog.SetButtons(AButtons: TMsgDlgButtons); - - function AddBtn(const AText: String; ADefault: Boolean): TFButton; - begin - Result := TFButton.Create(Self); - Result.Text := AText; - // Result.Default := ADefault; - Result.OnClick := @StdBtnClicked; - Result.Parent := BtnLayout; - end; - -var - i: integer; - b: TFButton; -begin - // remove and free all previous buttons - for i := ComponentCount - 1 downto 0 do - begin - if Components[i] is TFButton then - begin - b := TFButton(Components[i]); - if BtnLayout.ContainsChild(b) then - BtnLayout.RemoveChild(b); - b.Free; - end; - end; - - FButtons := AButtons; - - if mbYes in FButtons then AddBtn(mbText_Yes, False); - if mbNo in FButtons then AddBtn(mbText_No, False); - if mbOk in FButtons then AddBtn(mbText_OK, True); - if mbCancel in FButtons then AddBtn(mbText_Cancel, False); - if mbApply in FButtons then AddBtn(mbText_Apply, False); - if mbAbort in FButtons then AddBtn(mbText_Abort, False); - if mbRetry in FButtons then AddBtn(mbText_Retry, False); - if mbIgnore in FButtons then AddBtn(mbText_Ignore, False); - if mbAll in FButtons then AddBtn(mbText_All, False); - if mbNoToAll in FButtons then AddBtn(mbText_NoToAll, False); - if mbYesToAll in FButtons then AddBtn(mbText_YesToAll, False); - if mbHelp in FButtons then AddBtn(mbText_Help, False); -end; - -function TFCustomStandardDialog.GetMessage: string; -begin - Result := FMessage.Text; -end; - -procedure TFCustomStandardDialog.SetMessage(const AValue: string); -begin - if FMessage.Text <> AValue then - FMessage.Text := AValue; -end; - -procedure TFCustomStandardDialog.StdBtnClicked(Sender: TObject); -begin - Close; -end; - - -{$ENDIF read_implementation} - diff --git a/gui/fpguiedit.inc b/gui/fpguiedit.inc deleted file mode 100644 index 34e822cc..00000000 --- a/gui/fpguiedit.inc +++ /dev/null @@ -1,430 +0,0 @@ -{ - fpGUI - Free Pascal GUI Library - - Edit class declarations - - Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this - distribution, for details of the copyright. - - See the file COPYING.modifiedLGPL, included in this distribution, - for details about redistributing fpGUI. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -} - -{%mainunit fpgui.pas} - -{$IFDEF read_interface} - - - { TFCustomEdit } - TBorderStyle = (bsNone, bsSingle); - - TFCustomEdit = class(TFWidget) - private - FFontColor: TColor; - FReadOnly: Boolean; - FSelStart: integer; - FSelOffset: integer; - FDrawOffset: integer; - FCursorPos: Integer; - FPasswordChar: Char; - FOnChange: TNotifyEvent; - FBorderStyle: TBorderStyle; - procedure SetFontColor(const AValue: TColor); - procedure SetPasswordChar(APasswordChar: Char); - procedure SetCursorPos(ACursorPos: Integer); - procedure SetBorderStyle(ABorderStyle: TBorderStyle); - procedure DoMousePressed(pEvent: TMousePressedEventObj); - procedure SetReadOnly(const AValue: Boolean); - procedure AdjustCursor; - function GetDrawText: string; - protected - procedure Paint(Canvas: TFCanvas); override; - function ProcessEvent(Event: TEventObj): Boolean; override; - procedure CalcSizes; override; - procedure EvKeyPressed(Key: Word; Shift: TShiftState); override; - procedure EvKeyChar(KeyChar: Char); override; - procedure EvTextChanged; override; - property CanExpandWidth default True; - property Cursor default crIBeam; - property PasswordChar: Char read FPasswordChar write SetPasswordChar default #0; - property CursorPos: Integer read FCursorPos write SetCursorPos; - property OnChange: TNotifyEvent read FOnChange write FOnChange; - property FontColor: TColor read FFontColor write SetFontColor; - property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle; - property ReadOnly: Boolean read FReadOnly write SetReadOnly default False; - procedure SetText(const AText: String); override; - public - constructor Create(AOwner: TComponent); override; - constructor Create(const pText: string; pOwner: TComponent); overload; - end; - - - TFEdit = class(TFCustomEdit) - published - property CanExpandWidth; - property Enabled; - property PasswordChar; - property Text; - property OnChange; - property FontColor; - property BorderStyle; - end; - -{$ENDIF read_interface} - - - -{$IFDEF read_implementation} - -// =================================================================== -// TFCustomEdit -// =================================================================== - -constructor TFCustomEdit.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - WidgetStyle := WidgetStyle + [wsCaptureMouse, wsClickable, wsOpaque]; - FCanExpandWidth := True; - FCursor := crIBeam; - FFontColor := clWindowText; - FCursorPos := 0; - FDrawOffset := 0; - FBorderStyle := bsSingle; - FReadOnly := False; -end; - -constructor TFCustomEdit.Create(const pText: string; pOwner: TComponent); -begin - Create(pOwner); - Text := pText; -end; - -procedure TFCustomEdit.SetBorderStyle(ABorderStyle: TBorderStyle); -begin - if FBorderStyle <> ABorderStyle then - begin - FBorderStyle := ABorderStyle; - Redraw; - end; -end; - -procedure TFCustomEdit.Paint(Canvas: TFCanvas); -var - Borders: TRect; - s: string; - c: TGfxColor; - ItemRect: TRect; - tw: integer; - lSideMargins: integer; -begin - Borders := Style.GetEditBoxBorders; - lSideMargins := Borders.Left + Borders.Right; - - ItemRect := Rect(0, 0, BoundsSize.cx, BoundsSize.cy); - case FBorderStyle of - bsNone: - begin - c := Canvas.GetColor; - Style.SetUIColor(Canvas, clWindow); - Style.DrawWindowBackground(Canvas, ItemRect); - Canvas.SetColor(c); - end; - bsSingle: - Style.DrawEditBox(Canvas, ItemRect, ReadOnly); - end; - - // setup the clip rectangle - if not Canvas.IntersectClipRect(Rect(Borders.Left + 1, Borders.Top + 1, - BoundsSize.cx - Borders.Right - 1, BoundsSize.cy - Borders.Bottom - 1)) then - exit; - - // setup the correct font color - if wsEnabled in WidgetState then - Canvas.SetColor(Style.GetUIColor(FFontColor)) - else - Canvas.SetColor(Style.GetUIColor(clGrayText)); - - // paint the text - s := GetDrawText; - Canvas.TextOut(Point(-FDrawOffset + Borders.Left+2, 3), s); - - if wsHasFocus in WidgetState then - begin -(* - // drawing selection - if (FSelOffset <> 0) then - begin - if (wsHasFocus in WidgetState) and FindForm.IsActive then - begin - Include(ItemFlags, ifFocused); - Include(ItemFlags, ifSelected); - end; - - ItemRect.Left := Canvas.TextWidth(Copy(s, 1, CursorPos - FSelOffset)); - ItemRect.Top := 0; - ItemRect.Right := Canvas.TextWidth(Copy(s, 1, CursorPos)); - ItemRect.Bottom := Height; - - Style.DrawItemBefore(Canvas, ItemRect, ItemFlags); - Style.DrawText(Canvas, (Borders.TopLeft + Point(1, 1)), s, WidgetState); - Style.DrawItemAfter(Canvas, ItemRect, ItemFlags); - end; -*) - - // drawing cursor - Canvas.SetColor(Style.GetUIColor(clWindowText)); -// Style.SetUIColor(Canvas, clWindowText); - tw := Canvas.TextWidth(UTF8Copy(s, 1, FCursorPos)); - - // 2 pixel cursor line -// ItemRect.Top := Borders.Top; -// ItemRect.Left := -FDrawOffset + lSideMargins + tw; -// ItemRect.Bottom := BoundsSize.cy - Borders.Bottom; -// ItemRect.Right := ItemRect.Left + 2; -// Canvas.FillRect(ItemRect); - - // 1 pixel cursor line - Canvas.DrawLine( - Point(-FDrawOffset + lSideMargins + tw, Borders.Top), - Point(-FDrawOffset + lSideMargins + tw, BoundsSize.cy - Borders.Bottom)); - end; -end; - -function TFCustomEdit.ProcessEvent(Event: TEventObj): Boolean; -begin - if Event.InheritsFrom(TMousePressedEventObj) then - begin - DoMousePressed(TMousePressedEventObj(Event)); - end; - Result := inherited ProcessEvent(Event); -end; - -procedure TFCustomEdit.EvKeyPressed(Key: Word; Shift: TShiftState); -begin - if Shift * [ssShift, ssAlt, ssCtrl, ssMeta, ssSuper, ssHyper, ssAltGr] = [] then - begin - // Normal typing - no selections - case Key of - keyLeft, keyUp: - if CursorPos > 0 then - CursorPos := CursorPos - 1; - keyRight, keyDown: - if CursorPos < UTF8Length(FText) then - CursorPos := CursorPos + 1; - keyHome: - CursorPos := 0; - keyEnd: - CursorPos := UTF8Length(FText); - else - inherited EvKeyPressed(Key, Shift); - end; - end -{ else if Shift * [ssShift, ssAlt, ssCtrl, ssMeta, ssSuper, ssHyper, ssAltGr] = [ssShift] then - begin - Writeln('2'); - case Key of - keyHome: - begin - FSelOffset := CursorPos; - CursorPos := 0; - end; - keyEnd: - begin - FSelOffset := CursorPos; - CursorPos := Length(Text); - end; - else - EvKeyPressed(Key, Shift); - end; - end -} - else - begin - inherited EvKeyPressed(Key, Shift); - end; - AdjustCursor; - Redraw; -end; - - -procedure TFCustomEdit.EvKeyChar(KeyChar: Char); -begin - case KeyChar of - #8: { Backspace } - if FCursorPos > 0 then - begin - FText := UTF8Copy(FText, 1, FCursorPos - 1) + UTF8Copy(FText, FCursorPos + 1, UTF8Length(FText)); - FCursorPos := FCursorPos - 1; - end; - #127: { Del } - if FCursorPos < UTF8Length(FText) then - begin - FText := UTF8Copy(FText, 1, FCursorPos) + UTF8Copy(FText, FCursorPos + 2, UTF8Length(FText)); - Redraw; - end; - #32..#126, #128..#255: - begin - FText := UTF8Copy(FText, 1, FCursorPos) + KeyChar + UTF8Copy(FText, CursorPos + 1, UTF8Length(FText)); - FCursorPos := FCursorPos + 1; - end; - else - inherited EvKeyChar(KeyChar); - end; - AdjustCursor; -end; - -procedure TFCustomEdit.CalcSizes; -var - Borders: TRect; -begin - Borders := Style.GetEditBoxBorders; - FMinSize := Size(50, Borders.Top + Borders.Bottom + - FindForm.Wnd.Canvas.FontCellHeight + 2); -end; - -procedure TFCustomEdit.EvTextChanged; -begin - Redraw; - if Assigned(OnChange) then - OnChange(Self); -end; - -procedure TFCustomEdit.SetText(const AText: String); -begin - inherited SetText(AText); - FSelOffset := 0; - FCursorPos := UTF8Length(FText); - FSelStart := FCursorPos; - FDrawOffset := 0; - AdjustCursor; -end; - -procedure TFCustomEdit.SetPasswordChar(APasswordChar: Char); -begin - if APasswordChar <> PasswordChar then - begin - FPasswordChar := APasswordChar; - Redraw; - end; -end; - -procedure TFCustomEdit.SetFontColor(const AValue: TColor); -begin - if FFontColor = AValue then exit; - FFontColor := AValue; -end; - -procedure TFCustomEdit.SetCursorPos(ACursorPos: Integer); -begin - if ACursorPos <> CursorPos then - begin - FCursorPos := ACursorPos; - Redraw; - end; -end; - -procedure TFCustomEdit.DoMousePressed(pEvent: TMousePressedEventObj); -var - Borders: TRect; - cp: integer; - cpx: integer; - lSideMargin: integer; - n: integer; - cx: integer; - lText: string; -begin - if (pEvent.Button = mbLeft) then - begin - // searching for the appropriate character position - Borders := Style.GetEditBoxBorders; - lSideMargin := Borders.Left + 1; - - // Make sure we work with the correct displayed text - lText := GetDrawText; - - cp := FCursorPos; - cpx := FindForm.Wnd.Canvas.TextWidth(UTF8Copy(lText, 1, FCursorPos)) - FDrawOffset + lSideMargin; - - for n := 0 to UTF8Length(lText) do - begin - cx := FindForm.Wnd.Canvas.TextWidth(UTF8Copy(lText, 1, n)) - FDrawOffset + lSideMargin; - if abs(cx - pEvent.Position.x) < abs(cpx - pEvent.Position.x) then - begin - cpx := cx; - cp := n; - end; - end; - - FCursorPos := cp; - - if (ssShift in pEvent.Shift) then - begin - FSelOffset := FCursorPos - FSelStart; - end - else - begin - FSelStart := cp; - FSelOffset := 0; - end; - end; -end; - -procedure TFCustomEdit.SetReadOnly(const AValue: Boolean); -begin - if FReadOnly <> AValue then - begin - FReadOnly := AValue; - Redraw; - end; -end; - -procedure TFCustomEdit.AdjustCursor; -var - tw: integer; - VisibleWidth: integer; - Canvas: TFCustomCanvas; - lBorders: TRect; - lSideMargins: integer; -begin - // This is not pretty and needs to change, but if these two tests are not - // here it throws a AV when loading forms - if not Assigned(FindForm) then - Exit; //==> - if not Assigned(FindForm.FWnd) then - Exit; //==> - - Canvas := FindForm.Wnd.Canvas; - tw := Canvas.TextWidth(UTF8Copy(GetDrawText, 1, FCursorPos)); - - lBorders := Style.GetEditBoxBorders; - lSideMargins := lBorders.Left + lBorders.Right; - VisibleWidth := (Width - lSideMargins); - - if tw - FDrawOffset > VisibleWidth - 2 then - begin - FDrawOffset := tw - VisibleWidth + 2; - end - else if tw - FDrawOffset < 0 then - begin - FDrawOffset := tw; - if tw <> 0 then - dec(FDrawOffset, 2); - end; -end; - -// Return the correct text to be displayed -function TFCustomEdit.GetDrawText: string; -begin - if FPasswordChar = #0 then - Result := FText - else - begin - Result := StringOfChar(FPasswordChar, UTF8Length(FText)); - end; -end; - -{$ENDIF read_implementation} diff --git a/gui/fpguiform.inc b/gui/fpguiform.inc deleted file mode 100644 index 66d4c18f..00000000 --- a/gui/fpguiform.inc +++ /dev/null @@ -1,587 +0,0 @@ -{ - fpGUI - Free Pascal GUI Library - - Form class declarations - - Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this - distribution, for details of the copyright. - - See the file COPYING.modifiedLGPL, included in this distribution, - for details about redistributing fpGUI. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -} - -{%mainunit fpgui.pas} - -{$IFDEF read_interface} - - { TFCustomForm } - - TFCustomForm = class(TFBinWidget) - private - FFocusedWidget: TFWidget; - FMouseCaptureWidget: TFWidget; - FLastSetCursor: TFCursor; - FWindowOptions: TFWindowOptions; - FWnd: TFCustomWindow; - FOnCreate: TNotifyEvent; - FOnDestroy: TNotifyEvent; - FOnActivate: TNotifyEvent; - FOnDeactivate: TNotifyEvent; - // Property access - function GetWnd: TFCustomWindow; - procedure SetFocusedWidget(AWidget: TFWidget); - procedure SetMouseCaptureWidget(AWidget: TFWidget); - procedure SetWindowOptions(const AValue: TFWindowOptions); - // fpGFX event handling - procedure WndClose(Sender: TObject); - procedure WndFocusIn(Sender: TObject); - procedure WndFocusOut(Sender: TObject); - procedure WndHide(Sender: TObject); - procedure WndKeyPressed(Sender: TObject; AKey: Word; AShift: TShiftState); - procedure WndKeyReleased(Sender: TObject; AKey: Word; AShift: TShiftState); - procedure WndKeyChar(Sender: TObject; AKeyChar: Char); - procedure WndMouseEnter(Sender: TObject; AShift: TShiftState; const AMousePos: TPoint); - procedure WndMouseLeave(Sender: TObject); - procedure WndMouseMoved(Sender: TObject; AShift: TShiftState; const AMousePos: TPoint); - procedure WndMousePressed(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); - procedure WndMouseReleased(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); - procedure WndMouseWheel(Sender: TObject; AShift: TShiftState; AWheelDelta: Single; const AMousePos: TPoint); - procedure WndPaint(Sender: TObject; const ARect: TRect); - procedure WndMove(Sender: TObject); - procedure WndResize(Sender: TObject); - procedure WndShow(Sender: TObject); - protected - FBorderWidth: Integer; - FIsActive: Boolean; - FResizedByUser: Boolean; - FPositionSpecified: Boolean; - procedure Loaded; override; - procedure Paint(Canvas: TFCanvas); override; - procedure Resized; override; - function WidgetCoords(AWidget: TFWidget): TPoint; - function ProcessEvent(Event: TEventObj): Boolean; override; - procedure CalcSizes; override; - procedure EvTextChanged; override; - procedure CreateWnd; - property CanExpandWidth default True; - property CanExpandHeight default True; - property Cursor default crArrow; - property BorderWidth: Integer read FBorderWidth write FBorderWidth; - property OnCreate: TNotifyEvent read FOnCreate write FOnCreate; - property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy; - property OnActivate: TNotifyEvent read FOnActivate write FOnActivate; // Get focus - property OnDeactivate: TNotifyEvent read FOnDeactivate write FOnDeactivate; // Loose focus - public - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - procedure Show; override; - procedure ShowModal; - procedure Close; virtual; - procedure SetPosition(APosition: TPoint); - property FocusedWidget: TFWidget read FFocusedWidget write SetFocusedWidget; - property IsActive: Boolean read FIsActive; - property MouseCaptureWidget: TFWidget read FMouseCaptureWidget write SetMouseCaptureWidget; - property WindowOptions: TFWindowOptions read FWindowOptions write SetWindowOptions; - property Wnd: TFCustomWindow read GetWnd; - end; - - - TFForm = class(TFCustomForm) - published - property BorderWidth; - property Color; - property Enabled; - property Text; - property WindowOptions; - property OnCreate; - property OnDestroy; - property OnActivate; - property OnDeactivate; - end; - -{$ENDIF read_interface} - - - -{$IFDEF read_implementation} - -// =================================================================== -// TFCustomForm -// =================================================================== - -constructor TFCustomForm.Create(AOwner: TComponent); -begin - if not Assigned(FStyle) then - FStyle := gStyleManager.DefaultStyle; - - inherited Create(AOwner); - - FCanExpandWidth := True; - FCanExpandHeight := True; - FCursor := crArrow; - FWindowOptions := [woWindow]; -end; - - -destructor TFCustomForm.Destroy; -begin - if Assigned(OnDestroy) then - OnDestroy(Self); - if Assigned(FWnd) then - FWnd.Free; - -// GFApplication.RemoveWindow(Self); - - inherited Destroy; -end; - - -procedure TFCustomForm.Show; -begin - LAYOUTTRACE('TFCustomForm.Show for %s:%s', [Name, ClassName]); - - FVisible := True; - GFApplication.AddWindow(Wnd); - Wnd.Show; -end; - -procedure TFCustomForm.ShowModal; -begin - Include(WindowOptions, woModal); - Show; -end; - -procedure TFCustomForm.Close; -begin - LAYOUTTRACE('TFCustomForm.Close for %s:%s', [Name, ClassName]); - - FVisible := False; - - FWnd.Free; - FWnd := nil; -end; - - -procedure TFCustomForm.SetPosition(APosition: TPoint); -begin - if Assigned(FWnd) then - Wnd.SetPosition(APosition) - else - begin - FOrigin := APosition; - FPositionSpecified := True; - end; -end; - - -function TFCustomForm.WidgetCoords(AWidget: TFWidget): TPoint; -begin - Result := Point(0, 0); - while AWidget <> Self do - begin - Result := Result + AWidget.Parent.ClientToWidget(AWidget.Origin); - AWidget := AWidget.Parent; - end; -end; - - -procedure TFCustomForm.Loaded; -begin - inherited Loaded; - if Assigned(OnCreate) then - OnCreate(Self); -end; - - -procedure TFCustomForm.Paint(Canvas: TFCanvas); -begin - inherited Paint(Canvas); - Style.DrawWindowBackground(Canvas, Rect(0, 0, Width, Height)); -end; - - -procedure TFCustomForm.CalcSizes; -begin - if Assigned(Child) then - begin - FMinSize := Child.MinSize + 2 * BorderWidth; - FDefSize := Child.DefSize + 2 * BorderWidth; - FMaxSize.cx := Min(InfiniteSize, Child.MaxSize.cx + 2 * BorderWidth); - FMaxSize.cy := Min(InfiniteSize, Child.MaxSize.cy + 2 * BorderWidth); - end; -end; - - -function TFCustomForm.ProcessEvent(Event: TEventObj): Boolean; -begin - if Event is TDestroyEventObj then - FWnd := nil; - - Result := inherited ProcessEvent(Event); -end; - - -procedure TFCustomForm.EvTextChanged; -begin - if Assigned(FWnd) then - Wnd.Title := Text; -end; - - -procedure TFCustomForm.CreateWnd; -var - ParentWnd: TFCustomWindow; -begin - if Parent is TFCustomForm then - ParentWnd := TFCustomForm(Parent).Wnd - else - ParentWnd := nil; - - FWnd := TFWindow.Create(ParentWnd, WindowOptions); - - if FPositionSpecified then - Wnd.SetPosition(Origin); - - Wnd.OnClose := @WndClose; - Wnd.OnFocusIn := @WndFocusIn; - Wnd.OnFocusOut := @WndFocusOut; - Wnd.OnHide := @WndHide; - Wnd.OnKeyPressed := @WndKeyPressed; - Wnd.OnKeyReleased := @WndKeyReleased; - Wnd.OnKeyChar := @WndKeyChar; - Wnd.OnMouseEnter := @WndMouseEnter; - Wnd.OnMouseLeave := @WndMouseLeave; - Wnd.OnMouseMove := @WndMouseMoved; - Wnd.OnMousePressed := @WndMousePressed; - Wnd.OnMouseReleased := @WndMouseReleased; - Wnd.OnMouseWheel := @WndMouseWheel; - Wnd.OnPaint := @WndPaint; - Wnd.OnMove := @WndMove; - Wnd.OnResize := @WndResize; - Wnd.OnShow := @WndShow; - - if Length(Text) = 0 then - Wnd.Title := GFApplication.Title - else - Wnd.Title := Text; -end; - - -{ -procedure TFCustomForm.ApplyNewLayout; -var - OrigW, OrigH: Integer; -begin - Wnd.SetMinMaxClientSize(MinW, MinH, MaxW, MaxH); - - OrigW := ClientRect.Right; - OrigH := ClientRect.Bottom; - - if (ClientRect.Right < MinW) or (ClientRect.Bottom < MinW) or - (ClientRect.Right > MaxW) or (ClientRect.Bottom > MaxH) then - begin - if ClientRect.Right < MinW then - FClientRect.Right := MinW; - if ClientRect.Bottom < MinH then - FClientRect.Bottom := MinH; - if ClientRect.Right > MaxW then - FClientRect.Right := MaxW; - if ClientRect.Bottom > MaxH then - FClientRect.Bottom := MaxH; -// Wnd.SetClientSize(ClientRect.Right, ClientRect.Bottom); - end; - - if not FResizedByUser then - begin - FClientRect.Right := DefW; - FClientRect.Bottom := DefH; - end; - - if (ClientRect.Right <> OrigW) or (ClientRect.Bottom <> OrigH) then - begin - LAYOUTTRACE('TFCustomForm.EvRecalcLayout for %s:%s: Setting size to %dx%d', - [Name, ClassName, ClientRect.Right, ClientRect.Bottom]); - Wnd.SetClientSize(ClientRect.Right, ClientRect.Bottom); - end; -end;} - - -procedure TFCustomForm.Resized; -begin - ClientRect.Right := Wnd.ClientWidth; - ClientRect.Bottom := Wnd.ClientHeight; - if Assigned(Child) then - Child.SetBounds(Point(BorderWidth, BorderWidth), - TSize(ClientRect.BottomRight) - 2 * BorderWidth); -end; - - -procedure TFCustomForm.SetFocusedWidget(AWidget: TFWidget); -begin - if AWidget <> FocusedWidget then - begin - if Assigned(FocusedWidget) then - begin - Exclude(FFocusedWidget.WidgetState, wsHasFocus); - FocusedWidget.EvFocusChanged; - end; - FFocusedWidget := AWidget; - if Assigned(FocusedWidget) then - begin - Include(FFocusedWidget.WidgetState, wsHasFocus); - FocusedWidget.EvFocusChanged; - end; - end; -end; - -function TFCustomForm.GetWnd: TFCustomWindow; -begin - if not Assigned(FWnd) then - begin - CreateWnd; - // !!!: Doesn't handle a set initial size yet - SendEvent(TCalcSizesEventObj.Create(Self)); - Wnd.SetMinMaxClientSize(MinSize, MaxSize); - Wnd.SetClientSize(DefSize); - end; - Result := FWnd; -end; - - -procedure TFCustomForm.SetMouseCaptureWidget(AWidget: TFWidget); -begin - if AWidget <> FMouseCaptureWidget then - begin - FMouseCaptureWidget := AWidget; - if Assigned(AWidget) then - Wnd.CaptureMouse - else - Wnd.ReleaseMouse; - end; -end; - -procedure TFCustomForm.SetWindowOptions(const AValue: TFWindowOptions); -begin - if FWindowOptions=AValue then exit; - FWindowOptions:=AValue; - if Assigned(FWnd) then Wnd.WindowOptions := AValue; -end; - - -// GfxWindow message handlers - -procedure TFCustomForm.WndClose(Sender: TObject); -begin - SendEvent(TDestroyEventObj.Create(Self)); - FMouseCaptureWidget := nil; -end; - -procedure TFCustomForm.WndFocusIn(Sender: TObject); -begin - FIsActive := True; - if Assigned(FocusedWidget) then - FocusedWidget.EvFocusChanged; - if Assigned(OnActivate) then - OnActivate(Self); -end; - -procedure TFCustomForm.WndFocusOut(Sender: TObject); -begin - FIsActive := False; - if Assigned(FocusedWidget) then - FocusedWidget.EvFocusChanged; - if Assigned(OnDeactivate) then - OnDeactivate(Self); -end; - -procedure TFCustomForm.WndHide(Sender: TObject); -begin - LAYOUTTRACE('TFCustomForm.WndHide for %s:%s', [Name, ClassName]); - if wsIsVisible in WidgetState then - begin - Exclude(WidgetState, wsIsVisible); - SendEvent(TVisibilityChangeEventObj.Create(Self)); - Update; - end; -end; - -procedure TFCustomForm.WndKeyPressed(Sender: TObject; - AKey: Word; AShift: TShiftState); -begin - if Assigned(FocusedWidget) then - FocusedWidget.EvKeyPressed(AKey, AShift) - else - EvKeyPressed(AKey, AShift); -end; - -procedure TFCustomForm.WndKeyReleased(Sender: TObject; - AKey: Word; AShift: TShiftState); -begin - if Assigned(FocusedWidget) then - FocusedWidget.EvKeyReleased(AKey, AShift) - else - EvKeyReleased(AKey, AShift); -end; - -procedure TFCustomForm.WndKeyChar(Sender: TObject; AKeyChar: Char); -begin - if Assigned(FocusedWidget) then - FocusedWidget.EvKeyChar(AKeyChar) - else - EvKeyChar(AKeyChar); -end; - -procedure TFCustomForm.WndMouseEnter(Sender: TObject; - AShift: TShiftState; const AMousePos: TPoint); -begin - if wsEnabled in WidgetState then - DoMouseEnter(AShift, AMousePos); -end; - - -procedure TFCustomForm.WndMouseLeave(Sender: TObject); -begin - if wsEnabled in WidgetState then - SendEvent(TMouseLeaveEventObj.Create(Self)); -end; - - -procedure TFCustomForm.WndMouseMoved(Sender: TObject; - AShift: TShiftState; const AMousePos: TPoint); -{var - dx, dy: Integer; - IsInside: Boolean; -begin - if Assigned(MouseCaptureWidget) then - begin - WidgetCoords(MouseCaptureWidget, dx, dy); - - // Emulate MouseEnter/MouseLeave events - IsInside := (x >= dx) and (y >= dy) and - (x < dx + MouseCaptureWidget.Width) and (y < dy + MouseCaptureWidget.Height); - if IsInside and not (wsMouseInside in MouseCaptureWidget.WidgetState) then - MouseCaptureWidget.EvMouseEnter(Shift, x - dy, y - dy) - else if (not IsInside) and (wsMouseInside in MouseCaptureWidget.WidgetState) then - MouseCaptureWidget.EvMouseLeave; - - MouseCaptureWidget.SendEvent( - TMouseMovedEventObj.Create(Self, Shift, x - dx, y - dy)); - end else} - - procedure SendMouseEvents(Widget: TFWidget; APos: TPoint); - var - LeaveCheckEvent: TMouseLeaveCheckEventObj; - begin - LeaveCheckEvent := TMouseLeaveCheckEventObj.Create(Self, AShift, APos); - LeaveCheckEvent.AddRef; - Widget.SendEvent(LeaveCheckEvent); - Widget.SendEvent(TMouseMoveEventObj.Create(Self, AShift, APos)); - if (LeaveCheckEvent.NewCursor <> crDefault) and - (LeaveCheckEvent.NewCursor <> Wnd.Cursor) then - Wnd.Cursor := LeaveCheckEvent.NewCursor; - LeaveCheckEvent.Free; - end; - -begin - if wsEnabled in WidgetState then - begin - if Assigned(MouseCaptureWidget) then - begin - SendMouseEvents(MouseCaptureWidget, - AMousePos - WidgetCoords(MouseCaptureWidget)); - if not Assigned(MouseCaptureWidget) then - SendMouseEvents(Self, AMousePos); - end else - SendMouseEvents(Self, AMousePos); - end; { if } -end; - - -procedure TFCustomForm.WndMousePressed(Sender: TObject; AButton: TMouseButton; - AShift: TShiftState; const AMousePos: TPoint); -begin - if wsEnabled in WidgetState then - begin - if Assigned(MouseCaptureWidget) then - begin - MouseCaptureWidget.SendEvent( - TMousePressedEventObj.Create(Self, AButton, AShift, - AMousePos - WidgetCoords(MouseCaptureWidget))); - if not Assigned(MouseCaptureWidget) then - SendEvent(TMouseMoveEventObj.Create(Self, AShift, AMousePos)); - end - else - SendEvent(TMousePressedEventObj.Create(Self, AButton, AShift, AMousePos)); - end; { if } -end; - - -procedure TFCustomForm.WndMouseReleased(Sender: TObject; AButton: TMouseButton; - AShift: TShiftState; const AMousePos: TPoint); -begin - if wsEnabled in WidgetState then - if Assigned(MouseCaptureWidget) then - begin - MouseCaptureWidget.SendEvent( - TMouseReleasedEventObj.Create(Self, AButton, AShift, - AMousePos - WidgetCoords(MouseCaptureWidget))); - if not Assigned(MouseCaptureWidget) then - SendEvent(TMouseMoveEventObj.Create(Self, AShift, AMousePos)); - end else - SendEvent(TMouseReleasedEventObj.Create(Self, - AButton, AShift, AMousePos)); -end; - - -procedure TFCustomForm.WndMouseWheel(Sender: TObject; AShift: TShiftState; - AWheelDelta: Single; const AMousePos: TPoint); -begin - if wsEnabled in WidgetState then - SendEvent(TMouseWheelEventObj.Create(Self, AShift, AWheelDelta, AMousePos)); -end; - - -procedure TFCustomForm.WndPaint(Sender: TObject; const ARect: TRect); -begin - LAYOUTTRACE('TFCustomForm.WndPaint for %s:%s (%d/%d-%d/%d)', - [Name, ClassName, ARect.Left, ARect.Top, ARect.Right, ARect.Bottom]); - if wsIsVisible in WidgetState then - SendEvent(TPaintEventObj.Create(Self, TFCanvas(Wnd.Canvas))); -end; - - -procedure TFCustomForm.WndMove(Sender: TObject); -begin - FOrigin := Point(Wnd.Left, Wnd.Top); -end; - - -procedure TFCustomForm.WndResize(Sender: TObject); -begin - LAYOUTTRACE('TFCustomForm.WndResize for %s:%s: New size is %dx%d. Visible? %d', - [Name, ClassName, Wnd.Width, Wnd.Height, Ord(wsIsVisible in WidgetState)]); - if Visible or (wsIsVisible in WidgetState) then - begin - FResizedByUser := (Wnd.Width <> DefSize.cx) or (Wnd.Height <> DefSize.cy); - SetBounds(Origin, gfxBase.Size(Wnd.Width, Wnd.Height)); - end; -end; - - -procedure TFCustomForm.WndShow(Sender: TObject); -begin - LAYOUTTRACE('TFCustomForm.WndShow for %s:%s', [Name, ClassName]); - if not (wsIsVisible in WidgetState) then - begin - Include(WidgetState, wsIsVisible); - SendEvent(TVisibilityChangeEventObj.Create(Self)); - end; -end; - - -{$ENDIF read_implementation} - diff --git a/gui/fpguigrid.inc b/gui/fpguigrid.inc deleted file mode 100644 index 4747dea6..00000000 --- a/gui/fpguigrid.inc +++ /dev/null @@ -1,657 +0,0 @@ -{ - fpGUI - Free Pascal GUI Library - - Grid class declarations - - Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this - distribution, for details of the copyright. - - See the file COPYING.modifiedLGPL, included in this distribution, - for details about redistributing fpGUI. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -} - -{%mainunit fpgui.pas} - -{$IFDEF read_interface} - -// ------------------------------------------------------------------- -// TFCustomGrid -// ------------------------------------------------------------------- - - EInvalidGridOperation = class(Exception); - - TGridDrawState = set of (gdSelected, gdFocused, gdFixed); - - -// PIntegerArray = ^TIntegerArray; -// TIntegerArray = array[0..(MAXINT div SizeOf(Integer))-1] of Integer; - - - TFCustomGrid = class(TFWidget) - private - FColCount: Integer; - FRowCount: Integer; - FFixedCols: Integer; - FFixedRows: Integer; - FDefaultColWidth: Integer; - FDefaultRowHeight: Integer; - FGridWidth: Integer; - FGridHeight: Integer; - FFixedWidth: Integer; - FFixedHeight: Integer; - FColWidths, FRowHeights: PIntegerArray; - procedure SetColCount(AColCount: Integer); - procedure SetRowCount(ARowCount: Integer); - procedure SetFixedCols(AFixedCols: Integer); - procedure SetFixedRows(AFixedRows: Integer); - procedure SetDefaultColWidth(AWidth: Integer); - procedure SetDefaultRowHeight(AHeight: Integer); - function GetColWidths(ACol: Integer): Integer; - procedure SetColWidths(ACol, AWidth: Integer); - function GetRowHeights(ARow: Integer): Integer; - procedure SetRowHeights(ARow, AHeight: Integer); - procedure HorzScrollBarScroll(Sender: TObject; var APosition: Integer); - procedure VertScrollBarScroll(Sender: TObject; var APosition: Integer); - protected - ScrollingSupport: TScrollingSupport; - procedure Paint(Canvas: TFCanvas); override; - function ProcessEvent(Event: TEventObj): Boolean; override; - function DistributeEvent(Event: TEventObj): Boolean; override; - procedure CalcSizes; override; - procedure Resized; override; - procedure ColWidthsChanged; dynamic; - procedure DrawCell(ACanvas: TFCanvas; ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState); virtual; abstract; - procedure RowHeightsChanged; dynamic; - procedure SizeChanged(OldColCount, OldRowCount: Integer); dynamic; - property CanExpandWidth default True; - property CanExpandHeight default True; - property ColCount: Integer read FColCount write SetColCount default 5; - property RowCount: Integer read FRowCount write SetRowCount default 5; - property FixedCols: Integer read FFixedCols write SetFixedCols default 1; - property FixedRows: Integer read FFixedRows write SetFixedRows default 1; - property GridWidth: Integer read FGridWidth; - property GridHeight: Integer read FGridHeight; - property FixedWidth: Integer read FFixedWidth; - property FixedHeight: Integer read FFixedHeight; - property DefaultColWidth: Integer read FDefaultColWidth write SetDefaultColWidth default 64; - property DefaultRowHeight: Integer read FDefaultRowHeight write SetDefaultRowHeight default 24; - property ColWidths[ACol: Integer]: Integer read GetColWidths write SetColWidths; - property RowHeights[ARow: Integer]: Integer read GetRowHeights write SetRowHeights; - public - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - end; - - -// ------------------------------------------------------------------- -// TFDrawGrid -// ------------------------------------------------------------------- - - TDrawCellEvent = procedure(Sender: TObject; ACanvas: TFCanvas; - ACol, ARow: Integer; Rect: TRect; State: TGridDrawState) of object; - - - TFDrawGrid = class(TFCustomGrid) - private - FOnDrawCell: TDrawCellEvent; - protected - procedure DrawCell(ACanvas: TFCanvas; ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState); override; - public - function CellRect(ACol, ARow: Integer): TRect; - property ColWidths; - property RowHeights; - published - property CanExpandWidth; - property CanExpandHeight; - property ColCount; - property RowCount; - property FixedCols; - property FixedRows; - property DefaultColWidth; - property DefaultRowHeight; - property OnDrawCell: TDrawCellEvent read FOnDrawCell write FOnDrawCell; - end; - - -// ------------------------------------------------------------------- -// TFStringGrid -// ------------------------------------------------------------------- - - PCells = ^TCells; - TCells = array[0..(1 shl 30) div SizeOf(AnsiString)] of AnsiString; - - - TFStringGrid = class(TFDrawGrid) - private - CellStrings: PCells; - function GetCells(ACol, ARow: Integer): String; - procedure SetCells(ACol, ARow: Integer; const AValue: String); - protected - //function GetEditText(ACol, ARow: Integer): String; override; - //procedure SetEditText(ACol, ARow: Integer; const AValue: String); override; - procedure SizeChanged(OldColCount, OldRowCount: Integer); override; - //procedure ColumnMoved(AFrom, ATo: Integer); override; - //procedure RowMoved(AFrom, ATo: Integer); override; - procedure DrawCell(ACanvas: TFCanvas; ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState); override; - public - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - property Cells[ACol, ARow: Integer]: String read GetCells write SetCells; - property Cols[Index: Integer]: TStrings; - property Objects[ACol, ARow: Integer]: TObject; - property Rows[Index: Integer]: TStrings; - end; - -{$ENDIF read_interface} - - - -{$IFDEF read_implementation} - - -resourcestring - - SGridIndexOutOfRange = 'Grid index out of range'; - -// =================================================================== -// TFCustomGrid -// =================================================================== - -// public methods - -constructor TFCustomGrid.Create(AOwner: TComponent); -var - i: Integer; -begin - inherited Create(AOwner); - WidgetStyle := WidgetStyle + [wsOpaque]; - FCanExpandWidth := True; - FCanExpandHeight := True; - ScrollingSupport := TScrollingSupport.Create(Self); - ScrollingSupport.HorzScrollBar.OnScroll := @HorzScrollBarScroll; - ScrollingSupport.VertScrollBar.OnScroll := @VertScrollBarScroll; - - FDefaultColWidth := 64; - FDefaultRowHeight := 24; - FColCount := 5; - FRowCount := 5; - FFixedCols := 1; - FFixedRows := 1; - GetMem(FColWidths, FColCount * SizeOf(Integer)); - GetMem(FRowHeights, FRowCount * SizeOf(Integer)); - - for i := 0 to 4 do - begin - FColWidths^[i] := FDefaultColWidth; - FRowHeights^[i] := FDefaultRowHeight; - end; - ColWidthsChanged; - RowHeightsChanged; -end; - -destructor TFCustomGrid.Destroy; -begin - FreeMem(FRowHeights); - FreeMem(FColWidths); - ScrollingSupport.Free; - inherited Destroy; -end; - - -// protected methods - -procedure TFCustomGrid.Paint(Canvas: TFCanvas); -var - x1, y1, x2, y2, x, y, Sum: Integer; - CellRect: TRect; - GridDrawState: TGridDrawState; -begin - if not Canvas.IntersectClipRect(ScrollingSupport.ClientRect) then - exit; - - with Canvas.GetClipRect do - begin - x1 := Left; - y1 := Top; - x2 := Right; - y2 := Bottom; - end; - - { Initialize these for the case that the cell drawing loop won't get - executed at all: } - CellRect.Left := 0; - CellRect.Right := 0; - - // Draw the cells - - CellRect.Top := ScrollingSupport.ClientRect.Top; - y := 0; - while y < RowCount do - begin - CellRect.Bottom := CellRect.Top + RowHeights[y]; - if CellRect.Bottom > y1 then - begin - CellRect.Left := ScrollingSupport.ClientRect.Left; - x := 0; - while x < ColCount do - begin - CellRect.Right := CellRect.Left + ColWidths[x]; - if CellRect.Right > x1 then - begin - GridDrawState := []; - if (x < FixedCols) or (y < FixedRows) then - Include(GridDrawState, gdFixed); - - Canvas.SaveState; - if gdFixed in GridDrawState then - begin - with CellRect do - Style.DrawButtonFace(Canvas, - Rect(Left, Top, Right + 1, Bottom + 1), []); - Style.SetUIColor(Canvas, clBtnText); - end else - begin - Style.SetUIColor(Canvas, clWindow); - Canvas.FillRect(CellRect); - Style.SetUIColor(Canvas, clWindowText); - end; - DrawCell(Canvas, x, y, CellRect, GridDrawState); - Canvas.RestoreState; - end; - - CellRect.Left := CellRect.Right + 1; - if CellRect.Left >= x2 then - break; - - Inc(x); - if x = FixedRows then - Inc(x, ScrollingSupport.HorzScrollBar.Position); - end; - end; - - CellRect.Top := CellRect.Bottom + 1; - if CellRect.Top >= y2 then - break; - - Inc(y); - if y = FixedRows then - Inc(y, ScrollingSupport.VertScrollBar.Position); - end; - - - // Draw the grid lines - - Style.SetUIColor(Canvas, cl3DFace); - - y := 0; - Sum := ScrollingSupport.ClientRect.Top; - while y < RowCount do - begin - Inc(Sum, RowHeights[y]); - if (y >= FixedRows) and (Sum >= y1) then - Canvas.DrawLine(Point(ScrollingSupport.ClientRect.Left + FixedWidth, Sum), - Point(CellRect.Right + 1, Sum)); - Inc(Sum); - if Sum >= y2 then - break; - - Inc(y); - if y = FixedRows then - Inc(y, ScrollingSupport.VertScrollBar.Position); - end; - - x := 0; - Sum := ScrollingSupport.ClientRect.Left; - while x < ColCount do - begin - Inc(Sum, ColWidths[x]); - if (x >= FixedCols) and (Sum >= x1) then - Canvas.DrawLine(Point(Sum, ScrollingSupport.ClientRect.Top + FixedHeight), - Point(Sum, CellRect.Bottom)); - Inc(Sum); - if Sum >= x2 then - break; - - Inc(x); - if x = FixedCols then - Inc(x, ScrollingSupport.HorzScrollBar.Position); - end; - - - // Clear the empty space right and below the grid itself - - Style.SetUIColor(Canvas, clWindow); - if CellRect.Right + 1 < x2 then - Canvas.FillRect(Rect(CellRect.Right + 1, y1, x2, y2)); - if CellRect.Bottom + 1 < y2 then - Canvas.FillRect(Rect(x1, CellRect.Top, CellRect.Right + 1, y2)); -end; - -function TFCustomGrid.ProcessEvent(Event: TEventObj): Boolean; -begin - Result := ScrollingSupport.ProcessEvent(Event) or - inherited ProcessEvent(Event); -end; - -function TFCustomGrid.DistributeEvent(Event: TEventObj): Boolean; -begin - Result := ScrollingSupport.DistributeEvent(Event) or - inherited DistributeEvent(Event); -end; - -procedure TFCustomGrid.CalcSizes; -begin - ScrollingSupport.CalcSizes; -end; - -procedure TFCustomGrid.Resized; -begin - ScrollingSupport.Resized; -end; - -procedure TFCustomGrid.ColWidthsChanged; -var - i: Integer; -begin - FGridWidth := 0; - for i := 0 to ColCount - 1 do - Inc(FGridWidth, ColWidths[i] + 1); - if FGridWidth > 0 then - Dec(FGridWidth); - - FFixedWidth := 0; - for i := 0 to FixedCols - 1 do - Inc(FFixedWidth, ColWidths[i] + 1); - if FFixedWidth > 0 then - Dec(FFixedWidth); -end; - -procedure TFCustomGrid.RowHeightsChanged; -var - i: Integer; -begin - FGridHeight := 0; - for i := 0 to RowCount - 1 do - Inc(FGridHeight, RowHeights[i] + 1); - if FGridHeight > 0 then - Dec(FGridHeight); - - FFixedHeight := 0; - for i := 0 to FixedRows - 1 do - Inc(FFixedHeight, RowHeights[i] + 1); - if FFixedHeight > 0 then - Dec(FFixedHeight); -end; - -procedure TFCustomGrid.SizeChanged(OldColCount, OldRowCount: Integer); -begin - Assert(OldColCount = OldColCount); - Assert(OldRowCount = OldRowCount); - // This dynamic method is only used for descendants of TFCustomGrid -end; - - -// private methods - -procedure TFCustomGrid.SetColCount(AColCount: Integer); -var - OldColCount, i: Integer; -begin - if AColCount <> FColCount then - begin - OldColCount := FColCount; - FColCount := AColCount; - - ReallocMem(FColWidths, FColCount * SizeOf(Integer)); - for i := OldColCount to FColCount - 1 do - FColWidths^[i] := FDefaultColWidth; - - ScrollingSupport.HorzScrollBar.Max := ColCount - FixedCols - 1; - - ColWidthsChanged; - SizeChanged(OldColCount, FRowCount); - end; -end; - -procedure TFCustomGrid.SetRowCount(ARowCount: Integer); -var - OldRowCount, i: Integer; -begin - if ARowCount <> FRowCount then - begin - OldRowCount := FRowCount; - FRowCount := ARowCount; - - ReallocMem(FRowHeights, FRowCount * SizeOf(Integer)); - for i := OldRowCount to FRowCount - 1 do - FRowHeights^[i] := FDefaultRowHeight; - - ScrollingSupport.VertScrollBar.Max := RowCount - FixedRows - 1; - - RowHeightsChanged; - SizeChanged(FColCount, OldRowCount); - end; -end; - -procedure TFCustomGrid.SetFixedCols(AFixedCols: Integer); -begin - if AFixedCols <> FixedCols then - begin - FFixedCols := AFixedCols; - ScrollingSupport.HorzScrollBar.Max := ColCount - FixedCols - 1; - end; -end; - -procedure TFCustomGrid.SetFixedRows(AFixedRows: Integer); -begin - if AFixedRows <> FixedRows then - begin - FFixedRows := AFixedRows; - ScrollingSupport.VertScrollBar.Max := RowCount - FixedRows - 1; - end; -end; - -procedure TFCustomGrid.SetDefaultColWidth(AWidth: Integer); -var - i: Integer; -begin - if AWidth <> FDefaultColWidth then - begin - FDefaultColWidth := AWidth; - for i := 0 to FColCount - 1 do - FColWidths^[i] := AWidth; - ColWidthsChanged; - end; -end; - -procedure TFCustomGrid.SetDefaultRowHeight(AHeight: Integer); -var - i: Integer; -begin - if AHeight <> FDefaultRowHeight then - begin - FDefaultRowHeight := AHeight; - for i := 0 to FRowCount - 1 do - FRowHeights^[i] := AHeight; - RowHeightsChanged; - end; -end; - -function TFCustomGrid.GetColWidths(ACol: Integer): Integer; -begin - if (ACol < 0) or (ACol >= FColCount) then - raise EInvalidGridOperation(SGridIndexOutOfRange); - Result := FColWidths^[ACol]; -end; - -procedure TFCustomGrid.SetColWidths(ACol, AWidth: Integer); -begin - if (ACol < 0) or (ACol >= FColCount) then - raise EInvalidGridOperation(SGridIndexOutOfRange); - FColWidths^[ACol] := AWidth; -end; - -function TFCustomGrid.GetRowHeights(ARow: Integer): Integer; -begin - if (ARow < 0) or (ARow >= FRowCount) then - raise EInvalidGridOperation(SGridIndexOutOfRange); - Result := FRowHeights^[ARow]; -end; - -procedure TFCustomGrid.SetRowHeights(ARow, AHeight: Integer); -begin - if (ARow < 0) or (ARow >= FRowCount) then - raise EInvalidGridOperation(SGridIndexOutOfRange); - FRowHeights^[ARow] := AHeight; -end; - -procedure TFCustomGrid.HorzScrollBarScroll(Sender: TObject; - var APosition: Integer); -var - i, Delta: Integer; - r: TRect; -begin - Delta := 0; - if APosition > ScrollingSupport.HorzScrollBar.Position then - for i := ScrollingSupport.HorzScrollBar.Position to APosition - 1 do - Dec(Delta, ColWidths[i + FixedCols] + 1) - else - for i := APosition to ScrollingSupport.HorzScrollBar.Position - 1 do - Inc(Delta, ColWidths[i + FixedCols] + 1); - - // Scroll the horizontal fixed cells - r := ScrollingSupport.ClientRect; - Inc(r.Left, FixedWidth + 1); - if r.Left <= r.Right then - begin - if Delta < 0 then // Scrolling to the right side - Dec(r.Left, Delta) - else // Scrolling to the left side - Dec(r.Right, Delta); - Scroll(r, Delta, 0); - end; -end; - -procedure TFCustomGrid.VertScrollBarScroll(Sender: TObject; - var APosition: Integer); -var - i, Delta: Integer; - r: TRect; -begin - Delta := 0; - if APosition > ScrollingSupport.VertScrollBar.Position then - for i := ScrollingSupport.VertScrollBar.Position to APosition - 1 do - Dec(Delta, RowHeights[i + FixedRows] + 1) - else - for i := APosition to ScrollingSupport.VertScrollBar.Position - 1 do - Inc(Delta, RowHeights[i + FixedRows] + 1); - - // Scroll the grid body - r := ScrollingSupport.ClientRect; - Inc(r.Top, FixedHeight + 1); - if r.Top <= r.Bottom then - begin - if Delta < 0 then // Scrolling downwards - Dec(r.Top, Delta) - else // Scrolling upwards - Dec(r.Bottom, Delta); - Scroll(r, 0, Delta); - end; -end; - - -// ------------------------------------------------------------------- -// TFDrawGrid -// ------------------------------------------------------------------- - -procedure TFDrawGrid.DrawCell(ACanvas: TFCanvas; ACol, ARow: Integer; - ARect: TRect; - AState: TGridDrawState); -begin - if Assigned(OnDrawCell) then - OnDrawCell(Self, ACanvas, ACol, ARow, ARect, AState); -end; - -function TFDrawGrid.CellRect(ACol, ARow: Integer): TRect; -var - i: Integer; -begin - Result.Left := 0; - for i := 0 to ACol - 1 do - Inc(Result.Left, ColWidths[i]); - Result.Right := Result.Left + ColWidths[ACol]; - - Result.Top := 0; - for i := 0 to ARow - 1 do - Inc(Result.Top, RowHeights[i]); - Result.Bottom := Result.Top + RowHeights[ARow]; -end; - - -// ------------------------------------------------------------------- -// TFStringGrid -// ------------------------------------------------------------------- - -function TFStringGrid.GetCells(ACol, ARow: Integer): String; -begin - if (ACol >= 0) and (ARow >= 0) and (ACol < ColCount) and (ARow < RowCount) then - Result := CellStrings^[ARow * ColCount + ACol] - else - SetLength(Result, 0); -end; - -procedure TFStringGrid.SetCells(ACol, ARow: Integer; const AValue: String); -begin - if (ACol >= 0) and (ARow >= 0) and (ACol < ColCount) and (ARow < RowCount) then - CellStrings^[ARow * ColCount + ACol] := AValue; -end; - -procedure TFStringGrid.SizeChanged(OldColCount, OldRowCount: Integer); -var - Count: Integer; -begin - inherited SizeChanged(OldColCount, OldRowCount); - ReallocMem(CellStrings, ColCount * RowCount * SizeOf(AnsiString)); - Count := ColCount * RowCount - OldColCount * OldRowCount; - if Count > 0 then - FillChar(CellStrings^[OldColCount * OldRowCount], - Count * SizeOf(AnsiString), #0); -end; - -procedure TFStringGrid.DrawCell(ACanvas: TFCanvas; ACol, ARow: Integer; - ARect: TRect; - AState: TGridDrawState); -var - s: String; -begin - // WriteLn('TFStringGrid.DrawCell(', ACol, ', ', ARow, ', ', Integer(AState), ');'); - s := Cells[ACol, ARow]; - if Length(s) > 0 then - ACanvas.TextOut(ARect.TopLeft + Point(2, 2), s); - if Assigned(OnDrawCell) then - OnDrawCell(Self, ACanvas, ACol, ARow, ARect, AState); -end; - -constructor TFStringGrid.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - Self.SizeChanged(0, 0); -end; - -destructor TFStringGrid.Destroy; -var - i: Integer; -begin - for i := 0 to RowCount * ColCount - 1 do - CellStrings^[i] := ''; - FreeMem(CellStrings); - inherited Destroy; -end; - - -{$ENDIF read_implementation} - diff --git a/gui/fpguigroupbox.inc b/gui/fpguigroupbox.inc deleted file mode 100644 index 25c4d70e..00000000 --- a/gui/fpguigroupbox.inc +++ /dev/null @@ -1,106 +0,0 @@ -{ - fpGUI - Free Pascal GUI Library - - GroupBox class declarations - - Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this - distribution, for details of the copyright. - - See the file COPYING.modifiedLGPL, included in this distribution, - for details about redistributing fpGUI. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -} - -{%mainunit fpgui.pas} - -{$IFDEF read_interface} - - { TCustomGroupBox } - - TFCustomGroupBox = class(TFBinWidget) - protected - procedure Paint(Canvas: TFCanvas); override; - procedure CalcSizes; override; - procedure Resized; override; - public - constructor Create(const pText: string; pOwner: TComponent); overload; - end; - - - TFGroupBox = class(TFCustomGroupBox) - published - property CanExpandWidth; - property CanExpandHeight; - property Enabled; - property Text; - end; - -{$ENDIF read_interface} - - - -{$IFDEF read_implementation} - - - -// =================================================================== -// TCustomGroupBox -// =================================================================== - -procedure TFCustomGroupBox.Paint(Canvas: TFCanvas); -begin - Style.DrawGroupBox(Canvas, Rect(0, 0, Width, Height), Text, WidgetState); -end; - - -procedure TFCustomGroupBox.CalcSizes; -var - Borders: TRect; - LabelWidth: Integer; -begin - LabelWidth := 0; - Borders := Style.GetGroupBoxBorders(TFCanvas(FindForm.Wnd.Canvas), Text, LabelWidth); - FMinSize.cx := Borders.Left + Borders.Right + LabelWidth; - FMinSize.cy := Borders.Top + Borders.Bottom; - if Assigned(Child) then - begin - if Child.MinSize.cx > LabelWidth then - FMinSize.cx := Borders.Left + Borders.Right + Child.MinSize.cx; - Inc(FMinSize.cy, Child.MinSize.cy); - if Child.DefSize.cx > LabelWidth then - FDefSize.cx := Borders.Left + Borders.Right + Child.MinSize.cx; - Inc(FDefSize.cy, Child.DefSize.cy); - if Child.MaxSize.cx > LabelWidth then - FMaxSize.cx := Min(Borders.Left + Borders.Right + Child.MaxSize.cx, InfiniteSize); - FMaxSize.cy := Min(MaxSize.cy + Child.MaxSize.cy, InfiniteSize); - end; -end; - - -procedure TFCustomGroupBox.Resized; -var - LabelWidth: Integer; - Borders: TRect; -begin - LabelWidth := 0; - if Assigned(Child) then - begin - Borders := Style.GetGroupBoxBorders(TFCanvas(FindForm.Wnd.Canvas), Text, LabelWidth); - Child.SetBounds(Borders.TopLeft, Size(Width - Borders.Left - Borders.Right, - Height - Borders.Top - Borders.Bottom)); - end; -end; - - -constructor TFCustomGroupBox.Create(const pText: string; pOwner: TComponent); -begin - Create(pOwner); - Text := pText; -end; - - -{$ENDIF read_implementation} - diff --git a/gui/fpguilabel.inc b/gui/fpguilabel.inc deleted file mode 100644 index 31f11aef..00000000 --- a/gui/fpguilabel.inc +++ /dev/null @@ -1,104 +0,0 @@ -{ - fpGUI - Free Pascal GUI Library - - Label class declarations - - Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this - distribution, for details of the copyright. - - See the file COPYING.modifiedLGPL, included in this distribution, - for details about redistributing fpGUI. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -} - -{%mainunit fpgui.pas} - -{$IFDEF read_interface} - - - { TFCustomLabel } - - TFCustomLabel = class(TFWidget) - private - FFontColor: TColor; - procedure SetAlignment(AAlignment: TAlignment); - procedure SetFontColor(const AValue: TColor); - protected - FAlignment: TAlignment; - procedure Paint(Canvas: TFCanvas); override; - procedure CalcSizes; override; - property Alignment: TAlignment read FAlignment write SetAlignment; - property FontColor: TColor read FFontColor write SetFontColor; - public - constructor Create(const pText: string; pOwner: TComponent); overload; - end; - - - TFLabel = class(TFCustomLabel) - published - property Alignment default taLeftJustify; - property CanExpandWidth; - property Enabled; - property FontColor; - property Text; - end; - -{$ENDIF read_interface} - - - -{$IFDEF read_implementation} - - -// =================================================================== -// TFCustomLabel -// =================================================================== - -procedure TFCustomLabel.Paint(Canvas: TFCanvas); -var - x: Integer; -begin - Canvas.SetColor(Style.GetUIColor(FFontColor)); - case Alignment of - taLeftJustify: x := 0; - taCenter: x := (BoundsSize.cx - Canvas.TextWidth(Text)) div 2; - taRightJustify: x := BoundsSize.cx - Canvas.TextWidth(Text); - end; - Style.DrawText(Canvas, Point(x, - (BoundsSize.cy - Canvas.FontCellHeight) div 2), Text, WidgetState); -end; - -procedure TFCustomLabel.CalcSizes; -begin - with FindForm.Wnd.Canvas do - FMinSize := Size(TextWidth(Text), FontCellHeight); -end; - -constructor TFCustomLabel.Create(const pText: string; pOwner: TComponent); -begin - Create(pOwner); - FFontColor := clWindowText; - Text := pText; -end; - -procedure TFCustomLabel.SetAlignment(AAlignment: TAlignment); -begin - if AAlignment <> Alignment then - begin - FAlignment := AAlignment; - Redraw; - end; -end; - -procedure TFCustomLabel.SetFontColor(const AValue: TColor); -begin - if FFontColor = AValue then exit; - FFontColor := AValue; -end; - - -{$ENDIF read_implementation} - diff --git a/gui/fpguilayouts.inc b/gui/fpguilayouts.inc deleted file mode 100644 index cf5d76fe..00000000 --- a/gui/fpguilayouts.inc +++ /dev/null @@ -1,1088 +0,0 @@ -{ - fpGUI - Free Pascal GUI Library - - Layout Managers class declarations - - Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this - distribution, for details of the copyright. - - See the file COPYING.modifiedLGPL, included in this distribution, - for details about redistributing fpGUI. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -} - -{%mainunit fpgui.pas} - -{$IFDEF read_interface} - -// =================================================================== -// Layouts -// =================================================================== - -type - - ELayoutError = class(Exception); - - THorzAlign = (horzLeft, horzCenter, horzRight, horzFill); - TVertAlign = (vertTop, vertCenter, vertBottom, vertFill); - - TFLayoutItem = class(TCollectionItem) - private - FWidget: TFWidget; - published - property Widget: TFWidget read FWidget write FWidget; - end; - - TFWidgetArrayInfo = record - min: Integer; - def: Integer; - max: Integer; - MinFlag: Boolean; - MaxFlag: Boolean; - end; - - TFWidgetArrayInfoArray = array[0..(1 shl 30) div SizeOf(TFWidgetArrayInfo) - 1] of TFWidgetArrayInfo; - PWidgetArrayInfoArray = ^TFWidgetArrayInfoArray; - - - TFLayout = class(TFContainerWidget) - protected - FWidgets: TCollection; - FBorderSpacing: Integer; - IsRecalcingLayout: Boolean; - function GetChildCount: Integer; override; - function GetChild(Index: Integer): TFWidget; override; - property BorderSpacing: Integer read FBorderSpacing write FBorderSpacing; - public - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - function ContainsChild(AChild: TFWidget): Boolean; override; - end; - - -// ------------------------------------------------------------------- -// Fixed Layout -// ------------------------------------------------------------------- - - TFFixedItem = class(TFLayoutItem) - public - Left: Integer; - Top: Integer; - end; - - - TFFixedLayout = class(TFLayout) - protected - procedure CalcSizes; override; - procedure Resized; override; - public - constructor Create(AOwner: TComponent); override; - procedure AddWidget(AWidget: TFWidget; ALeft, ATop: Integer); - procedure MoveWidget(AWidget: TFWidget; ALeft, ATop: Integer); - published - property Enabled; - end; - - -// ------------------------------------------------------------------- -// Docking Layout -// ------------------------------------------------------------------- - - TDockingMode = (dmTop, dmBottom, dmLeft, dmRight, dmClient, dmUndocked); - - TFDockingItem = class(TFLayoutItem) - public - Left: Integer; - Top: Integer; - DockingMode: TDockingMode; - end; - - - TFDockingLayout = class(TFLayout) - private - procedure InternalLayoutChildren; - protected - procedure CalcSizes; override; - procedure Resized; override; - public - constructor Create(AOwner: TComponent); override; - procedure AddWidget(AWidget: TFWidget; ADockingMode: TDockingMode); - procedure AddWidget(AWidget: TFWidget; ALeft, ATop: Integer); - published - property Enabled; - end; - - -// ------------------------------------------------------------------- -// Box Layout -// ------------------------------------------------------------------- - - TFCustomBoxLayout = class(TFLayout) - private - FHorzAlign: THorzAlign; - FVertAlign: TVertAlign; - FOrientation: TOrientation; - FSpacing: Integer; - procedure SetOrientation(AOrientation: TOrientation); - protected - procedure CalcSizes; override; - procedure Resized; override; - property HorzAlign: THorzAlign read FHorzAlign write FHorzAlign default horzFill; - property VertAlign: TVertAlign read FVertAlign write FVertAlign default vertFill; - property Orientation: TOrientation read FOrientation write SetOrientation default Horizontal; - property Spacing: Integer read FSpacing write FSpacing default 4; - public - constructor Create(AOwner: TComponent); override; - procedure InsertChild(AChild: TFWidget); override; - procedure RemoveChild(AChild: TFWidget); override; - end; - - - TFBoxLayout = class(TFCustomBoxLayout) - published - property CanExpandWidth; - property CanExpandHeight; - property Enabled; - property BorderSpacing; - property HorzAlign; - property Orientation; - property Spacing; - property VertAlign; - end; - - -// ------------------------------------------------------------------- -// Grid Layout -// ------------------------------------------------------------------- - - TFGridItem = class(TFLayoutItem) - private - FX, FY, FWidth, FHeight: Integer; - public - constructor Create(ACollection: TCollection); override; - published - property x: Integer read FX write FX default 1; - property y: Integer read FY write FY default 1; - property Width: Integer read FWidth write FWidth; - property Height: Integer read FHeight write FHeight; - end; - - - { TFCustomGridLayout } - - TFCustomGridLayout = class(TFLayout) - private - FColCount: Integer; - FRowCount: Integer; - FColSpacing: Integer; - FRowSpacing: Integer; -// FWidgets: TCollection; - procedure SetColCount(AColCount: Integer); - procedure SetRowCount(ARowCount: Integer); - procedure SetColSpacing(AColSpacing: Integer); - procedure SetRowSpacing(ARowSpacing: Integer); - protected - procedure InitSizeInfos(var ColInfos, RowInfos: PWidgetArrayInfoArray); - procedure CalcSizes; override; - procedure Resized; override; - property GridPositions: TCollection read FWidgets write FWidgets; - property ColCount: Integer read FColCount write SetColCount default 2; - property RowCount: Integer read FRowCount write SetRowCount default 2; - property ColSpacing: Integer read FColSpacing write SetColSpacing default 4; - property RowSpacing: Integer read FRowSpacing write SetRowSpacing default 4; - public - constructor Create(AOwner: TComponent); override; - procedure AddWidget(AWidget: TFWidget; x, y, w, h: Integer); - procedure MoveWidget(AWidget: TFWidget; x, y, w, h: Integer); - end; - - - TFGridLayout = class(TFCustomGridLayout) - published - property Enabled; - property ColCount; - property RowCount; - property ColSpacing; - property RowSpacing; - property GridPositions; - end; - -{$ENDIF read_interface} - - - -{$IFDEF read_implementation} - -// =================================================================== -// Common layout widgets implementation -// =================================================================== - -resourcestring - SLayoutWidgetNotFound = 'Layout child widget not found'; - - -procedure AddToSizes(infos: PWidgetArrayInfoArray; count: Integer; TooMuch: Integer); -var - i, add, FoundElements: Integer; -begin - while TooMuch > 0 do - begin - add := TooMuch; - FoundElements := 0; - for i := 0 to count - 1 do - begin - if not infos^[i].MaxFlag then - continue; - Inc(FoundElements); - if infos^[i].def + add > infos^[i].max then - add := infos^[i].max - infos^[i].def; - end; - if FoundElements > 0 then - begin - add := add div FoundElements; - if add <= 0 then - add := 1; - end else - break; - - for i := 0 to count - 1 do - begin - if not infos^[i].MaxFlag then - continue; - Inc(infos^[i].def, add); - Dec(TooMuch, add); - if TooMuch = 0 then - exit; - if infos^[i].def = infos^[i].max then - infos^[i].MaxFlag := False; - end; - end; -end; - -procedure SubFromSizes(infos: PWidgetArrayInfoArray; count: Integer; TooMuch: Integer); -var - i, sub, FoundElements: Integer; -begin - while TooMuch > 0 do - begin - sub := TooMuch; - FoundElements := 0; - for i := 0 to count - 1 do - begin - if not infos^[i].MinFlag then - continue; - Inc(FoundElements); - if infos^[i].def - sub < infos^[i].min then - sub := infos^[i].def - infos^[i].min; - end; - if FoundElements > 0 then - begin - sub := sub div FoundElements; - if sub <= 0 then - sub := 1; - end else - break; - - for i := 0 to count - 1 do - begin - if not infos^[i].MinFlag then - continue; - Dec(infos^[i].def, sub); - Dec(TooMuch, sub); - if TooMuch = 0 then - exit; - if infos^[i].def = infos^[i].min then - infos^[i].MinFlag := False; - end; - end; -end; - -procedure CorrectSizes(infos: PWidgetArrayInfoArray; count: Integer; SizeDiff: Integer); -var - TooMuch: Integer; -begin - TooMuch := SizeDiff; - if TooMuch > 0 then - AddToSizes(infos, count, TooMuch) - else if TooMuch < 0 then - SubFromSizes(infos, count, -TooMuch); -end; - - -// ------------------------------------------------------------------- -// TFLayout -// ------------------------------------------------------------------- - -constructor TFLayout.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - FCanExpandWidth := True; - FCanExpandHeight := True; -end; - -destructor TFLayout.Destroy; -begin - FWidgets.Free; - inherited Destroy; -end; - -function TFLayout.ContainsChild(AChild: TFWidget): Boolean; -var - i: Integer; -begin - for i := 0 to FWidgets.Count - 1 do - if TFLayoutItem(FWidgets.Items[i]).Widget = AChild then - begin - Result := True; - Exit; //==> - end; - Result := False; -end; - -function TFLayout.GetChildCount: Integer; -begin - Result := FWidgets.Count; -end; - -function TFLayout.GetChild(Index: Integer): TFWidget; -begin - Result := TFLayoutItem(FWidgets.Items[Index]).Widget; -end; - - -// ------------------------------------------------------------------- -// TFFixedLayout -// ------------------------------------------------------------------- - -{ Find the biggest X and Y coordinates that will cover all Widgets, by looking - at each Widget in the Layout. } -procedure TFFixedLayout.CalcSizes; -var - i: Integer; - item: TFFixedItem; -begin - if FWidgets.Count = 0 then - begin - FDefSize := gfxbase.Size(50, 50) - end - else - begin - for i := 0 to FWidgets.Count - 1 do - begin - item := TFFixedItem(FWidgets.Items[i]); - FDefSize.cx := Max(DefSize.cx, item.Left + item.Widget.DefSize.cx); - FDefSize.cy := Max(DefSize.cy, item.Top + item.Widget.DefSize.cy); - end; - end; { if..else } -end; - -procedure TFFixedLayout.Resized; -var - i: Integer; - item: TFFixedItem; -begin -// writeln('==> ' + Classname + '.Resized'); - - for i := 0 to FWidgets.Count - 1 do - begin - item := TFFixedItem(FWidgets.Items[i]); - item.Widget.SetBounds(item.Widget.Left, item.Widget.Top, item.Widget.Width, item.Widget.Height); - end; -end; - -constructor TFFixedLayout.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - FWidgets := TCollection.Create(TFFixedItem); -end; - -procedure TFFixedLayout.AddWidget(AWidget: TFWidget; ALeft, ATop: Integer); -var - item: TFFixedItem; -begin - if not ContainsChild(AWidget) then - begin - item := TFFixedItem(FWidgets.Add); - item.Left := ALeft; - item.Top := ATop; - item.Widget := AWidget; - AWidget.Parent := self; - AWidget.SetBounds(Point(item.Left, item.Top), item.Widget.DefSize); - end; -end; - -procedure TFFixedLayout.MoveWidget(AWidget: TFWidget; ALeft, ATop: Integer); -var - i: integer; - item: TFFixedItem; -begin - for i := 0 to FWidgets.Count - 1 do - begin - item := TFFixedItem(FWidgets.Items[i]); - if item.Widget = AWidget then - begin - item.Left := ALeft; - item.Top := ATop; - AWidget.SetBounds(Point(item.Left, item.Top), item.Widget.DefSize); - Exit; //==> - end; - end; - raise ELayoutError.Create(SLayoutWidgetNotFound); -end; - -{ -procedure TFixedLayout.EvLayoutChildren(Canvas: TGfxCanvas); -var - i: Integer; - item: TFixedItem; -begin - for i := 0 to FWidgets.Count - 1 do - begin - item := TFixedItem(FWidgets.Items[i]); - item.Widget.SetBounds(item.Left, item.Top, item.Widget.DefSize.cx, item.Widget.DefSize.cy); - end; -end; -} - -// ------------------------------------------------------------------- -// TFDockingLayout -// ------------------------------------------------------------------- - -constructor TFDockingLayout.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - FWidgets := TCollection.Create(TFDockingItem); -end; - -procedure TFDockingLayout.InternalLayoutChildren; -var - clx, cly, clw, clh: Integer; // Client rectangle - ClientWidget: TFWidget; - i, WidgetW, WidgetH: Integer; - item: TFDockingItem; -begin - clx := 0; - cly := 0; - clw := BoundsSize.cx; - clh := BoundsSize.cy; -//WriteLn('=> DockingLayout.EvLayoutChildren ', BoundsSize.cx, ' x ', BoundsSize.cy); - if (clw = 0) or (clh = 0) then - exit; - - // Process all attached widgets - ClientWidget := nil; - for i := 0 to FWidgets.Count - 1 do - begin - item := TFDockingItem(FWidgets.Items[i]); - case item.DockingMode of - dmLeft: - begin - WidgetW := item.Widget.DefSize.cx; - WidgetH := clh; - item.Left := clx; - item.Top := cly; - Inc(clx, WidgetW); - Dec(clw, WidgetW); - end; - dmTop: - begin - WidgetW := clw; - WidgetH := item.Widget.DefSize.cy; - item.Left := clx; - item.Top := cly; - Inc(cly, WidgetH); - Dec(clh, WidgetH); - end; - dmRight: - begin - WidgetW := item.Widget.DefSize.cx; - WidgetH := clh; - item.Left := clx + clw - WidgetW; - item.Top := cly; - Dec(clw, WidgetW); - end; - dmBottom: - begin - WidgetH := item.Widget.DefSize.cy; - WidgetW := clw; - item.Left := clx; - item.Top := cly + clh - WidgetH; - Dec(clh, WidgetH); - end; - dmClient: - ClientWidget := item.Widget; - end; { case } - if item.DockingMode <> dmClient then - item.Widget.SetBounds(item.Left, item.Top, WidgetW, WidgetH); - end; { for } - if Assigned(ClientWidget) then - ClientWidget.SetBounds(clx, cly, clw, clh); -end; - -procedure TFDockingLayout.CalcSizes; -var - i: Integer; - item: TFDockingItem; - w: TFWidget; - cw: TFWidget; -begin - if FWidgets.Count = 0 then - begin - FDefSize := gfxbase.Size(200, 200); - Exit; //==> - end; - - // Find the client widget (widget with DockingMode "dmClient") - cw := nil; - for i := 0 to FWidgets.Count - 1 do - begin - item := TFDockingItem(FWidgets.Items[i]); - if item.DockingMode = dmClient then - begin - cw := item.Widget; - Break; //==> - end; - end; - - if Assigned(cw) then - begin - FMinSize := cw.MinSize; - FMaxSize := cw.MaxSize; - FDefSize := cw.DefSize; - end - else - FDefSize := gfxbase.Size(200, 200); - - for i := 0 to FWidgets.Count - 1 do - begin - item := TFDockingItem(FWidgets.Items[i]); - w := item.Widget; - case item.DockingMode of - dmTop, dmBottom: - begin - if MinSize.cx < w.MinSize.cx then - FMinSize.cx := w.MinSize.cx; - Inc(FMinSize.cy, w.MinSize.cy); - if MaxSize.cx < w.MaxSize.cx then - FMaxSize.cx := w.MaxSize.cx; - if MaxSize.cy < InfiniteSize then - Inc(FMaxSize.cy, w.MaxSize.cy); - if DefSize.cx < w.DefSize.cx then - FDefSize.cx := w.DefSize.cx; - Inc(FDefSize.cy, w.DefSize.cy); - end; - dmLeft, dmRight: - begin - Inc(FMinSize.cx, w.MinSize.cx); - if MinSize.cy < w.MinSize.cy then - FMinSize.cy := w.MinSize.cy; - if MaxSize.cx < InfiniteSize then - Inc(FMaxSize.cx, w.MaxSize.cx); - if MaxSize.cy < w.MaxSize.cy then - FMaxSize.cy := w.MaxSize.cy; - Inc(FDefSize.cx, w.DefSize.cx); - if DefSize.cy < w.DefSize.cy then - FDefSize.cy := w.DefSize.cy; - end; - end; { case } - end; { for } -end; - -procedure TFDockingLayout.Resized; -begin - inherited Resized; - InternalLayoutChildren; -end; - -procedure TFDockingLayout.AddWidget(AWidget: TFWidget; ADockingMode: TDockingMode); -var - item: TFDockingItem; -begin - if not ContainsChild(AWidget) then - begin - item := TFDockingItem(FWidgets.Add); - item.Widget := AWidget; - item.DockingMode := ADockingMode; - AWidget.Parent := Self; - end; -end; - -procedure TFDockingLayout.AddWidget(AWidget: TFWidget; ALeft, ATop: Integer); -var - item: TFDockingItem; -begin - if not ContainsChild(AWidget) then - begin - item := TFDockingItem(FWidgets.Add); - item.Widget := AWidget; - item.DockingMode := dmUndocked; - item.Left := ALeft; - item.Top := ATop; - AWidget.Parent := Self; - end; -end; - - -// ------------------------------------------------------------------- -// TFCustomBoxLayout -// ------------------------------------------------------------------- - -procedure TFCustomBoxLayout.SetOrientation(AOrientation: TOrientation); -begin - if AOrientation <> FOrientation then - begin - FOrientation := AOrientation; - Update; - end; -end; - - -constructor TFCustomBoxLayout.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - FWidgets := TCollection.Create(TFLayoutItem); - FOrientation := Horizontal; - FHorzAlign := horzFill; - FVertAlign := vertFill; - FSpacing := 4; -end; - - -procedure TFCustomBoxLayout.InsertChild(AChild: TFWidget); -var - item: TFLayoutItem; -begin - if not ContainsChild(AChild) then - begin - item := TFLayoutItem(FWidgets.Add); - item.Widget := AChild; - AChild.Parent := Self; - end; -end; - - -procedure TFCustomBoxLayout.RemoveChild(AChild: TFWidget); -var - i: integer; - item: TFLayoutItem; -begin - for i := FWidgets.Count - 1 downto 0 do - begin - item := TFLayoutItem(FWidgets.Items[i]); - if item.Widget = AChild then - begin - item := nil; - FWidgets.Delete(i); - exit; - end - end; - {$Warning Not implemented yet.} -// raise Exception.Create('TCustomBoxLayout.RemoveChild - Not implemented yet'); -end; - - -procedure TFCustomBoxLayout.CalcSizes; -var - i: Integer; - item: TFLayoutItem; -begin - i := (FWidgets.Count - 1) * FSpacing; - if Orientation = Horizontal then - begin - FMinSize := Size(i, 0); - FDefSize := MinSize; - if HorzAlign = horzFill then - FMaxSize.cx := i - else - FMaxSize.cx := InfiniteSize; - FMaxSize.cy := InfiniteSize; - end - else - begin - FMinSize := Size(0, i); - FDefSize := MinSize; - FMaxSize.cx := InfiniteSize; - if VertAlign = vertFill then - FMaxSize.cy := i - else - FMaxSize.cy := InfiniteSize; - end; { if..else } - - for i := 0 to FWidgets.Count - 1 do - begin - item := TFLayoutItem(FWidgets.Items[i]); - if Orientation = Horizontal then - begin - Inc(FMinSize.cx, item.Widget.MinSize.cx); - Inc(FDefSize.cx, item.Widget.DefSize.cx); - FMaxSize.cx := Min(InfiniteSize, MaxSize.cx + item.Widget.MaxSize.cx); - FMaxSize.cy := Min(MaxSize.cy, item.Widget.MaxSize.cy); - if MinSize.cy < item.Widget.MinSize.cy then - FMinSize.cy := item.Widget.MinSize.cy; - if DefSize.cy < item.Widget.DefSize.cy then - FDefSize.cy := item.Widget.DefSize.cy; - if MaxSize.cy > item.Widget.MaxSize.cy then - FMaxSize.cy := item.Widget.MaxSize.cy; - end - else - begin { Vertical } - Inc(FMinSize.cy, item.Widget.MinSize.cy); - Inc(FDefSize.cy, item.Widget.DefSize.cy); - FMaxSize.cx := Min(MaxSize.cx, item.Widget.MaxSize.cx); - FMaxSize.cy := Min(InfiniteSize, MaxSize.cy + item.Widget.MaxSize.cy); - if MinSize.cx < item.Widget.MinSize.cx then - FMinSize.cx := item.Widget.MinSize.cx; - if DefSize.cx < item.Widget.DefSize.cx then - FDefSize.cx := item.Widget.DefSize.cx; - if MaxSize.cx > item.Widget.MaxSize.cx then - FMaxSize.cx := item.Widget.MaxSize.cx; - end; { if..else } - end; - - Inc(FMinSize.cx, 2 * FBorderSpacing); - Inc(FMinSize.cy, 2 * FBorderSpacing); - Inc(FDefSize.cx, 2 * FBorderSpacing); - Inc(FDefSize.cy, 2 * FBorderSpacing); - FMaxSize.cx := Min(InfiniteSize, MaxSize.cx + 2 * FBorderSpacing); - FMaxSize.cy := Min(InfiniteSize, MaxSize.cy + 2 * FBorderSpacing); -end; - -procedure TFCustomBoxLayout.Resized; -var - sizes: PWidgetArrayInfoArray; - i, x, y, xpos, ypos, w, h, sum: Integer; - item: TFLayoutItem; -begin - GetMem(sizes, FWidgets.Count * SizeOf(TFWidgetArrayInfo)); - - for i := 0 to FWidgets.Count - 1 do - begin - sizes^[i].min := 0; - sizes^[i].def := 0; - sizes^[i].max := InfiniteSize; - sizes^[i].MinFlag := True; - sizes^[i].MaxFlag := True; - end; - - if Orientation = Horizontal then - for i := 0 to FWidgets.Count - 1 do - begin - item := TFLayoutItem(FWidgets.Items[i]); - sizes^[i].min := Max(sizes^[i].min, item.Widget.MinSize.cx); - sizes^[i].def := Max(sizes^[i].def, item.Widget.DefSize.cx); - sizes^[i].max := Min(sizes^[i].max, item.Widget.MaxSize.cx); - end - else - for i := 0 to FWidgets.Count - 1 do - begin - item := TFLayoutItem(FWidgets.Items[i]); - sizes^[i].min := Max(sizes^[i].min, item.Widget.MinSize.cy); - sizes^[i].def := Max(sizes^[i].def, item.Widget.DefSize.cy); - sizes^[i].max := Min(sizes^[i].max, item.Widget.MaxSize.cy); - end; - - for i := 0 to FWidgets.Count - 1 do - begin - if sizes^[i].def = 0 then sizes^[i].def := 20; - if sizes^[i].min >= sizes^[i].def then - sizes^[i].MinFlag := False; - if sizes^[i].max <= sizes^[i].def then - sizes^[i].MaxFlag := False; - end; - - if Orientation = Horizontal then - begin - if FHorzAlign = horzFill then - CorrectSizes(sizes, FWidgets.Count, BoundsSize.cx - DefSize.cx) - end else - if FVertAlign = vertFill then - CorrectSizes(sizes, FWidgets.Count, BoundsSize.cy - DefSize.cy); - - sum := (FWidgets.Count - 1) * FSpacing; - for i := 0 to FWidgets.Count - 1 do - Inc(sum, sizes^[i].def); - - if Orientation = Horizontal then - case FHorzAlign of - horzCenter: x := (BoundsSize.cx - sum) div 2; - horzRight: x := BoundsSize.cx - FBorderSpacing - sum; - else x := FBorderSpacing; - end - else - case FVertAlign of - vertCenter: y := (BoundsSize.cy - sum) div 2; - vertBottom: y := BoundsSize.cy - FBorderSpacing - sum; - else y := FBorderSpacing; - end; - - for i := 0 to FWidgets.Count - 1 do - begin - item := TFLayoutItem(FWidgets.Items[i]); - if Orientation = Horizontal then - begin - xpos := x; - w := sizes^[i].def; - h := Min(BoundsSize.cy, item.Widget.DefSize.cy); - case FVertAlign of - vertCenter: ypos := (BoundsSize.cy - h) div 2; - vertBottom: ypos := BoundsSize.cy - FBorderSpacing - h; - else ypos := FBorderSpacing; - end; - Inc(x, sizes^[i].def + FSpacing); - if FVertAlign = vertFill then - h := Min(BoundsSize.cy, item.Widget.MaxSize.cy); - end - else - begin - ypos := y; - w := Min(BoundsSize.cx, item.Widget.DefSize.cx); - h := sizes^[i].def; - case FHorzAlign of - horzCenter: xpos := (BoundsSize.cx - w) div 2; - horzRight : xpos := BoundsSize.cx - FBorderSpacing - w; - else xpos := FBorderSpacing; - end; - Inc(y, sizes^[i].def + FSpacing); - if FHorzAlign = horzFill then - w := Min(BoundsSize.cx, item.Widget.MaxSize.cx); - end; - item.Widget.SetBounds(Point(xpos, ypos), Size(w, h)); - end; - - FreeMem(sizes); -end; - - -// ------------------------------------------------------------------- -// TFCustomGridLayout -// ------------------------------------------------------------------- - -constructor TFGridItem.Create(ACollection: TCollection); -begin - inherited Create(ACollection); - Width := 1; - Height := 1; -end; - - -procedure TFCustomGridLayout.SetColCount(AColCount: Integer); -begin - if AColCount <> FColCount then - begin - FColCount := AColCount; - Update; - end; -end; - - -procedure TFCustomGridLayout.SetRowCount(ARowCount: Integer); -begin - if ARowCount <> FRowCount then - begin - FRowCount := ARowCount; - Update; - end; -end; - - -procedure TFCustomGridLayout.SetColSpacing(AColSpacing: Integer); -begin - if AColSpacing <> FColSpacing then - begin - FColSpacing := AColSpacing; - Update; - end; -end; - - -procedure TFCustomGridLayout.SetRowSpacing(ARowSpacing: Integer); -begin - if ARowSpacing <> FRowSpacing then - begin - FRowSpacing := ARowSpacing; - Update; - end; -end; - - -procedure TFCustomGridLayout.InitSizeInfos(var ColInfos, RowInfos: PWidgetArrayInfoArray); -var - i: Integer; - item: TFGridItem; -begin - GetMem(ColInfos, FColCount * SizeOf(TFWidgetArrayInfo)); - GetMem(RowInfos, FRowCount * SizeOf(TFWidgetArrayInfo)); - - for i := 0 to FColCount - 1 do - begin - ColInfos^[i].min := 0; - ColInfos^[i].def := 0; - ColInfos^[i].max := InfiniteSize; - ColInfos^[i].MinFlag := True; - ColInfos^[i].MaxFlag := True; - end; - - for i := 0 to FRowCount - 1 do - begin - RowInfos^[i].min := 0; - RowInfos^[i].def := 0; - RowInfos^[i].max := InfiniteSize; - RowInfos^[i].MinFlag := True; - RowInfos^[i].MaxFlag := True; - end; - - for i := 0 to FWidgets.Count - 1 do - begin - item := TFGridItem(FWidgets.Items[i]); - ColInfos^[item.x].min := Max(ColInfos^[item.x].min, item.Widget.MinSize.cx); - ColInfos^[item.x].def := Max(ColInfos^[item.x].def, item.Widget.DefSize.cx); - ColInfos^[item.x].max := Min(ColInfos^[item.x].max, item.Widget.MaxSize.cx); - RowInfos^[item.y].min := Max(RowInfos^[item.y].min, item.Widget.MinSize.cy); - RowInfos^[item.y].def := Max(RowInfos^[item.y].def, item.Widget.DefSize.cy); - RowInfos^[item.y].max := Min(RowInfos^[item.y].max, item.Widget.MaxSize.cy); - end; - - for i := 0 to FColCount - 1 do - begin - if ColInfos^[i].def = 0 then - ColInfos^[i].def := 20; - if ColInfos^[i].min >= ColInfos^[i].def then - ColInfos^[i].MinFlag := False; - if ColInfos^[i].max <= ColInfos^[i].def then - ColInfos^[i].MaxFlag := False; - end; - - for i := 0 to FRowCount - 1 do - begin - if RowInfos^[i].def = 0 then - RowInfos^[i].def := 20; - if RowInfos^[i].min >= RowInfos^[i].def then - RowInfos^[i].MinFlag := False; - if RowInfos^[i].max <= RowInfos^[i].def then - RowInfos^[i].MaxFlag := False; - end; -end; - - -procedure TFCustomGridLayout.CalcSizes; -var - ColInfos, RowInfos: PWidgetArrayInfoArray; - i: Integer; -begin - MinSize.cx := (FColCount - 1) * FColSpacing; - MinSize.cy := (FRowCount - 1) * FRowSpacing; - DefSize.cx := (FColCount - 1) * FColSpacing; - DefSize.cy := (FRowCount - 1) * FRowSpacing; - MaxSize.cx := (FColCount - 1) * FColSpacing; - MaxSize.cy := (FRowCount - 1) * FRowSpacing; - - InitSizeInfos(ColInfos, RowInfos); - - for i := 0 to FColCount - 1 do - begin - Inc(FMinSize.cx, ColInfos^[i].min); - Inc(FDefSize.cx, ColInfos^[i].def); - FMaxSize.cx := Min(InfiniteSize, MaxSize.cx + ColInfos^[i].max); - end; - - for i := 0 to FRowCount - 1 do - begin - Inc(FMinSize.cy, RowInfos^[i].min); - Inc(FDefSize.cy, RowInfos^[i].def); - FMaxSize.cy := Min(InfiniteSize, MaxSize.cy + RowInfos^[i].max); - end; - - FreeMem(RowInfos); - FreeMem(ColInfos); -end; - - -procedure TFCustomGridLayout.Resized; -var - ColInfos, RowInfos: PWidgetArrayInfoArray; - i, j, x, y, w, h: Integer; - item: TFGridItem; -begin - InitSizeInfos(ColInfos, RowInfos); - - CorrectSizes(ColInfos, FColCount, BoundsSize.cx - DefSize.cx); - CorrectSizes(RowInfos, FRowCount, BoundsSize.cy - DefSize.cy); - - for i := 0 to FWidgets.Count - 1 do - begin - item := TFGridItem(FWidgets.Items[i]); - x := 0; - for j := 0 to item.x - 1 do - Inc(x, ColInfos^[j].def); - y := 0; - for j := 0 to item.y - 1 do - Inc(y, RowInfos^[j].def); - w := 0; - for j := 0 to item.Width - 1 do - Inc(w, ColInfos^[item.x + j].def); - h := 0; - for j := 0 to item.Height - 1 do - Inc(h, RowInfos^[item.y + j].def); - Inc(w, (item.Width - 1) * FColSpacing); - Inc(h, (item.Height - 1) * FRowSpacing); - item.Widget.SetBounds(Point(x + item.x * FColSpacing, - y + item.y * FRowSpacing), Size(w, h)); - end; - - FreeMem(ColInfos); - FreeMem(RowInfos); -end; - -constructor TFCustomGridLayout.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - FWidgets := TCollection.Create(TFGridItem); - FColCount := 2; - FRowCount := 2; - FColSpacing := 4; - FRowSpacing := 4; -end; - -procedure TFCustomGridLayout.AddWidget(AWidget: TFWidget; x, y, w, h: Integer); -var - item: TFGridItem; -begin - if not ContainsChild(AWidget) then - begin - item := TFGridItem(FWidgets.Add); - item.Widget := AWidget; - item.x := x; - item.y := y; - item.Width := w; - item.Height := h; - AWidget.Parent := Self; - end; -end; - -procedure TFCustomGridLayout.MoveWidget(AWidget: TFWidget; x, y, w, h: Integer); -var - i: integer; - item: TFGridItem; -begin - for i := 0 to FWidgets.Count - 1 do - begin - item := TFGridItem(FWidgets.Items[i]); - if item.Widget = AWidget then - begin - item.x := x; - item.y := y; - item.Width := w; - item.Height := h; - Update; - exit; - end; - end; - raise ELayoutError.Create(SLayoutWidgetNotFound); -end; - - -{$ENDIF read_implementation} - diff --git a/gui/fpguilistbox.inc b/gui/fpguilistbox.inc deleted file mode 100644 index abea4016..00000000 --- a/gui/fpguilistbox.inc +++ /dev/null @@ -1,430 +0,0 @@ -{ - fpGUI - Free Pascal GUI Library - - ListBox class declarations - - Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this - distribution, for details of the copyright. - - See the file COPYING.modifiedLGPL, included in this distribution, - for details about redistributing fpGUI. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -} - -{%mainunit fpgui.pas} - -{ Listbox widget implementation } - -{$IFDEF read_interface} - - { TFCustomListBox } - - TFCustomListBox = class(TFWidget) - private - FHotTrack: Boolean; - FItems: TStrings; - FItemIndex: Integer; - function EvMousePressed(Event: TMousePressedEventObj): Boolean; - function EvMouseReleased(Event: TMouseReleasedEventObj): Boolean; - function EvMouseMoved(Event: TMouseMoveEventObj): Boolean; - function ProcessMouseEvent(Event: TMouseEventObj): Boolean; - protected - ScrollingSupport: TScrollingSupport; - FMaxItemWidth: Integer; - ItemHeight: Integer; - procedure Paint(Canvas: TFCanvas); override; - function ProcessEvent(Event: TEventObj): Boolean; override; - function DistributeEvent(Event: TEventObj): Boolean; override; - procedure EvKeyPressed(Key: Word; Shift: TShiftState); override; - procedure CalcSizes; override; - procedure Resized; override; - procedure RecalcWidth; - procedure UpdateScrollBars; - function RedrawItem(AIndex: Integer): TRect; - property CanExpandWidth default True; - property CanExpandHeight default True; - property HotTrack: Boolean read FHotTrack write FHotTrack default False; - property ItemIndex: Integer read FItemIndex write FItemIndex default -1; - public - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - property Items: TStrings read FItems write FItems; - end; - - - TFListBox = class(TFCustomListBox) - published - // TWidget properties - property OnClick; - property Enabled; - // TCustomListBox properties - property HotTrack; - property Items; - property ItemIndex; - end; - -{$ENDIF read_interface} - - - -{$IFDEF read_implementation} - -// =================================================================== -// TFListBoxStrings -// =================================================================== - -type - - TFListBoxStrings = class(TStringList) - protected - ListBox: TFCustomListBox; - procedure SetUpdateState(Updating: Boolean); override; - public - constructor Create(AListBox: TFCustomListBox); - function Add(const s: String): Integer; override; - end; - - -constructor TFListBoxStrings.Create(AListBox: TFCustomListBox); -begin - inherited Create; - ListBox := AListBox; -end; - -function TFListBoxStrings.Add(const s: String): Integer; -var - ItemWidth: Integer; -begin - Result := inherited Add(s); - if Assigned(ListBox.FindForm) and Assigned(ListBox.FindForm.Wnd) then - begin - ItemWidth := ListBox.FindForm.Wnd.Canvas.TextWidth(s) + 4; - if ItemWidth > ListBox.FMaxItemWidth then - ListBox.FMaxItemWidth := ItemWidth; - ListBox.UpdateScrollBars; - end; -end; - -procedure TFListBoxStrings.SetUpdateState(Updating: Boolean); -begin - if not Updating then - ListBox.RecalcWidth; -end; - - -// =================================================================== -// TCustomListBox -// =================================================================== - -constructor TFCustomListBox.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - WidgetStyle := WidgetStyle + [wsCaptureMouse, wsClickable, wsOpaque]; - FCanExpandWidth := True; - FCanExpandHeight := True; - - ScrollingSupport := TScrollingSupport.Create(Self); - ScrollingSupport.HorzScrollBar.OnScroll := @ScrollingSupport.DefHorzScrollHandler; - ScrollingSupport.VertScrollBar.OnScroll := @ScrollingSupport.DefVertScrollHandler; - Items := TFListBoxStrings.Create(Self); - FItemIndex := -1; - UpdateScrollBars; -end; - -destructor TFCustomListBox.Destroy; -begin - Items.Free; - ScrollingSupport.Free; - inherited Destroy; -end; - -procedure TFCustomListBox.Paint(Canvas: TFCanvas); -var - i, StartIndex, EndIndex: Integer; - ItemRect: TRect; - ItemFlags: TItemFlags; -begin - inherited Paint(Canvas); - - if not Canvas.IntersectClipRect(ScrollingSupport.ClientRect) then - exit; //==> - - Style.SetUIColor(Canvas, clWindow); -// Style.DrawWindowBackground(Canvas, ScrollingSupport.ClientRect); - Canvas.FillRect(ScrollingSupport.ClientRect); - Style.SetUIColor(Canvas, clWindowText); - - with ScrollingSupport.VertScrollBar do - begin - StartIndex := Position div ItemHeight; - EndIndex := (Position + PageSize) div ItemHeight; - end; - - Canvas.AppendTranslation(ScrollingSupport.ClientRect.TopLeft - - ScrollingSupport.ScrollPos); - - if StartIndex < 0 then - StartIndex := 0; - if EndIndex >= Items.Count then - EndIndex := Items.Count - 1; - - for i := StartIndex to EndIndex do - begin - Canvas.SaveState; - - ItemRect.Left := ScrollingSupport.HorzScrollBar.Position; - ItemRect.Top := i * ItemHeight; - ItemRect.Right := ScrollingSupport.ClientRect.Right - - ScrollingSupport.ClientRect.Left + - ScrollingSupport.HorzScrollBar.Position; - ItemRect.Bottom := (i + 1) * ItemHeight; - - Canvas.IntersectClipRect(ItemRect); - - ItemFlags := []; - if (wsHasFocus in WidgetState) and ((i = ItemIndex) or - ((ItemIndex = -1) and (i = 0))) then - Include(ItemFlags, ifFocused); - if i = ItemIndex then - Include(ItemFlags, ifSelected); - - Style.DrawItemBefore(Canvas, ItemRect, ItemFlags); -// Canvas.TextOut(Point(2, i * ItemHeight), Items[i]); - Style.DrawText(Canvas, Point(2, i * ItemHeight), Items[i], WidgetState); - Style.DrawItemAfter(Canvas, ItemRect, ItemFlags); - - Canvas.RestoreState; - end; -end; - -function TFCustomListBox.ProcessEvent(Event: TEventObj): Boolean; -begin - if Event.InheritsFrom(TMousePressedEventObj) then - Result := ScrollingSupport.ProcessEvent(Event) or - EvMousePressed(TMousePressedEventObj(Event)) or - inherited ProcessEvent(Event) - else if Event.InheritsFrom(TMouseReleasedEventObj) then - Result := ScrollingSupport.ProcessEvent(Event) or - EvMouseReleased(TMouseReleasedEventObj(Event)) or - inherited ProcessEvent(Event) - else if Event.InheritsFrom(TMouseMoveEventObj) then - Result := ScrollingSupport.ProcessEvent(Event) or - EvMouseMoved(TMouseMoveEventObj(Event)) or - inherited ProcessEvent(Event) - else - Result := ScrollingSupport.ProcessEvent(Event) or - inherited ProcessEvent(Event); -end; - -function TFCustomListBox.DistributeEvent(Event: TEventObj): Boolean; -begin - Result := ScrollingSupport.DistributeEvent(Event) or - inherited DistributeEvent(Event); -end; - -procedure TFCustomListBox.EvKeyPressed(Key: Word; Shift: TShiftState); -var - mshift: TShiftState; - HorzScrollBar: TFScrollBar; - VertScrollBar: TFScrollBar; - r: TRect; -begin -// writeln('Before FItemIndex=' + IntToStr(FItemIndex)); - HorzScrollBar := ScrollingSupport.HorzScrollBar; - VertScrollBar := ScrollingSupport.VertScrollBar; - - mshift := Shift * [ssShift, ssAlt, ssCtrl, ssMeta, ssSuper, ssHyper, ssAltGr]; - if mshift = [] then - case Key of -// keyLeft: -// HorzScrollBar.ButtonUpClick(nil); -// keyRight: -// HorzScrollBar.ButtonDownClick(nil); - keyUp: - begin -// writeln('keyup'); - if FItemIndex > 0 then - begin - RedrawItem(ItemIndex); - Dec(FItemIndex); - r := RedrawItem(ItemIndex); - // we should only call this when focus rect is out of view - if not PtInRect(ScrollingSupport.ClientRect, Point(r.Left, r.Top)) then - begin - VertScrollBar.ButtonUpClick(nil); - end; - end; - end; - keyDown: - begin -// writeln('keydown'); - if FItemIndex < (Items.Count - 1) then - begin - RedrawItem(ItemIndex); - Inc(FItemIndex); - r := RedrawItem(ItemIndex); - // we should only call this when focus rect is out of view - if not PtInRect(ScrollingSupport.ClientRect, Point(r.Left, r.Bottom)) then - begin - VertScrollBar.ButtonDownClick(nil); - end; - end; - end; - keyPageUp: - VertScrollBar.PageUp; - keyPageDown: - VertScrollBar.PageDown; - keyHome: - begin - RedrawItem(ItemIndex); - FItemIndex := 0; - RedrawItem(ItemIndex); - VertScrollBar.Position := 0; - end; - keyEnd: - begin - RedrawItem(ItemIndex); - FItemIndex := (Items.Count - 1); - RedrawItem(ItemIndex); - VertScrollBar.Position := VertScrollBar.Max - VertScrollBar.PageSize; - end; - keyReturn: - begin - if Assigned(OnClick) then - OnClick(Self); - end; - end - else if mshift = [ssShift] then - case Key of - keyPageUp: - HorzScrollBar.PageUp; - keyPageDown: - HorzScrollBar.PageDown; - keyHome: - HorzScrollBar.Position := 0; - keyEnd: - HorzScrollBar.Position := HorzScrollBar.Max - HorzScrollBar.PageSize; - end - else - inherited EvKeyPressed(Key, Shift); - -// writeln('After FItemIndex=' + IntToStr(FItemIndex)); -end; - -procedure TFCustomListBox.CalcSizes; -begin - ScrollingSupport.CalcSizes; - ItemHeight := FindForm.Wnd.Canvas.FontCellHeight; - ScrollingSupport.VertScrollBar.SmallChange := ItemHeight; - RecalcWidth; -end; - -procedure TFCustomListBox.Resized; -begin - ScrollingSupport.Resized; - UpdateScrollBars; -end; - -procedure TFCustomListBox.RecalcWidth; -var - i, ItemWidth: Integer; -begin - if (not Assigned(FindForm)) or (not Assigned(FindForm.Wnd)) then - exit; //==> - - FMaxItemWidth := 0; - for i := 0 to Items.Count - 1 do - begin - ItemWidth := FindForm.Wnd.Canvas.TextWidth(Items[i]) + 4; - if ItemWidth > FMaxItemWidth then - FMaxItemWidth := ItemWidth; - end; - UpdateScrollBars; -end; - -procedure TFCustomListBox.UpdateScrollBars; -begin - ScrollingSupport.SetVirtualSize( - Size(FMaxItemWidth, Items.Count * ItemHeight - 1)); -end; - -function TFCustomListBox.RedrawItem(AIndex: Integer): TRect; -var - ItemRect: TRect; -begin - if AIndex < 0 then - Exit; //==> - ItemRect := ScrollingSupport.ClientRect; - Inc(ItemRect.Top, AIndex * ItemHeight - ScrollingSupport.VertScrollBar.Position); - if (ItemRect.Top > ScrollingSupport.ClientRect.Bottom) or - (ItemRect.Top + ItemHeight <= ScrollingSupport.ClientRect.Top) then - Exit; //==> - ItemRect.Bottom := Min(ItemRect.Top + ItemHeight, ScrollingSupport.ClientRect.Bottom); - Redraw(ItemRect); - Result := ItemRect; -end; - - -// private methods - -function TFCustomListBox.EvMousePressed(Event: TMousePressedEventObj): Boolean; -begin - if HotTrack then - Result := False - else if Event.Button = mbLeft then - Result := ProcessMouseEvent(Event) - else - Result := False; -end; - -function TFCustomListBox.EvMouseReleased(Event: TMouseReleasedEventObj): Boolean; -begin - if HotTrack and (Event.Button = mbLeft) then - Result := ProcessMouseEvent(Event) - else - Result := False; -end; - -function TFCustomListBox.EvMouseMoved(Event: TMouseMoveEventObj): Boolean; -begin - if HotTrack then - Result := ProcessMouseEvent(Event) - else - Result := False; -end; - -function TFCustomListBox.ProcessMouseEvent(Event: TMouseEventObj): Boolean; -var - Index: Integer; -begin - if not PtInRect(ScrollingSupport.ClientRect, Event.Position) then - begin - Result := False; - Exit; //==> - end; - - Index := (Event.Position.y - ScrollingSupport.ClientRect.Top + - ScrollingSupport.VertScrollBar.Position) div ItemHeight; - if (Index >= 0) and (Index < Items.Count) and ((Index <> ItemIndex) or - (HotTrack and Event.InheritsFrom(TMouseReleasedEventObj))) then - begin - RedrawItem(ItemIndex); - FItemIndex := Index; - RedrawItem(ItemIndex); - if (not Event.InheritsFrom(TMouseMoveEventObj)) and Assigned(OnClick) then - OnClick(Self); - end; - -{ !!!: Re-include this for correct focus handling. But at the moment a focus - change results in a complete widget redraw, which is not very brilliant. } -// inherited ProcessEvent(Event); - - Result := True; -end; - - -{$ENDIF read_implementation} - diff --git a/gui/fpguimemo.inc b/gui/fpguimemo.inc deleted file mode 100644 index f1774c17..00000000 --- a/gui/fpguimemo.inc +++ /dev/null @@ -1,295 +0,0 @@ -{ - fpGUI - Free Pascal GUI Library - - Memo class declarations - - Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this - distribution, for details of the copyright. - - See the file COPYING.modifiedLGPL, included in this distribution, - for details about redistributing fpGUI. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -} - -{%mainunit fpgui.pas} - -{$IFDEF read_interface} - - - { TFCustomMemo } - - TFCustomMemo = class(TFWidget) - private - FLines: TStrings; - function EvMousePressed(Event: TMousePressedEventObj): Boolean; - function EvMouseReleased(Event: TMouseReleasedEventObj): Boolean; - function EvMouseMoved(Event: TMouseMoveEventObj): Boolean; - function ProcessMouseEvent(Event: TMouseEventObj): Boolean; - protected - FScrollingSupport: TScrollingSupport; - FMaxItemWidth: Integer; - FItemHeight: Integer; - procedure SetLines(const AValue: TStrings); - procedure Paint(Canvas: TFCanvas); override; - function ProcessEvent(Event: TEventObj): Boolean; override; - function DistributeEvent(Event: TEventObj): Boolean; override; - procedure CalcSizes; override; - procedure UpdateScrollBars; - procedure RecalcWidth; - procedure Resized; override; - public - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - property Lines: TStrings read FLines write SetLines; - end; - - - TFMemo = class(TFCustomMemo) - published -// property Alignment; -// property BorderStyle; -// property Color; - property Enabled; - property Lines; -// property MaxLength; - end; -{$ENDIF read_interface} - - - -{$IFDEF read_implementation} - -type - - TFMemoStrings = class(TStringList) - protected - Memo: TFCustomMemo; - procedure SetUpdateState(Updating: Boolean); override; - public - constructor Create(AMemo: TFCustomMemo); - function Add(const s: String): Integer; override; - end; - - -constructor TFMemoStrings.Create(AMemo: TFCustomMemo); -begin - inherited Create; - Memo := AMemo; -end; - -function TFMemoStrings.Add(const s: String): Integer; -var - ItemWidth: Integer; -begin - Result := inherited Add(s); - if Assigned(Memo.FindForm) and Assigned(Memo.FindForm.Wnd) then - begin - ItemWidth := Memo.FindForm.Wnd.Canvas.TextWidth(s) + 4; - if ItemWidth > Memo.FMaxItemWidth then - Memo.FMaxItemWidth := ItemWidth; - Memo.UpdateScrollBars; - end; -end; - -procedure TFMemoStrings.SetUpdateState(Updating: Boolean); -begin - if not Updating then - Memo.RecalcWidth; -end; - - -{ TFCustomMemo } - -function TFCustomMemo.EvMousePressed(Event: TMousePressedEventObj): Boolean; -begin - -end; - -function TFCustomMemo.EvMouseReleased(Event: TMouseReleasedEventObj): Boolean; -begin - -end; - -function TFCustomMemo.EvMouseMoved(Event: TMouseMoveEventObj): Boolean; -begin - -end; - -function TFCustomMemo.ProcessMouseEvent(Event: TMouseEventObj): Boolean; -var - Index: Integer; -begin - if not PtInRect(FScrollingSupport.ClientRect, Event.Position) then - begin - Result := False; - exit; - end; -{ // Graeme: TODO - - Index := (Event.Position.y - FScrollingSupport.ClientRect.Top + - FScrollingSupport.VerTFScrollBar.Position) div FItemHeight; - if (Index >= 0) and (Index < FLines.Count) and ((Index <> FItemIndex) or - (HotTrack and Event.InheritsFrom(TMouseReleasedEventObj))) then - begin - RedrawItem(ItemIndex); - FItemIndex := Index; - RedrawItem(ItemIndex); - if (not Event.InheritsFrom(TMouseMoveEventObj)) and Assigned(OnClick) then - OnClick(Self); - end; -} - Result := True; -end; - -procedure TFCustomMemo.SetLines(const AValue: TStrings); -begin - FLines.Assign(AValue); -end; - -procedure TFCustomMemo.Paint(Canvas: TFCanvas); -var - i, StartIndex, EndIndex: Integer; - ItemRect: TRect; - ItemFlags: TItemFlags; -begin - inherited Paint(Canvas); - - if not Canvas.IntersectClipRect(FScrollingSupport.ClientRect) then - Exit; //==> - - Style.SetUIColor(Canvas, clWindow); - Canvas.FillRect(FScrollingSupport.ClientRect); - Style.SetUIColor(Canvas, clWindowText); - - with FScrollingSupport.VertScrollBar do - begin - StartIndex := Position div FItemHeight; - EndIndex := (Position + PageSize) div FItemHeight; - end; - - Canvas.AppendTranslation(FScrollingSupport.ClientRect.TopLeft - FScrollingSupport.ScrollPos); - - if StartIndex < 0 then - StartIndex := 0; - if EndIndex >= FLines.Count then - EndIndex := FLines.Count - 1; - - for i := StartIndex to EndIndex do - begin - Canvas.SaveState; - - ItemRect.Left := FScrollingSupport.HorzScrollBar.Position; - ItemRect.Top := i * FItemHeight; - ItemRect.Right := FScrollingSupport.ClientRect.Right - - FScrollingSupport.ClientRect.Left - + FScrollingSupport.HorzScrollBar.Position; - ItemRect.Bottom := (i + 1) * FItemHeight; - - Canvas.IntersectClipRect(ItemRect); - - ItemFlags := []; -// if (wsHasFocus in WidgetState) and ((i = ItemIndex) or -// ((ItemIndex = -1) and (i = 0))) then -// Include(ItemFlags, ifFocused); -// if i = ItemIndex then -// Include(ItemFlags, ifSelected); - -// Style.DrawItemBefore(Canvas, ItemRect, ItemFlags); - Style.DrawText(Canvas, Point(2, i * FItemHeight), FLines[i], WidgetState); -// Style.DrawItemAfter(Canvas, ItemRect, ItemFlags); - - Canvas.RestoreState; - end; -end; - -function TFCustomMemo.ProcessEvent(Event: TEventObj): Boolean; -begin - if Event.InheritsFrom(TMousePressedEventObj) then - Result := FScrollingSupport.ProcessEvent(Event) or - EvMousePressed(TMousePressedEventObj(Event)) or - inherited ProcessEvent(Event) - else if Event.InheritsFrom(TMouseReleasedEventObj) then - Result := FScrollingSupport.ProcessEvent(Event) or - EvMouseReleased(TMouseReleasedEventObj(Event)) or - inherited ProcessEvent(Event) - else if Event.InheritsFrom(TMouseMoveEventObj) then - Result := FScrollingSupport.ProcessEvent(Event) or - EvMouseMoved(TMouseMoveEventObj(Event)) or - inherited ProcessEvent(Event) - else - Result := FScrollingSupport.ProcessEvent(Event) or - inherited ProcessEvent(Event); -end; - -function TFCustomMemo.DistributeEvent(Event: TEventObj): Boolean; -begin - Result := FScrollingSupport.DistributeEvent(Event) or - inherited DistributeEvent(Event); -end; - -procedure TFCustomMemo.CalcSizes; -begin - FScrollingSupport.CalcSizes; - FItemHeight := FindForm.Wnd.Canvas.FontCellHeight; - FScrollingSupport.VertScrollBar.SmallChange := FItemHeight; - RecalcWidth; -end; - -procedure TFCustomMemo.UpdateScrollBars; -begin - FScrollingSupport.SetVirtualSize(Size(FMaxItemWidth, FLines.Count * FItemHeight - 1)); -end; - -procedure TFCustomMemo.RecalcWidth; -var - i, ItemWidth: Integer; -begin - if (not Assigned(FindForm)) or (not Assigned(FindForm.Wnd)) then - Exit; //==> - - FMaxItemWidth := 0; - for i := 0 to FLines.Count - 1 do - begin - ItemWidth := FindForm.Wnd.Canvas.TextWidth(FLines[i]) + 4; - if ItemWidth > FMaxItemWidth then - FMaxItemWidth := ItemWidth; - end; - UpdateScrollBars; -end; - -procedure TFCustomMemo.Resized; -begin - FScrollingSupport.Resized; - UpdateScrollBars; -end; - -constructor TFCustomMemo.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - WidgetStyle := WidgetStyle + [wsCaptureMouse, wsClickable, wsOpaque]; - FCanExpandWidth := True; - FCanExpandHeight := True; - - FScrollingSupport := TScrollingSupport.Create(Self); - FScrollingSupport.HorzScrollBar.OnScroll := @FScrollingSupport.DefHorzScrollHandler; - FScrollingSupport.VertScrollBar.OnScroll := @FScrollingSupport.DefVertScrollHandler; - - FLines := TFMemoStrings.Create(self); -// SetBounds(10, 10, 180, 90); - UpdateScrollBars; -end; - -destructor TFCustomMemo.Destroy; -begin - FLines.Free; - FScrollingSupport.Free; - inherited Destroy; -end; - - -{$ENDIF read_implementation} - - diff --git a/gui/fpguimenus.inc b/gui/fpguimenus.inc deleted file mode 100644 index 8a2c121b..00000000 --- a/gui/fpguimenus.inc +++ /dev/null @@ -1,246 +0,0 @@ -{ - fpGUI - Free Pascal GUI Library - - Menu class declarations - - Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this - distribution, for details of the copyright. - - See the file COPYING.modifiedLGPL, included in this distribution, - for details about redistributing fpGUI. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -} - -{%mainunit fpgui.pas} - -{$IFDEF read_interface} - - // forward class declarations - TFPopupMenu = class; - TFMenuBar = class; - - { TFMenuItem } - - TFMenuItem = class(TFCustomPanel) - private - FHotKeyDef: string; - FSeparator: boolean; - FSubMenu: TFPopupMenu; - function GetSubMenu: TFPopupMenu; - procedure InternalShowPopupMenu; - protected - procedure Paint(Canvas: TFCanvas); override; - function ProcessEvent(Event: TEventObj): Boolean; override; - procedure Click; override; - public - constructor Create(const pText: string; pOwner: TComponent); overload; - destructor Destroy; override; - property SubMenu: TFPopupMenu read GetSubMenu; - published - property Separator: boolean read FSeparator write FSeparator; - property HotKeyDef: string read FHotKeyDef write FHotKeyDef; - property Text; - property Visible; - property Enabled; - end; - - - { TFPopupMenu } - - TFPopupMenu = class(TFPopupWindow) - private - FMenu: TFMenuBar; - public - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - function AddMenu(const pTitle: string): TFMenuItem; - function AddMenu(const pTitle: string; const pHotKeyDef: string; pHandlerProc: TNotifyEvent): TFMenuItem; - end; - - - { TFMenuBar } - - TFMenuBar = class(TFCustomBoxLayout) - public - constructor Create(AOwner: TComponent); override; - function AddMenu(const pTitle: string): TFMenuItem; - function AddMenu(const pTitle: string; const pHotKeyDef: string; pHandlerProc: TNotifyEvent): TFMenuItem; - end; - -{$ENDIF read_interface} - - - -{$IFDEF read_implementation} - -{ TFMenuItem } - -function TFMenuItem.GetSubMenu: TFPopupMenu; -begin - if not Assigned(FSubMenu) then - FSubMenu := TFPopupMenu.Create(self); - Result := FSubMenu; -end; - -procedure TFMenuItem.InternalShowPopupMenu; -begin - if Assigned(FSubMenu) and FSubMenu.Visible then - begin -// writeln('Closing submenu'); - FSubMenu.Close; - Exit; //==> - end; - - if not Assigned(FSubMenu) then - begin -// writeln('Creating submenu'); - FSubMenu := TFPopupMenu.Create(Self); - end; - -// writeln('set submenu position...'); - FSubMenu.SetPosition(ClientToScreen(Point(0, Height))); -// writeln('show submenu...'); - FSubMenu.Show; - FSubMenu.Wnd.SetMinMaxClientSize(MaxSize, MaxSize); -end; - -procedure TFMenuItem.Paint(Canvas: TFCanvas); -begin - if (wsClicked in WidgetState) or (wsMouseInside in WidgetState) then - FBevelStyle := bsRaised -// else if (wsClicked in WidgetState) then -// FBevelStyle := bsLowered - else - FBevelStyle := bsPlain; - - inherited Paint(Canvas); -end; - -function TFMenuItem.ProcessEvent(Event: TEventObj): Boolean; -begin - {$IFDEF DEBUG} - if Event.InheritsFrom(TMouseEnterEventObj) then - writeln(Format('MouseEnter for %s:%s', [Text, Classname])) - else if Event.InheritsFrom(TMouseLeaveEventObj) then - writeln(Format('MouseLeave for %s:%s', [Text, Classname])); - {$ENDIF} - - if Event.InheritsFrom(TMouseEnterEventObj) then - begin - Include(WidgetState, wsMouseInside); - Redraw; - result := True; - end - else if Event.InheritsFrom(TMouseLeaveEventObj) then - begin - Exclude(WidgetState, wsMouseInside); - Redraw; - result := True; - end - else - result := inherited ProcessEvent(Event); -end; - -procedure TFMenuItem.Click; -begin - if (wsMouseInside in WidgetState) and Assigned(FSubMenu) then - begin -// writeln('Passed'); - InternalShowPopupMenu; - end - else - begin -// writeln('Failed'); - inherited Click; - end; - - if FindForm is TFPopupMenu then - TFPopupMenu(FindForm).Close; -end; - -constructor TFMenuItem.Create(const pText: string; pOwner: TComponent); -begin - inherited Create(pText, pOwner); - WidgetStyle := WidgetStyle + [wsCaptureMouse, wsClickable, wsOpaque]; - FBevelStyle := bsPlain; -end; - -destructor TFMenuItem.Destroy; -begin - if Assigned(FSubMenu) then - FSubMenu.Free; - inherited Destroy; -end; - -{ TFPopupMenu } - -constructor TFPopupMenu.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - WidgetStyle := WidgetStyle + [wsCaptureMouse, wsClickable, wsOpaque]; - BorderWidth := 1; - Color := clBlack; - Name := '_MenuPopup'; - Visible := False; - - FMenu := TFMenuBar.Create(self); - FMenu.Name := '_VBoxMenu'; - FMenu.Orientation := Vertical; - FMenu.Spacing := 0; - InsertChild(FMenu); -end; - -destructor TFPopupMenu.Destroy; -begin - FMenu.Free; - inherited Destroy; -end; - -function TFPopupMenu.AddMenu(const pTitle: string): TFMenuItem; -begin - Result := FMenu.AddMenu(pTitle); -end; - -function TFPopupMenu.AddMenu(const pTitle: string; const pHotKeyDef: string; - pHandlerProc: TNotifyEvent): TFMenuItem; -begin - Result := FMenu.AddMenu(pTitle, photKeyDef, pHandlerProc); -end; - -{ TFMenuBar } - -constructor TFMenuBar.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - WidgetStyle := WidgetStyle + [wsCaptureMouse, wsClickable, wsOpaque]; - FCanExpandHeight := False; - Spacing := 0; -end; - -function TFMenuBar.AddMenu(const pTitle: string): TFMenuItem; -begin - Result := TFMenuItem.Create(pTitle, self); - InsertChild(Result); -end; - - -function TFMenuBar.AddMenu(const pTitle: string; const pHotKeyDef: string; - pHandlerProc: TNotifyEvent): TFMenuItem; -begin - Result := AddMenu(pTitle); - if pTitle <> '-' then - begin - Result.Text := pTitle; - Result.HotKeyDef := pHotKeyDef; - Result.OnClick := pHandlerProc; - end - else - Result.Separator := True; -end; - - -{$ENDIF read_implementation} - diff --git a/gui/fpguipackage.lpk b/gui/fpguipackage.lpk deleted file mode 100644 index 3f214145..00000000 --- a/gui/fpguipackage.lpk +++ /dev/null @@ -1,79 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/gui/fpguipackage.pas b/gui/fpguipackage.pas deleted file mode 100644 index 1052517f..00000000 --- a/gui/fpguipackage.pas +++ /dev/null @@ -1,14 +0,0 @@ -{ This file was automatically created by Lazarus. Do not edit! -This source is only used to compile and install the package. - } - -unit fpguipackage; - -interface - -uses - fpGUI, StyleManager, WindowsStyle, MotifStyle, OpenSoftStyle, fpGUI_DB; - -implementation - -end. diff --git a/gui/fpguipanel.inc b/gui/fpguipanel.inc deleted file mode 100644 index b0fbf655..00000000 --- a/gui/fpguipanel.inc +++ /dev/null @@ -1,126 +0,0 @@ -{ - fpGUI - Free Pascal GUI Library - - Panel class declarations - - Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this - distribution, for details of the copyright. - - See the file COPYING.modifiedLGPL, included in this distribution, - for details about redistributing fpGUI. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -} - -{%mainunit fpgui.pas} - -{ - Panel implementation. I mixture of Delphi's TPanel and TBevel. The class - name might change to Frame. -} - -{$IFDEF read_interface} - - TFCustomPanel = class(TFBinWidget) - private - FBevelStyle: TBevelStyle; - procedure SetBevelStyle(const AValue: TBevelStyle); - protected - procedure Paint(Canvas: TFCanvas); override; - procedure CalcSizes; override; - procedure Resized; override; - property BevelStyle: TBevelStyle read FBevelStyle write SetBevelStyle; - {$Note Still outstanding is the Shape and Color properties for starters } - public - constructor Create(const pText: string; pOwner: TComponent); overload; - end; - - - TFPanel = class(TFCustomPanel) - published - property CanExpandWidth; - property CanExpandHeight; - property Enabled; - property Text; - property BevelStyle; - end; - -{$ENDIF read_interface} - - - -{$IFDEF read_implementation} - -procedure TFCustomPanel.SetBevelStyle(const AValue: TBevelStyle); -begin - if FBevelStyle = AValue then exit; - FBevelStyle := AValue; - Redraw; -end; - -procedure TFCustomPanel.Paint(Canvas: TFCanvas); -var - Pt: TPoint; -begin - inherited Paint(Canvas); - Style.DrawPanel(Canvas, Rect(0, 0, Width, Height), FBevelStyle); - - if Text <> '' then - begin - Canvas.SetColor(Style.GetUIColor(clBtnText)); - Pt.x := (BoundsSize.cx - Canvas.TextWidth(Text)) div 2; - Pt.y := (BoundsSize.cy - Canvas.FontCellHeight) div 2; - Style.DrawText(Canvas, Pt, Text, WidgetState); - end; -end; - -procedure TFCustomPanel.CalcSizes; -var - Borders: TRect; - LabelWidth: Integer; -begin - Borders := Style.GetGroupBoxBorders(TFCanvas(FindForm.Wnd.Canvas), Text, LabelWidth); - FMinSize.cx := Borders.Left + Borders.Right + LabelWidth; - FMinSize.cy := Borders.Top + Borders.Bottom; - if Assigned(Child) then - begin - if Child.MinSize.cx > LabelWidth then - FMinSize.cx := Borders.Left + Borders.Right + Child.MinSize.cx; - Inc(FMinSize.cy, Child.MinSize.cy); - if Child.DefSize.cx > LabelWidth then - FDefSize.cx := Borders.Left + Borders.Right + Child.MinSize.cx; - Inc(FDefSize.cy, Child.DefSize.cy); - if Child.MaxSize.cx > LabelWidth then - FMaxSize.cx := Min(Borders.Left + Borders.Right + Child.MaxSize.cx, InfiniteSize); - FMaxSize.cy := Min(MaxSize.cy + Child.MaxSize.cy, InfiniteSize); - end; -end; - -procedure TFCustomPanel.Resized; -var - LabelWidth: Integer; - Borders: TRect; -begin - LabelWidth := 0; - if Assigned(Child) then - begin - Borders := Style.GetGroupBoxBorders(TFCanvas(FindForm.Wnd.Canvas), Text, LabelWidth); - Child.SetBounds(Borders.TopLeft, Size(Width - Borders.Left - Borders.Right, - Height - Borders.Top - Borders.Bottom)); - end; -end; - -constructor TFCustomPanel.Create(const pText: string; pOwner: TComponent); -begin - Create(pOwner); - FCanExpandWidth := True; - FCanExpandHeight := True; - Text := pText; - FBevelStyle := bsRaised; -end; - - -{$ENDIF read_implementation} - diff --git a/gui/fpguipopupwindow.inc b/gui/fpguipopupwindow.inc deleted file mode 100644 index 8a995e6b..00000000 --- a/gui/fpguipopupwindow.inc +++ /dev/null @@ -1,57 +0,0 @@ -{ - fpGUI - Free Pascal GUI Library - - PopupWindow class declarations - - Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this - distribution, for details of the copyright. - - See the file COPYING.modifiedLGPL, included in this distribution, - for details about redistributing fpGUI. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -} - -{%mainunit fpgui.pas} - -{$IFDEF read_interface} - - TFPopupWindow = class(TFCustomForm) - public - constructor Create(AOwner: TComponent); override; - procedure Show; override; - procedure Close; override; - end; - -{$ENDIF read_interface} - - - -{$IFDEF read_implementation} - -constructor TFPopupWindow.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - FParent := nil; - FWindowOptions := FWindowOptions + [woBorderless, woPopup]; -end; - - -procedure TFPopupWindow.Show; -begin - inherited Show; - LAYOUTTRACE('TFPopupWindow.Show for %s:%s', [Name, ClassName]); - Wnd.CaptureMouse; -end; - - -procedure TFPopupWindow.Close; -begin - Wnd.ReleaseMouse; - inherited Close; -end; - -{$ENDIF read_implementation} - diff --git a/gui/fpguiprogressbar.inc b/gui/fpguiprogressbar.inc deleted file mode 100644 index 0f8f4dd0..00000000 --- a/gui/fpguiprogressbar.inc +++ /dev/null @@ -1,159 +0,0 @@ -{ - fpGUI - Free Pascal GUI Library - - Progress Bar class declarations - - Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this - distribution, for details of the copyright. - - See the file COPYING.modifiedLGPL, included in this distribution, - for details about redistributing fpGUI. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -} - -{%mainunit fpgui.pas} - -{ - Progress Bar implementation -} - -{$IFDEF read_interface} - - { TCustomProgressBar } - - TFCustomProgressBar = class(TFCustomPanel) - private - FFillColor: TColor; - FMax: integer; - FMin: integer; - FPosition: integer; - FShowPercentage: Boolean; - procedure SetFillColor(const AValue: TColor); - procedure SetMax(const AValue: integer); - procedure SetMin(const AValue: integer); - procedure SetPosition(const AValue: integer); - procedure SetShowPercentage(const AValue: Boolean); - protected - procedure Paint(Canvas: TFCanvas); override; - property FillColor: TColor read FFillColor write SetFillColor default clRed; - property Position: integer read FPosition write SetPosition; - property Min: integer read FMin write SetMin default 0; - property Max: integer read FMax write SetMax default 100; - property ShowPercentage: Boolean read FShowPercentage write SetShowPercentage default True; - public - constructor Create(const pText: string; pOwner: TComponent); overload; - end; - - - TFProgressBar = class(TFCustomProgressBar) - published - property CanExpandWidth; - property CanExpandHeight; - property Enabled; -// property Text; - property FillColor; - property Position; - property Min; - property Max; - property ShowPercentage; - end; - -{$ENDIF read_interface} - - - -{$IFDEF read_implementation} - -procedure TFCustomProgressBar.SetFillColor(const AValue: TColor); -begin - if FFillColor = AValue then exit; - FFillColor := AValue; - Redraw; -end; - -procedure TFCustomProgressBar.SetMax(const AValue: integer); -begin - if FMax = AValue then exit; - FMax := AValue; - if FPosition > FMax then - FPosition := FMax; - Redraw; -end; - -procedure TFCustomProgressBar.SetMin(const AValue: integer); -begin - if FMin = AValue then exit; - FMin := AValue; - if FPosition < FMin then - FPosition := FMin; - Redraw; -end; - -procedure TFCustomProgressBar.SetPosition(const AValue: integer); -begin - if FPosition = AValue then - exit; //==> - if (AValue >= Min) and (AValue <= Max) then - begin - FPosition := AValue; - Redraw; - end; -end; - -procedure TFCustomProgressBar.SetShowPercentage(const AValue: Boolean); -begin - if FShowPercentage = AValue then - Exit; //==> - FShowPercentage := AValue; - Redraw; -end; - -procedure TFCustomProgressBar.Paint(Canvas: TFCanvas); -var - Pt: TPoint; - r: TRect; - p: integer; - percent: integer; - t: string; -begin - FText := ''; - inherited Paint(Canvas); - Canvas.SetColor(Style.GetUIColor(FFillColor)); - - percent := (100 div (Max - Min)) * FPosition; - p := (percent * (Width - 3)) div 100; - - r := Rect( - ClientRect.Left + 3, - ClientRect.Top + 3, - p, - ClientRect.Bottom - 3); - Canvas.FillRect(r); - - if FShowPercentage then - begin - t := IntToStr(percent) + '%'; - Pt.x := (Width - Canvas.TextWidth(t)) div 2; - Pt.y := (Height - Canvas.FontCellHeight) div 2; - Canvas.SetColor(Style.GetUIColor(clBtnText)); - Style.DrawText(Canvas, Pt, t, WidgetState); - end; -end; - -constructor TFCustomProgressBar.Create(const pText: string; pOwner: TComponent); -begin - inherited Create(pText, pOwner); - FCanExpandHeight := False; - FBevelStyle := bsLowered; - FFillColor := clRed; - FMin := 0; - FMax := 100; - FShowPercentage := True; -end; - - -{$ENDIF read_implementation} - diff --git a/gui/fpguiradiobutton.inc b/gui/fpguiradiobutton.inc deleted file mode 100644 index 58240ac6..00000000 --- a/gui/fpguiradiobutton.inc +++ /dev/null @@ -1,139 +0,0 @@ -{ - fpGUI - Free Pascal GUI Library - - RadioButton class declarations - - Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this - distribution, for details of the copyright. - - See the file COPYING.modifiedLGPL, included in this distribution, - for details about redistributing fpGUI. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -} - -{%mainunit fpgui.pas} - -{$IFDEF read_interface} - - { TFCustomRadioButton } - - TFCustomRadioButton = class(TFWidget) - private - procedure SetChecked(AChecked: Boolean); - protected - FChecked: Boolean; - FLabelPos: TPoint; - procedure Click; override; - procedure Paint(Canvas: TFCanvas); override; - procedure CalcSizes; override; - property Checked: Boolean read FChecked write SetChecked; - public - constructor Create(AOwner: TComponent); override; - constructor Create(const pText: string; pOwner: TComponent); overload; - end; - - - TFRadioButton = class(TFCustomRadioButton) - published - property CanExpandWidth; - property CanExpandHeight; - property Enabled; - property Checked; - property Text; - property OnClick; - end; - -{$ENDIF read_interface} - - - -{$IFDEF read_implementation} - - -// =================================================================== -// TFCustomRadioButton -// =================================================================== - -constructor TFCustomRadioButton.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - WidgetStyle := WidgetStyle + [wsCaptureMouse, wsClickable]; -end; - - -constructor TFCustomRadioButton.Create(const pText: string; pOwner: TComponent); -begin - Create(pOwner); - Text := pText; -end; - - -procedure TFCustomRadioButton.Click; -begin - if not Checked then - SetChecked(True); - inherited Click; -end; - - -procedure TFCustomRadioButton.Paint(Canvas: TFCanvas); -var - FontHeight: Integer; - LabelRect: TRect; - Flags: TFCheckboxFlags; -begin - FontHeight := Canvas.FontCellHeight; - LabelRect.Left := FLabelPos.x; - LabelRect.Top := FLabelPos.y + (Height - MinSize.cy) div 2; - LabelRect.Right := LabelRect.Left + Canvas.TextWidth(Text); - LabelRect.Bottom := LabelRect.Top + FontHeight; - - Flags := []; - if (wsClicked in WidgetState) and (wsMouseInside in WidgetState) then - Include(Flags, cbIsPressed); - if (wsHasFocus in WidgetState) and FindForm.IsActive then - Include(Flags, cbHasFocus); - if wsEnabled in WidgetState then - Include(Flags, cbIsEnabled); - if Checked then - Include(Flags, cbIsChecked); - - Style.DrawRadioButton(Canvas, Rect(0, 0, Width, Height), LabelRect, Flags); - Canvas.SetColor(Style.GetUIColor(clWindowText)); - Style.DrawText(Canvas, LabelRect.TopLeft, Text, WidgetState); -end; - -procedure TFCustomRadioButton.CalcSizes; -begin - with FindForm.Wnd.Canvas do - Style.GetRadioButtonLayout(gfxbase.Size(TextWidth(Text), FontCellHeight), - FMinSize, FLabelPos); -end; - -procedure TFCustomRadioButton.SetChecked(AChecked: Boolean); -var - i: Integer; - Child: TFWidget; -begin - if AChecked <> Checked then - begin - FChecked := AChecked; - Redraw; - - if Checked and Assigned(Parent) and - Parent.InheritsFrom(TFContainerWidget) then - for i := 0 to TFContainerWidget(Parent).ChildCount - 1 do - begin - Child := TFContainerWidget(Parent).Children[i]; - if (Child <> Self) and Child.InheritsFrom(TFCustomRadioButton) then - TFCustomRadioButton(Child).Checked := False; - end; - end; -end; - - -{$ENDIF read_implementation} - diff --git a/gui/fpguiscrollbar.inc b/gui/fpguiscrollbar.inc deleted file mode 100644 index c3dfa195..00000000 --- a/gui/fpguiscrollbar.inc +++ /dev/null @@ -1,723 +0,0 @@ -{ - fpGUI - Free Pascal GUI Library - - ScrollBar class declarations - - Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this - distribution, for details of the copyright. - - See the file COPYING.modifiedLGPL, included in this distribution, - for details about redistributing fpGUI. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -} - -{%mainunit fpgui.pas} - -{$IFDEF read_interface} - - // !!!: Add argument which indicates the type of scrolling - TScrollEvent = procedure(Sender: TObject; var APosition: Integer) of object; - - - TFCustomScrollBar = class(TFWidget) - private - FOrientation: TOrientation; - FMin: Integer; - FMax: Integer; - FPageSize: Integer; - FPosition: Integer; - FSmallChange: Integer; - FLargeChange: Integer; - FOnChange: TNotifyEvent; - FOnScroll: TScrollEvent; - ButtonUp: TFGenericButton; - ButtonDown: TFGenericButton; - Slider: TFWidget; - Embedded: Boolean; // for internal embedded usage! - - // Event handling - procedure ButtonUpClick(Sender: TObject); - procedure ButtonDownClick(Sender: TObject); - // Property access - procedure SetOrientation(AOrientation: TOrientation); - procedure SetMin(AMin: Integer); - procedure SetMax(AMax: Integer); - procedure SetPageSize(APageSize: Integer); - procedure SetPosition(APosition: Integer); - // Helpers - function GetButtonSize: Integer; - function ClipPosition(APosition: Integer): Integer; - procedure UpdateBar; - protected - function DistributeEvent(Event: TEventObj): Boolean; override; - procedure Paint(Canvas: TFCanvas); override; - procedure CalcSizes; override; - procedure Resized; override; - property Orientation: TOrientation read FOrientation write SetOrientation; - property Min: Integer read FMin write SetMin default 0; - property Max: Integer read FMax write SetMax default 100; - property PageSize: Integer read FPageSize write SetPageSize; - property Position: Integer read FPosition write SetPosition default 0; - property SmallChange: Integer read FSmallChange write FSmallChange default 1; - property LargeChange: Integer read FLargeChange write FLargeChange default 0; - property OnChange: TNotifyEvent read FOnChange write FOnChange; - property OnScroll: TScrollEvent read FOnScroll write FOnScroll; - public - constructor Create(AOwner: TComponent); override; - procedure LineUp; - procedure LineDown; - procedure PageUp; - procedure PageDown; - end; - - - TFScrollBar = class(TFCustomScrollBar) - published - property Enabled; - property Orientation; - property Min; - property Max; - property PageSize; - property Position; - property SmallChange; - property LargeChange; - property OnChange; - property OnScroll; - end; - - -{$ENDIF read_interface} - - - -{$IFDEF read_implementation} - - - -// =================================================================== -// TFCustomScrollBar and helper classes -// =================================================================== - -// ------------------------------------------------------------------- -// TFScrollBarButton -// ------------------------------------------------------------------- - -type - { Private button type only used for scrollbars. } - TFScrollBarButton = class(TFGenericButton) - protected - procedure Paint(Canvas: TFCanvas); override; - procedure CalcSizes; override; - public - Direction: TArrowDirection; - end; - - -procedure TFScrollBarButton.Paint(Canvas: TFCanvas); -begin - inherited Paint(Canvas); - Style.DrawScrollBarButton(Canvas, Rect(0, 0, BoundsSize.cx, BoundsSize.cy), - Direction, (wsClicked in WidgetState) and (wsMouseInside in WidgetState), - wsEnabled in WidgetState); -end; - - -procedure TFScrollBarButton.CalcSizes; -begin - ASSERT(Owner is TFCustomScrollBar); - FMinSize := Style.GetScrollBarBtnSize(TFCustomScrollBar(Owner).Orientation); -end; - - -// ------------------------------------------------------------------- -// TFScrollBarSlider -// ------------------------------------------------------------------- - -type - TFScrollBarSlider = class(TFWidget) - private - function EvMousePressed(Event: TMousePressedEventObj): Boolean; - function EvMouseReleased(Event: TMouseReleasedEventObj): Boolean; - function EvMouseMove(Event: TMouseMoveEventObj): Boolean; - protected - ButtonPos: Integer; - ButtonSize: Integer; - IsDraggingButton: Boolean; - PrevAreaPressed: Boolean; - NextAreaPressed: Boolean; - DragStartMousePos: Integer; - DragStarTFButtonPos: Integer; -// ButtonMoveSavedPosition: Integer; - procedure Paint(Canvas: TFCanvas); override; - function ProcessEvent(Event: TEventObj): Boolean; override; - procedure CalcSizes; override; - function CalcPosition: Integer; - public - constructor Create(AOwner: TComponent); override; - procedure UpdateBar; - end; - - -constructor TFScrollBarSlider.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - WidgetStyle := WidgetStyle + [wsCaptureMouse, wsClickable, wsOpaque]; -end; - -procedure TFScrollBarSlider.UpdateBar; -var - Size: Integer; -begin - ASSERT(Owner is TFCustomScrollBar); - - if Visible then - begin - with TFCustomScrollBar(Owner) do - begin - if (Min = Max) or (Max - Min = PageSize - 1) then - ButtonPos := 0 - else - begin - if Orientation = Horizontal then - Size := Self.BoundsSize.cx - else - Size := Self.BoundsSize.cy; - - if PageSize = 0 then - ButtonPos := (Position - Min) * (Size - ButtonSize) div (Max - Min) - else - ButtonPos := (Position - Min) * - (Size - ButtonSize) div (Max - Min - PageSize + 1); - end; - ButtonSize := GetButtonSize; - end; - Redraw; - end; -end; - -procedure TFScrollBarSlider.Paint(Canvas: TFCanvas); -var - Size: Integer; - r: TRect; - StartPos, EndPos: PInteger; - Color2: TColor; -begin - ASSERT(Owner is TFCustomScrollBar); - inherited Paint(Canvas); - - if TFCustomScrollBar(Owner).Orientation = Horizontal then - begin - r.Top := 0; - r.Bottom := Height; - StartPos := @r.Left; - EndPos := @r.Right; - Size := Width; - end else - begin - r.Left := 0; - r.Right := Width; - StartPos := @r.Top; - EndPos := @r.Bottom; - Size := Height; - end; - - if ButtonPos > 0 then - begin - if PrevAreaPressed then - Color2 := cl3DDkShadow - else - Color2 := cl3DLight; - Canvas.SetColor(GetAvgColor(Style.GetUIColor(clScrollBar), - Style.GetUIColor(Color2))); - StartPos^ := 0; - EndPos^ := ButtonPos; - Canvas.FillRect(r); - end; - if ButtonPos + ButtonSize < Size then - begin - if NextAreaPressed then - Color2 := cl3DDkShadow - else - Color2 := cl3DLight; - Canvas.SetColor(GetAvgColor(Style.GetUIColor(clScrollBar), - Style.GetUIColor(Color2))); - StartPos^ := ButtonPos + ButtonSize; - EndPos^ := Size; - Canvas.FillRect(r); - end; - - StartPos^ := ButtonPos; - EndPos^ := ButtonPos + ButtonSize; - Style.DrawButtonFace(Canvas, r, [btnIsEmbedded]); -end; - -function TFScrollBarSlider.ProcessEvent(Event: TEventObj): Boolean; -begin - Result := False; - if Event.InheritsFrom(TMousePressedEventObj) then - Result := EvMousePressed(TMousePressedEventObj(Event)) - else if Event.InheritsFrom(TMouseReleasedEventObj) then - Result := EvMouseReleased(TMouseReleasedEventObj(Event)) - else if Event.InheritsFrom(TMouseMoveEventObj) then - Result := EvMouseMove(TMouseMoveEventObj(Event)); - - if not Result then - Result := inherited ProcessEvent(Event); - - if Event.InheritsFrom(TVisibilityChangeEventObj) and Visible then - UpdateBar; -end; - -function TFScrollBarSlider.EvMousePressed(Event: TMousePressedEventObj): Boolean; -var - Pos: Integer; -begin - Result := inherited ProcessEvent(Event); // For mouse grabbing support - - if Event.Button <> mbLeft then - Exit; //==> - - if TFCustomScrollBar(Owner).Orientation = Horizontal then - Pos := Event.Position.x - else - Pos := Event.Position.y; - - if Pos < ButtonPos then - begin - PrevAreaPressed := True; - TFCustomScrollBar(Owner).PageUp - end - else if Pos > ButtonPos + ButtonSize then - begin - NextAreaPressed := True; - TFCustomScrollBar(Owner).PageDown - end - else - begin - IsDraggingButton := True; - DragStartMousePos := Pos; - DragStarTFButtonPos := ButtonPos; - end; - - Result := True; -end; - -function TFScrollBarSlider.EvMouseReleased(Event: TMouseReleasedEventObj): Boolean; -var - NewPosition: Integer; -begin - Result := inherited ProcessEvent(Event); // For mouse grabbing support - - if Event.Button <> mbLeft then - Exit; //==> - - if IsDraggingButton then - begin - IsDraggingButton := False; - NewPosition := CalcPosition; - if NewPosition <> TFCustomScrollBar(Owner).Position then - begin - if Assigned(TFCustomScrollBar(Owner).OnScroll) then - TFCustomScrollBar(Owner).OnScroll(Owner, NewPosition); - TFCustomScrollBar(Owner).FPosition := NewPosition; - end; - if (NewPosition <> DragStartMousePos) and - Assigned(TFCustomScrollBar(Owner).OnChange) then - TFCustomScrollBar(Owner).OnChange(Self); - UpdateBar; - end - else if PrevAreaPressed then - begin - PrevAreaPressed := False; - Redraw; - end - else if NextAreaPressed then - begin - NextAreaPressed := False; - Redraw; - end; - Result := True; -end; - -function TFScrollBarSlider.EvMouseMove(Event: TMouseMoveEventObj): Boolean; -var - Pos, Size, VirtualPos: Integer; -begin - if IsDraggingButton then - begin -// We can maybe make this a scrollbar option. Reset scrollbar thumb when -// mouse moves out of bounds of scrollbar. For now it is just anoying. -// if wsMouseInside in WidgetState then -// begin - if TFCustomScrollBar(Owner).Orientation = Horizontal then - begin - Pos := Event.Position.x; - Size := Width; - end else - begin - Pos := Event.Position.y; - Size := Height; - end; -// end -// else -// begin -// Pos := DragStartMousePos; -// if TFCustomScrollBar(Owner).Orientation = Horizontal then -// Size := Width -// else -// Size := Height; -// end; { if/else } - - ButtonPos := ClipMinMax(DragStarTFButtonPos + Pos - DragStartMousePos, - 0, Size - ButtonSize); - VirtualPos := CalcPosition; - - if VirtualPos <> TFCustomScrollBar(Owner).Position then - begin - if Assigned(TFCustomScrollBar(Owner).OnScroll) then - TFCustomScrollBar(Owner).OnScroll(Owner, VirtualPos); - TFCustomScrollBar(Owner).FPosition := VirtualPos; - end; - - Redraw; - Result := True - end - else - Result := False; -end; - -procedure TFScrollBarSlider.CalcSizes; -begin - if TFCustomScrollBar(Owner).Orientation = Horizontal then - FDefSize.cx := Style.GetScrollBarBtnSize(Horizontal).cy * 5 - else - FDefSize.cy := Style.GetScrollBarBtnSize(Vertical).cx * 5; -end; - -function TFScrollBarSlider.CalcPosition: Integer; -var - Size: Integer; - lOwner: TFCustomScrollBar; -begin - Assert(Owner is TFCustomScrollBar); - lOwner := TFCustomScrollBar(Owner); - - if lOwner.Orientation = Horizontal then - Size := Width - else - Size := Height; - - if Size = ButtonSize then - lOwner.Position := 0 - else - begin - if lOwner.PageSize = 0 then - Result := ButtonPos * (lOwner.Max - lOwner.Min + 1) - else - Result := ButtonPos * (lOwner.Max - lOwner.Min - lOwner.PageSize + 2); - Result := Result div (Size - ButtonSize); - Result := Result + lOwner.Min; - end; - Result := lOwner.ClipPosition(Result); -end; - - -// ------------------------------------------------------------------- -// TFCustomScrollBar -// ------------------------------------------------------------------- - -constructor TFCustomScrollBar.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - Include(WidgetStyle, wsOpaque); - Embedded := False; - - FMax := 100; - FSmallChange := 1; - - ButtonUp := TFScrollBarButton.Create(Self); - ButtonUp.Name := '_ScrollBarButtonUp'; - TFScrollBarButton(ButtonUp).Direction := arrowLeft; - ButtonUp.Embedded := True; - ButtonUp.CanExpandWidth := False; - ButtonUp.CanExpandHeight := False; - ButtonUp.OnClick := @ButtonUpClick; - ButtonUp.SetEmbeddedParent(Self); - - Slider := TFScrollBarSlider.Create(Self); - Slider.Name := '_ScrollBarSlider'; - Slider.SetEmbeddedParent(Self); - - ButtonDown := TFScrollBarButton.Create(Self); - ButtonDown.Name := '_ScrollBarButtonDown'; - TFScrollBarButton(ButtonDown).Direction := arrowRight; - ButtonDown.Embedded := True; - ButtonDown.CanExpandWidth := False; - ButtonDown.CanExpandHeight := False; - ButtonDown.OnClick := @ButtonDownClick; - ButtonDown.SetEmbeddedParent(Self); -end; - -procedure TFCustomScrollBar.LineUp; -begin - Position := Position - SmallChange; -end; - -procedure TFCustomScrollBar.LineDown; -begin - Position := Position + SmallChange; -end; - -procedure TFCustomScrollBar.PageUp; -var - Diff: Integer; -begin - if LargeChange = 0 then - begin - Diff := (Max - Min + 6) div 10; - if Diff = 0 then - Inc(Diff); - Position := Position - Diff; - end else - Position := Position - LargeChange; -end; - - -procedure TFCustomScrollBar.PageDown; -var - Diff: Integer; -begin - if LargeChange = 0 then - begin - Diff := (Max - Min + 6) div 10; - if Diff = 0 then - Inc(Diff); - Position := Position + Diff; - end else - Position := Position + LargeChange; -end; - - -function TFCustomScrollBar.DistributeEvent(Event: TEventObj): Boolean; -begin - Result := Event.SendToChild(Slider) or Event.SendToChild(ButtonUp) or - Event.SendToChild(ButtonDown); -end; - - -procedure TFCustomScrollBar.Paint(Canvas: TFCanvas); -begin - if not Embedded then - Style.DrawScrollBarBorder(Canvas, Rect(0, 0, Width, Height)); -end; - - -procedure TFCustomScrollBar.CalcSizes; -begin - if Orientation = Horizontal then - begin - FMinSize.cx := ButtonUp.DefSize.cx + Slider.MinSize.cx + ButtonDown.DefSize.cx; - FMinSize.cy := ButtonUp.DefSize.cy; - FDefSize.cx := ButtonUp.DefSize.cx + Slider.DefSize.cx + ButtonDown.DefSize.cx; - FDefSize.cy := ButtonUp.DefSize.cy; - FMaxSize.cx := InfiniteSize; - FMaxSize.cy := ButtonUp.DefSize.cy; - end else - begin - FMinSize.cx := ButtonUp.DefSize.cx; - FMinSize.cy := ButtonUp.DefSize.cy + Slider.MinSize.cy + ButtonDown.DefSize.cy; - FDefSize.cx := ButtonUp.DefSize.cx; - FDefSize.cy := ButtonUp.DefSize.cy + Slider.DefSize.cy + ButtonDown.DefSize.cy; - FMaxSize.cx := ButtonUp.DefSize.cx; - FMaxSize.cy := InfiniteSize; - end; - - if not Embedded then - with Style.GetScrollBarBorders(Orientation) do - begin - Inc(FMinSize.cx, Left + Right); - Inc(FMinSize.cy, Top + Bottom); - FDefSize.cx := Math.Min(DefSize.cx + Left + Right, InfiniteSize); - FDefSize.cy := Math.Min(DefSize.cy + Top + Bottom, InfiniteSize); - FMaxSize.cx := Math.Min(MaxSize.cx + Left + Right, InfiniteSize); - FMaxSize.cy := Math.Min(MaxSize.cy + Top + Bottom, InfiniteSize); - end; -end; - - -procedure TFCustomScrollBar.Resized; -var - r: TRect; -begin - if not Embedded then - with Style.GetScrollBarBorders(Orientation) do - begin - r.Left := Left; - r.Top := Top; - r.Right := Width - Right; - r.Bottom := Height - Bottom; - end - else - begin - r.Left := 0; - r.Top := 0; - r.Right := Width; - r.Bottom := Height; - end; - - with r do - if Orientation = Horizontal then - begin - ButtonUp.SetBounds(TopLeft, Size(ButtonUp.DefSize.cx, Bottom - Top)); - ButtonDown.SetBounds(Point(Right - ButtonDown.DefSize.cx, Top), - Size(ButtonDown.DefSize.cx, Bottom - Top)); - Slider.SetBounds(Point(Left + ButtonUp.DefSize.cx, Top), - Size(Right - Left - ButtonUp.DefSize.cx - ButtonDown.DefSize.cx, - Bottom - Top)); - end - else - begin - ButtonUp.SetBounds(TopLeft, Size(Right - Left, ButtonDown.DefSize.cy)); - ButtonDown.SetBounds(Point(Left, Bottom - ButtonDown.DefSize.cy), - Size(Right - Left, ButtonDown.DefSize.cy)); - Slider.SetBounds(Point(Left, Top + ButtonUp.DefSize.cy), - Size(Right - Left, - Bottom - Top - ButtonUp.DefSize.cy - ButtonDown.DefSize.cy)); - end; - - UpdateBar; -end; - - -procedure TFCustomScrollBar.ButtonUpClick(Sender: TObject); -begin - LineUp; -end; - - -procedure TFCustomScrollBar.ButtonDownClick(Sender: TObject); -begin - LineDown; -end; - - -procedure TFCustomScrollBar.SetOrientation(AOrientation: TOrientation); -begin - if AOrientation <> Orientation then - begin - FOrientation := AOrientation; - if Orientation = Horizontal then - begin - TFScrollBarButton(ButtonUp).Direction := arrowLeft; - TFScrollBarButton(ButtonDown).Direction := arrowRight; - end else - begin - TFScrollBarButton(ButtonUp).Direction := arrowUp; - TFScrollBarButton(ButtonDown).Direction := arrowDown; - end; - end; -end; - - -procedure TFCustomScrollBar.SetMin(AMin: Integer); -begin - if AMin <> FMin then - begin - FMin := AMin; - Position := Position; // Do range clipping - UpdateBar; - end; -end; - - -procedure TFCustomScrollBar.SetMax(AMax: Integer); -begin - if AMax <> FMax then - begin - FMax := AMax; - Position := Position; // Do range clipping - UpdateBar; - end; -end; - - -procedure TFCustomScrollBar.SetPageSize(APageSize: Integer); -begin - if FPageSize <> APageSize then - begin - FPageSize := APageSize; - Position := Position; // Do range clipping - UpdateBar; - end; -end; - - -procedure TFCustomScrollBar.SetPosition(APosition: Integer); -begin - APosition := ClipPosition(APosition); - - if (APosition <> Position) and Assigned(OnScroll) then - OnScroll(Self, APosition); - - if APosition <> Position then - begin - FPosition := APosition; - UpdateBar; - if Assigned(OnChange) then - OnChange(Self); - end; -end; - - -function TFCustomScrollBar.GetButtonSize: Integer; -var - Size: Integer; -begin - if PageSize = 0 then - if Orientation = Horizontal then - Result := Height - else - Result := Width - else - begin - if Orientation = Horizontal then - Size := Slider.Width - else - Size := Slider.Height; - Result := Math.Max(Style.GetScrollBarBtnMinSize, - PageSize * Size div Math.Max(1, Max - Min + 1)); - if Result > Size then - Result := Size; - end; -end; - - -function TFCustomScrollBar.ClipPosition(APosition: Integer): Integer; -begin - if APosition > (Max - PageSize) then - begin - if PageSize = 0 then - Result := Max - else - Result := Max - PageSize + 1; - end - else - Result := APosition; - if Result < Min then - Result := Min; -end; - - -procedure TFCustomScrollBar.UpdateBar; -begin - if Embedded then - Visible := (Max > Min) and ((PageSize = 0) or (PageSize <= Max - Min)); - TFScrollBarSlider(Slider).UpdateBar; -end; - - -{$ENDIF read_implementation} - diff --git a/gui/fpguiscrollbox.inc b/gui/fpguiscrollbox.inc deleted file mode 100644 index d374da10..00000000 --- a/gui/fpguiscrollbox.inc +++ /dev/null @@ -1,428 +0,0 @@ -{ - fpGUI - Free Pascal GUI Library - - ScrollBox class declarations - - Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this - distribution, for details of the copyright. - - See the file COPYING.modifiedLGPL, included in this distribution, - for details about redistributing fpGUI. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -} - -{%mainunit fpgui.pas} - -{ Scrolling support implementation } - -{$IFDEF read_interface} - - TScrollingSupport = class - private - Parent: TFWidget; - FBorders: TRect; - FClientRect: TRect; - FVirtualSize: TSize; - FHorzScrollBar, FVertScrollBar: TFScrollBar; - FOnClientRectChange: TNotifyEvent; - function EvMouseWheel(Event: TMouseWheelEventObj): Boolean; - procedure EvKeyPressed(Key: Word; Shift: TShiftState); - protected - public - constructor Create(AParent: TFWidget); - destructor Destroy; override; - function ProcessEvent(Event: TEventObj): Boolean; - function DistributeEvent(Event: TEventObj): Boolean; - function SendToChild(AChild: TFWidget; Event: TEventObj): Boolean; - procedure CalcSizes; - procedure Resized; - function CalcClientSize(AHorzBarVisible, AVertBarVisible: Boolean): TSize; - procedure SetVirtualSize(const ASize: TSize); - function ScrollPos: TPoint; - procedure DefHorzScrollHandler(Sender: TObject; var APosition: Integer); - procedure DefVertScrollHandler(Sender: TObject; var APosition: Integer); - property Borders: TRect read FBorders; - property ClientRect: TRect read FClientRect; - property HorzScrollBar: TFScrollBar read FHorzScrollBar; - property VertScrollBar: TFScrollBar read FVertScrollBar; - property OnClientRectChange: TNotifyEvent read FOnClientRectChange write FOnClientRectChange; - end; - - - TFCustomScrollBox = class(TFWidget) - protected - ScrollingSupport: TScrollingSupport; - procedure Paint(Canvas: TFCanvas); override; - function ProcessEvent(Event: TEventObj): Boolean; override; - function DistributeEvent(Event: TEventObj): Boolean; override; - procedure CalcSizes; override; - procedure Resized; override; - public - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - end; - - - TFScrollBox = class(TFCustomScrollBox) - end; - -{$ENDIF read_interface} - - - -{$IFDEF read_implementation} - -// =================================================================== -// TScrollingSupport -// =================================================================== - -constructor TScrollingSupport.Create(AParent: TFWidget); -begin - Parent := AParent; - - FHorzScrollBar := TFScrollBar.Create(Parent); - HorzScrollBar.Name := '_Scrolling_HorzBar'; - HorzScrollBar.Embedded := True; - HorzScrollBar.SetEmbeddedParent(Parent); - - FVertScrollBar := TFScrollBar.Create(Parent); - VertScrollBar.Name := '_Scrolling_VertBar'; - VertScrollBar.Orientation := Vertical; - VertScrollBar.Embedded := True; - VertScrollBar.SetEmbeddedParent(Parent); -end; - -destructor TScrollingSupport.Destroy; -begin - inherited Destroy; -end; - -function TScrollingSupport.ProcessEvent(Event: TEventObj): Boolean; -var - HorzScrollBarHeight, VertScrollBarWidth: Integer; - Canvas: TFCanvas; -begin - if Event.InheritsFrom(TPaintEventObj) then - begin - if HorzScrollBar.Visible then - HorzScrollBarHeight := HorzScrollBar.MinSize.cy - else - HorzScrollBarHeight := 0; - - if VertScrollBar.Visible then - VertScrollBarWidth := VertScrollBar.MinSize.cx - else - VertScrollBarWidth := 0; - - Canvas := TPaintEventObj(Event).Canvas; - Parent.Style.DrawScrollBoxBorder(Canvas, - Rect(0, 0, Parent.Width, Parent.Height)); - Parent.Style.DrawWindowBackground(Canvas, Rect(VertScrollBar.Left, - HorzScrollBar.Top, VertScrollBar.Left + VertScrollBarWidth, - HorzScrollBar.Top + HorzScrollBarHeight)); - Result := False; - end else if Event.InheritsFrom(TMouseWheelEventObj) then - Result := EvMouseWheel(TMouseWheelEventObj(Event)) - else if Event.InheritsFrom(TMouseWheelEventObj) then - Result := EvMouseWheel(TMouseWheelEventObj(Event)) - else - Result := False; -end; - -function TScrollingSupport.DistributeEvent(Event: TEventObj): Boolean; -begin - Result := Event.SendToChild(HorzScrollBar) or - Event.SendToChild(VertScrollBar); -end; - -function TScrollingSupport.SendToChild(AChild: TFWidget; - Event: TEventObj): Boolean; -var - Canvas: TFCanvas; - OldMatrix: TGfxMatrix; -begin - if Event.InheritsFrom(TPreparePaintEventObj) then - begin - Canvas := TPaintEventObj(Event).Canvas; - OldMatrix := Canvas.Matrix; - Canvas.AppendTranslation(Point(ClientRect.Left - HorzScrollBar.Position, - ClientRect.Top - VertScrollBar.Position)); - Result := Event.SendToChild(AChild); - Canvas.Matrix := OldMatrix; - end else if Event.InheritsFrom(TPaintEventObj) then - begin - Canvas := TPaintEventObj(Event).Canvas; - Canvas.SaveState; - try - Canvas.AppendTranslation(Point(-HorzScrollBar.Position, -VertScrollBar.Position)); - if Canvas.IntersectClipRect(ClientRect) {and Canvas.IntersectClipRect( - Rect(AChild.Left + ClientRect.Left, AChild.Top + ClientRect.Top, - AChild.Left + AChild.Width + ClientRect.Left, - AChild.Top + AChild.Height + ClientRect.Top))} then - begin - {Canvas.AppendTranslation(AChild.Left + ClientRect.Left, - AChild.Top + ClientRect.Top); - Inc(Event.RefCount); - Result := AChild.SendEvent(Event);} - Canvas.AppendTranslation(ClientRect.TopLeft); - Result := Event.SendToChild(AChild); - end else - Result := False; - finally - Canvas.RestoreState; - end; - end else - Result := Event.SendToChild(AChild); -end; - -procedure TScrollingSupport.CalcSizes; -begin - FBorders := Parent.Style.GetScrollBoxBorders; - with Parent, Borders do - begin - FMinSize := HorzScrollBar.MinSize + VertScrollBar.MinSize + - TopLeft + BottomRight; - FDefSize := HorzScrollBar.DefSize + VertScrollBar.DefSize + - TopLeft + BottomRight; - end; -end; - -procedure TScrollingSupport.Resized; -var - HorzScrollBarHeight, VertScrollBarWidth: Integer; - - procedure CalcScrollBarSizes; - begin - if HorzScrollBar.Visible then - HorzScrollBarHeight := HorzScrollBar.MinSize.cy - else - HorzScrollBarHeight := 0; - - if VertScrollBar.Visible then - VertScrollBarWidth := VertScrollBar.MinSize.cx - else - VertScrollBarWidth := 0; - end; - -var - Canvas: TFCanvas; - HorzBarVisible, VertBarVisible, - LastHorzBarVisible, LastVertBarVisible: Boolean; -begin - HorzBarVisible := HorzScrollBar.Visible; - VertBarVisible := VertScrollBar.Visible; - LastHorzBarVisible := not HorzBarVisible; - - if FVirtualSize <> gfxbase.Size(0, 0) then - with Size(ClientRect) do - begin - HorzScrollBar.PageSize := cx; - VertScrollBar.PageSize := cy; - end; - - FBorders := Parent.Style.GetScrollBoxBorders; - with FBorders do - begin - while (HorzBarVisible <> LastHorzBarVisible) or - (VertBarVisible <> LastVertBarVisible) do - begin - LastHorzBarVisible := HorzBarVisible; - LastVertBarVisible := VertBarVisible; - CalcScrollBarSizes; - HorzScrollBar.SetBounds( - Point(Left, Parent.Height - HorzScrollBar.MinSize.cy - Bottom), - Size(Parent.Width - VertScrollBarWidth - Left - Right, HorzScrollBar.MinSize.cy)); - VertScrollBar.SetBounds( - Point(Parent.Width - VertScrollBar.MinSize.cx - Right, Top), - Size(VertScrollBar.MinSize.cx, Parent.Height - HorzScrollBarHeight - Top - Bottom)); - - ClientRect.Left := Left; - ClientRect.Top := Top; - ClientRect.Right := Parent.Width - Right - VertScrollBarWidth; - ClientRect.Bottom := Parent.Height - Bottom - HorzScrollBarHeight; - if Assigned(OnClientRectChange) then - OnClientRectChange(Self); - - HorzBarVisible := HorzScrollBar.Visible; - VertBarVisible := VertScrollBar.Visible; - end; - end; -end; - -function TScrollingSupport.CalcClientSize(AHorzBarVisible, - AVertBarVisible: Boolean): TSize; -begin - FBorders := Parent.Style.GetScrollBoxBorders; - Result := Parent.BoundsSize - Borders.TopLeft - Borders.BottomRight; - if AVertBarVisible then - Dec(Result.cx, VertScrollBar.MinSize.cx); - if AHorzBarVisible then - Dec(Result.cy, HorzScrollBar.MinSize.cy); -end; - -procedure TScrollingSupport.SetVirtualSize(const ASize: TSize); -begin - FVirtualSize := ASize; - HorzScrollBar.Max := FVirtualSize.cx; - VertScrollBar.Max := FVirtualSize.cy; -end; - -function TScrollingSupport.ScrollPos: TPoint; -begin - Result.x := HorzScrollBar.Position; - Result.y := VertScrollBar.Position; -end; - -procedure TScrollingSupport.DefHorzScrollHandler(Sender: TObject; var APosition: Integer); -var - Delta: Integer; - r: TRect; -begin - Delta := HorzScrollBar.Position - APosition; - r := ClientRect; - if Delta < 0 then // Scrolling to the right side - Dec(r.Left, Delta) - else // Scrolling to the left side - Dec(r.Right, Delta); - Parent.Scroll(r, Delta, 0); -end; - -procedure TScrollingSupport.DefVertScrollHandler(Sender: TObject; - var APosition: Integer); -var - Delta: Integer; - r: TRect; -begin - Delta := VertScrollBar.Position - APosition; - r := ClientRect; - if Delta < 0 then // Scrolling downwards - Dec(r.Top, Delta) - else // Scrolling upwards - Dec(r.Bottom, Delta); - Parent.Scroll(r, 0, Delta); -end; - -function TScrollingSupport.EvMouseWheel(Event: TMouseWheelEventObj): Boolean; -var - mshift: TShiftState; -begin - if Parent.DistributeEvent(Event) then - Exit; //==> - - mshift := Event.Shift * [ssShift, ssAlt, ssCtrl, ssMeta, - ssSuper, ssHyper, ssAltGr]; - - if not VertScrollBar.Visible then - Include(mshift, ssShift); - - if mshift = [] then - VertScrollBar.Position := VertScrollBar.Position + - Round(Event.WheelDelta * VertScrollBar.SmallChange) - else if mshift = [ssShift] then - HorzScrollBar.Position := HorzScrollBar.Position + - Round(Event.WheelDelta * VertScrollBar.SmallChange); - Result := True; -end; - -procedure TScrollingSupport.EvKeyPressed(Key: Word; Shift: TShiftState); -var - mshift: TShiftState; -begin -{ - mshift := Shift * [ssShift, ssAlt, ssCtrl, ssMeta, ssSuper, ssHyper, ssAltGr]; - if mshift = [] then - case Key of - keyLeft: - HorzScrollBar.ButtonUpClick(nil); - keyRight: - HorzScrollBar.ButtonDownClick(nil); - keyUp: - VertScrollBar.ButtonUpClick(nil); - keyDown: - VertScrollBar.ButtonDownClick(nil); - keyPageUp: - VertScrollBar.PageUp; - keyPageDown: - VertScrollBar.PageDown; - keyHome: - VertScrollBar.Position := 0; - keyEnd: - VertScrollBar.Position := VertScrollBar.Max - VertScrollBar.PageSize; - end - else if mshift = [ssShift] then - case Key of - keyPageUp: - HorzScrollBar.PageUp; - keyPageDown: - HorzScrollBar.PageDown; - keyHome: - HorzScrollBar.Position := 0; - keyEnd: - HorzScrollBar.Position := HorzScrollBar.Max - HorzScrollBar.PageSize; - end - else - inherited EvKeyPressed(Key, Shift); -} -end; - - - -// =================================================================== -// TFCustomScrollBox -// =================================================================== - -constructor TFCustomScrollBox.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - WidgetStyle := WidgetStyle + [wsClickable, wsOpaque]; - FCanExpandWidth := True; - FCanExpandHeight := True; - ScrollingSupport := TScrollingSupport.Create(Self); -end; - -destructor TFCustomScrollBox.Destroy; -begin - ScrollingSupport.Free; - inherited Destroy; -end; - - -// Protected methods - -procedure TFCustomScrollBox.Paint(Canvas: TFCanvas); -begin - Assert(Canvas = Canvas); -{ - Style.DrawWindowBackground(Canvas, Rect(HorzScrollBar.Left, - VertScrollBar.Top, HorzScrollBar.Left + HorzScrollBar.Width, - VertScrollBar.Top + VertScrollBar.Height));} -end; - -function TFCustomScrollBox.ProcessEvent(Event: TEventObj): Boolean; -begin - Result := ScrollingSupport.ProcessEvent(Event) or - inherited ProcessEvent(Event); -end; - -function TFCustomScrollBox.DistributeEvent(Event: TEventObj): Boolean; -begin - Result := ScrollingSupport.DistributeEvent(Event) or - inherited DistributeEvent(Event); -end; - -procedure TFCustomScrollBox.CalcSizes; -begin - ScrollingSupport.CalcSizes; -end; - -procedure TFCustomScrollBox.Resized; -begin - ScrollingSupport.Resized; -end; - - -{$ENDIF read_implementation} - diff --git a/gui/fpguiseparator.inc b/gui/fpguiseparator.inc deleted file mode 100644 index d415956d..00000000 --- a/gui/fpguiseparator.inc +++ /dev/null @@ -1,103 +0,0 @@ -{ - fpGUI - Free Pascal GUI Library - - Separator class declarations - - Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this - distribution, for details of the copyright. - - See the file COPYING.modifiedLGPL, included in this distribution, - for details about redistributing fpGUI. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -} - -{%mainunit fpgui.pas} - -{$IFDEF read_interface} - - TCustomSeparator = class(TFWidget) - private - procedure SetOrientation(AOrientation: TOrientation); - procedure SetSpacing(ASpacing: Integer); - protected - FOrientation: TOrientation; - FSpacing: Integer; - procedure Paint(Canvas: TFCanvas); override; - procedure CalcSizes; override; - property Orientation: TOrientation read FOrientation write SetOrientation default Horizontal; - property Spacing: Integer read FSpacing write SetSpacing default 4; - public - constructor Create(AOwner: TComponent); override; - end; - - - TSeparator = class(TCustomSeparator) - published - property Enabled; - property Orientation; - property Spacing; - end; - -{$ENDIF read_interface} - - - -{$IFDEF read_implementation} - - - -// =================================================================== -// TCustomSeparator -// =================================================================== - -constructor TCustomSeparator.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - FCanExpandWidth := True; - FSpacing := 4; -end; - -procedure TCustomSeparator.Paint(Canvas: TFCanvas); -begin - Style.DrawSeparator(Canvas, Rect(0, 0, Width, Height), Orientation); -end; - -procedure TCustomSeparator.CalcSizes; -begin - if Orientation = Horizontal then - begin - FCanExpandWidth := True; - FCanExpandHeight := False; - FMinSize.cy := Style.GetSeparatorSize + 2 * Spacing - end else - begin - FCanExpandWidth := False; - FCanExpandHeight := True; - FMinSize.cx := Style.GetSeparatorSize + 2 * Spacing; - end; -end; - -procedure TCustomSeparator.SetOrientation(AOrientation: TOrientation); -begin - if AOrientation <> Orientation then - begin - FOrientation := AOrientation; - Update; - end; -end; - -procedure TCustomSeparator.SetSpacing(ASpacing: Integer); -begin - if ASpacing <> Spacing then - begin - FSpacing := ASpacing; - Update; - end; -end; - - -{$ENDIF read_implementation} - diff --git a/gui/fpguistyle.inc b/gui/fpguistyle.inc deleted file mode 100644 index 991c85b5..00000000 --- a/gui/fpguistyle.inc +++ /dev/null @@ -1,834 +0,0 @@ -{ - fpGUI - Free Pascal GUI Library - - Style class declarations - - Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this - distribution, for details of the copyright. - - See the file COPYING.modifiedLGPL, included in this distribution, - for details about redistributing fpGUI. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -} - -{%mainunit fpgui.pas} - -{ - Default style implementation -} - -{$IFDEF read_interface} - - { Possible styles } - TItemFlags = set of (ifFocused, ifSelected, ifDeactivated); - - { Possible arrow directions } - TArrowDirection = (arrowUp, arrowDown, arrowLeft, arrowRight); - - { Abstract Style declarations } - TStyleAbs = class(TObject) - protected - UIColorCache: array[0..$18] of TGfxColor; - public - constructor Create; virtual; - // Colors - procedure UpdateUIColorCache; - function GetGUIColor(Color: TColor): TGfxColor; virtual; abstract; - function GetUIColor(AColor: TColor): TGfxColor; - procedure SetUIColor(Canvas: TFCanvas; Color: TColor); - // General - procedure DrawText(Canvas: TFCanvas; const APosition: TPoint; const AText: String; State: TFWidgetState); virtual; abstract; - procedure DrawItemBefore(Canvas: TFCanvas; const ARect: TRect; Flags: TItemFlags); virtual; abstract; - procedure DrawItemAfter(Canvas: TFCanvas; const ARect: TRect; Flags: TItemFlags); virtual; abstract; - procedure Draw3DFrame(Canvas: TFCanvas; const ARect: TRect; Color1, Color2, Color3, Color4: TColor); virtual; abstract; - procedure DrawFocusRect(Canvas: TFCanvas; const ARect: TRect); virtual; abstract; - procedure DrawSunkenOuterBorder(Canvas: TFCanvas; const ARect: TRect); virtual; abstract; - procedure DrawRaisedOuterBorder(Canvas: TFCanvas; const ARect: TRect); virtual; abstract; - // Windows - procedure DrawWindowBackground(Canvas: TFCanvas; const ARect: TRect); virtual; abstract; - // Buttons - procedure DrawButtonFace(Canvas: TFCanvas; const ARect: TRect; Flags: TFButtonFlags); virtual; abstract; - function GetButtonBorders: TRect; virtual; abstract; - // Separators - function GetSeparatorSize: Integer; virtual; abstract; - procedure DrawSeparator(Canvas: TFCanvas; const ARect: TRect; AOrientation: TOrientation); virtual; abstract; - // Group boxes - procedure DrawGroupBox(Canvas: TFCanvas; const ARect: TRect; const ALabel: String; WidgetState: TFWidgetState); virtual; abstract; - function GetGroupBoxBorders(Canvas: TFCanvas; const ALabel: String; var LabelWidth: Integer): TRect; virtual; abstract; - // Edit widgets - procedure DrawEditBox(Canvas: TFCanvas; const ARect: TRect; const IsReadOnly: Boolean = False); virtual; abstract; - function GetEditBoxBorders: TRect; virtual; abstract; - // Check boxes - procedure DrawCheckBox(Canvas: TFCanvas; const ARect, LabelRect: TRect; Flags: TFCheckboxFlags); virtual; abstract; - procedure GetCheckboxLayout(const LabelSize: TSize; var TotalSize: TSize; var LabelPos: TPoint); virtual; abstract; - // Radio buttons - procedure DrawRadioButton(Canvas: TFCanvas; const ARect, LabelRect: TRect; Flags: TFCheckboxFlags); virtual; abstract; - procedure GetRadioButtonLayout(const LabelSize: TSize; var TotalSize: TSize; var LabelPos: TPoint); virtual; abstract; - // Combo boxes - function GetComboBoxArrowSize: TSize; virtual; abstract; - procedure DrawComboBoxArrow(Canvas: TFCanvas; const ARect: TRect; IsPressed, IsEnabled: Boolean); virtual; abstract; - function GetComboBoxBtnSize: TSize; virtual; abstract; - // Scroll bars - function GetScrollBarBorders(Orientation: TOrientation): TRect; virtual; abstract; - function GetScrollBarBtnSize(Orientation: TOrientation): TSize; virtual; abstract; - function GetScrollBarBtnMinSize: Integer; virtual; abstract; - procedure DrawScrollBarBorder(Canvas: TFCanvas; const ARect: TRect); virtual; abstract; - procedure DrawScrollBarButton(Canvas: TFCanvas; const ARect: TRect; Direction: TArrowDirection; IsPressed, IsEnabled: Boolean); virtual; abstract; - // Scroll boxes - function GetScrollBoxBorders: TRect; virtual; abstract; - procedure DrawScrollBoxBorder(Canvas: TFCanvas; const ARect: TRect); virtual; abstract; - // Menus - function GetMenuBorders(pCanvas: TFCanvas; const pText: string; var pTextWidth: Integer): TRect; virtual; abstract; - // Panel/Frame - function GetPanelBorders: TRect; virtual; abstract; - procedure DrawPanel(Canvas: TFCanvas; const ARect: TRect; ABevelStyle: TBevelStyle); virtual; abstract; - end; - - - { TDefaultStyle } - - TBasicStyle = class(TStyleAbs) - private - FImageCanvas: TFCanvas; - FMaskCanvas: TFCanvas; - protected - procedure DrawDirectionArrows(ACanvas: TFCanvas; const ARect: TRect; ADirection: TArrowDirection); - procedure DrawCheckBoxCheck(ACanvas: TFCanvas; const ARect: TRect; AFlags: TFCheckboxFlags); - public - constructor Create; override; - destructor Destroy; override; - // Colors - function GetGUIColor(Color: TColor): TGfxColor; override; - // General - procedure DrawText(Canvas: TFCanvas; const APosition: TPoint; const AText: String; State: TFWidgetState); override; - procedure DrawItemBefore(Canvas: TFCanvas; const ARect: TRect; Flags: TItemFlags); override; - procedure DrawItemAfter(Canvas: TFCanvas; const ARect: TRect; Flags: TItemFlags); override; - procedure Draw3DFrame(Canvas: TFCanvas; const ARect: TRect; Color1, Color2, Color3, Color4: TColor); override; - procedure DrawFocusRect(Canvas: TFCanvas; const ARect: TRect); override; - procedure DrawSunkenOuterBorder(Canvas: TFCanvas; const ARect: TRect); override; - procedure DrawRaisedOuterBorder(Canvas: TFCanvas; const ARect: TRect); override; - // Windows - procedure DrawWindowBackground(Canvas: TFCanvas; const ARect: TRect); override; - // Buttons - procedure DrawButtonFace(Canvas: TFCanvas; const ARect: TRect; Flags: TFButtonFlags); override; - function GetButtonBorders: TRect; override; - // Separators - procedure DrawSeparator(Canvas: TFCanvas; const ARect: TRect; AOrientation: TOrientation); override; - function GetSeparatorSize: Integer; override; - // Group boxes - procedure DrawGroupBox(Canvas: TFCanvas; const ARect: TRect; const ALabel: String; WidgetState: TFWidgetState); override; - function GetGroupBoxBorders(Canvas: TFCanvas; const ALabel: String; var LabelWidth: Integer): TRect; override; - // Edit widgets - procedure DrawEditBox(Canvas: TFCanvas; const ARect: TRect; const IsReadOnly: Boolean = False); override; - function GetEditBoxBorders: TRect; override; - // Check boxes - procedure DrawCheckBox(Canvas: TFCanvas; const ARect, LabelRect: TRect; Flags: TFCheckboxFlags); override; - procedure GetCheckboxLayout(const LabelSize: TSize; var TotalSize: TSize; var LabelPos: TPoint); override; - // Radio buttons - procedure DrawRadioButton(Canvas: TFCanvas; const ARect, LabelRect: TRect; Flags: TFCheckboxFlags); override; - procedure GetRadioButtonLayout(const LabelSize: TSize; var TotalSize: TSize; var LabelPos: TPoint); override; - // Combo boxes - procedure DrawComboBoxArrow(Canvas: TFCanvas; const ARect: TRect; IsPressed, IsEnabled: Boolean); override; - function GetComboBoxArrowSize: TSize; override; - function GetComboBoxBtnSize: TSize; override; - // Scroll bars - function GetScrollBarBorders(Orientation: TOrientation): TRect; override; - function GetScrollBarBtnSize(Orientation: TOrientation): TSize; override; - function GetScrollBarBtnMinSize: Integer; override; - procedure DrawScrollBarBorder(Canvas: TFCanvas; const ARect: TRect); override; - procedure DrawScrollBarButton(Canvas: TFCanvas; const ARect: TRect; Direction: TArrowDirection; IsPressed, IsEnabled: Boolean); override; - // Scroll boxes - function GetScrollBoxBorders: TRect; override; - procedure DrawScrollBoxBorder(Canvas: TFCanvas; const ARect: TRect); override; - // Menus - function GetMenuBorders(pCanvas: TFCanvas; const pText: string; var pTextWidth: Integer): TRect; override; - // Panel/Frame - function GetPanelBorders: TRect; override; - procedure DrawPanel(Canvas: TFCanvas; const ARect: TRect; ABevelStyle: TBevelStyle); override; - end; - - -{$ENDIF read_interface} - - - -{$IFDEF read_implementation} - - -{ TStyleAbs } - -constructor TStyleAbs.Create; -begin - inherited Create; - UpdateUIColorCache; -end; - - -procedure TStyleAbs.UpdateUIColorCache; -var - i: TColor; -begin - for i := 0 to $18 do - UIColorCache[i] := GetGUIColor(TColor(i + clScrollBar)); -end; - - -function TStyleAbs.GetUIColor(AColor: TColor): TGfxColor; -begin - if (AColor >= clScrollBar) and (AColor <= clScrollBar + $18) then - Result := UIColorCache[TColor(AColor - clScrollBar)] - else - begin -// Result := colBlack; - Result.Red := (AColor and $ff) * 257; - Result.Green := ((AColor shr 8) and $ff) * 257; - Result.Blue := ((AColor shr 16) and $ff) * 257; - Result.Alpha := 0; - end; -end; - - -procedure TStyleAbs.SetUIColor(Canvas: TFCanvas; Color: TColor); -var - lGfxColor: TGfxColor; -begin - if (Color >= clScrollBar) and (Color <= clScrollBar + $18) then - Canvas.SetColor(UIColorCache[TColor(Color - clScrollBar)]) - else - begin - lGfxColor.Red := (Color and $ff) * 257; - lGfxColor.Green := ((Color shr 8) and $ff) * 257; - lGfxColor.Blue := ((Color shr 16) and $ff) * 257; - lGfxColor.Alpha := 0; - Canvas.SetColor(lGfxColor); - end; -end; - - -{ TBasicStyle } - -const - rgbaDkWhite: TGfxColor = (Red: $e000; Green: $e000; Blue: $e000; Alpha: 0); - - -{ This gets platform specific colors and focus rectangle styles } -{$IFDEF MSWINDOWS} - {$I win32/defstyle.inc} -{$ENDIF} -{$IFDEF UNIX} - {$I defimpl/defstyle.inc} -{$ENDIF} - -procedure TBasicStyle.DrawDirectionArrows(ACanvas: TFCanvas; - const ARect: TRect; ADirection: TArrowDirection); -var - peekx, peeky: Cardinal; - basex, basey: Cardinal; - side, margin: Cardinal; -begin - side := (ARect.Right div 4) + 1; - margin := side; - - if ADirection in [arrowUp, arrowDown] then - begin - peekx := ARect.Left+(ARect.Right div 2); - if ADirection = arrowDown then - begin - peeky := ARect.Top + ARect.Bottom - margin; - basey := peeky-side; - end - else - begin // up - peeky := ARect.Top+margin; - basey := peeky+side; - end; - LAYOUTTRACE('Triangle Points (%d,%d)(%d,%d)(%d,%d)', - [peekx, peeky, peekx+side, basey, peekx-side, basey]); - - ACanvas.FillTriangle(Point(peekx, peeky), Point(peekx+side, basey), Point(peekx-side, basey)); - end - else // horizontal - begin - peeky := ARect.Top + (ARect.Bottom div 2); - if ADirection = arrowRight then - begin - peekx := ARect.Left + ARect.Right - margin; - basex := peekx - side; - end - else // left - begin - peekx := ARect.Left + margin; - basex := peekx + side; - end; - LAYOUTTRACE('Triangle Points (%d,%d)(%d,%d)(%d,%d)', - [peekx, peeky, basex, peeky-side, basex, peeky+side]); - ACanvas.FillTriangle(Point(peekx, peeky), Point(basex, peeky-side), Point(basex, peeky+side)); - end; -end; - -procedure TBasicStyle.DrawCheckBoxCheck(ACanvas: TFCanvas; - const ARect: TRect; AFlags: TFCheckboxFlags); -begin - if (cbIsEnabled in AFlags) then - SetUIColor(ACanvas, clBtnText) - else - SetUIColor(ACanvas, cl3DShadow); - - {$Note As soon as canvas supports a Pen, we need to set the PenWidth} - if (cbIsChecked in AFlags) then - begin - ACanvas.DrawLine(Point(ARect.Left+1, ARect.Top+1), Point(ARect.Right, ARect.Bottom)); - ACanvas.DrawLine(Point(ARect.Left+2, ARect.Top+1), Point(ARect.Right, ARect.Bottom-1)); - ACanvas.DrawLine(Point(ARect.Left+1, ARect.Top+2), Point(ARect.Right-1, ARect.Bottom)); - - ACanvas.DrawLine(Point(ARect.Right-1, ARect.Top+1), Point(ARect.Left, ARect.Bottom)); - ACanvas.DrawLine(Point(ARect.Right-2, ARect.Top+1), Point(ARect.Left, ARect.Bottom-1)); - ACanvas.DrawLine(Point(ARect.Right-1, ARect.Top+2), Point(ARect.Left+1, ARect.Bottom)); - end; -end; - -constructor TBasicStyle.Create; -const - // 60x12 pixel 4bpp bitmap - RadioBitmapData: array[0..359] of Byte = ( - $00, $00, $22, $22, $00, $00, $00, $00, $22, $22, $00, $00, $00, $00, $22, $22, $00, $00, $00, $00, $22, $22, $00, $00, $00, $00, $22, $22, $00, $00, - $00, $22, $11, $11, $22, $00, $00, $22, $11, $11, $22, $00, $00, $22, $11, $11, $22, $00, $00, $22, $11, $11, $22, $00, $00, $22, $11, $11, $22, $00, - $02, $11, $77, $77, $11, $50, $02, $11, $77, $77, $11, $50, $02, $11, $33, $33, $11, $50, $02, $11, $33, $33, $11, $50, $02, $11, $33, $33, $11, $50, - $02, $17, $77, $77, $74, $50, $02, $17, $77, $77, $74, $50, $02, $13, $33, $33, $34, $50, $02, $13, $33, $33, $34, $50, $02, $13, $33, $33, $34, $50, - $21, $77, $77, $77, $77, $45, $21, $77, $76, $67, $77, $45, $21, $33, $33, $33, $33, $45, $21, $33, $36, $63, $33, $45, $21, $33, $32, $23, $33, $45, - $21, $77, $77, $77, $77, $45, $21, $77, $66, $66, $77, $45, $21, $33, $33, $33, $33, $45, $21, $33, $66, $66, $33, $45, $21, $33, $22, $22, $33, $45, - $21, $77, $77, $77, $77, $45, $21, $77, $66, $66, $77, $45, $21, $33, $33, $33, $33, $45, $21, $33, $66, $66, $33, $45, $21, $33, $22, $22, $33, $45, - $21, $77, $77, $77, $77, $45, $21, $77, $76, $67, $77, $45, $21, $33, $33, $33, $33, $45, $21, $33, $36, $63, $33, $45, $21, $33, $32, $23, $33, $45, - $02, $17, $77, $77, $74, $50, $02, $17, $77, $77, $74, $50, $02, $13, $33, $33, $34, $50, $02, $13, $33, $33, $34, $50, $02, $13, $33, $33, $34, $50, - $02, $44, $77, $77, $44, $50, $02, $44, $77, $77, $44, $50, $02, $44, $33, $33, $44, $50, $02, $44, $33, $33, $44, $50, $02, $44, $33, $33, $44, $50, - $00, $55, $44, $44, $55, $00, $00, $55, $44, $44, $55, $00, $00, $55, $44, $44, $55, $00, $00, $55, $44, $44, $55, $00, $00, $55, $44, $44, $55, $00, - $00, $00, $55, $55, $00, $00, $00, $00, $55, $55, $00, $00, $00, $00, $55, $55, $00, $00, $00, $00, $55, $55, $00, $00, $00, $00, $55, $55, $00, $00 - ); - - // 12x12 pixel monochrome bitmap - RadioMaskData: array[0..23] of Byte = ($0f, $00, $3f, $c0, $7f, $e0, $7f, - $e0, $ff, $f0, $ff, $f0, $ff, $f0, $ff, $f0, $7f, $e0, $7f, $e0, $3f, $c0, - $0f, $00); - - // 65x13 pixel 4bpp bitmap - CheckBoxBitmapData: array[0..428] of Byte = ( - $22, $22, $22, $22, $22, $22, $52, $22, $22, $22, $22, $22, $25, $22, $22, $22, $22, $22, $22, $52, $22, $22, $22, $22, $22, $25, $22, $22, $22, $22, $22, $22, $50, - $21, $11, $11, $11, $11, $14, $52, $11, $11, $11, $11, $11, $45, $21, $11, $11, $11, $11, $14, $52, $11, $11, $11, $11, $11, $45, $21, $11, $11, $11, $11, $14, $50, - $21, $77, $77, $77, $77, $74, $52, $17, $77, $77, $77, $77, $45, $21, $33, $33, $33, $33, $34, $52, $13, $33, $33, $33, $33, $45, $21, $33, $33, $33, $33, $34, $50, - $21, $77, $77, $77, $77, $74, $52, $17, $77, $77, $77, $67, $45, $21, $33, $33, $33, $33, $34, $52, $13, $33, $33, $33, $63, $45, $21, $33, $33, $33, $32, $34, $50, - $21, $77, $77, $77, $77, $74, $52, $17, $77, $77, $76, $67, $45, $21, $33, $33, $33, $33, $34, $52, $13, $33, $33, $36, $63, $45, $21, $33, $33, $33, $22, $34, $50, - $21, $77, $77, $77, $77, $74, $52, $17, $67, $77, $66, $67, $45, $21, $33, $33, $33, $33, $34, $52, $13, $63, $33, $66, $63, $45, $21, $32, $33, $32, $22, $34, $50, - $21, $77, $77, $77, $77, $74, $52, $17, $66, $76, $66, $77, $45, $21, $33, $33, $33, $33, $34, $52, $13, $66, $36, $66, $33, $45, $21, $32, $23, $22, $23, $34, $50, - $21, $77, $77, $77, $77, $74, $52, $17, $66, $66, $67, $77, $45, $21, $33, $33, $33, $33, $34, $52, $13, $66, $66, $63, $33, $45, $21, $32, $22, $22, $33, $34, $50, - $21, $77, $77, $77, $77, $74, $52, $17, $76, $66, $77, $77, $45, $21, $33, $33, $33, $33, $34, $52, $13, $36, $66, $33, $33, $45, $21, $33, $22, $23, $33, $34, $50, - $21, $77, $77, $77, $77, $74, $52, $17, $77, $67, $77, $77, $45, $21, $33, $33, $33, $33, $34, $52, $13, $33, $63, $33, $33, $45, $21, $33, $32, $33, $33, $34, $50, - $21, $77, $77, $77, $77, $74, $52, $17, $77, $77, $77, $77, $45, $21, $33, $33, $33, $33, $34, $52, $13, $33, $33, $33, $33, $45, $21, $33, $33, $33, $33, $34, $50, - $24, $44, $44, $44, $44, $44, $52, $44, $44, $44, $44, $44, $45, $24, $44, $44, $44, $44, $44, $52, $44, $44, $44, $44, $44, $45, $24, $44, $44, $44, $44, $44, $50, - $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $50 - ); - - // 64x8 pixel 4bpp bitmap - ArrowBitmapData: array[0..255] of Byte = ( - $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $13, $33, $33, $31, $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $23, $33, $33, $23, $33, $33, - $33, $33, $33, $33, $33, $33, $33, $33, $33, $31, $13, $33, $33, $31, $13, $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $32, $25, $33, $33, $22, $33, $33, - $33, $31, $33, $33, $11, $11, $11, $13, $33, $11, $13, $33, $33, $31, $11, $33, $33, $32, $33, $33, $22, $22, $22, $23, $33, $22, $25, $33, $33, $22, $23, $33, - $33, $11, $13, $33, $31, $11, $11, $33, $31, $11, $13, $33, $33, $31, $11, $13, $33, $22, $23, $33, $32, $22, $22, $55, $32, $22, $25, $33, $33, $22, $22, $33, - $31, $11, $11, $33, $33, $11, $13, $33, $33, $11, $13, $33, $33, $31, $11, $33, $32, $22, $22, $33, $33, $22, $25, $53, $33, $22, $25, $33, $33, $22, $25, $53, - $11, $11, $11, $13, $33, $31, $33, $33, $33, $31, $13, $33, $33, $31, $13, $33, $22, $22, $22, $23, $33, $32, $55, $33, $33, $32, $25, $33, $33, $22, $55, $33, - $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $13, $33, $33, $31, $33, $33, $35, $55, $55, $55, $33, $33, $53, $33, $33, $33, $25, $33, $33, $25, $53, $33, - $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $35, $33, $33, $35, $33, $33 - ); - -var - PalData: array[0..7] of TGfxColor; - Palette: TGfxPalette; - Bitmap: TFBitmap; -begin - inherited Create; - - FImageCanvas := TFCanvas(GFScreen.CreateBitmapCanvas(65, 33)); - FMaskCanvas := TFCanvas(GFScreen.CreateMonoBitmapCanvas(12, 12)); - - PalData[0] := colMagenta; - PalData[1] := GetGUIColor(cl3DDkShadow); - PalData[2] := GetGUIColor(cl3DShadow); - PalData[3] := GetGUIColor(cl3DFace); - PalData[4] := GetGUIColor(cl3DLight); - PalData[5] := GetGUIColor(cl3DHighlight); - PalData[6] := GetGUIColor(clWindowText); - PalData[7] := GetGUIColor(clWindow); - Palette := TGfxPalette.Create(8, @PalData); - - Bitmap := TFBitmap.Create(60, 12, PixelFormatPal4A); - BitMap.Palette := Palette; - BitMap.SetPixelsFromData(@RadioBitmapData, 30); - FImageCanvas.DrawImage(Bitmap, Point(0,0)); - Bitmap.Free; - - Bitmap := TFBitmap.Create(12, 12, PixelFormatMono); - Bitmap.SetPixelsFromData(@RadioMaskData, 2); - FMaskCanvas.DrawImage(Bitmap, Point(0, 0)); - Bitmap.Free; - - Palette := TGfxPalette.Create(8, @PalData); - Bitmap := TFBitmap.Create(66, 13, PixelFormatPal4); - BitMap.Palette := Palette; - BitMap.SetPixelsFromData(@CheckBoxBitmapData, 33); - FImageCanvas.DrawImage(Bitmap, Point(0, 12)); - Bitmap.Free; - - Palette := TGfxPalette.Create(8, @PalData); - Bitmap := TFBitmap.Create(64, 8, PixelFormatPal4); - BitMap.Palette := Palette; - BitMap.SetPixelsFromData(@ArrowBitmapData, 32); - FImageCanvas.DrawImage(Bitmap, Point(0, 25)); - Bitmap.Free; - - Palette.Release; -end; - -destructor TBasicStyle.Destroy; -begin - FImageCanvas.Free; - FMaskCanvas.Free; - inherited Destroy; -end; - -// helper functions - - -{ Draws a 3D frame, its thickness is 2 pixels. The 4 given colors are used in - this way: - Color1: Outer frame left & top - Color2: Inner frame left & top - Color3: Outer frame right & bottom - Color4: Inner frame right & bottom -} - -procedure TBasicStyle.Draw3DFrame(Canvas: TFCanvas; const ARect: TRect; - Color1, Color2, Color3, Color4: TColor); -begin - with ARect do - begin - SetUIColor(Canvas, Color1); - {Canvas.DrawPolyLine([Point(Left, Bottom - 2), TopLeft, - Point(Right - 1, Top)]);} - Canvas.DrawLine(Point(Left, Bottom - 2), TopLeft); - Canvas.DrawLine(TopLeft, Point(Right - 1, Top)); - SetUIColor(Canvas, Color2); - {Canvas.DrawPolyLine([Point(Left + 1, Bottom - 3), Point(Left + 1, Top + 1), - Point(Right - 2, Top + 1)]);} - Canvas.DrawLine(Point(Left + 1, Bottom - 3), Point(Left + 1, Top + 1)); - Canvas.DrawLine(Point(Left + 1, Top + 1), Point(Right - 2, Top + 1)); - SetUIColor(Canvas, Color3); - {Canvas.DrawPolyLine([Point(Left, Bottom - 1), Point(Right - 1, Bottom - 1), - Point(Right - 1, Top - 1)]);} - Canvas.DrawLine(Point(Left, Bottom - 1), Point(Right - 1, Bottom - 1)); - Canvas.DrawLine(Point(Right - 1, Bottom - 1), Point(Right - 1, Top - 1)); - SetUIColor(Canvas, Color4); - {Canvas.DrawPolyLine([Point(Left + 1, Bottom - 2), - Point(Right - 2, Bottom - 2), Point(Right - 2, Top)]);} - Canvas.DrawLine(Point(Left + 1, Bottom - 2), Point(Right - 2, Bottom - 2)); - Canvas.DrawLine(Point(Right - 2, Bottom - 2), Point(Right - 2, Top)); - end; -end; - -procedure TBasicStyle.DrawSunkenOuterBorder(Canvas: TFCanvas; - const ARect: TRect); -begin - with ARect do - begin - SetUIColor(Canvas, cl3DShadow); - Canvas.DrawLine(Point(Left, Bottom - 2), TopLeft); - Canvas.DrawLine(TopLeft, Point(Right, Top)); - SetUIColor(Canvas, cl3DHighlight); - Canvas.DrawLine(Point(Left, Bottom - 1), Point(Right - 1, Bottom - 1)); - Canvas.DrawLine(Point(Right - 1, Bottom - 1), Point(Right - 1, Top - 1)); - end; -end; - -procedure TBasicStyle.DrawRaisedOuterBorder(Canvas: TFCanvas; - const ARect: TRect); -begin - with ARect do - begin - SetUIColor(Canvas, cl3DHighlight); - Canvas.DrawLine(Point(Left, Bottom - 2), TopLeft); - Canvas.DrawLine(TopLeft, Point(Right, Top)); - SetUIColor(Canvas, cl3DShadow); - Canvas.DrawLine(Point(Left, Bottom - 1), Point(Right - 1, Bottom - 1)); - Canvas.DrawLine(Point(Right - 1, Bottom - 1), Point(Right - 1, Top - 1)); - end; -end; - -procedure TBasicStyle.DrawText(Canvas: TFCanvas; const APosition: TPoint; - const AText: String; State: TFWidgetState); -begin - if not (wsEnabled in State) then - begin - SetUIColor(Canvas, cl3DHighlight); - Canvas.TextOut(APosition + Point(1, 1), AText); - SetUIColor(Canvas, cl3DShadow); - end; - Canvas.TextOut(APosition, AText); -end; - -procedure TBasicStyle.DrawItemBefore(Canvas: TFCanvas; const ARect: TRect; - Flags: TItemFlags); -begin - if ifSelected in Flags then - begin - SetUIColor(Canvas, clHighlight); - Canvas.FillRect(ARect); - SetUIColor(Canvas, clHighlightText); - end; -end; - -procedure TBasicStyle.DrawItemAfter(Canvas: TFCanvas; const ARect: TRect; - Flags: TItemFlags); -begin - if ifFocused in Flags then - DrawFocusRect(Canvas, ARect); -end; - -procedure TBasicStyle.DrawWindowBackground(Canvas: TFCanvas; - const ARect: TRect); -begin -// SetUIColor(Canvas, cl3DFace); - Canvas.FillRect(ARect); -end; - -procedure TBasicStyle.DrawButtonFace(Canvas: TFCanvas; const ARect: TRect; - Flags: TFButtonFlags); -var - r: TRect; -begin - r := ARect; - - if btnIsSelected in Flags then - begin - SetUIColor(Canvas, cl3DDkShadow); - Canvas.DrawRect(r); - Inc(r.Left); - Inc(r.Top); - Dec(r.Right); - Dec(r.Bottom); - end; - - if btnIsPressed in Flags then - begin - SetUIColor(Canvas, cl3DShadow); - Canvas.DrawRect(r); - Inc(r.Left); - Inc(r.Top); - Dec(r.Right); - Dec(r.Bottom); - end else - begin - if btnIsEmbedded in Flags then - Draw3DFrame(Canvas, r, cl3DLight, cl3DHighlight, cl3DDkShadow, cl3DShadow) - else - Draw3DFrame(Canvas, r, cl3DHighlight, cl3DLight, cl3DDkShadow, cl3DShadow); - Inc(r.Left, 2); - Inc(r.Top, 2); - Dec(r.Right, 2); - Dec(r.Bottom, 2); - end; - - SetUIColor(Canvas, cl3DFace); - Canvas.FillRect(r); - - if btnHasFocus in Flags then - begin - r.Left := ARect.Left + 4; - r.Top := ARect.Top + 4; - r.Right := ARect.Right - 4; - r.Bottom := ARect.Bottom - 4; - DrawFocusRect(Canvas, r); - end; -end; - -function TBasicStyle.GetButtonBorders: TRect; -begin - Result := Rect(5, 5, 5, 5); -end; - -function TBasicStyle.GetSeparatorSize: Integer; -begin - Result := 2; -end; - -procedure TBasicStyle.DrawSeparator(Canvas: TFCanvas; const ARect: TRect; - AOrientation: TOrientation); -var - r: TRect; -begin - with ARect do - if AOrientation = Horizontal then - r := Rect(Left, Top + (Bottom - Top) div 2 - 1, Right, - Top + (Bottom - Top) div 2 + 1) - else - r := Rect(Left + (Right - Left) div 2 - 1, Top, - Left + (Right - Left) div 2 + 1, Bottom); - DrawSunkenOuterBorder(Canvas, r); -end; - -procedure TBasicStyle.DrawGroupBox(Canvas: TFCanvas; const ARect: TRect; - const ALabel: String; WidgetState: TFWidgetState); -var - TitleWidth, TitleHeight, TopLine: Integer; -begin - TitleWidth := Canvas.TextWidth(ALabel); - TitleHeight := Canvas.FontCellHeight; - TopLine := ARect.Top + TitleHeight div 3; - - SetUIColor(Canvas, cl3DHighlight); - with ARect do - begin - Canvas.DrawLine(Point(Left + TitleWidth + 10, TopLine + 1), Point(Right - 1, TopLine + 1)); { top - right of text } - Canvas.DrawLine(Point(Right - 1, TopLine + 1), Point(Right - 1, Bottom - 1)); { right } - Canvas.DrawLine(Point(Right - 1, Bottom - 1), Point(Left + 1, Bottom - 1)); { bottom } - Canvas.DrawLine(Point(Left + 1, Bottom - 1), Point(Left + 1, TopLine + 1)); { left } - Canvas.DrawLine(Point(Left + 1, TopLine + 1), Point(Left + 8, TopLine + 1)); { top - left of text } - end; - - SetUIColor(Canvas, cl3DShadow); - with ARect do - begin - Canvas.DrawLine(Point(Left + TitleWidth + 10, TopLine), Point(Right - 2, TopLine)); - Canvas.DrawLine(Point(Right - 2, TopLine), Point(Right - 2, Bottom - 2)); - Canvas.DrawLine(Point(Right - 2, Bottom - 2), Point(Left, Bottom - 2)); - Canvas.DrawLine(Point(Left, Bottom - 2), Point(Left, TopLine)); - Canvas.DrawLine(Point(Left, TopLine), Point(Left + 8, TopLine)); - end; - - SetUIColor(Canvas, clWindowText); - if ALabel <> '' then - DrawText(Canvas, ARect.TopLeft + Point(9, 0), ALabel, WidgetState); -end; - -function TBasicStyle.GetGroupBoxBorders(Canvas: TFCanvas; - const ALabel: String; var LabelWidth: Integer): TRect; -begin - Result := Rect(6, Canvas.FontCellHeight + 4, 6, 6); - LabelWidth := Canvas.TextWidth(ALabel) + 6; -end; - -procedure TBasicStyle.DrawEditBox(Canvas: TFCanvas; const ARect: TRect; const IsReadOnly: Boolean); -begin - Draw3DFrame(Canvas, ARect, cl3DShadow, cl3DDkShadow, cl3DHighlight, cl3DFace); - if IsReadOnly then - SetUIColor(Canvas, cl3DFace) - else - SetUIColor(Canvas, clWindow); - with ARect do - Canvas.FillRect(Rect(Left + 2, Top + 2, Right - 2, Bottom - 2)); -end; - -function TBasicStyle.GetEditBoxBorders: TRect; -begin - Result := Rect(2, 2, 2, 2); -end; - -procedure TBasicStyle.DrawCheckBox(Canvas: TFCanvas; - const ARect, LabelRect: TRect; Flags: TFCheckboxFlags); -var - r: TRect; -begin - SetUIColor(Canvas, cl3DFace); - Canvas.FillRect(ARect); - - r.Left := ARect.Left; - r.Top := ARect.Top + (ARect.Bottom - ARect.Top - 13) div 2; - r.Right := 13; - r.Bottom := r.Top + 13; - DrawEditBox(Canvas, r); - - inc(r.Left,2); - inc(r.Top,2); - dec(r.Right,3); - dec(r.Bottom,3); - DrawCheckBoxCheck(Canvas, r, Flags); - - if cbHasFocus in Flags then - with LabelRect do - DrawFocusRect(Canvas, Rect(Left - 2, Top - 2, Right + 2, Bottom + 2)); -end; - -procedure TBasicStyle.GetCheckboxLayout(const LabelSize: TSize; - var TotalSize: TSize; var LabelPos: TPoint); -begin - TotalSize := Size(LabelSize.cx + 21, Max(13, LabelSize.cy + 4)); - LabelPos := Point(19, (TotalSize.cy - LabelSize.cy) div 2); -end; - - -procedure TBasicStyle.DrawRadioButton(Canvas: TFCanvas; - const ARect, LabelRect: TRect; Flags: TFCheckboxFlags); -var - Index, BtnY: Integer; - r: TRect; -begin - with ARect do - begin - BtnY := Top + (Bottom - Top - 12) div 2; - if cbIsEnabled in Flags then - begin - Index := Ord(cbIsChecked in Flags); - if cbIsPressed in Flags then - Inc(Index, 2); - end else - Index := 2 + Ord(cbIsChecked in Flags) * 2; - - Canvas.MaskedCopyRect(FImageCanvas, FMaskCanvas, - Rect(Index * 12, 0, (Index + 1) * 12, 12), - Point(0, 0), Point(Left, BtnY)); - end; - - if cbHasFocus in Flags then - with LabelRect do - DrawFocusRect(Canvas, Rect(Left - 2, Top - 2, Right + 2, Bottom + 2)); -end; - -procedure TBasicStyle.GetRadioButtonLayout(const LabelSize: TSize; - var TotalSize: TSize; var LabelPos: TPoint); -begin - TotalSize := Size(LabelSize.cx + 20, Max(12, LabelSize.cy + 4)); - LabelPos := Point(18, (TotalSize.cy - LabelSize.cy) div 2); -end; - -function TBasicStyle.GetComboBoxArrowSize: TSize; -begin - Result.cx := 17; - Result.cy := 17; -end; - -function TBasicStyle.GetComboBoxBtnSize: TSize; -begin - Result.cx := 18; - Result.cy := 18; -end; - -procedure TBasicStyle.DrawComboBoxArrow(Canvas: TFCanvas; - const ARect: TRect; IsPressed, IsEnabled: Boolean); -var - r: TRect; -begin - r := ARect; - if IsEnabled then - begin - Canvas.SetColor(GetGUIColor(clBtnText)); - if IsPressed then - begin - r.Top := ARect.Top + 1; - r.Left := ARect.Left + 1; - end; - end - else - Canvas.SetColor(GetGUIColor(cl3DShadow)); - - DrawDirectionArrows(Canvas, r, arrowDown); -end; - -function TBasicStyle.GetScrollBarBorders(Orientation: TOrientation): TRect; -begin - Result := Rect(1, 1, 1, 1); -end; - -function TBasicStyle.GetScrollBarBtnSize(Orientation: TOrientation): TSize; -begin - Result.cx := 18; - Result.cy := 18; -end; - -function TBasicStyle.GetScrollBarBtnMinSize: Integer; -begin - Result := 30; -end; - -procedure TBasicStyle.DrawScrollBarBorder(Canvas: TFCanvas; - const ARect: TRect); -begin - with ARect do - begin - SetUIColor(Canvas, cl3DShadow); - Canvas.DrawLine(Point(Left, Bottom - 1), TopLeft); - Canvas.DrawLine(TopLeft, Point(Right, Top)); - - SetUIColor(Canvas, cl3DHighlight); - Canvas.DrawLine(Point(Left + 1, Bottom - 1), Point(Right - 1, Bottom - 1)); - Canvas.DrawLine(Point(Right - 1, Bottom - 1), Point(Right - 1, Top)); - - SetUIColor(Canvas, cl3DFace); - Canvas.FillRect(Rect(Left, Bottom - 1, Left + 1, Bottom)); - Canvas.FillRect(Rect(Right - 1, Top, Right, Top + 1)); - end; -end; - -procedure TBasicStyle.DrawScrollBarButton(Canvas: TFCanvas; - const ARect: TRect; Direction: TArrowDirection; - IsPressed, IsEnabled: Boolean); -var - r: TRect; -begin - r := ARect; - if IsEnabled then - begin - SetUIColor(Canvas, clBtnText); - if IsPressed then - begin - r.Top := ARect.Top + 1; - r.Left := ARect.Left + 1; - end; - end - else - SetUIColor(Canvas, cl3DShadow); - - DrawDirectionArrows(Canvas, r, Direction); -end; - -function TBasicStyle.GetScrollBoxBorders: TRect; -begin - Result := Rect(2, 2, 2, 2); -end; - -procedure TBasicStyle.DrawScrollBoxBorder(Canvas: TFCanvas; const ARect: TRect); -begin - Draw3DFrame(Canvas, ARect, cl3DShadow, cl3DDkShadow, - cl3DHighlight, cl3DLight); -end; - -function TBasicStyle.GetMenuBorders(pCanvas: TFCanvas; const pText: string; - var pTextWidth: Integer): TRect; -begin - pTextWidth := pCanvas.TextWidth(pText) + 6; -// Result := Rect(2, 2, 6, pCanvas.FontCellHeight+4); - Result := Rect(6, 2, 2, 2); -// Result := Rect(6, pCanvas.FontCellHeight + 4, 6, 6); -end; - -function TBasicStyle.GetPanelBorders: TRect; -begin - Result := Rect(5, 5, 5, 5); -end; - -procedure TBasicStyle.DrawPanel(Canvas: TFCanvas; const ARect: TRect; - ABevelStyle: TBevelStyle); -begin - // bsPlain, bsLowered, bsRaised - if ABevelStyle = bsPlain then - DrawWindowBackground(Canvas, ARect) - else if ABevelStyle = bsLowered then - DrawSunkenOuterBorder(Canvas, ARect) - else - DrawRaisedOuterBorder(Canvas, ARect); -// Draw3DFrame(Canvas, ARect, cl3DHighlight, cl3DFace, cl3DFace, cl3DShadow); -end; - - - -{$ENDIF read_implementation} - diff --git a/gui/fpguiwidget.inc b/gui/fpguiwidget.inc deleted file mode 100644 index 249c1ce2..00000000 --- a/gui/fpguiwidget.inc +++ /dev/null @@ -1,1368 +0,0 @@ -{ - fpGUI - Free Pascal GUI Library - - Basic events and Widget class declarations - - Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this - distribution, for details of the copyright. - - See the file COPYING.modifiedLGPL, included in this distribution, - for details about redistributing fpGUI. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -} - -{%mainunit fpgui.pas} - -{$IFDEF read_interface} - -{ Basic events and widget declarations } - - -// ------------------------------------------------------------------- -// Basic event objects -// ------------------------------------------------------------------- - - {$M+} - { Basic/Abstract event object which has RTTI enabled. This object does some - kind of reference counting as well. } - TEventObj = class - private - RefCount: LongInt; - FSender: TObject; - public - constructor Create(ASender: TObject); - procedure AddRef; - procedure Release; - function SendToChild(AChild: TFWidget): Boolean; virtual; - published - property Sender: TObject read FSender write FSender; - end; - {$M-} - - TEventClass = class of TEventObj; - - // Miscellaneous events - - TLayoutingEventObj = class(TEventObj); - - TCalcSizesEventObj = class(TLayoutingEventObj); - - TResizedEventObj = class(TLayoutingEventObj) - private - FIsForced: Boolean; - public - constructor Create(ASender: TObject; AIsForced: Boolean); - published - property IsForced: Boolean read FIsForced write FIsForced; - end; - - - TDestroyEventObj = class(TEventObj); - TEnabledChangeEventObj = class(TEventObj); - TVisibilityChangeEventObj = class(TEventObj); - - - TPaintingEventObj = class(TEventObj) - private - FCanvas: TFCanvas; - public - constructor Create(ASender: TObject; ACanvas: TFCanvas); - published - property Canvas: TFCanvas read FCanvas write FCanvas; - end; - - - TPreparePaintEventObj = class(TPaintingEventObj) - public - // To prevent invisible children to be processed: - function SendToChild(AChild: TFWidget): Boolean; override; - end; - - - TPaintEventObj = class(TPaintingEventObj) - public - // To adapt the clipping region and add a translation: - function SendToChild(AChild: TFWidget): Boolean; override; - end; - - - // Mouse events - - TMouseEventObj = class(TEventObj) - private - FShift: TShiftState; - FPosition: TPoint; - public - constructor Create(ASender: TObject; AShift: TShiftState; APosition: TPoint); - function SendToChild(AChild: TFWidget): Boolean; override; - property Position: TPoint read FPosition write FPosition; - published - property Shift: TShiftState read FShift write FShift; - end; - - - TMouseButtonEventObj = class(TMouseEventObj) - private - FButton: TMouseButton; - public - constructor Create(ASender: TObject; AButton: TMouseButton; - AShift: TShiftState; APosition: TPoint); - published - property Button: TMouseButton read FButton write FButton; - end; - - - TMousePressedEventObj = class(TMouseButtonEventObj); - TMouseReleasedEventObj = class(TMouseButtonEventObj); - - - TMouseMoveEventObj = class(TMouseEventObj) - public - function SendToChild(AChild: TFWidget): Boolean; override; - end; - - - TMouseEnterEventObj = class(TMouseEventObj) - public - NewCursor: TFCursor; - end; - - - TMouseLeaveEventObj = class(TEventObj) - public - function SendToChild(AChild: TFWidget): Boolean; override; - end; - - - TMouseLeaveCheckEventObj = class(TMouseEventObj) - public - function SendToChild(AChild: TFWidget): Boolean; override; - NewCursor: TFCursor; - end; - - - TMouseWheelEventObj = class(TMouseEventObj) - private - FWheelDelta: Single; - public - constructor Create(ASender: TObject; AShift: TShiftState; - AWheelDelta: Single; APosition: TPoint); - published - property WheelDelta: Single read FWheelDelta write FWheelDelta; - end; - - -// ------------------------------------------------------------------- -// TWidget -// ------------------------------------------------------------------- - - TFWidgetStyle = set of (wsCaptureMouse, wsClickable, wsOpaque); - - TFContainerWidget = class; - - - TFWidget = class(TComponent) - private - FColor: TColor; - FParent: TFWidget; - FOnClick: TNotifyEvent; - // Property access - procedure SetColor(const AValue: TColor); - procedure SetParent(AParent: TFWidget); - function GetBoundsRect: TRect; - function GetLeft: Integer; - function GetTop: Integer; - function GetWidth: Integer; - function GetHeight: Integer; - procedure SetEnabled(AEnabled: Boolean); - procedure SetStyle(const AValue: TStyleAbs); - procedure SetVisible(AVisible: Boolean); - // Event handling - function EvCalcSizes(Event: TCalcSizesEventObj): Boolean; - function EvEnabledChange(Event: TEnabledChangeEventObj): Boolean; - function EvVisibilityChange(Event: TVisibilityChangeEventObj): Boolean; - function EvMousePressed(Event: TMousePressedEventObj): Boolean; - function EvMouseReleased(Event: TMouseReleasedEventObj): Boolean; - function EvMouseEnter(Event: TMouseEnterEventObj): Boolean; - function EvMouseLeave(Event: TMouseLeaveEventObj): Boolean; - function EvMouseLeaveCheck(Event: TMouseLeaveCheckEventObj): Boolean; - protected - FCursor: TFCursor; - FText: string; - FStyle: TStyleAbs; - FCanExpandHeight: Boolean; - FCanExpandWidth: Boolean; - FEnabled: Boolean; - FVisible: Boolean; - FOrigin: TPoint; - FBoundsSize: TSize; - FClientRect: TRect; - FMinSize: TSize; - FMaxSize: TSize; - FDefSize: TSize; - WidgetStyle: TFWidgetStyle; - WidgetState: TFWidgetState; - procedure Loaded; override; - procedure Click; dynamic; - procedure Paint(Canvas: TFCanvas); virtual; - procedure SetParentComponent(AParent: TComponent); override; - - // Layouting - procedure CalcSizes; virtual; abstract; - procedure Resized; virtual; - - // Events - function ProcessEvent(Event: TEventObj): Boolean; virtual; - function DistributeEvent(Event: TEventObj): Boolean; virtual; - procedure EvFocusChanged; dynamic; // Widget got or lost focus - procedure EvKeyPressed(Key: Word; Shift: TShiftState); dynamic; - procedure EvKeyReleased(Key: Word; Shift: TShiftState); dynamic; - procedure EvKeyChar(KeyChar: Char); dynamic; - procedure EvTextChanged; dynamic; - function DoMouseEnter(AShift: TShiftState; AMousePos: TPoint): Boolean; - - // Properties - function GetStyle: TStyleAbs; - procedure SetCanExpandWidth(allow: Boolean); - procedure SetCanExpandHeight(allow: Boolean); - procedure SetText(const AText: String); virtual; - property CanExpandWidth: Boolean read FCanExpandWidth write SetCanExpandWidth default False; - property CanExpandHeight: Boolean read FCanExpandHeight write SetCanExpandHeight default False; - property Cursor: TFCursor read FCursor write FCursor default crDefault; - property Text: String read FText write SetText; - property Color: TColor read FColor write SetColor default cl3DFace; - property OnClick: TNotifyEvent read FOnClick write FOnClick; - public - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - function SendEvent(Event: TEventObj): Boolean; - function FindForm: TFCustomForm; - procedure SetEmbeddedParent(AParent: TFWidget); - procedure SetBounds(APosition: TPoint; ASize: TSize); - procedure SetBounds(x, y, w, h: Integer); overload; - function WidgetToClient(const APoint: TPoint): TPoint; virtual; - function ClientToWidget(const APoint: TPoint): TPoint; virtual; - function ClientToScreen(const APoint: TPoint): TPoint; virtual; - procedure Show; dynamic; - procedure Hide; dynamic; - procedure Redraw; - procedure Redraw(const ARect: TRect); - procedure Scroll(const ARect: TRect; DeltaX, DeltaY: Integer); - procedure SetFocus; - procedure Update; - property Parent: TFWidget read FParent write SetParent; - property Origin: TPoint read FOrigin; - property BoundsSize: TSize read FBoundsSize; - property BoundsRect: TRect read GetBoundsRect; - property Left: Integer read GetLeft; - property Top: Integer read GetTop; - property Width: Integer read GetWidth; - property Height: Integer read GetHeight; - property MinSize: TSize read FMinSize; - property MaxSize: TSize read FMaxSize; - property DefSize: TSize read FDefSize; - property ClientRect: TRect read FClientRect; - property Style: TStyleAbs read GetStyle write SetStyle; - property Enabled: Boolean read FEnabled write SetEnabled default True; - property Visible: Boolean read FVisible write SetVisible default True; - end; - -{$ENDIF read_interface} - - - -{$IFDEF read_implementation} - -// ------------------------------------------------------------------- -// TEventObj -// ------------------------------------------------------------------- - -constructor TEventObj.Create(ASender: TObject); -begin - Sender := ASender; - RefCount := 1; -end; - - -procedure TEventObj.AddRef; -begin - Inc(RefCount); -end; - - -procedure TEventObj.Release; -begin - ASSERT(RefCount > 0); - Dec(RefCount); - if RefCount = 0 then - Self.Free; -end; - - -function TEventObj.SendToChild(AChild: TFWidget): Boolean; -begin - Inc(RefCount); - Result := AChild.SendEvent(Self); -end; - - -// ------------------------------------------------------------------- -// Miscellaneous events -// ------------------------------------------------------------------- - -constructor TResizedEventObj.Create(ASender: TObject; AIsForced: Boolean); -begin - inherited Create(ASender); - FIsForced := AIsForced; -end; - - -function TPreparePaintEventObj.SendToChild(AChild: TFWidget): Boolean; -begin - if wsIsVisible in AChild.WidgetState then - Result := inherited SendToChild(AChild) - else - Result := False; -end; - - -constructor TPaintingEventObj.Create(ASender: TObject; ACanvas: TFCanvas); -begin - inherited Create(ASender); - FCanvas := ACanvas; -end; - - -function TPaintEventObj.SendToChild(AChild: TFWidget): Boolean; -var - ClientPos: TPoint; -begin - if wsIsVisible in AChild.WidgetState then - begin - Canvas.SaveState; - try - if Canvas.IntersectClipRect(AChild.BoundsRect) then - begin - ClientPos := AChild.ClientToWidget(AChild.Origin); - Canvas.AppendTranslation(ClientPos); - Result := inherited SendToChild(AChild); - end else - Result := False; - finally - Canvas.RestoreState; - end; - end else - Result := False; -end; - - -// ------------------------------------------------------------------- -// Mouse events -// ------------------------------------------------------------------- - -constructor TMouseEventObj.Create(ASender: TObject; AShift: TShiftState; - APosition: TPoint); -begin - inherited Create(ASender); - Shift := AShift; - Position := APosition; -end; - - -function TMouseEventObj.SendToChild(AChild: TFWidget): Boolean; -var - OldPos, ClientPos: TPoint; -begin - if (AChild.WidgetState * [wsEnabled, wsIsVisible] = [wsEnabled, wsIsVisible]) - and ((AChild = AChild.FindForm.MouseCaptureWidget) or - PtInRect(AChild.BoundsRect, Position)) then - begin - // Store the old values, as they might get modified during AChild.SendEvent! - OldPos := Position; - ClientPos := AChild.WidgetToClient(Position); - Position := ClientPos - AChild.Origin; - Result := inherited SendToChild(AChild); - Position := OldPos; - end - else - Result := False; -end; - - -constructor TMouseButtonEventObj.Create(ASender: TObject; AButton: TMouseButton; - AShift: TShiftState; APosition: TPoint); -begin - inherited Create(ASender, AShift, APosition); - Button := AButton; -end; - - -function TMouseMoveEventObj.SendToChild(AChild: TFWidget): Boolean; -begin - if AChild.WidgetState * [wsEnabled, wsIsVisible] = [wsEnabled, wsIsVisible] then - begin - if PtInRect(AChild.BoundsRect, Position) and not (wsMouseInside in AChild.WidgetState) then - AChild.DoMouseEnter(Shift, Position - AChild.Origin); - - Result := inherited SendToChild(AChild); - end - else - Result := False; -end; - - -function TMouseLeaveEventObj.SendToChild(AChild: TFWidget): Boolean; -begin - if wsMouseInside in AChild.WidgetState then - Result := inherited SendToChild(AChild) - else - Result := False; -end; - - -function TMouseLeaveCheckEventObj.SendToChild(AChild: TFWidget): Boolean; -begin - if ((FPosition.X < AChild.Left) or (FPosition.Y < AChild.Top) or - (FPosition.X >= AChild.Left + AChild.Width) or - (FPosition.Y >= AChild.Top + AChild.Height)) and - (wsMouseInside in AChild.WidgetState) then - AChild.SendEvent(TMouseLeaveEventObj.Create(Self)); - - Result := inherited SendToChild(AChild); -end; - - -constructor TMouseWheelEventObj.Create(ASender: TObject; AShift: TShiftState; - AWheelDelta: Single; APosition: TPoint); -begin - inherited Create(ASender, AShift, APosition); - WheelDelta := AWheelDelta; -end; - - -// =================================================================== -// TWidget -// =================================================================== - -constructor TFWidget.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - WidgetStyle := []; - WidgetState := [wsEnabled]; - FCanExpandWidth := False; - FCanExpandHeight := False; - FEnabled := True; - FVisible := True; - FColor := cl3DFace; -end; - -destructor TFWidget.Destroy; -begin - inherited Destroy; -end; - -function TFWidget.SendEvent(Event: TEventObj): Boolean; -{$IFDEF TraceEvents} -var - i: Integer; -{$ENDIF} -begin -{$IFDEF TraceEvents} - for i := 1 to EventNestingLevel do - Write(' '); - WriteLn(Event.ClassName, ' event for ', Name, ':', ClassName); - Inc(EventNestingLevel); -{$ENDIF} - - Result := ProcessEvent(Event); - -{$IFDEF TraceEvents} - Dec(EventNestingLevel); - for i := 1 to EventNestingLevel do - Write(' '); - if Result then - WriteLn(Event.ClassName, ' event has been blocked.'); -{$ENDIF} - Event.Release; -end; - -function TFWidget.FindForm: TFCustomForm; -var - Widget: TFWidget; -begin - Widget := Self; - while not (Widget is TFCustomForm) do - begin - Widget := Widget.Parent; - if not Assigned(Widget) then - begin - Result := nil; - exit; - end; - end; - Result := TFCustomForm(Widget); -end; - -procedure TFWidget.SetEmbeddedParent(AParent: TFWidget); -begin - FParent := AParent; -end; - -procedure TFWidget.SetBounds(APosition: TPoint; ASize: TSize); -begin - LAYOUTTRACE('TFWidget.SetBounds for %s:%s. Old size: %dx%d, new size: %dx%d', - [Name, ClassName, BoundsSize.cx, BoundsSize.cy, ASize.cx, ASize.cy]); - FOrigin := APosition; - if ASize <> BoundsSize then - begin - FBoundsSize := ASize; - FClientRect := Rect(0, 0, BoundsSize.cx, BoundsSize.cy); - SendEvent(TResizedEventObj.Create(Self, wsSizeIsForced in WidgetState)); - end; -end; - -procedure TFWidget.SetBounds(x, y, w, h: Integer); -begin - SetBounds(Point(x, y), Size(w, h)); -end; - -function TFWidget.WidgetToClient(const APoint: TPoint): TPoint; -begin - // as default, the outer rectangle is identical to the client rectangle - Result := APoint; -end; - -function TFWidget.ClientToWidget(const APoint: TPoint): TPoint; -begin - // as default, the outer rectangle is identical to the client rectangle - Result := APoint; -end; - -function TFWidget.ClientToScreen(const APoint: TPoint): TPoint; -begin - Result := APoint + Origin; - Result := ClientToWidget(Result); - if Assigned(Parent) then - Result := Parent.ClientToScreen(Result); -end; - -{procedure TFWidget.Update; -begin - LAYOUTTRACE('TFWidget.Update for %s:%s', [Name, ClassName]); - if wsIsUpdating in WidgetState then - exit; - - Include(WidgetState, wsIsUpdating); - SendEvent(TUpdateEventObj.Create(Self)); - Exclude(WidgetState, wsIsUpdating); -end; - -procedure TFWidget.RecalcLayout; -var - OldW, OldH: Integer; - x, y: Integer; - Widget: TFWidget; -begin - if (csLoading in ComponentState) or (not Visible) then - exit; - - LAYOUTTRACE('TFWidget.RecalcLayout for %s:%s', [Name, ClassName]); - - OldW := Width; - OldH := Height; - - MinW := 0; - MinH := 0; - DefW := 0; - DefH := 0; - MaxW := InfiniteSize; - MaxH := InfiniteSize; - - EvRecalcLayout; - - if MinW = 0 then MinW := 1; - if MinH = 0 then MinH := 1; - if DefW < MinW then DefW := MinW; - if DefH < MinH then DefH := MinH; - - if (not FCanExpandWidth) or (MaxW < DefW) then - MaxW := DefW; - if (not FCanExpandHeight) or (MaxH < DefH) then - MaxH := DefH; - - if (DefW < OldW) or (DefH < OldH) or ((not (wsOpaque in WidgetStyle)) and - ((DefW > OldW) or (DefH > OldH))) then - begin - x := 0; - y := 0; - Widget := Self; - while not (Widget is TFCustomForm) do - begin - Inc(x, Widget.Left); - Inc(y, Widget.Top); - Widget := Widget.parent; - end; - TFCustomForm(Widget).Wnd.Invalidate(Rect(x, y, - x + Max(Width, OldW), y + Max(Height, OldH))); - end; - - if Assigned(Parent) and not (wsIsUpdating in Parent.WidgetState) then - Parent.RecalcLayout; -end;} - -procedure TFWidget.Show; -begin - if not Visible then - begin - LAYOUTTRACE('TFWidget.Show for %s:%s', [Name, ClassName]); - FVisible := True; - if Assigned(Parent) and (wsIsVisible in Parent.WidgetState) then - begin - SendEvent(TVisibilityChangeEventObj.Create(Self)); - Parent.Update; - end; - end; -end; - -procedure TFWidget.Hide; -begin - if Visible then - begin - LAYOUTTRACE('TFWidget.Hide for %s:%s', [Name, ClassName]); - FVisible := False; - if wsIsVisible in WidgetState then - begin - SendEvent(TVisibilityChangeEventObj.Create(Self)); - if Assigned(Parent) then - Parent.Update; - end; - end; -end; - -procedure TFWidget.Redraw; -begin - {$IFDEF DEBUG} - writeln(Format('TFWidget.Redraw -> %s:%s', [Text, ClassName])); - {$ENDIF} - Redraw(Rect(0, 0, BoundsSize.cx, BoundsSize.cy)); -end; - -procedure TFWidget.Redraw(const ARect: TRect); -var - x, y: Integer; - Form: TFCustomForm; - WidgetPos, FormPos: TPoint; -begin - if not (wsIsVisible in WidgetState) then - exit; - - Form := FindForm; - WidgetPos := ClientToScreen(Point(0, 0)); - FormPos := Form.ClientToScreen(Point(0, 0)); - - x := ARect.Left + WidgetPos.x - FormPos.x; - y := ARect.Top + WidgetPos.y - FormPos.y; - Form.Wnd.Invalidate( - Rect(x, y, x + ARect.Right - ARect.Left, y + ARect.Bottom - ARect.Top)); -end; - -procedure TFWidget.Scroll(const ARect: TRect; DeltaX, DeltaY: Integer); -var - r, ClipRect: TRect; - Widget: TFWidget; - Form: TFCustomForm; - Canvas: TFCanvas; -begin - if not (wsIsVisible in WidgetState) then - exit; - - Form := FindForm; - - { !!!: Better do real DirtyList correction, which might improve performance - a lot in some situations } - Form.Wnd.PaintInvalidRegion; - - r.Left := ARect.Left; - r.Top := ARect.Top; - Widget := Self; - Canvas := TFCanvas(Form.Wnd.Canvas); - Canvas.SaveState; - try - while Widget <> Form do - begin - ClipRect.TopLeft := Form.WidgetCoords(Widget); - ClipRect.BottomRight := ClipRect.TopLeft + Widget.BoundsSize; - Canvas.IntersectClipRect(ClipRect); - r.TopLeft := r.TopLeft + Widget.Origin + - Widget.ClientToWidget(Point(0, 0)); - Widget := Widget.Parent; - end; - - r.Right := r.Left + ARect.Right - ARect.Left; - r.Bottom := r.Top + ARect.Bottom - ARect.Top; - - ClipRect := Canvas.GetClipRect; - - { Perform a quick clipping against the ClipRect - this might reduce - the number of pixels which get copied } - if r.Left < ClipRect.Left then - r.Left := ClipRect.Left; - if r.Left + DeltaX < ClipRect.Left then - r.Left := ClipRect.Left - DeltaX; - if r.Top < ClipRect.Top then - r.Top := ClipRect.Top; - if r.Top + DeltaY < ClipRect.Top then - r.Top := ClipRect.Top - DeltaY; - if r.Right > ClipRect.Right then - r.Right := ClipRect.Right; - if r.Right + DeltaX > ClipRect.Right then - r.Right := ClipRect.Right - DeltaX; - if r.Bottom > ClipRect.Bottom then - r.Bottom := ClipRect.Bottom; - if r.Bottom + DeltaY > ClipRect.Bottom then - r.Bottom := ClipRect.Bottom - DeltaY; - - Canvas.CopyRect(Canvas, r, r.TopLeft + Point(DeltaX, DeltaY)); - finally - Canvas.RestoreState; - end; - - // Redraw the areas which has been scrolled in - with Form.WidgetCoords(Self) do - begin - Dec(ClipRect.Left, x); - Dec(ClipRect.Top, y); - Dec(ClipRect.Right, x); - Dec(ClipRect.Bottom, y); - end; - - if DeltaX <> 0 then - begin - r := ARect; - if DeltaX < 0 then // Scrolling to the left size - begin - r.Left := r.Right + DeltaX; - if r.Right > ClipRect.Right then - begin - Dec(r.Left, r.Right - ClipRect.Right); - r.Right := ClipRect.Right; - end; - end else // Scrolling to the right size - begin - r.Right := r.Left + DeltaX; - if r.Left < ClipRect.Left then - begin - Inc(r.Right, ClipRect.Left - r.Left); - r.Left := ClipRect.Left; - end; - end; - Redraw(r); - end; - - if DeltaY <> 0 then - begin - r := ARect; - if DeltaY < 0 then // Scrolling upwards - begin - r.Top := r.Bottom + DeltaY; - if r.Bottom > ClipRect.Bottom then - begin - Dec(r.Top, r.Bottom - ClipRect.Bottom); - r.Bottom := ClipRect.Bottom; - end; - end else // Scrolling downwards - begin - r.Bottom := r.Top + DeltaY; - if r.Top < ClipRect.Top then - begin - Inc(r.Bottom, ClipRect.Top - r.Top); - r.Top := ClipRect.Top; - end; - end; - Redraw(r); - end; -end; - -procedure TFWidget.SetFocus; -begin - FindForm.FocusedWidget := Self; -end; - -procedure TFWidget.Update; -var - PropagateUpdate: Boolean; - OldMinSize, OldMaxSize, OldDefSize: TSize; -begin - if not (wsIsVisible in WidgetState) then - exit; - - if wsSizeIsForced in WidgetState then - PropagateUpdate := True - else - begin - OldMinSize := MinSize; - OldMaxSize := MaxSize; - OldDefSize := DefSize; - SendEvent(TCalcSizesEventObj.Create(Self)); - PropagateUpdate := (OldMinSize <> MinSize) or (OldMaxSize <> MaxSize) or - (OldDefSize <> DefSize); - end; - - if PropagateUpdate and Assigned(Parent) then - Parent.Update - else - SendEvent(TResizedEventObj.Create(Self, wsSizeIsForced in WidgetState)); -end; - -procedure TFWidget.Loaded; -begin - inherited Loaded; -{!!!: if not (wsEnabled in WidgetState) then - UpdateEnabledState;} -end; - -procedure TFWidget.Click; -begin - Redraw; - if Assigned(OnClick) then - OnClick(Self); -end; - -procedure TFWidget.Paint(Canvas: TFCanvas); -begin - Canvas.SetColor(Style.GetUIColor(FColor)); -end; - -procedure TFWidget.SetParentComponent(AParent: TComponent); -begin - if AParent is TFContainerWidget then - SetParent(TFContainerWidget(AParent)); -end; - -procedure TFWidget.SetEnabled(AEnabled: Boolean); -begin - if AEnabled <> Enabled then - begin - FEnabled := AEnabled; - SendEvent(TEnabledChangeEventObj.Create(Self)); - end; -end; - -procedure TFWidget.SetStyle(const AValue: TStyleAbs); -begin - FStyle := AValue; -end; - -procedure TFWidget.SetVisible(AVisible: Boolean); -begin - if AVisible then - Show - else - Hide; -end; - -procedure TFWidget.Resized; -begin - // Do nothing by default -end; - -procedure TFWidget.EvFocusChanged; -begin - Redraw; -end; - -procedure TFWidget.EvKeyPressed(Key: Word; Shift: TShiftState); - - function SetFocusIfPossible(Widget: TFWidget): Boolean; - begin - Result := (wsClickable in Widget.WidgetStyle) and - (wsEnabled in Widget.WidgetState); - if Result then - Widget.SetFocus; - end; - - function FocusFirst(Widget: TFWidget): Boolean; - var - i: Integer; - Child: TFWidget; - begin - Result := False; - if not Widget.InheritsFrom(TFContainerWidget) then - exit; - - for i := 0 to TFContainerWidget(Widget).ChildCount - 1 do - begin - Child := TFContainerWidget(Widget).Children[i]; - if SetFocusIfPossible(Child) or FocusFirst(Child) then - begin - Result := True; - exit; - end; - end; - end; - - function FocusLast(Widget: TFWidget): Boolean; - var - i: Integer; - Child: TFWidget; - begin - Result := False; - if not Widget.InheritsFrom(TFContainerWidget) then - exit; - - for i := TFContainerWidget(Widget).ChildCount - 1 downto 0 do - begin - Child := TFContainerWidget(Widget).Children[i]; - if SetFocusIfPossible(Child) or FocusLast(Child) then - begin - Result := True; - exit; - end; - end; - end; - -var - mshift: TShiftState; - i, j: Integer; - CurWidget: TFWidget; - CurParent: TFContainerWidget; -begin - // Handle focus movement keys - mshift := Shift * [ssShift, ssAlt, ssCtrl, ssMeta, ssSuper, ssHyper, ssAltGr]; - if ((mshift = []) and ((Key = keyLeft) or (Key = keyUp))) or - ((mshift = [ssShift]) and (Key = keyTab)) then - begin - if Assigned(Parent) then - begin - CurWidget := Self; - CurParent := TFContainerWidget(Parent); - while Assigned(CurParent) and CurParent.InheritsFrom(TFContainerWidget) do - begin - for i := CurParent.ChildCount - 1 downto 1 do - begin - if CurParent.Children[i] = CurWidget then - begin - j := i - 1; - //Dec(i); - while j >= 0 do - begin - if SetFocusIfPossible(CurParent.Children[j]) or - FocusLast(CurParent.Children[j]) then - exit; - Dec(j); - end; - break; - end; { if } - end; { for } - CurParent := TFContainerWidget(CurParent.Parent); - end; { while } - end - else - begin - if FocusLast(Self) then - exit; - end; - end - else - begin - if (mshift = []) and - ((Key = keyRight) or (Key = keyDown) or (Key = keyTab)) then - begin - if Assigned(Parent) then - begin - CurWidget := Self; - CurParent := TFContainerWidget(Parent); - while Assigned(CurParent) and CurParent.InheritsFrom(TFContainerWidget) do - begin - for i := 0 to CurParent.ChildCount - 2 do - begin - if CurParent.Children[i] = CurWidget then - begin - j := i; - Inc(j); - while j < CurParent.ChildCount do - begin - if SetFocusIfPossible(CurParent.Children[j]) or - FocusFirst(CurParent.Children[j]) then - exit; - Inc(j); - end; - break; - end; { if } - end; { for } - CurParent := TFContainerWidget(CurParent.Parent); - end; { while } - end - else - begin - if FocusFirst(Self) then - exit; - end; - end - else if (Key = Ord(' ')) and (wsClickable in WidgetStyle) then - begin - Click; - exit; - end; - end; - - if Assigned(Parent) then - Parent.EvKeyPressed(Key, Shift); -end; - -procedure TFWidget.EvKeyReleased(Key: Word; Shift: TShiftState); -begin - if Assigned(Parent) then - Parent.EvKeyReleased(Key, Shift); -end; - -procedure TFWidget.EvKeyChar(KeyChar: Char); -begin - if Assigned(Parent) then - Parent.EvKeyChar(KeyChar); -end; - -procedure TFWidget.EvTextChanged; -begin - Update; - Redraw; -end; - -function TFWidget.DoMouseEnter(AShift: TShiftState; AMousePos: TPoint): Boolean; -var - Event: TMouseEnterEventObj; -begin - Event := TMouseEnterEventObj.Create(Self, AShift, AMousePos); - Event.AddRef; - Result := SendEvent(Event); - if Event.NewCursor <> crDefault then - FindForm.Wnd.Cursor := Event.NewCursor; - Event.Free; -end; - -function TFWidget.GetStyle: TStyleAbs; -var - Widget: TFWidget; -begin - if Assigned(FStyle) then - Result := FStyle - else - begin - ASSERT(Assigned(Parent)); - // Don't use recursive calls here, they are not necessary - Widget := Parent; - while not Assigned(Widget.FStyle) do - begin - Widget := Widget.Parent; - ASSERT(Assigned(Widget)); - end; - Result := Widget.FStyle; - end; -end; - -function TFWidget.ProcessEvent(Event: TEventObj): Boolean; -var - Canvas: TFCanvas; - Matrix: TGfxMatrix; - ClientPos: TPoint; - PreparationEvent: TPreparePaintEventObj; -begin - // Handle events which must be processed before the children get them - if Event.InheritsFrom(TResizedEventObj) then - begin - if TResizedEventObj(Event).IsForced then - Include(WidgetState, wsSizeIsForced) - else - Exclude(WidgetState, wsSizeIsForced); - Resized; - Result := DistributeEvent(Event); - end - else if Event.InheritsFrom(TEnabledChangeEventObj) then - Result := EvEnabledChange(TEnabledChangeEventObj(Event)) - else if Event.InheritsFrom(TVisibilityChangeEventObj) then - Result := EvVisibilityChange(TVisibilityChangeEventObj(Event)) or DistributeEvent(Event) - else if Event.InheritsFrom(TMouseEnterEventObj) then - Result := EvMouseEnter(TMouseEnterEventObj(Event)) or DistributeEvent(Event) - else if Event.InheritsFrom(TPreparePaintEventObj) then - begin - Canvas := TPreparePaintEventObj(Event).Canvas; - if wsOpaque in WidgetStyle then - begin - Canvas.ExcludeClipRect(BoundsRect); - Result := False; - end - else - begin - Matrix := Canvas.Matrix; - ClientPos := ClientToWidget(Origin); - Canvas.AppendTranslation(ClientPos); - Result := DistributeEvent(Event); - Canvas.Matrix := Matrix; - end; - end - else if Event.InheritsFrom(TPaintEventObj) then - begin - Canvas := TPaintEventObj(Event).Canvas; - Canvas.SaveState; - PreparationEvent := TPreparePaintEventObj.Create(Self, Canvas); - DistributeEvent(PreparationEvent); - PreparationEvent.Release; - Paint(Canvas); - Canvas.RestoreState; - Result := DistributeEvent(Event); - end - else - begin - // First distribute the event to all children, then try to handle them here - Result := DistributeEvent(Event); - if not Result then - begin - if Event.InheritsFrom(TCalcSizesEventObj) then - EvCalcSizes(TCalcSizesEventObj(Event)) -{ if Event.InheritsFrom(TUpdateEventObj) then - Result := EvUpdate(TUpdateEventObj(Event))} - else if Event.InheritsFrom(TMousePressedEventObj) then - Result := EvMousePressed(TMousePressedEventObj(Event)) - else if Event.InheritsFrom(TMouseReleasedEventObj) then - Result := EvMouseReleased(TMouseReleasedEventObj(Event)) - else if Event.InheritsFrom(TMouseLeaveEventObj) then - Result := EvMouseLeave(TMouseLeaveEventObj(Event)) - else if Event.InheritsFrom(TMouseLeaveCheckEventObj) then - Result := EvMouseLeaveCheck(TMouseLeaveCheckEventObj(Event)); - end; - end; -end; - -function TFWidget.DistributeEvent(Event: TEventObj): Boolean; -begin - // Do nothing here, as TFWidget itself doesn't have children - Result := False; -end; - -procedure TFWidget.SetParent(AParent: TFWidget); -begin - // !!!: reparenting when changing the form is not possible - if AParent <> FParent then - begin - // Remove the widget from the old parent, if it had a parent... - if Assigned(FParent) and FParent.InheritsFrom(TFContainerWidget) then - TFContainerWidget(FParent).RemoveChild(Self); - - FParent := AParent; - - // ...and add it to the new parent, if existent. - if Assigned(Parent) and Parent.InheritsFrom(TFContainerWidget) then - TFContainerWidget(Parent).InsertChild(Self); - end; -end; - -procedure TFWidget.SetColor(const AValue: TColor); -begin - if FColor=AValue then exit; - FColor:=AValue; -end; - -function TFWidget.GetBoundsRect: TRect; -begin - Result.TopLeft := Origin; - Result.BottomRight := Origin + BoundsSize; -end; - -function TFWidget.GetLeft: Integer; -begin - Result := Origin.x; -end; - -function TFWidget.GetTop: Integer; -begin - Result := Origin.y; -end; - -function TFWidget.GetWidth: Integer; -begin - Result := BoundsSize.cx; -end; - -function TFWidget.GetHeight: Integer; -begin - Result := BoundsSize.cy; -end; - -procedure TFWidget.SetCanExpandWidth(allow: Boolean); -begin - if FCanExpandWidth <> allow then - begin - FCanExpandWidth := allow; - Update; - end; -end; - -procedure TFWidget.SetCanExpandHeight(allow: Boolean); -begin - if FCanExpandHeight <> allow then - begin - FCanExpandHeight := allow; - Update; - end; -end; - -procedure TFWidget.SetText(const AText: String); -begin - if AText <> Text then - begin - FText := AText; - EvTextChanged; - end; -end; - -function TFWidget.EvCalcSizes(Event: TCalcSizesEventObj): Boolean; -begin - LAYOUTTRACE('TFWidget.EvCalcSizes for %s:%s', [Name, ClassName]); - - FMinSize := Size(0, 0); - FMaxSize := Size(InfiniteSize, InfiniteSize); - FDefSize := Size(0, 0); - - CalcSizes; - - if MinSize.cx = 0 then FMinSize.cx := 1; - if MinSize.cy = 0 then FMinSize.cy := 1; - if DefSize.cx < MinSize.cx then FDefSize.cx := MinSize.cx; - if DefSize.cy < MinSize.cy then FDefSize.cy := MinSize.cy; - - if (not FCanExpandWidth) or (MaxSize.cx < DefSize.cx) then - FMaxSize.cx := DefSize.cx; - if (not FCanExpandHeight) or (MaxSize.cy < DefSize.cy) then - FMaxSize.cy := DefSize.cy; - - Result := False; -end; - -function TFWidget.EvEnabledChange(Event: TEnabledChangeEventObj): Boolean; -var - NewState: Boolean; -begin - if Assigned(Parent) then - NewState := Enabled and (wsEnabled in Parent.WidgetState) - else - NewState := Enabled; - - if NewState and not (wsEnabled in WidgetState) then - begin - Include(WidgetState, wsEnabled); - Redraw; - Result := DistributeEvent(Event); - end else if (not NewState) and (wsEnabled in WidgetState) then - begin - Exclude(WidgetState, wsEnabled); - if wsHasFocus in WidgetState then - FindForm.FocusedWidget := nil; - Redraw; - Result := DistributeEvent(Event); - end else - Result := False; -end; - -function TFWidget.EvVisibilityChange(Event: TVisibilityChangeEventObj): Boolean; -begin - if Visible then - begin - if (not Assigned(Parent)) or (wsIsVisible in Parent.WidgetState) then - Include(WidgetState, wsIsVisible); - end else - Exclude(WidgetState, wsIsVisible); - - Result := False; -end; - -function TFWidget.EvMousePressed(Event: TMousePressedEventObj): Boolean; -begin - if (wsClickable in WidgetStyle) and (wsEnabled in WidgetState) and - (Event.Button = mbLeft) then - begin - if wsCaptureMouse in WidgetStyle then - FindForm.MouseCaptureWidget := Self; - Include(WidgetState, wsClicked); - Include(WidgetState, wsHasFocus); - SetFocus; - Redraw; - Result := True; - end - else - Result := False; -end; - -function TFWidget.EvMouseReleased(Event: TMouseReleasedEventObj): Boolean; -begin - if (wsClickable in WidgetStyle) and (wsEnabled in WidgetState) and - (Event.Button = mbLeft) then - begin - if wsClicked in WidgetState then - begin - Exclude(WidgetState, wsClicked); - with Event do - if (Position.x >= 0) and (Position.y >= 0) - and (Position.x < BoundsSize.cx) - and (Position.y < BoundsSize.cy) then - Click - else - Redraw; - end; - if wsCaptureMouse in WidgetStyle then - FindForm.MouseCaptureWidget := nil; - Result := True; - end else - Result := False; -end; - -function TFWidget.EvMouseEnter(Event: TMouseEnterEventObj): Boolean; -begin - Include(WidgetState, wsMouseInside); - if Cursor <> crDefault then - Event.NewCursor := Cursor; - if (wsClickable in WidgetStyle) and (wsClicked in WidgetState) and - (wsEnabled in WidgetState) then - Redraw; - Result := False; - {$IFDEF DEBUG} - WriteLn('Mouse entered ', Name, ':', ClassName, '. New cursor: ', Ord(Event.NewCursor)); - {$ENDIF} -end; - -function TFWidget.EvMouseLeave(Event: TMouseLeaveEventObj): Boolean; -begin - Exclude(WidgetState, wsMouseInside); - if (wsClickable in WidgetStyle) and (wsClicked in WidgetState) and - (wsEnabled in WidgetState) then - Redraw; - Result := False; - {$IFDEF DEBUG} - WriteLn('Mouse left ', Name, ':', ClassName); - {$ENDIF} -end; - -function TFWidget.EvMouseLeaveCheck(Event: TMouseLeaveCheckEventObj): Boolean; -begin - if ((Event.Position.x < 0) or (Event.Position.y < 0) or - (Event.Position.x >= BoundsSize.cx) or - (Event.Position.y >= BoundsSize.cy)) then - begin - if wsMouseInside in WidgetState then - SendEvent(TMouseLeaveEventObj.Create(Self)) - end - else if (FindForm.MouseCaptureWidget = Self) and not (wsMouseInside in WidgetState) then - SendEvent(TMouseEnterEventObj.Create(Self, Event.Shift, Event.Position)); - - if (wsMouseInside in WidgetState) and (Event.NewCursor = crDefault) and - (Cursor <> crDefault) then - begin - Event.NewCursor := Cursor; - end; - Result := False; -end; - -{$ENDIF read_implementation} - diff --git a/gui/motifstyle.pas b/gui/motifstyle.pas deleted file mode 100644 index 5abf01e0..00000000 --- a/gui/motifstyle.pas +++ /dev/null @@ -1,174 +0,0 @@ -{ - fpGUI - Free Pascal GUI Library - - Motif style implementation - - Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this - distribution, for details of the copyright. - - See the file COPYING.modifiedLGPL, included in this distribution, - for details about redistributing fpGUI. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -} - -unit MotifStyle; - -{$mode objfpc}{$H+} - -interface - -uses - Classes - ,SysUtils - ,fpGUI - ,fpGFX - ; - - -type - - TMotifStyle = class(TBasicStyle) - public - // General - procedure DrawFocusRect(Canvas: TFCanvas; const ARect: TRect); override; - // Buttons - procedure DrawButtonFace(Canvas: TFCanvas; const ARect: TRect; Flags: TFButtonFlags); override; - // Check boxes - procedure DrawCheckBox(Canvas: TFCanvas; const ARect, LabelRect: TRect; Flags: TFCheckboxFlags); override; - end; - - -implementation - - -{ MotifStyle } - -procedure TMotifStyle.DrawButtonFace(Canvas: TFCanvas; const ARect: TRect; - Flags: TFButtonFlags); -var - r: TRect; -begin - r := ARect; - - if btnIsSelected in Flags then - begin - SetUIColor(Canvas, cl3DDkShadow); - Canvas.DrawRect(r); - Inc(r.Left); - Inc(r.Top); - Dec(r.Right); - Dec(r.Bottom); - end; - - if btnIsPressed in Flags then - begin - SetUIColor(Canvas, cl3DShadow); - Canvas.DrawRect(r); - Inc(r.Left); - Inc(r.Top); - Dec(r.Right); - Dec(r.Bottom); - end else - begin - if btnIsEmbedded in Flags then - Draw3DFrame(Canvas, r, cl3DLight, cl3DHighlight, cl3DDkShadow, cl3DShadow) - else - Draw3DFrame(Canvas, r, cl3DHighlight, cl3DLight, cl3DDkShadow, cl3DShadow); - Inc(r.Left, 2); - Inc(r.Top, 2); - Dec(r.Right, 2); - Dec(r.Bottom, 2); - end; - - SetUIColor(Canvas, cl3DFace); - Canvas.FillRect(r); - - if btnHasFocus in Flags then - begin - r.Left := ARect.Left + 4; - r.Top := ARect.Top + 4; - r.Right := ARect.Right - 4; - r.Bottom := ARect.Bottom - 4; - DrawFocusRect(Canvas, r); - end; -end; - -procedure TMotifStyle.DrawFocusRect(Canvas: TFCanvas; const ARect: TRect); -begin - SetUIColor(Canvas, clGray); - Canvas.DrawRect(ARect); -end; - -procedure TMotifStyle.DrawCheckBox(Canvas: TFCanvas; const ARect, - LabelRect: TRect; Flags: TFCheckboxFlags); -var - r: TRect; - xmid: integer; - ymid: integer; - - procedure _DrawBottomHalf; - begin - // draw the bottom \ line - Canvas.DrawLine(Point(r.Left+1, r.Top+ymid+1), Point(r.Left+xmid, r.Bottom)); - Canvas.DrawLine(Point(r.Left+2, r.Top+ymid+1), Point(r.Left+xmid, r.Bottom-1)); - Canvas.DrawLine(Point(r.Left+3, r.Top+ymid+1), Point(r.Left+xmid, r.Bottom-2)); - // draw the bottom / line - Canvas.DrawLine(Point(r.Left+xmid, r.Bottom), Point(r.Right, r.Top+ymid-1)); - Canvas.DrawLine(Point(r.Left+xmid, r.Bottom-1), Point(r.Right-1, r.Top+ymid-1)); - Canvas.DrawLine(Point(r.Left+xmid, r.Bottom-2), Point(r.Right-2, r.Top+ymid-1)); - end; - - procedure _DrawTopHalf; - begin - // draw the top / line - Canvas.DrawLine(Point(r.Left, r.Top+ymid), Point(r.Left+xmid+1, r.Top)); - Canvas.DrawLine(Point(r.Left+1, r.Top+ymid), Point(r.Left+xmid+1, r.Top+1)); - Canvas.DrawLine(Point(r.Left+2, r.Top+ymid), Point(r.Left+xmid+1, r.Top+2)); - // draw the top \ line - Canvas.DrawLine(Point(r.Left+xmid+1, r.Top+2), Point(r.Right-1, r.Top+ymid)); - Canvas.DrawLine(Point(r.Left+xmid+1, r.Top+3), Point(r.Right-2, r.Top+ymid)); - Canvas.DrawLine(Point(r.Left+xmid+1, r.Top+4), Point(r.Right-3, r.Top+ymid)); - end; - -begin - SetUIColor(Canvas, cl3DFace); - Canvas.FillRect(ARect); - - r.Left := ARect.Left; - r.Top := ARect.Top + (ARect.Bottom - ARect.Top - 13) div 2; - r.Right := 13; - r.Bottom := r.Top + 13; - xmid := ((r.Right - r.Left) div 2); - ymid := ((r.Bottom - r.Top) div 2) + 1; - - if (cbIsChecked in Flags) then - begin - SetUIColor(Canvas, clWhite); - _DrawBottomHalf; - SetUIColor(Canvas, cl3DShadow); - _DrawTopHalf; - end - else - begin - SetUIColor(Canvas, cl3DShadow); - _DrawBottomHalf; - SetUIColor(Canvas, clWhite); - _DrawTopHalf; - end; - - if cbHasFocus in Flags then - with LabelRect do - DrawFocusRect(Canvas, Rect(Left - 2, Top - 2, Right + 2, Bottom + 2)); - -end; - - -//initialization -//finalization -// gStyleManager.RegisterClass('Motif', TMotifStyle); - -end. - diff --git a/gui/opensoftstyle.pas b/gui/opensoftstyle.pas deleted file mode 100644 index cb23cc43..00000000 --- a/gui/opensoftstyle.pas +++ /dev/null @@ -1,327 +0,0 @@ -{ - fpGUI - Free Pascal GUI Library - - OpenSoft look-and-feel style implementation - - Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this - distribution, for details of the copyright. - - See the file COPYING.modifiedLGPL, included in this distribution, - for details about redistributing fpGUI. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -} - -unit OpenSoftStyle; - -{$mode objfpc}{$H+} - -interface -uses - Classes - ,fpGUI - ,gfxBase - ,fpGFX - ; - -type - - TGradientDirection = (gdTopToBottom, gdBottomToTop, gdLeftToRight, gdRightToLeft); - TCalcGradientEndX = function(Y, H: Integer): Integer; - - - { TOpenSoftStyle } - - TOpenSoftStyle = class(TBasicStyle) - private - procedure PaintGradient(pCanvas: TFCanvas; const R: TRect; StartColor, EndColor: TColor; Direction: TGradientDirection; GradLines: Integer = -1); - public - // Colors - function GetGUIColor(Color: TColor): TGfxColor; override; - // Buttons - procedure DrawButtonFace(Canvas: TFCanvas; const ARect: TRect; Flags: TFButtonFlags); override; - function GetButtonBorders: TRect; override; - // GroupBox - procedure DrawGroupBox(Canvas: TFCanvas; const ARect: TRect; const ALabel: String; WidgetState: TFWidgetState); override; - end; - - -implementation - -const - // Some predefined colors: - rgbaDkBlue: TGfxColor = (Red: $0000; Green: $0000; Blue: $8000; Alpha: $0000); - rgbaLtYellow: TGfxColor = (Red: $ffff; Green: $ffff; Blue: $e100; Alpha: $0000); - - rgbaWindowText: TGfxColor = (Red: $0000; Green: $0000; Blue: $0000; Alpha: $0000); - rgbaWindow: TGfxColor = (Red: $efef; Green: $efef; Blue: $efef; Alpha: $0000); - rgbaDkGrey: TGfxColor = (Red: $8686; Green: $8686; Blue: $8686; Alpha: $0000); - rgbaGbAALtGrey: TGfxColor = (Red: $baba; Green: $baba; Blue: $baba; Alpha: $0000); - rgbaGbAADkGrey: TGfxColor = (Red: $7878; Green: $7878; Blue: $7878; Alpha: $0000); - - -{ -procedure DrawGradient(Canvas: TCanvas; const R: TRect; StartColor, EndColor: TColor; - Direction: TGradientDirection; GradLines: Integer = -1; CalcEndX: TCalcGradientEndX = nil); -procedure DrawGradientEx(Canvas: TCanvas; const R: TRect; StartColor: TColor; - StartToMidHeight: Integer; MidColor, EndColor: TColor; - Direction: TGradientDirection; CalcEndX: TCalcGradientEndX = nil); - - -procedure ToRGB(c: TColor; out rgb: TRGB); -var - l: TColorRef; -begin - c := ColorFromColormap(c); - l := ColorToRGB(c); - rgb.r := TRGBValue(l).r; - rgb.g := TRGBValue(l).g; - rgb.b := TRGBValue(l).b; -end; -} - -{ TOpenSoftStyle } - -procedure TOpenSoftStyle.PaintGradient(pCanvas: TFCanvas; const R: TRect; - StartColor, EndColor: TColor; Direction: TGradientDirection; - GradLines: Integer = -1); -var - X: integer; - i: integer; - w: integer; - h: integer; - Count: integer; - EndCol: TGfxColor; - StartCol: TGfxColor; - AddCol: TGfxColor; - Tmp: TGfxColor; -begin -(* - w := R.Right - R.Left - 1; - h := R.Bottom - R.Top - 1; - if (w <= 0) or (h <= 0) then - Exit; //==> - - StartCol := GetGUIColor(StartColor); - EndCol := GetGUIColor(EndColor); - - case Direction of - gdTopToBottom: - Count := h; - gdLeftToRight: - Count := w; - gdBottomToTop: - begin - Count := h; - Tmp := EndCol; - EndCol := StartCol; - StartCol := Tmp; - end; - gdRightToLeft: - begin - Count := w; - Tmp := EndCol; - EndCol := StartCol; - StartCol := Tmp; - end; - else - Exit; //==> - end; - if GradLines < 0 then - GradLines := Count; - - AddCol.Red := (EndCol.Red - StartCol.Red) div GradLines; - AddCol.Green := (EndCol.Green - StartCol.Green) div GradLines; - AddCol.Blue := (EndCol.Blue - StartCol.Blue) div GradLines; - -// Canvas.Pen.Style := psSolid; - pCanvas.SaveState; -// Canvas.Start; - try -// StartColor := TColor(Round(StartCol.Red), Round(StartCol.Green), Round(StartCol.Blue)); -// Canvas.Pen.Color := StartColor; - pCanvas.SetColor(GetGUIColor(StartColor)); - for i := 0 to Count - 1 do - begin - if Direction in [gdTopToBottom, gdBottomToTop] then - begin -// pCanvas.MoveTo(R.Left, R.Top + i); -// if Assigned(CalcEndX) then -// X := CalcEndX(i, Count) -// else - X := 0; -// pCanvas.LineTo(R.Right + X, R.Top + i); - pCanvas.DrawLine(Point(R.Left, R.Top + i), Point(R.Right + X, R.Top + i)); - end - else - begin - pCanvas.DrawLine(Point(R.Left + i, R.Top), Point(R.Left + i, R.Bottom)) -// pCanvas.MoveTo(R.Left + i, R.Top); -// pCanvas.LineTo(R.Left + i, R.Bottom); - end; - StartCol.Red := StartCol.Red + AddCol.Red; - StartCol.Green := StartCol.Green + AddCol.Green; - StartCol.Blue := StartCol.Blue + AddCol.Blue; - EndColor := RGB(Round(StartCol.Red), Round(StartCol.Green), Round(StartCol.Blue)); - if StartColor <> EndColor then - begin -// Canvas.Pen.Color := EndColor; - pCanvas.SetColor(GetGUIColor(EndColor)); - StartColor := EndColor; - end; - end; // for - - finally -// Canvas.Stop; - pCanvas.RestoreState; - end; -*) -end; - - -function TOpenSoftStyle.GetGUIColor(Color: TColor): TGfxColor; -begin - Result := inherited GetGUIColor(Color); - case Color of - // UI element colors - clScrollBar: Result := GetUIColor(clLightGrey); //rgbaWindow; - clMenu: Result := GetUIColor(clLightGrey); //rgbaWindow; -// clWindow: Result := GetUIColor(clWhite); -// clMenuText: Result := GetUIColor(clBlack); -// clWindowText: Result := GetUIColor(clBlack); -// clAppWorkSpace: Result := GetUIColor(clGray); -// clHighlight: Result := GetUIColor(clNavy); -// clHighlightText: Result := GetUIColor(clWhite); - cl3DFace: Result := GetUIColor(clLightGrey); //rgbaWindow; -// cl3DShadow: Result := rgbaDkWhite; -// clGrayText: Result := GetUIColor(clGray); -// clBtnText: Result := GetUIColor(clBlack); -// cl3DHighlight: Result := GetUIColor(clWhite); - cl3DDkShadow: Result := GetUIColor(clBlack); -// cl3DLight: Result := GetUIColor(clDarkWhite); -// clInfoText: Result := GetUIColor(clBlack); -// clInfoBk: Result := GetUIColor(clLightYellow); -// -// else Result := GetUIColor(clWhite); - end; - -end; - -procedure TOpenSoftStyle.DrawButtonFace(Canvas: TFCanvas; const ARect: TRect; - Flags: TFButtonFlags); -var - r: TRect; -begin - r := ARect; - - if btnIsSelected in Flags then - begin - SetUIColor(Canvas, cl3DDkShadow); - Canvas.DrawRect(r); - Inc(r.Left); - Inc(r.Top); - Dec(r.Right); - Dec(r.Bottom); - end; - - if btnIsPressed in Flags then - begin - SetUIColor(Canvas, cl3DShadow); - Canvas.DrawRect(r); - Inc(r.Left); - Inc(r.Top); - Dec(r.Right); - Dec(r.Bottom); - end else - begin - if btnIsEmbedded in Flags then - Draw3DFrame(Canvas, r, cl3DLight, cl3DFace, cl3DDkShadow, cl3DShadow) - else - Draw3DFrame(Canvas, r, cl3DHighlight, cl3DFace, cl3DDkShadow, cl3DShadow); - Inc(r.Left, 2); - Inc(r.Top, 2); - Dec(r.Right, 2); - Dec(r.Bottom, 2); - end; - - SetUIColor(Canvas, cl3DFace); - Canvas.FillRect(r); - - if btnHasFocus in Flags then - begin - r.Left := ARect.Left + 4; - r.Top := ARect.Top + 4; - r.Right := ARect.Right - 4; - r.Bottom := ARect.Bottom - 4; - DrawFocusRect(Canvas, r); - end; -end; - -function TOpenSoftStyle.GetButtonBorders: TRect; -begin - Result := Rect(4, 4, 4, 4); -end; - -procedure TOpenSoftStyle.DrawGroupBox(Canvas: TFCanvas; const ARect: TRect; - const ALabel: String; WidgetState: TFWidgetState); -var - TitleWidth, TitleHeight, TopLine: Integer; -begin - TitleWidth := Canvas.TextWidth(ALabel); - TitleHeight := Canvas.FontCellHeight; - TopLine := ARect.Top + TitleHeight div 3; - - Canvas.SetColor(rgbaDkGrey); - // box outline - with ARect do - begin - // top - Canvas.DrawLine(Point(Left + 2, TopLine), Point(Left + 12, TopLine)); - Canvas.DrawLine(Point(Left + TitleWidth + 16, TopLine), Point(Right - 2, TopLine)); - // right - Canvas.DrawLine(Point(Right-1, TopLine + 2), Point(Right-1, Bottom - 2)); - // bottom - Canvas.DrawLine(Point(Right - 3, Bottom-1), Point(Left + 1, Bottom-1)); - // left - Canvas.DrawLine(Point(Left, Bottom - 3), Point(Left, TopLine + 1)); - end; - - // Text caption - SetUIColor(Canvas, clWindowText); - DrawText(Canvas, ARect.TopLeft + Point(14, 0), ALabel, WidgetState); - - { Anti-Aliasing - Top/Left } - Canvas.SetColor(rgbaGbAALtGrey); - Canvas.DrawPoint(ARect.TopLeft + Point(0, TopLine+1)); - Canvas.DrawPoint(ARect.TopLeft + Point(1, TopLine)); - Canvas.SetColor(rgbaGbAADkGrey); - Canvas.DrawPoint(ARect.TopLeft + Point(1, TopLine+1)); - { Anti-Aliasing - Top/Right } - Canvas.SetColor(rgbaGbAALtGrey); - Canvas.DrawPoint(ARect.TopLeft + Point(ARect.Right-1, TopLine+1)); - Canvas.DrawPoint(ARect.TopLeft + Point(ARect.Right-2, TopLine)); - Canvas.SetColor(rgbaGbAADkGrey); - Canvas.DrawPoint(ARect.TopLeft + Point(ARect.Right-2, TopLine+1)); - { Anti-Aliasing - Bottom/Right } - Canvas.SetColor(rgbaGbAALtGrey); - Canvas.DrawPoint(ARect.TopLeft + Point(ARect.Right-1, ARect.Bottom-2)); - Canvas.DrawPoint(ARect.TopLeft + Point(ARect.Right-2, ARect.Bottom-1)); - Canvas.SetColor(rgbaGbAADkGrey); - Canvas.DrawPoint(ARect.TopLeft + Point(ARect.Right-2, ARect.Bottom-2)); - { Anti-Aliasing - Bottom/Left } - Canvas.SetColor(rgbaGbAALtGrey); - Canvas.DrawPoint(ARect.TopLeft + Point(0, ARect.Bottom-2)); - Canvas.DrawPoint(ARect.TopLeft + Point(1, ARect.Bottom-1)); - Canvas.SetColor(rgbaGbAADkGrey); - Canvas.DrawPoint(ARect.TopLeft + Point(1, ARect.Bottom-2)); -end; - - -//initialization -//finalization -// gStyleManager.RegisterClass('OpenSoft', TOpenSoftStyle); - -end. - diff --git a/gui/stylemanager.pas b/gui/stylemanager.pas deleted file mode 100644 index 1c5a82e5..00000000 --- a/gui/stylemanager.pas +++ /dev/null @@ -1,220 +0,0 @@ -{ - fpGUI - Free Pascal GUI Library - - Style Manager as a Singleton - - Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this - distribution, for details of the copyright. - - See the file COPYING.modifiedLGPL, included in this distribution, - for details about redistributing fpGUI. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -} - -unit StyleManager; - -{$mode objfpc}{$H+} - -interface - -uses - Classes - ,Contnrs - ,fpGUI - ; - -const - cDefaultStyle = 'auto'; - -type - - // A class reference for the TStyle descendants - TStyleClass = class of TStyleAbs; - - - // A class to hold the TStyle class mappings. The factory maintains - // a list of these and uses the StyleClass property to create the objects. - TStyleClassMapping = class(TObject) - private - FsMappingName: string; - FStyleClass: TStyleClass; - public - constructor Create(const AMappingName: string; AStyleClass: TStyleClass); overload; - property MappingName: string read FsMappingName; - property StyleClass: TStyleClass read FStyleClass; - end; - - - // Style manager and factory class - - { TStyleManager } - - TStyleManager = class(TObject) - private - FList : TObjectList; - FDefaultStyle: TStyleAbs; - FUserStyle: TStyleAbs; - FDefaultStyleType: string; - function GetDefaultStyle: TStyleAbs; - public - constructor Create; - destructor Destroy; override; - property DefaultStyle: TStyleAbs read GetDefaultStyle; - procedure SetStyle(const AStyleName: string); - procedure RegisterClass(const AStyleName: string; AStyleClass : TStyleClass); - function CreateInstance(const AStyleName: string): TStyleAbs; overload; - function CreateInstance: TStyleAbs; overload; - procedure AssignStyleTypes(AStrings: TStrings); - end; - - -// Singleton -function gStyleManager: TStyleManager; - - -implementation -uses - SysUtils - ,fpGFX - ,WindowsStyle - ,OpenSoftStyle - ,MotifStyle - ; - -var - uStyleManager: TStyleManager; - - -{ Creation is deferred to the first request } -function gStyleManager: TStyleManager; -begin - if uStyleManager = nil then - uStyleManager := TStyleManager.Create; - result := uStyleManager; -end; - - -{ TStyleManager } - -function TStyleManager.GetDefaultStyle: TStyleAbs; -begin - if not Assigned(FDefaultStyle) then -// FDefaultStyle.Free; - FDefaultStyle := CreateInstance(FDefaultStyleType); - Result := FDefaultStyle; -end; - -constructor TStyleManager.Create; -begin - inherited Create; - FList := TObjectList.Create; - FUserStyle := nil; - FDefaultStyle := nil; - FDefaultStyleType := cDefaultStyle; // will change later -end; - -destructor TStyleManager.Destroy; -begin - FDefaultStyle.Free; - FList.Free; - inherited Destroy; -end; - -procedure TStyleManager.SetStyle(const AStyleName: string); -var - i: integer; -begin - for i := 0 to FList.Count - 1 do - if UpperCase(TStyleClassMapping(FList.Items[i]).MappingName) = - UpperCase(AStyleName) then - begin - FDefaultStyleType := AStyleName; - Break; //==> - end; - - Assert(FDefaultStyleType <> AStyleName, - Format('<%s> does not identify a registered style class.', - [AStyleName])); -end; - -// Register a TStyle class for creation by the factory -procedure TStyleManager.RegisterClass(const AStyleName: string; - AStyleClass: TStyleClass); -var - i: integer; -begin - for i := 0 to FList.Count - 1 do - if UpperCase(TStyleClassMapping(FList.Items[i]).MappingName) = - UpperCase(AStyleName) then - Assert(false, - Format('Style class <%s> already registered.', - [AStyleName])); - FList.Add(TStyleClassMapping.Create(AStyleName, AStyleClass)); - -// writeln('Registering style: ' + AStyleName); - // we will use this later -// FDefaultStyleType := UpperCase(AStyleName); -end; - -// Call the factory to create an instance of TStyle -function TStyleManager.CreateInstance(const AStyleName: string): TStyleAbs; -var - i: integer; -begin - result := nil; - for i := 0 to FList.Count - 1 do - if UpperCase(TStyleClassMapping(FList.Items[i]).MappingName) = - UpperCase(AStyleName) then - begin - result := TStyleClassMapping(FList.Items[i]).StyleClass.Create; - Break; //==> - end; - - Assert(result <> nil, - Format('<%s> does not identify a registered style class.', - [AStyleName])); -end; - -function TStyleManager.CreateInstance: TStyleAbs; -begin - result := CreateInstance(FDefaultStyleType); -end; - -// Assing the registered list of TStyle names to a StringList -// This can be used to populate a combobox with the available TStyle -// class types. -procedure TStyleManager.AssignStyleTypes(AStrings: TStrings); -var - i: integer; -begin - AStrings.Clear; - for i := 0 to FList.Count - 1 do - AStrings.Add(TStyleClassMapping(FList.Items[i]).MappingName); -end; - -{ TStyleClassMapping } - -constructor TStyleClassMapping.Create(const AMappingName: string; - AStyleClass: TStyleClass); -begin - inherited Create; - FsMappingName := AMappingName; - FStyleClass := AStyleClass; -end; - - -initialization - gStyleManager.RegisterClass(cDefaultStyle, TWin2000Style); - gStyleManager.RegisterClass('Windows 9x', TWin9xStyle); - gStyleManager.RegisterClass('Windows 2000', TWin2000Style); - gStyleManager.RegisterClass('OpenSoft', TOpenSoftStyle); - gStyleManager.RegisterClass('Motif', TMotifStyle); - -finalization - uStyleManager.Free; - -end. - diff --git a/gui/win32/defstyle.inc b/gui/win32/defstyle.inc deleted file mode 100644 index 41c36f5f..00000000 --- a/gui/win32/defstyle.inc +++ /dev/null @@ -1,47 +0,0 @@ -{ - fpGUI - Free Pascal GUI Library - - Basic Style implementation for Win32 - - Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this - distribution, for details of the copyright. - - See the file COPYING.modifiedLGPL, included in this distribution, - for details about redistributing fpGUI. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -} - -{$DEFINE Has_DefaultStyle_GetGUIColor} - -function TBasicStyle.GetGUIColor(Color: TColor): TGfxColor; -begin - Color := Windows.GetSysColor(Color and $ffff); - Result.Red := (Color and $ff) * 257; - Result.Green := ((Color shr 8) and $ff) * 257; - Result.Blue := ((Color shr 16) and $ff) * 257; - Result.Alpha := 0; -end; - - -{$DEFINE Has_DefaultStyle_DrawFocusRect} - -procedure TBasicStyle.DrawFocusRect(Canvas: TFCanvas; const ARect: TRect); -var - Rect: Windows.TRect; -begin - if Canvas.InheritsFrom(TGDICanvas) then - begin - Rect := RectToWinRect(Canvas.Transform(ARect)); - Windows.DrawFocusRect(TGDICanvas(Canvas).Handle, Rect) - end - else - begin - Canvas.SetColor(GetGUIColor(clGray)); - Canvas.DrawRect(ARect); - end; -end; - - diff --git a/gui/windowsstyle.pas b/gui/windowsstyle.pas deleted file mode 100644 index 08eca3a0..00000000 --- a/gui/windowsstyle.pas +++ /dev/null @@ -1,111 +0,0 @@ -{ - fpGUI - Free Pascal GUI Library - - Windows style implementation - - Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this - distribution, for details of the copyright. - - See the file COPYING.modifiedLGPL, included in this distribution, - for details about redistributing fpGUI. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -} - -unit WindowsStyle; - -{$mode objfpc}{$H+} - -interface - -uses - Classes - ,SysUtils - ,fpGUI - ,fpgfx - ; - - -type - - TWindowsStyle = class(TBasicStyle) - end; - - // Win95 and Win98 look. ie: Buttons are different - TWin9xStyle = class(TWindowsStyle) - end; - - - // Win2000 look. ie: Again the buttons are different (more flat) - TWin2000Style = class(TWindowsStyle) - public - // Buttons - procedure DrawButtonFace(Canvas: TFCanvas; const ARect: TRect; Flags: TFButtonFlags); override; - function GetButtonBorders: TRect; override; - end; - - -implementation - - -{ TWin2000Style } - -procedure TWin2000Style.DrawButtonFace(Canvas: TFCanvas; const ARect: TRect; - Flags: TFButtonFlags); -var - r: TRect; -begin - r := ARect; - - if btnIsSelected in Flags then - begin - SetUIColor(Canvas, cl3DDkShadow); - Canvas.DrawRect(r); - Inc(r.Left); - Inc(r.Top); - Dec(r.Right); - Dec(r.Bottom); - end; - - if btnIsPressed in Flags then - begin - SetUIColor(Canvas, cl3DShadow); - Canvas.DrawRect(r); - Inc(r.Left); - Inc(r.Top); - Dec(r.Right); - Dec(r.Bottom); - end else - begin - if btnIsEmbedded in Flags then - Draw3DFrame(Canvas, r, cl3DLight, cl3DFace, cl3DDkShadow, cl3DShadow) - else - Draw3DFrame(Canvas, r, cl3DHighlight, cl3DFace, cl3DDkShadow, cl3DShadow); - Inc(r.Left, 2); - Inc(r.Top, 2); - Dec(r.Right, 2); - Dec(r.Bottom, 2); - end; - - SetUIColor(Canvas, cl3DFace); - Canvas.FillRect(r); - - if btnHasFocus in Flags then - begin - r.Left := ARect.Left + 4; - r.Top := ARect.Top + 4; - r.Right := ARect.Right - 4; - r.Bottom := ARect.Bottom - 4; - DrawFocusRect(Canvas, r); - end; -end; - -function TWin2000Style.GetButtonBorders: TRect; -begin - Result := Rect(4, 4, 4, 4); -end; - -end. - -- cgit v1.2.3-70-g09d2