mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-13 06:29:32 +02:00
* initial advanced records support for TSize..TRect and -F.
git-svn-id: trunk@32333 -
This commit is contained in:
marco
parent
7d2c723a54
commit
92960ff3ac
@ -15,7 +15,8 @@
|
||||
unit Types;
|
||||
|
||||
interface
|
||||
|
||||
{$modeswitch advancedrecords}
|
||||
{$modeswitch class}
|
||||
{$ifdef Windows}
|
||||
uses
|
||||
Windows;
|
||||
@ -68,63 +69,75 @@ type
|
||||
{$endif}
|
||||
|
||||
{$ifdef Windows}
|
||||
TSmallPoint = Windows.TSmallPoint;
|
||||
PSmallPoint = Windows.PSmallPoint;
|
||||
|
||||
TSize = Windows.TSize;
|
||||
PSize = Windows.PSize;
|
||||
|
||||
TPoint = Windows.TPoint;
|
||||
PPoint = Windows.PPoint;
|
||||
|
||||
TRect = Windows.TRect;
|
||||
PRect = Windows.PRect;
|
||||
{$else}
|
||||
TPoint =
|
||||
{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
|
||||
packed
|
||||
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
|
||||
record
|
||||
X : Longint;
|
||||
Y : Longint;
|
||||
end;
|
||||
{$i typshrdh.inc}
|
||||
{$endif}
|
||||
PPoint = ^TPoint;
|
||||
tagPOINT = TPoint;
|
||||
|
||||
{$ifdef Windows}
|
||||
TRect = Windows.TRect;
|
||||
{$else}
|
||||
TRect =
|
||||
{ TPointF }
|
||||
TPointF =
|
||||
{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
|
||||
packed
|
||||
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
|
||||
record
|
||||
x,y : Single;
|
||||
public
|
||||
function Add(const apt: TPoint): TPointF;
|
||||
function Add(const apt: TPointF): TPointF;
|
||||
function Distance(const apt : TPointF) : Single;
|
||||
function DotProduct(const apt : TPointF) : Single;
|
||||
function IsZero : Boolean;
|
||||
function Subtract(const apt : TPointF): TPointF;
|
||||
function Subtract(const apt : TPoint): TPointF;
|
||||
procedure SetLocation(const apt :TPointF);
|
||||
procedure SetLocation(const apt :TPoint);
|
||||
procedure SetLocation(ax,ay : Longint);
|
||||
procedure Offset(const apt :TPointF);
|
||||
procedure Offset(const apt :TPoint);
|
||||
procedure Offset(dx,dy : Longint);
|
||||
|
||||
function Scale (afactor:Single) : TPointF;
|
||||
function Ceiling : TPoint;
|
||||
function Truncate: TPoint;
|
||||
function Floor : TPoint;
|
||||
function Round : TPoint;
|
||||
function Length : Single;
|
||||
class operator = (const apt1, apt2 : TPointF) : Boolean;
|
||||
class operator <> (const apt1, apt2 : TPointF): Boolean;
|
||||
class operator + (const apt1, apt2 : TPointF): TPointF;
|
||||
class operator - (const apt1, apt2 : TPointF): TPointF;
|
||||
end;
|
||||
{ TRectF }
|
||||
|
||||
TRectF =
|
||||
{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
|
||||
packed
|
||||
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
|
||||
record
|
||||
private
|
||||
function GetHeight: Single; inline;
|
||||
function GetWidth: Single; inline;
|
||||
procedure SetHeight(AValue: Single);
|
||||
procedure SetWidth (AValue: Single);
|
||||
public
|
||||
function Union (const r: TRectF):TRectF; inline;
|
||||
procedure Offset (const dx,dy : Single); inline;
|
||||
property Width : Single read GetWidth write SetWidth;
|
||||
property Height : Single read GetHeight write SetHeight;
|
||||
case Integer of
|
||||
0: (Left,Top,Right,Bottom : Longint);
|
||||
1: (TopLeft,BottomRight : TPoint);
|
||||
0: (Left, Top, Right, Bottom: Single);
|
||||
1: (TopLeft, BottomRight: TPointF);
|
||||
end;
|
||||
{$endif Windows}
|
||||
PRect = ^TRect;
|
||||
|
||||
{$ifdef Windows}
|
||||
TSize = Windows.TSize;
|
||||
{$else}
|
||||
TSize =
|
||||
{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
|
||||
packed
|
||||
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
|
||||
record
|
||||
cx : Longint;
|
||||
cy : Longint;
|
||||
end;
|
||||
{$endif Windows}
|
||||
|
||||
|
||||
PSize = ^TSize;
|
||||
tagSIZE = TSize;
|
||||
// SIZE = TSize;
|
||||
|
||||
|
||||
TSmallPoint =
|
||||
{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
|
||||
packed
|
||||
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
|
||||
record
|
||||
x : SmallInt;
|
||||
y : SmallInt;
|
||||
end;
|
||||
PSmallPoint = ^TSmallPoint;
|
||||
|
||||
TDuplicates = (dupIgnore, dupAccept, dupError);
|
||||
|
||||
@ -309,6 +322,11 @@ function Size(const ARect: TRect): TSize;
|
||||
|
||||
implementation
|
||||
|
||||
Uses Math;
|
||||
|
||||
{$ifndef Windows}
|
||||
{$i typshrd.inc}
|
||||
{$endif}
|
||||
|
||||
function EqualRect(const r1,r2 : TRect) : Boolean;
|
||||
|
||||
@ -316,7 +334,6 @@ begin
|
||||
EqualRect:=(r1.left=r2.left) and (r1.right=r2.right) and (r1.top=r2.top) and (r1.bottom=r2.bottom);
|
||||
end;
|
||||
|
||||
|
||||
function Rect(Left,Top,Right,Bottom : Integer) : TRect;
|
||||
|
||||
begin
|
||||
@ -326,7 +343,6 @@ begin
|
||||
Rect.Bottom:=Bottom;
|
||||
end;
|
||||
|
||||
|
||||
function Bounds(ALeft,ATop,AWidth,AHeight : Integer) : TRect;
|
||||
|
||||
begin
|
||||
@ -336,7 +352,6 @@ begin
|
||||
Bounds.Bottom:=ATop+AHeight;
|
||||
end;
|
||||
|
||||
|
||||
function Point(x,y : Integer) : TPoint; inline;
|
||||
|
||||
begin
|
||||
@ -353,7 +368,6 @@ begin
|
||||
(p.x<Rect.Right);
|
||||
end;
|
||||
|
||||
|
||||
function IntersectRect(var Rect : TRect;const R1,R2 : TRect) : Boolean;
|
||||
var
|
||||
lRect: TRect;
|
||||
@ -478,5 +492,171 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
{ TPointF}
|
||||
|
||||
function TPointF.Add(const apt: TPoint): TPointF;
|
||||
begin
|
||||
result.x:=x+apt.x;
|
||||
result.y:=y+apt.y;
|
||||
end;
|
||||
|
||||
function TPointF.Add(const apt: TPointF): TPointF;
|
||||
begin
|
||||
result.x:=x+apt.x;
|
||||
result.y:=y+apt.y;
|
||||
end;
|
||||
|
||||
function TPointF.Subtract(const apt : TPointF): TPointF;
|
||||
begin
|
||||
result.x:=x-apt.x;
|
||||
result.y:=y-apt.y;
|
||||
end;
|
||||
|
||||
function TPointF.Subtract(const apt: TPoint): TPointF;
|
||||
begin
|
||||
result.x:=x-apt.x;
|
||||
result.y:=y-apt.y;
|
||||
end;
|
||||
|
||||
function TPointF.Distance(const apt : TPointF) : Single;
|
||||
begin
|
||||
result:=sqrt(sqr(apt.x-x)+sqr(apt.y-y));
|
||||
end;
|
||||
|
||||
function TPointF.DotProduct(const apt: TPointF): Single;
|
||||
begin
|
||||
result:=x*apt.x+y*apt.y;
|
||||
end;
|
||||
|
||||
function TPointF.IsZero : Boolean;
|
||||
begin
|
||||
result:=SameValue(x,0.0) and SameValue(y,0.0);
|
||||
end;
|
||||
|
||||
procedure TPointF.Offset(const apt :TPointF);
|
||||
begin
|
||||
x:=x+apt.x;
|
||||
y:=y+apt.y;
|
||||
end;
|
||||
|
||||
procedure TPointF.Offset(const apt: TPoint);
|
||||
begin
|
||||
x:=x+apt.x;
|
||||
y:=y+apt.y;
|
||||
end;
|
||||
|
||||
procedure TPointF.Offset(dx,dy : Longint);
|
||||
begin
|
||||
x:=x+dx;
|
||||
y:=y+dy;
|
||||
end;
|
||||
|
||||
function TPointF.Scale(afactor: Single): TPointF;
|
||||
begin
|
||||
result.x:=afactor*x;
|
||||
result.y:=afactor*y;
|
||||
end;
|
||||
|
||||
function TPointF.Ceiling: TPoint;
|
||||
begin
|
||||
result.x:=ceil(x);
|
||||
result.y:=ceil(y);
|
||||
end;
|
||||
|
||||
function TPointF.Truncate: TPoint;
|
||||
begin
|
||||
result.x:=trunc(x);
|
||||
result.y:=trunc(y);
|
||||
end;
|
||||
|
||||
function TPointF.Floor: TPoint;
|
||||
begin
|
||||
result.x:=Math.floor(x);
|
||||
result.y:=Math.floor(y);
|
||||
end;
|
||||
|
||||
function TPointF.Round: TPoint;
|
||||
begin
|
||||
result.x:=System.round(x);
|
||||
result.y:=System.round(y);
|
||||
end;
|
||||
|
||||
function TPointF.Length: Single;
|
||||
begin //distance(self) ?
|
||||
result:=sqrt(sqr(x)+sqr(y));
|
||||
end;
|
||||
|
||||
class operator TPointF.= (const apt1, apt2 : TPointF) : Boolean;
|
||||
begin
|
||||
result:=SameValue(apt1.x,apt2.x) and SameValue(apt1.y,apt2.y);
|
||||
end;
|
||||
|
||||
class operator TPointF.<> (const apt1, apt2 : TPointF): Boolean;
|
||||
begin
|
||||
result:=NOT (SameValue(apt1.x,apt2.x) and Samevalue(apt1.y,apt2.y));
|
||||
end;
|
||||
|
||||
class operator TPointF.+ (const apt1, apt2 : TPointF): TPointF;
|
||||
begin
|
||||
result.x:=apt1.x+apt2.x;
|
||||
result.y:=apt1.y+apt2.y;
|
||||
end;
|
||||
|
||||
class operator TPointF.- (const apt1, apt2 : TPointF): TPointF;
|
||||
begin
|
||||
result.x:=apt1.x-apt2.x;
|
||||
result.y:=apt1.y-apt2.y;
|
||||
end;
|
||||
|
||||
procedure TPointF.SetLocation(const apt :TPointF);
|
||||
begin
|
||||
x:=apt.x; y:=apt.y;
|
||||
end;
|
||||
|
||||
procedure TPointF.SetLocation(const apt: TPoint);
|
||||
begin
|
||||
x:=apt.x; y:=apt.y;
|
||||
end;
|
||||
|
||||
procedure TPointF.SetLocation(ax,ay : Longint);
|
||||
begin
|
||||
x:=ax; y:=ay;
|
||||
end;
|
||||
|
||||
{ TRectF }
|
||||
|
||||
function TRectF.GetHeight: Single;
|
||||
begin
|
||||
result:=bottom-top;
|
||||
end;
|
||||
|
||||
function TRectF.GetWidth: Single;
|
||||
begin
|
||||
result:=right-left;
|
||||
end;
|
||||
|
||||
procedure TRectF.SetHeight(AValue: Single);
|
||||
begin
|
||||
bottom:=top+avalue;
|
||||
end;
|
||||
|
||||
procedure TRectF.SetWidth(AValue: Single);
|
||||
begin
|
||||
right:=left+avalue;
|
||||
end;
|
||||
|
||||
function TRectF.Union(const r: TRectF): TRectF;
|
||||
begin
|
||||
result.left:=min(r.left,left);
|
||||
result.top:=min(r.top,top);
|
||||
result.right:=min(r.right,right);
|
||||
result.bottom:=min(r.bottom,bottom);
|
||||
end;
|
||||
|
||||
procedure TRectF.Offset(const dx, dy: Single);
|
||||
begin
|
||||
left:=left+dx; right:=right+dx;
|
||||
bottom:=bottom+dy; top:=top+dy;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -1076,14 +1076,20 @@ end;
|
||||
|
||||
{$pop}
|
||||
|
||||
function ExecuteProcess(Const Path: AnsiString; Const ComLine: AnsiString;Flags:TExecuteFlags=[]):integer;
|
||||
function ExecuteProcess(Const Path: RawByteString; Const ComLine: RawByteString;Flags:TExecuteFlags=[]):integer;
|
||||
begin
|
||||
result:=ExecuteProcess(Unicodestring(Path),UnicodeString(ComLine),Flags);
|
||||
end;
|
||||
|
||||
|
||||
function ExecuteProcess(Const Path: UnicodeString; Const ComLine: UnicodeString;Flags:TExecuteFlags=[]):integer;
|
||||
// win specific function
|
||||
var
|
||||
SI: TStartupInfo;
|
||||
SI: TStartupInfoW;
|
||||
PI: TProcessInformation;
|
||||
Proc : THandle;
|
||||
l : DWord;
|
||||
CommandLine : ansistring;
|
||||
CommandLine : unicodestring;
|
||||
e : EOSError;
|
||||
ExecInherits : longbool;
|
||||
begin
|
||||
@ -1106,7 +1112,7 @@ begin
|
||||
|
||||
ExecInherits:=ExecInheritsHandles in Flags;
|
||||
|
||||
if not CreateProcessA(nil, pchar(CommandLine),
|
||||
if not CreateProcessW(nil, pwidechar(CommandLine),
|
||||
Nil, Nil, ExecInherits,$20, Nil, Nil, SI, PI) then
|
||||
begin
|
||||
e:=EOSError.CreateFmt(SExecuteProcessFailed,[CommandLine,GetLastError]);
|
||||
@ -1131,10 +1137,11 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function ExecuteProcess(Const Path: AnsiString; Const ComLine: Array of AnsiString;Flags:TExecuteFlags=[]):integer;
|
||||
|
||||
function ExecuteProcess(Const Path: RawByteString; Const ComLine: Array of RawByteString;Flags:TExecuteFlags=[]):integer;
|
||||
|
||||
var
|
||||
CommandLine: AnsiString;
|
||||
CommandLine: UnicodeString;
|
||||
I: integer;
|
||||
|
||||
begin
|
||||
@ -1144,7 +1151,23 @@ begin
|
||||
CommandLine := CommandLine + ' ' + '"' + ComLine [I] + '"'
|
||||
else
|
||||
CommandLine := CommandLine + ' ' + Comline [I];
|
||||
ExecuteProcess := ExecuteProcess (Path, CommandLine,Flags);
|
||||
ExecuteProcess := ExecuteProcess (UnicodeString(Path), CommandLine,Flags);
|
||||
end;
|
||||
|
||||
function ExecuteProcess(Const Path: UnicodeString; Const ComLine: Array of UnicodeString;Flags:TExecuteFlags=[]):integer;
|
||||
|
||||
var
|
||||
CommandLine: UnicodeString;
|
||||
I: integer;
|
||||
|
||||
begin
|
||||
Commandline := '';
|
||||
for I := 0 to High (ComLine) do
|
||||
if Pos (' ', ComLine [I]) <> 0 then
|
||||
CommandLine := CommandLine + ' ' + '"' + ComLine [I] + '"'
|
||||
else
|
||||
CommandLine := CommandLine + ' ' + Comline [I];
|
||||
ExecuteProcess := ExecuteProcess (Path,CommandLine,Flags);
|
||||
end;
|
||||
|
||||
Procedure Sleep(Milliseconds : Cardinal);
|
||||
|
||||
@ -284,7 +284,7 @@
|
||||
Enumerations
|
||||
}
|
||||
|
||||
ACL_INFORMATION_CLASS = (AclRevisionInformation := 1,AclSizeInformation
|
||||
ACL_INFORMATION_CLASS = (AclRevisionInformation = 1,AclSizeInformation
|
||||
);
|
||||
|
||||
_ACL_INFORMATION_CLASS = ACL_INFORMATION_CLASS;
|
||||
@ -302,7 +302,7 @@
|
||||
|
||||
type
|
||||
|
||||
RASCONNSTATE = (RASCS_OpenPort := 0,RASCS_PortOpened,
|
||||
RASCONNSTATE = (RASCS_OpenPort = 0,RASCS_PortOpened,
|
||||
RASCS_ConnectDevice,RASCS_DeviceConnected,
|
||||
RASCS_AllDevicesConnected,RASCS_Authenticate,
|
||||
RASCS_AuthNotify,RASCS_AuthRetry,RASCS_AuthCallback,
|
||||
@ -312,15 +312,15 @@
|
||||
RASCS_WaitForModemReset,RASCS_WaitForCallback,
|
||||
RASCS_Projected,RASCS_StartAuthentication,
|
||||
RASCS_CallbackComplete,RASCS_LogonNetwork,
|
||||
RASCS_Interactive := RASCS_PAUSED,RASCS_RetryAuthentication,
|
||||
RASCS_Interactive = RASCS_PAUSED,RASCS_RetryAuthentication,
|
||||
RASCS_CallbackSetByCaller,RASCS_PasswordExpired,
|
||||
RASCS_Connected := RASCS_DONE,RASCS_Disconnected
|
||||
RASCS_Connected = RASCS_DONE,RASCS_Disconnected
|
||||
);
|
||||
|
||||
_RASCONNSTATE = RASCONNSTATE;
|
||||
|
||||
RASPROJECTION = (RASP_PppIp := $8021, RASP_PppIpx := $802B, RASP_PppNbf := $803F,
|
||||
RASP_Amb := $10000);
|
||||
RASPROJECTION = (RASP_PppIp = $8021, RASP_PppIpx = $802B, RASP_PppNbf = $803F,
|
||||
RASP_Amb = $10000);
|
||||
|
||||
_RASPROJECTION = RASPROJECTION;
|
||||
|
||||
@ -330,7 +330,7 @@
|
||||
|
||||
_SECURITY_IMPERSONATION_LEVEL = SECURITY_IMPERSONATION_LEVEL;
|
||||
|
||||
SID_NAME_USE = (SidTypeUser := 1,SidTypeGroup,SidTypeDomain,
|
||||
SID_NAME_USE = (SidTypeUser = 1,SidTypeGroup,SidTypeDomain,
|
||||
SidTypeAlias,SidTypeWellKnownGroup,SidTypeDeletedAccount,
|
||||
SidTypeInvalid,SidTypeUnknown);
|
||||
|
||||
@ -404,7 +404,7 @@
|
||||
FINDEX_SEARCH_OPS = _FINDEX_SEARCH_OPS;
|
||||
PFINDEX_SEARCH_OPS = ^TFINDEX_SEARCH_OPS;
|
||||
|
||||
PARTITION_STYLE = (PARTITION_STYLE_MBR:=0,PARTITION_STYLE_GPT,PARTITION_STYLE_RAW);
|
||||
PARTITION_STYLE = (PARTITION_STYLE_MBR=0,PARTITION_STYLE_GPT,PARTITION_STYLE_RAW);
|
||||
TPARTITION_STYLE = PARTITION_STYLE;
|
||||
PPARTITION_STYLE = ^TPARTITION_STYLE;
|
||||
|
||||
|
||||
@ -50,6 +50,7 @@ Const
|
||||
IMAGE_SIZEOF_SHORT_NAME = 8;
|
||||
|
||||
type
|
||||
{$I typshrdh.inc}
|
||||
|
||||
{ WARNING
|
||||
the variable argument list
|
||||
@ -214,24 +215,14 @@ Const
|
||||
TANIMATIONINFO = ANIMATIONINFO;
|
||||
PANIMATIONINFO = ^ANIMATIONINFO;
|
||||
|
||||
POINT = record
|
||||
x : LONG;
|
||||
y : LONG;
|
||||
end;
|
||||
LPPOINT = ^POINT;
|
||||
tagPOINT = POINT;
|
||||
TPOINT = POINT;
|
||||
PPOINT = ^POINT;
|
||||
POINT = TPOINT;
|
||||
LPPOINT = PPOINT;
|
||||
tagPOINT = TPOINT;
|
||||
|
||||
RECT = record
|
||||
case Integer of
|
||||
0: (Left,Top,Right,Bottom : Longint);
|
||||
1: (TopLeft,BottomRight : TPoint);
|
||||
end;
|
||||
LPRECT = ^RECT;
|
||||
|
||||
RECT = TRect;
|
||||
LPRECT = PRECT;
|
||||
_RECT = RECT;
|
||||
TRECT = RECT;
|
||||
PRECT = ^RECT;
|
||||
|
||||
RECTL = record
|
||||
left : LONG;
|
||||
@ -494,12 +485,6 @@ Const
|
||||
TPOINTL = POINTL;
|
||||
PPOINTL = ^POINTL;
|
||||
|
||||
TSmallPoint = record
|
||||
X,
|
||||
Y : SHORT;
|
||||
end;
|
||||
|
||||
|
||||
POINTS = record
|
||||
x : SHORT;
|
||||
y : SHORT;
|
||||
@ -2950,14 +2935,9 @@ Const
|
||||
TEMRFORMAT = EMRFORMAT;
|
||||
PEMRFORMAT = ^EMRFORMAT;
|
||||
|
||||
SIZE = record
|
||||
cx : LONG;
|
||||
cy : LONG;
|
||||
end;
|
||||
LPSIZE = ^SIZE;
|
||||
SIZE = TSize;
|
||||
LPSIZE = PSIZE;
|
||||
tagSIZE = SIZE;
|
||||
TSIZE = SIZE;
|
||||
PSIZE = ^SIZE;
|
||||
|
||||
SIZEL = SIZE;
|
||||
TSIZEL = SIZE;
|
||||
@ -9111,5 +9091,6 @@ type
|
||||
a.flag0:=a.flag0 or ((__fAckReq shl bp_DDEUP_fAckReq) and bm_DDEUP_fAckReq);
|
||||
end;
|
||||
|
||||
{$i typshrd.inc}
|
||||
{$endif read_implementation}
|
||||
|
||||
|
||||
@ -22,6 +22,8 @@ unit windows;
|
||||
|
||||
{ stuff like array of const is used }
|
||||
{$mode objfpc}
|
||||
{$modeswitch ADVANCEDRECORDS}
|
||||
{$modeswitch class}
|
||||
{$inline on}
|
||||
{$calling stdcall}
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user