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

IVGSoft

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

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

  • Посещение

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

    6

Весь контент 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.
  15. Создайте свой класс потока. Я так поступаю для полного контроля над потоком. Например как-то так : TBeePosMessageThread = class(TThread) private function ExtractData(aPacket : PBeePosDataPacket): string; procedure ProcessPacket(aPacket : pointer); procedure DoProcess(aPacket : PBeePosDataPacket); protected procedure Execute; override; end; implementation { TBeePosMessageThread } procedure TBeePosMessageThread.DoProcess(aPacket: PBeePosDataPacket); var jObj : TJSONObject; sObj : string; cmd : string; typ : string; oObj : string; lock : boolean; id, uid : TBeePosID; price : Currency; qty : double; table : integer; begin sObj := ExtractData(aPacket); jObj := nil; try jObj := TJSONObject.ParseJSONValue(sObj) as TJSONObject; cmd := jObj.Values['command'].Value; typ := jObj.Values['type'].Value; if cmd = 'update' then begin //New order received if typ = 'order' then begin oObj := (jObj.Values['object'] as TJSONObject).ToJSON; Synchronize(procedure begin MainFrm.OrderReceived(oObj); end); end; //order lock changed if typ = 'orderlock' then begin try lock := jObj.Values['value'].Value.ToBoolean; except end; try id := jObj.Values['object'].Value.ToInt64; except end; try uid := jObj.Values['user'].Value.ToInt64; except end; try table := jObj.Values['table'].Value.ToInteger; except end; Synchronize(procedure begin MainFrm.SetOrderLocked(id, uid, lock, table); end); end; //menu item stock changed if typ = 'menuitem' then begin id := 0; try id := jObj.Values['object'].Value.ToInt64; except end; try price := jObj.Values['price'].Value.ToDouble; except end; try qty := jObj.Values['qty'].Value.ToDouble; except end; Synchronize(procedure begin MainFrm.MenuStockChanged(id, qty, price); end); end; //ingredient stock changed if typ = 'ingredient' then begin id := 0; try id := jObj.Values['object'].Value.ToInt64; except end; try price := jObj.Values['price'].Value.ToDouble; except end; try qty := jObj.Values['qty'].Value.ToDouble; except end; Synchronize(procedure begin MainFrm.IngredientStockChanged(id, qty, price); end); end; //Customer received if typ = 'customer' then begin oObj := (jObj.Values['object'] as TJSONObject).ToJSON; Synchronize(procedure begin MainFrm.CustomerAdded(oObj); end); end; end; if cmd = 'delete' then begin if typ = 'order' then begin try id := jObj.Values['object'].Value.ToInt64; except end; Synchronize(procedure begin MainFrm.RemoveOrder(id); end); end; end; finally if Assigned(jObj) then FreeAndNil(jObj); end; end; procedure TBeePosMessageThread.Execute; var Len : integer; Buf : TIdBytes; pBuf : pointer; begin while not Terminated do begin sleep(10); if MainFrm.MessagingClient.Connected then begin len := 0; try if MainFrm.MessagingClient.IOHandler.CheckForDataOnSource(100) then begin len := MainFrm.MessagingClient.IOHandler.InputBuffer.Size; try MainFrm.MessagingClient.IOHandler.ReadBytes(Buf, len, false); GetMem(pBuf, len); Move(Buf[0], pBuf^, len); ProcessPacket(pBuf); finally SetLength(Buf, 0); end; end; except on E:EIdException do Synchronize(procedure begin MainFrm.MessagingClientDisconnected(nil); end); end; end else begin TTask.Run(procedure begin Synchronize(procedure begin MainFrm.MessagingClientDisconnected(nil); end) end); Exit; end; end; end; function TBeePosMessageThread.ExtractData(aPacket: PBeePosDataPacket): string; var str : string; begin DecryptPacket(aPacket.Data, aPacket.BufferSize); SetLength(str, (aPacket.BufferSize div SizeOf(Char)) - 1); Move(aPacket.Data^, str[1], aPacket.BufferSize); Result := TIdDecoderMIME.DecodeString(str); end; procedure TBeePosMessageThread.ProcessPacket(aPacket: pointer); var aDataPacket : PBeePosDataPacket; begin try if TBeePosContext.CheckPacket(aPacket) then begin GetMem(aDataPacket, SizeOf(TBeePosDataPacket)); aDataPacket.Header := PBeePosDataPacket(aPacket).Header; aDataPacket.BufferSize := PBeePosDataPacket(aPacket).BufferSize; aDataPacket.Data := nil; GetMem(aDataPacket.Data, aDataPacket.BufferSize); Move(pointer(NativeUInt(aPacket) + SizeOf(TBeePosMessagePacket))^, aDataPacket.Data^, aDataPacket.BufferSize); try DoProcess(aDataPacket); finally FreeMem(aDataPacket.Data); end; end finally FreeMem(aDataPacket); FreeMem(aPacket); end; end;
  16. Вы, наверное, не правильно поняли проблему. Перевести строку в аппер для подсовывания в запрос не проблема. Проблема в том, что SQLite не умеет преобразовывать кирилицу в аппер (или лоуер)!
  17. То не компилятор, а CodeInsight. Попробуйте его отключить.
  18. Почему бесконечном? Тут как захотите. Обычно делают как-то так : While not (Terminated or fStopped) do begin DoSomeActions; end;
  19. Очень просто - в потоке проверяйте наличие данных. Появился ответ - меняйте состояние контролов. Он будет работать в фоновом режиме. Можно даже снизить ему приоритет.
  20. Можете использовать поток вместо таймера.
  21. Ну, во-первых Вы не указали что за сервер используется - HTTP или какой-то иной. Если сервер самописный ТСР, то можно на клиентской стороне открыть сокет на прослушку для сообщений от сервера и по приходу пакета от сервера менять отображение визуальных компонентов.
  22. IVGSoft

    Audio Streaming

    Вечер добрый! И как успехи с прикручиванием кодека?
×
×
  • Создать...