From b42f9e541f41adce59bd5696ab88ba17034b86e7 Mon Sep 17 00:00:00 2001 From: vincents Date: Thu, 10 Jun 2004 18:14:10 +0000 Subject: [PATCH] converted win32proc.inc to unit git-svn-id: trunk@5549 - --- .gitattributes | 1 + lcl/interfaces/win32/Makefile | 306 +++++++--- lcl/interfaces/win32/Makefile.fpc | 2 +- lcl/interfaces/win32/win32int.pp | 15 +- lcl/interfaces/win32/win32object.inc | 5 +- lcl/interfaces/win32/win32proc.pp | 832 +++++++++++++++++++++++++++ lcl/interfaces/win32/win32winapi.inc | 5 +- 7 files changed, 1079 insertions(+), 87 deletions(-) create mode 100644 lcl/interfaces/win32/win32proc.pp diff --git a/.gitattributes b/.gitattributes index 1566a62128..9af738c198 100644 --- a/.gitattributes +++ b/.gitattributes @@ -1253,6 +1253,7 @@ lcl/interfaces/win32/win32listsl.inc svneol=native#text/pascal lcl/interfaces/win32/win32listslh.inc svneol=native#text/pascal lcl/interfaces/win32/win32object.inc svneol=native#text/pascal lcl/interfaces/win32/win32proc.inc svneol=native#text/pascal +lcl/interfaces/win32/win32proc.pp svneol=native#text/pascal lcl/interfaces/win32/win32winapi.inc svneol=native#text/pascal lcl/interfaces/win32/win32winapih.inc svneol=native#text/pascal lcl/interfaces/win32/win32wsactnlist.pp svneol=native#text/pascal diff --git a/lcl/interfaces/win32/Makefile b/lcl/interfaces/win32/Makefile index 77875410ba..1715b8f515 100644 --- a/lcl/interfaces/win32/Makefile +++ b/lcl/interfaces/win32/Makefile @@ -1,15 +1,24 @@ # -# Don't edit, this file is generated by FPCMake Version 1.1 [2003/12/19] +# Don't edit, this file is generated by FPCMake Version 1.1 [2004/06/03] # default: all MAKEFILETARGETS=linux go32v2 win32 os2 freebsd beos netbsd amiga atari sunos qnx netware openbsd wdosx palmos macos darwin emx watcom -override PATH:=$(subst \,/,$(PATH)) +BSDs = freebsd netbsd openbsd darwin +UNIXs = linux $(BSDs) sunos qnx +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),) @@ -37,22 +46,13 @@ ifneq ($(findstring cygdrive,$(PATH)),) inCygWin=1 endif endif -ifeq ($(OS_TARGET),freebsd) -BSDhier=1 -endif -ifeq ($(OS_TARGET),netbsd) -BSDhier=1 -endif -ifeq ($(OS_TARGET),openbsd) -BSDhier=1 -endif ifdef inUnix -BATCHEXT=.sh +SRCBATCHEXT=.sh else ifdef inOS2 -BATCHEXT=.cmd +SRCBATCHEXT=.cmd else -BATCHEXT=.bat +SRCBATCHEXT=.bat endif endif ifdef inUnix @@ -154,6 +154,12 @@ ifeq ($(findstring $(OS_TARGET),$(MAKEFILETARGETS)),) $(error The Makefile doesn't support target $(OS_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 CROSSCOMPILE ifdef FPCDIR override FPCDIR:=$(subst \,/,$(FPCDIR)) @@ -183,11 +189,14 @@ 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 CROSSDIR CROSSDIR:=$(FPCDIR)/cross/$(FULL_TARGET) endif @@ -205,7 +214,7 @@ endif PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/extra) override PACKAGE_NAME=lazarus/lcl override TARGET_UNITS+=interfaces -override TARGET_IMPLICITUNITS+=winext win32def win32int +override TARGET_IMPLICITUNITS+=winext win32def win32proc win32int override CLEAN_FILES+=$(wildcard $(COMPILER_UNITTARGETDIR)/*$(OEXT)) $(wildcard $(COMPILER_UNITTARGETDIR)/*$(PPUEXT)) $(wildcard $(COMPILER_UNITTARGETDIR)/*$(STATICLIBEXT)) $(wildcard $(COMPILER_UNITTARGETDIR)/*$(RSTEXT)) $(wildcard *$(OEXT)) $(wildcard *$(PPUEXT)) $(wildcard *$(RSTEXT)) override COMPILER_OPTIONS+=-gl override COMPILER_UNITDIR+=../../units/$(CPU_TARGET)/$(OS_TARGET) . @@ -217,42 +226,12 @@ ifdef REQUIRE_PACKAGESDIR override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR) endif ifdef ZIPINSTALL -ifeq ($(OS_TARGET),linux) -UNIXINSTALLDIR=1 -endif -ifeq ($(OS_TARGET),freebsd) -UNIXINSTALLDIR=1 -endif -ifeq ($(OS_TARGET),netbsd) -UNIXINSTALLDIR=1 -endif -ifeq ($(OS_TARGET),openbsd) -UNIXINSTALLDIR=1 -endif -ifeq ($(OS_TARGET),sunos) -UNIXINSTALLDIR=1 -endif -ifeq ($(OS_TARGET),qnx) -UNIXINSTALLDIR=1 +ifneq ($(findstring $(OS_TARGET),$(UNIXs)),) +UNIXHier=1 endif else -ifeq ($(OS_SOURCE),linux) -UNIXINSTALLDIR=1 -endif -ifeq ($(OS_SOURCE),freebsd) -UNIXINSTALLDIR=1 -endif -ifeq ($(OS_SOURCE),netbsd) -UNIXINSTALLDIR=1 -endif -ifeq ($(OS_SOURCE),openbsd) -UNIXINSTALLDIR=1 -endif -ifeq ($(OS_TARGET),sunos) -UNIXINSTALLDIR=1 -endif -ifeq ($(OS_TARGET),qnx) -UNIXINSTALLDIR=1 +ifneq ($(findstring $(OS_SOURCE),$(UNIXs)),) +UNIXHier=1 endif endif ifndef INSTALL_PREFIX @@ -261,7 +240,7 @@ INSTALL_PREFIX=$(PREFIX) endif endif ifndef INSTALL_PREFIX -ifdef UNIXINSTALLDIR +ifdef UNIXHier INSTALL_PREFIX=/usr/local else ifdef INSTALL_FPCPACKAGE @@ -280,7 +259,7 @@ DIST_DESTDIR:=$(BASEDIR) endif export DIST_DESTDIR ifndef INSTALL_BASEDIR -ifdef UNIXINSTALLDIR +ifdef UNIXHier ifdef INSTALL_FPCPACKAGE INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION) else @@ -291,7 +270,7 @@ INSTALL_BASEDIR:=$(INSTALL_PREFIX) endif endif ifndef INSTALL_BINDIR -ifdef UNIXINSTALLDIR +ifdef UNIXHier ifdef CROSSCOMPILE INSTALL_BINDIR:=$(INSTALL_BASEDIR)/cross/$(FULL_TARGET)/bin else @@ -321,19 +300,23 @@ endif endif endif ifndef INSTALL_LIBDIR -ifdef UNIXINSTALLDIR +ifdef UNIXHier INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib else INSTALL_LIBDIR:=$(INSTALL_UNITDIR) endif endif ifndef INSTALL_SOURCEDIR -ifdef UNIXINSTALLDIR +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) @@ -356,12 +339,16 @@ endif endif endif ifndef INSTALL_DOCDIR -ifdef UNIXINSTALLDIR +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 @@ -376,20 +363,28 @@ endif endif endif ifndef INSTALL_EXAMPLEDIR -ifdef UNIXINSTALLDIR +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) @@ -413,7 +408,19 @@ CROSSBINDIR= endif ifeq ($(OS_SOURCE),linux) ifndef GCCLIBDIR -GCCLIBDIR:=$(shell dirname `(gcc -v 2>&1)| head -n 1| awk '{ print $$4 } '`) +ifeq ($(CPU_TARGET),i386) +ifneq ($(findstring x86_64,$(shell uname -a)),) +ifeq ($(BINUTILSPREFIX),) +GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) +else +GCCLIBDIR:=$(shell dirname `$(BINUTILSPREFIX)gcc -print-libgcc-file-name`) +endif +else +GCCLIBDIR:=$(shell dirname `$(BINUTILSPREFIX)gcc -print-libgcc-file-name`) +endif +else +GCCLIBDIR:=$(shell dirname `$(BINUTILSPREFIX)gcc -print-libgcc-file-name`) +endif endif ifndef OTHERLIBDIR OTHERLIBDIR:=$(shell grep -v "^\#" /etc/ld.so.conf | awk '{ ORS=" "; print $1 }') @@ -425,6 +432,7 @@ OTHERLIBDIR+=/usr/pkg/lib endif export GCCLIBDIR OTHERLIB endif +BATCHEXT=.bat LOADEREXT=.as EXEEXT=.exe PPLEXT=.ppl @@ -457,24 +465,28 @@ ASMEXT=.asm SHAREDLIBEXT=.dll endif ifeq ($(OS_TARGET),linux) +BATCHEXT=.sh EXEEXT= HASSHAREDLIB=1 FPCMADE=fpcmade.lnx ZIPSUFFIX=linux endif ifeq ($(OS_TARGET),freebsd) +BATCHEXT=.sh EXEEXT= HASSHAREDLIB=1 FPCMADE=fpcmade.freebsd ZIPSUFFIX=freebsd endif ifeq ($(OS_TARGET),netbsd) +BATCHEXT=.sh EXEEXT= HASSHAREDLIB=1 FPCMADE=fpcmade.netbsd ZIPSUFFIX=netbsd endif ifeq ($(OS_TARGET),openbsd) +BATCHEXT=.sh EXEEXT= HASSHAREDLIB=1 FPCMADE=fpcmade.openbsd @@ -486,6 +498,7 @@ FPCMADE=fpcmade.w32 ZIPSUFFIX=w32 endif ifeq ($(OS_TARGET),os2) +BATCHEXT=.cmd AOUTEXT=.out STATICLIBPREFIX= SHAREDLIBEXT=.dll @@ -494,6 +507,7 @@ ZIPSUFFIX=os2 ECHO=echo endif ifeq ($(OS_TARGET),emx) +BATCHEXT=.cmd AOUTEXT=.out STATICLIBPREFIX= SHAREDLIBEXT=.dll @@ -511,16 +525,19 @@ EXEEXT=.ttp FPCMADE=fpcmade.ata endif ifeq ($(OS_TARGET),beos) +BATCHEXT=.sh EXEEXT= FPCMADE=fpcmade.be ZIPSUFFIX=be endif ifeq ($(OS_TARGET),sunos) +BATCHEXT=.sh EXEEXT= FPCMADE=fpcmade.sun ZIPSUFFIX=sun endif ifeq ($(OS_TARGET),qnx) +BATCHEXT=.sh EXEEXT= FPCMADE=fpcmade.qnx ZIPSUFFIX=qnx @@ -532,10 +549,14 @@ FPCMADE=fpcmade.nw ZIPSUFFIX=nw endif ifeq ($(OS_TARGET),macos) +BATCHEXT= EXEEXT= -FPCMADE=fpcmade.mcc +FPCMADE=fpcmade.macos +ZIPSUFFIX=macos +DEBUGSYMEXT=.xcoff endif ifeq ($(OS_TARGET),darwin) +BATCHEXT=.sh EXEEXT= HASSHAREDLIB=1 FPCMADE=fpcmade.darwin @@ -564,24 +585,28 @@ FPCMADE=fpcmade.dos ZIPSUFFIX=watcom endif ifeq ($(OS_TARGET),linux) +BATCHEXT=.sh EXEEXT= HASSHAREDLIB=1 FPCMADE=fpcmade.lnx ZIPSUFFIX=linux endif ifeq ($(OS_TARGET),freebsd) +BATCHEXT=.sh EXEEXT= HASSHAREDLIB=1 FPCMADE=fpcmade.freebsd ZIPSUFFIX=freebsd endif ifeq ($(OS_TARGET),netbsd) +BATCHEXT=.sh EXEEXT= HASSHAREDLIB=1 FPCMADE=fpcmade.netbsd ZIPSUFFIX=netbsd endif ifeq ($(OS_TARGET),openbsd) +BATCHEXT=.sh EXEEXT= HASSHAREDLIB=1 FPCMADE=fpcmade.openbsd @@ -598,6 +623,7 @@ FPCMADE=fpcmade.w32 ZIPSUFFIX=w32 endif ifeq ($(OS_TARGET),os2) +BATCHEXT=.cmd PPUEXT=.ppo ASMEXT=.so2 OEXT=.oo2 @@ -630,6 +656,7 @@ EXEEXT=.ttp FPCMADE=fpcmade.ata endif ifeq ($(OS_TARGET),beos) +BATCHEXT=.sh PPUEXT=.ppu ASMEXT=.s OEXT=.o @@ -640,6 +667,7 @@ FPCMADE=fpcmade.be ZIPSUFFIX=be endif ifeq ($(OS_TARGET),sunos) +BATCHEXT=.sh PPUEXT=.ppu ASMEXT=.s OEXT=.o @@ -650,6 +678,7 @@ FPCMADE=fpcmade.sun ZIPSUFFIX=sun endif ifeq ($(OS_TARGET),qnx) +BATCHEXT=.sh PPUEXT=.ppu ASMEXT=.s OEXT=.o @@ -672,13 +701,15 @@ ZIPSUFFIX=nw EXEEXT=.nlm endif ifeq ($(OS_TARGET),macos) +BATCHEXT= PPUEXT=.ppu ASMEXT=.s OEXT=.o SMARTEXT=.sl STATICLIBEXT=.a EXEEXT= -FPCMADE=fpcmade.mcc +DEBUGSYMEXT=.xcoff +FPCMADE=fpcmade.macos endif endif ifndef ECHO @@ -686,7 +717,7 @@ ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH)))) ifeq ($(ECHO),) ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH)))) ifeq ($(ECHO),) -ECHO= +ECHO= __missing_command__ else ECHO:=$(firstword $(ECHO)) endif @@ -700,7 +731,7 @@ DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH)))) ifeq ($(DATE),) DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH)))) ifeq ($(DATE),) -DATE= +DATE= __missing_command__ else DATE:=$(firstword $(DATE)) endif @@ -714,7 +745,7 @@ GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH)))) ifeq ($(GINSTALL),) GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH)))) ifeq ($(GINSTALL),) -GINSTALL= +GINSTALL= __missing_command__ else GINSTALL:=$(firstword $(GINSTALL)) endif @@ -726,7 +757,7 @@ export GINSTALL ifndef CPPROG CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH)))) ifeq ($(CPPROG),) -CPPROG= +CPPROG= __missing_command__ else CPPROG:=$(firstword $(CPPROG)) endif @@ -735,7 +766,7 @@ export CPPROG ifndef RMPROG RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH)))) ifeq ($(RMPROG),) -RMPROG= +RMPROG= __missing_command__ else RMPROG:=$(firstword $(RMPROG)) endif @@ -744,7 +775,7 @@ export RMPROG ifndef MVPROG MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH)))) ifeq ($(MVPROG),) -MVPROG= +MVPROG= __missing_command__ else MVPROG:=$(firstword $(MVPROG)) endif @@ -793,7 +824,7 @@ export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR ifndef PPUMOVE PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH)))) ifeq ($(PPUMOVE),) -PPUMOVE= +PPUMOVE= __missing_command__ else PPUMOVE:=$(firstword $(PPUMOVE)) endif @@ -802,7 +833,7 @@ export PPUMOVE ifndef FPCMAKE FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH)))) ifeq ($(FPCMAKE),) -FPCMAKE= +FPCMAKE= __missing_command__ else FPCMAKE:=$(firstword $(FPCMAKE)) endif @@ -811,7 +842,7 @@ export FPCMAKE ifndef ZIPPROG ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH)))) ifeq ($(ZIPPROG),) -ZIPPROG= +ZIPPROG= __missing_command__ else ZIPPROG:=$(firstword $(ZIPPROG)) endif @@ -820,7 +851,7 @@ export ZIPPROG ifndef TARPROG TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH)))) ifeq ($(TARPROG),) -TARPROG= +TARPROG= __missing_command__ else TARPROG:=$(firstword $(TARPROG)) endif @@ -832,9 +863,11 @@ ARNAME=$(BINUTILSPREFIX)ar RCNAME=$(BINUTILSPREFIX)rc ifneq ($(findstring 1.0.,$(FPC_VERSION)),) ifeq ($(OS_TARGET),win32) -ASNAME=as -LDNAME=ld -ARNAME=ar +ifeq ($(CROSSBINDIR),) +ASNAME=asw +LDNAME=ldw +ARNAME=arw +endif endif endif ifndef ASPROG @@ -869,7 +902,7 @@ AS=$(ASPROG) LD=$(LDPROG) RC=$(RCPROG) AR=$(ARPROG) -PPAS=ppas$(BATCHEXT) +PPAS=ppas$(SRCBATCHEXT) ifdef inUnix LDCONFIG=ldconfig else @@ -917,6 +950,7 @@ REQUIRE_PACKAGES_NETDB=1 REQUIRE_PACKAGES_LIBASYNC=1 REQUIRE_PACKAGES_PTHREADS=1 REQUIRE_PACKAGES_FCL=1 +REQUIRE_PACKAGES_PASJPEG=1 REQUIRE_PACKAGES_MYSQL=1 REQUIRE_PACKAGES_IBASE=1 REQUIRE_PACKAGES_SQLITE=1 @@ -930,6 +964,7 @@ REQUIRE_PACKAGES_NETDB=1 REQUIRE_PACKAGES_LIBASYNC=1 REQUIRE_PACKAGES_PTHREADS=1 REQUIRE_PACKAGES_FCL=1 +REQUIRE_PACKAGES_PASJPEG=1 REQUIRE_PACKAGES_MYSQL=1 REQUIRE_PACKAGES_IBASE=1 REQUIRE_PACKAGES_SQLITE=1 @@ -943,6 +978,7 @@ REQUIRE_PACKAGES_NETDB=1 REQUIRE_PACKAGES_LIBASYNC=1 REQUIRE_PACKAGES_PTHREADS=1 REQUIRE_PACKAGES_FCL=1 +REQUIRE_PACKAGES_PASJPEG=1 REQUIRE_PACKAGES_MYSQL=1 REQUIRE_PACKAGES_IBASE=1 REQUIRE_PACKAGES_SQLITE=1 @@ -956,6 +992,7 @@ REQUIRE_PACKAGES_NETDB=1 REQUIRE_PACKAGES_LIBASYNC=1 REQUIRE_PACKAGES_PTHREADS=1 REQUIRE_PACKAGES_FCL=1 +REQUIRE_PACKAGES_PASJPEG=1 REQUIRE_PACKAGES_MYSQL=1 REQUIRE_PACKAGES_IBASE=1 REQUIRE_PACKAGES_SQLITE=1 @@ -969,6 +1006,21 @@ REQUIRE_PACKAGES_NETDB=1 REQUIRE_PACKAGES_LIBASYNC=1 REQUIRE_PACKAGES_PTHREADS=1 REQUIRE_PACKAGES_FCL=1 +REQUIRE_PACKAGES_PASJPEG=1 +REQUIRE_PACKAGES_MYSQL=1 +REQUIRE_PACKAGES_IBASE=1 +REQUIRE_PACKAGES_SQLITE=1 +endif +endif +ifeq ($(OS_TARGET),linux) +ifeq ($(CPU_TARGET),arm) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_PASZLIB=1 +REQUIRE_PACKAGES_NETDB=1 +REQUIRE_PACKAGES_LIBASYNC=1 +REQUIRE_PACKAGES_PTHREADS=1 +REQUIRE_PACKAGES_FCL=1 +REQUIRE_PACKAGES_PASJPEG=1 REQUIRE_PACKAGES_MYSQL=1 REQUIRE_PACKAGES_IBASE=1 REQUIRE_PACKAGES_SQLITE=1 @@ -979,6 +1031,7 @@ ifeq ($(CPU_TARGET),i386) REQUIRE_PACKAGES_RTL=1 REQUIRE_PACKAGES_PASZLIB=1 REQUIRE_PACKAGES_FCL=1 +REQUIRE_PACKAGES_PASJPEG=1 REQUIRE_PACKAGES_NETDB=1 REQUIRE_PACKAGES_LIBASYNC=1 endif @@ -989,6 +1042,7 @@ REQUIRE_PACKAGES_RTL=1 REQUIRE_PACKAGES_PASZLIB=1 REQUIRE_PACKAGES_NETDB=1 REQUIRE_PACKAGES_FCL=1 +REQUIRE_PACKAGES_PASJPEG=1 REQUIRE_PACKAGES_MYSQL=1 REQUIRE_PACKAGES_IBASE=1 REQUIRE_PACKAGES_SQLITE=1 @@ -1000,6 +1054,7 @@ ifeq ($(CPU_TARGET),i386) REQUIRE_PACKAGES_RTL=1 REQUIRE_PACKAGES_PASZLIB=1 REQUIRE_PACKAGES_FCL=1 +REQUIRE_PACKAGES_PASJPEG=1 REQUIRE_PACKAGES_NETDB=1 REQUIRE_PACKAGES_LIBASYNC=1 endif @@ -1012,6 +1067,7 @@ REQUIRE_PACKAGES_NETDB=1 REQUIRE_PACKAGES_LIBASYNC=1 REQUIRE_PACKAGES_PTHREADS=1 REQUIRE_PACKAGES_FCL=1 +REQUIRE_PACKAGES_PASJPEG=1 REQUIRE_PACKAGES_MYSQL=1 REQUIRE_PACKAGES_IBASE=1 REQUIRE_PACKAGES_SQLITE=1 @@ -1025,6 +1081,21 @@ REQUIRE_PACKAGES_NETDB=1 REQUIRE_PACKAGES_LIBASYNC=1 REQUIRE_PACKAGES_PTHREADS=1 REQUIRE_PACKAGES_FCL=1 +REQUIRE_PACKAGES_PASJPEG=1 +REQUIRE_PACKAGES_MYSQL=1 +REQUIRE_PACKAGES_IBASE=1 +REQUIRE_PACKAGES_SQLITE=1 +endif +endif +ifeq ($(OS_TARGET),freebsd) +ifeq ($(CPU_TARGET),x86_64) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_PASZLIB=1 +REQUIRE_PACKAGES_NETDB=1 +REQUIRE_PACKAGES_LIBASYNC=1 +REQUIRE_PACKAGES_PTHREADS=1 +REQUIRE_PACKAGES_FCL=1 +REQUIRE_PACKAGES_PASJPEG=1 REQUIRE_PACKAGES_MYSQL=1 REQUIRE_PACKAGES_IBASE=1 REQUIRE_PACKAGES_SQLITE=1 @@ -1035,6 +1106,7 @@ ifeq ($(CPU_TARGET),i386) REQUIRE_PACKAGES_RTL=1 REQUIRE_PACKAGES_PASZLIB=1 REQUIRE_PACKAGES_FCL=1 +REQUIRE_PACKAGES_PASJPEG=1 REQUIRE_PACKAGES_NETDB=1 REQUIRE_PACKAGES_LIBASYNC=1 endif @@ -1046,6 +1118,7 @@ REQUIRE_PACKAGES_PASZLIB=1 REQUIRE_PACKAGES_NETDB=1 REQUIRE_PACKAGES_LIBASYNC=1 REQUIRE_PACKAGES_FCL=1 +REQUIRE_PACKAGES_PASJPEG=1 REQUIRE_PACKAGES_MYSQL=1 REQUIRE_PACKAGES_IBASE=1 REQUIRE_PACKAGES_SQLITE=1 @@ -1058,6 +1131,33 @@ REQUIRE_PACKAGES_PASZLIB=1 REQUIRE_PACKAGES_NETDB=1 REQUIRE_PACKAGES_LIBASYNC=1 REQUIRE_PACKAGES_FCL=1 +REQUIRE_PACKAGES_PASJPEG=1 +REQUIRE_PACKAGES_MYSQL=1 +REQUIRE_PACKAGES_IBASE=1 +REQUIRE_PACKAGES_SQLITE=1 +endif +endif +ifeq ($(OS_TARGET),netbsd) +ifeq ($(CPU_TARGET),powerpc) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_PASZLIB=1 +REQUIRE_PACKAGES_NETDB=1 +REQUIRE_PACKAGES_LIBASYNC=1 +REQUIRE_PACKAGES_FCL=1 +REQUIRE_PACKAGES_PASJPEG=1 +REQUIRE_PACKAGES_MYSQL=1 +REQUIRE_PACKAGES_IBASE=1 +REQUIRE_PACKAGES_SQLITE=1 +endif +endif +ifeq ($(OS_TARGET),netbsd) +ifeq ($(CPU_TARGET),sparc) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_PASZLIB=1 +REQUIRE_PACKAGES_NETDB=1 +REQUIRE_PACKAGES_LIBASYNC=1 +REQUIRE_PACKAGES_FCL=1 +REQUIRE_PACKAGES_PASJPEG=1 REQUIRE_PACKAGES_MYSQL=1 REQUIRE_PACKAGES_IBASE=1 REQUIRE_PACKAGES_SQLITE=1 @@ -1068,6 +1168,7 @@ ifeq ($(CPU_TARGET),m68k) REQUIRE_PACKAGES_RTL=1 REQUIRE_PACKAGES_PASZLIB=1 REQUIRE_PACKAGES_FCL=1 +REQUIRE_PACKAGES_PASJPEG=1 REQUIRE_PACKAGES_NETDB=1 REQUIRE_PACKAGES_LIBASYNC=1 endif @@ -1077,6 +1178,7 @@ ifeq ($(CPU_TARGET),m68k) REQUIRE_PACKAGES_RTL=1 REQUIRE_PACKAGES_PASZLIB=1 REQUIRE_PACKAGES_FCL=1 +REQUIRE_PACKAGES_PASJPEG=1 REQUIRE_PACKAGES_NETDB=1 REQUIRE_PACKAGES_LIBASYNC=1 endif @@ -1086,6 +1188,7 @@ ifeq ($(CPU_TARGET),i386) REQUIRE_PACKAGES_RTL=1 REQUIRE_PACKAGES_PASZLIB=1 REQUIRE_PACKAGES_FCL=1 +REQUIRE_PACKAGES_PASJPEG=1 REQUIRE_PACKAGES_NETDB=1 REQUIRE_PACKAGES_LIBASYNC=1 endif @@ -1095,6 +1198,7 @@ ifeq ($(CPU_TARGET),sparc) REQUIRE_PACKAGES_RTL=1 REQUIRE_PACKAGES_PASZLIB=1 REQUIRE_PACKAGES_FCL=1 +REQUIRE_PACKAGES_PASJPEG=1 REQUIRE_PACKAGES_NETDB=1 REQUIRE_PACKAGES_LIBASYNC=1 endif @@ -1104,6 +1208,7 @@ ifeq ($(CPU_TARGET),i386) REQUIRE_PACKAGES_RTL=1 REQUIRE_PACKAGES_PASZLIB=1 REQUIRE_PACKAGES_FCL=1 +REQUIRE_PACKAGES_PASJPEG=1 REQUIRE_PACKAGES_NETDB=1 REQUIRE_PACKAGES_LIBASYNC=1 endif @@ -1113,6 +1218,7 @@ ifeq ($(CPU_TARGET),i386) REQUIRE_PACKAGES_RTL=1 REQUIRE_PACKAGES_PASZLIB=1 REQUIRE_PACKAGES_FCL=1 +REQUIRE_PACKAGES_PASJPEG=1 REQUIRE_PACKAGES_NETDB=1 REQUIRE_PACKAGES_LIBASYNC=1 endif @@ -1124,6 +1230,7 @@ REQUIRE_PACKAGES_PASZLIB=1 REQUIRE_PACKAGES_NETDB=1 REQUIRE_PACKAGES_LIBASYNC=1 REQUIRE_PACKAGES_FCL=1 +REQUIRE_PACKAGES_PASJPEG=1 REQUIRE_PACKAGES_MYSQL=1 REQUIRE_PACKAGES_IBASE=1 REQUIRE_PACKAGES_SQLITE=1 @@ -1136,6 +1243,7 @@ REQUIRE_PACKAGES_PASZLIB=1 REQUIRE_PACKAGES_NETDB=1 REQUIRE_PACKAGES_LIBASYNC=1 REQUIRE_PACKAGES_FCL=1 +REQUIRE_PACKAGES_PASJPEG=1 REQUIRE_PACKAGES_MYSQL=1 REQUIRE_PACKAGES_IBASE=1 REQUIRE_PACKAGES_SQLITE=1 @@ -1146,6 +1254,7 @@ ifeq ($(CPU_TARGET),i386) REQUIRE_PACKAGES_RTL=1 REQUIRE_PACKAGES_PASZLIB=1 REQUIRE_PACKAGES_FCL=1 +REQUIRE_PACKAGES_PASJPEG=1 REQUIRE_PACKAGES_NETDB=1 REQUIRE_PACKAGES_LIBASYNC=1 endif @@ -1155,6 +1264,7 @@ ifeq ($(CPU_TARGET),m68k) REQUIRE_PACKAGES_RTL=1 REQUIRE_PACKAGES_PASZLIB=1 REQUIRE_PACKAGES_FCL=1 +REQUIRE_PACKAGES_PASJPEG=1 REQUIRE_PACKAGES_NETDB=1 REQUIRE_PACKAGES_LIBASYNC=1 endif @@ -1164,6 +1274,7 @@ ifeq ($(CPU_TARGET),powerpc) REQUIRE_PACKAGES_RTL=1 REQUIRE_PACKAGES_PASZLIB=1 REQUIRE_PACKAGES_FCL=1 +REQUIRE_PACKAGES_PASJPEG=1 REQUIRE_PACKAGES_NETDB=1 REQUIRE_PACKAGES_LIBASYNC=1 endif @@ -1172,9 +1283,14 @@ ifeq ($(OS_TARGET),darwin) ifeq ($(CPU_TARGET),powerpc) REQUIRE_PACKAGES_RTL=1 REQUIRE_PACKAGES_PASZLIB=1 -REQUIRE_PACKAGES_FCL=1 REQUIRE_PACKAGES_NETDB=1 REQUIRE_PACKAGES_LIBASYNC=1 +REQUIRE_PACKAGES_PTHREADS=1 +REQUIRE_PACKAGES_FCL=1 +REQUIRE_PACKAGES_PASJPEG=1 +REQUIRE_PACKAGES_MYSQL=1 +REQUIRE_PACKAGES_IBASE=1 +REQUIRE_PACKAGES_SQLITE=1 endif endif ifeq ($(OS_TARGET),emx) @@ -1182,6 +1298,7 @@ ifeq ($(CPU_TARGET),i386) REQUIRE_PACKAGES_RTL=1 REQUIRE_PACKAGES_PASZLIB=1 REQUIRE_PACKAGES_FCL=1 +REQUIRE_PACKAGES_PASJPEG=1 REQUIRE_PACKAGES_NETDB=1 REQUIRE_PACKAGES_LIBASYNC=1 endif @@ -1191,6 +1308,7 @@ ifeq ($(CPU_TARGET),i386) REQUIRE_PACKAGES_RTL=1 REQUIRE_PACKAGES_PASZLIB=1 REQUIRE_PACKAGES_FCL=1 +REQUIRE_PACKAGES_PASJPEG=1 REQUIRE_PACKAGES_NETDB=1 REQUIRE_PACKAGES_LIBASYNC=1 endif @@ -1351,6 +1469,32 @@ ifdef UNITDIR_FCL override COMPILER_UNITDIR+=$(UNITDIR_FCL) 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)/$(OS_TARGET)),) +UNITDIR_PASJPEG=$(PACKAGEDIR_PASJPEG)/$(OS_TARGET) +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_MYSQL PACKAGEDIR_MYSQL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /mysql/Makefile.fpc,$(PACKAGESDIR)))))) ifneq ($(PACKAGEDIR_MYSQL),) @@ -1472,8 +1616,12 @@ ifdef RELEASE ifeq ($(CPU_TARGET),i386) FPCCPUOPT:=-OG2p3 else +ifeq ($(CPU_TARGET),powerpc) +FPCCPUOPT:=-O1 +else FPCCPUOPT:= endif +endif override FPCOPT+=-Xs $(FPCCPUOPT) -n override FPCOPTDEF+=RELEASE endif @@ -1561,7 +1709,7 @@ EXECPPAS:=@$(PPAS) endif endif .PHONY: fpc_units -ifdef TARGET_UNITS +ifneq ($(TARGET_UNITS),) override ALLTARGET+=fpc_units override UNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_UNITS)) override IMPLICITUNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_IMPLICITUNITS)) @@ -1680,6 +1828,9 @@ override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS)) endif ifdef CLEANPPUFILES override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(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 @@ -1703,6 +1854,7 @@ 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_distclean: clean ifdef COMPILER_UNITTARGETDIR TARGETDIRCLEAN=fpc_clean @@ -1714,9 +1866,13 @@ endif -$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT) -$(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 .PHONY: fpc_baseinfo override INFORULES+=fpc_baseinfo fpc_baseinfo: diff --git a/lcl/interfaces/win32/Makefile.fpc b/lcl/interfaces/win32/Makefile.fpc index 7b81182117..aa62ad187c 100644 --- a/lcl/interfaces/win32/Makefile.fpc +++ b/lcl/interfaces/win32/Makefile.fpc @@ -11,7 +11,7 @@ packages=rtl fcl [target] units=interfaces -implicitunits=winext win32def win32int +implicitunits=winext win32def win32proc win32int [compiler] options=-gl diff --git a/lcl/interfaces/win32/win32int.pp b/lcl/interfaces/win32/win32int.pp index f704bf7469..c2726fc226 100644 --- a/lcl/interfaces/win32/win32int.pp +++ b/lcl/interfaces/win32/win32int.pp @@ -36,7 +36,7 @@ Interface successful compilation. } Uses - Windows, Classes, LCLStrConsts, ComCtrls, Controls, Dialogs, DynHashArray, + Windows, Classes, ComCtrls, Controls, Dialogs, DynHashArray, ExtCtrls, Forms, GraphMath, GraphType, InterfaceBase, LCLIntf, LCLType, LMessages, StdCtrls, SysUtils, VCLGlobals, Win32Def, Graphics, Menus; @@ -175,12 +175,10 @@ Type {$I win32listslh.inc} - { Asserts a trace for event named Message in the object Data } - Procedure EventTrace(Message: String; Data: TObject); - Implementation Uses + Win32Proc, //////////////////////////////////////////////////// // I M P O R T A N T //////////////////////////////////////////////////// @@ -215,9 +213,7 @@ Uses //////////////////////////////////////////////////// Buttons, Calendar, CListBox, Spin, CheckLst, WinExt, LclProc; -Type - TEventType = (etNotify, etKey, etKeyPress, etMouseWheel, etMouseUpDown); - +type { Linked list of objects for events } PLazObject = ^TLazObject; TLazObject = Record @@ -237,7 +233,7 @@ const ClsName : array[0..20] of char = 'LazarusForm'#0; ToolBtnClsName : array[0..20] of char = 'ToolbarButton'#0; -{$I win32proc.inc} +//{$I win32proc.inc} {$I win32listsl.inc} {$I win32callback.inc} {$I win32object.inc} @@ -257,6 +253,9 @@ End. { ============================================================================= $Log$ + Revision 1.82 2004/06/10 18:14:09 vincents + converted win32proc.inc to unit + Revision 1.81 2004/06/09 20:51:45 vincents implemented basic clipboard support for win32 diff --git a/lcl/interfaces/win32/win32object.inc b/lcl/interfaces/win32/win32object.inc index 6b2c1ca388..51396481b6 100644 --- a/lcl/interfaces/win32/win32object.inc +++ b/lcl/interfaces/win32/win32object.inc @@ -162,7 +162,7 @@ Begin Windows.DeleteMenu(SysMenu, SC_MAXIMIZE, MF_BYCOMMAND); Windows.DeleteMenu(SysMenu, SC_SIZE, MF_BYCOMMAND); Windows.DeleteMenu(SysMenu, SC_MOVE, MF_BYCOMMAND); - + Assert(False, 'Trace:Win32Object.Init - Exit'); End; @@ -3003,6 +3003,9 @@ End; { $Log$ + Revision 1.203 2004/06/10 18:14:09 vincents + converted win32proc.inc to unit + Revision 1.202 2004/05/31 19:32:34 vincents fixed using ecUpperCase in win32 diff --git a/lcl/interfaces/win32/win32proc.pp b/lcl/interfaces/win32/win32proc.pp new file mode 100644 index 0000000000..b692329051 --- /dev/null +++ b/lcl/interfaces/win32/win32proc.pp @@ -0,0 +1,832 @@ +{ + /*************************************************************************** + win32proc.pp - Misc Support Functions + ------------------- + + + + ***************************************************************************/ + + ***************************************************************************** + * * + * This file is part of the Lazarus Component Library (LCL) * + * * + * See the file COPYING.LCL, included in this distribution, * + * for details about the copyright. * + * * + * 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 win32proc; + +{$mode objfpc}{$H+} + +interface + +uses + Windows, Classes, LMessages, LCLType, Controls; + +Type + TEventType = (etNotify, etKey, etKeyPress, etMouseWheel, etMouseUpDown); + +function WM_To_String(WM_Message: Integer): string; +function WindowPosFlagsToString(Flags: UINT): string; +procedure EventTrace(Message: String; Data: TObject); +Procedure AssertEx(Const Message: String; Const PassErr: Boolean; + Const Severity: Byte); +Procedure AssertEx(Const PassErr: Boolean; Const Message: String); +Procedure AssertEx(Const Message: String); +Function GetShiftState: TShiftState; +Function DeliverMessage(Const Target: Pointer; Var Message): Integer; +Function DeliverMessage(Const Target: TObject; Var Message: TLMessage): Integer; +Procedure CallEvent(Const Target: TObject; Event: TNotifyEvent; + Const Data: Pointer; Const EventType: TEventType); +Function ObjectToHWND(Const AObject: TObject): HWND; +function LCLControlSizeNeedsUpdate(Sender: TWinControl; + SendSizeMsgOnDiff: boolean): boolean; +Procedure SetAccelGroup(Const Control: HWND; Const AnAccelGroup: HACCEL); +Function GetAccelGroup(Const Control: HWND): HACCEL; +Procedure SetAccelKey(Window: HWND; Const CommandId: Word; Const AKey: word; + Const AModifier: TShiftState); +Function GetAccelKey(Const Control: HWND): LPACCEL; +function GetLCLClientBoundsOffset(Sender: TObject; var ORect: TRect): boolean; +function GetLCLClientBoundsOffset(Handle: HWnd; var Rect: TRect): boolean; +Procedure LCLBoundsToWin32Bounds(Sender: TObject; + var Left, Top, Width, Height: Integer); +Procedure Win32PosToLCLPos(Sender: TObject; var Left, Top: SmallInt); +procedure UpdateWindowStyle(Handle: HWnd; Style: integer; StyleMask: integer); +function BorderStyleToWin32Flags(Style: TFormBorderStyle): DWORD; +function BorderStyleToWin32FlagsEx(Style: TFormBorderStyle): DWORD; + +implementation + +uses + SysUtils, LCLStrConsts, Menus, Dialogs, StdCtrls, ExtCtrls, + LCLIntf; //remove this unit when GetWindowSize is moved to TWSWinControl + +{$IFOPT C-} +// Uncomment for local trace +// {$C+} +// {$DEFINE ASSERT_IS_ON} +{$ENDIF} + +{------------------------------------------------------------------------------ + Function: WM_To_String + Params: WM_Message - a WinDows message + Returns: A WinDows-message name + + Converts a winDows message identIfier to a string + ------------------------------------------------------------------------------} +function WM_To_String(WM_Message: Integer): string; +Begin + Case WM_Message of + $0000: Result := 'WM_NULL'; + $0001: Result := 'WM_CREATE'; + $0002: Result := 'WM_DESTROY'; + $0003: Result := 'WM_MOVE'; + $0005: Result := 'WM_SIZE'; + $0006: Result := 'WM_ACTIVATE'; + $0007: Result := 'WM_SETFOCUS'; + $0008: Result := 'WM_KILLFOCUS'; + $000A: Result := 'WM_ENABLE'; + $000B: Result := 'WM_SETREDRAW'; + $000C: Result := 'WM_SETTEXT'; + $000D: Result := 'WM_GETTEXT'; + $000E: Result := 'WM_GETTEXTLENGTH'; + $000F: Result := 'WM_PAINT'; + $0010: Result := 'WM_CLOSE'; + $0011: Result := 'WM_QUERYENDSESSION'; + $0012: Result := 'WM_QUIT'; + $0013: Result := 'WM_QUERYOPEN'; + $0014: Result := 'WM_ERASEBKGND'; + $0015: Result := 'WM_SYSCOLORCHANGE'; + $0016: Result := 'WM_EndSESSION'; + $0017: Result := 'WM_SYSTEMERROR'; + $0018: Result := 'WM_SHOWWINDOW'; + $0019: Result := 'WM_CTLCOLOR'; + $001A: Result := 'WM_WININICHANGE or WM_SETTINGCHANGE'; + $001B: Result := 'WM_DEVMODECHANGE'; + $001C: Result := 'WM_ACTIVATEAPP'; + $001D: Result := 'WM_FONTCHANGE'; + $001E: Result := 'WM_TIMECHANGE'; + $001F: Result := 'WM_CANCELMODE'; + $0020: Result := 'WM_SETCURSOR'; + $0021: Result := 'WM_MOUSEACTIVATE'; + $0022: Result := 'WM_CHILDACTIVATE'; + $0023: Result := 'WM_QUEUESYNC'; + $0024: Result := 'WM_GETMINMAXINFO'; + $0026: Result := 'WM_PAINTICON'; + $0027: Result := 'WM_ICONERASEBKGND'; + $0028: Result := 'WM_NEXTDLGCTL'; + $002A: Result := 'WM_SPOOLERSTATUS'; + $002B: Result := 'WM_DRAWITEM'; + $002C: Result := 'WM_MEASUREITEM'; + $002D: Result := 'WM_DELETEITEM'; + $002E: Result := 'WM_VKEYTOITEM'; + $002F: Result := 'WM_CHARTOITEM'; + $0030: Result := 'WM_SETFONT'; + $0031: Result := 'WM_GETFONT'; + $0032: Result := 'WM_SETHOTKEY'; + $0033: Result := 'WM_GETHOTKEY'; + $0037: Result := 'WM_QUERYDRAGICON'; + $0039: Result := 'WM_COMPAREITEM'; + $003D: Result := 'WM_GETOBJECT'; + $0041: Result := 'WM_COMPACTING'; + $0044: Result := 'WM_COMMNOTIFY { obsolete in Win32}'; + $0046: Result := 'WM_WINDOWPOSCHANGING'; + $0047: Result := 'WM_WINDOWPOSCHANGED'; + $0048: Result := 'WM_POWER'; + $004A: Result := 'WM_COPYDATA'; + $004B: Result := 'WM_CANCELJOURNAL'; + $004E: Result := 'WM_NOTIFY'; + $0050: Result := 'WM_INPUTLANGCHANGEREQUEST'; + $0051: Result := 'WM_INPUTLANGCHANGE'; + $0052: Result := 'WM_TCARD'; + $0053: Result := 'WM_HELP'; + $0054: Result := 'WM_USERCHANGED'; + $0055: Result := 'WM_NOTIFYFORMAT'; + $007B: Result := 'WM_CONTEXTMENU'; + $007C: Result := 'WM_STYLECHANGING'; + $007D: Result := 'WM_STYLECHANGED'; + $007E: Result := 'WM_DISPLAYCHANGE'; + $007F: Result := 'WM_GETICON'; + $0080: Result := 'WM_SETICON'; + $0081: Result := 'WM_NCCREATE'; + $0082: Result := 'WM_NCDESTROY'; + $0083: Result := 'WM_NCCALCSIZE'; + $0084: Result := 'WM_NCHITTEST'; + $0085: Result := 'WM_NCPAINT'; + $0086: Result := 'WM_NCACTIVATE'; + $0087: Result := 'WM_GETDLGCODE'; + $00A0: Result := 'WM_NCMOUSEMOVE'; + $00A1: Result := 'WM_NCLBUTTONDOWN'; + $00A2: Result := 'WM_NCLBUTTONUP'; + $00A3: Result := 'WM_NCLBUTTONDBLCLK'; + $00A4: Result := 'WM_NCRBUTTONDOWN'; + $00A5: Result := 'WM_NCRBUTTONUP'; + $00A6: Result := 'WM_NCRBUTTONDBLCLK'; + $00A7: Result := 'WM_NCMBUTTONDOWN'; + $00A8: Result := 'WM_NCMBUTTONUP'; + $00A9: Result := 'WM_NCMBUTTONDBLCLK'; + $0100: Result := 'WM_KEYFIRST or WM_KEYDOWN'; + $0101: Result := 'WM_KEYUP'; + $0102: Result := 'WM_CHAR'; + $0103: Result := 'WM_DEADCHAR'; + $0104: Result := 'WM_SYSKEYDOWN'; + $0105: Result := 'WM_SYSKEYUP'; + $0106: Result := 'WM_SYSCHAR'; + $0107: Result := 'WM_SYSDEADCHAR'; + $0108: Result := 'WM_KEYLAST'; + $010D: Result := 'WM_IME_STARTCOMPOSITION'; + $010E: Result := 'WM_IME_ENDCOMPOSITION'; + $010F: Result := 'WM_IME_COMPOSITION or WM_IME_KEYLAST'; + $0110: Result := 'WM_INITDIALOG'; + $0111: Result := 'WM_COMMAND'; + $0112: Result := 'WM_SYSCOMMAND'; + $0113: Result := 'WM_TIMER'; + $0114: Result := 'WM_HSCROLL'; + $0115: Result := 'WM_VSCROLL'; + $0116: Result := 'WM_INITMENU'; + $0117: Result := 'WM_INITMENUPOPUP'; + $011F: Result := 'WM_MENUSELECT'; + $0120: Result := 'WM_MENUCHAR'; + $0121: Result := 'WM_ENTERIDLE'; + $0122: Result := 'WM_MENURBUTTONUP'; + $0123: Result := 'WM_MENUDRAG'; + $0124: Result := 'WM_MENUGETOBJECT'; + $0125: Result := 'WM_UNINITMENUPOPUP'; + $0126: Result := 'WM_MENUCOMMAND'; + $0132: Result := 'WM_CTLCOLORMSGBOX'; + $0133: Result := 'WM_CTLCOLOREDIT'; + $0134: Result := 'WM_CTLCOLORLISTBOX'; + $0135: Result := 'WM_CTLCOLORBTN'; + $0136: Result := 'WM_CTLCOLORDLG'; + $0137: Result := 'WM_CTLCOLORSCROLLBAR'; + $0138: Result := 'WM_CTLCOLORSTATIC'; + $0200: Result := 'WM_MOUSEFIRST or WM_MOUSEMOVE'; + $0201: Result := 'WM_LBUTTONDOWN'; + $0202: Result := 'WM_LBUTTONUP'; + $0203: Result := 'WM_LBUTTONDBLCLK'; + $0204: Result := 'WM_RBUTTONDOWN'; + $0205: Result := 'WM_RBUTTONUP'; + $0206: Result := 'WM_RBUTTONDBLCLK'; + $0207: Result := 'WM_MBUTTONDOWN'; + $0208: Result := 'WM_MBUTTONUP'; + $0209: Result := 'WM_MBUTTONDBLCLK'; + $020A: Result := 'WM_MOUSEWHEEL or WM_MOUSELAST'; + $0210: Result := 'WM_PARENTNOTIFY'; + $0211: Result := 'WM_ENTERMENULOOP'; + $0212: Result := 'WM_EXITMENULOOP'; + $0213: Result := 'WM_NEXTMENU'; + $0214: Result := 'WM_SIZING'; + $0215: Result := 'WM_CAPTURECHANGED'; + $0216: Result := 'WM_MOVING'; + $0218: Result := 'WM_POWERBROADCAST'; + $0219: Result := 'WM_DEVICECHANGE'; + $0220: Result := 'WM_MDICREATE'; + $0221: Result := 'WM_MDIDESTROY'; + $0222: Result := 'WM_MDIACTIVATE'; + $0223: Result := 'WM_MDIRESTORE'; + $0224: Result := 'WM_MDINEXT'; + $0225: Result := 'WM_MDIMAXIMIZE'; + $0226: Result := 'WM_MDITILE'; + $0227: Result := 'WM_MDICASCADE'; + $0228: Result := 'WM_MDIICONARRANGE'; + $0229: Result := 'WM_MDIGETACTIVE'; + $0230: Result := 'WM_MDISETMENU'; + $0231: Result := 'WM_ENTERSIZEMOVE'; + $0232: Result := 'WM_EXITSIZEMOVE'; + $0233: Result := 'WM_DROPFILES'; + $0234: Result := 'WM_MDIREFRESHMENU'; + $0281: Result := 'WM_IME_SETCONTEXT'; + $0282: Result := 'WM_IME_NOTIFY'; + $0283: Result := 'WM_IME_CONTROL'; + $0284: Result := 'WM_IME_COMPOSITIONFULL'; + $0285: Result := 'WM_IME_SELECT'; + $0286: Result := 'WM_IME_CHAR'; + $0288: Result := 'WM_IME_REQUEST'; + $0290: Result := 'WM_IME_KEYDOWN'; + $0291: Result := 'WM_IME_KEYUP'; + $02A1: Result := 'WM_MOUSEHOVER'; + $02A3: Result := 'WM_MOUSELEAVE'; + $0300: Result := 'WM_CUT'; + $0301: Result := 'WM_COPY'; + $0302: Result := 'WM_PASTE'; + $0303: Result := 'WM_CLEAR'; + $0304: Result := 'WM_UNDO'; + $0305: Result := 'WM_RENDERFORMAT'; + $0306: Result := 'WM_RENDERALLFORMATS'; + $0307: Result := 'WM_DESTROYCLIPBOARD'; + $0308: Result := 'WM_DRAWCLIPBOARD'; + $0309: Result := 'WM_PAINTCLIPBOARD'; + $030A: Result := 'WM_VSCROLLCLIPBOARD'; + $030B: Result := 'WM_SIZECLIPBOARD'; + $030C: Result := 'WM_ASKCBFORMATNAME'; + $030D: Result := 'WM_CHANGECBCHAIN'; + $030E: Result := 'WM_HSCROLLCLIPBOARD'; + $030F: Result := 'WM_QUERYNEWPALETTE'; + $0310: Result := 'WM_PALETTEISCHANGING'; + $0311: Result := 'WM_PALETTECHANGED'; + $0312: Result := 'WM_HOTKEY'; + $0317: Result := 'WM_PRINT'; + $0318: Result := 'WM_PRINTCLIENT'; + $0358: Result := 'WM_HANDHELDFIRST'; + $035F: Result := 'WM_HANDHELDLAST'; + $0380: Result := 'WM_PENWINFIRST'; + $038F: Result := 'WM_PENWINLAST'; + $0390: Result := 'WM_COALESCE_FIRST'; + $039F: Result := 'WM_COALESCE_LAST'; + $03E0: Result := 'WM_DDE_FIRST or WM_DDE_INITIATE'; + $03E1: Result := 'WM_DDE_TERMINATE'; + $03E2: Result := 'WM_DDE_ADVISE'; + $03E3: Result := 'WM_DDE_UNADVISE'; + $03E4: Result := 'WM_DDE_ACK'; + $03E5: Result := 'WM_DDE_DATA'; + $03E6: Result := 'WM_DDE_REQUEST'; + $03E7: Result := 'WM_DDE_POKE'; + $03E8: Result := 'WM_DDE_EXECUTE or WM_DDE_LAST'; + $0400: Result := 'WM_USER'; + $8000: Result := 'WM_APP'; + Else + Result := 'Unknown WM_Message = $' + IntToHex(WM_Message, 4); + End; {Case} +End; + +function WindowPosFlagsToString(Flags: UINT): string; +var + FlagsStr: string; +begin + if (Flags and SWP_DRAWFRAME) <> 0 then + FlagsStr := FlagsStr + '|SWP_DRAWFRAME'; + if (Flags and SWP_HIDEWINDOW) <> 0 then + FlagsStr := FlagsStr + '|SWP_HIDEWINDOW'; + if (Flags and SWP_NOACTIVATE) <> 0 then + FlagsStr := FlagsStr + '|SWP_NOACTIVATE'; + if (Flags and SWP_NOCOPYBITS) <> 0 then + FlagsStr := FlagsStr + '|SWP_NOCOPYBITS'; + if (Flags and SWP_NOMOVE) <> 0 then + FlagsStr := FlagsStr + '|SWP_NOMOVE'; + if (Flags and SWP_NOOWNERZORDER) <> 0 then + FlagsStr := FlagsStr + '|SWP_NOOWNERZORDER'; + if (Flags and SWP_NOREDRAW) <> 0 then + FlagsStr := FlagsStr + '|SWP_NOREDRAW'; + if (Flags and SWP_NOSENDCHANGING) <> 0 then + FlagsStr := FlagsStr + '|SWP_NOSENDCHANGING'; + if (Flags and SWP_NOSIZE) <> 0 then + FlagsStr := FlagsStr + '|SWP_NOSIZE'; + if (Flags and SWP_NOZORDER) <> 0 then + FlagsStr := FlagsStr + '|SWP_NOZORDER'; + if (Flags and SWP_SHOWWINDOW) <> 0 then + FlagsStr := FlagsStr + '|SWP_SHOWWINDOW'; + if Length(FlagsStr) > 0 then + FlagsStr := Copy(FlagsStr, 2, Length(FlagsStr)-1); + Result := FlagsStr; +end; + + +{------------------------------------------------------------------------------ + Procedure: EventTrace + Params: Message - Event name + Data - Object which fired this event + Returns: Nothing + + Displays a trace about an event + ------------------------------------------------------------------------------} +Procedure EventTrace(Message: String; Data: TObject); +Begin + If Data = Nil Then + Assert(False, Format('Trace:Event [%S] fired', [Message])) + Else + Assert(False, Format('Trace:Event [%S] fired for %S',[Message, Data.Classname])); +End; + +{------------------------------------------------------------------------------ + Function: AssertEx + Params: Message - Message sent + PassErr - Pass error to a catching Procedure (default: False) + Severity - How severe is the error on a scale from 0 to 3 + (default: 0) + Returns: Nothing + + An expanded, better version of Assert + ------------------------------------------------------------------------------} +Procedure AssertEx(Const Message: String; Const PassErr: Boolean; Const Severity: Byte); +Begin + Case Severity Of + 0: + Begin + Assert(PassErr, Message); + End; + 1: + Begin + Assert(PassErr, Format('Trace:%S', [Message])); + End; + 2: + Begin + Case IsConsole Of + True: + Begin + WriteLn(rsWin32Warning, Message); + End; + False: + Begin + MessageBox(0, PChar(Message), PChar(rsWin32Warning), MB_OK); + End; + End; + End; + 3: + Begin + Case IsConsole Of + True: + Begin + WriteLn(rsWin32Error, Message); + End; + False: + Begin + MessageBox(0, PChar(Message), Nil, MB_OK); + End; + End; + End; + End; +End; + +Procedure AssertEx(Const PassErr: Boolean; Const Message: String); +Begin + AssertEx(Message, PassErr, 0); +End; + +Procedure AssertEx(Const Message: String); +Begin + AssertEx(Message, False, 0); +End; + +{------------------------------------------------------------------------------ + Function: GetShiftState + Params: None + Returns: A shift state + + Creates a TShiftState set based on the status when the function was called. + ------------------------------------------------------------------------------} +Function GetShiftState: TShiftState; +Begin + Result := []; + If Hi(GetKeyState(VK_SHIFT)) = 1 Then + Result := Result + [ssShift]; + If Hi(GetKeyState(VK_CAPITAL)) = 1 Then + Result := Result + [ssCaps]; + If Hi(GetKeyState(VK_CONTROL)) = 1 Then + Result := Result + [ssCtrl]; + If Hi(GetKeyState(VK_MENU)) = 1 Then + Result := Result + [ssAlt]; + If Hi(GetKeyState(VK_SHIFT)) = 1 Then + Result := Result + [ssShift]; + If Hi(GetKeyState(VK_CAPITAL)) = 1 Then + Result := Result + [ssCaps]; + If Hi(GetKeyState(VK_CONTROL)) = 1 Then + Result := Result + [ssCtrl]; + If Hi(GetKeyState(VK_NUMLOCK)) = 1 Then + Result := Result + [ssNum]; + //TODO: ssSuper + If Hi(GetKeyState(VK_SCROLL)) = 1 Then + Result := Result + [ssScroll]; + If ((Hi(GetKeyState(VK_LBUTTON)) = 1) And (GetSystemMetrics(SM_SWAPBUTTON) = 0)) Or ((Hi(GetKeyState(VK_RBUTTON)) = 1) And (GetSystemMetrics(SM_SWAPBUTTON) <> 0)) Then + Result := Result + [ssLeft]; + If Hi(GetKeyState(VK_MBUTTON)) = 1 Then + Result := Result + [ssMiddle]; + If ((Hi(GetKeyState(VK_RBUTTON)) = 1) And (GetSystemMetrics(SM_SWAPBUTTON) = 0)) Or ((Hi(GetKeyState(VK_LBUTTON)) = 1) And (GetSystemMetrics(SM_SWAPBUTTON) <> 0)) Then + Result := Result + [ssRight]; + //TODO: ssAltGr +End; + +{------------------------------------------------------------------------------ + Procedure: GetWin32KeyInfo + Params: Event - Requested info + KeyCode - the ASCII key code of the eventkey + VirtualKey - the virtual key code of the eventkey + SysKey - True If the key is a syskey + ExtEnded - True If the key is an extended key + Toggle - True If the key is a toggle key and its value is on + Returns: Nothing + + GetWin32KeyInfo returns information about the given key event + ------------------------------------------------------------------------------} +{ +Procedure GetWin32KeyInfo(const Event: Integer; var KeyCode, VirtualKey: Integer; var SysKey, Extended, Toggle: Boolean); +Const + MVK_UNIFY_SIDES = 1; +Begin + Assert(False, 'TRACE:Using function GetWin32KeyInfo which isn''t implemented yet'); + KeyCode := Word(Event); + VirtualKey := MapVirtualKey(KeyCode, MVK_UNIFY_SIDES); + SysKey := (VirtualKey = VK_SHIFT) Or (VirtualKey = VK_CONTROL) Or (VirtualKey = VK_MENU); + ExtEnded := (SysKey) Or (VirtualKey = VK_INSERT) Or (VirtualKey = VK_HOME) Or (VirtualKey = VK_LEFT) Or (VirtualKey = VK_UP) Or (VirtualKey = VK_RIGHT) Or (VirtualKey = VK_DOWN) Or (VirtualKey = VK_PRIOR) Or (VirtualKey = VK_NEXT) Or (VirtualKey = VK_END) Or (VirtualKey = VK_DIVIDE); + Toggle := Lo(GetKeyState(VirtualKey)) = 1; +End; +} +{------------------------------------------------------------------------------ + Function: DeliverMessage + Params: Message - The message to process + Returns: True If handled + + Generic function which calls the WindowProc if defined, otherwise the + dispatcher + ------------------------------------------------------------------------------} +Function DeliverMessage(Const Target: Pointer; Var Message): Integer; +Begin + If Target = Nil Then + begin + WriteLn('[DeliverMessage Target: Pointer] Nil'); + Exit; + end; + If TObject(Target) Is TControl Then + Begin + TControl(Target).WinDowProc(TLMessage(Message)); + End + Else + Begin + TObject(Target).Dispatch(TLMessage(Message)); + End; + + Result := TLMessage(Message).Result; +End; + +{------------------------------------------------------------------------------ + Function: DeliverMessage + Params: Target - The target object + Message - The message to process + Returns: Message result + + Generic function which calls the WindowProc if defined, otherwise the + dispatcher + ------------------------------------------------------------------------------} +Function DeliverMessage(Const Target: TObject; Var Message: TLMessage): Integer; +Begin + If Target = Nil Then + begin + WriteLn('[DeliverMessage (Target: TObject)] Nil'); + Exit; + end; + If Target Is TControl Then + TControl(Target).WindowProc(Message) + Else + Target.Dispatch(Message); + Result := Message.Result; +End; + +{----------------------------------------------------------------------------- + Procedure: CallEvent + Params: Target - the object for which the event will be called + Event - event to call + Data - misc data + EventType - the type of event + Returns: Nothing + + Calls an event +-------------------------------------------------------------------------------} +Procedure CallEvent(Const Target: TObject; Event: TNotifyEvent; Const Data: Pointer; Const EventType: TEventType); +Begin + If Assigned(Target) And Assigned(Event) Then + Begin + Case EventType Of + etNotify: + Begin + Event(Target); + End; + End; + End; +End; + +{------------------------------------------------------------------------------ + Function: ObjectToHWND + Params: AObject - An LCL Object + Returns: The Window handle of the given object + + Returns the Window handle of the given object, 0 if no object available + ------------------------------------------------------------------------------} +Function ObjectToHWND(Const AObject: TObject): HWND; +Var + Handle: HWND; +Begin + Handle:=0; + If Integer(AObject) = 0 Then + Begin + Assert (False, 'TRACE:[ObjectToHWND] Object not assigned'); + End + Else If (AObject Is TWinControl) Then + Begin + If TWinControl(AObject).HandleAllocated Then + Handle := TWinControl(AObject).Handle + End + Else If (AObject Is TMenuItem) Then + Begin + If TMenuItem(AObject).HandleAllocated Then + Handle := TMenuItem(AObject).Handle + End + Else If (AObject Is TMenu) Then + Begin + If TMenu(AObject).HandleAllocated Then + Handle := TMenu(AObject).Items.Handle + End + Else If (AObject Is TCommonDialog) Then + Begin + {If TCommonDialog(AObject).HandleAllocated Then } + Handle := TCommonDialog(AObject).Handle + End + Else + Begin + Assert(False, Format('Trace:[ObjectToHWND] Message received With unhandled class-type <%s>', [AObject.ClassName])); + End; + Result := Handle; + If Handle = 0 Then + Assert (False, 'Trace:[ObjectToHWND]****** Warning: handle = 0 *******'); +End; + +(*********************************************************************** + Widget member Functions +************************************************************************) + +{------------------------------------------------------------------------------- + function LCLBoundsNeedsUpdate(Sender: TWinControl; + SendSizeMsgOnDiff: boolean): boolean; + + Returns true if LCL bounds and win32 bounds differ for the control. +-------------------------------------------------------------------------------} +function LCLControlSizeNeedsUpdate(Sender: TWinControl; + SendSizeMsgOnDiff: boolean): boolean; +var + Window:HWND; + IntfWidth, IntfHeight: integer; +begin + Result:=false; + Window:= Sender.Handle; + LCLIntf.GetWindowSize(Window, IntfWidth, IntfHeight); + if (Sender.Width = IntfWidth) + and (Sender.Height = IntfHeight) + and (not Sender.ClientRectNeedsInterfaceUpdate) then + exit; + Result:=true; + if SendSizeMsgOnDiff then begin + //writeln('LCLBoundsNeedsUpdate B ',TheWinControl.Name,':',TheWinControl.ClassName,' Sending WM_SIZE'); + Sender.InvalidateClientRectCache(true); + Windows.PostMessage(Window, WM_SIZE, 0, MakeLParam(IntfWidth, IntfHeight)); + end; +end; + +// ---------------------------------------------------------------------- +// The Accelgroup and AccelKey is needed by menus +// ---------------------------------------------------------------------- +Procedure SetAccelGroup(Const Control: HWND; Const AnAccelGroup: HACCEL); +Begin + Assert(False, 'Trace:TODO: Code SetAccelGroup'); + Windows.SetProp(Control, 'AccelGroup', AnAccelGroup); +End; + +Function GetAccelGroup(Const Control: HWND): HACCEL; +Begin + Assert(False, 'Trace:TODO: Code GetAccelGroup'); + Result := HACCEL(Windows.GetProp(Control, 'AccelGroup')); +End; + +Procedure SetAccelKey(Window: HWND; Const CommandId: Word; Const AKey: word; Const AModifier: TShiftState); +var AccelCount: integer; {number of accelerators in table} + NewCount: integer; {total sum of accelerators in the table} + ControlIndex: integer; {index of new (modified) accelerator in table} + OldAccel: HACCEL; {old accelerator table} + NewAccel: LPACCEL; {new accelerator table} + NullAccel: LPACCEL; {nil pointer} + + function ControlInTable: integer; + var i: integer; + begin + Result:=AccelCount; + i:=0; + while i < AccelCount do + begin + if NewAccel[i].cmd = CommandId then + begin + Result:=i; + exit; + end; + inc(i); + end; + end; + + function GetVirtFromState(const AState: TShiftState): Byte; + begin + Result := FVIRTKEY; + if ssAlt in AState then Result := Result or FALT; + if ssCtrl in AState then Result := Result or FCONTROL; + if ssShift in AState then Result := Result or FSHIFT; + end; + +Begin + OldAccel := Windows.GetProp(Window, 'Accel'); + NullAccel := nil; + AccelCount := CopyAcceleratorTable(OldAccel, NullAccel, 0); + Assert(False,Format('Trace: AccelCount=%d',[AccelCount])); + NewAccel := LPACCEL(LocalAlloc(LPTR, AccelCount * sizeof(ACCEL))); + CopyAcceleratorTable(OldAccel, NewAccel, AccelCount); + ControlIndex := ControlInTable; + if ControlIndex = AccelCount then {realocating the accelerator array, adding new accelerator} + begin + LocalFree(HLOCAL(NewAccel)); + NewAccel := LPACCEL(LocalAlloc(LPTR, (AccelCount+1) * sizeof(ACCEL))); + CopyAcceleratorTable(OldAccel, NewAccel, AccelCount); + NewCount := AccelCount+1; + end + else NewCount := AccelCount; + NewAccel[ControlIndex].cmd := CommandId; + NewAccel[ControlIndex].fVirt := GetVirtFromState(AModifier); + NewAccel[ControlIndex].key := AKey; + DestroyAcceleratorTable(OldAccel); + Windows.SetProp(Window, 'Accel', CreateAcceleratorTable(NewAccel, NewCount)); +End; + +Function GetAccelKey(Const Control: HWND): LPACCEL; +Begin + Assert(False, 'Trace:TODO: Code GetAccelKey'); + Result := GetProp(Control, 'AccelKey'); +End; + +{------------------------------------------------------------------------------- + function GetLCLClientOriginOffset(Sender: TObject; + var LeftOffset, TopOffset: integer): boolean; + + Returns the difference between the client origin of a win32 handle + and the definition of the LCL counterpart. + For example: + TGroupBox's client area is the area inside the groupbox frame. + Hence, the LeftOffset is the frame width and the TopOffset is the caption + height. +-------------------------------------------------------------------------------} +function GetLCLClientBoundsOffset(Sender: TObject; var ORect: TRect): boolean; +var + TM: TextMetricA; + DC: HDC; + Handle: HWND; + TheWinControl: TWinControl; + ARect: TRect; +Begin + Result:=false; + if (Sender = nil) or (not (Sender is TWinControl)) then exit; + TheWinControl:=TWinControl(Sender); + if not TheWinControl.HandleAllocated then exit; + Handle := TheWinControl.Handle; + ORect.Left := 0; + ORect.Top := 0; + ORect.Bottom := 0; + ORect.Right := 0; + If (TheWinControl is TCustomGroupBox) Then + Begin + // The client area of a groupbox under win32 is the whole size, including + // the frame. The LCL defines the client area without the frame. + // -> Adjust the position + DC := Windows.GetDC(Handle); + // add the upper frame with the caption + GetTextMetrics(DC, TM); + ORect.Top := TM.TMHeight; + // add the left frame border + ORect.Left := 2; + ORect.Right := -2; + ORect.Bottom := -2; + ReleaseDC(Handle, DC); + End Else + If TheWinControl is TCustomNoteBook then begin + // Can't use complete client rect in win32 interface, top part contains the tabs + Windows.GetClientRect(Handle, @ARect); + ORect := ARect; + Windows.SendMessage(Handle, TCM_AdjustRect, 0, LPARAM(@ORect)); + Dec(ORect.Right, ARect.Right); + Dec(ORect.Bottom, ARect.Bottom); + end; +{ + if (Windows.GetWindowLong(Handle, GWL_EXSTYLE) and WS_EX_CLIENTEDGE) <> 0 then + begin + Dec(LeftOffset, Windows.GetSystemMetrics(SM_CXEDGE)); + Dec(TopOffset, Windows.GetSystemMetrics(SM_CYEDGE)); + end; +} + Result:=true; +end; + +function GetLCLClientBoundsOffset(Handle: HWnd; var Rect: TRect): boolean; +var + OwnerObject: TObject; +begin + OwnerObject := TObject(GetProp(Handle, 'Wincontrol')); + Result:=GetLCLClientBoundsOffset(OwnerObject, Rect); +end; + +Procedure LCLBoundsToWin32Bounds(Sender: TObject; + var Left, Top, Width, Height: Integer); +var + ORect: TRect; +Begin + if (Sender=nil) or (not (Sender is TWinControl)) then exit; + if not GetLCLClientBoundsOffset(TWinControl(Sender).Parent, ORect) then exit; + inc(Left, ORect.Left); + inc(Top, ORect.Top); +End; + +Procedure Win32PosToLCLPos(Sender: TObject; var Left, Top: SmallInt); +var + ORect: TRect; +Begin + if (Sender=nil) or (not (Sender is TWinControl)) then exit; + if not GetLCLClientBoundsOffset(TWinControl(Sender).Parent, ORect) then exit; + dec(Left, ORect.Left); + dec(Top, ORect.Top); +End; + +{ + Updates the window style of the window indicated by Handle. + The new style is the Style parameter. + Only the bits set in the StyleMask are changed, + the other bits remain untouched. + If the bits in the StyleMask are not used in the Style, + there are cleared. +} +procedure UpdateWindowStyle(Handle: HWnd; Style: integer; StyleMask: integer); +var + CurrentStyle: integer; + NewStyle: integer; +begin + CurrentStyle := Windows.GetWindowLong(Handle, GWL_STYLE); + NewStyle := (Style and StyleMask) or (CurrentStyle and (not StyleMask)); + Windows.SetWindowLong(Handle, GWL_STYLE, NewStyle); +end; + +function BorderStyleToWin32Flags(Style: TFormBorderStyle): DWORD; +begin + Result := WS_OVERLAPPEDWINDOW or WS_CLIPSIBLINGS or WS_CLIPCHILDREN; + case Style of + //bsSizeable:; -> Default + bsSingle: + Result := Result and DWORD(not WS_THICKFRAME); + bsDialog: + Result := Result and DWORD(not (WS_THICKFRAME or WS_MINIMIZEBOX or WS_MAXIMIZEBOX)); + bsNone: + Result := WS_POPUP or WS_CLIPSIBLINGS or WS_CLIPCHILDREN; + bsToolWindow: + Result := Result and DWORD(not WS_THICKFRAME); + end; +end; + +function BorderStyleToWin32FlagsEx(Style: TFormBorderStyle): DWORD; +begin + Result := 0; + case Style of + bsToolWindow, bsSizeToolWin: + Result := WS_EX_TOOLWINDOW; + end; +end; + +{$IFDEF ASSERT_IS_ON} + {$UNDEF ASSERT_IS_ON} + {$C-} +{$ENDIF} +end. + diff --git a/lcl/interfaces/win32/win32winapi.inc b/lcl/interfaces/win32/win32winapi.inc index 60735ab7e0..06163593c9 100644 --- a/lcl/interfaces/win32/win32winapi.inc +++ b/lcl/interfaces/win32/win32winapi.inc @@ -490,9 +490,7 @@ function TWin32WidgetSet.ClipboardGetFormats(ClipboardType: TClipboardType; var Count: Integer; var List: PClipboardFormat): Boolean; var FormatID: UINT; - LastFormatID: UINT; c: integer; - TextPlainFormatID: TClipboardFormat; Begin Result := false; @@ -3067,6 +3065,9 @@ end; { ============================================================================= $Log$ + Revision 1.117 2004/06/10 18:14:10 vincents + converted win32proc.inc to unit + Revision 1.116 2004/06/09 20:51:45 vincents implemented basic clipboard support for win32