diff --git a/source/YDW.FMX.ImageWithURLCacheManager.pas b/source/YDW.FMX.ImageWithURLCacheManager.pas index 4be339d..c4cd2d5 100644 --- a/source/YDW.FMX.ImageWithURLCacheManager.pas +++ b/source/YDW.FMX.ImageWithURLCacheManager.pas @@ -225,7 +225,7 @@ procedure TImageWithURLCahceManager.LoadFromCache(AUrl: string; Except on E: Exception do begin Log('TImageWithURLCahceManager.LoadFromCache(); SyncBitmapLoadFromFile: ' + Booltostr(SyncBitmapLoadFromFile, True), E); - Raise E; + raise; end; end; {$ENDIF} end; diff --git a/source/YDW.FMX.ImageWithURLManager.pas b/source/YDW.FMX.ImageWithURLManager.pas index 2890f02..a550c2d 100644 --- a/source/YDW.FMX.ImageWithURLManager.pas +++ b/source/YDW.FMX.ImageWithURLManager.pas @@ -128,9 +128,9 @@ procedure TImageWithUrlManager.SubThreadExecute(AValue: IImageWithURL); function IsValidHTTPURL(const AURL: string): boolean; begin - Result := AURL.StartsWith('https://', True); + Result := AURL.StartsWith(TURI.SCHEME_HTTPS, True); if not Result then - Result := AURL.StartsWith('http://', True); + Result := AURL.StartsWith(TURI.SCHEME_HTTP, True); end; function IsStoredLocal(const AURL: string): boolean; @@ -163,28 +163,35 @@ procedure TImageWithUrlManager.SubThreadExecute(AValue: IImageWithURL); begin LImage := AValue; - LUrl := LImage.ImageURL; // Saved local url LFinalImage := nil; try try - if EnableLoadFromCache and Assigned(CacheManager) + if EnableLoadFromCache + and Assigned(CacheManager) and CacheManager.IsCached(LUrl) then begin + // Have copy on cache CacheManager.LoadFromCache(LUrl, LImage.BitmapIWU); LImageLoaded := True; + end else if IsStoredLocal(LUrl) then begin + // Url is file path and file exists if SyncBitmapLoadFromFile then begin - TThread.Synchronize(TThread.Current, procedure begin + + TThread.Synchronize(TThread.Current, procedure + begin if Self.LoadThumbnailFromFile then LImage.BitmapIWU.LoadThumbnailFromFile(LUrl, ThumbSize.Width, ThumbSize.Height) // ISSUE (FormOnCreate, FormOnShow) else LImage.BitmapIWU.LoadFromFile(LUrl); // ISSUE (FormOnCreate, FormOnShow) LImageLoaded := True; end); + end else begin // Usign buffer bitmap + LBufBmp := TBitmap.Create; try {$IFDEF YDW_DEBUG} try {$ENDIF} @@ -193,23 +200,26 @@ procedure TImageWithUrlManager.SubThreadExecute(AValue: IImageWithURL); else LBufBmp.LoadFromFile(LUrl); // ISSUE (FormOnCreate, FormOnShow) - TThread.Synchronize(nil, + TThread.Synchronize(TThread.Current, procedure begin LImage.BitmapIWU.Assign(LBufBmp); LImageLoaded := True; end); + {$IFDEF YDW_DEBUG} Except on E: Exception do begin Log('IsStoredLocal async load', E); - Raise E; + raise; end; end; {$ENDIF} + finally LBufBmp.Free; end; + end; end else begin @@ -228,19 +238,18 @@ procedure TImageWithUrlManager.SubThreadExecute(AValue: IImageWithURL); end; LClient.SynchronizeEvents := False; - LClient.Asynchronous := false; + LClient.Asynchronous := False; LClient.AutomaticDecompression := [THTTPCompressionMethod.Any]; if TThread.Current.CheckTerminated then exit; - LResponse := LClient.Get(LUrl); if TThread.Current.CheckTerminated then exit; if not AllowThisResponse(LUrl, LResponse) then exit; - Self.EncodeImage(LResponse.ContentStream, LFinalImage); + EncodeImage(LResponse.ContentStream, LFinalImage); - if Self.EnableSaveToCache and Assigned(CacheManager) then begin + if EnableSaveToCache and Assigned(CacheManager) then begin if not CacheManager.IsCached(LUrl) then CacheManager.CacheItem(LUrl, LFinalImage); end; @@ -254,7 +263,8 @@ procedure TImageWithUrlManager.SubThreadExecute(AValue: IImageWithURL); finally - if Assigned(LResponse) and (LFinalImage <> LResponse.ContentStream) then + if Assigned(LResponse) + and (LFinalImage <> LResponse.ContentStream) then FreeAndNil(LFinalImage); LClient.Free; @@ -267,10 +277,11 @@ procedure TImageWithUrlManager.SubThreadExecute(AValue: IImageWithURL); On E: Exception do DoOnException(E); end; + finally if Assigned(LImage.OnLoadingFinished) then begin - TThread.Synchronize(nil, + TThread.Synchronize(TThread.Current, procedure begin LImage.OnLoadingFinished(LImage as TObject, LImageLoaded); diff --git a/source/YDW.Threading.pas b/source/YDW.Threading.pas index 88cab07..b4ea124 100644 --- a/source/YDW.Threading.pas +++ b/source/YDW.Threading.pas @@ -45,14 +45,14 @@ TYdwReusableThread = class(TObject) Value: T; procedure Execute; override; End; - TThreadAndValue = record + TThreadAndValue = Class(TObject) public Thread: TSubWorkerThread; Value: T; constructor Create(AValue: T); end; { ❤-------------- } - TThreadAndValueList = TList>; + TThreadAndValueList = TObjectList>; protected { ❤ -- Thread safe --- } procedure SetThreadsCount(const value: integer); @@ -63,14 +63,16 @@ TThreadAndValue = record function IsRunning(AValue: T): boolean; function WaitForItem(AValue: T): LongWord; function OnWaitList(AThread: TSubWorkerThread): boolean; + function AutoRestartCondition: boolean; virtual; protected FThreadsCount: integer; FQueue: TList; FRunning: TThreadAndValueList; FWaitList: TThreadList; +// FGarbage: TObjectList; +// procedure ClearGarbage; { FIXME: Anal Violation sometimes. } function NewSubThread(AValue: T): TSubWorkerThread; function QueueCondition: boolean; virtual; - function AutoRestartCondition: boolean; virtual; procedure OnSubThreadFinish; virtual; function GetThreadByItem(AValue: T): TSubWorkerThread; function RunningIndex(AValue: T): integer; virtual; abstract; { dont forget this ! } @@ -99,95 +101,104 @@ implementation function TGenericYDWQueuedThread.AutoRestartCondition: boolean; begin - Result := ( Self.QueueCondition ) and - ( not TThread.Current.CheckTerminated); + FLock.BeginRead; + try + Result := ( Self.QueueCondition ) and + ( not TThread.Current.CheckTerminated); + finally + FLock.EndRead; + end; end; procedure TGenericYDWQueuedThread.Execute; const - MICRO_SLEEP_TIME = 10; + MICRO_SLEEP_TIME = 2; var I: integer; LNewThread: TSubWorkerThread; LItem: TThreadAndValue; begin - try - repeat - try + repeat + try + while ( TRUE ) do begin - while ( TRUE ) do begin + if TThread.Current.CheckTerminated then exit; + While ( RunningCount >= Self.ThreadsCount ) do begin if TThread.Current.CheckTerminated then exit; + Sleep(MICRO_SLEEP_TIME); + end; - While ( RunningCount >= Self.ThreadsCount ) do begin - if TThread.Current.CheckTerminated then exit; - Sleep(MICRO_SLEEP_TIME); - end; + FLock.BeginWrite; + try + if QueueCondition then begin - FLock.BeginWrite(); - try - if ( Self.QueueCondition ) then begin + LItem := TThreadAndValue.Create(FQueue.First); { get next Value from queue } + LNewThread := NewSubThread(LItem.Value); + LItem.Thread := LNewThread; + FRunning.Add(LItem); + FQueue.Delete(0); + LNewThread.Start; - LItem := TThreadAndValue.Create(FQueue.First); { get next Value from queue } - LNewThread := NewSubThread(LItem.Value); - LItem.Thread := LNewThread; - FRunning.Add(LItem); - FQueue.Delete(0); - LNewThread.Start; + while not LNewThread.Started do + Sleep(1); - while not LNewThread.Started do - Sleep(1); + LNewThread := Nil; + LItem := Nil; - end; - finally - FLock.EndWrite(); end; - - if ( RunningCount = 0 ) then break; - + finally + FLock.EndWrite; end; - finally + if (not AutoRestartCondition) + and (RunningCount = 0) then break; - { Terminate all threads } - FLock.BeginWrite(); - try + end; - for I := 0 to FRunning.count - 1 do begin - var LThread := FRunning[I].Thread; + finally - LThread.Terminate; + { Terminate all threads } + FLock.BeginWrite; + try + for I := 0 to FRunning.count - 1 do + FRunning[I].Thread.Terminate; + finally + FLock.EndWrite; + end; - end; + { Waiting for finish } + while (RunningCount > 0) do begin + sleep(MICRO_SLEEP_TIME); + end; - finally - FLock.EndWrite(); - end; + var LListEmpty: boolean := False; + while (not LListEmpty) do begin + var LWaitList := FWaitList.LockList; + try + LListEmpty := (LWaitList.Count = 0); + +// FLock.BeginWrite; +// try +// {$IFDEF YDW_DEBUG} try {$ENDIF} +// if LListEmpty then ClearGarbage; { Free used threads } +// {$IFDEF YDW_DEBUG} except +// On E: Exception do begin +// YDW.Debug.Log('TGenericYDWQueuedThread.Execute ClearGarbage', E); +// raise; +// end; +// end; {$ENDIF} +// finally +// FLock.EndWrite; +// end; - { Waiting for finish } - while (RunningCount > 0) do begin - sleep(MICRO_SLEEP_TIME); - end; - - var LListEmpty: boolean := False; - while (not LListEmpty) do begin - var LWaitList := FWaitList.LockList; - try - LListEmpty := (LWaitList.Count = 0) - finally - FWaitList.UnlockList; - end; + finally + FWaitList.UnlockList; end; - end; - until not AutoRestartCondition; - except - - on E: Exception do begin - Raise E; + end; - - end; + until not AutoRestartCondition; end; function TGenericYDWQueuedThread.GetThreadByItem( @@ -229,9 +240,12 @@ function TGenericYDWQueuedThread.NewSubThread(AValue: T): TSubWorkerThread; function TGenericYDWQueuedThread.RunningCount: integer; begin - FLock.BeginRead(); - Result := Self.FRunning.Count; - FLock.EndRead(); + FLock.BeginRead; + try + Result := Self.FRunning.Count; + finally + FLock.EndRead; + end; end; procedure TGenericYDWQueuedThread.SetThreadsCount(const Value: integer); @@ -248,7 +262,6 @@ procedure TGenericYDWQueuedThread.SetThreadsCount(const Value: integer); function TGenericYDWQueuedThread.WaitForItem(AValue: T): LongWord; var LThread: TSubWorkerThread; - LIndex: integer; begin {$IFDEF YDW_DEBUG} try {$ENDIF} FLock.BeginRead; @@ -260,14 +273,14 @@ function TGenericYDWQueuedThread.WaitForItem(AValue: T): LongWord; FLock.EndRead; end; - if Assigned(LThread) then + if Assigned(LThread) then begin Result := LThread.WaitFor; - - FWaitList.Remove(LThread); + FWaitList.Remove(LThread); + end; {$IFDEF YDW_DEBUG} except On E: Exception do begin YDW.Debug.Log('TGenericYDWQueuedThread.WaitForItem', E); - raise E; + raise; end; end; {$ENDIF} end; @@ -321,7 +334,7 @@ procedure TYdwReusableThread.Terminate; {$IFDEF YDW_DEBUG} except On E: Exception do begin YDW.Debug.Log('TYdwReusableThread.Terminate', E); - Raise E; + raise; end; end; {$ENDIF} end; @@ -336,7 +349,7 @@ function TYdwReusableThread.UnlockedIsRunning: boolean; {$IFDEF YDW_DEBUG} except On E: Exception do begin YDW.Debug.Log('TYdwReusableThread.UnlockedIsRunning', E); - Raise E; + raise; end; end; {$ENDIF} end; @@ -361,7 +374,7 @@ function TYdwReusableThread.WaitFor: LongWord; {$IFDEF YDW_DEBUG} except On E: exception do begin YDW.Debug.Log('TYdwReusableThread.WaitForFinish ' + FThread.ThreadID.ToString, E); - Raise E; + raise; end; end; {$ENDIF} end; @@ -383,25 +396,27 @@ procedure TGenericYDWQueuedThread.AbortItem(AItem: T); FLock.BeginWrite(); try Index := Self.RunningIndex(AItem); - if ( Index <> -1 ) then begin - try - FRunning[Index].Thread.Terminate; - except - On E: exception do - raise E; - end; - end; + if ( Index <> -1 ) then + FRunning[Index].Thread.Terminate; Index := FQueue.IndexOf(AItem); - if ( Index <> -1 ) then begin + if ( Index <> -1 ) then FQueue.Delete(Index); - end; - finally FLock.EndWrite(); end; end; +//procedure TGenericYDWQueuedThread.ClearGarbage; +//begin +// try +// FGarbage.Clear; +// except +// On E: Exception do +// Log('TGenericYDWQueuedThread.ClearGarbage FGarbage.Clear', E); +// end; +//end; + constructor TGenericYDWQueuedThread.Create; begin inherited; @@ -410,6 +425,7 @@ constructor TGenericYDWQueuedThread.Create; FThreadsCount := DEFAULT_THREADS_COUNT; FWaitList := TThreadList.Create; FWaitList.Duplicates := dupAccept; +// FGarbage := TObjectList.Create; end; destructor TGenericYDWQueuedThread.Destroy; @@ -418,6 +434,16 @@ destructor TGenericYDWQueuedThread.Destroy; FQueue.Free; FRunning.Free; FWaitList.Free; + +// {$IFDEF YDW_DEBUG} try {$ENDIF} +// Self.ClearGarbage; +// FGarbage.Free; +// {$IFDEF YDW_DEBUG} except +// On E: exception do begin +// YDW.Debug.Log('TGenericYDWQueuedThread.Destroy ClearGarbage: ' + LStr, E); +// raise; +// end; +// end; {$ENDIF} end; procedure TGenericYDWQueuedThread.OnSubThreadFinish; @@ -477,7 +503,7 @@ function TGenericYDWQueuedThreadInterface.RunningIndex(AValue: T): integer; I: integer; begin for I := 0 to FRunning.Count - 1 do begin - if ((AValue as TObject) = (FRunning[I].value as TObject )) then + if ((AValue as TObject) = (FRunning[I].value as TObject)) then begin Result := I; exit; @@ -492,13 +518,11 @@ procedure TYdwReusableThread.TWorkerThread.Execute; begin Owner.Execute; end; - -{ TGenericYDWQueuedThread.TSubWorkerThread } - + procedure TGenericYDWQueuedThread.TSubWorkerThread.Execute; var - I, ThreadIndex, LastIndex: integer; - TempItem: TThreadAndValue; + I: integer; + ThreadIndex: integer; begin try Owner.SubThreadExecute(Value); @@ -506,9 +530,8 @@ procedure TGenericYDWQueuedThread.TSubWorkerThread.Execute; finally Owner.FLock.BeginWrite(); try - LastIndex := Owner.FRunning.Count - 1; - for I := 0 to LastIndex do begin + for I := 0 to Owner.FRunning.Count - 1 do begin if ( Owner.FRunning[I].Thread = TThread.Current ) then begin ThreadIndex := I; @@ -516,12 +539,8 @@ procedure TGenericYDWQueuedThread.TSubWorkerThread.Execute; end; end; - if ( ThreadIndex <> LastIndex ) and ( Owner.FRunning.Count > 1 ) then - begin - Owner.FRunning.Exchange(LastIndex, ThreadIndex); - end; - - Owner.FRunning.Delete(LastIndex); + Owner.FRunning.Delete(ThreadIndex); +// Owner.FGarbage.Add(TThread.Current); finally Owner.FLock.EndWrite(); diff --git a/tests/IWU/IWUTest.fmx b/tests/IWU/IWUTest.fmx index cbe3e3d..1acfe9b 100644 --- a/tests/IWU/IWUTest.fmx +++ b/tests/IWU/IWUTest.fmx @@ -16,7 +16,7 @@ object Form2: TForm2 Size.Height = 467.000000000000000000 Size.PlatformDefault = False TabHeight = 25.000000000000000000 - TabIndex = 4 + TabIndex = 2 TabOrder = 0 TabPosition = PlatformDefault Sizes = ( @@ -338,7 +338,7 @@ object Form2: TForm2 CustomIcon = < item end> - IsSelected = False + IsSelected = True Size.Width = 84.000000000000000000 Size.Height = 25.000000000000000000 Size.PlatformDefault = False @@ -494,7 +494,7 @@ object Form2: TForm2 CustomIcon = < item end> - IsSelected = True + IsSelected = False Size.Width = 51.000000000000000000 Size.Height = 25.000000000000000000 Size.PlatformDefault = False diff --git a/tests/IWU/IWUTest.pas b/tests/IWU/IWUTest.pas index 1541292..5bd179f 100644 --- a/tests/IWU/IWUTest.pas +++ b/tests/IWU/IWUTest.pas @@ -410,8 +410,30 @@ procedure TForm2.FormCreate(Sender: TObject); end; procedure TForm2.FormDestroy(Sender: TObject); +var + I: integer; + + procedure NilManager(AObject: TComponent); + var + I: integer; + LIWU: IImageWithURL; + begin + if Supports(AObject, IImageWithURL, LIWU) then + LIWU.ImageManager := Nil; + + for I := 0 to AObject.ComponentCount - 1 do + begin + NilManager(AObject.Components[I]) + end; + end; + begin - ImgManager.Free; + for I := 0 to Images.Count - 1 do + images[I].ImageManager := Nil; + + nilManager(Self); + + FreeAndNil(ImgManager); end; function TForm2.GetThreadsCount: integer; diff --git a/tests/IWU/IWUTestApp.dproj b/tests/IWU/IWUTestApp.dproj index 0007607..a816f9b 100644 --- a/tests/IWU/IWUTestApp.dproj +++ b/tests/IWU/IWUTestApp.dproj @@ -5,7 +5,7 @@ FMX True Release - Win32 + Win64 32787 Application IWUTestApp.dpr @@ -38,6 +38,12 @@ Base true + + true + Cfg_1 + true + true + true Cfg_1 @@ -55,6 +61,12 @@ Base true + + true + Cfg_2 + true + true + true Cfg_2 @@ -164,14 +176,25 @@ true true + + YDW_DEBUG;$(DCC_Define) + 1 + #000000 + false true PerMonitorV2 + YDW_DEBUG;$(DCC_Define) + true + 1033 true PerMonitorV2 + YDW_DEBUG;$(DCC_Define) + true + 1033 false @@ -179,6 +202,11 @@ 0 0 + + YDW_DEBUG;$(DCC_Define) + 1 + #000000 + true PerMonitorV2 @@ -189,6 +217,9 @@ true PerMonitorV2 + YDW_DEBUG;$(DCC_Define) + true + 1033 @@ -234,111 +265,93 @@ - - - IWUTestApp.exe - true - - - - - IWUTestApp.exe - true - - true - - - libIWUTestApp.so - true - - - + - styles.xml + ic_launcher.png true - + - ic_notification.png + ic_launcher.png true - + - ic_launcher.png true - + - ic_launcher.png true - + - splash_image.png true - + + ic_launcher.png true - + + ic_launcher.png true - + - 64 + ic_launcher.png true - + ic_launcher.png true - + ic_launcher.png true - + ic_launcher.png true - - + + + ic_notification.png true - + ic_notification.png true - + splash_image.png true - + splash_image.png true @@ -350,14 +363,14 @@ true - - + + + libIWUTestApp.so true - + - libIWUTestApp.so true @@ -372,13 +385,30 @@ true - + ic_notification.png true - + + + true + + + + + 64 + true + + + + + ic_notification.png + true + + + ic_notification.png true @@ -406,12 +436,164 @@ true + + + libIWUTestApp.so + true + + + + + ic_launcher.png + true + + + + + IWUTestApp.exe + true + + + + + IWUTestApp.exe + true + + + + + libIWUTestApp.so + true + + + + + libIWUTestApp.so + true + + + + + styles.xml + true + + + + + ic_notification.png + true + + + + + ic_launcher.png + true + + + + + splash_image.png + true + + + + + ic_launcher.png + true + + + + + splash_image.png + true + + + + + libIWUTestApp.so + true + + + + + ic_notification.png + true + + + + + 64 + true + + + + + true + + + + + true + + + + + splash_image.png + true + + + + + splash_image.png + true + + + + + true + + + + + true + + + + + styles.xml + true + + + + + libIWUTestApp.so + true + + + + + ic_notification.png + true + + + + + ic_notification.png + true + + splash_image.png true + + + splash_image.png + true + + 1 @@ -1213,10 +1395,10 @@ - + + -