Перейти к содержанию
Fire Monkey от А до Я

IVGSoft

Пользователи
  • Постов

    61
  • Зарегистрирован

  • Посещение

  • Победитель дней

    6

IVGSoft стал победителем дня 6 марта 2019

IVGSoft имел наиболее популярный контент!

Посетители профиля

Блок последних пользователей отключён и не показывается другим пользователям.

  1. As I told you in a previous message - use logging after each potentially errorneous block/line.
  2. Emulate debugger in release mode - insert logging after each line and see where problem occurred
  3. Первым делом FMX пытается использовать аппаратное ускорение (DirectX на Windows), при невозможности - GDI+. Посмотрите исходники и увидите на каком канвасе все рисуется.
  4. Чтоб не заморозить интерфейс. Интерфейс отдельно, логика отдельно.
  5. Снабдите запрос уникальным идентификатором.
  6. Я же писал - заведите флажок у слушающего потока. И его дергайте в Екзекьют. А в основном цикле проверяйте состояние его. И тогда уберите вот єти строки : Client1.Socket.CheckForDataOnSource(100); while Client1.Socket.InputBufferIsEmpty = true do Client1.Socket.CheckForDataOnSource(100); И вообще меняйте архитектуру Отправили запрос - закончили процедуру. Поток ждет прихода ответа. Пришел ответ - или вызываем какой-то метод обработки или сигнализируем главному потоку об ответе. Все. Иначе будет глюк на глюке и глюком погонять. И никакой асинхронности.
  7. Вот пример (обрезанный) из другого проекта : TJobCompleteEvent = procedure(Sender: TObject; Success: boolean) of object; TivgImageProcessor = class(TThread) private ... fOnGrayScaleReady: TImageProcessedEvent; fOnEdgeMapReady: TImageProcessedEvent; fOnUnfilteredLinesReady: TImageProcessedEvent; fOnFilteredLinesReady: TImageProcessedEvent; fOnHaughSpaceImageReady: TImageProcessedEvent; fOnScreenImageReady: TImageProcessedEvent; fOnFullSizeReady: TImageProcessedEvent; fOnPreviewReady: TImageProcessedEvent; fOnResultReady: TResultReadyEvent; fOnCurveReady: TResultReadyEvent; fOnError: TProcessingErrorEvent; fOnNotify: TProcessingNotifyEvent; fOnJobComplete: TJobCompleteEvent; procedure DoULinesReady; procedure DoFLinesReady; procedure DoHaughSpaceReady; procedure DoGrayImgReady; procedure DoEdgeMapReady; procedure DoResultReady; procedure DoScreenReady; procedure DoFullSizeImgReady; procedure DoPreviewReady; procedure DoCurveReady; procedure DoError; procedure DoNotify; procedure DoJobComplete; procedure DoLoad(var aTask: TProcessingTask); procedure DoSave(aTask: TProcessingTask); procedure DoCropCalculate(aSrc: TBitmapSurface; out res: TProcessingResult); procedure DoCrop; procedure DoRotate; procedure DoAdjust; procedure DoPreview; procedure DoCannyTrace(bm_in, bm_out: TBitmapSurface; lowerThreshold, upperThreshold: integer); procedure Convolve(ABitmap: TBitmapSurface; AMask: T3x3FloatArray; ABias: integer); protected procedure Execute; override; function ExecuteTask(aTask: TProcessingTask): boolean; virtual; public constructor Create(aVer : string); destructor Destroy; override; procedure AbortBatch; procedure RunBatch(Jobs: TProcessingJobs; inputImages: TStringDynArray; CanOverwrite: boolean; outPath, outExt: string; multPage: boolean; mirroring : integer = 0); overload; procedure RunBatch(Jobs: TProcessingJobs; FromPath, ToPath: string; outExt: string; CanOverwrite: boolean; multPage: boolean; mirroring : integer = 0); overload; procedure RunSingleTask(aTask: TProcessingTask); procedure SharpenImg(aBmp: TBitmapSurface; aVal: single); procedure CalcImgCropRect(SourceImg: TBitmapSurface); procedure MakePreview(aMirror : integer); // color correction procedure DoColorCorrection(aSrc: TBitmapSurface); overload; procedure DoColorCorrection(aSrc: TBitmapSurface; fCrv : TCorrectionCurve); overload; function PavlidisContourTrace(aBmp: TBitmapSurface; sx, sy: integer; coords: PCoordinates; const aWorkArea: TRect): TPavResult; // events property OnGrayImageReady: TImageProcessedEvent read fOnGrayScaleReady write fOnGrayScaleReady; property OnEdgeMapReady: TImageProcessedEvent read fOnEdgeMapReady write fOnEdgeMapReady; property OnUnfilteredLinesReady: TImageProcessedEvent read fOnUnfilteredLinesReady write fOnUnfilteredLinesReady; property OnFilteredLinesReady: TImageProcessedEvent read fOnFilteredLinesReady write fOnFilteredLinesReady; property OnHaughSpaceReady : TImageProcessedEvent read fOnHaughSpaceImageReady write fOnHaughSpaceImageReady; property OnScreenImageReady: TImageProcessedEvent read fOnScreenImageReady write fOnScreenImageReady; property OnFullSizeReady: TImageProcessedEvent read fOnFullSizeReady write fOnFullSizeReady; property OnPreviewReady: TImageProcessedEvent read fOnPreviewReady write fOnPreviewReady; property OnResultReady: TResultReadyEvent read fOnResultReady write fOnResultReady; property OnCurveReady: TResultReadyEvent read fOnCurveReady write fOnCurveReady; property OnError: TProcessingErrorEvent read fOnError write fOnError; property OnNotify: TProcessingNotifyEvent read fOnNotify write fOnNotify; property OnJobComplete: TJobCompleteEvent read fOnJobComplete write fOnJobComplete; end; procedure TivgImageProcessor.DoJobComplete; begin if Assigned(fOnJobComplete) then fOnJobComplete(Self, fSuccess); end; ... procedure TivgImageProcessor.DoHaughSpaceReady; begin if Assigned(fOnHaughSpaceImageReady) then fOnHaughSpaceImageReady(Self, fImgToShow); end; ... procedure TivgImageProcessor.Execute; begin while not Self.Terminated do begin if not fTaskComplete then try while (fProcTasks.Count <> 0) and not fStoped do begin fSuccess := true; fTaskActive := true; try try fCurrentTask := fProcTasks[0]; ExecuteTask(fProcTasks[0]); Inc(fSuccessCounter); except on E: Exception do begin Inc(fErrorsCounter); fErrorMsg := E.Message; Synchronize(DoError); end; end; finally fProcTasks.Delete(0); Inc(fJobsFinished); fTaskActive := false; end; end; if fCurrentTask.MultiPaged and not fStoped then begin if fUseCompression then fNotification := 'Saving multipage PDF document. Estimated time - ' + FormatDateTime('hh:nn:ss', SecondsToDateTime(cPDFPAGESAVINGTIME * fJobsTotal)) else fNotification := 'Saving multipage PDF document. Estimated time - ' + FormatDateTime('hh:nn:ss', SecondsToDateTime(uPDFPAGESAVINGTIME * fJobsTotal)); Synchronize(DoNotify); MultiPagePDF.SaveToFile(fCurrentTask.ToPath); end; fTaskComplete := true; fSuccess := true; if fStoped then begin fNotification := 'Batch processing aborted!'; fSuccess := false; fProcTasks.Clear; end else fNotification := 'Job complete'; fStoped := false; Synchronize(DoNotify); Synchronize(DoJobComplete); except on E: Exception do begin Inc(fErrorsCounter); fTaskActive := false; fTaskComplete := true; fSuccess := false; fErrorMsg := 'Task processing failed! Err :: ' + E.Message; DoError; Synchronize(DoJobComplete); end; end; Self.Sleep(1); end; end;
  8. А хоспади! Заведите свойство у потока скажем property IsAnswerReceived : boolean read fIsAnswerReceived; В начале цикла в методе Execute сбрасывайте его на false, а по приходу ответа выставляйте в true. В главном же потоке проверяйте это свойство. Так узнаете есть ответ или нету. Это один из вариантов. Второй вариант это создать свойство обработчик события у слушающего потока. По приходу ответа - "выстреливать" им. Сам обработчик пишете в главном потоке и присваиваете его слушающему потоку при (после) создании.
  9. Вы не можете его вызывать. Да и не надо. Передавайте потоку сигналы для управления. И отслеживайте их в методе Execute. И наоборот - пришел ответ от сервера в потоке - сигнализируйте главному потоку о получении.
  10. В общем, согласен. На практике же пока не стыкался с такими проблемами. Такое может случиться в каком-то интенсивном приложении, согласен. Потокобезопасность превыше всего. Но зачастую это выглядит как в анекдоте про монашку, свечу и презерватив.
  11. Ну, IOHandler можно менять. Например на свой с шифрованием. Рекомендуется использовать его.
  12. Удачи! На самом деле мой пример не очень удачный, ибо в нем напрямую дергаются компоненты главной формы. Лучше каким-то образом слать на главную форму сообщения об изменении. Либо создать какие-то события. Собственно в другом проекте я пошел по пути создания событий. А вот в обработчике события уже смотрим нужна ли синхронизация или нет.
  13. По умолчанию - да. Но можно указать флаг Suspended при создании. Тогда метод Execute будет запущен после снятия єтого флага. Синхронизация нужна при обращении к визуальным компонентам. И то только при обновлении (перерисовке) их свойств. Для чтения не надо. Да, именно так. Если есть изменения визуальных компонентов - надо использовать синхронизацию.
  14. procedure TLocationForm.btnSendClick(Sender: TObject); begin with dmMyLocation do begin if not fgActivityDialog.IsShown then begin fgActivityDialog.Message := 'Please, Wait'; fgActivityDialog.Show; FActivityDialogThread := TThread.CreateAnonymousThread(procedure begin Sleep(1000); if TThread.CheckTerminated then Exit; TThread.Synchronize(nil, procedure begin fgActivityDialog.Message := 'Sending data...'; end); try qInsert.SQL.Clear; qInsert.SQL.Add('INSERT INTO mabsensilokasi('); qInsert.SQL.Add('idlokasi,'); qInsert.SQL.Add('tgllokasi,'); qInsert.SQL.Add('latx,'); qInsert.SQL.Add('longx,'); qInsert.SQL.Add('latlongx,'); qInsert.SQL.Add('namalokasi) '); qInsert.SQL.Add('VALUES('); qInsert.SQL.Add(':idlokasi,'); qInsert.SQL.Add(':tgllokasi,'); qInsert.SQL.Add(':latx,'); qInsert.SQL.Add(':longx,'); qInsert.SQL.Add(':latlongx,'); qInsert.SQL.Add(':namalokasi)'); qInsert.Prepare; qInsert.Params[0].AsInteger := 0; qInsert.Params[1].AsDateTime := Now; qInsert.Params[2].AsFloat := strToFloat(ENUSLat); qInsert.Params[3].AsFloat := strToFloat(ENUSLong); qInsert.Params[4].AsString := ENUSLat+':'+ENUSLong; qInsert.Params[5].AsString := edtNamaLokasi.Text; try UniConnection1.Connect; qInsert.ExecSQL; TThread.Synchronize(nil, procedure begin ShowMessage('Record was saved into MySQL Server DB...'); //showup windows of dialog when data was save succesfully into db mysql server end); except on e:exception do begin TThread.Synchronize(nil, procedure begin ShowMessage(e.Message); UniConnection1.Disconnect; end); end;//exception end;//try //fgActivityDialog.ExecuteAction(btnSend); Sleep(1000); if TThread.CheckTerminated then Exit; TThread.Synchronize(nil, procedure begin fgActivityDialog.Message := 'Finish'; end); Sleep(500); if TThread.CheckTerminated then Exit; finally if not TThread.CheckTerminated then TThread.Synchronize(nil, procedure begin fgActivityDialog.Hide; end); end;//try end);//FActivityDialogThread FActivityDialogThread.FreeOnTerminate := False; FActivityDialogThread.Start; end;//if end;//endDM end;//endProc I have changed your code a little bit. To make some kind of separation.
×
×
  • Создать...