paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-10 15:56:10 +02:00
Code Issues Packages Projects Releases Wiki Activity

converted win32proc.inc to unit

Browse Source 
git-svn-id: trunk@5549 -
This commit is contained in:
vincents 2004-06-10 18:14:10 +00:00
parent ca66b2a830
commit b42f9e541f
7 changed files with 1079 additions and 87 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -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

306
lcl/interfaces/win32/Makefile
View File

@ -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:

2
lcl/interfaces/win32/Makefile.fpc
View File

@ -11,7 +11,7 @@ packages=rtl fcl
[target]
units=interfaces
implicitunits=winext win32def win32int
implicitunits=winext win32def win32proc win32int
[compiler]
options=-gl

15
lcl/interfaces/win32/win32int.pp
View File

@ -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

5
lcl/interfaces/win32/win32object.inc
View File

@ -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

832
lcl/interfaces/win32/win32proc.pp Normal file
View File

@ -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.

5
lcl/interfaces/win32/win32winapi.inc
View File

@ -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