mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-09-10 02:20:00 +02:00
MWE:
* fixed some selection code + Added selection sample git-svn-id: trunk@40 -
This commit is contained in:
lazarus
parent
fd870cae44
commit
fe47d09840
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -93,6 +93,8 @@ examples/notebk.pp svneol=native#text/pascal
|
||||
examples/notebku.pp svneol=native#text/pascal
|
||||
examples/notebooktest.pp svneol=native#text/pascal
|
||||
examples/progressbar.pp svneol=native#text/pascal
|
||||
examples/selection.pp svneol=native#text/pascal
|
||||
examples/selectionform.pp svneol=native#text/pascal
|
||||
examples/speedtest.pp svneol=native#text/pascal
|
||||
examples/testall.pp svneol=native#text/pascal
|
||||
examples/testallform.pp svneol=native#text/pascal
|
||||
|
||||
@ -72,7 +72,7 @@ type
|
||||
procedure ControlMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
||||
procedure DOChange;
|
||||
procedure SetGrabbers;
|
||||
procedure SizeContent(dx, dy: Integer);
|
||||
procedure SizeContent;
|
||||
procedure MoveContent(dx, dy: Integer);
|
||||
procedure SetVisible(const Value: Boolean);
|
||||
procedure GrabberMove(Sender: TObject; dx, dy: Integer);
|
||||
@ -174,7 +174,7 @@ end;
|
||||
|
||||
procedure TGrabber.PaintWindow(DC: HDC);
|
||||
begin
|
||||
WriteLn(Format('[TGrabber.PaintWindow] 0x%x', [DC]));
|
||||
// WriteLn(Format('[TGrabber.PaintWindow] 0x%x', [DC]));
|
||||
FillRect(DC, Rect(0, 0, Width, Height), GetStockObject(BLACK_BRUSH));
|
||||
end;
|
||||
|
||||
@ -205,35 +205,39 @@ var
|
||||
n: Integer;
|
||||
begin
|
||||
if AControl <> nil
|
||||
then with AControl do
|
||||
begin
|
||||
then begin
|
||||
if Initial
|
||||
then begin
|
||||
FLeft := Left;
|
||||
FTop := Top;
|
||||
FWidth := Width;
|
||||
FHeight := Height;
|
||||
FLeft := AControl.Left;
|
||||
FTop := AControl.Top;
|
||||
FWidth := AControl.Width;
|
||||
FHeight := AControl.Height;
|
||||
WriteLn(Format('[TControlSelection.AdjustSize] Initializing to X:%d, Y:%d, W:%d, H: %d', [FLeft, FTop, FWidth, FHeight]));
|
||||
end
|
||||
else begin
|
||||
n := FLeft - Left;
|
||||
WriteLn(Format('[TControlSelection.AdjustSize] current X:%d, Y:%d, W:%d, H: %d', [FLeft, FTop, FWidth, FHeight]));
|
||||
with AControl do
|
||||
WriteLn(Format('[TControlSelection.AdjustSize] Adjust for %s --> X:%d, Y:%d, W:%d, H: %d', [Classname, Left, Top, Width, Height]));
|
||||
n := FLeft - AControl.Left;
|
||||
if n > 0
|
||||
then begin
|
||||
FLeft := Left;
|
||||
FLeft := AControl.Left;
|
||||
Inc(FWidth , n);
|
||||
end;
|
||||
|
||||
n := FTop - Top;
|
||||
n := FTop - AControl.Top;
|
||||
if n > 0
|
||||
then begin
|
||||
FTop := Top;
|
||||
FTop := AControl.Top;
|
||||
Inc(FHeight, n);
|
||||
end;
|
||||
|
||||
n := Max(FLeft + FWidth, Left + Width);
|
||||
n := Max(FLeft + FWidth, AControl.Left + AControl.Width);
|
||||
FWidth := n - FLeft;
|
||||
|
||||
n := Max(FTop + FHeight, Top + Height);
|
||||
n := Max(FTop + FHeight, AControl.Top + AControl.Height);
|
||||
FHeight := n - FTop;
|
||||
WriteLn(Format('[TControlSelection.AdjustSize] Adjusted to X:%d, Y:%d, W:%d, H: %d', [FLeft, FTop, FWidth, FHeight]));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -308,6 +312,7 @@ begin
|
||||
|
||||
for GrabPos := Low(TGrabIndex) to High(TGrabIndex) do
|
||||
begin
|
||||
WriteLN(Format('[TControlSelection.Create] Create grabber %d', [Ord(GrabPos)]));
|
||||
FGrabbers[GrabPos] := TGrabber.Create(AOwner);
|
||||
with FGrabbers[GrabPos] do
|
||||
begin
|
||||
@ -356,11 +361,12 @@ end;
|
||||
|
||||
procedure TControlSelection.GrabberMoved(Sender: TObject; dx, dy: Integer);
|
||||
begin
|
||||
SizeContent(dx, dy);
|
||||
SizeContent;
|
||||
end;
|
||||
|
||||
function TControlSelection.IsSelected(AControl: TControl): Boolean;
|
||||
begin
|
||||
WriteLn(Format('[TControlSelection.IsSelected] %s --> index %d', [AControl.ClassName, FControlList.IndexOf(AControl)]));
|
||||
Result := FControlList.IndexOf(AControl) <> -1;
|
||||
end;
|
||||
|
||||
@ -370,33 +376,38 @@ var
|
||||
begin
|
||||
with FControlList do
|
||||
for n := 0 to Count -1 do
|
||||
with TControl(Items[n]) do
|
||||
SetBounds(Left + dx, Top + dy, Width, Height);
|
||||
with TControl(Items[n]) do
|
||||
begin
|
||||
Left := Left + dx;
|
||||
Top := Top + dy;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TControlSelection.Remove(AControl: TControl);
|
||||
var
|
||||
n: Integer;
|
||||
begin
|
||||
with FControlList do
|
||||
if (Remove(AControl) <> -1)
|
||||
then begin
|
||||
if Count > 0
|
||||
then begin
|
||||
for n := 0 to Count -1 do AdjustSize(Items[n], n = 0);
|
||||
end
|
||||
else FVisible := False;
|
||||
SetGrabbers;
|
||||
with AControl do
|
||||
WriteLn(Format('[TControlSelection.AdjustSize] Remove %s --> X:%d, Y:%d, W:%d, H: %d', [Classname, Left, Top, Width, Height]));
|
||||
|
||||
with TSelectControl(AControl) do
|
||||
begin
|
||||
OnMouseDown := nil;
|
||||
OnMouseMove := nil;
|
||||
OnMouseUp := nil;
|
||||
end;
|
||||
FDragging := False;
|
||||
DoChange;
|
||||
if (FControlList.Remove(AControl) <> -1)
|
||||
then begin
|
||||
if FControlList.Count > 0
|
||||
then begin
|
||||
for n := 0 to FControlList.Count - 1 do AdjustSize(FControlList[n], n = 0);
|
||||
end
|
||||
else FVisible := False;
|
||||
SetGrabbers;
|
||||
|
||||
with TSelectControl(AControl) do
|
||||
begin
|
||||
OnMouseDown := nil;
|
||||
OnMouseMove := nil;
|
||||
OnMouseUp := nil;
|
||||
end;
|
||||
FDragging := False;
|
||||
DoChange;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TControlSelection.SetGrabbers;
|
||||
@ -404,25 +415,51 @@ var
|
||||
GrabPos: TGrabIndex;
|
||||
Grabber: TGrabber;
|
||||
begin
|
||||
WriteLn(Format('[TControlSelection.SetGrabbers] Selection --> X:%d, Y:%d, W:%d, H:%d', [FLeft, FTop, FWidth, FHeight]));
|
||||
for GrabPos := Low(TGrabIndex) to High(TGrabIndex) do
|
||||
begin
|
||||
Grabber := FGrabbers[GrabPos];
|
||||
if FVisible
|
||||
then begin
|
||||
Write(Format('[TControlSelection.SetGrabbers] Setting grabber %d --> ', [Ord(GrabPos)]));
|
||||
if gpLeft in Grabber.Positions
|
||||
then Grabber.Left := FLeft - GRAB_SIZE
|
||||
else if gpRight in Grabber.Positions
|
||||
then Grabber.Left := FLeft + FWidth
|
||||
else Grabber.Left := FLeft + (FWidth - GRAB_SIZE) div 2;
|
||||
then begin
|
||||
Write('Left, ');
|
||||
Grabber.Left := FLeft - GRAB_SIZE
|
||||
end
|
||||
else begin
|
||||
if gpRight in Grabber.Positions
|
||||
then begin
|
||||
Write('Right, ');
|
||||
Grabber.Left := FLeft + FWidth
|
||||
end
|
||||
else begin
|
||||
Write('Center, ');
|
||||
Grabber.Left := FLeft + (FWidth - GRAB_SIZE) div 2;
|
||||
end;
|
||||
end;
|
||||
|
||||
if gpTop in Grabber.Positions
|
||||
then Grabber.Top := FTop - GRAB_SIZE
|
||||
else if gpBottom in Grabber.Positions
|
||||
then Grabber.Top := FTop + FHeight
|
||||
else Grabber.Top := FTop + (FHeight - GRAB_SIZE) div 2;
|
||||
then begin
|
||||
Write('Top ');
|
||||
Grabber.Top := FTop - GRAB_SIZE
|
||||
end
|
||||
else begin
|
||||
if gpBottom in Grabber.Positions
|
||||
then begin
|
||||
Write('Bottom ');
|
||||
Grabber.Top := FTop + FHeight
|
||||
end
|
||||
else begin
|
||||
Write('Center ');
|
||||
Grabber.Top := FTop + (FHeight - GRAB_SIZE) div 2;
|
||||
end
|
||||
end;
|
||||
|
||||
WriteLN(Format('X:%d, Y:%d', [Grabber.Left, Grabber.Top]));
|
||||
end;
|
||||
|
||||
Grabber.Visible := FVisible;
|
||||
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -435,7 +472,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TControlSelection.SizeContent(dx, dy: Integer);
|
||||
procedure TControlSelection.SizeContent;
|
||||
begin
|
||||
if FControlList.Count = 1 then
|
||||
begin
|
||||
|
||||
@ -1,12 +1,12 @@
|
||||
#
|
||||
# Makefile generated by fpcmake v1.00 [2000/10/01]
|
||||
# Makefile generated by fpcmake v1.00 [2000/07/11]
|
||||
#
|
||||
|
||||
defaultrule: all
|
||||
|
||||
#####################################################################
|
||||
# Autodetect OS (Linux or Dos or Windows NT)
|
||||
# define inUnix when running under Unix (Linux,FreeBSD)
|
||||
# define inlinux when running under linux
|
||||
# define inWinNT when running under WinNT
|
||||
#####################################################################
|
||||
|
||||
@ -23,18 +23,22 @@ nopwd:
|
||||
@echo Get ftp://ftp.freepascal.org/pub/fpc/dist/go32v2/utilgo32.zip
|
||||
@exit
|
||||
else
|
||||
inUnix=1
|
||||
inlinux=1
|
||||
endif
|
||||
else
|
||||
PWD:=$(firstword $(PWD))
|
||||
endif
|
||||
|
||||
# Detect NT - NT sets OS to Windows_NT
|
||||
# Detect OS/2 - OS/2 has OS2_SHELL defined
|
||||
ifndef inUnix
|
||||
ifndef inlinux
|
||||
ifeq ($(OS),Windows_NT)
|
||||
inWinNT=1
|
||||
else
|
||||
endif
|
||||
endif
|
||||
|
||||
# Detect OS/2 - OS/2 has OS2_SHELL defined
|
||||
ifndef inlinux
|
||||
ifndef inWinNT
|
||||
ifdef OS2_SHELL
|
||||
inOS2=1
|
||||
endif
|
||||
@ -42,14 +46,14 @@ endif
|
||||
endif
|
||||
|
||||
# The extension of executables
|
||||
ifdef inUnix
|
||||
SRCEXEEXT=
|
||||
ifdef inlinux
|
||||
EXEEXT=
|
||||
else
|
||||
SRCEXEEXT=.exe
|
||||
EXEEXT=.exe
|
||||
endif
|
||||
|
||||
# The path which is searched separated by spaces
|
||||
ifdef inUnix
|
||||
ifdef inlinux
|
||||
SEARCHPATH=$(subst :, ,$(PATH))
|
||||
else
|
||||
SEARCHPATH=$(subst ;, ,$(PATH))
|
||||
@ -72,11 +76,15 @@ ifndef FPC
|
||||
ifdef PP
|
||||
FPC=$(PP)
|
||||
else
|
||||
ifdef inOS2
|
||||
FPC=ppos2
|
||||
else
|
||||
FPC=ppc386
|
||||
endif
|
||||
endif
|
||||
override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
|
||||
override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
|
||||
endif
|
||||
override FPC:=$(subst $(EXEEXT),,$(FPC))
|
||||
override FPC:=$(subst \,/,$(FPC))$(EXEEXT)
|
||||
|
||||
# Target OS
|
||||
ifndef OS_TARGET
|
||||
@ -123,7 +131,7 @@ endif
|
||||
|
||||
# Detect FPCDIR
|
||||
ifeq ($(FPCDIR),wrong)
|
||||
ifdef inUnix
|
||||
ifdef inlinux
|
||||
override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION)
|
||||
ifeq ($(wildcard $(FPCDIR)/units),)
|
||||
override FPCDIR=/usr/lib/fpc/$(FPC_VERSION)
|
||||
@ -166,7 +174,7 @@ endif
|
||||
|
||||
# Targets
|
||||
|
||||
override EXEOBJECTS+=hello notebk comdialogs progressbar trackbar listboxtest bitbutton combobox checkbox
|
||||
override EXEOBJECTS+=hello notebk comdialogs progressbar trackbar listboxtest bitbutton combobox checkbox selection
|
||||
|
||||
# Clean
|
||||
|
||||
@ -181,7 +189,7 @@ ZIPTARGET=install
|
||||
|
||||
# Directories
|
||||
|
||||
override NEEDUNITDIR=. ../lcl/units ../components/units
|
||||
override NEEDUNITDIR=. ../lcl/units ../components/units ../designer
|
||||
ifndef TARGETDIR
|
||||
TARGETDIR=.
|
||||
endif
|
||||
@ -205,7 +213,7 @@ INFOTARGET=fpc_infocfg fpc_infoobjects fpc_infoinstall
|
||||
ifndef ECHO
|
||||
ECHO:=$(strip $(wildcard $(addsuffix /gecho$(EXEEXT),$(SEARCHPATH))))
|
||||
ifeq ($(ECHO),)
|
||||
ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
|
||||
ECHO:=$(strip $(wildcard $(addsuffix /echo$(EXEEXT),$(SEARCHPATH))))
|
||||
ifeq ($(ECHO),)
|
||||
ECHO:=echo
|
||||
ECHOE:=echo
|
||||
@ -246,7 +254,7 @@ endif
|
||||
|
||||
# To install files
|
||||
ifndef INSTALL
|
||||
ifdef inUnix
|
||||
ifdef inlinux
|
||||
INSTALL:=install -m 644
|
||||
else
|
||||
INSTALL:=$(COPY)
|
||||
@ -255,7 +263,7 @@ endif
|
||||
|
||||
# To install programs
|
||||
ifndef INSTALLEXE
|
||||
ifdef inUnix
|
||||
ifdef inlinux
|
||||
INSTALLEXE:=install -m 755
|
||||
else
|
||||
INSTALLEXE:=$(COPY)
|
||||
@ -264,7 +272,7 @@ endif
|
||||
|
||||
# To make a directory.
|
||||
ifndef MKDIR
|
||||
ifdef inUnix
|
||||
ifdef inlinux
|
||||
MKDIR:=install -m 755 -d
|
||||
else
|
||||
MKDIR:=ginstall -m 755 -d
|
||||
@ -288,7 +296,7 @@ LD=ld
|
||||
endif
|
||||
|
||||
# ppas.bat / ppas.sh
|
||||
ifdef inUnix
|
||||
ifdef inlinux
|
||||
PPAS=ppas.sh
|
||||
else
|
||||
ifdef inOS2
|
||||
@ -299,7 +307,7 @@ endif
|
||||
endif
|
||||
|
||||
# ldconfig to rebuild .so cache
|
||||
ifdef inUnix
|
||||
ifdef inlinux
|
||||
LDCONFIG=ldconfig
|
||||
else
|
||||
LDCONFIG=
|
||||
@ -307,7 +315,7 @@ endif
|
||||
|
||||
# ppumove
|
||||
ifndef PPUMOVE
|
||||
PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH))))
|
||||
PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(EXEEXT),$(SEARCHPATH))))
|
||||
ifeq ($(PPUMOVE),)
|
||||
PPUMOVE=
|
||||
else
|
||||
@ -318,7 +326,7 @@ export PPUMOVE
|
||||
|
||||
# ppufiles
|
||||
ifndef PPUFILES
|
||||
PPUFILES:=$(strip $(wildcard $(addsuffix /ppufiles$(SRCEXEEXT),$(SEARCHPATH))))
|
||||
PPUFILES:=$(strip $(wildcard $(addsuffix /ppufiles$(EXEEXT),$(SEARCHPATH))))
|
||||
ifeq ($(PPUFILES),)
|
||||
PPUFILES=
|
||||
else
|
||||
@ -337,7 +345,7 @@ ifeq ($(OS_TARGET),win32)
|
||||
UPXPROG:=1
|
||||
endif
|
||||
ifdef UPXPROG
|
||||
UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(SRCEXEEXT),$(SEARCHPATH))))
|
||||
UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(EXEEXT),$(SEARCHPATH))))
|
||||
ifeq ($(UPXPROG),)
|
||||
UPXPROG=
|
||||
else
|
||||
@ -351,7 +359,7 @@ export UPXPROG
|
||||
|
||||
# ZipProg, you can't use Zip as the var name (PFV)
|
||||
ifndef ZIPPROG
|
||||
ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH))))
|
||||
ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(EXEEXT),$(SEARCHPATH))))
|
||||
ifeq ($(ZIPPROG),)
|
||||
ZIPPROG=
|
||||
else
|
||||
@ -365,7 +373,7 @@ ZIPEXT=.zip
|
||||
|
||||
# Tar
|
||||
ifndef TARPROG
|
||||
TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH))))
|
||||
TARPROG:=$(strip $(wildcard $(addsuffix /tar$(EXEEXT),$(SEARCHPATH))))
|
||||
ifeq ($(TARPROG),)
|
||||
TARPROG=
|
||||
else
|
||||
@ -388,7 +396,6 @@ endif
|
||||
|
||||
# Default needed extensions (Go32v2,Linux)
|
||||
LOADEREXT=.as
|
||||
EXEEXT=.exe
|
||||
PPLEXT=.ppl
|
||||
PPUEXT=.ppu
|
||||
OEXT=.o
|
||||
@ -417,18 +424,9 @@ endif
|
||||
|
||||
# Linux
|
||||
ifeq ($(OS_TARGET),linux)
|
||||
EXEEXT=
|
||||
HASSHAREDLIB=1
|
||||
FPCMADE=fpcmade.lnx
|
||||
endif
|
||||
|
||||
# Linux
|
||||
ifeq ($(OS_TARGET),freebsd)
|
||||
EXEEXT=
|
||||
HASSHAREDLIB=1
|
||||
FPCMADE=fpcmade.freebsd
|
||||
endif
|
||||
|
||||
# Win32
|
||||
ifeq ($(OS_TARGET),win32)
|
||||
PPUEXT=.ppw
|
||||
@ -589,30 +587,9 @@ endif
|
||||
# Default Directories
|
||||
#####################################################################
|
||||
|
||||
# Linux and freebsd use unix dirs with /usr/bin, /usr/lib
|
||||
# When zipping use the target as default, when normal install then
|
||||
# use the source os as default
|
||||
ifdef ZIPNAME
|
||||
# Zipinstall
|
||||
ifeq ($(OS_TARGET),linux)
|
||||
UNIXINSTALLDIR=1
|
||||
endif
|
||||
ifeq ($(OS_TARGET),freebsd)
|
||||
UNIXINSTALLDIR=1
|
||||
endif
|
||||
else
|
||||
# Normal install
|
||||
ifeq ($(OS_SOURCE),linux)
|
||||
UNIXINSTALLDIR=1
|
||||
endif
|
||||
ifeq ($(OS_SOURCE),freebsd)
|
||||
UNIXINSTALLDIR=1
|
||||
endif
|
||||
endif
|
||||
|
||||
# set the prefix directory where to install everything
|
||||
ifndef PREFIXINSTALLDIR
|
||||
ifdef UNIXINSTALLDIR
|
||||
ifdef inlinux
|
||||
PREFIXINSTALLDIR=/usr
|
||||
else
|
||||
PREFIXINSTALLDIR=/pp
|
||||
@ -632,7 +609,7 @@ export DESTZIPDIR
|
||||
|
||||
# set the base directory where to install everything
|
||||
ifndef BASEINSTALLDIR
|
||||
ifdef UNIXINSTALLDIR
|
||||
ifdef inlinux
|
||||
BASEINSTALLDIR=$(PREFIXINSTALLDIR)/lib/fpc/$(FPC_VERSION)
|
||||
else
|
||||
BASEINSTALLDIR=$(PREFIXINSTALLDIR)
|
||||
@ -641,7 +618,7 @@ endif
|
||||
|
||||
# set the directory where to install the binaries
|
||||
ifndef BININSTALLDIR
|
||||
ifdef UNIXINSTALLDIR
|
||||
ifdef inlinux
|
||||
BININSTALLDIR=$(PREFIXINSTALLDIR)/bin
|
||||
else
|
||||
BININSTALLDIR=$(BASEINSTALLDIR)/bin/$(OS_TARGET)
|
||||
@ -658,7 +635,7 @@ endif
|
||||
|
||||
# Where to install shared libraries
|
||||
ifndef LIBINSTALLDIR
|
||||
ifdef UNIXINSTALLDIR
|
||||
ifdef inlinux
|
||||
LIBINSTALLDIR=$(PREFIXINSTALLDIR)/lib
|
||||
else
|
||||
LIBINSTALLDIR=$(UNITINSTALLDIR)
|
||||
@ -667,7 +644,7 @@ endif
|
||||
|
||||
# Where the source files will be stored
|
||||
ifndef SOURCEINSTALLDIR
|
||||
ifdef UNIXINSTALLDIR
|
||||
ifdef inlinux
|
||||
SOURCEINSTALLDIR=$(PREFIXINSTALLDIR)/src/fpc-$(FPC_VERSION)
|
||||
else
|
||||
SOURCEINSTALLDIR=$(BASEINSTALLDIR)/source
|
||||
@ -679,7 +656,7 @@ endif
|
||||
|
||||
# Where the doc files will be stored
|
||||
ifndef DOCINSTALLDIR
|
||||
ifdef UNIXINSTALLDIR
|
||||
ifdef inlinux
|
||||
DOCINSTALLDIR=$(PREFIXINSTALLDIR)/doc/fpc-$(FPC_VERSION)
|
||||
else
|
||||
DOCINSTALLDIR=$(BASEINSTALLDIR)/doc
|
||||
@ -689,7 +666,7 @@ endif
|
||||
# Where to install the examples, under linux we use the doc dir
|
||||
# because the copytree command will create a subdir itself
|
||||
ifndef EXAMPLEINSTALLDIR
|
||||
ifdef UNIXINSTALLDIR
|
||||
ifdef inlinux
|
||||
EXAMPLEINSTALLDIR=$(DOCINSTALLDIR)/examples
|
||||
else
|
||||
EXAMPLEINSTALLDIR=$(BASEINSTALLDIR)/examples
|
||||
@ -713,7 +690,7 @@ REDIRFILE=log
|
||||
endif
|
||||
|
||||
ifdef REDIR
|
||||
ifndef inUnix
|
||||
ifndef inlinux
|
||||
override FPC=redir -eo $(FPC)
|
||||
endif
|
||||
# set the verbosity to max
|
||||
@ -760,7 +737,7 @@ endif
|
||||
|
||||
# Debug
|
||||
ifdef DEBUG
|
||||
override FPCOPT+=-gl -dDEBUG
|
||||
override FPCOPT+=-g -dDEBUG
|
||||
endif
|
||||
|
||||
# Release mode (strip, optimize and don't load ppc386.cfg)
|
||||
@ -796,27 +773,9 @@ ifdef UNITSDIR
|
||||
override FPCOPT+=-Fu$(UNITSDIR)
|
||||
endif
|
||||
|
||||
# Target dirs and the prefix to use for clean/install
|
||||
# Target dirs
|
||||
ifdef TARGETDIR
|
||||
override FPCOPT+=-FE$(TARGETDIR)
|
||||
ifeq ($(TARGETDIR),.)
|
||||
override TARGETDIRPREFIX=
|
||||
else
|
||||
override TARGETDIRPREFIX=$(TARGETDIR)/
|
||||
endif
|
||||
endif
|
||||
ifdef UNITTARGETDIR
|
||||
override FPCOPT+=-FU$(UNITTARGETDIR)
|
||||
ifeq ($(UNITTARGETDIR),.)
|
||||
override UNITTARGETDIRPREFIX=
|
||||
else
|
||||
override UNITTARGETDIRPREFIX=$(TARGETDIR)/
|
||||
endif
|
||||
else
|
||||
ifdef TARGETDIR
|
||||
override UNITTARGETDIR=$(TARGETDIR)
|
||||
override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)
|
||||
endif
|
||||
endif
|
||||
|
||||
# Add commandline options last so they can override
|
||||
@ -850,14 +809,11 @@ endif
|
||||
override COMPILER:=$(FPC) $(FPCOPT)
|
||||
|
||||
# also call ppas if with command option -s
|
||||
# but only if the OS_SOURCE and OS_TARGE are equal
|
||||
ifeq (,$(findstring -s ,$(COMPILER)))
|
||||
EXECPPAS=
|
||||
else
|
||||
ifeq ($(OS_SOURCE),$(OS_TARGET))
|
||||
EXECPPAS:=@$(PPAS)
|
||||
endif
|
||||
endif
|
||||
|
||||
#####################################################################
|
||||
# Standard rules
|
||||
@ -901,12 +857,11 @@ info: fpc_info
|
||||
|
||||
ifdef EXEOBJECTS
|
||||
override EXEFILES=$(addsuffix $(EXEEXT),$(EXEOBJECTS))
|
||||
override EXEOFILES:=$(addsuffix $(OEXT),$(EXEOBJECTS)) $(addprefix $(LIBPREFIX),$(addsuffix $(STATICLIBEXT),$(EXEOBJECTS)))
|
||||
override EXEOFILES=$(addsuffix $(OEXT),$(EXEOBJECTS))
|
||||
|
||||
override ALLTARGET+=fpc_exes
|
||||
override INSTALLEXEFILES+=$(EXEFILES)
|
||||
override CLEANEXEFILES+=$(EXEFILES) $(EXEOFILES)
|
||||
|
||||
endif
|
||||
|
||||
fpc_exes: $(EXEFILES)
|
||||
@ -927,11 +882,6 @@ fpc_all: fpc_packages $(FPCMADE)
|
||||
fpc_debug:
|
||||
$(MAKE) all DEBUG=1
|
||||
|
||||
# Search paths for .ppu if targetdir is set
|
||||
ifdef UNITTARGETDIR
|
||||
vpath %$(PPUEXT) $(UNITTARGETDIR)
|
||||
endif
|
||||
|
||||
# General compile rules, available for both possible PASEXT
|
||||
|
||||
.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .pp
|
||||
@ -973,7 +923,7 @@ fpc_smart:
|
||||
$(MAKE) all LINKSMART=1 CREATESMART=1
|
||||
|
||||
fpc_shared: all
|
||||
ifdef HASSHAREDLIB
|
||||
ifdef inlinux
|
||||
ifndef LIBNAME
|
||||
@$(ECHO) "LIBNAME not set"
|
||||
else
|
||||
@ -994,17 +944,11 @@ override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(EXTRAINSTALLUNITS))
|
||||
endif
|
||||
|
||||
ifdef INSTALLPPUFILES
|
||||
override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(INSTALLPPUFILES))
|
||||
ifdef PPUFILES
|
||||
INSTALLPPULINKFILES:=$(shell $(PPUFILES) -S -O $(INSTALLPPUFILES))
|
||||
else
|
||||
INSTALLPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(LIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES))))
|
||||
INSTALLPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)))
|
||||
endif
|
||||
override INSTALLPPULINKFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(INSTALLPPULINKFILES))
|
||||
endif
|
||||
|
||||
ifdef INSTALLEXEFILES
|
||||
override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(INSTALLEXEFILES))
|
||||
endif
|
||||
|
||||
fpc_showinstall: $(SHOWINSTALLTARGET)
|
||||
@ -1018,7 +962,7 @@ ifneq ($(INSTALLPPULINKFILES),)
|
||||
endif
|
||||
ifneq ($(wildcard $(LIBFULLNAME)),)
|
||||
@$(ECHO) $(LIBINSTALLDIR)/$(LIBFULLNAME)
|
||||
ifdef HASSHAREDLIB
|
||||
ifdef inlinux
|
||||
@$(ECHO) $(LIBINSTALLDIR)/$(LIBNAME)
|
||||
endif
|
||||
endif
|
||||
@ -1046,7 +990,7 @@ endif
|
||||
ifneq ($(wildcard $(LIBFULLNAME)),)
|
||||
$(MKDIR) $(LIBINSTALLDIR)
|
||||
$(INSTALL) $(LIBFULLNAME) $(LIBINSTALLDIR)
|
||||
ifdef inUnix
|
||||
ifdef inlinux
|
||||
ln -sf $(LIBFULLNAME) $(LIBINSTALLDIR)/$(LIBNAME)
|
||||
endif
|
||||
endif
|
||||
@ -1107,7 +1051,7 @@ endif
|
||||
|
||||
# Temporary path to pack a file
|
||||
ifndef PACKDIR
|
||||
ifndef inUnix
|
||||
ifndef inlinux
|
||||
PACKDIR=$(BASEDIR)/pack_tmp
|
||||
else
|
||||
PACKDIR=/tmp/fpc-pack
|
||||
@ -1123,7 +1067,7 @@ endif
|
||||
|
||||
# Use tar by default under linux
|
||||
ifndef USEZIP
|
||||
ifdef inUnix
|
||||
ifdef inlinux
|
||||
USETAR=1
|
||||
endif
|
||||
endif
|
||||
@ -1160,23 +1104,16 @@ fpc_zipexampleinstall:
|
||||
|
||||
.PHONY: fpc_clean fpc_cleanall fpc_distclean
|
||||
|
||||
ifdef EXEFILES
|
||||
override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES))
|
||||
endif
|
||||
|
||||
ifdef EXTRACLEANUNITS
|
||||
override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(EXTRACLEANUNITS))
|
||||
endif
|
||||
|
||||
ifdef CLEANPPUFILES
|
||||
override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES))
|
||||
# Get the .o and .a files created for the units
|
||||
ifdef PPUFILES
|
||||
CLEANPPULINKFILES:=$(shell $(PPUFILES) $(CLEANPPUFILES))
|
||||
else
|
||||
CLEANPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(LIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES))))
|
||||
CLEANPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)))
|
||||
endif
|
||||
override CLEANPPULINKFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES))
|
||||
endif
|
||||
|
||||
fpc_clean: $(CLEANTARGET)
|
||||
@ -1190,7 +1127,7 @@ ifneq ($(CLEANPPULINKFILES),)
|
||||
-$(DEL) $(CLEANPPULINKFILES)
|
||||
endif
|
||||
ifdef CLEANRSTFILES
|
||||
-$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
|
||||
-$(DEL) $(CLEANRSTFILES)
|
||||
endif
|
||||
ifdef EXTRACLEANFILES
|
||||
-$(DEL) $(EXTRACLEANFILES)
|
||||
@ -1202,13 +1139,7 @@ endif
|
||||
|
||||
fpc_distclean: fpc_clean
|
||||
|
||||
# Also run clean first if targetdir is set. Unittargetdir is always
|
||||
# set if targetdir or unittargetdir is specified
|
||||
ifdef UNITTARGETDIR
|
||||
TARGETDIRCLEAN=fpc_clean
|
||||
endif
|
||||
|
||||
fpc_cleanall: $(CLEANTARGET) $(TARGETDIRCLEAN)
|
||||
fpc_cleanall: $(CLEANTARGET)
|
||||
ifdef CLEANEXEFILES
|
||||
-$(DEL) $(CLEANEXEFILES)
|
||||
endif
|
||||
|
||||
@ -4,7 +4,7 @@
|
||||
|
||||
[targets]
|
||||
programs=hello notebk comdialogs progressbar trackbar listboxtest \
|
||||
bitbutton combobox checkbox
|
||||
bitbutton combobox checkbox selection
|
||||
|
||||
[clean]
|
||||
units=$(basename $(wildcard *$(PPUEXT)))
|
||||
@ -14,7 +14,7 @@ packages=fcl gtk
|
||||
|
||||
[dirs]
|
||||
targetdir=.
|
||||
unitdir=. ../lcl/units ../components/units
|
||||
unitdir=. ../lcl/units ../components/units ../designer
|
||||
|
||||
[presettings]
|
||||
|
||||
|
||||
14
examples/selection.pp
Normal file
14
examples/selection.pp
Normal file
@ -0,0 +1,14 @@
|
||||
program Selection;
|
||||
|
||||
{$mode delphi}
|
||||
|
||||
uses
|
||||
Forms,
|
||||
Selectionform,
|
||||
ControlSelection;
|
||||
|
||||
begin
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TForm1, Form1);
|
||||
Application.Run;
|
||||
end.
|
||||
203
examples/selectionform.pp
Normal file
203
examples/selectionform.pp
Normal file
@ -0,0 +1,203 @@
|
||||
unit SelectionForm;
|
||||
|
||||
interface
|
||||
|
||||
{$mode delphi}
|
||||
|
||||
uses
|
||||
Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ControlSelection,
|
||||
StdCtrls, Buttons;
|
||||
|
||||
type
|
||||
TForm1 = class(TForm)
|
||||
Button1: TButton;
|
||||
Button2: TButton;
|
||||
Button3: TButton;
|
||||
Button4: TButton;
|
||||
Button5: TButton;
|
||||
Button6: TButton;
|
||||
Button7: TButton;
|
||||
Button8: TButton;
|
||||
procedure AddSelClick(Sender: TObject);
|
||||
procedure Button8MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
|
||||
procedure Button8MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
||||
procedure Button8MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
||||
private
|
||||
FSelection: TControlSelection;
|
||||
FDown: Boolean;
|
||||
FStart: TPoint;
|
||||
procedure SelChange(Sender: TObject);
|
||||
public
|
||||
constructor Create(Owner: TComponent); override;
|
||||
end;
|
||||
|
||||
var
|
||||
Form1: TForm1;
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
constructor TForm1.Create(Owner: TComponent);
|
||||
begin
|
||||
inherited Create(Owner);
|
||||
|
||||
Left := 154;
|
||||
Top := 117;
|
||||
Width := 500;
|
||||
Height := 400;
|
||||
Caption := 'Selection Test';
|
||||
|
||||
Button1 := TButton.Create(Self);
|
||||
with Button1 do
|
||||
begin
|
||||
Parent := Self;
|
||||
Visible := True;
|
||||
Left := 44;
|
||||
Top := 128;
|
||||
Width := 265;
|
||||
Height := 25;
|
||||
Caption := 'Button1';
|
||||
TabOrder := 0;
|
||||
OnClick := AddSelClick;
|
||||
end;
|
||||
|
||||
Button2 := TButton.Create(Self);
|
||||
with Button2 do
|
||||
begin
|
||||
Parent := Self;
|
||||
Visible := True;
|
||||
Left := 212;
|
||||
Top := 184;
|
||||
Width := 221;
|
||||
Height := 105;
|
||||
Caption := 'Button2 (Allways selected)';
|
||||
TabOrder := 1;
|
||||
end;
|
||||
|
||||
Button3 := TButton.Create(Self);
|
||||
with Button3 do
|
||||
begin
|
||||
Parent := Self;
|
||||
Visible := True;
|
||||
Left := 148;
|
||||
Top := 92;
|
||||
Width := 75;
|
||||
Height := 25;
|
||||
Caption := 'Button3';
|
||||
TabOrder := 2;
|
||||
OnClick := AddSelClick;
|
||||
end;
|
||||
|
||||
Button4 := TButton.Create(Self);
|
||||
with Button4 do
|
||||
begin
|
||||
Parent := Self;
|
||||
Visible := True;
|
||||
Left := 264;
|
||||
Top := 80;
|
||||
Width := 217;
|
||||
Height := 25;
|
||||
Caption := 'Button4';
|
||||
TabOrder := 3;
|
||||
OnClick := AddSelClick;
|
||||
end;
|
||||
|
||||
Button5 := TButton.Create(Self);
|
||||
with Button5 do
|
||||
begin
|
||||
Parent := Self;
|
||||
Visible := True;
|
||||
Left := 96;
|
||||
Top := 56;
|
||||
Width := 75;
|
||||
Height := 25;
|
||||
Caption := 'Button5';
|
||||
TabOrder := 4;
|
||||
OnClick := AddSelClick;
|
||||
end;
|
||||
|
||||
Button6 := TButton.Create(Self);
|
||||
with Button6 do
|
||||
begin
|
||||
Parent := Self;
|
||||
Visible := True;
|
||||
Left := 112;
|
||||
Top := 212;
|
||||
Width := 75;
|
||||
Height := 105;
|
||||
Caption := 'Button6';
|
||||
TabOrder := 5;
|
||||
OnClick := AddSelClick;
|
||||
end;
|
||||
|
||||
Button7 := TButton.Create(Self);
|
||||
with Button7 do
|
||||
begin
|
||||
Parent := Self;
|
||||
Visible := True;
|
||||
Left := 324;
|
||||
Top := 48;
|
||||
Width := 75;
|
||||
Height := 165;
|
||||
Caption := 'Button7';
|
||||
TabOrder := 6;
|
||||
OnClick := AddSelClick;
|
||||
end;
|
||||
|
||||
Button8 := TButton.Create(Self);
|
||||
with Button8 do
|
||||
begin
|
||||
Parent := Self;
|
||||
Visible := True;
|
||||
Left := 32;
|
||||
Top := 36;
|
||||
Width := 105;
|
||||
Height := 85;
|
||||
Caption := 'Drag test';
|
||||
TabOrder := 7;
|
||||
OnMouseDown := Button8MouseDown;
|
||||
OnMouseMove := Button8MouseMove;
|
||||
OnMouseUp := Button8MouseUp;
|
||||
end;
|
||||
|
||||
FDown := False;
|
||||
|
||||
FSelection := TControlSelection.Create(Self);
|
||||
FSelection.OnChange := SelChange;
|
||||
FSelection.Add(Button2);
|
||||
end;
|
||||
|
||||
procedure TForm1.AddSelClick(Sender: TObject);
|
||||
begin
|
||||
if FSelection.IsSelected(TControl(Sender))
|
||||
then FSelection.Remove(TControl(Sender))
|
||||
else FSelection.Add(TControl(Sender));
|
||||
end;
|
||||
|
||||
procedure TForm1.SelChange(Sender: TObject);
|
||||
begin
|
||||
beep;
|
||||
end;
|
||||
|
||||
procedure TForm1.Button8MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
|
||||
begin
|
||||
Button8.Caption := Format('X:%d, Y:%d', [X, Y]);
|
||||
if FDown then
|
||||
begin
|
||||
Button8.Left := Button8.Left + X - FStart.X;
|
||||
Button8.Top := Button8.Top + Y - FStart.Y;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm1.Button8MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
||||
begin
|
||||
FDown := True;
|
||||
FStart := Point(X, Y);
|
||||
end;
|
||||
|
||||
procedure TForm1.Button8MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
||||
begin
|
||||
FDown := False;
|
||||
end;
|
||||
|
||||
end.
|
||||
@ -322,8 +322,10 @@ begin
|
||||
with Msg do
|
||||
begin
|
||||
Msg := LM_MouseMove;
|
||||
XPos := Trunc(Event^.X);
|
||||
YPos := trunc(Event^.Y);
|
||||
XPos := Round(Event^.X);
|
||||
YPos := Round(Event^.Y);
|
||||
// XPos := Trunc(Event^.X);
|
||||
// YPos := trunc(Event^.Y);
|
||||
{ Writeln('MOUSEMOVE Signal');
|
||||
Writeln('X = ');
|
||||
Writeln(' '+inttostr(XPos));
|
||||
@ -1075,6 +1077,11 @@ end;
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.7 2000/10/09 22:50:32 lazarus
|
||||
MWE:
|
||||
* fixed some selection code
|
||||
+ Added selection sample
|
||||
|
||||
Revision 1.6 2000/09/10 23:08:31 lazarus
|
||||
MWE:
|
||||
+ Added CreateCompatibeleBitamp function
|
||||
|
||||
@ -2565,7 +2565,38 @@ begin
|
||||
n := FDeviceContexts.Add(Result);
|
||||
Assert(False, Format('Trace:< [TgtkObject.NewDC] FDeviceContexts[%d] --> 0x%p', [n, Result]));
|
||||
end;
|
||||
(*
|
||||
{------------------------------------------------------------------------------
|
||||
Function: FreeDC
|
||||
Params: ADC: A DC to Free
|
||||
Returns: nothing
|
||||
|
||||
Frees an initial DC
|
||||
------------------------------------------------------------------------------}
|
||||
function TgtkObject.FreeDC(ADC: PDeviceContext);
|
||||
var
|
||||
n: Integer;
|
||||
begin
|
||||
Assert(False, Format('Trace:> [TgtkObject.FreeDC] DC:0x%p', [ADC]));
|
||||
if ADC <> nil
|
||||
then begin
|
||||
if ADC^.SavedContext <> nil
|
||||
then FreeDC(ADC^.SavedContext);
|
||||
|
||||
Assert(ADC^.CurrentBitmap = nil, 'trace: [TgtkObject.FreeDC] CurrentBitmap <> nil');
|
||||
Assert(ADC^.CurrentFont = nil, 'trace: [TgtkObject.FreeDC] CurrentFont <> nil');
|
||||
Assert(ADC^.CurrentPen = nil, 'trace: [TgtkObject.FreeDC] CurrentPen <> nil');
|
||||
Assert(ADC^.CurrentBrush = nil, 'trace: [TgtkObject.FreeDC] CurrentBrush <> nil');
|
||||
|
||||
if ADC^.GC <> nil
|
||||
then gdk_gc_unref(ADC^.GC);
|
||||
n := FDeviceContexts.Remove(ADC);
|
||||
Dispose(ADC);
|
||||
end;
|
||||
|
||||
Assert(False, Format('Trace:< [TgtkObject.FreeDC] FDeviceContexts[%d]', [n]));
|
||||
end;
|
||||
*)
|
||||
{------------------------------------------------------------------------------
|
||||
Function: NewGDIObject
|
||||
Params: none
|
||||
@ -2635,6 +2666,11 @@ end;
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.9 2000/10/09 22:50:32 lazarus
|
||||
MWE:
|
||||
* fixed some selection code
|
||||
+ Added selection sample
|
||||
|
||||
Revision 1.8 2000/09/10 23:08:31 lazarus
|
||||
MWE:
|
||||
+ Added CreateCompatibeleBitamp function
|
||||
|
||||
@ -7,6 +7,12 @@
|
||||
GTKCallback
|
||||
******************************************************************************)
|
||||
|
||||
{$IFOPT C-}
|
||||
// Uncomment for local trace
|
||||
// {$C+}
|
||||
// {$DEFINE ASSERT_IS_ON}
|
||||
{$ENDIF}
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Function: NewGDIRawImage
|
||||
Params: Width, Height: Size of the image
|
||||
@ -57,7 +63,7 @@ function CopyDCData(const DestinationDC, SourceDC: PDeviceContext): Boolean;
|
||||
var
|
||||
GCValues: TGDKGCValues;
|
||||
begin
|
||||
Assert(False, 'Trace:[CopyDCData]');
|
||||
Assert(False, Format('Trace:> [CopyDCData] DestDC:0x%x, SourceDC:0x%x', [Integer(DestinationDC), Integer(SourceDC)]));
|
||||
Result := (DestinationDC <> nil) and (SourceDC <> nil);
|
||||
if Result
|
||||
then begin
|
||||
@ -82,6 +88,7 @@ begin
|
||||
SavedContext := SourceDC^.SavedContext;
|
||||
end;
|
||||
end;
|
||||
Assert(False, Format('Trace:< [CopyDCData] DestDC:0x%x, SourceDC:0x%x --> %d', [Integer(DestinationDC), Integer(SourceDC), Integer(Result)]));
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -653,8 +660,19 @@ Assert(False, 'Trace:OBSOLETE gtkproc.inc GetPen');
|
||||
end;
|
||||
|
||||
|
||||
{
|
||||
{$IFDEF ASSERT_IS_ON}
|
||||
{$UNDEF ASSERT_IS_ON}
|
||||
{$C-}
|
||||
{$ENDIF}
|
||||
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.5 2000/10/09 22:50:32 lazarus
|
||||
MWE:
|
||||
* fixed some selection code
|
||||
+ Added selection sample
|
||||
|
||||
Revision 1.4 2000/09/10 23:08:31 lazarus
|
||||
MWE:
|
||||
+ Added CreateCompatibeleBitamp function
|
||||
|
||||
@ -2337,7 +2337,7 @@ begin
|
||||
Result := 1;
|
||||
end;
|
||||
end;
|
||||
Assert(False, Format('trace:< [TgtkObject.ReleaseDC] DC:0x%x', [hDC]));
|
||||
Assert(False, Format('trace:< [TgtkObject.ReleaseDC] FDeviceContexts[%d] DC:0x%x', [nIndex, hDC]));
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -2359,37 +2359,53 @@ function TgtkObject.RestoreDC(DC: HDC; SavedDC: Integer): Boolean;
|
||||
end;
|
||||
|
||||
var
|
||||
pDC, OldDC: PDeviceContext;
|
||||
pDC, pSaved: PDeviceContext;
|
||||
count: Integer;
|
||||
begin
|
||||
Assert(False, Format('Trace:> [TgtkObject.RestoreDC] 0x%x, Saved: %d', [DC, SavedDC]));
|
||||
Assert(False, Format('Trace:> [TgtkObject.RestoreDC] DC:0x%x, SavedDC: %d', [DC, SavedDC]));
|
||||
Result := IsValidDC(DC) and (SavedDC <> 0);
|
||||
if Result
|
||||
then begin
|
||||
pDC := PDeviceContext(DC);
|
||||
Count := CountSaved(pDC);
|
||||
Result := (Abs(SavedDC) <= Count);
|
||||
if Result
|
||||
then begin
|
||||
if SavedDC > 0 then Dec(SavedDc, Count + 1); // make relative
|
||||
while (SavedDC < 0) and (pDC <> nil) do
|
||||
begin
|
||||
OldDC := pDC;
|
||||
pDC := pDC^.SavedContext;
|
||||
Inc(SavedDC);
|
||||
// TODO copy bitmap allso
|
||||
// DeleteDC(OldDC);
|
||||
// fornow unref GC
|
||||
if OldDC^.GC <> nil
|
||||
then begin
|
||||
gdk_gc_unref(OldDC^.GC);
|
||||
OldDC^.GC := nil;
|
||||
end;
|
||||
|
||||
if SavedDC > 0 then Dec(SavedDc, Count + 1); // make relative
|
||||
|
||||
while (SavedDC < 0) and (pDC <> nil) and Result do
|
||||
begin
|
||||
Assert(False, Format('Trace:< [TgtkObject.RestoreDC] Unwinding#: %d', [SavedDC]));
|
||||
pSaved := pDC^.SavedContext;
|
||||
Inc(SavedDC);
|
||||
// TODO copy bitmap allso
|
||||
|
||||
pDC^.SavedContext := pSaved^.SavedContext;
|
||||
pSaved^.SavedContext := nil;
|
||||
|
||||
//prevent deleting of copied objects;
|
||||
if pSaved^.CurrentBitmap = pDC^.CurrentBitmap
|
||||
then pSaved^.CurrentBitmap := nil;
|
||||
if pSaved^.CurrentFont = pDC^.CurrentFont
|
||||
then pSaved^.CurrentFont := nil;
|
||||
if pSaved^.CurrentPen = pDC^.CurrentPen
|
||||
then pSaved^.CurrentPen := nil;
|
||||
if pSaved^.CurrentBrush = pDC^.CurrentBrush
|
||||
then pSaved^.CurrentBrush := nil;
|
||||
|
||||
Result := CopyDCData(pDC, pSaved);
|
||||
|
||||
DeleteDC(HGDIOBJ(pSaved));
|
||||
// fornow unref GC
|
||||
(*
|
||||
if OldDC^.GC <> nil
|
||||
then begin
|
||||
gdk_gc_unref(OldDC^.GC);
|
||||
OldDC^.GC := nil;
|
||||
end;
|
||||
Result := CopyDCData(PDeviceContext(DC), pDC);
|
||||
*)
|
||||
end;
|
||||
end;
|
||||
Assert(False, Format('Trace:< [TgtkObject.RestoreDC] 0x%x, Saved: %d --> %s', [Integer(DC), SavedDC, BOOL_TEXT[Result]]));
|
||||
Assert(False, Format('Trace:< [TgtkObject.RestoreDC] DC:0x%x, Saved: %d --> %s', [Integer(DC), SavedDC, BOOL_TEXT[Result]]));
|
||||
end;
|
||||
|
||||
|
||||
@ -3101,6 +3117,11 @@ end;
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.9 2000/10/09 22:50:33 lazarus
|
||||
MWE:
|
||||
* fixed some selection code
|
||||
+ Added selection sample
|
||||
|
||||
Revision 1.8 2000/09/10 23:08:31 lazarus
|
||||
MWE:
|
||||
+ Added CreateCompatibeleBitamp function
|
||||
|
||||
Loading…
Reference in New Issue
Block a user