Leaderboard
Popular Content
Showing content with the highest reputation on 06/28/23 in all areas
-
New Code Signing Certificate Recommendations
David Heffernan replied to James Steel's topic in General Help
Expect it to be discontinued at short notice when Google get bored of it -
TNetHttpRequest.ContentStream Save To File
Dave Nottage replied to egnew's topic in Network, Cloud and Web
You'd need to typecast it to a TMemoryStream in order to do that, e.g: if LResponse.ContentStream is TMemoryStream then TMemoryStream(LResponse.ContentStream).SaveToFile(LFileName) // else the implementation has changed ;-) -
unit Bitset; interface uses SysUtils, Math; type TBitSet = record private FBitCount: Int64; FSets: array of set of 0..255; class function SetCount(BitCount: Int64): Int64; static; procedure MakeUnique; procedure GetSetIndexAndBitIndex(Bit: Int64; out SetIndex: Int64; out BitIndex: Integer); function GetIsEmpty: Boolean; procedure SetBitCount(Value: Int64); function GetSize: Int64; public class operator In(const Bit: Int64; const BitSet: TBitSet): Boolean; class operator Equal(const bs1, bs2: TBitSet): Boolean; class operator NotEqual(const bs1, bs2: TBitSet): Boolean; property BitCount: Int64 read FBitCount write SetBitCount; property Size: Int64 read GetSize; property IsEmpty: Boolean read GetIsEmpty; procedure Clear; procedure IncludeAll; procedure Include(const Bit: Int64); procedure Exclude(const Bit: Int64); end; implementation { TBitSet } procedure TBitSet.MakeUnique; begin // this is used to implement copy-on-write so that the type behaves like a value SetLength(FSets, Length(FSets)); end; procedure TBitSet.GetSetIndexAndBitIndex(Bit: Int64; out SetIndex: Int64; out BitIndex: Integer); begin Assert(InRange(Bit, 0, FBitCount-1)); SetIndex := Bit shr 8; // shr 8 = div 256 BitIndex := Bit and 255; // and 255 = mod 256 end; function TBitSet.GetIsEmpty: Boolean; var i: Int64; begin for i := 0 to High(FSets) do begin if FSets[i]<>[] then begin Result := False; Exit; end; end; Result := True; end; procedure TBitSet.SetBitCount(Value: Int64); var Bit, BitIndex: Integer; SetIndex: Int64; begin if (Value<>FBitCount) or not Assigned(FSets) then begin Assert(Value>=0); FBitCount := Value; SetLength(FSets, SetCount(Value)); if Value>0 then begin (* Ensure that unused bits are cleared, necessary give the CompareMem call in Equal. This also means that state does not persist when we decrease and then increase BitCount. For instance, consider this code: var bs: TBitSet; ... bs.BitCount := 2; bs.Include(1); bs.BitCount := 1; bs.BitCount := 2; Assert(not (1 in bs)); *) GetSetIndexAndBitIndex(Value - 1, SetIndex, BitIndex); for Bit := BitIndex + 1 to 255 do begin System.Exclude(FSets[SetIndex], Bit); end; end; end; end; function TBitSet.GetSize: Int64; begin Result := Length(FSets)*SizeOf(FSets[0]); end; class function TBitSet.SetCount(BitCount: Int64): Int64; begin Result := (BitCount + 255) shr 8; // shr 8 = div 256 end; class operator TBitSet.In(const Bit: Int64; const BitSet: TBitSet): Boolean; var SetIndex: Int64; BitIndex: Integer; begin BitSet.GetSetIndexAndBitIndex(Bit, SetIndex, BitIndex); Result := BitIndex in BitSet.FSets[SetIndex]; end; class operator TBitSet.Equal(const bs1, bs2: TBitSet): Boolean; begin Result := (bs1.FBitCount=bs2.FBitCount) and CompareMem(Pointer(bs1.FSets), Pointer(bs2.FSets), bs1.Size); end; class operator TBitSet.NotEqual(const bs1, bs2: TBitSet): Boolean; begin Result := not (bs1=bs2); end; procedure TBitSet.Clear; var i: Int64; begin MakeUnique; for i := 0 to High(FSets) do begin FSets[i] := []; end; end; procedure TBitSet.IncludeAll; var i: Int64; begin for i := 0 to BitCount-1 do begin Include(i); end; end; procedure TBitSet.Include(const Bit: Int64); var SetIndex: Int64; BitIndex: Integer; begin MakeUnique; GetSetIndexAndBitIndex(Bit, SetIndex, BitIndex); System.Include(FSets[SetIndex], BitIndex); end; procedure TBitSet.Exclude(const Bit: Int64); var SetIndex: Int64; BitIndex: Integer; begin MakeUnique; GetSetIndexAndBitIndex(Bit, SetIndex, BitIndex); System.Exclude(FSets[SetIndex], BitIndex); end; end. This is based on code of mine that has is limited to integer bit count. I've not tested it extended to Int64, but I'm sure anyone that wanted to use random code like this would test.
-
delphi Thread ITask.ExecuteWork not wait until Task finish in mobile devices?
Dalija Prasnikar replied to bravesofts's topic in Cross-platform
There is no safe way to block main thread. You should never, ever block main thread, especially not on mobile devices that have slightly different workflow than Windows. And yes, don't use Sleep either. The only proper solution for your problem is not to wait, reorganize code, so you don't have to wait. Disable the UI to prevent user from starting something else while your task is running and enable the UI and run other code from within task procedure (synchronized) when the task is done. This is not a safe way. Your code is bad even on Windows, even though it seems like it works. This is the wrong way to deal with threads anywhere. Again, it is not about Delphi, it is that this is the wrong way to use threads.- 24 replies
-
- android
- multithreading
-
(and 2 more)
Tagged with:
-
delphi Thread ITask.ExecuteWork not wait until Task finish in mobile devices?
Lajos Juhász replied to bravesofts's topic in Cross-platform
On the other hand I believe you should learn a bit more about multi threading.- 24 replies
-
- android
- multithreading
-
(and 2 more)
Tagged with:
-
delphi Thread ITask.ExecuteWork not wait until Task finish in mobile devices?
Lajos Juhász replied to bravesofts's topic in Cross-platform
On mobile devices you should never block the main thread (or risk that the OS will terminate your program). Without more details we cannot help you. Most probably you want to disable the UI elements that are not allowed while your background thread is executing.- 24 replies
-
- android
- multithreading
-
(and 2 more)
Tagged with:
-
delphi Thread ITask.ExecuteWork not wait until Task finish in mobile devices?
Dalija Prasnikar replied to bravesofts's topic in Cross-platform
This is why you are failing. The main thread should not wait for background thread to finish. If you need to run something after your task is completed you need to change your code logic and initiate that code from within TTask procedure. If you wait you will block the main thread and this is not something you should be doing, unless it is some very brief period for some cleanup (even then you need to be careful) This is how you should use TTask to run task in background and then run some code after task finishes: begin fTask := TTask.Create( procedure begin // Here you do your task code ... TThread.Synchronize(nil, procedure begin // Here you can call code that needs to run after task is finished ... end); end); fTask.Start; end; If you change your code workflow, you will not need the Sleep or anything else. There is no magic there. Just because at some point it may look like it is doing what you want it to do, does not mean it is right way to do it.- 24 replies
-
- android
- multithreading
-
(and 2 more)
Tagged with:
-
delphi Thread ITask.ExecuteWork not wait until Task finish in mobile devices?
Dalija Prasnikar replied to bravesofts's topic in Cross-platform
Do not call Application.ProcessMessages, it is a wrong solution to whatever problem you have.- 24 replies
-
- android
- multithreading
-
(and 2 more)
Tagged with:
-
delphi Thread ITask.ExecuteWork not wait until Task finish in mobile devices?
Dalija Prasnikar replied to bravesofts's topic in Cross-platform
It doesn't help much. The code does not make sense, so it is very hard to understand what you want to accomplish and even more importantly why. Delphi does support background threads on mobile devices, but again your code is very much wrong. Again, don't ever call ExecuteWork on task, use Start. It would help if you could show your original code as in what you need to do, without your broken solution which just makes it harder to understand what you need.- 24 replies
-
- android
- multithreading
-
(and 2 more)
Tagged with:
-
How about the idea to store this in a 2D-image as Bitfield, of maybe 17320x17320 pixel ? Of course storage will be maybe more efficient, but access would be slower. Thinking further, using such Bitfield with involvement of the GPU ....
-
delphi Thread ITask.ExecuteWork not wait until Task finish in mobile devices?
Dalija Prasnikar replied to bravesofts's topic in Cross-platform
I don't quite understand what you mean that it didn't wait until task complete, but you are using the task wrong. First, you should never call ExecuteWork as it is internal method. You should use Start instead. Next code within task procedure will run in the background thread so when you call fTask.Start any code following that line will immediately run and it will not wait for task completion. The whole point of running a task is that it does not block further code along with the GUI. Next, since task procedure will run in background thread, you must never call Application.ProcessMessages within, because it can only be called within main thread context. And because task is running in the background you don't need to manually pump message queue anyway. If you wanted to use it to simulate some work, just use some other code. If you want to wait for task to complete you can call fTask.Wait, but this will then block the thread were it is called and if you call it on main thread it will block the main thread which defeats the purpose of running a task in the background. It only makes sense if user closes some form or similar and you need to wait for task to perform some cleanup. But in such scenarios you need to know that wait will be very short or you will get unresponsive application.- 24 replies
-
- android
- multithreading
-
(and 2 more)
Tagged with:
-
I typecast the ContentStream as a TMemoryStream and SaveToFile worked perfectly. Thanks for your help.
-
"natural" compare function for sort
programmerdelphi2k replied to Tommi Prami's topic in Algorithms, Data Structures and Class Design
@Ian Branch I think that the Natural Order (to computer) is based on "symbol's" numerical value on the table used not? (normally ASCII table) Which would come first for you: the letter "a=97 / A=65" (lowercase or uppercase), or the number "0 = 48" (zero)? me(...) X StrCmpLogicalW(...) -
TNetHttpRequest.ContentStream Save To File
aehimself replied to egnew's topic in Network, Cloud and Web
AFFAIK it's a TMemoryStream, so you simply can call ContentStream.SaveToFile. You also can create a separate TFileStream and use .CopyFrom(ContentStream). just make sure position is 0 before calling .CopyFrom. -
I made it so that it works both with and without the T as it's more readable without it. [Test] [TestCase('Date, space, time', '1988-10-21 17:44:23.456')] [TestCase('Date, T, time', '1988-10-21T17:44:23.456')] [TestCase('Date, T, time, Z', '1988-10-21T17:44:23.456Z')] [TestCase('Date, T, time, offset (1)', '1988-10-21T17:44:23.456+02:30')] [TestCase('Date, T, time, offset (2)', '1988-10-21T17:44:23.456+0230')] procedure TestDateTimeArgument(dateTime: TDateTime); https://github.com/VSoftTechnologies/DUnitX/blob/c348ea5010822368975c0f10aa1d16969c6ba6bd/Tests/DUnitX.Tests.Example.pas#L68-L74
-
At least more than three🙄. Judging by the readme file, it is newer than September 2016, but as you noticed, older than June 2020 when my change was added.
-
Error PKCS12 certificate - error:0308010C:digital envelope routines::unsupported
Angus Robertson replied to razzmatazz's topic in General Help
You need to set GSSLEAY_LOAD_LEGACY := True in formcreate so OpenSSL loads the legacy provider that has obsolete cryptography that old versions of Windows still require. Making those PKCS12 functions backward and forward compatible was a nightmare. Angus -
Firstly, let me say that my work on SynEdit has moved back to pyscripter/SynEdit for reasons explained here. The newest enhancement to SynEdit is accessibility support. Now, SynEdit fully supports screen readers such as Windows Narrator and NVDA. The support is much better than, for instance, in Visual Studio Code. The implementation is not based on the older Microsoft Active Accessibility (MSAA), but on the newer Microsoft UI Automation. Microsoft UI Automation has been around since 2005 and is available to all Windows versions, since Windows XP. In addition to making applications accessible, it can also be used by automated UI testing tools. Despite been available for almost 20 years, Delphi does not provide the relevant header translations (See RSP-41898), which complicated the implementation. I also could not find any other complete Delphi implementation of UI automation. So, the SynEdit implementation may serve as a guide to how to implement UI Automation in other controls. Further details can be found here.
-
How to set event handler for generic TControl descendant using RTTI
programmerdelphi2k replied to CoMPi74's topic in General Help
@CoMPi74 try this way too: type TForm1 = class(TForm) Button1: TButton; procedure Button1Click(Sender: TObject); private // OR... strict private procedure DoOnClick(Sender: TObject); procedure DoMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); end; ... procedure MySetEventHandler(AObj: TObject; AEventName: string; AMethod: TMethod); begin if IsPublishedProp(AObj, AEventName) then SetMethodProp(AObj, AEventName, AMethod); end; procedure TForm1.Button1Click(Sender: TObject); var LNewButton : TButton; LNewButtonName: string; LMethod: TMethod; begin DateTimeToString(LNewButtonName, '_ss_zzz', now); // LNewButton := TButton.Create(self); LNewButton.Name := 'Btn' + LNewButtonName; LNewButton.Parent := self; LNewButton.Left := random(ClientWidth - LNewButton.Width); LNewButton.Top := random(ClientHeight - LNewButton.Height); // LMethod.Data := @LNewButton; LMethod.Code := @TForm1.DoOnClick; MySetEventHandler(LNewButton, 'OnClick', LMethod); // works! // LMethod.Data := @LNewButton; LMethod.Code := @TForm1.DoMouseUp; // namespace.proceduralType = method MySetEventHandler(LNewButton, 'OnMouseUp', LMethod); // works! end; procedure TForm1.DoMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin ShowMessage('OnMouseUp ' + TControl(Sender).Name); end; procedure TForm1.DoOnClick(Sender: TObject); begin ShowMessage('OnClick ' + TControl(Sender).Name); end; -
search between two dates
programmerdelphi2k replied to Analyste2023's topic in RTL and Delphi Object Pascal
Serge, there are so many possibilities that we often forget the obvious... good times when there weren't so many options 😂 -
👍 programmerd2k response, and, with firedac, you can simplify his code to : procedure TForm1.Button1Click(Sender : TObject) begin Salestable.open('',[DateFrom.Date,Dateto.Date]); end;
-
search between two dates
programmerdelphi2k replied to Analyste2023's topic in RTL and Delphi Object Pascal
using "Between" dates: Using "PARAMetrizations" in your FDQuery for example: procedure TForm1.Button1Click(Sender: TObject); begin SalesTable.Close; SalesTable.ParamByName('DateBegin').AsDate := StrToDate('06/01/2023'); SalesTable.ParamByName('DateEnd').AsDate := StrToDate('06/30/2023'); SalesTable.Open; end; -
No data to provide any help on, sorry. We need more detail. If your UI view is populated from a database query just use an appropriate condition in the WHERE clause of the query. Most database engines support the BETWEEN operator for dates; just make sure to formulate the bounds using parameters and not date literals (which are sensitive to date formats, locales for client and server, great potential to cause a mess).
-
delphi Thread ITask.ExecuteWork not wait until Task finish in mobile devices?
KodeZwerg replied to bravesofts's topic in Cross-platform
Make your app the OOP way and event driven, split your source into smaller parts, start your selfmade sleep and fire at sync an event that executes next things...- 24 replies
-
- android
- multithreading
-
(and 2 more)
Tagged with: