What I'm trying to do is to get the list of fields in a class without an instance... for example:
TAClass=class
a_: Integer;
b_: Integer;
constructor (a,b Integer);
end;
I'm not being able to get the fieldTable from the VMT:
ovmt: PVmt;
ftable: PVmtFieldTable;
finfo: PVmtFieldEntry;
ovmt:=PVmt(TAClass);
ftable := ovmt^.vfieldtable
finfo := ftable^.fields[0]
this way I'm not gettig the list of fields
any help is welcome,
thanks in advance
Afaik the field tables in classic delphi and FPC only work for published fields. Published fields must be class fields (value types like integer must go via properties). Newer Delphi's also allow RTTI for non published fields, but that works differently (different untis), and FPC doesn't support that yet.
I hacked together a small demonstration example since the help for typinfo seems to be light on examples. Note the tpersistent derivation.
{$mode delphi}
uses typinfo,classes;
type
TAClass=class(Tpersistent)
a: tstringlist;
b: tlist;
end;
var
ovmt: PVmt;
FieldTable: PVMTFieldTable;
PVMTFieldEntry;
i: longint;
begin
ovmt := PVmt(TAClass);
while ovmt <> nil do
begin
FieldTable := PVMTFieldTable(ovmt^.vFieldTable);
if FieldTable <> nil then
begin
FieldInfo := #FieldTable^.Fields[0];
for i := 0 to FieldTable^.Count - 1 do
begin
writeln(fieldinfo^.name);
FieldInfo := PvmtFieldEntry(PByte(#FieldInfo^.Name) + 1 + Length(FieldInfo^.Name));
end;
end;
{ Try again with the parent class type }
ovmt:=ovmt^.vParent;
end;
end.
Related
This question already has answers here:
Incompatible types: 'string' and 'Double'
(2 answers)
Closed last year.
I have to check for a sound card, so I don't need quality but only one answer yes or no. I used this code:
function IsSoundCardInstalled: Boolean;
Begin
Result := waveOutGetNumDevs > 0;
End;
procedure TForm1.FormCreate(Sender: TObject);
var
ids: TidIpWatch;
Speed: Double;
myStringList: TStringList;
begin
ids := TidIpWatch.Create;
Speed := GetCPUSpeed;
ids.Free;
myStringList:=TStringList.Create;
myStringList.Add('IP:' + (ids.LocalIP));
myStringList.Add('CPU: ' + (Tipo_cpu) + ' ' + Format('%f', [Speed]));
myStringList.Add((IsSoundCardInstalled));
myStringList.Add('etc.');
Memo1.Lines.Assign(myStringList);
myStringList.Free;
end;
But the error returns to me:
[DCC Error] Unit1.pas(138): E2010 Incompatible types: 'string' and 'Boolean'
On the line:
myStringList.Add((IsSoundCardInstalled));
IsSoundCardInstalled() returns a Boolean, but myStringList.Add() expects a string instead. You can't assign a Boolean as-is to a string, you need to use a conversion function (just like in your previous question), such as SysUtils.BoolToStr():
uses
..., SysUtils;
myStringList.Add(BoolToStr(IsSoundCardInstalled));
Or SysUtils.TBooleanHelper.ToString() in XE4+:
uses
..., SysUtils;
myStringList.Add(IsSoundCardInstalled.ToString);
On a side note: you are freeing the TIdIPWatch component before reading its LocalIP property, which is undefined behavior.
For that matter, you should not be using TIdIPWatch in this manner at all. It is meant for notifying you when the local IP changes, and for maintaining a history of local IP changes over time, but that is not how you have been using it lately. The TIdIPWatch.LocalIP property simply reads the global GStack.LocalAddress property, that is what you should be using instead:
uses
..., IdStack;
TIdStack.IncUsage;
try
myStringList.Add('IP:' + GStack.LocalAddress);
finally
TIdStack.DecUsage;
end;
However, a machine can have multiple local IPs, so you really should use GStack.GetLocalAddressList() instead:
uses
..., IdStack;
var
myLocalIPList: TIdStackLocalAddressList;
i: Integer;
begin
...
TIdStack.IncUsage;
try
myLocalIPList := TIdStackLocalAddressList.Create;
try
GStack.GetLocalAddressList(myLocalIPList);
for I := 0 to myLocalIPList.Count-1 do
myStringList.Add('IP:' + myLocalIPList[I].IPAddress);
finally
list.Free;
end;
finally
TIdStack.DecUsage;
end;
...
end;
I use this code to ask for a password:
Inno Setup - Move the password page before the welcome page (first page)
And this code for custom language selector:
Inno Setup - Language selector with VCL Styles
When I merge them, it does not work.
I need password before that the language selector, so this is no correct:
function InitializeSetup(): Boolean;
var
Language: string;
begin
Result := True;
Language := ExpandConstant('{param:LANG}');
if Language = '' then
begin
Log('No language specified, showing language dialog');
SelectLanguage();
Result := False;
Exit;
end
else
begin
Log('Language specified, proceeding with installation');
Result := AskPassword();
end;
end;
And this way, with an incorrect password the setup continues.
function InitializeSetup(): Boolean;
var
Language: string;
begin
Result := True;
Language := ExpandConstant('{param:LANG}');
if Language = '' then
begin
Result := AskPassword();
Log('No language specified, showing language dialog');
SelectLanguage();
Result := False;
Exit;
end
else
begin
Log('Language specified, proceeding with installation');
end;
end;
Inno Setup 6
Inno Setup 6 has event attributes features that helps solving this problem.
Just make sure that each of your event implementation have an unique name, e.g. appending unique suffix. And add event attribute with the name of the implemented event.
[Code]
function InitializeSetup(): Boolean;
begin
Result := ...
end;
<event('InitializeSetup')>
function InitializeSetup2(): Boolean;
begin
Result := ...
end;
Inno Setup 5
In general, the easiest is to keep both implementations of the event function separate and add one wrapper implementation that call both.
function InitializeSetup1(): Boolean;
var
Language: string;
begin
Result := True;
Language := ExpandConstant('{param:LANG}');
if Language = '' then
begin
Log('No language specified, showing language dialog');
SelectLanguage();
Result := False;
Exit;
end
else
begin
Log('Language specified, proceeding with installation');
Result := True;
end;
end;
function InitializeSetup2(): Boolean;
begin
Result := AskPassword();
end;
function InitializeSetup(): Boolean;
begin
{ Order the calls the way you want the checks to be performed }
Result :=
InitializeSetup2() and
InitializeSetup1();
end;
For more general discussion of the problem, see
Merging event function (InitializeWizard) implementations from different sources
Though in your specific case, it's more complicated, as you will also need to pass the password from the first instance to the other, similarly to how the language is passed from the first instance to the other.
So actually, the InitializeSetup2 (password) implementation will have to be similar like the InitializeSetup1 (language), not to ask for the password again.
I actually do not really understand, why you complicate the things so much by not asking for language before the password. It would actually make sense. To get a localized password prompt.
I'm kinda a Delphi-newbie and I don't get how the Sort method of a TList of Records is called in order to sort the records by ascending integer value.
I have a record like the following:
type
TMyRecord = record
str1: string;
str2: string;
intVal: integer;
end;
And a generic list of such records:
TListMyRecord = TList<TMyRecord>;
Have tried to find a code-example in the help files and found this one:
MyList.Sort(#CompareNames);
Which I can't use, since it uses classes. So I tried to write my own compare function with a little different parameters:
function CompareIntVal(i1, i2: TMyRecord): Integer;
begin
Result := i1.intVal - i2.intVal;
end;
But the compiler always throws a 'not enough parameters' - error when I call it with open.Sort(CompareIntVal);, which seems obvious; so I tried to stay closer to the help file:
function SortKB(Item1, Item2: Pointer): Integer;
begin
Result:=PMyRecord(Item1)^.intVal - PMyRecord(Item2)^.intVal;
end;
with PMyRecord as PMyRecord = ^TMyRecord;
I have tried different ways of calling a function, always getting some error...
The Sort overload you should be using is this one:
procedure Sort(const AComparer: IComparer<TMyRecord>);
Now, you can create an IComparer<TMyRecord> by calling TComparer<TMyRecord>.Construct. Like this:
var
Comparison: TComparison<TMyRecord>;
....
Comparison :=
function(const Left, Right: TMyRecord): Integer
begin
Result := Left.intVal-Right.intVal;
end;
List.Sort(TComparer<TMyRecord>.Construct(Comparison));
I've written the Comparison function as an anonymous method, but you could also use a plain old style non-OOP function, or a method of an object.
One potential problem with your comparison function is that you may suffer from integer overflow. So you could instead use the default integer comparer.
Comparison :=
function(const Left, Right: TMyRecord): Integer
begin
Result := TComparer<Integer>.Default.Compare(Left.intVal, Right.intVal);
end;
It might be expensive to call TComparer<Integer>.Default repeatedly so you could store it away in a global variable:
var
IntegerComparer: IComparer<Integer>;
....
initialization
IntegerComparer := TComparer<Integer>.Default;
Another option to consider is to pass in the comparer when you create the list. If you only ever sort the list using this ordering then that's more convenient.
List := TList<TMyRecord>.Create(TComparer<TMyRecord>.Construct(Comparison));
And then you can sort the list with
List.Sort;
The concise answer:
uses
.. System.Generics.Defaults // Contains TComparer
myList.Sort(
TComparer<TMyRecord>.Construct(
function(const Left, Right: TMyRecord): Integer
begin
Result := Left.intVal - Right.intVal;
end
)
);
I want to share my solution (based on the input I have gathered here).
It's a standard setup. A filedata class that holds data of a single file in a generic TObjectList. The list has the two private attributes fCurrentSortedColumn and fCurrentSortAscending to control the sort order. The AsString-method is the path and filename combined.
function TFileList.SortByColumn(aColumn: TSortByColums): boolean;
var
Comparison: TComparison<TFileData>;
begin
result := false;
Comparison := nil;
case aColumn of
sbcUnsorted : ;
sbcPathAndName: begin
Comparison := function(const Left, Right: TFileData): integer
begin
Result := TComparer<string>.Default.Compare(Left.AsString,Right.AsString);
end;
end;
sbcSize : begin
Comparison := function(const Left, Right: TFileData): integer
begin
Result := TComparer<int64>.Default.Compare(Left.Size,Right.Size);
if Result = 0 then
Result := TComparer<string>.Default.Compare(Left.AsString,Right.AsString);
end;
end;
sbcDate : begin
Comparison := function(const Left, Right: TFileData): integer
begin
Result := TComparer<TDateTime>.Default.Compare(Left.Date,Right.Date);
if Result = 0 then
Result := TComparer<string>.Default.Compare(Left.AsString,Right.AsString);
end;
end;
sbcState : begin
Comparison := function(const Left, Right: TFileData): integer
begin
Result := TComparer<TFileDataTestResults>.Default.Compare(Left.FileDataResult,Right.FileDataResult);
if Result = 0 then
Result := TComparer<string>.Default.Compare(Left.AsString,Right.AsString);
end;
end;
end;
if assigned(Comparison) then
begin
Sort(TComparer<TFileData>.Construct(Comparison));
// Control the sort order
if fCurrentSortedColumn = aColumn then
fCurrentSortAscending := not fCurrentSortAscending
else begin
fCurrentSortedColumn := aColumn;
fCurrentSortAscending := true;
end;
if not fCurrentSortAscending then
Reverse;
result := true;
end;
end;
I found a much simpler modified sort function to alphabetize a TList of records or nonstandard list of items.
Example
PList = ^TContact;
TContact = record //Record for database of user contact records
firstname1 : string[20];
lastname1 : string[20];
phonemobile : Integer; //Fields in the database for contact info
phonehome : Integer;
street1 : string;
street2 : string;
type
TListSortCompare = function (Item1,
Item2: TContact): Integer;
var
Form1: TForm1;
Contact : PList; //declare record database for contacts
arecord : TContact;
Contacts : TList; //List for the Array of Contacts
function CompareNames(i1, i2: TContact): Integer;
begin
Result := CompareText(i1.lastname1, i2.lastname1) ;
end;
and the function to call to sort your list
Contacts.Sort(#CompareNames);
The Windows ribbon framework markup supports an EnablePinning attribute for the recent items menu in the application menu:
<ApplicationMenu.RecentItems>
<RecentItems CommandName="MRU" EnablePinning="true" />
</ApplicationMenu.RecentItems>
I expected that there would be a matching property that can be queried/updated at runtime, but I can't find a property key. Does anyone know if there is one, and, if so, what it is?
Alternatively, is there another way to turn pinning on/off at runtime? Neither the element nor its parent support application modes.
TIA
Clarification: What I'm trying to do is enable/disable pinning for the entire menu at runtime. I'm not concerned about the pin states of the individual items.
I'm not sure if you can modify the pinned state from existing entries but it's definitely possible to programmatically query the state and add new items with a specific state using the UI_PKEY_Pinned property:
https://msdn.microsoft.com/en-us/library/windows/desktop/dd940401(v=vs.85).aspx
Wrappers such as the Windows Ribbon Framework for Delphi or the Windows Ribbon for WinForms (.NET) provide an easy access to the API model. This CodeProject article also describes how to query/add recent items using C#.
If you want to change the state during runtime, you could for example query the state of all items, remove them from the list, adjust whetever you need and add them to the list again. Didn't do that yet, could be worth a try however.
Hmm... this will be quite difficult to accomplish as the flag is defined in the XML which will be compiled into a resource file that is linked to the application and then loaded on start up. You could create another resource definition and reload the ribbon if you want to disable/enable the flagging, but that's quite a lot overhead and certainly noticeable from an users perspective as it requires the creation of a new window handle.
I place the recent items by inside UpdateProperty
TRecentItem = class(TInterfacedObject, IUISimplePropertySet)
private
FRecentFile: TSSettings.TRecentFile;
protected
function GetValue(const key: TUIPropertyKey; out value: TPropVariant): HRESULT; stdcall;
public
procedure Initialize(const RecentFile: TSSettings.TRecentFile); safecall;
end;
function TMyForm.UpdateProperty(commandId: UInt32; const key: TUIPropertyKey;
currentValue: PPropVariant; out newValue: TPropVariant): HRESULT;
var
I: Integer;
psa: PSafeArray;
pv: Pointer;
RecentItem: TRecentItem;
begin
if (key = UI_PKEY_RecentItems) then
begin
psa := SafeArrayCreateVector(VT_UNKNOWN, 0, Settings.RecentFiles.Count);
if (not Assigned(psa)) then
Result := E_FAIL
else
begin
for I := 0 to Settings.RecentFiles.Count - 1 do
begin
RecentItem := TRecentItem.NewInstance() as TRecentItem;
RecentItem.Initialize(Settings.RecentFiles[I]);
pv := Pointer(IUnknown(RecentItem));
Check(SafeArrayPutElement(psa, I, pv^));
end;
Result := UIInitPropertyFromIUnknownArray(UI_PKEY_RecentItems, psa, PropVar);
SafeArrayDestroy(psa);
end;
end;
If a pin was changed, I get this command while closing the application menu:
function TMyForm.Execute(commandId: UInt32; verb: _UIExecutionVerb;
key: PUIPropertyKey; currentValue: PPropVariant;
commandExecutionProperties: IUISimplePropertySet): HRESULT; stdcall;
var
Count: Integer;
I: Integer;
Pinned: Boolean;
psa: PSafeArray;
pv: IUnknown;
RecentFile: UInt32;
SimplePropertySet: IUISimplePropertySet;
Value: TPropVariant;
begin
if ((commandId = cmdAppRecentItems)
and Assigned(key) and (key^ = UI_PKEY_RecentItems)
and Assigned(currentValue) and (currentValue^.vt = VT_ARRAY + VT_UNKNOWN)) then
begin
psa := nil;
Result := UIPropertyToIUnknownArrayAlloc(key^, currentValue^, psa);
if (Succeeded(Result)) then
begin
Result := SafeArrayGetUBound(psa, 1, Count);
for I := 0 to Count do
if (Succeeded(Result)) then
begin
Result := SafeArrayGetElement(psa, I, pv);
if (Succeeded(Result) and Assigned(pv)) then
begin
Result := pv.QueryInterface(IUISimplePropertySet, SimplePropertySet);
if (Succeeded(Result)) then
Result := SimplePropertySet.GetValue(UI_PKEY_Pinned, Value);
if (Succeeded(Result)) then
Result := UIPropertyToBoolean(UI_PKEY_Pinned, Value, Pinned);
if (Succeeded(Result)) then
Settings.RecentFiles.SetPinned(I, Pinned);
end;
end;
SafeArrayDestroy(psa);
end;
end
end;
... but I didn't find a documentation of this solution.
I have a record that looks similar to:
type
TNote = record
Title : string;
Note : string;
Index : integer;
end;
Simple. The reason I chose to set the variables as string (as opposed to an array of chars) is that I have no idea how long those strings are going to be. They can be 1 char long, 200 or 2000.
Of course when I try to save the record to a type file (file of...) the compiler complains that I have to give a size to string.
Is there a way to overcome this? or a way to save those records to an untyped file and still maintain a sort of searchable way?
Please do not point me to possible solutions, if you know the solution please post code.
Thank you
You can't do it with a typed file. Try something like this, with a TFileStream:
type
TStreamEx = class helper for TStream
public
procedure writeString(const data: string);
function readString: string;
procedure writeInt(data: integer);
function readInt: integer;
end;
function TStreamEx.readString: string;
var
len: integer;
iString: UTF8String;
begin
self.readBuffer(len, 4);
if len > 0 then
begin
setLength(iString, len);
self.ReadBuffer(iString[1], len);
result := string(iString);
end;
end;
procedure TStreamEx.writeString(const data: string);
var
len: cardinal;
oString: UTF8String;
begin
oString := UTF8String(data);
len := length(oString);
self.WriteBuffer(len, 4);
if len > 0 then
self.WriteBuffer(oString[1], len);
end;
function TStreamEx.readInt: integer;
begin
self.readBuffer(result, 4);
end;
procedure TStreamEx.writeInt(data: integer);
begin
self.WriteBuffer(data, 4);
end;
type
TNote = record
Title : string;
Note : string;
Index : integer;
procedure Save(stream: TStream);
end;
procedure TNote.Save(stream: TStream);
var
temp: TMemoryStream;
begin
temp := TMemoryStream.Create;
try
temp.writeString(Title);
temp.writeString(Note);
temp.writeInt(Index);
temp.seek(0, soFromBeginning);
stream.writeInt(temp.size);
stream.copyFrom(temp, temp.size);
finally
temp.Free;
end;
end;
I'll leave the Load procedure to you. Same basic idea, but it shouldn't need a temp stream. With the record size in front of each entry, you can read it and know how far to skip if you're looking for a certain record # instead of reading the whole thing.
EDIT: This was written specifically for versions of Delphi that use Unicode strings. On older versions, you could simplify it quite a bit.
Why not write this out as XML? See my session "Practical XML with Delphi" on how to get started with this.
Another possibility would be to make your records into classes descending form TComponent and store/retreive your data in DFM files.
This Stackoverflow entry shows you how to do that.
--jeroen
PS: Sorry my XML answer was a bit dense; I'm actually on the road for two conferences (BASTA! and DelphiLive! Germany).
Basically what you need to do is very simple: create a sample XML file, then start the Delphi XML Data Binding Wizard (available in Delphi since version 6).
This wizard will generate a unit for you that has the interfaces and classes mapping XML to Delphi objects, and a few helper functions for reading them from file, creating a new object, etc. My session (see the first link above) actually contains most of the details for this process.
The above link is a video demonstrating the usage of the Delphi XML Data Binding Wizard.
You could work with two different files, one that just stores the strings in some convenient way, the other stores the records with a reference to the strings. That way you will still have a file of records for easy access even though you don't know the size of the actual content.
(Sorry no code.)
TNote = record
Title : string;
Note : string;
Index : integer;
end;
could be translated as
TNote = record
Title : string[255];
Note : string[255];
Index : integer;
end;
and use Stream.writebuffer(ANodeVariable, sizeof(TNode), but you said that strings get go over 255 chars in this case IF a string goes over 65535 chars then change WORD to INTEGER
type
TNodeHeader=Record
TitleLen,
NoteLen: Word;
end;
(* this is for writing a TNode *)
procedure saveNodetoStream(theNode: TNode; AStream: TStream);
var
header: TNodeHeader;
pStr: PChar;
begin
...
(* writing to AStream which should be initialized before this *)
Header.TitleLen := Length(theNode.Title);
header.NodeLen := Length(theNode.Note);
AStream.WriteBuffer(Header, sizeof(TNodeHeader);
(* save strings *)
PStr := PChar(theNode.Title);
AStream.writeBuffer(PStr^, Header.TitleLen);
PStr := PChar(theNode.Note);
AStream.writebuffer(PStr^, Header.NoteLen);
(* save index *)
AStream.writebuffer(theNode.Index, sizeof(Integer));
end;
(* this is for reading a TNode *)
function readNode(AStream: TStream): TNode;
var
header: THeader
PStr: PChar;
begin
AStream.ReadBuffer(Header, sizeof(TNodeHeader);
SetLength(Result.Title, Header.TitleLen);
PStr := PChar(Result.Title);
AStream.ReadBuffer(PStr^, Header.TitleLen);
SetLength(Result.Note, Header.NoteLen);
PStr := PChar(Result.Note);
AStream.ReadBuffer(PStr^, Header.NoteLen);
AStream.ReadBuffer(REsult.Index, sizeof(Integer)(* 4 bytes *);
end;
You can use the functions available in this Open Source unit.
It allows you to serialize any record content into binary, including even dynamic arrays within:
type
TNote = record
Title : string;
Note : string;
Index : integer;
end;
var
aSave: TRawByteString;
aNote, aNew: TNote;
begin
// create some content
aNote.Title := 'Title';
aNote.Note := 'Note';
aNote.Index := 10;
// serialize the content
aSave := RecordSave(aNote,TypeInfo(TNote));
// unserialize the content
RecordLoad(aNew,pointer(aSave),TypeInfo(TNote));
// check the content
assert(aNew.Title = 'Title');
assert(aNew.Note = 'Note');
assert(aNew.Index = 10);
end;