Browse Source

* initial advanced records support for TSize..TRect and -F.

git-svn-id: trunk@32333 -
marco 9 years ago
parent
commit
92960ff3ac
5 changed files with 280 additions and 94 deletions
  1. 230 50
      rtl/objpas/types.pp
  2. 30 7
      rtl/win/sysutils.pp
  3. 8 8
      rtl/win/wininc/base.inc
  4. 10 29
      rtl/win/wininc/struct.inc
  5. 2 0
      rtl/win32/windows.pp

+ 230 - 50
rtl/objpas/types.pp

@@ -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;
-{$else}
-  TPoint =
-{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
-  packed
-{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
-  record
-    X : Longint;
-    Y : Longint;
-  end;
-{$endif}
-  PPoint = ^TPoint;
-  tagPOINT = TPoint;
+  PPoint = Windows.PPoint;
 
-{$ifdef Windows}
-  TRect = Windows.TRect;
+  TRect  = Windows.TRect;
+  PRect  = Windows.PRect;
 {$else}
-  TRect =
-{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
-  packed
-{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
-  record
-    case Integer of
-      0: (Left,Top,Right,Bottom : Longint);
-      1: (TopLeft,BottomRight : TPoint);
-    end;
-{$endif Windows}
-  PRect = ^TRect;
+  {$i typshrdh.inc}
+{$endif}
 
-{$ifdef Windows}
-  TSize = Windows.TSize;
-{$else}
-  TSize =
+  { TPointF }
+  TPointF =
 {$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 =
+       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
-     x : SmallInt;
-     y : SmallInt;
-  end;
-  PSmallPoint = ^TSmallPoint;
+  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: Single);
+     1: (TopLeft, BottomRight: TPointF);
+    end;
 
   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.

+ 30 - 7
rtl/win/sysutils.pp

@@ -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,27 @@ 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: 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 (UnicodeString(Path), CommandLine,Flags);
+end;
+
+function ExecuteProcess(Const Path: UnicodeString; Const ComLine: Array of UnicodeString;Flags:TExecuteFlags=[]):integer;
 
 var
-  CommandLine: AnsiString;
+  CommandLine: UnicodeString;
   I: integer;
 
 begin
@@ -1144,7 +1167,7 @@ begin
     CommandLine := CommandLine + ' ' + '"' + ComLine [I] + '"'
    else
     CommandLine := CommandLine + ' ' + Comline [I];
-  ExecuteProcess := ExecuteProcess (Path, CommandLine,Flags);
+  ExecuteProcess := ExecuteProcess (Path,CommandLine,Flags);
 end;
 
 Procedure Sleep(Milliseconds : Cardinal);

+ 8 - 8
rtl/win/wininc/base.inc

@@ -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;
 

+ 10 - 29
rtl/win/wininc/struct.inc

@@ -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}
 

+ 2 - 0
rtl/win32/windows.pp

@@ -22,6 +22,8 @@ unit windows;
 
 { stuff like array of const is used }
 {$mode objfpc}
+{$modeswitch ADVANCEDRECORDS}
+{$modeswitch class}
 {$inline on}
 {$calling stdcall}