mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-07 00:28:23 +02:00
+ Added SysUtils, Classes, Messages units for WinCE.
+ More units are built for WinCE. git-svn-id: trunk@1037 -
This commit is contained in:
yury
parent
398b31226b
commit
9bccd2a725
4
.gitattributes
vendored
4
.gitattributes
vendored
@ -4206,10 +4206,14 @@ rtl/win64/system.pp svneol=native#text/plain
|
||||
rtl/wince/Makefile svneol=native#text/plain
|
||||
rtl/wince/Makefile.fpc svneol=native#text/plain
|
||||
rtl/wince/arm/wprt0.as svneol=native#text/plain
|
||||
rtl/wince/classes.pp -text
|
||||
rtl/wince/dos.pp -text
|
||||
rtl/wince/i386/wprt0.as svneol=native#text/plain
|
||||
rtl/wince/messages.pp -text
|
||||
rtl/wince/readme-winceapi-port -text
|
||||
rtl/wince/system.pp svneol=native#text/plain
|
||||
rtl/wince/sysutils.pp -text
|
||||
rtl/wince/tthread.inc -text
|
||||
rtl/wince/windows.pp -text
|
||||
rtl/wince/wininc/base.inc -text
|
||||
rtl/wince/wininc/defines.inc -text
|
||||
|
||||
@ -248,112 +248,112 @@ GRAPHDIR=$(INC)/graph
|
||||
include $(WININC)/makefile.inc
|
||||
WINDOWS_SOURCE_FILES=$(addprefix $(WININC)/,$(addsuffix .inc,$(WINDOWS_FILES)))
|
||||
ifeq ($(FULL_TARGET),i386-linux)
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-go32v2)
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-win32)
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-os2)
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-freebsd)
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-beos)
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-netbsd)
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-solaris)
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-qnx)
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-netware)
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-openbsd)
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-wdosx)
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-emx)
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-watcom)
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-netwlibc)
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-wince)
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),m68k-linux)
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),m68k-freebsd)
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),m68k-netbsd)
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),m68k-amiga)
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),m68k-atari)
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),m68k-openbsd)
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),m68k-palmos)
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),powerpc-linux)
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),powerpc-netbsd)
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),powerpc-macos)
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),powerpc-darwin)
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),powerpc-morphos)
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),sparc-linux)
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),sparc-netbsd)
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),sparc-solaris)
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),x86_64-linux)
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),x86_64-freebsd)
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),x86_64-win64)
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),arm-linux)
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),arm-wince)
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-linux)
|
||||
override TARGET_LOADERS+=wprt0 #wdllprt0
|
||||
@ -1902,11 +1902,34 @@ strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
|
||||
$(SYSTEMUNIT)$(PPUEXT)
|
||||
windows$(PPUEXT) : windows.pp $(WINDOWS_SOURCE_FILES) $(SYSTEMUNIT)$(PPUEXT)
|
||||
$(COMPILER) -I$(WININC) windows.pp
|
||||
messages$(PPUEXT): messages.pp $(WININC)/messages.inc $(SYSTEMUNIT)$(PPUEXT)
|
||||
$(COMPILER) -I$(WININC) messages.pp
|
||||
dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) windows$(PPUEXT)
|
||||
objects$(PPUEXT) : $(INC)/objects.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
|
||||
objpas$(PPUEXT) dos$(PPUEXT) windows$(PPUEXT) sysconst$(PPUEXT)
|
||||
$(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp
|
||||
classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
|
||||
sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT) sysconst$(PPUEXT)
|
||||
$(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp
|
||||
typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
|
||||
$(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp
|
||||
math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
|
||||
$(COMPILER) $(OBJPASDIR)/math.pp
|
||||
types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
|
||||
$(COMPILER) $(OBJPASDIR)/types.pp
|
||||
rtlconsts$(PPUEXT) : objpas$(PPUEXT) $(OBJPASDIR)/rtlconsts.pp
|
||||
$(COMPILER) $(OBJPASDIR)/rtlconsts.pp
|
||||
sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
|
||||
$(COMPILER) $(OBJPASDIR)/sysconst.pp
|
||||
dateutils$(PPUEXT) : $(OBJPASDIR)/dateutils.pp
|
||||
$(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/dateutils.pp
|
||||
convutils$(PPUEXT) : $(OBJPASDIR)/convutils.pp
|
||||
$(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/convutils.pp
|
||||
strutils$(PPUEXT) : $(OBJPASDIR)/strutils.pp
|
||||
$(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/strutils.pp
|
||||
macpas$(PPUEXT) : $(INC)/macpas.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
$(COMPILER) $(INC)/macpas.pp $(REDIR)
|
||||
cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
|
||||
getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
@ -1916,3 +1939,4 @@ lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
cmem$(PPUEXT) : $(INC)/cmem.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
|
||||
ctypes$(PPUEXT) : $(INC)/ctypes.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
|
||||
@ -7,19 +7,20 @@ main=rtl
|
||||
|
||||
[target]
|
||||
loaders= wprt0 #wdllprt0
|
||||
units=$(SYSTEMUNIT) objpas strings \
|
||||
# ctypes macpas
|
||||
units=$(SYSTEMUNIT) ctypes objpas macpas strings \
|
||||
lineinfo \
|
||||
# heaptrc matrix \
|
||||
windows \
|
||||
windows messages \
|
||||
# winsock initc cmem dynlibs signals \
|
||||
dos \
|
||||
# crt objects graph messages \
|
||||
rtlconsts sysconst \
|
||||
# sysutils \
|
||||
# math types \
|
||||
# strutils convutils dateutils varutils variants typinfo classes \
|
||||
# cpu mmx charset ucomplex getopts \
|
||||
dos objects \
|
||||
# crt graph \
|
||||
rtlconsts sysconst sysutils \
|
||||
typinfo types classes \
|
||||
# math dateutils
|
||||
strutils convutils \
|
||||
# varutils variants \
|
||||
charset getopts
|
||||
# cpu mmx ucomplex \
|
||||
# wincrt winmouse winevent sockets printer \
|
||||
# video mouse keyboard \
|
||||
# winsysut
|
||||
@ -118,8 +119,8 @@ strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
|
||||
windows$(PPUEXT) : windows.pp $(WINDOWS_SOURCE_FILES) $(SYSTEMUNIT)$(PPUEXT)
|
||||
$(COMPILER) -I$(WININC) windows.pp
|
||||
|
||||
#messages$(PPUEXT): messages.pp $(WININC)/messages.inc $(SYSTEMUNIT)$(PPUEXT)
|
||||
# $(COMPILER) -I$(WININC) messages.pp
|
||||
messages$(PPUEXT): messages.pp $(WININC)/messages.inc $(SYSTEMUNIT)$(PPUEXT)
|
||||
$(COMPILER) -I$(WININC) messages.pp
|
||||
|
||||
#opengl32$(PPUEXT) : opengl32.pp windows$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
|
||||
|
||||
@ -144,7 +145,7 @@ dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) $(S
|
||||
|
||||
#crt$(PPUEXT) : crt.pp $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT) dos$(PPUEXT) windows$(PPUEXT)
|
||||
|
||||
#objects$(PPUEXT) : $(INC)/objects.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
objects$(PPUEXT) : $(INC)/objects.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
|
||||
#
|
||||
# Graph
|
||||
@ -162,22 +163,22 @@ dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) $(S
|
||||
# Delphi Compatible Units
|
||||
#
|
||||
|
||||
#sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
|
||||
# objpas$(PPUEXT) dos$(PPUEXT) windows$(PPUEXT) sysconst$(PPUEXT)
|
||||
# $(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp
|
||||
sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
|
||||
objpas$(PPUEXT) dos$(PPUEXT) windows$(PPUEXT) sysconst$(PPUEXT)
|
||||
$(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp
|
||||
|
||||
#classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
|
||||
# sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT) sysconst$(PPUEXT)
|
||||
# $(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp
|
||||
classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
|
||||
sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT) sysconst$(PPUEXT)
|
||||
$(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp
|
||||
|
||||
#winsysut$(PPUEXT) : winsysut.pp sysutils$(PPUEXT)
|
||||
# $(COMPILER) winsysut.pp
|
||||
|
||||
#typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
|
||||
# $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp
|
||||
typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
|
||||
$(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp
|
||||
|
||||
#math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
|
||||
# $(COMPILER) $(OBJPASDIR)/math.pp
|
||||
math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
|
||||
$(COMPILER) $(OBJPASDIR)/math.pp
|
||||
|
||||
#varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
|
||||
# $(OBJPASDIR)/varutilh.inc varutils.pp sysutils$(PPUEXT)
|
||||
@ -186,8 +187,8 @@ dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) $(S
|
||||
#variants$(PPUEXT) : $(INC)/variants.pp varutils$(PPUEXT) sysutils$(PPUEXT) sysconst$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT)
|
||||
# $(COMPILER) -Fi$(INC) $(INC)/variants.pp
|
||||
|
||||
#types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
|
||||
# $(COMPILER) $(OBJPASDIR)/types.pp
|
||||
types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
|
||||
$(COMPILER) $(OBJPASDIR)/types.pp
|
||||
|
||||
rtlconsts$(PPUEXT) : objpas$(PPUEXT) $(OBJPASDIR)/rtlconsts.pp
|
||||
$(COMPILER) $(OBJPASDIR)/rtlconsts.pp
|
||||
@ -195,21 +196,21 @@ rtlconsts$(PPUEXT) : objpas$(PPUEXT) $(OBJPASDIR)/rtlconsts.pp
|
||||
sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
|
||||
$(COMPILER) $(OBJPASDIR)/sysconst.pp
|
||||
|
||||
#dateutils$(PPUEXT) : $(OBJPASDIR)/dateutils.pp
|
||||
# $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/dateutils.pp
|
||||
dateutils$(PPUEXT) : $(OBJPASDIR)/dateutils.pp
|
||||
$(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/dateutils.pp
|
||||
|
||||
#convutils$(PPUEXT) : $(OBJPASDIR)/convutils.pp
|
||||
# $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/convutils.pp
|
||||
convutils$(PPUEXT) : $(OBJPASDIR)/convutils.pp
|
||||
$(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/convutils.pp
|
||||
|
||||
#strutils$(PPUEXT) : $(OBJPASDIR)/strutils.pp
|
||||
# $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/strutils.pp
|
||||
strutils$(PPUEXT) : $(OBJPASDIR)/strutils.pp
|
||||
$(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/strutils.pp
|
||||
|
||||
#
|
||||
# Mac Pascal Model
|
||||
#
|
||||
|
||||
#macpas$(PPUEXT) : $(INC)/macpas.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
# $(COMPILER) $(INC)/macpas.pp $(REDIR)
|
||||
macpas$(PPUEXT) : $(INC)/macpas.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
$(COMPILER) $(INC)/macpas.pp $(REDIR)
|
||||
|
||||
#
|
||||
# Other system-independent RTL Units
|
||||
@ -238,6 +239,6 @@ ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
|
||||
|
||||
#callspec$(PPUEXT) : $(INC)/callspec.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
|
||||
#ctypes$(PPUEXT) : $(INC)/ctypes.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
ctypes$(PPUEXT) : $(INC)/ctypes.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
|
||||
#variants$(PPUEXT) : $(INC)/variants.pp varutils$(PPUEXT) typinfo$(PPUEXT)
|
||||
|
||||
47
rtl/wince/classes.pp
Normal file
47
rtl/wince/classes.pp
Normal file
@ -0,0 +1,47 @@
|
||||
{
|
||||
This file is part of the Free Component Library (FCL)
|
||||
Copyright (c) 1998 by Michael Van Canneyt and Florian Klaempfl
|
||||
|
||||
Classes unit for wince
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
{$mode objfpc}
|
||||
|
||||
{ determine the type of the resource/form file }
|
||||
{$define Win16Res}
|
||||
|
||||
unit Classes;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
rtlconsts,
|
||||
sysutils,
|
||||
types,
|
||||
typinfo,
|
||||
windows;
|
||||
|
||||
{$i classesh.inc}
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
sysconst;
|
||||
|
||||
{ OS - independent class implementations are in /inc directory. }
|
||||
{$i classes.inc}
|
||||
|
||||
initialization
|
||||
CommonInit;
|
||||
|
||||
finalization
|
||||
CommonCleanup;
|
||||
end.
|
||||
@ -33,15 +33,6 @@ Type
|
||||
|
||||
{$i dosh.inc}
|
||||
|
||||
//Const
|
||||
{ allow EXEC to inherited handles from calling process,
|
||||
needed for FPREDIR in ide/text
|
||||
now set to true by default because
|
||||
other OS also pass open handles to childs
|
||||
finally reset to false after Florian's response PM }
|
||||
// ExecInheritsHandles : Longbool = false;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
{$DEFINE HAS_GETMSCOUNT}
|
||||
@ -208,14 +199,19 @@ var
|
||||
i, len: LongInt;
|
||||
begin
|
||||
GetDriveName:=nil;
|
||||
// Current drive is C: drive always
|
||||
if drive = 0 then
|
||||
drive:=2;
|
||||
if (drive < 3) or (drive > 26) then
|
||||
exit;
|
||||
if DriveNames[1] = nil then
|
||||
begin
|
||||
// Drive C: is filesystem root always
|
||||
GetMem(DriveNames[1], 2*SizeOf(WideChar));
|
||||
DriveNames[1][0]:='\';
|
||||
DriveNames[1][1]:=#0;
|
||||
|
||||
// Other drives are found dinamically
|
||||
h:=FindFirstFile('\*', @fd);
|
||||
if h <> 0 then
|
||||
begin
|
||||
@ -322,7 +318,7 @@ begin
|
||||
F.ExcludeAttr:=(not Attr) and ($1e); {hidden,sys,dir,volume}
|
||||
StringToPchar(f.name);
|
||||
|
||||
{ FindFirstFile is a Win32 Call }
|
||||
{ FindFirstFile is a WinCE Call }
|
||||
F.W32FindData.dwFileAttributes:=DosToWinAttr(f.attr);
|
||||
AnsiToWideBuf(@f.Name, -1, buf, SizeOf(buf));
|
||||
F.FindHandle:=FindFirstFile (buf, F.W32FindData);
|
||||
@ -498,81 +494,6 @@ begin
|
||||
GetEnv:=''; //!!! fixme
|
||||
end;
|
||||
|
||||
{
|
||||
The environment is a block of zero terminated strings
|
||||
terminated by a #0
|
||||
}
|
||||
(*
|
||||
function envcount : longint;
|
||||
var
|
||||
hp,p : pchar;
|
||||
count : longint;
|
||||
begin
|
||||
p:=GetEnvironmentStrings;
|
||||
hp:=p;
|
||||
count:=0;
|
||||
while hp^<>#0 do
|
||||
begin
|
||||
{ next string entry}
|
||||
hp:=hp+strlen(hp)+1;
|
||||
inc(count);
|
||||
end;
|
||||
FreeEnvironmentStrings(p);
|
||||
envcount:=count;
|
||||
end;
|
||||
|
||||
|
||||
Function EnvStr (Index: longint): string;
|
||||
var
|
||||
hp,p : pchar;
|
||||
count,i : longint;
|
||||
begin
|
||||
{ envcount takes some time in win32 }
|
||||
count:=envcount;
|
||||
|
||||
{ range checking }
|
||||
if (index<=0) or (index>count) then
|
||||
begin
|
||||
envstr:='';
|
||||
exit;
|
||||
end;
|
||||
p:=GetEnvironmentStrings;
|
||||
hp:=p;
|
||||
|
||||
{ retrive the string with the given index }
|
||||
for i:=2 to index do
|
||||
hp:=hp+strlen(hp)+1;
|
||||
|
||||
envstr:=strpas(hp);
|
||||
FreeEnvironmentStrings(p);
|
||||
end;
|
||||
|
||||
|
||||
Function GetEnv(envvar: string): string;
|
||||
var
|
||||
s : string;
|
||||
i : longint;
|
||||
hp,p : pchar;
|
||||
begin
|
||||
getenv:='';
|
||||
p:=GetEnvironmentStrings;
|
||||
hp:=p;
|
||||
while hp^<>#0 do
|
||||
begin
|
||||
s:=strpas(hp);
|
||||
i:=pos('=',s);
|
||||
if upcase(copy(s,1,i-1))=upcase(envvar) then
|
||||
begin
|
||||
getenv:=copy(s,i+1,length(s)-i);
|
||||
break;
|
||||
end;
|
||||
{ next string entry}
|
||||
hp:=hp+strlen(hp)+1;
|
||||
end;
|
||||
FreeEnvironmentStrings(p);
|
||||
end;
|
||||
*)
|
||||
|
||||
var
|
||||
oldexitproc : pointer;
|
||||
|
||||
|
||||
15
rtl/wince/messages.pp
Normal file
15
rtl/wince/messages.pp
Normal file
@ -0,0 +1,15 @@
|
||||
unit messages;
|
||||
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
windows;
|
||||
|
||||
{$DEFINE read_interface}
|
||||
{$DEFINE MESSAGESUNIT}
|
||||
{$I messages.inc}
|
||||
|
||||
implementation
|
||||
|
||||
end.
|
||||
@ -56,12 +56,11 @@ var
|
||||
{ C compatible arguments }
|
||||
argc : longint;
|
||||
argv : ppchar;
|
||||
{ Win32 Info }
|
||||
{ WinCE Info }
|
||||
hprevinst,
|
||||
HInstance,
|
||||
MainInstance,
|
||||
DLLreason,DLLparam:longint;
|
||||
Win32StackTop : Dword;
|
||||
WinCEStackTop : Dword;
|
||||
|
||||
type
|
||||
TDLL_Process_Entry_Hook = function (dllparam : longint) : longbool;
|
||||
@ -73,9 +72,6 @@ const
|
||||
Dll_Thread_Attach_Hook : TDLL_Entry_Hook = nil;
|
||||
Dll_Thread_Detach_Hook : TDLL_Entry_Hook = nil;
|
||||
|
||||
type
|
||||
HMODULE = THandle;
|
||||
|
||||
{ ANSI <-> Wide }
|
||||
function AnsiToWideBuf(AnsiBuf: PChar; AnsiBufLen: longint; WideBuf: PWideChar; WideBufLen: longint): longint;
|
||||
function WideToAnsiBuf(WideBuf: PWideChar; WideBufLen: longint; AnsiBuf: PChar; AnsiBufLen: longint): longint;
|
||||
@ -157,6 +153,9 @@ function i64tod(i : int64) : double; compilerproc;
|
||||
|
||||
implementation
|
||||
|
||||
var
|
||||
SysInstance : Longint;
|
||||
|
||||
function MessageBox(w1:longint;l1,l2:PWideChar;w2:longint):longint;
|
||||
stdcall;external 'coredll' name 'MessageBoxW';
|
||||
|
||||
@ -182,7 +181,7 @@ function WideCharToMultiByte(CodePage:UINT; dwFlags:DWORD; lpWideCharStr:PWideCh
|
||||
|
||||
function AnsiToWideBuf(AnsiBuf: PChar; AnsiBufLen: longint; WideBuf: PWideChar; WideBufLen: longint): longint;
|
||||
begin
|
||||
Result := MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, AnsiBuf, AnsiBufLen, WideBuf, WideBufLen);
|
||||
Result := MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, AnsiBuf, AnsiBufLen, WideBuf, WideBufLen div SizeOf(WideChar));
|
||||
if ((AnsiBufLen <> -1) or (Result = 0)) and (WideBuf <> nil) then
|
||||
begin
|
||||
if (Result + 1)*SizeOf(WideChar) > WideBufLen then
|
||||
@ -192,7 +191,10 @@ begin
|
||||
exit;
|
||||
end;
|
||||
WideBuf[Result] := #0;
|
||||
if (Result <> 0) or (AnsiBufLen = 0) then
|
||||
Inc(Result);
|
||||
end;
|
||||
Result:=Result*SizeOf(WideChar);
|
||||
end;
|
||||
|
||||
function WideToAnsiBuf(WideBuf: PWideChar; WideBufLen: longint; AnsiBuf: PChar; AnsiBufLen: longint): longint;
|
||||
@ -207,6 +209,8 @@ begin
|
||||
exit;
|
||||
end;
|
||||
AnsiBuf[Result] := #0;
|
||||
if (Result <> 0) or (WideBufLen = 0) then
|
||||
Inc(Result);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -405,7 +409,7 @@ var
|
||||
|
||||
begin
|
||||
{ create commandline, it starts with the executed filename which is argv[0] }
|
||||
{ Win32 passes the command NOT via the args, but via getmodulefilename}
|
||||
{ WinCE passes the command NOT via the args, but via getmodulefilename}
|
||||
argv:=nil;
|
||||
argvlen:=0;
|
||||
pc:=getcommandfile;
|
||||
@ -427,7 +431,7 @@ begin
|
||||
count:=0;
|
||||
pc:=cmdline;
|
||||
{$IfDef SYSTEM_DEBUG_STARTUP}
|
||||
Writeln(stderr,'Win32 GetCommandLine is #',pc,'#');
|
||||
Writeln(stderr,'WinCE GetCommandLine is #',pc,'#');
|
||||
{$EndIf }
|
||||
while pc^<>#0 do
|
||||
begin
|
||||
@ -701,7 +705,7 @@ end;
|
||||
//
|
||||
|
||||
{
|
||||
Error code definitions for the Win32 API functions
|
||||
Error code definitions for the WinCE API functions
|
||||
|
||||
|
||||
Values are 32 bit values layed out as follows:
|
||||
@ -1198,7 +1202,8 @@ begin
|
||||
res := 215;
|
||||
STATUS_ILLEGAL_INSTRUCTION:
|
||||
res := 216;
|
||||
STATUS_ACCESS_VIOLATION:
|
||||
STATUS_ACCESS_VIOLATION,
|
||||
STATUS_DATATYPE_MISALIGNMENT:
|
||||
res := 216;
|
||||
STATUS_CONTROL_C_EXIT:
|
||||
res := 217;
|
||||
@ -1258,7 +1263,7 @@ begin
|
||||
pushl %ebp
|
||||
xorl %ebp,%ebp
|
||||
movl %esp,%eax
|
||||
movl %eax,Win32StackTop
|
||||
movl %eax,WinCEStackTop
|
||||
movw %ss,%bp
|
||||
movl %ebp,_SS
|
||||
call SysResetFPU
|
||||
@ -1283,7 +1288,45 @@ function CharUpperBuff(lpsz:LPWSTR; cchLength:DWORD):DWORD; stdcall; external Ke
|
||||
function CharLowerBuff(lpsz:LPWSTR; cchLength:DWORD):DWORD; stdcall; external KernelDLL name 'CharLowerBuffW';
|
||||
|
||||
|
||||
function Win32WideUpper(const s : WideString) : WideString;
|
||||
procedure WinCEWide2AnsiMove(source:pwidechar;var dest:ansistring;len:SizeInt);
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
if len = 0 then
|
||||
dest:=''
|
||||
else
|
||||
begin
|
||||
for i:=1 to 2 do begin
|
||||
setlength(dest, len);
|
||||
len:=WideCharToMultiByte(CP_ACP, 0, source, len, @dest[1], len, nil, nil);
|
||||
if len > 0 then
|
||||
break;
|
||||
len:=WideCharToMultiByte(CP_ACP, 0, source, len, nil, 0, nil, nil);
|
||||
end;
|
||||
setlength(dest, len);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure WinCEAnsi2WideMove(source:pchar;var dest:widestring;len:SizeInt);
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
if len = 0 then
|
||||
dest:=''
|
||||
else
|
||||
begin
|
||||
for i:=1 to 2 do begin
|
||||
setlength(dest, len);
|
||||
len:=MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, source, len, @dest[1], len);
|
||||
if len > 0 then
|
||||
break;
|
||||
len:=MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, source, len, nil, 0);
|
||||
end;
|
||||
setlength(dest, len);
|
||||
end;
|
||||
end;
|
||||
|
||||
function WinCEWideUpper(const s : WideString) : WideString;
|
||||
begin
|
||||
result:=s;
|
||||
UniqueString(result);
|
||||
@ -1292,7 +1335,7 @@ function Win32WideUpper(const s : WideString) : WideString;
|
||||
end;
|
||||
|
||||
|
||||
function Win32WideLower(const s : WideString) : WideString;
|
||||
function WinCEWideLower(const s : WideString) : WideString;
|
||||
begin
|
||||
result:=s;
|
||||
UniqueString(result);
|
||||
@ -1303,10 +1346,12 @@ function Win32WideLower(const s : WideString) : WideString;
|
||||
|
||||
{ there is a similiar procedure in sysutils which inits the fields which
|
||||
are only relevant for the sysutils units }
|
||||
procedure InitWin32Widestrings;
|
||||
procedure InitWinCEWidestrings;
|
||||
begin
|
||||
widestringmanager.UpperWideStringProc:=@Win32WideUpper;
|
||||
widestringmanager.LowerWideStringProc:=@Win32WideLower;
|
||||
widestringmanager.Wide2AnsiMoveProc:=@WinCEWide2AnsiMove;
|
||||
widestringmanager.Ansi2WideMoveProc:=@WinCEAnsi2WideMove;
|
||||
widestringmanager.UpperWideStringProc:=@WinCEWideUpper;
|
||||
widestringmanager.LowerWideStringProc:=@WinCEWideLower;
|
||||
end;
|
||||
|
||||
|
||||
@ -1434,7 +1479,7 @@ var
|
||||
buf: array[0..MaxPathLen] of WideChar;
|
||||
begin
|
||||
GetModuleFileName(0, @buf, SizeOf(buf));
|
||||
HInstance:=GetModuleHandle(@buf);
|
||||
SysInstance:=GetModuleHandle(@buf);
|
||||
end;
|
||||
|
||||
const
|
||||
@ -1464,5 +1509,5 @@ begin
|
||||
errno:=0;
|
||||
initvariantmanager;
|
||||
initwidestringmanager;
|
||||
InitWin32Widestrings
|
||||
InitWinCEWidestrings
|
||||
end.
|
||||
|
||||
1039
rtl/wince/sysutils.pp
Normal file
1039
rtl/wince/sysutils.pp
Normal file
File diff suppressed because it is too large
Load Diff
213
rtl/wince/tthread.inc
Normal file
213
rtl/wince/tthread.inc
Normal file
@ -0,0 +1,213 @@
|
||||
{ Thread management routines }
|
||||
|
||||
const
|
||||
CM_EXECPROC = $8FFF;
|
||||
CM_DESTROYWINDOW = $8FFE;
|
||||
|
||||
type
|
||||
PRaiseFrame = ^TRaiseFrame;
|
||||
TRaiseFrame = record
|
||||
NextRaise: PRaiseFrame;
|
||||
ExceptAddr: Pointer;
|
||||
ExceptObject: TObject;
|
||||
ExceptionRecord: pointer; {PExceptionRecord}
|
||||
end;
|
||||
|
||||
var
|
||||
ThreadWindow: HWND;
|
||||
ThreadCount: Integer;
|
||||
{ event that happens when gui thread is done executing the method
|
||||
}
|
||||
|
||||
function ThreadWndProc(Window: HWnd; AMessage:UInt; WParam : WParam; LParam: LParam): Longint; stdcall;
|
||||
|
||||
begin
|
||||
case AMessage of
|
||||
CM_EXECPROC:
|
||||
with TThread(lParam) do
|
||||
begin
|
||||
Result := 0;
|
||||
try
|
||||
FSynchronizeException := nil;
|
||||
FMethod;
|
||||
except
|
||||
{ if RaiseList <> nil then
|
||||
begin
|
||||
FSynchronizeException := PRaiseFrame(RaiseList)^.ExceptObject;
|
||||
PRaiseFrame(RaiseList)^.ExceptObject := nil;
|
||||
end; }
|
||||
end;
|
||||
end;
|
||||
CM_DESTROYWINDOW:
|
||||
begin
|
||||
DestroyWindow(Window);
|
||||
Result := 0;
|
||||
end;
|
||||
else
|
||||
Result := DefWindowProc(Window, AMessage, wParam, lParam);
|
||||
end;
|
||||
end;
|
||||
|
||||
const
|
||||
ThreadWindowClass: TWndClass = (
|
||||
style: 0;
|
||||
lpfnWndProc: nil;
|
||||
cbClsExtra: 0;
|
||||
cbWndExtra: 0;
|
||||
hInstance: 0;
|
||||
hIcon: 0;
|
||||
hCursor: 0;
|
||||
hbrBackground: 0;
|
||||
lpszMenuName: nil;
|
||||
lpszClassName: 'TThreadWindow');
|
||||
|
||||
procedure AddThread;
|
||||
|
||||
function AllocateWindow: HWND;
|
||||
var
|
||||
TempClass: TWndClass;
|
||||
ClassRegistered: Boolean;
|
||||
begin
|
||||
ThreadWindowClass.hInstance := HInstance;
|
||||
ThreadWindowClass.lpfnWndProc:=WndProc(@ThreadWndProc);
|
||||
ClassRegistered := GetClassInfo(HInstance, ThreadWindowClass.lpszClassName,
|
||||
@TempClass);
|
||||
if not ClassRegistered or (TempClass.lpfnWndProc <> WndProc(@ThreadWndProc)) then
|
||||
begin
|
||||
if ClassRegistered then
|
||||
Windows.UnregisterClass(ThreadWindowClass.lpszClassName, HInstance);
|
||||
Windows.RegisterClass(ThreadWindowClass);
|
||||
end;
|
||||
Result := CreateWindow(ThreadWindowClass.lpszClassName, '', 0,
|
||||
0, 0, 0, 0, 0, 0, HInstance, nil);
|
||||
end;
|
||||
|
||||
begin
|
||||
if ThreadCount = 0 then
|
||||
ThreadWindow := AllocateWindow;
|
||||
Inc(ThreadCount);
|
||||
end;
|
||||
|
||||
procedure RemoveThread;
|
||||
begin
|
||||
Dec(ThreadCount);
|
||||
if ThreadCount = 0 then
|
||||
PostMessage(ThreadWindow, CM_DESTROYWINDOW, 0, 0);
|
||||
end;
|
||||
|
||||
{ TThread }
|
||||
|
||||
function ThreadProc(ThreadObjPtr: Pointer): Integer;
|
||||
var
|
||||
FreeThread: Boolean;
|
||||
Thread: TThread absolute ThreadObjPtr;
|
||||
begin
|
||||
try
|
||||
Thread.Execute;
|
||||
except
|
||||
Thread.FFatalException := TObject(AcquireExceptionObject);
|
||||
end;
|
||||
FreeThread := Thread.FFreeOnTerminate;
|
||||
Result := Thread.FReturnValue;
|
||||
Thread.FFinished := True;
|
||||
Thread.DoTerminate;
|
||||
if FreeThread then Thread.Free;
|
||||
end;
|
||||
|
||||
constructor TThread.Create(CreateSuspended: Boolean);
|
||||
var
|
||||
Flags: Integer;
|
||||
begin
|
||||
inherited Create;
|
||||
AddThread;
|
||||
FSuspended := CreateSuspended;
|
||||
Flags := 0;
|
||||
if CreateSuspended then Flags := CREATE_SUSPENDED;
|
||||
FHandle := BeginThread(nil, 0, @ThreadProc, pointer(self), Flags, FThreadID);
|
||||
FFatalException := nil;
|
||||
end;
|
||||
|
||||
|
||||
destructor TThread.Destroy;
|
||||
begin
|
||||
if not FFinished and not Suspended then
|
||||
begin
|
||||
Terminate;
|
||||
WaitFor;
|
||||
end;
|
||||
if FHandle <> 0 then CloseHandle(FHandle);
|
||||
FFatalException.Free;
|
||||
FFatalException := nil;
|
||||
inherited Destroy;
|
||||
RemoveThread;
|
||||
end;
|
||||
|
||||
procedure TThread.CallOnTerminate;
|
||||
begin
|
||||
FOnTerminate(Self);
|
||||
end;
|
||||
|
||||
procedure TThread.DoTerminate;
|
||||
begin
|
||||
if Assigned(FOnTerminate) then
|
||||
Synchronize(@CallOnTerminate);
|
||||
end;
|
||||
|
||||
const
|
||||
Priorities: array [TThreadPriority] of Integer =
|
||||
(THREAD_PRIORITY_IDLE, THREAD_PRIORITY_LOWEST, THREAD_PRIORITY_BELOW_NORMAL,
|
||||
THREAD_PRIORITY_NORMAL, THREAD_PRIORITY_ABOVE_NORMAL,
|
||||
THREAD_PRIORITY_HIGHEST, THREAD_PRIORITY_TIME_CRITICAL);
|
||||
|
||||
function TThread.GetPriority: TThreadPriority;
|
||||
var
|
||||
P: Integer;
|
||||
I: TThreadPriority;
|
||||
begin
|
||||
P := GetThreadPriority(FHandle);
|
||||
Result := tpNormal;
|
||||
for I := Low(TThreadPriority) to High(TThreadPriority) do
|
||||
if Priorities[I] = P then Result := I;
|
||||
end;
|
||||
|
||||
procedure TThread.SetPriority(Value: TThreadPriority);
|
||||
begin
|
||||
SetThreadPriority(FHandle, Priorities[Value]);
|
||||
end;
|
||||
|
||||
|
||||
procedure TThread.SetSuspended(Value: Boolean);
|
||||
begin
|
||||
if Value <> FSuspended then
|
||||
if Value then
|
||||
Suspend else
|
||||
Resume;
|
||||
end;
|
||||
|
||||
procedure TThread.Suspend;
|
||||
begin
|
||||
FSuspended := True;
|
||||
SuspendThread(FHandle);
|
||||
end;
|
||||
|
||||
procedure TThread.Resume;
|
||||
begin
|
||||
if ResumeThread(FHandle) = 1 then FSuspended := False;
|
||||
end;
|
||||
|
||||
procedure TThread.Terminate;
|
||||
begin
|
||||
FTerminated := True;
|
||||
end;
|
||||
|
||||
function TThread.WaitFor: Integer;
|
||||
var
|
||||
Msg: TMsg;
|
||||
begin
|
||||
if GetCurrentThreadID = MainThreadID then
|
||||
while MsgWaitForMultipleObjects(1, FHandle, False, INFINITE, QS_SENDMESSAGE) = WAIT_OBJECT_0 + 1 do
|
||||
PeekMessage(Msg, 0, 0, 0, PM_NOREMOVE)
|
||||
else
|
||||
WaitForSingleObject(ulong(FHandle), INFINITE);
|
||||
GetExitCodeThread(FHandle, DWord(Result));
|
||||
end;
|
||||
@ -694,6 +694,29 @@ function SetEvent(hEvent:HANDLE):WINBOOL;
|
||||
//win32 version redirected
|
||||
function WindowFromPoint(Point:POINT):HWND; external UserDLLCore name 'WindowFromPoint';
|
||||
|
||||
// SHGetSpecialFolderPath consts
|
||||
const
|
||||
CSIDL_PROGRAMS = $0002;
|
||||
CSIDL_CONTROLS = $0003;
|
||||
CSIDL_PRINTERS = $0004;
|
||||
CSIDL_PERSONAL = $0005;
|
||||
CSIDL_FAVORITES = $0006;
|
||||
CSIDL_STARTUP = $0007;
|
||||
CSIDL_RECENT = $0008;
|
||||
CSIDL_SENDTO = $0009;
|
||||
CSIDL_BITBUCKET = $000a;
|
||||
CSIDL_STARTMENU = $000b;
|
||||
CSIDL_DESKTOPDIRECTORY = $0010;
|
||||
CSIDL_DRIVES = $0011;
|
||||
CSIDL_NETWORK = $0012;
|
||||
CSIDL_NETHOOD = $0013;
|
||||
CSIDL_FONTS = $0014;
|
||||
CSIDL_TEMPLATES = $0015;
|
||||
CSIDL_APPDATA = $001a;
|
||||
|
||||
function SHGetSpecialFolderPath(hwndOwner: HWND; lpszPath: LPTSTR; nFolder: LongInt; fCreate: BOOL): BOOL;
|
||||
external 'coredll' name 'SHGetSpecialFolderPath';
|
||||
|
||||
//end wince only
|
||||
{$endif WINCE}
|
||||
|
||||
|
||||
@ -22,12 +22,87 @@
|
||||
{$ifdef read_interface}
|
||||
|
||||
//begin common win32 & wince
|
||||
|
||||
//
|
||||
// A language ID is a 16 bit value which is the combination of a
|
||||
// primary language ID and a secondary language ID. The bits are
|
||||
// allocated as follows:
|
||||
//
|
||||
// +-----------------------+-------------------------+
|
||||
// | Sublanguage ID | Primary Language ID |
|
||||
// +-----------------------+-------------------------+
|
||||
// 15 10 9 0 bit
|
||||
//
|
||||
//
|
||||
// Language ID creation/extraction macros:
|
||||
//
|
||||
// MAKELANGID - construct language id from a primary language id and
|
||||
// a sublanguage id.
|
||||
// PRIMARYLANGID - extract primary language id from a language id.
|
||||
// SUBLANGID - extract sublanguage id from a language id.
|
||||
//
|
||||
|
||||
function MAKELANGID(PrimaryLang, SubLang: USHORT): WORD;
|
||||
function PRIMARYLANGID(LangId: WORD): WORD;
|
||||
function SUBLANGID(LangId: WORD): WORD;
|
||||
|
||||
//
|
||||
// A locale ID is a 32 bit value which is the combination of a
|
||||
// language ID, a sort ID, and a reserved area. The bits are
|
||||
// allocated as follows:
|
||||
//
|
||||
// +-------------+---------+-------------------------+
|
||||
// | Reserved | Sort ID | Language ID |
|
||||
// +-------------+---------+-------------------------+
|
||||
// 31 20 19 16 15 0 bit
|
||||
//
|
||||
//
|
||||
// Locale ID creation/extraction macros:
|
||||
//
|
||||
// MAKELCID - construct the locale id from a language id and a sort id.
|
||||
// MAKESORTLCID - construct the locale id from a language id, sort id, and sort version.
|
||||
// LANGIDFROMLCID - extract the language id from a locale id.
|
||||
// SORTIDFROMLCID - extract the sort id from a locale id.
|
||||
// SORTVERSIONFROMLCID - extract the sort version from a locale id.
|
||||
//
|
||||
|
||||
const
|
||||
NLS_VALID_LOCALE_MASK = $000fffff; //winnt
|
||||
|
||||
function MAKELCID(LangId, SortId: WORD): DWORD; //winnt
|
||||
function MAKESORTLCID(LangId, SortId, SortVersion: WORD): DWORD; //winnt
|
||||
function LANGIDFROMLCID(LocaleId: LCID): WORD; //winnt
|
||||
function SORTIDFROMLCID(LocaleId: LCID): WORD; //winnt
|
||||
function SORTVERSIONFROMLCID(LocaleId: LCID): WORD; //winnt
|
||||
|
||||
//
|
||||
// Default System and User IDs for language and locale.
|
||||
//
|
||||
|
||||
function LANG_SYSTEM_DEFAULT: WORD; //winnt
|
||||
function LANG_USER_DEFAULT: WORD; //winnt
|
||||
function LOCALE_SYSTEM_DEFAULT: DWORD; //+winnt
|
||||
function LOCALE_USER_DEFAULT: DWORD; //+winnt
|
||||
function LOCALE_NEUTRAL: DWORD; //winnt
|
||||
function LOCALE_INVARIANT: DWORD; //winnt
|
||||
|
||||
|
||||
function GetVersionExW(var lpVersionInformation: TOSVersionInfoW): BOOL; external KernelDLL name 'GetVersionExW';
|
||||
procedure GetLocalTime(var SystemTime: SYSTEMTIME); external KernelDLL name 'GetLocalTime';
|
||||
function SetLocalTime(var lpSystemTime:SYSTEMTIME):WINBOOL; external KernelDLL name 'SetLocalTime';
|
||||
function CreateProcessW(lpApplicationName: LPWSTR; lpCommandLine: LPWSTR; lpProcessAttributes, lpThreadAttributes: PSecurityAttributes; bInheritHandles: BOOL; dwCreationFlags: DWORD; lpEnvironment: Pointer; lpCurrentDirectory: LPWSTR;
|
||||
const lpStartupInfo: TStartupInfo; var lpProcessInformation: TProcessInformation): BOOL; external KernelDLL name 'CreateProcessW';
|
||||
function GetExitCodeProcess(hProcess: THandle; var lpExitCode: DWORD): BOOL; external KernelDLL name 'GetExitCodeProcess';
|
||||
function ReadFile(hFile: THandle; var Buffer; nNumberOfBytesToRead: DWORD; var lpNumberOfBytesRead: DWORD; lpOverlapped: POverlapped): BOOL; external KernelDLL name 'ReadFile';
|
||||
function WriteFile(hFile: THandle; const Buffer; nNumberOfBytesToWrite: DWORD; var lpNumberOfBytesWritten: DWORD; lpOverlapped: POverlapped): BOOL; external KernelDLL name 'WriteFile';
|
||||
function SetFileTime(hFile:HANDLE; var lpCreationTime:FILETIME; var lpLastAccessTime:FILETIME; var lpLastWriteTime:FILETIME):WINBOOL; external KernelDLL name 'SetFileTime';
|
||||
procedure EnterCriticalSection(var CriticalSection : TRTLCriticalSection); external KernelDLL name 'EnterCriticalSection';
|
||||
procedure LeaveCriticalSection(var CriticalSection : TRTLCriticalSection); external KernelDLL name 'LeaveCriticalSection';
|
||||
function RegisterClassW(const lpWndClass: TWndClassW): ATOM; external UserDLLCore name 'RegisterClassW';
|
||||
//redirected to MsgWaitForMultipleObjectsEx
|
||||
function MsgWaitForMultipleObjects(nCount: DWORD; var pHandles; fWaitAll: BOOL; dwMilliseconds, dwWakeMask: DWORD): DWORD;
|
||||
function PeekMessageW(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): BOOL; external UserDLLCore name 'PeekMessageW';
|
||||
function GetExitCodeThread(hThread: THandle; var lpExitCode: DWORD): BOOL; external KernelDLL name 'GetExitCodeThread';
|
||||
//end common win32 & wince
|
||||
|
||||
{$ifdef WINCE}
|
||||
@ -37,6 +112,8 @@ function CreateProcess(lpApplicationName: LPTSTR; lpCommandLine: LPTSTR; lpProce
|
||||
const lpStartupInfo: LPStartupInfo; var lpProcessInformation: TProcessInformation): BOOL;external KernelDLL name 'CreateProcessW';
|
||||
function FindFirstFile(lpFileName: LPTSTR; var lpFindFileData: TWIN32FindData): THandle; external KernelDLL name 'FindFirstFileW';
|
||||
function FindNextFile(hFindFile: THandle; var lpFindFileData: TWIN32FindData): BOOL; external KernelDLL name 'FindNextFileW';
|
||||
function RegisterClass(const lpWndClass: TWndClass): ATOM;external UserDLLCore name 'RegisterClassW';
|
||||
function PeekMessage(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): BOOL;external UserDLLCore name 'PeekMessageW';
|
||||
//end wince only
|
||||
{$endif WINCE}
|
||||
|
||||
@ -132,70 +209,6 @@ const
|
||||
FACILITY_NT_BIT = $10000000;
|
||||
HFILE_ERROR = HFILE(-1);
|
||||
|
||||
//
|
||||
// A language ID is a 16 bit value which is the combination of a
|
||||
// primary language ID and a secondary language ID. The bits are
|
||||
// allocated as follows:
|
||||
//
|
||||
// +-----------------------+-------------------------+
|
||||
// | Sublanguage ID | Primary Language ID |
|
||||
// +-----------------------+-------------------------+
|
||||
// 15 10 9 0 bit
|
||||
//
|
||||
//
|
||||
// Language ID creation/extraction macros:
|
||||
//
|
||||
// MAKELANGID - construct language id from a primary language id and
|
||||
// a sublanguage id.
|
||||
// PRIMARYLANGID - extract primary language id from a language id.
|
||||
// SUBLANGID - extract sublanguage id from a language id.
|
||||
//
|
||||
|
||||
function MAKELANGID(PrimaryLang, SubLang: USHORT): WORD;
|
||||
function PRIMARYLANGID(LangId: WORD): WORD;
|
||||
function SUBLANGID(LangId: WORD): WORD;
|
||||
|
||||
//
|
||||
// A locale ID is a 32 bit value which is the combination of a
|
||||
// language ID, a sort ID, and a reserved area. The bits are
|
||||
// allocated as follows:
|
||||
//
|
||||
// +-------------+---------+-------------------------+
|
||||
// | Reserved | Sort ID | Language ID |
|
||||
// +-------------+---------+-------------------------+
|
||||
// 31 20 19 16 15 0 bit
|
||||
//
|
||||
//
|
||||
// Locale ID creation/extraction macros:
|
||||
//
|
||||
// MAKELCID - construct the locale id from a language id and a sort id.
|
||||
// MAKESORTLCID - construct the locale id from a language id, sort id, and sort version.
|
||||
// LANGIDFROMLCID - extract the language id from a locale id.
|
||||
// SORTIDFROMLCID - extract the sort id from a locale id.
|
||||
// SORTVERSIONFROMLCID - extract the sort version from a locale id.
|
||||
//
|
||||
|
||||
const
|
||||
NLS_VALID_LOCALE_MASK = $000fffff; //winnt
|
||||
|
||||
function MAKELCID(LangId, SortId: WORD): DWORD; //winnt
|
||||
function MAKESORTLCID(LangId, SortId, SortVersion: WORD): DWORD; //winnt
|
||||
function LANGIDFROMLCID(LocaleId: LCID): WORD; //winnt
|
||||
function SORTIDFROMLCID(LocaleId: LCID): WORD; //winnt
|
||||
function SORTVERSIONFROMLCID(LocaleId: LCID): WORD; //winnt
|
||||
|
||||
//
|
||||
// Default System and User IDs for language and locale.
|
||||
//
|
||||
|
||||
function LANG_SYSTEM_DEFAULT: WORD; //winnt
|
||||
function LANG_USER_DEFAULT: WORD; //winnt
|
||||
function LOCALE_SYSTEM_DEFAULT: DWORD; //+winnt
|
||||
function LOCALE_USER_DEFAULT: DWORD; //+winnt
|
||||
function LOCALE_NEUTRAL: DWORD; //winnt
|
||||
function LOCALE_INVARIANT: DWORD; //winnt
|
||||
|
||||
|
||||
function Succeeded(Status : HRESULT) : BOOL;
|
||||
function Failed(Status : HRESULT) : BOOL;
|
||||
function IsError(Status : HRESULT) : BOOL;
|
||||
@ -207,8 +220,6 @@ function HResultFromWin32(x : Longint) : HRESULT;
|
||||
function HResultFromNT(x : Longint) : HRESULT;
|
||||
|
||||
procedure InitializeCriticalSection(var CriticalSection : TRTLCriticalSection); external 'kernel32' name 'InitializeCriticalSection';
|
||||
procedure EnterCriticalSection(var CriticalSection : TRTLCriticalSection); external 'kernel32' name 'EnterCriticalSection';
|
||||
procedure LeaveCriticalSection(var CriticalSection : TRTLCriticalSection); external 'kernel32' name 'LeaveCriticalSection';
|
||||
procedure DeleteCriticalSection(var CriticalSection : TRTLCriticalSection); external 'kernel32' name 'DeleteCriticalSection';
|
||||
function InitializeCriticalSectionAndSpinCount(var CriticalSection : TRTLCriticalSection;dwSpinCount : DWORD) : BOOL; external 'kernel32' name 'InitializeCriticalSectionAndSpinCount';
|
||||
function SetCriticalSectionSpinCount(var CriticalSection : TRTLCriticalSection;dwSpinCount : DWORD ): DWORD; external 'kernel32' name 'SetCriticalSectionSpinCount';
|
||||
@ -485,7 +496,6 @@ function GetDiskFreeSpaceEx(lpDirectoryName: PChar; lpFreeBytesAvailableToCalle
|
||||
function GetDiskFreeSpaceExA(lpDirectoryName: LPCSTR; lpFreeBytesAvailableToCaller, lpTotalNumberOfBytes: pLargeInteger; lpTotalNumberOfFreeBytes: PLargeInteger): BOOL;external 'kernel32' name 'GetDiskFreeSpaceExA';
|
||||
function GetDiskFreeSpaceExW(lpDirectoryName: LPWSTR; lpFreeBytesAvailableToCaller, lpTotalNumberOfBytes: pLargeInteger; lpTotalNumberOfFreeBytes: PLargeInteger): BOOL;external 'kernel32' name 'GetDiskFreeSpaceExW';
|
||||
//function GetEnhMetaFilePixelFormat(p1: HENHMETAFILE; p2: Cardinal; var p3: TPixelFormatDescriptor): UINT;external 'gdi32' name 'GetEnhMetaFilePixelFormat';
|
||||
function GetExitCodeThread(hThread: THandle; var lpExitCode: DWORD): BOOL; external 'kernel32' name 'GetExitCodeThread';
|
||||
function GetFileInformationByHandle(hFile: THandle; var lpFileInformation: TByHandleFileInformation): BOOL; external 'kernel32' name 'GetFileInformationByHandle';
|
||||
//function GetFileSecurity(lpFileName: PChar; RequestedInformation: SECURITY_INFORMATION; pSecurityDescriptor: PSecurityDescriptor; nLength: DWORD; var lpnLengthNeeded: DWORD): BOOL;external 'advapi32' name 'GetFileSecurityA';
|
||||
//function GetFileSecurityA(lpFileName: LPCSTR; RequestedInformation: SECURITY_INFORMATION; pSecurityDescriptor: PSecurityDescriptor; nLength: DWORD; var lpnLengthNeeded: DWORD): BOOL; external 'advapi32' name 'GetFileSecurityA';
|
||||
@ -674,7 +684,6 @@ function MessageBoxIndirect(const MsgBoxParams: TMsgBoxParams): BOOL;external 'u
|
||||
function MessageBoxIndirectA(const MsgBoxParams: TMsgBoxParamsA): BOOL; external 'user32' name 'MessageBoxIndirectA';
|
||||
//function MessageBoxIndirectW(const MsgBoxParams: TMsgBoxParamsW): BOOL; external 'user32' name 'MessageBoxIndirectW';
|
||||
//function ModifyWorldTransform(DC: HDC; const p2: TXForm; p3: DWORD): BOOL; external 'gdi32' name 'ModifyWorldTransform';
|
||||
function MsgWaitForMultipleObjects(nCount: DWORD; var pHandles; fWaitAll: BOOL; dwMilliseconds, dwWakeMask: DWORD): DWORD;external 'user32' name 'MsgWaitForMultipleObjects';
|
||||
{$ifdef support_smartlink}
|
||||
function MsgWaitForMultipleObjectsEx(nCount: DWORD; var pHandles; dwMilliseconds, dwWakeMask, dwFlags: DWORD): DWORD;external 'user32' name 'MsgWaitForMultipleObjectsEx';
|
||||
{$endif support_smartlink}
|
||||
@ -698,9 +707,7 @@ function OpenThreadToken(ThreadHandle: THandle; DesiredAccess: DWORD; OpenAsSelf
|
||||
function PeekConsoleInput(hConsoleInput: THandle; var lpBuffer: TInputRecord; nLength: DWORD; var lpNumberOfEventsRead: DWORD): BOOL;external 'kernel32' name 'PeekConsoleInputA';
|
||||
function PeekConsoleInputA(hConsoleInput: THandle; var lpBuffer: TInputRecord; nLength: DWORD; var lpNumberOfEventsRead: DWORD): BOOL; external 'kernel32' name 'PeekConsoleInputA';
|
||||
function PeekConsoleInputW(hConsoleInput: THandle; var lpBuffer: TInputRecord; nLength: DWORD; var lpNumberOfEventsRead: DWORD): BOOL; external 'kernel32' name 'PeekConsoleInputW';
|
||||
function PeekMessage(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): BOOL;external 'user32' name 'PeekMessageA';
|
||||
function PeekMessageA(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): BOOL; external 'user32' name 'PeekMessageA';
|
||||
function PeekMessageW(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): BOOL; external 'user32' name 'PeekMessageW';
|
||||
//function PlayEnhMetaFile(DC: HDC; p2: HENHMETAFILE; const p3: TRect): BOOL; external 'gdi32' name 'PlayEnhMetaFile';
|
||||
function PlayEnhMetaFileRecord(DC: HDC; var p2: THandleTable; const p3: TEnhMetaRecord; p4: UINT): BOOL; external 'gdi32' name 'PlayEnhMetaFileRecord';
|
||||
function PlayMetaFileRecord(DC: HDC; const p2: THandleTable; const p3: TMetaRecord; p4: UINT): BOOL; external 'gdi32' name 'PlayMetaFileRecord';
|
||||
@ -744,7 +751,6 @@ function ReadConsoleW(hConsoleInput: THandle; lpBuffer: Pointer; nNumberOfCharsT
|
||||
function ReadEventLog(hEventLog: THandle; dwReadFlags, dwRecordOffset: DWORD; lpBuffer: Pointer; nNumberOfBytesToRead: DWORD; var pnBytesRead, pnMinNumberOfBytesNeeded: DWORD): BOOL;external 'advapi32' name 'ReadEventLogA';
|
||||
function ReadEventLogA(hEventLog: THandle; dwReadFlags, dwRecordOffset: DWORD; lpBuffer: Pointer; nNumberOfBytesToRead: DWORD; var pnBytesRead, pnMinNumberOfBytesNeeded: DWORD): BOOL; external 'advapi32' name 'ReadEventLogA';
|
||||
function ReadEventLogW(hEventLog: THandle; dwReadFlags, dwRecordOffset: DWORD; lpBuffer: Pointer; nNumberOfBytesToRead: DWORD; var pnBytesRead, pnMinNumberOfBytesNeeded: DWORD): BOOL; external 'advapi32' name 'ReadEventLogW';
|
||||
function ReadFile(hFile: THandle; var Buffer; nNumberOfBytesToRead: DWORD; var lpNumberOfBytesRead: DWORD; lpOverlapped: POverlapped): BOOL; external 'kernel32' name 'ReadFile';
|
||||
function ReadProcessMemory(hProcess: THandle; const lpBaseAddress: Pointer; lpBuffer: Pointer; nSize: DWORD; var lpNumberOfBytesRead: DWORD): BOOL; external 'kernel32' name 'ReadProcessMemory';
|
||||
//function RectInRegion(RGN: HRGN; const p2: TRect): BOOL; external 'gdi32' name 'RectInRegion';
|
||||
//function RectVisible(DC: HDC; const Rect: TRect): BOOL; external 'gdi32' name 'RectVisible';
|
||||
@ -767,12 +773,10 @@ function RegEnumValue(hKey: HKEY; dwIndex: DWORD; lpValueName: PChar; var lpcbVa
|
||||
function RegEnumValueA(hKey: HKEY; dwIndex: DWORD; lpValueName: PChar; var lpcbValueName: DWORD; lpReserved: Pointer; lpType: PDWORD; lpData: PByte; lpcbData: PDWORD): Longint; external 'advapi32' name 'RegEnumValueA';
|
||||
function RegEnumValueW(hKey: HKEY; dwIndex: DWORD; lpValueName: PChar; var lpcbValueName: DWORD; lpReserved: Pointer; lpType: PDWORD; lpData: PByte; lpcbData: PDWORD): Longint; external 'advapi32' name 'RegEnumValueW';
|
||||
function RegGetKeySecurity(hKey: HKEY; SecurityInformation: SECURITY_INFORMATION; pSecurityDescriptor: PSecurityDescriptor; var lpcbSecurityDescriptor: DWORD): Longint; external 'advapi32' name 'RegGetKeySecurity';
|
||||
function RegisterClass(const lpWndClass: TWndClass): ATOM;external 'user32' name 'RegisterClassA';
|
||||
function RegisterClassA(const lpWndClass: TWndClassA): ATOM; external 'user32' name 'RegisterClassA';
|
||||
function RegisterClassEx(const WndClass: TWndClassEx): ATOM;external 'user32' name 'RegisterClassExA';
|
||||
function RegisterClassExA(const WndClass: TWndClassExA): ATOM; external 'user32' name 'RegisterClassExA';
|
||||
function RegisterClassExW(const WndClass: TWndClassExW): ATOM; external 'user32' name 'RegisterClassExW';
|
||||
function RegisterClassW(const lpWndClass: TWndClassW): ATOM; external 'user32' name 'RegisterClassW';
|
||||
function RegOpenKey(hKey: HKEY; lpSubKey: PChar; var phkResult: HKEY): Longint;external 'advapi32' name 'RegOpenKeyA';
|
||||
function RegOpenKeyA(hKey: HKEY; lpSubKey: LPCSTR; var phkResult: HKEY): Longint; external 'advapi32' name 'RegOpenKeyA';
|
||||
function RegOpenKeyEx(hKey: HKEY; lpSubKey: PChar; ulOptions: DWORD; samDesired: REGSAM; var phkResult: HKEY): Longint;external 'advapi32' name 'RegOpenKeyExA';
|
||||
@ -816,7 +820,6 @@ function SetDeviceGammaRamp(DC: HDC; var Ramp): BOOL; external 'gdi32' name 'Set
|
||||
function SetDIBColorTable(DC: HDC; p2, p3: UINT; var RGBQuadSTructs): UINT; external 'gdi32' name 'SetDIBColorTable';
|
||||
function SetDIBits(DC: HDC; Bitmap: HBITMAP; StartScan, NumScans: UINT; Bits: Pointer; var BitsInfo: TBitmapInfo; Usage: UINT): Integer; external 'gdi32' name 'SetDIBits';
|
||||
//function SetDIBitsToDevice(DC: HDC; DestX, DestY: Integer; Width, Height: DWORD; SrcX, SrcY: Integer; nStartScan, NumScans: UINT; Bits: Pointer; var BitsInfo: TBitmapInfo; Usage: UINT): Integer; external 'gdi32' name 'SetDIBitsToDevice';
|
||||
function SetFileTime(hFile:HANDLE; var lpCreationTime:FILETIME; var lpLastAccessTime:FILETIME; var lpLastWriteTime:FILETIME):WINBOOL; external 'kernel32' name 'SetFileTime';
|
||||
//function SetKeyboardState(var KeyState: TKeyboardState): BOOL; external 'user32' name 'SetKeyboardState';
|
||||
//function SetLocalTime(const lpSystemTime: TSystemTime): BOOL; external 'kernel32' name 'SetLocalTime';
|
||||
//function SetMenuInfo(hMenu: HMENU; const lpcmi: TMenuInfo): BOOL;external 'user32' name 'SetMenuInfo';
|
||||
@ -945,7 +948,6 @@ function WriteConsoleOutputCharacterA(hConsoleOutput: THandle;lpCharacter: LPCST
|
||||
function WriteConsoleOutputCharacterW(hConsoleOutput: THandle;lpCharacter: LPWSTR; nLength: DWORD; dwWriteCoord: TCoord; var lpNumberOfCharsWritten: DWORD): BOOL; external 'kernel32' name 'WriteConsoleOutputCharacterW';
|
||||
function WriteConsoleOutputW(hConsoleOutput: THandle; lpBuffer: Pointer; dwBufferSize, dwBufferCoord: TCoord; var lpWriteRegion: TSmallRect): BOOL; external 'kernel32' name 'WriteConsoleOutputW';
|
||||
function WriteConsoleW(hConsoleOutput: THandle; const lpBuffer: Pointer; nNumberOfCharsToWrite: DWORD; var lpNumberOfCharsWritten: DWORD; lpReserved: Pointer): BOOL; external 'kernel32' name 'WriteConsoleW';
|
||||
function WriteFile(hFile: THandle; const Buffer; nNumberOfBytesToWrite: DWORD; var lpNumberOfBytesWritten: DWORD; lpOverlapped: POverlapped): BOOL; external 'kernel32' name 'WriteFile';
|
||||
function WriteFileEx(hFile: THandle; lpBuffer: Pointer; nNumberOfBytesToWrite: DWORD; const lpOverlapped: TOverlapped; lpCompletionRoutine: FARPROC): BOOL; external 'kernel32' name 'WriteFileEx';
|
||||
function WriteProcessMemory(hProcess: THandle; const lpBaseAddress: Pointer; lpBuffer: Pointer; nSize: DWORD; var lpNumberOfBytesWritten: DWORD): BOOL; external 'kernel32' name 'WriteProcessMemory';
|
||||
|
||||
@ -972,10 +974,86 @@ function AnsiLowerBuff(lpsz:LPSTR; cchLength:DWORD):DWORD; external 'user32' nam
|
||||
{$ifdef read_implementation}
|
||||
|
||||
//begin common win32 & wince
|
||||
function MAKELANGID(PrimaryLang, SubLang: USHORT): WORD;
|
||||
begin
|
||||
MAKELANGID := (SubLang shl 10) or PrimaryLang;
|
||||
end;
|
||||
|
||||
function PRIMARYLANGID(LangId: WORD): WORD;
|
||||
begin
|
||||
PRIMARYLANGID := LangId and $3FF;
|
||||
end;
|
||||
|
||||
function SUBLANGID(LangId: WORD): WORD;
|
||||
begin
|
||||
SUBLANGID := LangId shr 10;
|
||||
end;
|
||||
|
||||
function MAKELCID(LangId, SortId: WORD): DWORD;
|
||||
begin
|
||||
MAKELCID := (DWORD(SortId) shl 16) or DWORD(LangId);
|
||||
end;
|
||||
|
||||
function MAKESORTLCID(LangId, SortId, SortVersion: WORD): DWORD;
|
||||
begin
|
||||
MAKESORTLCID := MAKELCID(LangId, SortId) or (SortVersion shl 20);
|
||||
end;
|
||||
|
||||
function LANGIDFROMLCID(LocaleId: LCID): WORD;
|
||||
begin
|
||||
LANGIDFROMLCID := WORD(LocaleId);
|
||||
end;
|
||||
|
||||
function SORTIDFROMLCID(LocaleId: LCID): WORD;
|
||||
begin
|
||||
SORTIDFROMLCID := WORD((DWORD(LocaleId) shr 16) and $F);
|
||||
end;
|
||||
|
||||
function SORTVERSIONFROMLCID(LocaleId: LCID): WORD;
|
||||
begin
|
||||
SORTVERSIONFROMLCID := WORD((DWORD(LocaleId) shr 20) and $F);
|
||||
end;
|
||||
|
||||
function LANG_SYSTEM_DEFAULT: WORD;
|
||||
begin
|
||||
LANG_SYSTEM_DEFAULT := MAKELANGID(LANG_NEUTRAL, SUBLANG_SYS_DEFAULT);
|
||||
end;
|
||||
|
||||
function LANG_USER_DEFAULT: WORD;
|
||||
begin
|
||||
LANG_USER_DEFAULT := MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT);
|
||||
end;
|
||||
|
||||
function LOCALE_USER_DEFAULT: DWORD;
|
||||
begin
|
||||
LOCALE_USER_DEFAULT:= MAKELCID(LANG_USER_DEFAULT, SORT_DEFAULT);
|
||||
end;
|
||||
|
||||
function LOCALE_SYSTEM_DEFAULT: DWORD;
|
||||
begin
|
||||
LOCALE_SYSTEM_DEFAULT:= MAKELCID(LANG_SYSTEM_DEFAULT, SORT_DEFAULT);
|
||||
end;
|
||||
|
||||
function LOCALE_NEUTRAL: DWORD;
|
||||
begin
|
||||
LOCALE_NEUTRAL := MAKELCID(MAKELANGID(LANG_NEUTRAL, SUBLANG_NEUTRAL), SORT_DEFAULT);
|
||||
end;
|
||||
|
||||
function LOCALE_INVARIANT: DWORD;
|
||||
begin
|
||||
LOCALE_INVARIANT := MAKELCID(MAKELANGID(LANG_INVARIANT, SUBLANG_NEUTRAL), SORT_DEFAULT);
|
||||
end;
|
||||
|
||||
//end common win32 & wince
|
||||
|
||||
{$ifdef WINCE}
|
||||
//begin wince only
|
||||
|
||||
function MsgWaitForMultipleObjects(nCount: DWORD; var pHandles; fWaitAll: BOOL; dwMilliseconds, dwWakeMask: DWORD): DWORD;
|
||||
begin
|
||||
MsgWaitForMultipleObjects:=MsgWaitForMultipleObjectsEx(nCount,@pHandles,dwMilliseconds,dwWakeMask,0);
|
||||
end;
|
||||
|
||||
//end wince only
|
||||
{$endif WINCE}
|
||||
|
||||
@ -1029,75 +1107,6 @@ function HResultFromNT(x : Longint) : HRESULT;
|
||||
HResultFromNT:=x or FACILITY_NT_BIT;
|
||||
end;
|
||||
|
||||
function MAKELANGID(PrimaryLang, SubLang: USHORT): WORD;
|
||||
begin
|
||||
MAKELANGID := (SubLang shl 10) or PrimaryLang;
|
||||
end;
|
||||
|
||||
function PRIMARYLANGID(LangId: WORD): WORD;
|
||||
begin
|
||||
PRIMARYLANGID := LangId and $3FF;
|
||||
end;
|
||||
|
||||
function SUBLANGID(LangId: WORD): WORD;
|
||||
begin
|
||||
SUBLANGID := LangId shr 10;
|
||||
end;
|
||||
|
||||
function MAKELCID(LangId, SortId: WORD): DWORD;
|
||||
begin
|
||||
MAKELCID := (DWORD(SortId) shl 16) or DWORD(LangId);
|
||||
end;
|
||||
|
||||
function MAKESORTLCID(LangId, SortId, SortVersion: WORD): DWORD;
|
||||
begin
|
||||
MAKESORTLCID := MAKELCID(LangId, SortId) or (SortVersion shl 20);
|
||||
end;
|
||||
|
||||
function LANGIDFROMLCID(LocaleId: LCID): WORD;
|
||||
begin
|
||||
LANGIDFROMLCID := WORD(LocaleId);
|
||||
end;
|
||||
|
||||
function SORTIDFROMLCID(LocaleId: LCID): WORD;
|
||||
begin
|
||||
SORTIDFROMLCID := WORD((DWORD(LocaleId) shr 16) and $F);
|
||||
end;
|
||||
|
||||
function SORTVERSIONFROMLCID(LocaleId: LCID): WORD;
|
||||
begin
|
||||
SORTVERSIONFROMLCID := WORD((DWORD(LocaleId) shr 20) and $F);
|
||||
end;
|
||||
|
||||
function LANG_SYSTEM_DEFAULT: WORD;
|
||||
begin
|
||||
LANG_SYSTEM_DEFAULT := MAKELANGID(LANG_NEUTRAL, SUBLANG_SYS_DEFAULT);
|
||||
end;
|
||||
|
||||
function LANG_USER_DEFAULT: WORD;
|
||||
begin
|
||||
LANG_USER_DEFAULT := MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT);
|
||||
end;
|
||||
|
||||
function LOCALE_SYSTEM_DEFAULT: DWORD;
|
||||
begin
|
||||
LOCALE_SYSTEM_DEFAULT:= MAKELCID(LANG_SYSTEM_DEFAULT, SORT_DEFAULT);
|
||||
end;
|
||||
|
||||
function LOCALE_USER_DEFAULT: DWORD;
|
||||
begin
|
||||
LOCALE_USER_DEFAULT:= MAKELCID(LANG_USER_DEFAULT, SORT_DEFAULT);
|
||||
end;
|
||||
|
||||
function LOCALE_NEUTRAL: DWORD;
|
||||
begin
|
||||
LOCALE_NEUTRAL := MAKELCID(MAKELANGID(LANG_NEUTRAL, SUBLANG_NEUTRAL), SORT_DEFAULT);
|
||||
end;
|
||||
|
||||
function LOCALE_INVARIANT: DWORD;
|
||||
begin
|
||||
LOCALE_INVARIANT := MAKELCID(MAKELANGID(LANG_INVARIANT, SUBLANG_NEUTRAL), SORT_DEFAULT);
|
||||
end;
|
||||
//end win32 or wince not checked
|
||||
|
||||
{$endif WIN32}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user