MG: applied Keith Bowes win32 interface updates
git-svn-id: trunk@383 -
74
.gitattributes
vendored
@ -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
@ -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
|
||||
|
@ -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
|
||||
|
BIN
ide/lazarus.ico
Before Width: | Height: | Size: 3.2 KiB After Width: | Height: | Size: 766 B |
BIN
images/ActiveBreakPoint.ico
Normal file
After Width: | Height: | Size: 1.4 KiB |
BIN
images/InactiveBreakPoint.ico
Normal file
After Width: | Height: | Size: 1.4 KiB |
BIN
images/bookmark0.ico
Normal file
After Width: | Height: | Size: 1.4 KiB |
BIN
images/bookmark1.ico
Normal file
After Width: | Height: | Size: 1.4 KiB |
BIN
images/bookmark2.ico
Normal file
After Width: | Height: | Size: 1.4 KiB |
BIN
images/bookmark3.ico
Normal file
After Width: | Height: | Size: 1.4 KiB |
BIN
images/bookmark4.ico
Normal file
After Width: | Height: | Size: 1.4 KiB |
BIN
images/bookmark5.ico
Normal file
After Width: | Height: | Size: 1.4 KiB |
BIN
images/bookmark6.ico
Normal file
After Width: | Height: | Size: 1.4 KiB |
BIN
images/bookmark7.ico
Normal file
After Width: | Height: | Size: 1.4 KiB |
BIN
images/bookmark8.ico
Normal file
After Width: | Height: | Size: 1.4 KiB |
BIN
images/bookmark9.ico
Normal file
After Width: | Height: | Size: 1.4 KiB |
BIN
images/btn_downarrow.ico
Normal file
After Width: | Height: | Size: 1.1 KiB |
BIN
images/btn_newform.ico
Normal file
After Width: | Height: | Size: 1.3 KiB |
BIN
images/btn_newunit.ico
Normal file
After Width: | Height: | Size: 1.3 KiB |
BIN
images/btn_openfile.ico
Normal file
After Width: | Height: | Size: 1.3 KiB |
BIN
images/btn_run.ico
Normal file
After Width: | Height: | Size: 1.2 KiB |
BIN
images/btn_save.ico
Normal file
After Width: | Height: | Size: 1.3 KiB |
BIN
images/btn_saveall.ico
Normal file
After Width: | Height: | Size: 1.4 KiB |
BIN
images/btn_toggleform.ico
Normal file
After Width: | Height: | Size: 1.4 KiB |
BIN
images/btn_viewforms.ico
Normal file
After Width: | Height: | Size: 1.4 KiB |
BIN
images/btn_viewunits.ico
Normal file
After Width: | Height: | Size: 1.3 KiB |
BIN
images/color.ico
Normal file
After Width: | Height: | Size: 1.5 KiB |
BIN
images/default.ico
Normal file
After Width: | Height: | Size: 1.5 KiB |
BIN
images/downarrow.ico
Normal file
After Width: | Height: | Size: 1.8 KiB |
BIN
images/fonts.ico
Normal file
After Width: | Height: | Size: 1.5 KiB |
BIN
images/lazarus.ico
Normal file
After Width: | Height: | Size: 144 KiB |
BIN
images/lazarus64.ico
Normal file
After Width: | Height: | Size: 53 KiB |
BIN
images/leftarrow.ico
Normal file
After Width: | Height: | Size: 1.8 KiB |
BIN
images/mainicon.ico
Normal file
After Width: | Height: | Size: 11 KiB |
BIN
images/notebook.ico
Normal file
After Width: | Height: | Size: 1.8 KiB |
BIN
images/penguin.ico
Normal file
After Width: | Height: | Size: 26 KiB |
BIN
images/rightarrow.ico
Normal file
After Width: | Height: | Size: 1.8 KiB |
BIN
images/tbevel.ico
Normal file
After Width: | Height: | Size: 1.8 KiB |
BIN
images/tbitbtn.ico
Normal file
After Width: | Height: | Size: 1.8 KiB |
BIN
images/tbutton.ico
Normal file
After Width: | Height: | Size: 1.8 KiB |
BIN
images/tcheckbox.ico
Normal file
After Width: | Height: | Size: 1.8 KiB |
BIN
images/tcolordialog.ico
Normal file
After Width: | Height: | Size: 1.7 KiB |
BIN
images/tcombobox.ico
Normal file
After Width: | Height: | Size: 1.5 KiB |
BIN
images/tdatabase.ico
Normal file
After Width: | Height: | Size: 1.5 KiB |
BIN
images/tdatasource.ico
Normal file
After Width: | Height: | Size: 1.7 KiB |
BIN
images/tedit.ico
Normal file
After Width: | Height: | Size: 1.8 KiB |
BIN
images/tfontdialog.ico
Normal file
After Width: | Height: | Size: 1.7 KiB |
BIN
images/tgroupbox.ico
Normal file
After Width: | Height: | Size: 1.6 KiB |
BIN
images/tibdatabase.ico
Normal file
After Width: | Height: | Size: 1.5 KiB |
BIN
images/tibquery.ico
Normal file
After Width: | Height: | Size: 1.7 KiB |
BIN
images/tlabel.ico
Normal file
After Width: | Height: | Size: 1.8 KiB |
BIN
images/tlistbox.ico
Normal file
After Width: | Height: | Size: 1.5 KiB |
BIN
images/tlistview.ico
Normal file
After Width: | Height: | Size: 1.8 KiB |
BIN
images/tmemo.ico
Normal file
After Width: | Height: | Size: 1.8 KiB |
BIN
images/tmenu.ico
Normal file
After Width: | Height: | Size: 1.8 KiB |
BIN
images/tnotebook.ico
Normal file
After Width: | Height: | Size: 1.8 KiB |
BIN
images/topendialog.ico
Normal file
After Width: | Height: | Size: 1.7 KiB |
BIN
images/topenpicturedialog.ico
Normal file
After Width: | Height: | Size: 1.7 KiB |
BIN
images/tpaintbox.ico
Normal file
After Width: | Height: | Size: 1.8 KiB |
BIN
images/tpanel.ico
Normal file
After Width: | Height: | Size: 1.8 KiB |
BIN
images/tpopupmenu.ico
Normal file
After Width: | Height: | Size: 1.8 KiB |
BIN
images/tprinterdialog.ico
Normal file
After Width: | Height: | Size: 1.7 KiB |
BIN
images/tprintersetupdialog.ico
Normal file
After Width: | Height: | Size: 1.7 KiB |
BIN
images/tprogressbar.ico
Normal file
After Width: | Height: | Size: 1.8 KiB |
BIN
images/tquery.ico
Normal file
After Width: | Height: | Size: 1.7 KiB |
BIN
images/tradiobutton.ico
Normal file
After Width: | Height: | Size: 1.8 KiB |
BIN
images/tradiogroup.ico
Normal file
After Width: | Height: | Size: 1.8 KiB |
BIN
images/tsavedialog.ico
Normal file
After Width: | Height: | Size: 1.7 KiB |
BIN
images/tsavepicturedialog.ico
Normal file
After Width: | Height: | Size: 1.7 KiB |
BIN
images/tscrollbar.ico
Normal file
After Width: | Height: | Size: 1.5 KiB |
BIN
images/tspeedbutton.ico
Normal file
After Width: | Height: | Size: 1.8 KiB |
BIN
images/tspinedit.ico
Normal file
After Width: | Height: | Size: 1.8 KiB |
BIN
images/tstatusbar.ico
Normal file
After Width: | Height: | Size: 1.8 KiB |
BIN
images/ttimer.ico
Normal file
After Width: | Height: | Size: 1.7 KiB |
BIN
images/ttogglebox.ico
Normal file
After Width: | Height: | Size: 1.5 KiB |
BIN
images/ttoolbar.ico
Normal file
After Width: | Height: | Size: 1.8 KiB |
BIN
images/ttrackbar.ico
Normal file
After Width: | Height: | Size: 1.8 KiB |
BIN
images/uparrow.ico
Normal file
After Width: | Height: | Size: 1.8 KiB |
@ -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
|
||||
|
@ -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
|
@ -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
|
||||
|
||||
|
@ -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}
|
||||
|
||||
|
||||
|
||||
|
@ -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
|
||||
|
||||
|
@ -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
|
||||
|
@ -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.
|