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

MG: added graphics extensions from Andrew Johnson

Browse Source 
git-svn-id: trunk@1833 -
This commit is contained in:
lazarus 2002-08-08 18:05:48 +00:00
parent 45fbe892ab
commit c41c7d6a86
11 changed files with 186 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
lcl/Makefile
View File

@ -1,8 +1,8 @@
#
# Don't edit, this file is generated by FPCMake Version 1.1 [2002/05/20]
# Don't edit, this file is generated by FPCMake Version 1.1 [2002/08/06]
#
default: all
MAKEFILETARGETS=linux go32v2 win32 os2 freebsd beos netbsd amiga atari sunos qnx netware
MAKEFILETARGETS=linux go32v2 win32 os2 freebsd beos netbsd amiga atari sunos qnx netware openbsd wdosx
override PATH:=$(subst \,/,$(PATH))
ifeq ($(findstring ;,$(PATH)),)
inUnix=1
@ -42,6 +42,9 @@ endif
ifeq ($(OS_TARGET),netbsd)
BSDhier=1
endif
ifeq ($(OS_TARGET),openbsd)
BSDhier=1
endif
ifdef inUnix
BATCHEXT=.sh
else
@ -199,7 +202,7 @@ override PACKAGE_NAME=lazarus/lcl
override PACKAGE_VERSION=0.8a
override TARGET_DIRS+=interfaces
override TARGET_UNITS+=allunits
override TARGET_IMPLICITUNITS+=arrow buttons calendar clipbrd clistbox comctrls commctrl controls dialogs dynhasharray extctrls filectrl forms graphics graphtype imglist interfacebase lazqueue lcllinux lclstrconsts lcltype lmessages lresources menus messages registry spin stdctrls toolwin utrace vclglobals
override TARGET_IMPLICITUNITS+=arrow actnlist buttons calendar clipbrd clistbox comctrls commctrl controls dialogs dynhasharray extctrls filectrl forms graphics graphicsmath graphtype imglist interfacebase lazqueue lcllinux lclstrconsts lcltype lmessages lresources menus messages registry spin stdctrls toolwin utrace vclglobals
override TARGET_RSTS+=dialogs
override CLEAN_FILES+=$(wildcard units/*$(OEXT)) $(wildcard units/*$(PPUEXT)) $(wildcard units/*$(RSTEXT))$(wildcard *$(OEXT)) $(wildcard *$(PPUEXT)) $(wildcard *$(RSTEXT))
override INSTALL_BUILDUNIT=allunits
@ -223,6 +226,9 @@ endif
ifeq ($(OS_TARGET),netbsd)
UNIXINSTALLDIR=1
endif
ifeq ($(OS_TARGET),openbsd)
UNIXINSTALLDIR=1
endif
ifeq ($(OS_TARGET),sunos)
UNIXINSTALLDIR=1
endif
@ -239,6 +245,9 @@ endif
ifeq ($(OS_SOURCE),netbsd)
UNIXINSTALLDIR=1
endif
ifeq ($(OS_SOURCE),openbsd)
UNIXINSTALLDIR=1
endif
ifeq ($(OS_TARGET),sunos)
UNIXINSTALLDIR=1
endif
@ -454,6 +463,12 @@ HASSHAREDLIB=1
FPCMADE=fpcmade.netbsd
ZIPSUFFIX=netbsd
endif
ifeq ($(OS_TARGET),openbsd)
EXEEXT=
HASSHAREDLIB=1
FPCMADE=fpcmade.openbsd
ZIPSUFFIX=openbsd
endif
ifeq ($(OS_TARGET),win32)
PPUEXT=.ppw
OEXT=.ow
@ -803,6 +818,8 @@ REQUIRE_PACKAGES_RTL=1
REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_INET=1
REQUIRE_PACKAGES_FCL=1
REQUIRE_PACKAGES_MYSQL=1
REQUIRE_PACKAGES_IBASE=1
endif
ifeq ($(OS_TARGET),amiga)
REQUIRE_PACKAGES_RTL=1
@ -829,6 +846,19 @@ REQUIRE_PACKAGES_RTL=1
REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL=1
endif
ifeq ($(OS_TARGET),openbsd)
REQUIRE_PACKAGES_RTL=1
REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_INET=1
REQUIRE_PACKAGES_FCL=1
REQUIRE_PACKAGES_MYSQL=1
REQUIRE_PACKAGES_IBASE=1
endif
ifeq ($(OS_TARGET),wdosx)
REQUIRE_PACKAGES_RTL=1
REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL=1
endif
ifdef REQUIRE_PACKAGES_RTL
PACKAGEDIR_RTL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/$(OS_TARGET)/Makefile.fpc,$(PACKAGESDIR))))))
ifneq ($(PACKAGEDIR_RTL),)
@ -991,6 +1021,9 @@ endif
ifneq ($(OS_TARGET),$(OS_SOURCE))
override FPCOPT+=-T$(OS_TARGET)
endif
ifeq ($(OS_SOURCE),openbsd)
override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
endif
ifdef UNITDIR
override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
endif

10
lcl/Makefile.fpc
View File

@ -10,11 +10,11 @@ version=0.8a
[target]
dirs=interfaces
units=allunits
implicitunits=arrow buttons calendar clipbrd clistbox comctrls commctrl \
controls dialogs dynhasharray extctrls filectrl forms graphics \
graphtype imglist interfacebase lazqueue lcllinux lclstrconsts lcltype \
lmessages lresources menus messages registry spin stdctrls toolwin \
utrace vclglobals
implicitunits=arrow actnlist buttons calendar clipbrd clistbox comctrls \
commctrl controls dialogs dynhasharray extctrls filectrl forms \
graphics graphicsmath graphtype imglist interfacebase lazqueue \
lcllinux lclstrconsts lcltype lmessages lresources menus messages \
registry spin stdctrls toolwin utrace vclglobals
# !!! do not add interfaces. interfaces.ppu belongs to the interface(s).
# and do not add allunits. It is just a dummy unit used for compiling.

15
lcl/allunits.pp
View File

@ -26,12 +26,12 @@ interface
uses
InterfaceBase, Interfaces, LCLStrConsts,
Buttons, Extctrls, Registry, VCLGlobals, Calendar,
Clipbrd, Filectrl, Forms, LCLLinux, Spin,
Comctrls, Graphics, LMessages, Stdctrls, Arrow,
Controls, Imglist, Menus, Toolwin,
Dialogs, Messages, UTrace, DynHashArray,
Clistbox, Lazqueue;
Buttons, Extctrls, Registry, VCLGlobals, Calendar,
Clipbrd, Filectrl, Forms, LCLLinux, Spin,
Comctrls, Graphics, LMessages, Stdctrls, Arrow,
Controls, Imglist, Menus, Toolwin, Dialogs,
Messages, UTrace, DynHashArray, Clistbox, Lazqueue,
ActnList, GraphicsMath;
implementation
@ -40,6 +40,9 @@ end.
{ =============================================================================
$Log$
Revision 1.13 2002/08/08 18:05:46 lazarus
MG: added graphics extensions from Andrew Johnson
Revision 1.12 2002/07/04 11:46:00 lazarus
MG: moved resourcestring to lclstrconsts.pas

4
lcl/graphics.pp
View File

@ -474,6 +474,7 @@ type
Procedure BrushCopy(Dest : TRect; InternalImages: TBitmap; Src : TRect;
TransparentColor :TColor);
constructor Create;
procedure Chord(x,y,width,height,angle1,angle2 : Integer);
Procedure CopyRect(const Dest : TRect; Canvas : TCanvas; const Source : TRect);
destructor Destroy; override;
Procedure Draw(X,Y: Integer; Graphic : TGraphic);
@ -822,6 +823,9 @@ end.
{ =============================================================================
$Log$
Revision 1.36 2002/08/08 18:05:46 lazarus
MG: added graphics extensions from Andrew Johnson
Revision 1.35 2002/08/06 09:32:48 lazarus
MG: moved TColor definition to graphtype.pp and registered TColor names

19
lcl/include/canvas.inc
View File

@ -651,6 +651,22 @@ begin
FPenPos := Point(0, 0);
end;
{------------------------------------------------------------------------------
Method: TCanvas.Chord
Params: x,y,width,height,angle1,angle2
Returns: Nothing
Use Chord to draw a filled Chord-shape on the canvas. The angles angle1 and
angle2 are 1/16th of a degree. For example, a full circle equals 5760(16*360).
Positive values of Angle and AngleLength mean counter-clockwise while negative
values mean clockwise direction. Zero degrees is at the 3'o clock position.
------------------------------------------------------------------------------}
procedure TCanvas.Chord(x,y,width,height,angle1,angle2 : Integer);
begin
RequiredState([csHandleValid, csBrushValid, csPenValid]);
LCLLinux.AngleChord(FHandle,x,y,width,height,angle1,angle2);
end;
{------------------------------------------------------------------------------
Method: TCanvas.Destroy
Params: None
@ -834,6 +850,9 @@ end;
{ =============================================================================
$Log$
Revision 1.20 2002/08/08 18:05:46 lazarus
MG: added graphics extensions from Andrew Johnson
Revision 1.19 2002/06/04 15:17:22 lazarus
MG: improved TFont for XLFD font names

8
lcl/include/winapi.inc
View File

@ -34,6 +34,11 @@ begin
Result := InterfaceObject.Arc(DC,x,y,width,height,angle1,angle2);
end;
function AngleChord(DC: HDC; x,y,width,height,angle1,angle2 : Integer): Boolean;
begin
Result := InterfaceObject.AngleChord(DC,x,y,width,height,angle1,angle2);
end;
function BitBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc: Integer; Rop: DWORD): Boolean;
begin
Result := InterfaceObject.BitBlt(DestDC, X, Y, Width, Height, SrcDC, XSrc, YSrc, Rop);
@ -1115,6 +1120,9 @@ end;
{ =============================================================================
$Log$
Revision 1.38 2002/08/08 18:05:46 lazarus
MG: added graphics extensions from Andrew Johnson
Revision 1.37 2002/08/08 17:26:38 lazarus
MG: added property TMenuItems.RightJustify

6
lcl/include/winapih.inc
View File

@ -33,7 +33,8 @@
//##apiwiz##sps## // Do not remove
function Arc(DC: HDC; x,y,width,height,angle1,angle2 : Integer): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function AngleChord(DC: HDC; x,y,width,height,angle1,angle2 : Integer): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function BitBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc: Integer; Rop: DWORD): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
Function BringWindowToTop(hWnd : HWND): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
@ -274,6 +275,9 @@ function UnionRect(var DestRect: TRect; const SrcRect1, SrcRect2: TRect): Boolea
{ =============================================================================
$Log$
Revision 1.33 2002/08/08 18:05:46 lazarus
MG: added graphics extensions from Andrew Johnson
Revision 1.32 2002/08/08 17:26:38 lazarus
MG: added property TMenuItems.RightJustify

66
lcl/interfaces/gtk/gtkwinapi.inc
View File

@ -78,6 +78,46 @@ begin
end;
end;
{------------------------------------------------------------------------------
Method: AngleChord
Params: DC,x,y,width,height,angle1,angle2
Returns: Nothing
Use AngleChord to draw a filled Chord-shape on the canvas. The angles angle1
and angle2 are 1/16th of a degree. For example, a full circle equals 5760
16*360). Positive values of Angle and AngleLength mean counter-clockwise while
negative values mean clockwise direction. Zero degrees is at the 3'o clock
position.
------------------------------------------------------------------------------}
function TgtkObject.AngleChord(DC: HDC;
x,y,width,height,angle1,angle2 : Integer): Boolean;
var
Points : PPoint;
Count : Longint;
begin
Result := IsValidDC(DC);
if Result
then with PDeviceContext(DC)^ do
begin
if GC = nil
then begin
WriteLn('WARNING: [TgtkObject.AngleChord] Uninitialized GC');
Result := False;
end
else begin
Points := nil;
Count := 0;
PolyBezierArcPoints(X,Y,Width,Height,Angle1, Angle2, 0, Points, Count);
Inc(Count);
ReallocMem(Points, Count*SizeOf(TPoint));
Points[Count - 1] := Points[0];
Self.Polygon(DC, Points, Count, True);
ReallocMem(Points, 0);
Result := True;
end;
end;
end;
{------------------------------------------------------------------------------
Function: BitBlt
@ -3507,8 +3547,11 @@ end;
Zero degrees is at the 3'o clock position.
------------------------------------------------------------------------------}
function TgtkObject.Pie(DC: HDC;
function TgtkObject.Pie(DC: HDC;
x,y,width,height,angle1,angle2 : Integer): Boolean;
var
Points : PPoint;
Count : Longint;
begin
Result := IsValidDC(DC);
if Result
@ -3520,14 +3563,25 @@ begin
Result := False;
end
else begin
Points := nil;
Count := 0;
PolyBezierArcPoints(X,Y,Width,Height,Angle1, Angle2, 0, Points, Count);
Inc(Count,2);
ReallocMem(Points, Count*SizeOf(TPoint));
Points[Count - 2] := CenterPoint(Rect(X,Y,X+Width,Y+Height));
Points[Count - 1] := Points[0];
Self.Polygon(DC, Points, Count, True);
ReallocMem(Points, 0);
{ Old:
// first draw interior in brush color
SelectGDKBrushProps(DC);
gdk_draw_arc(Drawable, GC, 1, X, Y, Width, Height,
gdk_draw_arc(Drawable, GC, 1, X, Y, Width, Height,
Angle1 shl 2, Angle2 shl 2);
// Draw outline
SelectGDKPenProps(DC);
gdk_draw_arc(Drawable, GC, 0, X, Y, Width, Height,
gdk_draw_arc(Drawable, GC, 0, X, Y, Width, Height,
Angle1 shl 2, Angle2 shl 2);
}
Result := True;
end;
end;
@ -3614,8 +3668,7 @@ begin
// draw outline
SelectGDKPenProps(DC);
gdk_draw_polygon(Drawable, GC, 0, PointArray, NumPts);
gdk_draw_lines(Drawable, GC, PointArray, NumPts);
FreeMem(PointArray);
Result := True;
@ -4887,6 +4940,9 @@ end;
{ =============================================================================
$Log$
Revision 1.90 2002/08/08 18:05:47 lazarus
MG: added graphics extensions from Andrew Johnson
Revision 1.89 2002/08/08 17:26:39 lazarus
MG: added property TMenuItems.RightJustify

4
lcl/interfaces/gtk/gtkwinapih.inc
View File

@ -21,6 +21,7 @@
//##apiwiz##sps## // Do not remove
function Arc(DC: HDC; x,y,width,height,angle1,angle2 : Integer): Boolean; override;
function AngleChord(DC: HDC; x,y,width,height,angle1,angle2 : Integer): Boolean; override;
function BitBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc: Integer; Rop: DWORD): Boolean; override;
Function BringWindowToTop(hWnd : HWND): Boolean; override;
@ -161,6 +162,9 @@ Function WindowFromPoint(Point : TPoint) : HWND; override;
{ =============================================================================
$Log$
Revision 1.37 2002/08/08 18:05:48 lazarus
MG: added graphics extensions from Andrew Johnson
Revision 1.36 2002/08/08 17:26:40 lazarus
MG: added property TMenuItems.RightJustify

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

@ -58,6 +58,27 @@ Begin
Result := AngleArc(DC, X, Y, (Width + Height) Div 4, Angle1, Angle2);
End;
{------------------------------------------------------------------------------
Method: AngleChord
Params: DC,x,y,width,height,angle1,angle2
Returns: Nothing
Use AngleChord to draw a filled Chord-shape on the canvas. The angles angle1
and angle2 are 1/16th of a degree. For example, a full circle equals 5760
16*360). Positive values of Angle and AngleLength mean counter-clockwise while
negative values mean clockwise direction. Zero degrees is at the 3'o clock
position.
------------------------------------------------------------------------------}
Function TWin32Object.AngleChord(DC: HDC; X, Y, Width, Height, Angle1,
Angle2: Integer): Boolean;
var
SX, SY, EX, EY : Longint;
Begin
Angles2Coords(X,Y,Width,Height,Angle1,Angle2, SX, SY, EX, EY);
Result := Windows.Chord(DC, X, Y, X+Width, Y+Height, SX,SY,EX,EY);
End;
{------------------------------------------------------------------------------
Method: BitBlt
Params: DestDC - The destination device context
@ -1215,9 +1236,14 @@ End;
NOTE: This just calls Arc
------------------------------------------------------------------------------}
Function TWin32Object.Pie(DC: HDC; X, Y, Width, Height, Angle1, Angle2: Integer): Boolean;
Function TWin32Object.Pie(DC: HDC;
X, Y, Width, Height, Angle1, Angle2: Integer): Boolean;
var
SX, SY, EX, EY : Longint;
Begin
Result := Arc(DC, X, Y, Width, Height, Angle1, Angle2);
// Old: Result := Arc(DC, X, Y, Width, Height, Angle1, Angle2);
Angles2Coords(X,Y,Width,Height,Angle1,Angle2, SX, SY, EX, EY);
Result := Windows.Pie(DC, X, Y, X+Width, Y+Height, SX,SY,EX,EY);
End;
{------------------------------------------------------------------------------
@ -1851,6 +1877,9 @@ End;
{ =============================================================================
$Log$
Revision 1.11 2002/08/08 18:05:48 lazarus
MG: added graphics extensions from Andrew Johnson
Revision 1.10 2002/05/13 22:00:24 lazarus
Keith: Implemented GetWindowSize

4
lcl/interfaces/win32/win32winapih.inc
View File

@ -20,6 +20,7 @@
//##apiwiz##sps## // Do not remove
Function Arc(DC: HDC; X, Y, Width, Height, Angle1, Angle2: Integer): Boolean; Override;
function AngleChord(DC: HDC; x,y,width,height,angle1,angle2 : Integer): Boolean; override;
Function BitBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc: Integer; Rop: DWORD): Boolean; Override;
Function BringWindowToTop(HWnd: HWND): Boolean; Override;
@ -151,6 +152,9 @@ Function WindowFromPoint(Point: TPoint): HWND; Override;
{ =============================================================================
$Log$
Revision 1.8 2002/08/08 18:05:48 lazarus
MG: added graphics extensions from Andrew Johnson
Revision 1.7 2002/05/13 22:00:25 lazarus
Keith: Implemented GetWindowSize