# revisions: 33030,33056,33057,33100,33101

git-svn-id: branches/fixes_3_0@33799 -

rtl/inc/typshrd.inc

@@ -380,7 +380,7 @@ end;
 
 procedure TRect.setHeight(AValue: Longint);
 begin
-  right:=left+avalue;
+  bottom:=top+avalue;
 end;
 
 procedure TRect.SetLocation(X, Y: Longint);
@@ -401,7 +401,7 @@ end;
 
 procedure TRect.setWidth(AValue: Longint);
 begin
-  bottom:=top+avalue;
+  right:=left+avalue;
 end;
 
 function TRect.SplitRect(SplitType: TSplitRectType; Percent: Double): TRect;

rtl/inc/ustringh.inc

@@ -16,12 +16,12 @@
 
 
 Procedure UniqueString (Var S : UnicodeString);external name 'FPC_UNICODESTR_UNIQUE';
-Function Pos (Const Substr : UnicodeString; Const Source : UnicodeString) : SizeInt;
-Function Pos (c : Char; Const s : UnicodeString) : SizeInt;
-Function Pos (c : UnicodeChar; Const s : UnicodeString) : SizeInt;
-Function Pos (const c : RawByteString; Const s : UnicodeString) : SizeInt;
-Function Pos (const c : UnicodeString; Const s : RawByteString) : SizeInt;
-Function Pos (const c : ShortString; Const s : UnicodeString) : SizeInt;
+Function Pos (Const Substr : UnicodeString; Const Source : UnicodeString; Offset: Sizeint = 1) : SizeInt;
+Function Pos (c : Char; Const s : UnicodeString; Offset: Sizeint = 1) : SizeInt;
+Function Pos (c : UnicodeChar; Const s : UnicodeString; Offset: Sizeint = 1) : SizeInt;
+Function Pos (const c : RawByteString; Const s : UnicodeString; Offset: Sizeint = 1) : SizeInt;
+Function Pos (const c : UnicodeString; Const s : RawByteString; Offset: Sizeint = 1) : SizeInt;
+Function Pos (const c : ShortString; Const s : UnicodeString; Offset: Sizeint = 1) : SizeInt;
 
 Function UpCase(const s : UnicodeString) : UnicodeString;
 Function  UpCase(c:UnicodeChar):UnicodeChar;

rtl/inc/ustrings.inc

@@ -1160,7 +1160,7 @@ end;
 
 {$ifndef FPC_HAS_POS_UNICODESTR_UNICODESTR}
 {$define FPC_HAS_POS_UNICODESTR_UNICODESTR}
-Function Pos (Const Substr : UnicodeString; Const Source : UnicodeString) : SizeInt;
+Function Pos (Const Substr : UnicodeString; Const Source : UnicodeString; Offset: Sizeint = 1) : SizeInt;
 var
   i,MaxLen : SizeInt;
   pc : punicodechar;
@@ -1168,9 +1168,9 @@ begin
   Pos:=0;
   if Length(SubStr)>0 then
    begin
-     MaxLen:=Length(source)-Length(SubStr);
+     MaxLen:=Length(source)-Length(SubStr)-(OffSet-1);
      i:=0;
-     pc:=@source[1];
+     pc:=@source[OffSet];
      while (i<=MaxLen) do
       begin
         inc(i);
@@ -1190,13 +1190,13 @@ end;
 {$ifndef FPC_HAS_POS_UNICODECHAR_UNICODESTR}
 {$define FPC_HAS_POS_UNICODECHAR_UNICODESTR}
 { Faster version for a unicodechar alone }
-Function Pos (c : UnicodeChar; Const s : UnicodeString) : SizeInt;
+Function Pos (c : UnicodeChar; Const s : UnicodeString; Offset: Sizeint = 1) : SizeInt;
 var
   i: SizeInt;
   pc : punicodechar;
 begin
-  pc:=@s[1];
-  for i:=1 to length(s) do
+  pc:=@s[OffSet];
+  for i:=OffSet to length(s) do
    begin
      if pc^=c then
       begin
@@ -1212,21 +1212,21 @@ end;
 
 { DO NOT inline these! Inlining a managed typecast creates an implicit try..finally
   block, which is significant bloat without any sensible speed improvement. }
-Function Pos (const c : RawByteString; Const s : UnicodeString) : SizeInt;
+Function Pos (const c : RawByteString; Const s : UnicodeString; Offset: Sizeint = 1) : SizeInt;
   begin
-    result:=Pos(UnicodeString(c),s);
+    result:=Pos(UnicodeString(c),s,offset);
   end;
 
 
-Function Pos (const c : ShortString; Const s : UnicodeString) : SizeInt;
+Function Pos (const c : ShortString; Const s : UnicodeString; Offset: Sizeint = 1) : SizeInt;
   begin
-    result:=Pos(UnicodeString(c),s);
+    result:=Pos(UnicodeString(c),s,OffSet);
   end;
 
 
-Function Pos (const c : UnicodeString; Const s : RawByteString) : SizeInt;
+Function Pos (const c : UnicodeString; Const s : RawByteString; Offset: Sizeint = 1) : SizeInt;
   begin
-    result:=Pos(c,UnicodeString(s));
+    result:=Pos(c,UnicodeString(s),OffSet);
   end;
 
 {$ifndef FPC_HAS_POS_CHAR_UNICODESTR}
@@ -1235,15 +1235,15 @@ Function Pos (const c : UnicodeString; Const s : RawByteString) : SizeInt;
 { pos(c: char; const s: shortstring) also exists, so otherwise   }
 { using pos(char,pchar) will always call the shortstring version }
 { (exact match for first argument), also with $h+ (JM)           }
-Function Pos (c : Char; Const s : UnicodeString) : SizeInt;
+Function Pos (c : Char; Const s : UnicodeString; Offset: Sizeint = 1) : SizeInt;
 var
   i: SizeInt;
   wc : unicodechar;
   pc : punicodechar;
 begin
   wc:=c;
-  pc:=@s[1];
-  for i:=1 to length(s) do
+  pc:=@s[OffSet];
+  for i:=OffSet to length(s) do
    begin
      if pc^=wc then
       begin

rtl/inc/wstrings.inc

@@ -586,7 +586,7 @@ begin
   Pos:=0;
   if Length(SubStr)>0 then
    begin
-     MaxLen:=Length(source)-Length(SubStr);
+     MaxLen:=Length(source)-Length(SubStr)-(OffSet-1);
      i:=0;
      pc:=@source[1];
      while (i<=MaxLen) do

rtl/objpas/classes/classes.inc

@@ -644,6 +644,202 @@ begin
   Result := SysUtils.GetTickCount64;
 end;
 
+{ TSimpleThread allows objects to create a threading method without defining 
+  a new thread class }
+
+Type
+  TSimpleThread = class(TThread)
+  private
+    FExecuteMethod: TThreadExecuteHandler;
+  protected
+    procedure Execute; override;
+  public
+    constructor Create(ExecuteMethod: TThreadExecuteHandler; AOnterminate : TNotifyEvent);
+  end;
+
+  TSimpleStatusThread = class(TThread)
+  private
+    FExecuteMethod: TThreadExecuteStatusHandler;
+    FStatus : String;
+    FOnStatus : TThreadStatusNotifyEvent;
+  protected
+    procedure Execute; override;
+    Procedure DoStatus;
+    Procedure SetStatus(Const AStatus : String);
+  public
+    constructor Create(ExecuteMethod: TThreadExecuteStatusHandler; AOnStatus : TThreadStatusNotifyEvent; AOnterminate : TNotifyEvent);
+  end;
+
+  TSimpleProcThread = class(TThread)
+  private
+    FExecuteMethod: TThreadExecuteCallBack;
+    FCallOnTerminate : TNotifyCallBack;
+    FData : Pointer;
+  protected
+    Procedure TerminateCallBack(Sender : TObject);
+    procedure Execute; override;
+  public
+    constructor Create(ExecuteMethod: TThreadExecuteCallBack; AData : Pointer; AOnterminate : TNotifyCallBack);
+  end;
+
+  TSimpleStatusProcThread = class(TThread)
+  private
+    FExecuteMethod: TThreadExecuteStatusCallBack;
+    FCallOnTerminate : TNotifyCallBack;
+    FStatus : String;
+    FOnStatus : TThreadStatusNotifyCallBack;
+    FData : Pointer;
+  protected
+    procedure Execute; override;
+    Procedure DoStatus;
+    Procedure SetStatus(Const AStatus : String);
+    Procedure TerminateCallBack(Sender : TObject);
+  public
+    constructor Create(ExecuteMethod: TThreadExecuteStatusCallBack; AData : Pointer; AOnStatus : TThreadStatusNotifyCallBack; AOnterminate : TNotifyCallBack);
+  end;
+
+
+{ TSimpleThread }
+ 
+constructor TSimpleThread.Create(ExecuteMethod: TThreadExecuteHandler; AOnTerminate: TNotifyEvent);
+begin
+  FExecuteMethod := ExecuteMethod;
+  OnTerminate := AOnTerminate;
+  inherited Create(False);
+end;
+
+procedure TSimpleThread.Execute;
+begin
+  FreeOnTerminate := True;
+  FExecuteMethod;
+end;
+
+{ TSimpleStatusThread }
+ 
+constructor TSimpleStatusThread.Create(ExecuteMethod: TThreadExecuteStatusHandler;AOnStatus : TThreadStatusNotifyEvent; AOnTerminate: TNotifyEvent);
+begin
+  FExecuteMethod := ExecuteMethod;
+  OnTerminate := AOnTerminate;
+  FOnStatus:=AOnStatus;
+  FStatus:='';
+  inherited Create(False);
+end;
+
+procedure TSimpleStatusThread.Execute;
+begin
+  FreeOnTerminate := True;
+  FExecuteMethod(@SetStatus);
+end;
+
+procedure TSimpleStatusThread.SetStatus(Const AStatus : String);
+begin
+  If (AStatus=FStatus) then 
+    exit;
+  FStatus:=AStatus;
+  If Assigned(FOnStatus) then  
+    Synchronize(@DoStatus);  
+end;
+
+procedure TSimpleStatusThread.DoStatus;
+begin
+   FOnStatus(Self,FStatus);
+end;
+
+
+{ TSimpleProcThread }
+ 
+constructor TSimpleProcThread.Create(ExecuteMethod: TThreadExecuteCallBack; AData : Pointer; AOnTerminate: TNotifyCallBack);
+begin
+  FExecuteMethod := ExecuteMethod;
+  FCallOnTerminate := AOnTerminate;
+  FData:=AData;
+  If Assigned(FCallOnTerminate) then
+    OnTerminate:=@TerminateCallBack;
+  inherited Create(False);
+end;
+
+procedure TSimpleProcThread.Execute;
+begin
+  FreeOnTerminate := True;
+  FExecuteMethod(FData);
+end;
+
+procedure TSimpleProcThread.TerminateCallBack(Sender : TObject);
+
+begin
+  if Assigned(FCallOnTerminate) then
+    FCallOnTerminate(Sender,FData);  
+end;
+
+{ TSimpleStatusProcThread }
+ 
+constructor TSimpleStatusProcThread.Create(ExecuteMethod: TThreadExecuteStatusCallback; AData : Pointer; AOnStatus : TThreadStatusNotifyCallBack; AOnTerminate: TNotifyCallBack);
+begin
+  FExecuteMethod := ExecuteMethod;
+  FCallOnTerminate := AOnTerminate;
+  FData:=AData;
+  If Assigned(FCallOnTerminate) then
+    OnTerminate:=@TerminateCallBack;
+  FOnStatus:=AOnStatus;
+  FStatus:='';
+  inherited Create(False);
+end;
+
+procedure TSimpleStatusProcThread.Execute;
+begin
+  FreeOnTerminate := True;
+  FExecuteMethod(FData,@SetStatus);
+end;
+
+procedure TSimpleStatusProcThread.SetStatus(Const AStatus : String);
+begin
+  If (AStatus=FStatus) then 
+    exit;
+  FStatus:=AStatus;
+  If Assigned(FOnStatus) then  
+    Synchronize(@DoStatus);  
+end;
+
+procedure TSimpleStatusProcThread.DoStatus;
+begin
+   FOnStatus(Self,FData,FStatus);
+end;
+
+procedure TSimpleStatusProcThread.TerminateCallBack(Sender : TObject);
+
+begin
+  if Assigned(FCallOnTerminate) then
+    FCallOnTerminate(Sender,FData);  
+end;
+
+
+Class Function TThread.ExecuteInThread(AMethod : TThreadExecuteHandler; AOnTerminate : TNotifyEvent = Nil) : TThread;
+
+begin
+  Result:=TSimpleThread.Create(AMethod,AOnTerminate);
+end;
+
+Class Function TThread.ExecuteInThread(AMethod : TThreadExecuteCallback; AData : Pointer; AOnTerminate : TNotifyCallback = Nil) : TThread;
+
+begin
+  Result:=TSimpleProcThread.Create(AMethod,AData,AOnTerminate);
+end;
+
+Class Function TThread.ExecuteInThread(AMethod : TThreadExecuteStatusHandler; AOnStatus : TThreadStatusNotifyEvent; AOnTerminate : TNotifyEvent = Nil) : TThread;
+
+begin
+  If Not Assigned(AOnStatus) then 
+    Raise EThread.Create(SErrStatusCallBackRequired);
+  Result:=TSimpleStatusThread.Create(AMethod,AOnStatus,AOnTerminate);
+end;
+
+Class Function TThread.ExecuteInThread(AMethod : TThreadExecuteStatusCallback; AOnStatus : TThreadStatusNotifyCallback;AData : Pointer = Nil;  AOnTerminate : TNotifyCallBack = Nil) : TThread;
+
+begin
+  If Not Assigned(AOnStatus) then 
+    Raise EThread.Create(SErrStatusCallBackRequired);
+  Result:=TSimpleStatusProcThread.Create(AMethod,AData,AOnStatus,AOnTerminate);
+end;
 
 { TPersistent implementation }
 {$i persist.inc }

rtl/objpas/classes/classesh.inc

@@ -1558,13 +1558,25 @@ type
   end;
 
 { TThread }
-
+  TThread = Class;
+  
   EThread = class(Exception);
   EThreadExternalException = class(EThread);
   EThreadDestroyCalled = class(EThread);
   TSynchronizeProcVar = procedure;
   TThreadMethod = procedure of object;
-
+  
+  TThreadReportStatus = Procedure(Const status : String) of Object;
+
+  TThreadStatusNotifyEvent = Procedure(Sender : TThread; Const status : String) of Object;
+  TThreadExecuteHandler = TThreadMethod;
+  TThreadExecuteStatusHandler = Procedure(ReportStatus : TThreadReportStatus) of object;
+
+  TNotifyCallBack = Procedure(Sender : TObject; AData : Pointer);
+  TThreadStatusNotifyCallBack = Procedure(Sender : TThread; AData : Pointer; Const status : String);
+  TThreadExecuteCallBack = Procedure(AData : Pointer);
+  TThreadExecuteStatusCallBack = Procedure(AData : Pointer; ReportStatus : TThreadReportStatus);
+  
   TThreadPriority = (tpIdle, tpLowest, tpLower, tpNormal, tpHigher, tpHighest,
     tpTimeCritical);
 
@@ -1674,6 +1686,12 @@ type
     class procedure GetSystemTimes(out aSystemTimes: TSystemTimes); static;
     class function GetTickCount: LongWord; static; deprecated 'Use TThread.GetTickCount64 instead';
     class function GetTickCount64: QWord; static;
+    // Object based
+    Class Function ExecuteInThread(AMethod : TThreadExecuteHandler; AOnTerminate : TNotifyEvent = Nil) : TThread; overload; static;
+    Class Function ExecuteInThread(AMethod : TThreadExecuteStatusHandler; AOnStatus : TThreadStatusNotifyEvent; AOnTerminate : TNotifyEvent = Nil) : TThread; overload;static;
+    // Plain methods.
+    Class Function ExecuteInThread(AMethod : TThreadExecuteCallback; AData : Pointer = Nil; AOnTerminate: TNotifyCallBack = Nil) : TThread; overload;static;
+    Class Function ExecuteInThread(AMethod : TThreadExecuteStatusCallback; AOnStatus : TThreadStatusNotifyCallback; AData : Pointer = Nil; AOnTerminate : TNotifyCallBack = Nil) : TThread; overload;static;
     procedure AfterConstruction; override;
     procedure Start;
     procedure Resume; deprecated;

rtl/objpas/rtlconst.inc

@@ -301,6 +301,7 @@ ResourceString
   SInvalidHighSurrogate         = 'Invalid high surrogate at index %d. High surrogate must be followed by a low surrogate pair';
   SInvalidUnicodeCodePointSequence = 'Invalid unicode code point sequence';
   SClassCantBeConstructed       = 'Class %s can not be constructed';
+  SErrStatusCallBackRequired    = 'Thread status report handler cannot be empty.';
 
 { ---------------------------------------------------------------------
     Keysim Names