TStringList CustomSort method in FreePascal - components

What am I doign wrong with the following code
function CompareFloat(List: TStringList; Index1, Index2: Integer): Integer;
and I call it as :
var
SL :TstringList;
SL.CustomSort(CompareFloat);
//SL.CustomSort(#CompareFloat); // Tried this one also
The first function call 'SL.CustomSort(CompareFloat)' retrieves that error from compiler "Error: Wrong number of parameters specified for call to "CompareFloat"
Second function call 'SL.CustomSort(#CompareFloat)' retrieves that error from compiler Error: Only class methods can be referred with class references

SL.CustomSort(CompareFloat); works if you add {$mode delphi} directive to somewhere to the beginning of a unit.
However SL.CustomSort(#CompareFloat); should work fine. Make sure the error message is not caused by something else.
Example:
program Project1;
//{$mode delphi}
uses
Classes,
SysUtils;
function CompareFloat(List: TStringList; Index1, Index2: Integer): Integer;
begin
Result := StrToInt(List[Index1]) - StrToInt(List[Index2]);
end;
var
SL: TStringList;
begin
SL := TStringList.Create;
try
SL.Add('3');
SL.Add('2');
SL.Add('1');
SL.CustomSort(#CompareFloat);
//SL.CustomSort(CompareFloat);
Writeln(SL[0], SL[1], SL[2]);
Readln;
finally
SL.Free;
end;
end.

Related

Optional Parameters in Delphi [duplicate]

Is there any way to skip the default params, say suppose my method declaration is like this:
procedure MyProc1(var isAttr1: Boolean = FALSE;
var isAttr2: Boolean = FALSE; var isAttr3: Boolean = FALSE);
I can't call the function like this:
Self.MyProc1( , , Attr3);
because I don't want unnecessary var declarations, at the same time I want the last param return value (it is a var type)
Thank for help in advance.
Sorry, you can't do this. What's more you can't have a var parameter with a default as you have with isAttr1.
If your parameters had sufficiently different parameter types, then you could use overloaded methods as an alternative to default parameters, which is a technique that I personally prefer. But your parameters are all Boolean and so you can't do that here.
Other posters have suggested something like this:
procedure Myfunc1(var isAttr1, isAttr2, isAttr3: Boolean); overload;
procedure Myfunc1(var isAttr3: Boolean); overload;
This will compile and work but would be counter to the principle of least surprise. For overloaded procedures like this, you would expect, for the procedure with only a single parameter, for that single parameter to be the first parameter of the procedure with multiple parameters. In other words you would expect:
procedure Myfunc1(var isAttr1, isAttr2, isAttr3: Boolean); overload;
procedure Myfunc1(var isAttr1: Boolean); overload;
In this case you should use the overload directive:
The Overload directive allows you to
have different versions of the same
named function or procedure with
different arguments.
Yes, make an overloaded version of MyFunc1(isAttr3 : boolean = FALSE); overload;
Have it make up the dummy params and pass them for you.
As the other poster points out, you can do this with VAR.
Also, it's wrong to call it MyFunc if it's not a Function. Call it MyProc!
My solution:
function ov(p1 : boolean; p2 : boolean; p3 : boolean) : boolean; overload;
begin
result := p1 or p2 or p3;
end;
function ov(p3 : boolean) : boolean; overload;
begin
result := ov(false, false, p3);
end;
Now you can have your choice of:
ov(TestBool3)
or
ov(TestBool1, TestBool2, TestBool3)

Convert TStream to String?

In Delphi 10.4, I try to convert a TStream to a string with this code:
function MyStreamToString(aStream: TStream): string;
var
SS: TStringStream;
begin
if aStream <> nil then
begin
SS := TStringStream.Create('');
try
SS.CopyFrom(aStream, 0); // Exception: TStream.Seek not implemented
Result := SS.DataString;
finally
SS.Free;
end;
end else
begin
Result := '';
end;
end;
But in this code line, I get an exception "TStream.Seek not implemented": SS.CopyFrom(aStream, 0);
Why? How can I "heal" this code?
The error means you are passing your function a TStream object that does not implement Seek() at all. Such as if you are passing in an actual TStream object and not a derived object, like TFileStream, TMemoryStream, etc, for instance:
var
Strm: TStream;
begin
Strm := TStream.Create; // <-- ERROR
try
MyStreamToString(Strm);
finally
Strm.Free;
end;
end;
TStream is an abstract base class, it should never be instantiated directly.
In this case, the 32-bit Seek() method in the base TStream class calls the 64-bit Seek() method, but will raise that "Seek not implemented" exception if the 64-bit Seek() has not been overridden. A TStream-derived class must override either the 32-bit Seek() or the 64-bit Seek(), and the overridden method must not call the base TStream method it is overriding.
So, make sure you are passing in a valid stream object to your function.

Equivalent of InterlockedExchangeAdd for Linux using Delphi 10.2)

Delphi 10.2 (having support for Linux) has a cross Platform function AtomicExchange which is equivalent to Windows InterlocekdEchange. So far so good...
I have to port Win32 code making use of InterlockedExchangeAdd which has no AtomicExchangeAdd equivalent.
My question is: what can I use to replace InterlockedExchangeAdd when compiling for Linux ?
There is a hidden implementation of this function in System.SysUtils.pas:
function AtomicExchangeAdd(var Addend: Integer; Value: Integer): Integer;
begin
Result := AtomicIncrement(Addend, Value) - Value;
end;
It makes use of the fact that AtomicIncrement returns the new value of Addend, while InterlockedExchangeAdd returns the old value. Subtracting Value gives the expected result and obviously is thread-safe.
InterlockedExchangeAdd() "performs an atomic addition of Value to the value pointed to by Addend. The result is stored in the address specified by Addend."
The System.SyncObjs unit has a TInterlocked class, which has overloaded Add() methods to do the same thing:
Increments an integer value with another.
There are two overloaded Add methods. Both Add methods increment a Target by Increment.
class function Add(var Target: Integer; Increment: Integer): Integer; overload; static; inline;
class function Add(var Target: Int64; Increment: Int64): Int64; overload; static; inline;
The difference is that InterlockedExchangeAdd() "returns the initial value of the variable pointed to by Addend", whereas TInterlocked.Add() "returns the value of the incremented parameter" instead. So, if you use the return value, you will have to account for that difference, eg:
function InterlockedExchangeAdd(var Addend: Integer; Value: Integer): Integer;
begin
Result := TInterlocked.Add(Addend, Value) - Value;
end;

Compile Error when trying to return PChar or OleVariant for UDF

The title doesn't quite capture the essence of the issue.
I have a UDF function that returns a PChar.
function AccountDescription(sAccountId: PChar) : PChar; stdcall;
This was working fine but I realized I wanted to return #N/A if the accountId was not found.
I discovered CVErr(xlErrNA) and changed the Signature to return OleVariant.
But now I am receiving [Error] Incompatible types: 'OleVariant' and 'PAnsiChar'.
I could not find any information on how to resolve this so I figure my understanding of the problem must not be correct.
I tried just passing a string which compiled but produced a runtime error of "Invalid variant type".
The full code is:
function AccountDescription(sAccountId: PChar): OleVariant; stdcall;
var
strResult: string;
strPChar : PChar;
begin
try
strResult:= repo.GetAccount(sAccountId).Description;
strPChar := strAlloc(length(strResult)+1) ;
StrPCopy(strPChar, strResult) ;
Result := strPChar;
except
Result := CVErr(xlErrNA);
end;
end;
Note: Is excel responsible for destroying the string or is that my cleanup? Should I be creating a copy or should I just be returning a pointer to an existing string. After typing it I feel like I should be returning a pointer.
Update:
Removed some irrelevant code in the example.
Now using:
function AccountDescription(sAccountId: PChar): OleVariant; stdcall;
var
strResult: string;
begin
try
Result := PChar(repo.GetAccount(sAccountId).Description);
except
Result := CVErr(xlErrNA);
end;
end;
You do not need the PChar cast, you can assign a String directly to an OleVariant (it will be converted by the RTL into a BSTR that the receiver will then free when done using it):
Result := repo.GetAccount(sAccountId).Description;
As for reporting an error, do you have a viable CVErr() function in your Delphi code? In VB, CVErr() returns a Variant of type Error (varError in Delphi) containing an error code (xlErrNA is 2042). Delphi has a VarAsError() function for that same purpose:
Result := VarAsError(2042);

Selective critical section - conditional

I got a thread which takes a db table as a paramater, I got an issue where I can't write to that db table at the same time.
1 instance of TMyThread can have a db table of 'Member' while another could have 'Staff' however there can be cases of two threads open with the same table.
Thus, I need to wrap the code in a critical section (or similar) but I don't want some dirty thing like several crical sections like (fMemberTable, fStaffTable)...
begin
if fDBTable = 'Member' then
fMemberTable.Enter
else if fDbTable = 'Staff' then
....
We have 8 tables so that would get messy
Is there some way to do
TCricalSection(fMemberTable).Enter;
Or some way to do this which is easy to 'scale' and use?
One critical section around the function doesn't make sense, as I don't want to hold back other tables....
You can do:
TMonitor.Enter(fMemberTable);
try
// Do your stuff
finally TMonitor.Exit(fMemberTable);
end;
Please note this is a SPIN LOCK, not a true critical section. Very practical if you're not going to have a lot of collisions, but if threads block each other regularly, you might want to fall back to the critical section. The spin lock is, by definition, a busy-wait lock.
but I'm not sure what version of Delphi introduced this and you don't have version-specific tags.
You can use a Critical Section list, for example, My class defined in this unit:
interface
uses Classes, SyncObjs;
type
{ TCriticalSectionList by jachguate }
{ http://jachguate.wordpress.com }
TCriticalSectionList = class
private
FCSList: TThreadList;
FNameList: TStringList;
function GetByName(AName: string): TCriticalSection;
public
constructor Create();
destructor Destroy(); override;
property ByName[AName: string]: TCriticalSection read GetByName; default;
end;
function CSList: TCriticalSectionList;
implementation
uses SysUtils;
{ TCriticalSectionList }
constructor TCriticalSectionList.Create;
begin
inherited;
FCSList := TThreadList.Create;
FNameList := TStringList.Create;
end;
destructor TCriticalSectionList.Destroy;
var
I: Integer;
AList: TList;
begin
AList := FCSList.LockList;
for I := AList.Count - 1 downto 0 do
TCriticalSection(AList[I]).Free;
FCSList.Free;
FNameList.Free;
inherited;
end;
function TCriticalSectionList.GetByName(AName: string): TCriticalSection;
var
AList: TList;
AIdx: Integer;
begin
AList := FCSList.LockList;
try
AName := UpperCase(AName);
AIdx := FNameList.IndexOf(AName);
if AIdx < 0 then
begin
FNameList.Add(AName);
Result := TCriticalSection.Create;
AList.Add(Result);
end
else
Result := AList[AIdx];
finally
FCSList.UnlockList;
end;
end;
var
_CSList: TCriticalSectionList;
function CSList: TCriticalSectionList;
begin
if not Assigned(_CSList) then
_CSList := TCriticalSectionList.Create;
Result := _CSList;
end;
initialization
_CSList := nil;
finalization
_CSList.Free;
end.
The class basically define a List of critical sections, accesible by "name". The first time you ask for a Critical section of a particular name that critical section is automatically created for you. You must access a single instance of this class, use the provided CSList function.
All critical sections are destroyed when the instance of the list is destroyed, for instance, the "default" instance is destroyed upon application end.
You can write code like this example:
begin
CSList[fDBTable].Enter;
try
DoStuff;
finally
CSList[fDBTable].Leave;
end;
end;
Enjoy.

Resources