MG: applied Keith Bowes win32 interface updates

git-svn-id: trunk@383 -
This commit is contained in:
lazarus 2001-11-01 22:40:14 +00:00
parent 5da619f0b3
commit 326a431398
85 changed files with 429 additions and 473 deletions

74
.gitattributes vendored
View File

@ -125,83 +125,157 @@ ide/viewunit_dlg.lfm svneol=native#text/plain
ide/viewunit_dlg.pp svneol=native#text/pascal
ide/viewunits1.lrs svneol=native#text/pascal
ide/wordcompletion.pp svneol=native#text/pascal
images/ActiveBreakPoint.ico -text svneol=native#image/x-icon
images/ActiveBreakPoint.xpm -text svneol=native#image/x-xpixmap
images/InactiveBreakPoint.ico -text svneol=native#image/x-icon
images/InactiveBreakPoint.xpm -text svneol=native#image/x-xpixmap
images/bookmark0.ico -text svneol=native#image/x-icon
images/bookmark0.xpm -text svneol=native#image/x-xpixmap
images/bookmark1.ico -text svneol=native#image/x-icon
images/bookmark1.xpm -text svneol=native#image/x-xpixmap
images/bookmark2.ico -text svneol=native#image/x-icon
images/bookmark2.xpm -text svneol=native#image/x-xpixmap
images/bookmark3.ico -text svneol=native#image/x-icon
images/bookmark3.xpm -text svneol=native#image/x-xpixmap
images/bookmark4.ico -text svneol=native#image/x-icon
images/bookmark4.xpm -text svneol=native#image/x-xpixmap
images/bookmark5.ico -text svneol=native#image/x-icon
images/bookmark5.xpm -text svneol=native#image/x-xpixmap
images/bookmark6.ico -text svneol=native#image/x-icon
images/bookmark6.xpm -text svneol=native#image/x-xpixmap
images/bookmark7.ico -text svneol=native#image/x-icon
images/bookmark7.xpm -text svneol=native#image/x-xpixmap
images/bookmark8.ico -text svneol=native#image/x-icon
images/bookmark8.xpm -text svneol=native#image/x-xpixmap
images/bookmark9.ico -text svneol=native#image/x-icon
images/bookmark9.xpm -text svneol=native#image/x-xpixmap
images/btn_downarrow.ico -text svneol=unset#image/x-icon
images/btn_downarrow.xpm -text svneol=native#image/x-xpixmap
images/btn_newform.ico -text svneol=unset#image/x-icon
images/btn_newform.xpm -text svneol=native#image/x-xpixmap
images/btn_newunit.ico -text svneol=unset#image/x-icon
images/btn_newunit.xpm -text svneol=native#image/x-xpixmap
images/btn_openfile.ico -text svneol=unset#image/x-icon
images/btn_openfile.xpm -text svneol=native#image/x-xpixmap
images/btn_run.ico -text svneol=unset#image/x-icon
images/btn_run.xpm -text svneol=native#image/x-xpixmap
images/btn_save.ico -text svneol=unset#image/x-icon
images/btn_save.xpm -text svneol=native#image/x-xpixmap
images/btn_saveall.ico -text svneol=unset#image/x-icon
images/btn_saveall.xpm -text svneol=native#image/x-xpixmap
images/btn_toggleform.ico -text svneol=unset#image/x-icon
images/btn_toggleform.xpm -text svneol=native#image/x-xpixmap
images/btn_viewforms.ico -text svneol=unset#image/x-icon
images/btn_viewforms.xpm -text svneol=native#image/x-xpixmap
images/btn_viewunits.ico -text svneol=unset#image/x-icon
images/btn_viewunits.xpm -text svneol=native#image/x-xpixmap
images/color.ico -text svneol=unset#image/x-icon
images/color.xpm -text svneol=native#image/x-xpixmap
images/default.ico -text svneol=native#image/x-icon
images/default.xpm -text svneol=native#image/x-xpixmap
images/downarrow.ico -text svneol=unset#image/x-icon
images/downarrow.xpm -text svneol=native#image/x-xpixmap
images/fonts.ico -text svneol=unset#image/x-icon
images/fonts.xpm -text svneol=native#image/x-xpixmap
images/laz_images.lrs svneol=native#text/pascal
images/lazarus.ico -text svneol=unset#image/x-icon
images/lazarus.xpm -text svneol=native#image/x-xpixmap
images/lazarus64.ico -text svneol=unset#image/x-icon
images/lazarus64.xpm -text svneol=native#image/x-xpixmap
images/leftarrow.ico -text svneol=unset#image/x-icon
images/leftarrow.xpm -text svneol=native#image/x-xpixmap
images/mainicon.ico -text svneol=unset#image/x-icon
images/mainicon.lrs svneol=native#text/pascal
images/mainicon.xpm -text svneol=native#image/x-xpixmap
images/mouse.xpm -text svneol=native#image/x-xpixmap
images/notebook.ico -text svneol=unset#image/x-icon
images/notebook.xpm -text svneol=native#image/x-xpixmap
images/penguin.ico -text svneol=unset#image/x-icon
images/penguin.xpm -text svneol=native#image/x-xpixmap
images/rightarrow.ico -text svneol=unset#image/x-icon
images/rightarrow.xpm -text svneol=native#image/x-xpixmap
images/tbevel.ico -text svneol=native#image/x-icon
images/tbevel.xpm -text svneol=native#image/x-xpixmap
images/tbitbtn.ico -text svneol=native#image/x-icon
images/tbitbtn.xpm -text svneol=native#image/x-xpixmap
images/tbutton.ico -text svneol=native#image/x-icon
images/tbutton.xpm -text svneol=native#image/x-xpixmap
images/tcheckbox.ico -text svneol=native#image/x-icon
images/tcheckbox.xpm -text svneol=native#image/x-xpixmap
images/tcolordialog.ico -text svneol=native#image/x-icon
images/tcolordialog.xpm -text svneol=native#image/x-xpixmap
images/tcombobox.ico -text svneol=native#image/x-icon
images/tcombobox.xpm -text svneol=native#image/x-xpixmap
images/tdatabase.ico -text svneol=native#image/x-icon
images/tdatabase.xpm -text svneol=native#image/x-xpixmap
images/tdatasource.ico -text svneol=native#image/x-icon
images/tdatasource.xpm -text svneol=native#image/x-xpixmap
images/tedit.ico -text svneol=native#image/x-icon
images/tedit.xpm -text svneol=native#image/x-xpixmap
images/tfontdialog.ico -text svneol=native#image/x-icon
images/tfontdialog.xpm -text svneol=native#image/x-xpixmap
images/tgroupbox.ico -text svneol=native#image/x-icon
images/tgroupbox.xpm -text svneol=native#image/x-xpixmap
images/tibdatabase.ico -text svneol=native#image/x-icon
images/tibdatabase.xpm -text svneol=native#image/x-xpixmap
images/tibquery.ico -text svneol=native#image/x-icon
images/tibquery.xpm -text svneol=native#image/x-xpixmap
images/tlabel.ico -text svneol=native#image/x-icon
images/tlabel.xpm -text svneol=native#image/x-xpixmap
images/tlistbox.ico -text svneol=native#image/x-icon
images/tlistbox.xpm -text svneol=native#image/x-xpixmap
images/tlistview.ico -text svneol=native#image/x-icon
images/tlistview.xpm -text svneol=native#image/x-xpixmap
images/tmemo.ico -text svneol=native#image/x-icon
images/tmemo.xpm -text svneol=native#image/x-xpixmap
images/tmenu.ico -text svneol=native#image/x-icon
images/tmenu.xpm -text svneol=native#image/x-xpixmap
images/tmouse.xpm -text svneol=native#image/x-xpixmap
images/tnotebook.ico -text svneol=native#image/x-icon
images/tnotebook.xpm -text svneol=native#image/x-xpixmap
images/topendialog.ico -text svneol=native#image/x-icon
images/topendialog.xpm -text svneol=native#image/x-xpixmap
images/topenpicturedialog.ico -text svneol=native#image/x-icon
images/topenpicturedialog.xpm -text svneol=native#image/x-xpixmap
images/tpaintbox.ico -text svneol=native#image/x-icon
images/tpaintbox.xpm -text svneol=native#image/x-xpixmap
images/tpanel.ico -text svneol=native#image/x-icon
images/tpanel.xpm -text svneol=native#image/x-xpixmap
images/tpopupmenu.ico -text svneol=native#image/x-icon
images/tpopupmenu.xpm -text svneol=native#image/x-xpixmap
images/tprinterdialog.ico -text svneol=native#image/x-icon
images/tprinterdialog.xpm -text svneol=native#image/x-xpixmap
images/tprintersetupdialog.ico -text svneol=native#image/x-icon
images/tprintersetupdialog.xpm -text svneol=native#image/x-xpixmap
images/tprogressbar.ico -text svneol=native#image/x-icon
images/tprogressbar.xpm -text svneol=native#image/x-xpixmap
images/tquery.ico -text svneol=native#image/x-icon
images/tquery.xpm -text svneol=native#image/x-xpixmap
images/tradiobutton.ico -text svneol=native#image/x-icon
images/tradiobutton.xpm -text svneol=native#image/x-xpixmap
images/tradiogroup.ico -text svneol=native#image/x-icon
images/tradiogroup.xpm -text svneol=native#image/x-xpixmap
images/tsavedialog.ico -text svneol=native#image/x-icon
images/tsavedialog.xpm -text svneol=native#image/x-xpixmap
images/tsavepicturedialog.ico -text svneol=native#image/x-icon
images/tsavepicturedialog.xpm -text svneol=native#image/x-xpixmap
images/tscrollbar.ico -text svneol=native#image/x-icon
images/tscrollbar.xpm -text svneol=native#image/x-xpixmap
images/tspeedbutton.ico -text svneol=native#image/x-icon
images/tspeedbutton.xpm -text svneol=native#image/x-xpixmap
images/tspinedit.ico -text svneol=native#image/x-icon
images/tspinedit.xpm -text svneol=native#image/x-xpixmap
images/tstatusbar.ico -text svneol=native#image/x-icon
images/tstatusbar.xpm -text svneol=native#image/x-xpixmap
images/ttimer.ico -text svneol=native#image/x-icon
images/ttimer.xpm -text svneol=native#image/x-xpixmap
images/ttogglebox.ico -text svneol=native#image/x-icon
images/ttogglebox.xpm -text svneol=native#image/x-xpixmap
images/ttoolbar.ico -text svneol=native#image/x-icon
images/ttoolbar.xpm -text svneol=native#image/x-xpixmap
images/ttrackbar.ico -text svneol=native#image/x-icon
images/ttrackbar.xpm -text svneol=native#image/x-xpixmap
images/uparrow.ico -text svneol=unset#image/x-icon
images/uparrow.xpm -text svneol=native#image/x-xpixmap
lcl/allunits.pp svneol=native#text/pascal
lcl/buttons.pp svneol=native#text/pascal

100
Makefile
View File

@ -1,5 +1,5 @@
#
# Don't edit, this file is generated by FPCMake Version 1.1 [2001/08/22]
# Don't edit, this file is generated by fpcmake v1.99.0 [2001/08/15]
#
default: all
override PATH:=$(subst \,/,$(PATH))
@ -34,7 +34,7 @@ inOS2=1
endif
endif
else
ifneq ($(findstring cygwin,$(MACHTYPE)),)
ifneq ($(findstring cygwin,$(MACH_TYPE)),)
inCygWin=1
endif
endif
@ -54,13 +54,6 @@ PATHSEP:=$(subst /,\,/)
endif
ifdef PWD
BASEDIR:=$(subst \,/,$(shell $(PWD)))
ifdef inCygWin
ifneq ($(findstring /cygdrive/,$(BASEDIR)),)
BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR))
BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR)))
BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR))
endif
endif
else
BASEDIR=.
endif
@ -68,17 +61,8 @@ ifndef FPC
ifdef PP
FPC=$(PP)
else
ifdef inUnix
CPU_SOURCE=$(shell uname -m)
ifeq (m68k,$(CPU_SOURCE))
FPC=ppc68k
else
FPC=ppc386
endif
else
FPC=ppc386
endif
endif
endif
override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
@ -135,7 +119,6 @@ override TARGET_DIRS+=lcl components
override TARGET_PROGRAMS+=lazarus
override TARGET_EXAMPLEDIRS+=examples
override INSTALL_BASEDIR=lib/lazarus
override DIST_DESTDIR=$(BASEDIR)/dist
override COMPILER_OPTIONS+=-gl
override COMPILER_INCLUDEDIR+=. ./include ./include/$(OS_TARGET)
override COMPILER_UNITDIR+=. ./lcl/units ./lcl/units/$(LCLPLATFORM) ./components/units ./designer ./debugger
@ -368,12 +351,6 @@ HASSHAREDLIB=1
FPCMADE=fpcmade.freebsd
ZIPSUFFIX=freebsd
endif
ifeq ($(OS_TARGET),netbsd)
EXEEXT=
HASSHAREDLIB=1
FPCMADE=fpcmade.netbsd
ZIPSUFFIX=netbsd
endif
ifeq ($(OS_TARGET),win32)
PPUEXT=.ppw
OEXT=.ow
@ -395,25 +372,6 @@ SHAREDLIBEXT=.dll
FPCMADE=fpcmade.os2
ZIPSUFFIX=emx
endif
ifeq ($(OS_TARGET),amiga)
EXEEXT=
PPUEXT=.ppa
ASMEXT=.asm
OEXT=.o
SMARTEXT=.sl
STATICLIBEXT=.a
SHAREDLIBEXT=.library
FPCMADE=fpcmade.amg
endif
ifeq ($(OS_TARGET),atari)
PPUEXT=.ppt
ASMEXT=.s
OEXT=.o
SMARTEXT=.sl
STATICLIBEXT=.a
EXEEXT=.ttp
FPCMADE=fpcmade.ata
endif
ifdef REQUIRE_UNITSDIR
override UNITSDIR+=$(REQUIRE_UNITSDIR)
endif
@ -427,9 +385,6 @@ endif
ifeq ($(OS_TARGET),freebsd)
UNIXINSTALLDIR=1
endif
ifeq ($(OS_TARGET),netbsd)
UNIXINSTALLDIR=1
endif
else
ifeq ($(OS_SOURCE),linux)
UNIXINSTALLDIR=1
@ -437,9 +392,6 @@ endif
ifeq ($(OS_SOURCE),freebsd)
UNIXINSTALLDIR=1
endif
ifeq ($(OS_SOURCE),netbsd)
UNIXINSTALLDIR=1
endif
endif
ifndef INSTALL_PREFIX
ifdef UNIXINSTALLDIR
@ -608,30 +560,6 @@ REQUIRE_PACKAGES_GTK=1
REQUIRE_PACKAGES_REGEXPR=1
REQUIRE_PACKAGES_OPENGL=1
endif
ifeq ($(OS_TARGET),netbsd)
REQUIRE_PACKAGES_RTL=1
REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL=1
REQUIRE_PACKAGES_GTK=1
REQUIRE_PACKAGES_REGEXPR=1
REQUIRE_PACKAGES_OPENGL=1
endif
ifeq ($(OS_TARGET),amiga)
REQUIRE_PACKAGES_RTL=1
REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL=1
REQUIRE_PACKAGES_GTK=1
REQUIRE_PACKAGES_REGEXPR=1
REQUIRE_PACKAGES_OPENGL=1
endif
ifeq ($(OS_TARGET),atari)
REQUIRE_PACKAGES_RTL=1
REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL=1
REQUIRE_PACKAGES_GTK=1
REQUIRE_PACKAGES_REGEXPR=1
REQUIRE_PACKAGES_OPENGL=1
endif
ifdef REQUIRE_PACKAGES_RTL
PACKAGEDIR_RTL:=$(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR)))))
ifneq ($(PACKAGEDIR_RTL),)
@ -970,7 +898,7 @@ override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR)
ifeq ($(COMPILER_UNITTARGETDIR),.)
override UNITTARGETDIRPREFIX=
else
override UNITTARGETDIRPREFIX=$(COMPILER_UNITTARGETDIR)/
override UNITTARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
endif
else
ifdef COMPILER_TARGETDIR
@ -1070,12 +998,11 @@ ifdef INSTALLPPUFILES
override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(INSTALLPPUFILES))
override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(INSTALLPPULINKFILES)))
override INSTALL_CREATEPACKAGEFPC=1
endif
ifdef INSTALLEXEFILES
override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(INSTALLEXEFILES))
endif
fpc_install: all $(INSTALLTARGET)
fpc_install: $(INSTALLTARGET)
ifdef INSTALLEXEFILES
$(MKDIR) $(INSTALL_BINDIR)
ifdef UPXPROG
@ -1083,17 +1010,6 @@ ifdef UPXPROG
endif
$(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR)
endif
ifdef INSTALL_CREATEPACKAGEFPC
ifdef FPCMAKE
ifdef PACKAGE_VERSION
ifneq ($(wildcard Makefile.fpc),)
$(FPCMAKE) -p -T$(OS_TARGET) Makefile.fpc
$(MKDIR) $(INSTALL_UNITDIR)
$(INSTALL) Package.fpc $(INSTALL_UNITDIR)
endif
endif
endif
endif
ifdef INSTALLPPUFILES
$(MKDIR) $(INSTALL_UNITDIR)
$(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR)
@ -1174,7 +1090,6 @@ ZIPCMD_ZIP:=$(subst /,$(ZIPPATHSEP),$(ZIPPROG)) -Dr $(ZIPOPT) $(ZIPDESTFILE) *
endif
fpc_zipinstall:
$(MAKE) $(ZIPTARGET) INSTALL_PREFIX=$(PACKDIR) ZIPINSTALL=1
$(MKDIR) $(DIST_DESTDIR)
$(DEL) $(ZIPDESTFILE)
ifdef USEZIPWRAPPER
ifneq ($(ECHOREDIR),echo)
@ -1235,7 +1150,7 @@ endif
ifdef LIB_NAME
-$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
endif
-$(DEL) $(FPCMADE) Package.fpc $(PPAS) link.res $(FPCEXTFILE) $(REDIRFILE)
-$(DEL) $(FPCMADE) $(PPAS) link.res $(FPCEXTFILE) $(REDIRFILE)
fpc_distclean: clean
ifdef COMPILER_UNITTARGETDIR
TARGETDIRCLEAN=fpc_clean
@ -1466,7 +1381,7 @@ endif
.SUFFIXES: .rc .res
%.res: %.rc
windres -i $< -o $@
.PHONY: examples lcl components ide tools all win32
.PHONY: examples lcl components ide tools all win32 win32clean makefile makefiles
lcl: lcl_all
examples: lcl examples_all
components: lcl components_all
@ -1477,6 +1392,9 @@ all: lcl components ide
win32:
$(MAKE) lazarus.res
$(MAKE) all LCLPLATFORM=win32 OPT=-dSUPPORTS_RESOURCES
win32clean:
$(MAKE) clean LCLPLATFORM=win32
$(DEL) $(wildcard *$(EXEEXT) $(wildcard *.ow*) $(wildcard *.res) $(wildcard ./*$(PPUEXT)) $(wildcard ./debugger/*$(PPUEXT)) $(wildcard ./designer/*$(PPUEXT))
makefile: Makefile.fpc
-$(FPCMAKE) -w
makefiles: makefile

View File

@ -45,7 +45,7 @@ endif
windres -i $< -o $@
.PHONY: examples lcl components ide tools all win32
.PHONY: examples lcl components ide tools all win32 win32clean makefile makefiles
lcl: lcl_all
@ -64,6 +64,10 @@ win32:
$(MAKE) lazarus.res
$(MAKE) all LCLPLATFORM=win32 OPT=-dSUPPORTS_RESOURCES
win32clean:
$(MAKE) clean LCLPLATFORM=win32
$(DEL) $(wildcard *$(EXEEXT) $(wildcard *.ow*) $(wildcard *.res) $(wildcard ./*$(PPUEXT)) $(wildcard ./debugger/*$(PPUEXT)) $(wildcard ./designer/*$(PPUEXT))
# MWE: moved to a more generic rule
#lazarus.res: lazarus.rc
# windres -i lazarus.rc -o lazarus.res

Binary file not shown.

Before

Width:  |  Height:  |  Size: 3.2 KiB

After

Width:  |  Height:  |  Size: 766 B

BIN
images/ActiveBreakPoint.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.4 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.4 KiB

BIN
images/bookmark0.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.4 KiB

BIN
images/bookmark1.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.4 KiB

BIN
images/bookmark2.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.4 KiB

BIN
images/bookmark3.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.4 KiB

BIN
images/bookmark4.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.4 KiB

BIN
images/bookmark5.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.4 KiB

BIN
images/bookmark6.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.4 KiB

BIN
images/bookmark7.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.4 KiB

BIN
images/bookmark8.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.4 KiB

BIN
images/bookmark9.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.4 KiB

BIN
images/btn_downarrow.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.1 KiB

BIN
images/btn_newform.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.3 KiB

BIN
images/btn_newunit.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.3 KiB

BIN
images/btn_openfile.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.3 KiB

BIN
images/btn_run.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.2 KiB

BIN
images/btn_save.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.3 KiB

BIN
images/btn_saveall.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.4 KiB

BIN
images/btn_toggleform.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.4 KiB

BIN
images/btn_viewforms.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.4 KiB

BIN
images/btn_viewunits.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.3 KiB

BIN
images/color.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.5 KiB

BIN
images/default.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.5 KiB

BIN
images/downarrow.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.8 KiB

BIN
images/fonts.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.5 KiB

BIN
images/lazarus.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 144 KiB

BIN
images/lazarus64.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 53 KiB

BIN
images/leftarrow.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.8 KiB

BIN
images/mainicon.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 11 KiB

BIN
images/notebook.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.8 KiB

BIN
images/penguin.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 26 KiB

BIN
images/rightarrow.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.8 KiB

BIN
images/tbevel.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.8 KiB

BIN
images/tbitbtn.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.8 KiB

BIN
images/tbutton.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.8 KiB

BIN
images/tcheckbox.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.8 KiB

BIN
images/tcolordialog.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.7 KiB

BIN
images/tcombobox.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.5 KiB

BIN
images/tdatabase.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.5 KiB

BIN
images/tdatasource.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.7 KiB

BIN
images/tedit.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.8 KiB

BIN
images/tfontdialog.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.7 KiB

BIN
images/tgroupbox.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.6 KiB

BIN
images/tibdatabase.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.5 KiB

BIN
images/tibquery.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.7 KiB

BIN
images/tlabel.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.8 KiB

BIN
images/tlistbox.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.5 KiB

BIN
images/tlistview.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.8 KiB

BIN
images/tmemo.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.8 KiB

BIN
images/tmenu.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.8 KiB

BIN
images/tnotebook.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.8 KiB

BIN
images/topendialog.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.7 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.7 KiB

BIN
images/tpaintbox.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.8 KiB

BIN
images/tpanel.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.8 KiB

BIN
images/tpopupmenu.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.8 KiB

BIN
images/tprinterdialog.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.7 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.7 KiB

BIN
images/tprogressbar.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.8 KiB

BIN
images/tquery.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.7 KiB

BIN
images/tradiobutton.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.8 KiB

BIN
images/tradiogroup.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.8 KiB

BIN
images/tsavedialog.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.7 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.7 KiB

BIN
images/tscrollbar.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.5 KiB

BIN
images/tspeedbutton.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.8 KiB

BIN
images/tspinedit.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.8 KiB

BIN
images/tstatusbar.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.8 KiB

BIN
images/ttimer.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.7 KiB

BIN
images/ttogglebox.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.5 KiB

BIN
images/ttoolbar.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.8 KiB

BIN
images/ttrackbar.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.8 KiB

BIN
images/uparrow.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.8 KiB

View File

@ -1,5 +1,5 @@
#
# Don't edit, this file is generated by FPCMake Version 1.1 [2001/08/22]
# Don't edit, this file is generated by FPCMake Version 1.1 [2001/10/14]
#
default: all
override PATH:=$(subst \,/,$(PATH))
@ -67,33 +67,28 @@ endif
ifndef FPC
ifdef PP
FPC=$(PP)
else
ifdef inUnix
CPU_SOURCE=$(shell uname -m)
ifeq (m68k,$(CPU_SOURCE))
FPC=ppc68k
else
FPC=ppc386
endif
else
FPC=ppc386
endif
ifndef FPC
FPC:=$(shell fpc -P?)
ifneq ($(findstring Error,$(FPC)),)
override FPC=ppc386
endif
endif
override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
ifndef OS_TARGET
OS_TARGET:=$(shell $(FPC) -iTO)
endif
ifndef OS_SOURCE
OS_SOURCE:=$(shell $(FPC) -iSO)
endif
ifndef CPU_TARGET
CPU_TARGET:=$(shell $(FPC) -iTP)
endif
ifndef CPU_SOURCE
CPU_SOURCE:=$(shell $(FPC) -iSP)
endif
ifndef OS_TARGET
OS_TARGET:=$(shell $(FPC) -iTO)
endif
ifndef OS_SOURCE
OS_SOURCE:=$(shell $(FPC) -iSO)
endif
ifndef FPC_VERSION
FPC_VERSION:=$(shell $(FPC) -iV)
endif
@ -125,11 +120,12 @@ endif
endif
UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages)
override PACKAGE_NAME=lazarus-win32
override PACKAGE_NAME=lazarus
override PACKAGE_VERSION=0.7a
DIST_DESTDIR=$(BASEDIR)/../../../dist
override TARGET_UNITS+=interfaces
override COMPILER_OPTIONS+=-gl -Or -S2h
override TARGET_UNITS+=winext win32def win32int interfaces
override CLEAN_UNITS+=$(COMPILER_UNITTARGETDIR)/*
override COMPILER_OPTIONS+=-gl -S2 -Sh
override COMPILER_INCLUDEDIR+=.
override COMPILER_UNITDIR+=$(COMPILER_UNITTARGETDIR) ../../units
override COMPILER_UNITTARGETDIR+=../../units/win32
@ -408,6 +404,36 @@ STATICLIBEXT=.a
EXEEXT=.ttp
FPCMADE=fpcmade.ata
endif
ifeq ($(OS_TARGET),beos)
PPUEXT=.ppu
ASMEXT=.s
OEXT=.o
SMARTEXT=.sl
STATICLIBEXT=.a
EXEEXT=
FPCMADE=fpcmade.be
ZIPSUFFIX=be
endif
ifeq ($(OS_TARGET),sunos)
PPUEXT=.ppu
ASMEXT=.s
OEXT=.o
SMARTEXT=.sl
STATICLIBEXT=.a
EXEEXT=
FPCMADE=fpcmade.sun
ZIPSUFFIX=sun
endif
ifeq ($(OS_TARGET),qnx)
PPUEXT=.ppu
ASMEXT=.s
OEXT=.o
SMARTEXT=.sl
STATICLIBEXT=.a
EXEEXT=
FPCMADE=fpcmade.qnx
ZIPSUFFIX=qnx
endif
ifdef REQUIRE_UNITSDIR
override UNITSDIR+=$(REQUIRE_UNITSDIR)
endif
@ -539,9 +565,14 @@ ifdef inUnix
ifndef GCCLIBDIR
GCCLIBDIR:=$(shell dirname `(gcc -v 2>&1)| head -n 1| awk '{ print $$4 } '`)
endif
ifeq ($(OS_TARGET),linux)
ifndef OTHERLIBDIR
OTHERLIBDIR:=$(shell grep -v "^\#" /etc/ld.so.conf | awk '{ ORS=" "; print $1 }')
endif
endif
ifeq ($(OS_TARGET),netbsd)
OTHERLIBDIR+=/usr/pkg/lib
endif
export GCCLIBDIR OTHERLIB
endif
ifeq ($(OS_TARGET),linux)
@ -585,6 +616,7 @@ endif
ifeq ($(OS_TARGET),netbsd)
REQUIRE_PACKAGES_RTL=1
REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_INET=1
REQUIRE_PACKAGES_FCL=1
endif
ifeq ($(OS_TARGET),amiga)
@ -760,7 +792,9 @@ override COMPILER_UNITDIR+=$(UNITDIR_IBASE)
endif
endif
.PHONY: package_rtl package_paszlib package_inet package_fcl package_mysql package_ibase
ifndef NOCPUDEF
override FPCOPTDEF=$(CPU_TARGET)
endif
ifneq ($(OS_TARGET),$(OS_SOURCE))
override FPCOPT+=-T$(OS_TARGET)
endif
@ -787,15 +821,22 @@ override FPCOPT+=-gl
override FPCOPTDEF+=DEBUG
endif
ifdef RELEASE
override FPCOPT+=-Xs -OG2p3 -n
ifeq ($(CPU_TARGET),i386)
FPCCPUOPT:=-OG2p3
else
FPCCPUOPT:=
endif
override FPCOPT+=-Xs $(FPCCPUOPT) -n
override FPCOPTDEF+=RELEASE
endif
ifdef STRIP
override FPCOPT+=-Xs
endif
ifdef OPTIMIZE
ifeq ($(CPU_TARGET),i386)
override FPCOPT+=-OG2p3
endif
endif
ifdef VERBOSE
override FPCOPT+=-vwni
endif
@ -1073,7 +1114,7 @@ endif
ifdef LIB_NAME
-$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
endif
-$(DEL) $(FPCMADE) Package.fpc $(PPAS) link.res $(FPCEXTFILE) $(REDIRFILE)
-$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
fpc_distclean: clean
ifdef COMPILER_UNITTARGETDIR
TARGETDIRCLEAN=fpc_clean

View File

@ -2,26 +2,29 @@
#
# Makefile.fpc for Lazarus for Free Pascal
#
[package]
name=lazarus-win32
name=lazarus
version=0.7a
[require]
packages=rtl fcl
[target]
units=interfaces
units=winext win32def win32int interfaces
[compiler]
options=-gl -Or -S2h
options=-gl -S2 -Sh
unittargetdir=../../units/win32
unitdir=$(COMPILER_UNITTARGETDIR) ../../units
includedir=.
[clean]
units=$(COMPILER_UNITTARGETDIR)/*
[prerules]
DIST_DESTDIR=$(BASEDIR)/../../../dist
[rules]
.PHONY: all makefile makefiles
@ -31,4 +34,4 @@ all:
makefile: Makefile.fpc
-$(FPCMAKE) -w
makefiles: makefile
makefiles: makefile

View File

@ -29,7 +29,7 @@ unit win32def;
interface
uses
Windows, WinExt, LCLLinux, VclGlobals, Classes;
Windows, VclGlobals, Classes;
type
TGDIType = (gdiBitmap, gdiBrush, gdiFont, gdiPen, gdiRegion);
@ -84,7 +84,7 @@ type
TDeviceContext = record
hWnd: HWND;
GC: HDC {pgdkGC}; // Not sure of Win32 equiv.
Drawable: PHandle {PGDKDrawable}; // Not sure of Win32 equiv.
Drawable: PHANDLE {PGDKDrawable}; // Not sure of Win32 equiv.
PenPos: TPoint;
CurrentBitmap: PGdiObject;
CurrentFont: PGdiObject;
@ -114,6 +114,9 @@ end.
{ =============================================================================
$Log$
Revision 1.2 2001/11/01 22:40:13 lazarus
MG: applied Keith Bowes win32 interface updates
Revision 1.1 2001/08/02 12:58:35 lazarus
MG: win32 interface patch from Keith Bowes

View File

@ -18,7 +18,9 @@
}
unit Win32Int;
{$I checkcompiler.inc}
{$mode objfpc}
{$LONGSTRINGS ON}
@ -29,9 +31,9 @@ interface
{$endif}
uses
Windows, Strings, WinExt, InterfaceBase, sysutils, lmessages,
Classes, Controls, extctrls, forms, dialogs, VclGlobals,
stdctrls, comctrls, LCLLinux, win32def, DynHashArray;
Windows, InterfaceBase, SysUtils, LMessages, Classes, Controls, ExtCtrls,
Forms, Dialogs, VclGlobals, StdCtrls, ComCtrls, LclLinux, Win32Def,
DynHashArray;
Var AppName : PChar;
FormClassName : PChar;
@ -119,21 +121,25 @@ Type
public
constructor Create;
destructor Destroy; override;
procedure SetLabel(Sender : TObject; Data : Pointer);
Function GetText(Sender: TControl; Var Data: String): Boolean; Override;
procedure SetLabel(Sender : TObject; Data : Pointer);
procedure IntSendMessage(LM_Message : Integer; CompStyle : Integer; Var P : Pointer; Val1 : Integer; Var Str1 : String);
function IntSendMessage2( LM_Message : Integer; Parent,Child, Data : Pointer) : Integer;
function IntSendMessage3(LM_Message : Integer; Sender : TObject; data : pointer) : integer; override;
procedure SetCallback(Msg : LongInt; Sender : TObject); override;
procedure DoEvents; override;
procedure RemoveCallbacks(Sender : TObject); override;
procedure HandleEvents; override;
procedure DoEvents; override;
Procedure WaitMessage; Override;
procedure AppTerminate; override;
procedure Init; override;
function UpdateHint(Sender: TObject): Integer; override;
function RecreateWnd(Sender: TObject): Integer; override;
Procedure MessageBox(Message, Title: String; Flags: Cardinal);
procedure IntSendMessage(LM_Message : Integer; CompStyle : Integer; Var P : Pointer; Val1 : Integer; Var Str1 : String);
function IntSendMessage2( LM_Message : Integer; Parent,Child, Data : Pointer) : Integer;
procedure RemoveCallbacks(Sender : TControl);
{$I win32winapih.inc}
end;
{$I win32listslh.inc}
wPointer = Pointer;
PWin32Control = ^TWin32Control;
@ -166,14 +172,6 @@ Type
TheType: TWin32KeyType;
Window: HWND;
End;
TWin32ListStringList = Class(TList)
Constructor Create(Wnd: TObject);
Sorted: Boolean;
End;
TWin32CListStringList = Class(TWin32ListStringList)
End;
TEventProc = record
Name : String[25];
@ -181,7 +179,7 @@ Type
Data : Pointer;
End;
CallbackProcedure = Procedure (Data : Pointer);
CallbackProcedure = Function: Boolean;
TCbFunc = Function(Win32Control: PWin32Control; Event: Pointer; Data: Pointer): Boolean;
PCbFunc = ^TCbFunc;
@ -192,8 +190,25 @@ Type
Implementation
uses Graphics, buttons, Menus, CListBox;
uses WinExt, Graphics, buttons, Menus, CListBox;
{$I win32listsl.inc}
Type
{ Lazarus Message structure for call backs }
TLazMsg = Record
Window: HWND;
WinMsg: UINT;
LParam: LPARAM;
WParam: WPARAM;
Win32Control: PWin32Control;
Event: Pointer;
Draw: Record
X, Y: Integer;
End;
ExtData: Pointer;
Reserved: Pointer;
End;
Const
IcoExt: String = '.ico';
@ -201,6 +216,8 @@ Const
Var
FromCBProc: Boolean;
LMessage: Integer;
signalFunc: Pointer;
LazMsg: TLazMsg;
const
@ -216,16 +233,11 @@ type
IDEvent : Integer;
TimerFunc: TFNTimerProc;
end;
Constructor TWin32ListStringList.Create(Wnd: TObject);
Begin
Inherited Create;
End;
{$I win32proc.inc}
{$I win32callback.inc}
{$I win32object.inc}
{$I win32winapi.inc}

View File

@ -33,102 +33,7 @@ End;
Function LM_ToString(LM_Message: Integer): String;
Begin
Case LM_Message - $1000 of // Workaround: LCL message numbers have changed (+$1000) since this was writted; TODO: Use constants to improve future compatibility (or simply remove this function altogether)
-3011 : Result := 'LM_SCREENINIT';
1 : Result := 'LM_Create';
2 : Result := 'LM_SetLabel';
3 : Result := 'LM_SetLeft';
4 : Result := 'LM_SetTop';
5 : Result := 'LM_SetWidth';
6 : Result := 'LM_SetHeight';
7 : Result := 'LM_AddChild';
8 : Result := 'LM_Setsize';
9 : Result := 'LM_GetLabel';
10 : Result := 'LM_AssignEvent';
11 : Result := 'LM_AssignSelf';
12 : Result := 'LM_SetName';
13 : Result := 'LM_RESIZECHILDREN';
14 : Result := 'LM_ShowHide';
15 : Result := 'LM_AddPAge';
16 : Result := 'LM_GetLineCount';
17 : Result := 'LM_SETTEXT';
18 : Result := 'LM_GETTEXT';
19 : Result := 'LM_CANVASCREATE';
20 : Result := 'LM_DrawFIllRect';
21 : Result := 'LM_DrawRect';
22 : Result := 'LM_DrawLine';
23 : Result := 'LM_DrawText';
24 : Result := 'LM_FontSetSize';
25 : Result := 'LM_FontGetSize';
26 : Result := 'LM_ReDraw';
27 : Result := 'LM_SetColor';
28 : Result := 'LM_RemovePage';
29 : Result := 'LM_ShowTabs';
30 : Result := 'LM_SetTabPosition';
$100 : Result := 'LM_USER';
$101 : Result := 'LM_RESIZE';
$102 : Result := 'LM_DESTROY';
$103 : Result := 'LM_ACTIVATE';
$104 : Result := 'LM_ACTIVATEITEM';
$105 : Result := 'LM_CHANGED';
$106 : Result := 'LM_FOCUS';
$107 : Result := 'LM_CLICKED';
$108 : Result := 'LM_PRESSED';
$109 : Result := 'LM_RELEASED';
$10A : Result := 'LM_MOVECURSOR';
$10B : Result := 'LM_ENTER';
$10C : Result := 'LM_LEAVE';
$10D : Result := 'LM_SIZEALLOCATE';
$10E : Result := 'LM_CHECKRESIZE';
$10F : Result := 'LM_SHOW';
$110 : Result := 'LM_INSERTTEXT';
$111 : Result := 'LM_DELETETEXT';
$112 : Result := 'LM_SETEDITABLE';
$113 : Result := 'LM_MOVEWORD';
$114 : Result := 'LM_MOVEPAGE';
$115 : Result := 'LM_MOVETOROW';
$116 : Result := 'LM_MOVETOCOLUMN';
$117 : Result := 'LM_KILLCHAR';
$118 : Result := 'LM_KILLWORD';
$119 : Result := 'LM_KILLLINE';
$11A : Result := 'LM_CUTTOCLIP';
$11B : Result := 'LM_COPYTOCLIP';
$11C : Result := 'LM_PASTEFROMCLIP';
$11D : Result := 'LM_MOVERESIZE';
$11E : Result := 'LM_EXPOSEEVENT';
$11F : Result := 'LM_CONFIGUREEVENT';
$120 : Result := 'LM_DRAW';
$121 : Result := 'LM_SHOWMODAL';
$122 : Result := 'LM_SETFILTER';
$123 : Result := 'LM_SETFILENAME';
$124 : Result := 'LM_OK_CLICKED';
$125 : Result := 'LM_CANCEL_CLICKED';
$126 : Result := 'LM_KEYDOWN';
$127 : Result := 'LM_KEYUP';
$128 : Result := 'LM_TIMER';
$129 : Result := 'LM_MOUSEBTNPRESS';
$12A : Result := 'LM_MOUSEBTNRELEASE';
$12B : Result := 'LM_GETITEMS';
$12C : Result := 'LM_GETITEMINDEX';
$12D : Result := 'LM_SETITEMINDEX';
$12E : Result := 'LM_SETITEMINDEX';
$12F : Result := 'LM_SETSELTEXT';
$130 : Result := 'LM_GETSELSTART';
$131 : Result := 'LM_SETSELSTART';
$132 : Result := 'LM_GETSELLEN';
$133 : Result := 'LM_SETSELLEN';
$134 : Result := 'LM_MOUSEWHEEL';
$135 : Result := 'LM_GETLIMITTEXT';
$136 : Result := 'LM_SETLIMITTEXT';
$137 : Result := 'LM_SORT';
$138 : Result := 'LM_GETSELCOUNT';
$139 : Result := 'LM_GETSEL';
$13A : Result := 'LM_SETSEL';
$13B : Result := 'LM_SETSELMODE';
$163 : Result := 'LM_UNKNOWN';
Else
Result := 'Unknown LM_Message = $' + IntToHex(LM_Message, 4);
End; {Case}
Result := GetMessageName(LM_Message);
End;
Function WM_ToString(WM_Message: Integer): String;
@ -346,19 +251,47 @@ Begin
End; {Case}
End;
{------------------------------------------------------------------------------
Function: XPMToIcon
Params: PixMap: Pointer to an array that contains pixmap data.
bAndBits: The AND bitmask of the new icon.
bXorBits: The XOR bitmask of the new icon.
FromFile: Does PixMap refer to a file containing pixmap data
(True) or an internal array (False)?
ToFile: File to which the new icon will be written. If this
parameter is an empty string, the icon will be kept
in memory.
Returns: A handle to the created icon.
The XPMToIcon function converts XPM-image data to an icon and returns the
icon's handle.
-------------------------------------------------------------------------------}
Function XPMToIcon(PixMap: PPChar; Var bAndBits, bXorBits: Byte; FromFile: Boolean; ToFile: String): HICON;
Begin
Result := HICON(NULL);
End;
Function XPMToIcon(PixMap: PPChar; Var bAndBits, bXorBits: Byte): HICON;
Begin
Result := XPMToIcon(PixMap, bAndBits, bXorBits, False, '');
End;
{-----------------------------------------------------------------------------}
{ Windows-property remover }
{-----------------------------------------------------------------------------}
Function PropEnumProps(Window: Hwnd; Str: PChar; Data: Handle): BOOL; StdCall;
Begin
Assert(False, 'Trace: PropEnumProps - Start');
Assert(False, Format('Trace: Property %S (with value %S) from window %S removed', [String(Str), IntToHex(Integer(GetProp(Window, Str)), 4), IntToHex(Window, 4)]));
Assert(False, 'Trace:PropEnumProps - Start');
Assert(False, Format('Trace:PropEnumProps - Property %S (with value $%S) from window $%S removed', [String(Str), IntToHex(Integer(GetProp(Window, Str)), 4), IntToHex(Window, 4)]));
RemoveProp(Window, Str);
Result := True;
Assert(False, 'Trace: PropEnumProps - Exit');
Assert(False, 'Trace:PropEnumProps - Exit');
End;
{------------------------------------------------------------------------------}
{ Window Handler }
{ Window Handler }
{------------------------------------------------------------------------------}
Function WindowProc(Window: HWnd; Mess: UInt; WPar: WParam; LPar: LParam): LResult; Export; StdCall;
Function WindowProc(Window: HWnd; Msg: UInt; WParam: WParam; LParam: LParam): LResult; Export; StdCall;
Var
OwnerObject: TObject;
Begin
@ -367,31 +300,28 @@ Begin
OwnerObject := TObject(GetProp(Window, 'Lazarus'));
Assert(False, 'Trace:WindowProc - Getting Object With Callback Procedure');
Assert(False, 'Trace:WindowProc - Checking Proc');
Assert(False, 'Trace:WindowProc - Value of Mess is ' + WM_ToString(Mess));
Case Mess of
Assert(False, Format('Trace:WindowProc - Window Value: $%S; Msg Value: %S; WParam: $%S; LParam: $%S', [IntToHex(Window, 4), WM_ToString(Msg), IntToHex(WParam, 4), IntToHex(LParam, 4)]));
Case Msg of
WM_Create:
Begin
Assert(False, 'Trace:WindowProc - Got WM_Create');
Exit;
End;
WM_Destroy:
Begin
Assert(False, 'Trace:WindowProc - Got WM_Destroy');
EnumProps(Window, @PropEnumProps);
PostQuitMessage(0);
Exit;
End;
WM_ShowWindow:
Begin
Assert(False, 'Trace:WindowProc - Got WM_ShowWindow');
Exit;
End;
WM_NCLButtonDown:
Begin
Assert(False, 'Trace:WindowProc - Got WM_NCLButtonDown');
End;
End; {Case}
Result := DefWindowProc(Window, Mess, WPar, LPar);
Result := DefWindowProc(Window, Msg, WParam, LParam);
Assert(False, 'Trace:WindowProc - Exit');
End;
@ -409,12 +339,12 @@ Begin
Begin
Style := cs_hRedraw or cs_vRedraw;
lpfnWndProc := WndProc(@WindowProc);
cbClsExtra := 1;
cbWndExtra := 1;
cbClsExtra := 40;
cbWndExtra := 40;
hInstance := System.HInstance;
hIcon := LoadIcon(0, idi_Application);
hCursor := LoadCursor(0, idc_Arrow);
hbrBackground := GetStockObject(GRAY_BRUSH);
hbrBackground := GetSysColorBrush(Color_BtnFace);
lpszMenuName := nil;
lpszClassName := ClsName;
End;
@ -438,6 +368,18 @@ begin
End;
end;
Procedure TWin32Object.WaitMessage;
Begin
Assert(False, 'TRACE:TWin32Object.WaitMessage - Start');
While True Do
Begin
Windows.PeekMessage(@FMessage, HWND(NULL), 0, 0, PM_REMOVE);
If FMessage.message <> 0 Then
Break;
End;
Assert(False, 'TRACE:TWin32Object.WaitMessage - Exit');
End;
const
BOOL_RESULT: array[Boolean] of String = ('False', 'True');
@ -453,120 +395,16 @@ Var
AcTbl: Array[1..50] Of ACCEL;
begin
inherited Create;
Try
FKeyStateList := TList.Create;
Assert(False, 'FKeyStateList initialized');
FDeviceContexts := TDynHashArray.Create(-1);
Assert(False, 'FDeviceContexts initialized');
FGDIObjects := TDynHashArray.Create(-1);
Assert(False, 'FGDIObjects initialized');
FMessageQueue := TList.Create;
Assert(False, 'FMessageQueue initialized');
Assert(False, 'TODO: [TWin32Object.Create] Create an accelerator group');
FAccelGroup := CreateAcceleratorTable(LPACCEL(@AcTbl), High(AcTbl));
Assert(False, 'FAccelGroup initialized');
FTimerData := TList.Create;
Assert(False, 'Created Class Name');
FromCBProc := False;
Assert(False, 'FromCBProc negated');
Except
Exit;
End;
FKeyStateList := TList.Create;
FDeviceContexts := TDynHashArray.Create(-1);
FGDIObjects := TDynHashArray.Create(-1);
FMessageQueue := TList.Create;
FAccelGroup := CreateAcceleratorTable(LPACCEL(@AcTbl), High(AcTbl));
FTimerData := TList.Create;
end;
destructor TWin32Object.Destroy;
const
GDITYPENAME: array[TGDIType] of String = ('gdiBitmap', 'gdiBrush'
,'gdiFont', 'gdiPen', 'gdiRegion');
var
n: Integer;
p: PMsg;
pTimerInfo : PWin32ITimerInfo;
GDITypeCount: array[TGDIType] of Integer;
GDIType: TGDIType;
HashItem: PDynHashArrayItem;
begin
// tidy up the messages
n:=FMessageQueue.Count-1;
while (n>=0) do begin
p := PMsg(FMessageQueue.Items[n]);
if p^.Message=LM_PAINT then begin
//writeln('[TgtkObject.Destroy] freeing unused paint message ',HexStr(p^.WParam,8));
ReleaseDC(0,P^.WParam);
Dispose(p);
FMessageQueue.Delete(n);
end;
dec(n);
end;
if (FDeviceContexts.Count > 0)
then begin
WriteLN(Format('[TgtkObject.Destroy] WARNING: There are %d unreleased DCs, a detailed dump follows:' ,[FDeviceContexts.Count]));
n:=0;
write('[TgtkObject.Destroy] DCs: ');
HashItem:=FDeviceContexts.FirstHashItem;
while (n<7) and (HashItem<>nil) do
begin
write(' ',HexStr(Cardinal(HashItem^.Item),8));
HashItem:=HashItem^.Next;
inc(n);
end;
writeln();
end;
if (FGDIObjects.Count > 0)
then begin
WriteLN(Format('[TgtkObject.Destroy] WARNING: There are %d unreleased GDIObjects, a detailed dump follows:' ,[FGDIObjects.Count]));
for GDIType := Low(GDIType) to High(GDIType) do
begin
for GDIType := Low(GDIType) to High(GDIType) do
GDITypeCount[GDIType] := 0;
n:=0;
write('[TgtkObject.Destroy] GDIOs:');
HashItem := FGDIObjects.FirstHashItem;
while (HashItem <> nil) do
begin
if n < 7
then write(' ',HexStr(Cardinal(HashItem^.Item),8));
Inc(GDITypeCount[PGdiObject(HashItem^.Item)^.GDIType]);
HashItem := HashItem^.Next;
Inc(n);
end;
Writeln();
for GDIType := Low(GDIType) to High(GDIType) do
if GDITypeCount[GDIType] > 0
then WriteLN(Format('[TgtkObject.Destroy] %s: %d', [GDITYPENAME[GDIType], GDITypeCount[GDIType]]));
end;
end;
if FMessageQueue.Count > 0
then begin
WriteLN(Format('[TgtkObject.Destroy] WARNING: There are %d messages left in the queue! I''ll free them' ,[FMessageQueue.Count]));
for n := 0 to FMessageQueue.Count - 1 do
begin
p := PMsg(FMessageQueue.Items[n]);
Dispose(P);
end;
end;
n := FTimerData.Count;
if (n > 0) then
begin
WriteLN(Format('[TgtkObject.Destroy] WARNING: There are %d TimerInfo structures left, I''ll free them' ,[n]));
while (n > 0) do
begin
dec (n);
pTimerInfo := PWin32ITimerInfo (FTimerData.Items[n]);
Dispose (pTimerInfo);
FTimerData.Delete (n);
end;
end;
FMessageQueue.Free;
FDeviceContexts.Free;
FGDIObjects.Free;
@ -633,7 +471,7 @@ Begin
Assert(False, 'Trace:Win32Object.Init - Register Failed');
Exit;
End;
FToolTipWindow := CreateWindowEx(WS_EX_TOPMOST, TOOLTIPS_CLASS, NULL, WS_POPUP Or TTS_NOPREFIX Or TTS_ALWAYSTIP, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, FParentWindow, HMENU(NULL), HInstance, NULL);
Windows.SendMessage(FParentWindow, TTM_ACTIVATE, WPARAM(BOOL(TRUE)), 0);
@ -651,7 +489,9 @@ Begin
FStockDkGrayBrush := CreateBrushIndirect(LogBrush);
LogBrush.lbColor := $FFFFFF;
FStockWhiteBrush := CreateBrushIndirect(LogBrush);
InitCommonControls;
Assert(False, 'Trace:Win32Object.Init - Exit');
End;
@ -748,7 +588,7 @@ var
GList : Pointer; // Only used for listboxes, replace with widget!!!!!
SelectionMode : DWORD; // currently only used for listboxes
ListItem : HWND; // currently only used for listboxes
Rect : TRect;
TRt : TRect;
AOwner : TControl;
R : Windows.Rect;
tbb : Array[0..100] Of TBBUTTON; // Limited to 101 buttons at present
@ -811,12 +651,13 @@ Begin
begin
Assert(False, 'Trace:TODO:bringtofront');
//For now just hide and show again.
if (Sender is TControl) then begin
BringWindowToTop((Sender As TWinControl).Handle);
{if (Sender is TControl) then begin
TControl(Sender).Parent.RemoveControl(TControl(Sender));
writeln('Removed control ', TControl(Sender).Name);
TControl(Sender).Parent.InsertControl(TControl(Sender));
writeln('Inserted control ', TControl(Sender).Name);
end;
end;}
end;
LM_BTNDEFAULT_CHANGED :
@ -854,7 +695,7 @@ Begin
end;
Assert(False, 'Trace:2');
pixmap := LoadBitmap(GetWindowLong(TWinControl(Sender).Parent.Handle, GWL_HINSTANCE), MAKEINTRESOURCE(PGDIObject(TBitBtn(Sender).Glyph.MaskHandle)^.GDIBitmapObject));
pixmap := LoadBitmap(HInstance, MAKEINTRESOURCE(PGDIObject(TBitBtn(Sender).Glyph.MaskHandle)^.GDIBitmapObject));
Assert(False, 'Trace:3');
Assert(False, 'Trace:4');
@ -885,7 +726,7 @@ Begin
LM_POPUPSHOW :
Begin
TrackPopupMenu(HMENU(TWinControl(Sender).Handle), TPM_LEFTALIGN, TControl(Sender).Left, TControl(Sender).Top, TWinControl(Sender).Parent.Handle, 0, Windows.PRECT(NULL)^);
TrackPopupMenu(HMENU(TWinControl(Sender).Handle), TPM_LEFTALIGN, TControl(Sender).Left, TControl(Sender).Top, TWinControl(Sender).Parent.Handle, 0, R);
{Displays a menu and makes it available for selection. Applications can use this function to display context-sensitive menus,
and will typically supply NULL for the parent_menu_shell, parent_menu_item, func and data parameters.
The default menu positioning function will position the menu at the current pointer position.
@ -975,8 +816,8 @@ activate_time : the time at which the activation event occurred.
If TSpeedbutton(sender).Visible then (Sender as TSpeedButton).perform(LM_PAINT,0,0)
else
Begin
Rect := TSpeedButton(sender).BoundsRect;
InvalidateRect(TSpeedButton(sender).Parent.Handle,@Rect,True);
TRt := TSpeedButton(sender).BoundsRect;
InvalidateRect(TSpeedButton(sender).Parent.Handle,@Trt,True);
end;
end;
@ -1074,7 +915,7 @@ activate_time : the time at which the activation event occurred.
LM_Invalidate :
begin
Assert(False, 'Trace:Trying to invalidate window... !!!');
Windows.InvalidateRect(Handle, Windows.PRECT(NULL)^, True);
Windows.InvalidateRect(Handle, R, True);
end;
LM_SCREENINIT :
@ -1088,7 +929,7 @@ activate_time : the time at which the activation event occurred.
if (Sender as TControl).fCompStyle = csCListBox
then begin
Widget := HWND(GetCoreChildControl(Sender));
Data := TWin32CListStringList.Create(Sender);
Data := TWin32CListStringList.Create((Sender As TWinControl).Handle);
Result := integer(Data);
end
else begin
@ -1102,7 +943,7 @@ activate_time : the time at which the activation event occurred.
else
raise Exception.Create('Message LM_GETITEMS - Not implemented');
end;
Data:= TWin32ListStringList.Create(PObject(Widget)^);
Data:= TWin32ListStringList.Create(Widget);
Result:= Integer(Data);
end;
end;
@ -1362,14 +1203,35 @@ Function TWin32Object.GetText(Sender: TControl; Var Data: String): Boolean;
Var
CapLen: Cardinal;
Caption: PChar;
Ctrl: TNotebook;
tci: TC_ITEM;
Begin
Assert(False, 'Trace:TWin32Object.GetText - start');
Data := '';
Result := True;
Case Sender.FCompStyle Of
csComboBox, csEdit, csMemo:
Begin
CapLen := GetWindowTextLength((Sender As TWinControl).Handle);
GetWindowText((Sender As TWinControl).Handle, Caption, CapLen);
GetWindowText((Sender As TWinControl).Handle, Caption, CapLen + 1);
End;
csPage:
Begin
Assert(False, 'Trace:TWin32Object.GetText - csPage: Start');
Ctrl := (TNotebook(Sender));
Try
Assert(False, 'Trace:TWin32Object.GetText - Filling TC_ITEM');
tci.mask := TCIF_TEXT;
tci.cchTextMax := MAX_PATH;
tci.pszText := StrAlloc(MAX_PATH);
Assert(False, 'Trace:TWin32Object.GetText - Getting the text');
TabCtrl_GetItem(Ctrl.Handle, PTabInfo(@Sender)^.Index, tci);
Assert(False, 'Trace:TWin32Object.GetText - Returning the text');
Caption := tci.pszText;
Except
StrDispose(tci.pszText);
End;
Assert(False, 'Trace:TWin32Object.GetText - csPage: Exit');
End;
Else
Result := False;
@ -1454,27 +1316,15 @@ End;
procedure TWin32Object.SetCallback(Msg : LongInt; Sender : TObject);
var
winObject : HWND;
signalFunc : Pointer;
gSignal : PChar;
I : Integer;
Signal : String;
//signalFunc: Pointer;
Mess: UINT;
MessFunc: TCBFunc;
MessFunc: CallbackProcedure;
WPar: WParam;
LPar: LParam;
Procedure SignalConnect(Message: UINT; Func: TCBFunc);
Begin
// Func;
End;
Function CallWndProc(Code: Integer; WP: ULong; LP: LParam): LResult; StdCall;
Begin
SignalConnect(Mess, MessFunc);
CallNextHookEx(FHkProc, Code, WP, LP);
Exit;
End;
PrevWndProc: LongInt;
Begin
If Sender is TControlCanvas then
winObject := (Sender as TControlCanvas).Handle
@ -1482,7 +1332,6 @@ Begin
winObject := FParentWindow
else
winObject := (Sender as TWinControl).Handle;
signalFunc := nil;
Signal := '';
case Msg of
LM_SHOWWINDOW : Begin
@ -1511,7 +1360,7 @@ Begin
End;
LM_CLICKED : Begin
Assert(False, 'Trace:SetCallBack - LM_CLICKED');
//Mess := WM_MBUTTONUPDOWN;
Mess := WM_LBUTTONUP;
signalFunc := @Win32clickedCB;
End;
LM_CONFIGUREEVENT : Begin
@ -1663,8 +1512,8 @@ Begin
Exit;
End;
End; {Case}
FromCBProc := True;
// FHkProc := Windows.SetWindowsHookEx(WH_CALLWNDPROC, @CallWndProc, HInstance, 0);
FromCbProc := True;
// CallbackProcedure(signalFunc);
gSignal:= StrAlloc(length(Signal) + 1);
StrPCopy(gSignal, signal);
StrDispose(gsignal);
@ -1674,10 +1523,9 @@ end;
{ TWin32Object RemoveCallBacks }
{ *Note: Removes Call Back Signals from the sender }
{------------------------------------------------------------------------------}
procedure TWin32Object.RemoveCallbacks(Sender : TControl);
procedure TWin32Object.RemoveCallbacks(Sender : TObject);
begin
FromCBProc := False;
UnhookWindowsHookEx(FHkProc);
end;
{------------------------------------------------------------------------------}
@ -1698,7 +1546,7 @@ Var
ColorSelect: TChooseColor;
CustomColors: TCustomColors;
RGBIO: DWord;
Flags: Integer;
Flags: DWord;
tci: TC_ITEM;
Const
Ext: PChar = 'txt';
@ -1749,9 +1597,12 @@ Begin
Case CompStyle of
csAlignment : Begin
Assert(False, 'TODO: Code csAlignment. If anyone knows how to do this, please do.');
End;
csBitBtn : Begin
P := CreateWindow('BUTTON', strTemp, WS_CHILD Or WS_VISIBLE Or BS_BITMAP, (Sender As TControl).Left, (Sender As TControl).Top, (Sender As TControl).Width, (Sender As TControl).Height, FParentWindow, HMENU(Nil), HInstance, Nil);
SetProp(P, 'Lazarus', @Sender);
SetName(Pointer(P), strTemp);
End;
csButton : Begin
Assert(False, 'Trace:CreateComponent - Creating Button');
@ -1764,8 +1615,13 @@ Begin
Assert(False, 'Trace:CreateComponent - Value of Button Top is $' + IntToHex((Sender as TControl).Top , 4));
Assert(False, 'Trace:CreateComponent - Value of Button Width is $' + IntToHex((Sender as TControl).Width , 4));
Assert(False, 'Trace:CreateComponent - Value of Button Height is $' + IntToHex((Sender as TControl).Height, 4));
Flags := WS_VISIBLE Or WS_CHILD;
If Not (Sender As TButton).Default Then
Flags := Flags Or BS_PUSHBUTTON
Else
Flags := Flags Or BS_DEFPUSHBUTTON;
P := CreateWindow('BUTTON', strTemp,
WS_VISIBLE OR WS_CHILD OR BS_DEFPUSHBUTTON,
Flags,
(Sender as TControl).Left,
(Sender as TControl).Top,
(Sender as TControl).Width,
@ -1776,29 +1632,42 @@ Begin
Assert(False, 'Trace:CreateComponent - Creating a Button - SetProp');
if P <> HWND(nil) then
SetProp(HWND(P), 'Lazarus', @Sender);
SetName(Pointer(p),StrTemp);
SetName(Pointer(P), StrTemp);
End;
csCanvas : Begin
Assert(False, 'TODO: Code TWin32Object.CreateComponent: style csCanvas');
P := CreateWindow(ClsName, strTemp, WS_DLGFRAME Or WS_POPUP Or WS_VISIBLE, (Sender As TControl).Left, (Sender As TControl).Top, (Sender As TControl).Width, (Sender As TControl).Height, HWND(Nil), HMENU(Nil), HInstance, Nil);
SetProp(P, 'Lazarus', @Sender);
SetName(Pointer(P), strTemp);
End;
csCheckbox : Begin
CreateWindow('BUTTON', strTemp, WS_CHILD Or WS_VISIBLE Or BS_CHECKBOX, (Sender As TControl).Left, (Sender As TControl).Top, (Sender As TControl).Width, (Sender As TControl).Height, FParentWindow, HMENU(Nil), HInstance, Nil);
P := CreateWindow('BUTTON', strTemp, WS_VISIBLE OR WS_CHILD OR BS_CHECKBOX, (Sender as TControl).Left, (Sender as TControl).Top, (Sender as TControl).Width, (Sender as TControl).Height, FParentWindow, HMenu(Nil), HInstance, nil);
SetProp(P, 'Lazarus', @Sender);
SetName(Pointer(P), strTemp);
End;
csComboBox : Begin
P := CreateWindow('COMBOBOX', Nil, WS_CHILD Or WS_VISIBLE Or CBS_AUTOHSCROLL Or CBS_DROPDOWN, (Sender As TControl).Left, (Sender As TControl).Top, (Sender As TControl).Width, (Sender As TControl).Height, FParentWindow, HMENU(Nil), HInstance, Nil);
SendMessage(HWND(P), CB_ADDSTRING, 0, LPARAM(LPCTSTR(strTemp)));
SetProp(P, 'Lazarus', @Sender);
SetName(@P, strTemp);
End;
csListBox : Begin
P := CreateWindow('LISTBOX', Nil, WS_CHILD Or WS_VISIBLE, (Sender As TControl).Left, (Sender As TControl).Top, (Sender As TControl).Width, (Sender As TControl).Width, FParentWindow, HMENU(Nil), HInstance, Nil);
SendMessage(HWND(P), LB_ADDSTRING, 0, LPARAM(LPCTSTR(strTemp)));
SetProp(P, 'Lazarus', @Sender);
SetName(Pointer(P), strTemp);
End;
csCListBox : Begin
P := CreateWindow('LISTBOX', Nil, WS_CHILD Or WS_VISIBLE Or LBS_MULTICOLUMN, (Sender As TControl).Left, (Sender As TControl).Top, (Sender As TControl).Width, (Sender As TControl).Width, FParentWindow, HMENU(Nil), HInstance, Nil);
SendMessage(HWND(P), LB_SETCOLUMNWIDTH, WPARAM((Sender As TCListBox).Width Div ((Sender As TCListBox).ListColumns)), 0);
SendMessage(HWND(P), LB_ADDSTRING, 0, LPARAM(LPCTSTR(strTemp)));
SetProp(P, 'Lazarus', @Sender);
SetName(Pointer(P), strTemp);
End;
csEdit : Begin
P := CreateWindow('EDIT', strTemp, WS_CHILD OR WS_VISIBLE Or ES_AUTOHSCROLL, (Sender As TControl).Left, (Sender As TControl).Top, (Sender As TControl).Width, (Sender As TControl).Height, FParentWindow, HMENU(Nil), HInstance, Nil);
P := CreateWindow('EDIT', strTemp, WS_CHILD OR WS_VISIBLE Or WS_BORDER Or ES_AUTOHSCROLL, (Sender As TControl).Left, (Sender As TControl).Top, (Sender As TControl).Width, (Sender As TControl).Height, FParentWindow, HMENU(Nil), HInstance, Nil);
SetProp(P, 'Lazarus', @Sender);
SetName(Pointer(P), strTemp);
End;
csFileDialog : Begin
Assert(False, 'TRACE: CreateComponent - Creating a file-selection dialog');
@ -1818,6 +1687,8 @@ Begin
Win32DialogOKclickedCB(Pointer(P), Sender);
Win32DialogOKclickedCB(Pointer(P), Sender);
Win32DialogOKclickedCB(Pointer(P), Sender);
SetProp(P, 'Lazarus', @Sender);
SetName(Pointer(P), strTemp);
End;
csColorDialog : Begin
Assert(False, 'TRACE: CreateComponent - Creating a color-selection dialog');
@ -1834,13 +1705,15 @@ Begin
Win32DialogOKclickedCB(Pointer(P), Sender);
Win32DialogOKclickedCB(Pointer(P), Sender);
Win32DialogOKclickedCB(Pointer(P), Sender);
SetProp(P, 'Lazarus', @Sender);
SetName(Pointer(P), strTemp);
End;
csFontDialog :
Begin
Assert(False, 'TODO: Write code to make a font dialog when component style csFontDialog is specified. No dialog created.');
End;
csFixed : Begin
Assert((@ParentWindow = Nil), 'TODO: Figure out what component style fsFixed is and code the component. No component created.');
Assert(False, 'TODO: Figure out what component style fsFixed is and code the component. No component created.');
End;
csFont : Begin
Assert(False, 'Trace:CreateComponent - Creating a font');
@ -1883,36 +1756,51 @@ Begin
SetName(Pointer(p), StrTemp);
End;
csFrame : Begin
P := CreateWindowEx(Integer(Nil), 'BUTTON', strTemp, WS_CHILD Or WS_VISIBLE Or BS_GROUPBOX, (Sender As TControl).Left, (Sender As TControl).Top, (Sender As TControl).Width, (Sender As TControl).Height, FParentWindow, HMENU(Nil), HInstance, Nil);
P := CreateWindow('BUTTON', strTemp, WS_CHILD Or WS_VISIBLE Or BS_GROUPBOX, (Sender As TControl).Left, (Sender As TControl).Top, (Sender As TControl).Width, (Sender As TControl).Height, FParentWindow, HMENU(Nil), HInstance, Nil);
SetProp(P, 'Lazarus', @Sender);
SetName(Pointer(P), strTemp);
End;
csLabel : Begin
P := CreateWindow('STATIC', strTemp, WS_CHILD Or WS_VISIBLE Or SS_LEFT Or SS_SIMPLE, (Sender As TControl).Left, (Sender As TControl).Top, (Sender As TControl).Width, (Sender As TControl).Height, FParentWindow, HMENU(Nil), HInstance, Nil);
SetProp(P, 'Lazarus', @Sender);
SetName(Pointer(P), strTemp);
End;
csMemo : Begin
Assert(False, 'Creating a MEMO...');
Flags := WS_CHILD Or WS_VISIBLE Or ES_AUTOHSCROLL Or ES_AUTOVSCROLL Or ES_MULTILINE Or ES_WANTRETURN;
Flags := WS_CHILD Or WS_VISIBLE Or ES_AUTOHSCROLL Or ES_AUTOVSCROLL Or ES_MULTILINE;
If (Sender As TMemo).ReadOnly Then
Flags := Flags Or ES_READONLY;
Flags := Flags Or ES_ReadOnly;
Case (Sender As TCustomMemo).Scrollbars Of
ssHorizontal : Flags := Flags Or WS_HSCROLL;
ssVertical : Flags := Flags Or WS_VSCROLL;
ssBoth : Flags := Flags Or WS_HSCROLL Or WS_VSCROLL;
ssBoth : Flags := Flags Or WS_HSCROLL Or WS_VSCROLL;
End;
P := CreateWindow('EDIT', strTemp, Flags, (Sender As TControl).Left, (Sender As TControl).Top, (Sender As TControl).Width, (Sender As TControl).Height, FParentWindow, HMENU(Nil), HInstance, Nil);
SetProp(HWND(P), 'Lazarus', @Sender);
SetName(Pointer(P), strTemp);
End;
csMenuBar : Begin
P := HWND(CreateMenu);
FMenu := HMENU(P);
SetProp(P, 'Lazarus', @Sender);
SetName(Pointer(P), strTemp);
End;
csMenuItem : Begin
Assert(False, 'Trace: CreateComponent - Creating component menu item.');
Assert(False, 'Trace:CreateComponent - Creating component menu item.');
P := HWND(CreateMenu);
SetProp(P, 'Lazarus', @Sender);
SetName(Pointer(P), strTemp);
Assert(False, 'Trace:CreateComponent - Finished menu item');
End;
csNotebook : Begin
P := CreateWindow(WC_TABCONTROL, Nil, WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS, (Sender As TControl).Left, (Sender As TControl).Top, (Sender As TControl).Width, (Sender As TControl).Height, FParentWindow, HMENU(Nil), HInstance, Nil);
SetProp(P, 'Lazarus', @Sender);
SetName(Pointer(P), strTemp);
End;
csRadioButton : Begin
P := CreateWindow('BUTTON', strTemp, WS_CHILD Or WS_VISIBLE Or BS_RADIOBUTTON, (Sender As TControl).Left, (Sender As TControl).Top, (Sender As TControl).Width, (Sender As TControl).Height, FParentWindow, HMENU(Nil), HInstance, Nil);
SetProp(P, 'Lazarus', @Sender);
SetName(Pointer(P), strTemp);
End;
csScrollBar : Begin
Flags := WS_CHILD Or WS_Visible;
@ -1921,10 +1809,14 @@ Begin
sbVertical : Flags := Flags Or SBS_VERT;
End;
P := CreateWindow('SCROLLBAR', Nil, Flags, (Sender As TControl).Left, (Sender As TControl).Top, (Sender As TControl).Width, (Sender As TControl).Height, FParentWindow, HMENU(Nil), HInstance, Nil);
SetProp(P, 'Lazarus', @Sender);
SetName(Pointer(P), strTemp);
End;
csScrolledWindow : Begin
Assert(False, 'TRACE: CreateComponent - creating a scrolled window');
P := CreateWindow(AppName, strTemp, WS_OVERLAPPEDWINDOW Or WS_HSCROLL Or WS_VSCROLL Or WS_Visible, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, HWND(Nil), HMENU(Nil), HInstance, Nil);
SetProp(P, 'Lazarus', @Sender);
SetName(Pointer(P), strTemp);
End;
csSpeedButton : Begin
Assert(False, 'TODO: Code the speed button control');
@ -1936,46 +1828,60 @@ Begin
End;
csSTATUSBAR : Begin
Assert(False, 'TRACE: CreateComponent - Creating Status Bar');
CreateStatusWindow(WS_CHILD Or WS_VISIBLE, strTemp, FParentWindow, FControlIndex);
Inc(FControlIndex);
P := CreateStatusWindow(WS_CHILD Or WS_VISIBLE, strTemp, FParentWindow, $7712);
SetProp(HWND(P), 'Lazarus', @Sender);
SetName(Pointer(P), strTemp);
End;
csgtkTable : Begin
Assert(False, 'TODO: Create GTK Table (ie, spreadsheet) control. I''m not sure how to do this, but I assume an array (or TList) of records containing the rows and columns and the properties(x, y, width, height, etc) of everything. If you think you can help, be my guest.');
Assert(@Sender <> Nil, 'TRACE: GTK Table not created');
Assert(False, 'TRACE: GTK Table not created');
End;
csToggleBox : Begin
Assert(False, 'TRACE: CreateComponent - Creating toggle box');
P := CreateWindow('BUTTON', strTemp, WS_CHILD Or WS_VISIBLE Or BS_AUTOCHECKBOX Or BS_PUSHLIKE, (Sender As TControl).Left, (Sender As TControl).Top, (Sender As TControl).Width, (Sender As TControl).Height, FParentWindow, HMENU(Nil), HInstance, Nil);
SetProp(P, 'Lazarus', @Sender);
SetName(Pointer(P), strTemp);
End;
csToolBar : Begin
P := CreateWindow(TOOLBARCLASSNAME, LPSTR(Nil), WS_CHILD Or WS_VISIBLE OR CCS_ADJUSTABLE, (Sender As TControl).Left, (Sender As TControl).Top, (Sender As TControl).Width, (Sender As TControl).Height, FParentWindow, HMENU(Nil), HInstance, Nil);
End;
csToolButton : Begin
P := IntSendMessage3(LM_INSERTTOOLBUTTON, Sender, Pointer((Sender As TToolButton).Index));
SetProp(P, 'Lazarus', @Sender);
SetName(Pointer(P), strTemp);
End;
csGroupBox : Begin
Assert(False, 'TODO: Code csGroupBox. Is this the same as csFrame?');
End;
csPage : Begin // TPage - Notebook page
Assert(False, 'TODO: Create a csPage component.');
Assert(False, 'Trace: Going to try it here. I''m guaranteeing nothing.');
Assert(False, 'Trace:TODO:Create a csPage component.');
Assert(False, 'Trace:Going to try it here. I''m guaranteeing nothing.');
With tci Do
Begin
Mask := TCIF_TEXT;
PSzText := strTemp;
End;
TabCtrl_InsertItem(HWND((Sender As TWinControl).Handle), -1, tci);
Assert(False, 'Trace:csPage - class name is ' + (Sender As TWinControl).Parent.ClassName);
P := TabCtrl_InsertItem(HWND((Sender As TWinControl).Parent.Handle), -1, tci);
SetProp(P, 'Lazarus', @Sender);
SetName(Pointer(P), strTemp);
End;
csPopupMenu : Begin
P := HWND(CreatePopupMenu);
FSubMenu := HMENU(P);
SetProp(P, 'Lazarus', @Sender);
SetName(Pointer(P), strTemp);
End;
csProgressBar : Begin
P := CreateWindow(PROGRESS_CLASS, strTemp, WS_CHILD Or WS_VISIBLE, (Sender As TControl).Left, (Sender As TControl).Top, (Sender As TControl).Width, (Sender As TControl).Height, FParentWindow, HMENU(Nil), HInstance, Nil);
P := CreateWindow(PROGRESS_CLASS, NULL, WS_CHILD Or WS_VISIBLE, (Sender As TControl).Left, (Sender As TControl).Top, (Sender As TControl).Width, (Sender As TControl).Height, FParentWindow, HMENU(Nil), HInstance, Nil);
SetProp(P, 'Lazarus', @Sender);
SetName(Pointer(P), strTemp);
End;
csTrackBar: Begin
Assert(False, 'TRACE: CreateComponent - Creating a Track Bar (if we''re lucky)');
P := CreateWindowEx(DWord(Nil), strTemp, TRACKBAR_CLASS, WS_CHILD Or WS_VISIBLE, (Sender As TControl).Left, (Sender As TControl).Top, (Sender As TControl).Width, (Sender As TControl).Height, FParentWindow, HMENU(Nil), HInstance, Nil);
Assert(False, 'TRACE:CreateComponent - Creating a Track Bar (if we''re lucky)');
P := CreateWindow(TRACKBAR_CLASS, strTemp, WS_CHILD Or WS_VISIBLE, (Sender As TControl).Left, (Sender As TControl).Top, (Sender As TControl).Width, (Sender As TControl).Height, FParentWindow, HMENU(Nil), HInstance, Nil);
SetProp(P, 'Lazarus', @Sender);
SetName(Pointer(P), strTemp);
End;
end; {Case}
@ -2159,17 +2065,17 @@ begin
case TControl(Sender).fCompStyle of
csTrackbar :
if (handle <> nil) then begin
integer(data^) := round(SendMessage(HWND(handle), TBM_GETRANGEMAX, 0, 0) - SendMessage(HWND(handle), TBM_GETRANGEMIN, 0, 0));
integer(data) := round(SendMessage(HWND(handle), TBM_GETRANGEMAX, 0, 0) - SendMessage(HWND(handle), TBM_GETRANGEMIN, 0, 0));
end else
integer(data^) := 0;
integer(data) := 0;
csRadiobutton,
csCheckbox :
if SendMessage(HWND(handle), BM_GETSTATE, 0, 0) = BST_CHECKED then
TCheckBoxState(data^) := cbChecked;
TCheckBoxState(data) := cbChecked;
else if SendMessage(HWND(handle), BM_GETSTATE, 0, 0) = BST_UNCHECKED then
TCheckBoxState(data^) := cbUnChecked
TCheckBoxState(data) := cbUnChecked
else
Assert (true, Format ('WARNING:[TgtkObject.GetValue] failed for %s', [Sender.ClassName]));
end;
@ -2199,10 +2105,11 @@ begin
else Assert(False, Format('Trace:WARNING: [TgtkObject.SetValue] %s --> No Decendant of TWinControl', [Sender.ClassName]));
Handle := Pointer(TWinControl(Sender).Handle);
Assert (Handle = nil, 'WARNING: [TgtkObject.SetValue] --> got nil pointer (no gtkobject)');
If Handle = Nil Then
Assert (False, 'Trace:WARNING: [TgtkObject.SetValue] --> got nil pointer (no gtkobject)');
case TControl(Sender).fCompStyle of
csProgressBar: SendMessage(HWND(Handle), PBM_SETPOS, WPARAM(data^), 0);
csProgressBar: SendMessage(HWND(Handle), PBM_SETPOS, WPARAM(data), 0);
csTrackbar : begin
if Handle = nil then Exit;
@ -2212,12 +2119,12 @@ begin
csRadiobutton,
csCheckbox : begin
if TCheckBoxState (data^) = cbChecked
if TCheckBoxState (data) = cbChecked
then SendMessage(HWND(Handle), BM_SETCHECK, BST_CHECKED, 0)
else SendMessage(HWND(Handle), BM_SETCHECK, BST_UNCHECKED, 0);
end;
else
Assert (true, Format ('WARNING:[TgtkObject.SetValue] failed for %s', [Sender.ClassName]));
Assert (true, Format ('Trace:WARNING:[TgtkObject.SetValue] failed for %s', [Sender.ClassName]));
end;
end;
@ -2244,7 +2151,8 @@ begin
else Assert(False, Format('Trace:WARNING: [TgtkObject.SetProperties] %s --> No Decendant of TWinControl', [Sender.ClassName]));
Handle := Pointer(TWinControl(Sender).Handle);
Assert (Handle = nil, 'WARNING: [TgtkObject.SetProperties] --> got nil pointer');
If Handle = Nil Then
Assert (False, 'Trace:WARNING: [TgtkObject.SetProperties] --> got nil pointer');
case TControl(Sender).fCompStyle of
csEdit :
@ -2407,7 +2315,7 @@ var
AccelGroup: HACCEL;
MenuParent, MenuItem: HMENU;
begin
Assert(False, 'TODO: [TWin32Object.AttachMenu] Get accelerators up');
Assert(False, 'Trace:TODO: [TWin32Object.AttachMenu] Get accelerators up');
with (Sender as TMenuItem) do
begin
MenuItem := Handle;
@ -2417,7 +2325,7 @@ begin
begin
MenuParent := Parent.Handle;
AppendMenu(Parent.Handle, MF_POPUP, Handle, StrToPChar(Caption));
SetMenu(FParentWindow, Parent.Handle);
Windows.SetMenu(FParentWindow, Parent.Handle);
DrawMenuBar(FParentWindow);
end
else begin
@ -2428,7 +2336,7 @@ begin
MenuParent := CreateMenu;
SetProp(Parent.Handle, 'ContainerMenu', Pointer(MenuParent));
SetMenu(Parent.Handle, MenuParent);
Windows.SetMenu(Parent.Handle, MenuParent);
AccelGroup := CreateAcceleratorTable(LPACCEL(Nil), 0);
end;
@ -2725,6 +2633,9 @@ End;
{
$Log$
Revision 1.3 2001/11/01 22:40:13 lazarus
MG: applied Keith Bowes win32 interface updates
Revision 1.2 2001/08/02 12:58:35 lazarus
MG: win32 interface patch from Keith Bowes

View File

@ -368,6 +368,9 @@ end;
{ =============================================================================
$Log$
Revision 1.2 2001/11/01 22:40:14 lazarus
MG: applied Keith Bowes win32 interface updates
Revision 1.1 2001/08/02 12:58:35 lazarus
MG: win32 interface patch from Keith Bowes
@ -494,7 +497,7 @@ end;
Fixed TEdit text bug (thanks to hans-joachim ott <hjott@compuserve.com>)
Finished GetKeyState
Added changes from Peter Dyson <peter@skel.demon.co.uk>
- a new GetSysColor
- a new GetSysColor
- some improvements on ExTextOut
Revision 1.7 2000/03/03 22:58:26 lazarus

View File

@ -1,19 +1,26 @@
{
Extra Win32 code that's not in the RTL.
Copyright (C) 2001 Keith Bowes.
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.
This library 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. See the GNU
Lesser General Public License for more details.
}
Unit WinExt;
{ winext.pas: Extra Win32 code that's not in the RTL. }
{ Copyright (C) 2001 Keith Bowes. }
{ This unit is licensed under the GNU LGPL.
See http://www.gnu.org/copyleft/lesser.html for details. }
{$LONGSTRINGS ON}
{$MODE OBJFPC}
{$PACKRECORDS C}
{$SMARTLINK ON}
{$TYPEDADDRESS ON}
Interface
Uses SysUtils, Windows;
Uses Windows;
{ Types not included in system.pp }
Type
@ -37,11 +44,11 @@ Const
DSC_MODAL = WS_POPUP Or WS_SYSMENU Or WS_CAPTION Or DS_MODALFRAME;
{ Recommended modeless-dialog style }
DSC_MODELESS = WS_POPUP Or WS_CAPTION Or WS_BORDER Or WS_SYSMENU;
{ The windows' direct parent window }
{ The window's direct parent window }
GA_PARENT = 1;
{ The windows' root window }
{ The window's root window }
GA_ROOT = 2;
{ The windows' owner }
{ The window's owner }
GA_ROOTOWNER = 3;
{ Application starting cursor }
IDC_APPSTARTING = 32650;
@ -68,46 +75,26 @@ Function StrToPChar(Const Str: String): PChar;
Implementation
Uses SysUtils;
{$PACKRECORDS NORMAL}
Type
TStrArray = Array[1..2] Of Char;
PStrArray = ^TStrArray;
Var
ArLen: Cardinal;
StrArray: PStrArray;
TmpStr: PChar;
{ Function StrToPChar: Converts a String to a PChar without using a
buffer.
Parameters:
* Str: String to convert.
Returns: A PChar equivalent of the input string.
}
Function StrToPChar(Const Str: String): PChar;
Var
I: Cardinal;
Begin
StrArray := Nil;
ArLen := SizeOf(Str) * Length(Str);
GetMem(StrArray, ArLen);
For I := 1 To Length(Str) Do
StrArray^[I] := Str[I];
Result := PChar(StrArray);
TmpStr := PChar(Str);
Result := TmpStr;
End;
Initialization
ArLen := 0;
StrArray := Nil;
TmpStr := StrNew('');
Finalization
If ArLen <> 0 Then
FreeMem(StrArray, ArLen);
StrArray := Nil;
StrDispose(TmpStr);
TmpStr := Nil;
End.