I need to read some information regarding the monitors connected through the EnumDisplayDevicesA function.
I tried to convert the following example written in c++ to delphi, but I have a problem when I try to read the device name from the PDISPLAY_DEVICEA structure LDeviceName := LDisplayDevice.deviceName; as it only returns Chinese characters.
I think it is a problem related to character encoding but I don't know how to fix it.
My source code:
program Monitor;
{$APPTYPE CONSOLE}
uses
System.SysUtils;
const
user32 = 'user32.dll';
type
LONG = LongInt;
BOOL = LongBool;
PDISPLAY_DEVICE = ^DISPLAY_DEVICE;
LPCSTR = array[0..128 - 1] of WideChar;
PLPCSTR = ^LPCSTR;
//https://learn.microsoft.com/en-us/windows/win32/api/wingdi/ns-wingdi-display_devicea
DISPLAY_DEVICE = packed record
cb: Cardinal;
deviceName: array[0..32 - 1] of WideChar;
deviceString: array[0..128 - 1] of WideChar;
stateFlags: Cardinal;
deviceID: array[0..128 - 1] of WideChar;
deviceKey: array[0..128 - 1] of WideChar;
end;
//https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-enumdisplaydevicesa
function EnumDisplayDevicesA(APCSTR: PLPCSTR; iDevNum: Cardinal; PDISPLAY_DEVICEA: PDISPLAY_DEVICE; dwFlags: Cardinal): BOOL; stdcall; external user32;
procedure PrintMonitorNames();
var
LDisplayDevice: DISPLAY_DEVICE;
LDeviceIndex: Integer;
LMonitorIndex: Integer;
LDeviceName: string;
begin
LDisplayDevice.cb := Sizeof(LDisplayDevice);
LDeviceIndex := 0;
while EnumDisplayDevicesA(nil, LDeviceIndex, #LDisplayDevice, 0) do
begin
LDeviceName := LDisplayDevice.deviceName;
Writeln('Device name: ' + LDeviceName);
LMonitorIndex := 0;
while EnumDisplayDevicesA(#LDeviceName, LMonitorIndex, #LDisplayDevice, 0) do
begin
Writeln(StrPas(LDisplayDevice.deviceName) + ' ' + StrPas(LDisplayDevice.deviceString));
Inc(LMonitorIndex);
end;
Inc(LDeviceIndex);
end;
end;
var
LDummy: string;
begin
Writeln('START');
PrintMonitorNames();
Writeln('FINISH');
Readln(LDummy);
end.
You are mixing ANSI and Unicode.
The EnumDisplayDevices function exists in two versions:
EnumDisplayDevicesA which is (legacy) ANSI.
EnumDisplayDevicesW which is Unicode.
You are calling the ANSI version EnumDisplayDevicesA, but are using a Unicode version of DISPLAY_DEVICE. So you need to use EnumDisplayDevicesW instead.
This phenomenon that an API function exists in both W and A versions is present everywhere in the Windows API, so the above remarks are very general.
The fact that you get Chinese text because of this encoding mismatch is also very well known.
Having said all this, you don't need to declare EnumDisplayDevices yourself at all. Everything you need is already present in the Delphi RTL's Windows.pas unit, just like I showed you two days ago:
program Project1;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils,
Winapi.Windows;
begin
var dd, md: TDisplayDevice;
FillChar(dd, SizeOf(dd), 0);
dd.cb := SizeOf(dd);
FillChar(md, SizeOf(md), 0);
md.cb := SizeOf(md);
var i := 0;
while EnumDisplayDevices(nil, i, dd, 0) do
begin
var j := 0;
while EnumDisplayDevices(#dd.DeviceName[0], j, md, 0) do
begin
Writeln(md.DeviceString);
Inc(j);
end;
Inc(i);
end;
Readln;
end.
Notice that MSDN says this:
The winuser.h header defines EnumDisplayDevices as an alias which automatically selects the ANSI or Unicode version of this function based on the definition of the UNICODE preprocessor constant.
The same remarks applies to the Delphi RTL's Windows.pas.
Ihave value from nor or xor gate with represented as TBits and i want to convert it to generic variable like integer or unsigned integer my current working ide Tokyo 10.2
var
ABits: TBits;
AComulative: UInt32;
const
PosBitFromSensor1 = 0;
PosBitFromSensor2 = 1;
begin
ABits := TBits.Create;
try
ABits.Size := 32;
{GetValFromSensor return Boolean type}
ABits.Bits[PostBitFromSensor1] := GetValFromSensor(PosBitFromSensor1);
ABits.Bits[PostBitFromSensor2] := GetValFromSensor(PosBitFromSensor2);
AComulative := SomeBitsConvertToInteger(ABits); {some function like this}
finally
ABits.Free;
end;
end;
or any simple solution.
It won't be very fast but you can do regular bit manipulation, set each bit that corresponds to a "true" in the boolean array . For example:
function SomeBitsConvertToInteger(ABits: TBits): UInt32;
var
i: Integer;
begin
if ABits.Size <> SizeOf(Result) * 8 then
raise EBitsError.Create('Invalid bits size');
Result := 0;
for i := 0 to Pred(SizeOf(Result) * 8) do
Result := Result or UInt32((Ord(ABits[i]) shl i));
end;
this solution provided by #Victoria and #LURD it maybe usefull for the other that have same solving problem. sorry about my English.
type
TBitsHelper = class helper for TBits
public
function ToUInt32: UInt32;
end;
{ TBitsHelper }
function TBitsHelper.ToUInt32: UInt32;
type
PUInt32 = ^UInt32;
begin
if Size > SizeOf(Result) * 8 then
raise EOverflow.Create('Size overflow!');
with Self do
Result := PUInt32(FBits)^;
end;
maybe something like this :
type
{$IF CompilerVersion > 32} // tokyo
{$MESSAGE Fatal 'Check if TBits still has the exact same fields and adjust the IFDEF'}
{$ENDIF}
TPrivateAccessBits = class
public
FSize: Integer;
FBits: Pointer;
end;
Move(#TPrivateAccessBits(ABits).FBits, AComulative, sizeOf(AComulative));
Building, not just compiling, the following fails with an internal compiler error when using Delphi 6 if optimization is on. Using the assignment instead of the inc() works. Is this a compiler bug? The weird record structures are because the original code has been reduced to this minimal example.
program Project1;
type
requestCountsType = array[0..1] of
record
processed: int64;
end;
talliestype = record
counts: requestCountsType;
end;
healthtype = record
charged: talliestype;
end;
procedure computeProcessed(const h: healthtype; var requests, bytesin, bytesout: int64);
var i: byte;
begin
requests := 0; bytesin := 0; bytesout := 0;
for i := 0 to 1 do
begin
inc(requests, h.charged.counts[i].processed); // including this generates compiler internal error C1405 when optimization is on
// requests := requests + h.charged.counts[i].processed; // this works
end;
end;
var ht: healthtype; var r, b1, b2: int64;
begin
computeProcessed(ht, r, b1, b2);
end.
See bug report #109124. I can confirm the problem in Delphi XE; the bug report says it was fixed in Delphi XE4.
In this other question I asked: Drawing on a paintbox - How to keep up with mouse movements without delay?.
The function GetMouseMovePointsEx was brought to my attention by Sebastian Z, however in Lazarus I am unable to find this function.
He mentioned that in Delphi XE6 it is in Winapi.Windows.pas, in Lazarus though it is not in Windows.pas.
I understand Lazarus is by no means an exact copy of Delphi but this function sounds like it could be the answer I am looking for in that other question. Im just having a hard time finding where it is and even getting any Delphi documentation on it. I do have Delphi XE but right now it is not installed and my project is been written in Lazarus.
I did a Find in Files... search from the Lazarus IDE targeting the install folder and the only result that came back was from one of the fpc sources in:
lazarus\fpc\2.6.4\source\packages\winunits-jedi\src\jwawinuser.pas
I am not sure if I should use the above unit or not, or whether Lazarus has a different variant to GetMouseMovePointsEx?
Does anyone using Lazarus have any experience with GetMouseMovePointsEx and if so where can I find it?
Thanks.
Here's a quick example using Delphi. What you still need to do is filter out the points you've already received.
type
TMouseMovePoints = array of TMouseMovePoint;
const
GMMP_USE_HIGH_RESOLUTION_POINTS = 2;
function GetMouseMovePointsEx(cbSize: UINT; var lppt: TMouseMovePoint; var lpptBuf: TMouseMovePoint; nBufPoints: Integer; resolution: DWORD): Integer; stdcall; external 'user32.dll';
function GetMessagePosAsTPoint: TPoint;
type
TMakePoints = packed record
case Integer of
1: (C : Cardinal);
2: (X : SmallInt; Y : SmallInt);
end;
var
Tmp : TMakePoints;
begin
Tmp.C := GetMessagePos;
Result.X := Tmp.X;
Result.Y := Tmp.Y;
end;
function GetMousePoints: TMouseMovePoints;
var
nVirtualWidth: Integer;
nVirtualHeight: Integer;
nVirtualLeft: Integer;
nVirtualTop: Integer;
cpt: Integer;
mp_in: MOUSEMOVEPOINT;
mp_out: array[0..63] of MOUSEMOVEPOINT;
mode: Integer;
Pt: TPoint;
I: Integer;
begin
Pt := GetMessagePosAsTPoint;
nVirtualWidth := GetSystemMetrics(SM_CXVIRTUALSCREEN) ;
nVirtualHeight := GetSystemMetrics(SM_CYVIRTUALSCREEN) ;
nVirtualLeft := GetSystemMetrics(SM_XVIRTUALSCREEN) ;
nVirtualTop := GetSystemMetrics(SM_YVIRTUALSCREEN) ;
cpt := 0 ;
mode := GMMP_USE_DISPLAY_POINTS ;
FillChar(mp_in, sizeof(mp_in), 0) ;
mp_in.x := pt.x and $0000FFFF ;//Ensure that this number will pass through.
mp_in.y := pt.y and $0000FFFF ;
mp_in.time := GetMessageTime;
cpt := GetMouseMovePointsEx(SizeOf(MOUSEMOVEPOINT), mp_in, mp_out[0], 64, mode) ;
for I := 0 to cpt - 1 do
begin
case mode of
GMMP_USE_DISPLAY_POINTS:
begin
if (mp_out[i].x > 32767) then
mp_out[i].x := mp_out[i].x - 65536;
if (mp_out[i].y > 32767) then
mp_out[i].y := mp_out[i].y - 65536;
end;
GMMP_USE_HIGH_RESOLUTION_POINTS:
begin
mp_out[i].x := ((mp_out[i].x * (nVirtualWidth - 1)) - (nVirtualLeft * 65536)) div nVirtualWidth;
mp_out[i].y := ((mp_out[i].y * (nVirtualHeight - 1)) - (nVirtualTop * 65536)) div nVirtualHeight;
end;
end;
end;
if cpt > 0 then
begin
SetLength(Result, cpt);
for I := 0 to cpt - 1 do
begin
Result[I] := mp_out[I];
end;
end
else
SetLength(Result, 0);
end;
// the following is for demonstration purposes only, it still needs some improvements like filtering out points that were already processed. But it's good enough for painting a blue line on a TImage
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
MMPoints: TMouseMovePoints;
Pt: TPoint;
I: Integer;
begin
Image1.Canvas.Pen.Color := clBlue;
MMPoints := GetMousePoints;
for I := 0 to Length(MMPoints) - 1 do
begin
Pt.x := MMPoints[I].x;
Pt.y := MMPoints[I].y;
Pt := Image1.ScreenToClient(Pt);
if I = 0 then
Image1.Canvas.MoveTo(PT.X, pt.y)
else
Image1.Canvas.LineTo(PT.X, pt.y);
end;
end;
This function is implemented as part of the Win32 library. It is no more a Delphi or FPC function than it is a C++ or VB function. You import it from Win32.
In Delphi, this importing is achieved by way of the declaration of the function in the Windows unit. If you examine the source of this unit you'll find lots of type and constant declarations, as well as functions. The functions are typically implemented using the external keyword which indicates that the implementation is external to this code. The Windows unit is what is known as a header translation. That is it is a translation of the C/C++ header files from the Win32 SDK.
So you need a header translation with this function. The JEDI header translations are the most usual choice. And it seems that you've already found them. If the versions supplied with FPC serve your needs, use them.
Sometimes you might find yourself on the bleeding edge of progress and need to use a function that has not been included in any of the standard header translations. In that scenario it's usually simple enough to perform the translation yourself.
I have this code
type
TXSample = (xsType1, xsType2, xsType3, xsType4, xsType5, xsType6, xsType6, xsTyp7, xsType8); // up to FXSample30;
..
private
FXSample = Set of TXSample;
..
published
property Sample: TXSample read FXSample write FXSample;
..
//if Sample has a value of
Sample := [xsType2, xsType4, xsType5, xsType6, xsTyp7];
how can i save/load the property of Sample?
i would like to save it in the database.
is it possible?
Provided your set will never exceed 32 possibilities (Ord(High(TXSample)) <= 31), then it is perfectly fine to typecast the set into an Integer and back:
type
TXSamples = set of TXSample;
var
XSamples: TXSamples;
begin
ValueToStoreInDB := Integer(XSamples);
Integer(XSamples) := ValueReadFromDB;
end;
To be more specific: SizeOf(TXSamples) has to be precisely equal to SizeOf(StorageTypeForDB). Thus the following ranges apply for Ord(High(TXSample)) when typecasting TXSamples to:
Byte: Ord(High(TXSample)) < 8
Word: 8 <= Ord(High(TXSample)) < 16
Longword: 16 <= Ord(High(TXSample)) < 32
UInt64: 32 <= Ord(High(TXSample)) < 64
Directly typecasting a set variable is not possible in Delphi, but internally Delphi stores the set as a byte-value. By using an untyped move, it is easy copied into an integer. Note that these functions only go up to a size of 32 (bounds of an integer). To increase the bounds, use Int64 instead.
function SetToInt(const aSet;const Size:integer):integer;
begin
Result := 0;
Move(aSet, Result, Size);
end;
procedure IntToSet(const Value:integer;var aSet;const Size:integer);
begin
Move(Value, aSet, Size);
end;
Demo
type
TMySet = set of (mssOne, mssTwo, mssThree, mssTwelve=12);
var
mSet: TMySet;
aValue:integer;
begin
IntToSet(7,mSet,SizeOf(mSet));
Include(mSet,mssTwelve);
aValue := SetToInt(mSet, SizeOf(mSet));
end;
Personally, I would convert the set to an integer and store it in the database as an INT field, like others suggested. #teran suggested using the TIntegerSet type, and here is my approach working on native integers using bit operations.
Note that you can use SampleInInteger() to determine whether a certain element from the enumeration is present in the integer mask generated by SampleSetToInteger().
Here's the code:
program Project1;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils;
type
{ .: TXSample :. }
TXSample = (xsType1 = 0, xsType2, xsType3, xsType4, xsType5,
xsType6, xsType7, xsType8); // up to FXSample30;
TXSampleSet = set of TXSample;
// Converts a TXSampleSet to an integer.
function SampleSetToInteger(const S: TXSampleSet): Integer;
var
Sample: TXSample;
begin
Result := 0;
for Sample := Low(TXSample) to High(TXSample) do
if (Sample in S) then
Result := Result or (1 shl Ord(Sample));
end;
// Converts an integer to TXSampleSet.
function IntegerToSampleSet(const Int: Integer): TXSampleSet;
var
I: Integer;
begin
Result := [];
for I := 0 to Ord(High(TXSample)) do
if Int and (1 shl I) <> 0 then
Result := Result + [TXSample(I)];
end;
// Checks if a TXSample is present in the integer.
function SampleInInteger(const S: TXSample; const Int: Integer): Boolean;
begin
Result := Int and (1 shl Ord(S)) <> 0;
end;
var
XSample, XSample1: TXSampleSet;
Tmp: Integer;
begin
XSample := [xsType2, xsType4, xsType5, xsType6, xsType7];
XSample1 := [xsType1];
Tmp := SampleSetToInteger(XSample);
Writeln(Tmp);
XSample1 := IntegerToSampleSet(Tmp);
if (xsType5 in XSample1) then
Writeln('Exists');
if (SampleInInteger(xsType1, Tmp)) then
Writeln('Exists in int');
Readln;
end.
A Delphi set is simply a collection of (possibly) related boolean flags. Each boolean flag corresponds to whether or not the matching ordinal value is in the set.
You could certainly pack a set into an integer value by representing the set as a bitset. Or you could create a textual representation of the set.
However, both of these options leave you with no tractable ability to query the database at the SQL level. For this reason I would advise you to represent each value in the set, i.e. each boolean flag, as a separate field (i.e. column) of the database table. This gives you the most powerful representation of the data.
the easiest way to store set in database (as #DavidHeffernan mentioned in comment) is to convert your set to bit-mask.
in int32 (integer) value you have 32 bits and can save set up to 32 fields;
Delphi has TIntegerSet (see http://docwiki.embarcadero.com/Libraries/en/System.SysUtils.TIntegerSet) type defined in SysUtils. it is declared as:
TIntegerSet = set of 0..SizeOf(Integer) * 8 - 1;
so using it, it is simple to convert set to integer and back (just casting TIngeterSet to integer or vice versa);
bit-mask is also good option because it is only one INT field in your database table.
also you can create separate table in your DB to store set content (main table (id, ...), and setValuesTable (main_id, setElementValue)) (this option is good for using in db queries)
here is an example of using TIntegerSet:
program Project1;
{$APPTYPE CONSOLE}
uses System.SysUtils;
type
TXSample = (xsType1, xsType2, xsType3, xsType4, xsType5, xsType6, xsType7, xsType8);
TSampleSet = set of TXSample;
function SampleSetToInteger(ss : TSampleSet) : integer;
var intset : TIntegerSet;
s : TXSample;
begin
intSet := [];
for s in ss do
include(intSet, ord(s));
result := integer(intSet);
end;
function IntegerToSampleSet(mask : integer) : TSampleSet;
var intSet : TIntegerSet;
b : byte;
begin
intSet := TIntegerSet(mask);
result := [];
for b in intSet do
include(result, TXSample(b));
end;
var xs : TSampleSet;
mask : integer;
begin
xs := [xsType2, xsType6 .. xsType8];
mask := SampleSetToInteger(xs); //integer mask
xs := IntegerToSampleSet(mask);
end.
Set variables can be saved successfully to a TStream descendant. Here's an example.
Just create a new vcl forms application, add two TButton components to it and fill in the OnClick events for each button as illustrated in the example below.
This was created in XE4 so the uses clause might be different for other versions of Delphi but that should be trivial to change by removing the namespace indicators before each unit in the uses clause. Saving a set type variable with articulated values is possible to a binary file and easily with Delphi. In other words,
Also suggested is taking a look at the TypInfo unit if you have the source or just using the functions provided which make dissecting Set types down to their text representation fairly simple though no example is provided here. That is suggested if you want to include saving to a config or ini file or in a persistence format that is text editable.
The one below is the simplest one that I know of. Looking at the binary output of a set type saved to a stream like the one below implies that it is saved in the smallest possible bitmapped representation for the set based on its size. The one below maps to one byte on disk (the value is 5) which means that each value must be mapped to a power of 2 (seThis = 1, seThat = 2, seTheOther = 4) just like manually created constant bitmasked values. The compiler likely enforces that it follows rules that forces set to retain their ordinality. This example was tested an works in Delphi XE4.
Hope that helps.
Brian Joseph Johns
unit Unit1;
interface
uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
Vcl.StdCtrls;
type
TSomeEnum = (seThis, seThat, seTheOther);
TSomeEnumSet = set of TSomeEnum;
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
SomeSetVar: TSomeEnumSet;
SomeBoolean: Boolean;
SomeInt: Integer;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
SomeSetVar := [seThis, seTheOther];
SomeBoolean := True;
SomeInt := 31415;
with TFileStream.Create('SetSave.bin',fmCreate or fmOpenWrite or fmShareCompat) do
try
Write(SomeSetVar,SizeOf(SomeSetVar));
Write(SomeBoolean,SizeOf(Boolean));
Write(SomeInt,SizeOf(Integer));
finally
Free;
end;
SomeSetVar := [];
SomeInt := 0;
SomeBoolean := False;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
ResponseStr: string;
begin
with TFileStream.Create('SetSave.bin',fmOpenRead or fmShareCompat) do
try
Read(SomeSetVar,SizeOf(SomeSetVar));
Read(SomeBoolean,SizeOf(Boolean));
Read(SomeInt,SizeOf(Integer));
finally
Free;
end;
ResponseStr := 'SomeSetVar = ';
if (seThis in SomeSetVar) then
ResponseStr := ResponseStr + 'seThis ';
if (seThat in SomeSetVar) then
ResponseStr := ResponseStr + 'seThat ';
if (seTheOther in SomeSetVar) then
ResponseStr := ResponseStr + 'seTheOther ';
ResponseStr := ResponseStr + ' SomeBoolean = ' + BoolToStr(SomeBoolean);
ResponseStr := ResponseStr + ' SomeInt = ' + IntToStr(SomeInt);
ShowMessage(ResponseStr);
end;
end.
With a little help from RTTI it can be achieved in a generic way:
program SetConverter;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.RTTI, System.SysUtils;
type
SetConverter<T> = class abstract
strict private
class var FRttiContext: TRttiContext;
public
class function ToInteger(aSet: T): Integer;
class function FromInteger(aValue: Integer): T;
end;
{ SetConverter<T> }
class function SetConverter<T>.FromInteger(aValue: Integer): T;
var
ResultValues: TIntegerSet;
ReturnType: TRttiType;
SetValues: TIntegerSet;
EnumSet: T absolute SetValues;
begin
ReturnType := FRttiContext.GetType(Self).GetMethod('FromInteger').ReturnType;
if not((ReturnType is TRttiSetType) and (TRttiSetType(ReturnType).ElementType is TRttiEnumerationType)) then
Exit;
SetValues := TIntegerSet(aValue);
Result := EnumSet;
end;
class function SetConverter<T>.ToInteger(aSet: T): Integer;
var
RttiParameter: TRttiParameter;
ResultValues: TIntegerSet;
SetValues: TIntegerSet;
EnumSet: T absolute SetValues;
EnumType: TRttiEnumerationType;
SetType: TRttiSetType;
i: Integer;
begin
Result := 0;
RttiParameter := FRttiContext.GetType(Self).GetMethod('ToInteger').GetParameters[0];
if not(RttiParameter.ParamType is TRttiSetType) then
Exit;
SetType := RttiParameter.ParamType as TRttiSetType;
if not(SetType.ElementType is TRttiEnumerationType) then
Exit;
EnumType := SetType.ElementType as TRttiEnumerationType;
EnumSet := aSet;
ResultValues := [];
for i := EnumType.MinValue to EnumType.MaxValue do
if i in SetValues then
Include(ResultValues, i);
Result := Integer(ResultValues);
end;
type
TXSample = (xsType1, xsType2, xsType3, xsType4, xsType5, xsType6, xsType7, xsType8);
TSampleSet = set of TXSample;
var
Before, After: TSampleSet;
i: Integer;
begin
Before := [xsType2, xsType6 .. xsType8];
i := SetConverter<TSampleSet>.ToInteger(Before);
After := SetConverter<TSampleSet>.FromInteger(i);
WriteLN('Before = After: ' + (Before = After).ToString(TUseBoolStrs.True));
Readln;
end.
You can use this unit to convert set to int. if you need more settoint functions you can add yours by looking code below.
Set may take only 1 byte memory space.
So you can obtain yourSet size and get result as modula of this result.
example: your set size: 1 byte you can get result -->
Result := pINT^ mod maxVal
You should obtain maxval by calculating maxvalue of variable type.
maxVal = Power( 2, (8*sizeof(MySet)-1) )
unit u_tool;
interface
uses Graphics;
type
TXSample = (xsType1, xsType2, xsType3, xsType4, xsType5, xsType6, xsType6, xsTyp7, xsType8); // up to FXSample30;
FXSample = Set of TXSample;
function FXSampleToInt(FXSample: FXSample ): Integer;
function IntToFXSample(Value: Integer): FXSample;
function FontStyleToInt(FontStyle: TFontStyles ): Integer;
function IntToFontStyle(Value: Integer): TFontStyles;
implementation
function FXSampleToInt(FXSample: FXSample ): Integer;
var
pInt: PInteger;
begin
pInt := #FXSample;
Result := pInt^;
end;
function IntToFXSample(Value: Integer): FXSample;
var
PFXSample: ^FXSample;
begin
PFXSample := #Value;
Result := PFXSample^;
end;
function FontStyleToInt(FontStyle: TFontStyles ): Integer;
var
pInt: PInteger;
begin
pInt := #FontStyle;
Result := pInt^;
end;
function IntToFontStyle(Value: Integer): TFontStyles;
var
PFontStyles: ^TFontStyles;
begin
PFontStyles := #Value;
Result := PFontStyles^;
end;
end.
Or we can make compiler forget about the types completly and then define what it should see (in case we know in compile-time what it sould see). This solution is so awful as it can be written on just one line.
type
// Controls.TCMMouseWheel relies on TShiftState not exceeding 2 bytes in size
TShiftState = set of (ssShift, ssAlt, ssCtrl,
ssLeft, ssRight, ssMiddle,
ssDouble, ssTouch, ssPen,
ssCommand, ssHorizontal);
var
Shifts : TShiftState;
Value : Integer;
begin
Shifts := TShiftState((Pointer(#Value))^):
Value := (PInteger(#Shifts))^;
if ssShift in TShiftState((Pointer(#Value))^) then
Exit;
end;
It happens that unused (top) bits are set (or not) but it has no influence on set operations (in, =, +, -, * .. ).
This line in Delphi:
Shifts := TShiftState((Pointer(#Value))^);
is like this in Assembler (Delphi XE6):
lea eax,[ebp-$0c]
mov ax,[eax]
mov [ebp-$06],ax
On Delphi 2007 (where is TShiftState is smaller so Byte can be used) this Assembler:
movzx eax,[esi]
mov [ebp-$01],al
Simplest solution - proceeding the set directly as numeric variable. The "absolute" is a keyword:
procedure Foo(FXSample: TFXSample);
var
NumericFxSample: Byte absolute FXSample;
begin
WriteLn(YourTextFile, NumericFxSample);//numeric value from a set
end;
If your type is wider than 8 bits you need to use wider numeric type like word (up to 16 items in a set) or dword.