Related
How would I code this so that if an element equals a certain value it would display a message, but if ALL elements inside that array aren't equal to that value, then it would output 'None'?
I've tried
for i := 0 to high(array) do
begin
if (array[i].arrayElement = value) then
begin
WriteLn('A message');
end;
end;
That bit works, but I don't know how to do the check all bit. I had this:
if (array[i].arrayElement to array[high(array)].arrayElement <> value) then
begin
WriteLn('None');
end;
But it didn't allow me to use "to"
It's clearest to write a helper function for this:
function ArrayContains(const arr: array of Integer; const value: Integer): Boolean;
var
i: Integer;
begin
for i := Low(arr) to High(arr) do
if arr[i] = value then
begin
Result := True;
Exit;
end;
Result := False;
end;
Or using for/in:
function ArrayContains(const arr: array of Integer; const value: Integer): Boolean;
var
item: Integer;
begin
for item in arr do
if item = value then
begin
Result := True;
Exit;
end;
Result := False;
end;
Then you call it like this:
if not ArrayContains(myArray, myValue) then
Writeln('value not found');
I think this will look like 'do my homework' kind of a question, but I'm still at the 'copy code, use it and try to understand it' phase, and this is the most active thing I know of for posting questions of this theme.
I have a record:
type
Card = record
Name: string;
Up,Right,Left,Down,Mark: Single;
IDNumber: Integer;
end;
And array of that record:
var
ArrayCard: array of Card;
And I wanted to know how can a dynamic array of this kind be stored/loaded to/from a file.
Tried using this piece of code: http://www.pascalgamedevelopment.com/showthread.php?6319-save-load-a-dynamic-array
like this:
Procedure TMainFrom.WriteMyData;
Var
FS : TFileStream;
I,iSize : Integer;
TmpPath: string;
Begin
TmpPath:= TPath.Combine(TPath.GetDocumentsPath, 'Cards.dat');
FS := TFileStream.Create(TmpPath, fmOpenWrite);
iSize:= Length(ArrayCard);
FS.WriteBuffer(iSize,SizeOf(iSize));
For I := 0 To iSize - 1 Do
FS.WriteBuffer(ArrayCard[I],SizeOf(Card));
FS.Free;
End;
An it seems to work so far, but then I try to load it like this:
Procedure TMainFrom.ReadMyData;
Var
FS : TFileStream;
I,iSize : Integer;
TmpPath: string;
TempCard : Card;
Begin
TmpPath:= TPath.Combine(TPath.GetDocumentsPath, 'Cards.dat');
FS := TFileStream.Create(TmpPath, fmOpenRead);
FS.ReadBuffer(iSize,SizeOf(iSize));
SetLength(ArrayCard,iSize);
For I := 0 To iSize - 1 Do
Begin
FS.ReadBuffer(TempCard,SizeOf(Card));
ArrayCard[I] := TempCard; //It Breaks Here...The Watch List: TempCard Inaccessible value
End;
FS.Free;
End;
And I get a Exception EAccessViolation in module...
Then I also tried something like this: delphi Save and Load dynamic array
It loads the array with the correct amount of items, but they are all empty or blank:
procedure TMainFrom.SaveCardsToFile;
var
Stream: TStream;
L: Integer;
TmpPath: string;
ICount: Integer;
strm: TMemoryStream;
begin
TmpPath:= TPath.Combine(TPath.GetDocumentsPath, 'Cards.bin');
Stream:= TFileStream.Create(TmpPath, fmCreate);
L:= Length(ArrayCard);
Stream.WriteBuffer(L, SizeOf(L));
Stream.WriteBuffer(Pointer(ArrayCard)^, L * SizeOf(Card));
Stream.Free;
end;
procedure TMainFrom.LoadCardsFromFile;
var
Stream: TStream;
L: LongWord;
TmpPath: string;
begin
TmpPath:= TPath.Combine(TPath.GetDocumentsPath, 'Cards.bin');
Stream:= TFileStream.Create(TmpPath, fmOpenRead);
Stream.ReadBuffer(L, SizeOf(L));
SetLength(ArrayCard, L);
Stream.ReadBuffer(Pointer(ArrayCard)^, L * SizeOf(Card));
Stream.Free;
end;
Do not use buffer operations with records which contains "normal" strings. Instead of shortstring, string is only pointer to string content. So, your code saves and loads only pointer to string content, not string. You can get Access Violation if loaded value points to unreachable memory.
Change your code to separately save and load variables in record, like this:
type
TmyRec = record
str: string;
i: integer;
procedure SaveToStream(Stream: TStream);
procedure LoadFromStream(Stream: TStream);
end;
{ myRec }
procedure TmyRec.LoadFromStream(Stream: TStream);
var
strLen: integer;
strBuf: TBytes;
begin
Stream.Read(strLen, SizeOf(Integer));
SetLength(strBuf, strLen);
Stream.Read(strBuf, strLen);
str:=TEncoding.UTF8.GetString(strBuf);
Stream.Read(i, SizeOf(Integer));
end;
procedure TmyRec.SaveToStream(Stream: TStream);
var
strBuf: TBytes;
strLen: integer;
begin
// direct set encoding type helps to avoid problems with different platforms.
// for example, Windows uses UCS2, Android and iOS - UTF8 encoding
strBuf:=TEncoding.UTF8.GetBytes(str);
strLen:=Length(strBuf);
Stream.Write(strLen, SizeOf(Integer));
Stream.Write(strBuf, strLen);
Stream.Write(i, SizeOf(Integer));
end;
Update:
do you read about generics? Instead of dynamic array, you can use TList and load/save records in it:
type
TmyRecList = class(TList<TmyRec>)
public
procedure SaveToStream(Stream: TStream);
procedure LoadFromStream(Stream: TStream);
end;
{ TmyRecList }
procedure TmyRecList.LoadFromStream(Stream: TStream);
var
Len: integer;
i: Integer;
rec: TmyRec;
begin
Clear;
Stream.Read(Len, SizeOf(integer));
for i := 0 to Len-1 do
begin
Rec.LoadFromStream(Stream);
Add(rec);
end;
end;
procedure TmyRecList.SaveToStream(Stream: TStream);
var
i: Integer;
begin
Stream.Write(Count, SizeOf(Integer));
for i := 0 to Count-1 do
Items[i].SaveToStream(Stream);
end;
procedure THeaderFooterForm.FormCreate(Sender: TObject);
var
Stream: TStream;
rec: TmyRec;
recList: TmyRecList;
begin
Stream:=TMemoryStream.Create;
try
recList:=TmyRecList.Create;
try
rec.str:='sample text';
rec.i:=123;
recList.Add(rec);
rec.str:='another text';
rec.i:=234;
recList.Add(rec);
recList.SaveToStream(Stream);
Stream.Seek(0, soBeginning);
recList.LoadFromStream(Stream);
ShowMessage('this is str value in second record: ' + recList[1].str);
finally
recList.Free;
end;
finally
Stream.Free;
end;
With some help, I have managed to remake my code to work properly.
Firstly I needed to make the string something like string[20] but that couldn't compile for android so I modified my record to use array of char like this:
type
EventString= array [0..20] of Char;
Card = record
Name: EventString; //string[20]
Up,Right,Left,Down,Mark: Single;
IDNumber: Integer;
end;
Then I modified my Saving/Loading procedures to use TFileStream instead of TStream and a for loop:
procedure TMainFrom.SaveCardsToFile;
var
Stream: TFileStream;
L: Integer;
TmpPath: string;
n: Integer;
begin
TmpPath:= TPath.Combine(TPath.GetDocumentsPath, 'Cards.bin');
Stream:= TFileStream.Create(TmpPath, fmCreate);
L:= Length(ArrayCard)-1;
for n:=0 to L do
begin
Stream.WriteBuffer(ArrayCard[n], SizeOf(Card)); //Saving
end;
Stream.Free;
end;
procedure TMainFrom.LoadCardsFromFile;
var
Stream: TFileStream;
L: LongWord;
TmpPath: string;
n: Integer;
begin
TmpPath:= TPath.Combine(TPath.GetDocumentsPath, 'Cards.bin');
Stream:= TFileStream.Create(TmpPath, fmOpenRead);
SetLength(ArrayCard, Round(Stream.Size/SizeOf(Card)));
L:= Length(ArrayCard)-1;
for n:=0 to L do
begin
Stream.ReadBuffer(ArrayCard[n], SizeOf(Card)); //Loading
ListCard.Items.Add(ArrayCard[n].Name); //Just adds card names to a listbox
end;
Stream.Free;
end;
And now it works just fine.
I want to select more than one text file in the windows explorer and open the files via context menu in my app. For one file I found the solution but for more files there some ideas but no (working) solutions.
Anyone here that has the answer?
Here is an example that i've just searched and collected from internet.
Aim: Select multiple folders in Windows Explorer and get list of these folders' names via a shell context menu item "SelectedFolders", or using SendTo menu or drag-and-drop folders from shell onto the application form.
Please put a listbox named lstSelectedFolders and a speed button named sbClearList.
The main form name is frmSelectedFolders.
Here we go.
/////////////////////////////////////////////////////////////
program selectedfolders;
uses
Windows, Messages, SysUtils, Forms,
uSelectedFolders in 'uSelectedFolders.pas' {frmSelectedFolders};
{$R *.res}
var
receiver: THandle;
i, result: integer;
s: string;
dataToSend: TCopyDataStruct;
Mutex : THandle;
begin
Mutex := CreateMutex(nil, True, 'SelectedFolders');
if (Mutex <> 0) and (GetLastError = 0) then
begin
Application.Initialize;
Application.Title := 'Selected Folders';
Application.CreateForm(TfrmSelectedFolders, frmSelectedFolders);
Application.Run;
if Mutex <> 0 then CloseHandle(Mutex);
end
else
begin
receiver := FindWindow(PChar('TfrmSelectedFolders'), PChar('Selected Folders'));
if receiver <> 0 then
begin
for i:=1 to ParamCount do
begin
s := trim(ParamStr(i));
if s <> '' then
begin
dataToSend.dwData := 0;
dataToSend.cbData := 1 + Length(s);
dataToSend.lpData := PChar(s);
result := SendMessage(receiver, WM_COPYDATA, Integer(Application.Handle), Integer(#dataToSend));
//sleep(100);
//if result > 0 then
// ShowMessage(Format('Sender side: Receiver has %d items in list!', [result]));
end;
end; // for i
end;
end;
end.
/////////////////////////////////////////////////////////////
unit uSelectedFolders;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ShellAPI, ActiveX, ComObj, ShlObj, Registry, Buttons;
type
TfrmSelectedFolders = class(TForm)
lstSelectedFolders: TListBox;
sbClearList: TSpeedButton;
procedure FormCreate(Sender: TObject);
procedure sbClearListClick(Sender: TObject);
private { Private declarations }
public { Public declarations }
procedure WMDROPFILES(var Message: TWMDROPFILES); message WM_DROPFILES;
procedure WMCopyData(var Msg: TWMCopyData); message WM_COPYDATA;
function GetTarget(const LinkFileName: string): string;
end;
var
frmSelectedFolders: TfrmSelectedFolders;
implementation
{$R *.dfm}
procedure RegisterContextMenuForFolders();
const
Key = 'Directory\shell\SelectedFolders\command\';
begin
with TRegistry.Create do
try
// for all users, class registration for directories
RootKey := HKEY_CLASSES_ROOT;
if OpenKey(Key, true) then
WriteString('', '"' + Application.ExeName + '" "%l"');
finally
Free;
end;
end;
procedure TfrmSelectedFolders.WMDROPFILES(var Message: TWMDROPFILES);
var
N, i: integer;
buffer: array[0..255] of Char;
s: string;
begin
try
N := DragQueryFile(Message.Drop, $FFFFFFFF, nil, 0);
for i:=1 to N do
begin
DragQueryFile(Message.Drop, i-1, #buffer, SizeOf(buffer));
s := buffer;
if UpperCase(ExtractFileExt(s)) = '.LNK' then
s := GetTarget(s);
if lstSelectedFolders.Items.IndexOf(s) < 0 then
lstSelectedFolders.Items.Add(s);
end;
finally
DragFinish(Message.Drop);
end;
end;
function TfrmSelectedFolders.GetTarget(const LinkFileName: string): string;
var
//Link : String;
psl : IShellLink;
ppf : IPersistFile;
WidePath : Array[0..260] of WideChar;
Info : Array[0..MAX_PATH] of Char;
wfs : TWin32FindData;
begin
if UpperCase(ExtractFileExt(LinkFileName)) <> '.LNK' then
begin
Result := 'NOT a shortuct by extension!';
Exit;
end;
CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER, IShellLink, psl);
if psl.QueryInterface(IPersistFile, ppf) = 0 Then
Begin
MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, PChar(LinkFileName), -1, #WidePath, MAX_PATH);
ppf.Load(WidePath, STGM_READ);
psl.GetPath(#info, MAX_PATH, wfs, SLGP_UNCPRIORITY);
Result := info;
end
else
Result := '';
end;
procedure TfrmSelectedFolders.WMCopyData(var Msg: TWMCopyData);
var
s: string;
begin
s := trim(PChar(Msg.copyDataStruct.lpData));
if s = '' then
begin
msg.Result := -1;
exit;
end;
if UpperCase(ExtractFileExt(s)) = '.LNK' then
s := GetTarget(s);
if lstSelectedFolders.Items.IndexOf(s) < 0 then
lstSelectedFolders.Items.Add(s);
msg.Result := lstSelectedFolders.Items.Count;
end;
procedure TfrmSelectedFolders.FormCreate(Sender: TObject);
var
i: integer;
s: string;
begin
RegisterContextMenuForFolders();
DragAcceptFiles(Handle, TRUE);
lstSelectedFolders.Clear;
s := ExtractFileDir(Application.ExeName);
lstSelectedFolders.Items.Add(s);
for i:=1 to ParamCount do
begin
s := trim(ParamStr(i));
if UpperCase(ExtractFileExt(s)) = '.LNK' then
s := GetTarget(s);
if lstSelectedFolders.Items.IndexOf(s) < 0 then
lstSelectedFolders.Items.Add(s);
end;
end;
procedure TfrmSelectedFolders.sbClearListClick(Sender: TObject);
begin
lstSelectedFolders.Clear;
end;
end.
I'm trying to create my own class object and use it to store various data types for my application, this all works fine when using Published Properties, I can stream these to disk and back with no problems. But I need to stream some Arrays of both integer and strings data types as well.
I understand that Arrays, amongst other data types can't be published properties because Delphi doesn't know how to stream them, I was led to believe you need to use DefineProperties to accomplish this, I've created a test Array of String as a Public property, I can read and write to it just fine, however I need to stream it to disk so i can save it for future use.
The only thing i can find that touches on this subject is here:
Array of a custom class as a property
I've attempted to copy this code and manipulate it to archive what I need but I cannot get it to save, I'm seemingly missing something obvious, my test code I'm using is below, I get no errors with this code, published properties stream to disk ok but my private array does not. Any help would be greatly appreciated.
Thanks.
unit UnitDataSet;
//------------------------------------------------------------------------------
interface
uses System.Classes;
{$M+}
//------------------------------------------------------------------------------
type
TDataStrings = Array [1..50] of String;
TDataSet = class(TComponent)
protected
procedure DefineProperties(Filer: TFiler); override;
procedure ReadArray(Reader: TReader);
procedure WriteArray(Writer: TWriter);
private
FArrayToSave : TDataStrings;
FPStr : String;
function GetItem(I: Integer): String;
procedure SetItem(I: Integer; Value: string);
public
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;
procedure LoadFromStream(const Stream: TStream);
procedure LoadFromFile(const FileName: string);
procedure SaveToStream(const Stream: TStream);
procedure SaveToFile(const FileName: string);
property Items[I: Integer]: String read GetItem write SetItem;
published
property StringItem : String read FPStr write FPStr;
end;
//------------------------------------------------------------------------------
var
DataSet: TDataSet;
implementation
uses TypInfo, Sysutils;
{ TDataSet }
//------------------------------------------------------------------------------
procedure TDataSet.DefineProperties(Filer: TFiler);
begin
inherited;
Filer.DefineProperty('DataArray', ReadArray, WriteArray, True);
end;
//------------------------------------------------------------------------------
destructor TDataSet.Destroy;
begin
inherited;
end;
//------------------------------------------------------------------------------
function TDataSet.GetItem(I: Integer): string;
begin
Result := '';
if (I > 0) and (I < Length(FArrayToSave)) then
Result := FArrayToSave[I];
end;
//------------------------------------------------------------------------------
procedure TDataSet.SetItem(I: Integer; Value: string);
begin
if (I > 0) and (I < Length(FArrayToSave)) then
FArrayToSave[I] := Value;
end;
//------------------------------------------------------------------------------
procedure TDataSet.LoadFromFile(const FileName: string);
var
Stream: TStream;
begin
Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
try
LoadFromStream(Stream);
finally
Stream.Free;
end;
end;
//------------------------------------------------------------------------------
procedure TDataSet.LoadFromStream(const Stream: TStream);
var
Reader: TReader;
PropName, PropValue: string;
begin
Reader := TReader.Create(Stream, $FFF);
Stream.Position := 0;
Reader.ReadListBegin;
while not Reader.EndOfList do
begin
PropName := Reader.ReadString;
PropValue := Reader.ReadString;
SetPropValue(Self, PropName, PropValue);
end;
FreeAndNil(Reader);
end;
//------------------------------------------------------------------------------
procedure TDataSet.SaveToFile(const FileName: string);
var
Stream: TStream;
begin
Stream := TFileStream.Create(FileName, fmCreate);
try
SaveToStream(Stream);
finally
Stream.Free;
end;
end;
//------------------------------------------------------------------------------
procedure TDataSet.SaveToStream(const Stream: TStream);
var
PropName, PropValue: string;
cnt: Integer;
lPropInfo: PPropInfo;
lPropCount: Integer;
lPropList: PPropList;
lPropType: PPTypeInfo;
Writer: TWriter;
begin
lPropCount := GetPropList(PTypeInfo(ClassInfo), lPropList);
Writer := TWriter.Create(Stream, $FFF);
Stream.Size := 0;
Writer.WriteListBegin;
for cnt := 0 to lPropCount - 1 do
begin
lPropInfo := lPropList^[cnt];
lPropType := lPropInfo^.PropType;
if lPropType^.Kind = tkMethod then Continue;
PropName := lPropInfo.Name;
PropValue := GetPropValue(Self, lPropInfo);
Writer.WriteString(PropName);
Writer.WriteString(PropValue);
end;
Writer.WriteListEnd;
FreeAndNil(Writer);
end;
//------------------------------------------------------------------------------
constructor TDataSet.Create(aOwner: TComponent);
begin
inherited;
end;
//------------------------------------------------------------------------------
procedure TDataSet.ReadArray(Reader: TReader);
var
N: Integer;
begin
N := 0;
Reader.ReadListBegin;
while not Reader.EndOfList do begin
Reader.ReadListBegin;
FArrayToSave[N] := Reader.ReadString;
Reader.ReadListEnd;
Inc(N);
end;
Reader.ReadListEnd;
end;
//------------------------------------------------------------------------------
procedure TDataSet.WriteArray(Writer: TWriter);
var
I: Integer;
begin
Writer.WriteListBegin;
for I := 1 to High(FArrayToSave) do begin
Writer.WriteListBegin;
Writer.WriteString(FArrayToSave[I]);
Writer.WriteListEnd;
end;
Writer.WriteListEnd;
end;
//------------------------------------------------------------------------------
initialization
DataSet := TDataSet.Create(Nil);
finalization
FreeAndNil(DataSet);
end.
//------------------------------------------------------------------------------
Here is my Class code re-written with Arioch's suggested code modifications from below:
unit UnitCharSett;
interface
//------------------------------------------------------------------------------
uses System.Classes;
//------------------------------------------------------------------------------
type
TCustomDatSetA = Array [0..99] of String;
TCustomCharSet = class(TComponent)
public
procedure LoadFromStream(const Stream: TStream);
procedure LoadFromFile(const FileName: string);
procedure SaveToStream(const Stream: TStream);
procedure SaveToFile(const FileName: string);
end;
TZCharSet = class(TCustomCharSet)
private
FFullArray : TCustomDatSetA;
function GetItem(I: Integer): String;
procedure SetItem(I: Integer; Value: string);
protected
procedure DefineProperties(Filer: TFiler); override;
procedure ReadArray(Reader:TReader);
procedure WriteArray(Writer:TWriter);
public
property Items[Index: Integer]: string read GetItem write SetItem;
published
end;
//------------------------------------------------------------------------------
implementation
uses
System.TypInfo, System.SysUtils;
//------------------------------------------------------------------------------
procedure TCustomCharSet.LoadFromFile(const FileName: string);
var
Stream: TStream;
begin
Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
try
LoadFromStream(Stream);
finally
Stream.Free;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomCharSet.LoadFromStream(const Stream: TStream);
begin
Stream.ReadComponent(Self);
end;
//------------------------------------------------------------------------------
procedure TCustomCharSet.SaveToFile(const FileName: string);
var
Stream: TStream;
begin
Stream := TFileStream.Create(FileName, fmCreate);
try
SaveToStream(Stream);
finally
Stream.Free;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomCharSet.SaveToStream(const Stream: TStream);
begin
Stream.WriteComponent(Self);
end;
//------------------------------------------------------------------------------
{ TZCharSett }
//------------------------------------------------------------------------------
procedure TZCharSet.DefineProperties(Filer: TFiler);
begin
inherited;
Filer.DefineProperty('DataArray', ReadArray, WriteArray, True);
end;
//------------------------------------------------------------------------------
function TZCharSet.GetItem(I: Integer): string;
begin
Result := '';
if (I > -1) and (I < Length(FFullArray)) then
Result := FFullArray[I];
end;
//------------------------------------------------------------------------------
procedure TZCharSet.ReadArray(Reader: TReader);
var
N: Integer;
S: String;
begin
for N := Low(FFullArray) to High(FFullArray) do begin
FFullArray[N] := '';
end;
Reader.ReadListBegin;
N := Reader.ReadInteger;
if N = Length(FFullArray) then
begin
N := Low(FFullArray);
while not Reader.EndOfList do
begin
S := Reader.ReadString;
if N <= High(FFullArray) then
FFullArray[N] := S;
Inc(N);
end;
end;
Reader.ReadListEnd;
end;
//------------------------------------------------------------------------------
procedure TZCharSet.SetItem(I: Integer; Value: string);
begin
if (I > -1) and (I < Length(FFullArray)) then
FFullArray[I] := Value;
end;
//------------------------------------------------------------------------------
procedure TZCharSet.WriteArray(Writer: TWriter);
var
I: Integer;
begin
Writer.WriteListBegin;
Writer.WriteInteger(Length(FFullArray));
for I := Low(FFullArray) to High(FFullArray) do begin
Writer.WriteString(FFullArray[I]);
end;
Writer.WriteListEnd;
end;
//------------------------------------------------------------------------------
initialization
RegisterClasses([TZCharSet]);
//------------------------------------------------------------------------------
end.
HOW do you actually try to read and write it ? I think you're trying to make complex incompatible things when there instead of using standard methods.
Why not to use standard VCL streaming procedures?
procedure TMyDataSet.SaveToStream(const Stream: TStream);
begin
Stream.WriteComponent(self);
end;
procedure TMyDataSet.LoadFromStream(const Stream: TStream);
begin
Stream.ReadComponent(self);
end;
However if instead of using TFiler and standard VCL streamer you make your custom code using RTTI (GetPropList) - then it would not call those virtual properties APi custom to TFiler and would only show real properties.
So my advice is just to use standard emthods like shown above and to streamline and harden the code.
And since RegisterClass works by the classname you'd better choose another name, not clashing with a real TDataSet from stock DB unit.
Fix the name and do register the class, so VCL streamer could find it by name! For example:
procedure TMyDataSet.ReadArray(Reader: TReader);
var
N: Integer; S: String;
begin
N := Low(FArrayToSave);
Reader.ReadListBegin;
while not Reader.EndOfList do begin
S := Reader.ReadString; // even if we would not save it - we should remove it from the input
if N <= High(FArrayToSave) then
FArrayToSave[N] := S;
Inc(N);
end;
Reader.ReadListEnd;
end;
procedure TMyDataSet.WriteArray(Writer: TWriter);
var
I: Integer;
begin
Writer.WriteListBegin;
for I := Low(FArrayToSave) to High(FArrayToSave) do begin
Writer.WriteString(FArrayToSave[I]);
end;
Writer.WriteListEnd;
end;
initialization
DataSet := TMyDataSet.Create(Nil);
RegisterClasses([TMyDataSet]);
finalization
DataSet.Free;
end.
Additionally, i think you'd better - for future extensibility - save the array length in DFM.
procedure TMyDataSet.WriteArray(Writer: TWriter);
var
I: Integer;
begin
Writer.WriteInteger(Length(FArrayToSave));
Writer.WriteListBegin;
for I := Low(FArrayToSave) to High(FArrayToSave) do begin
....
procedure TMyDataSet.ReadArray(Reader: TReader);
var
N: Integer; S: String;
begin
for N := Low(FArrayToSave) to High(FArrayToSave) do begin
FArrayToSave := ''; // in case DFM would have less elements than 50
N := Reader.ReadInteger;
if N <> Length(FArrayToSave) then... recovery from unexpected DFM version error
N := Low(FArrayToSave);
Reader.ReadListBegin;
while not Reader.EndOfList do begin
PS. you do not need {$M+} there since TComponent already is derived from TPersistent
PPS. Wanted to comment upon update in the question, but the phone refuses to do (too long?) so putting it here.
1: since we moved away from using RTTI, the Typinfo unit no more needed in uses. 2: if N = Length(FFullArray) then lacks ELSE path. Okay, now we learned that DFM is broken or incompatible, what then? I think we better raise some error. Or try to remove list of N strings, so next property could be read. Or even remove the list of elements of any type/quantity until list end. Future compatibly is never warranted, but at least some attempt can be done, even just to explicitly halt with error. Skipping reading and silently leaving the reader inside middle of property, so next properties would get crazy, I think is not the way to do it.
And generally David is correct about ignoring incorrect indices in the setter and getter. Unless you would intentionally come with some unusual pattern of implicit item creation from default template in sparse array by setting or getting with "free" "unbound" index (which is no code for either) the better approach at least in Delphi would be "fail early". That is what users of your class would expect by default. So kinda
Procedure class.CheckArrayIdx(const i: integer);
Var mx, mn : integer;
Begin
Mn := low(myarray) ; Mx := high(myarray);
If (i <= mx) and (I >= mn) then exit;
Raise ERangeError.CreateFmt('%s.Items index should be %d <= %d <= %d', [
Self.ClassName, mn, I, mx]) ;
End;
This procedure can be called as 1st line in both setter and getter. Then you can just work with surely correct index value.
I have an array of byte that I wish to convert into a hex string, and then back into an array of byte.
I am using the following to convert into a hex string:
function bintoHex(const bin: array of byte): String;
const HexSymbols = '0123456789ABCDEF';
var i: integer;
begin
SetLength(Result, 2*Length(bin));
for i := 0 to Length(bin)-1 do begin
Result[1 + 2*i + 0] := HexSymbols[1 + bin[i] shr 4];
Result[1 + 2*i + 1] := HexSymbols[1 + bin[i] and $0F];
end;
end;
I am unsure how to convert it back into an array of byte properly. I am shooting for something like the following:
Type TDCArray = Array of Byte;
function xHexToBin(const HexStr: String): TDCArray;
const HexSymbols = '0123456789ABCDEF';
var i: integer;
begin
SetLength(Result, ???); //Need to now get half of the length, unsure how to go about that
for i := 0 to Length(HexStr)-1 do begin
//Here convert back into an array somehow...
//Result[i] := ???
end;
end;
How would I go about doing this?
Also, I am using Delphi XE2.
Why not just use the BinToHex and HexToBin RTL functions?
{$APPTYPE CONSOLE}
uses
System.Classes,
System.SysUtils;
var
LArray : array[1..6] of Byte = (10, 11, 12, 13, 14, 15);
LText: string;
I : integer;
begin
try
SetLength(LText, Length(LArray)*2);
BinToHex(#LArray, PChar(LText), SizeOf(LArray));
//show the hex string
Writeln(LText);
//fill the array with 0
FillChar(LArray, SizeOf(LArray), #0);
//get the values from the hex string
HexToBin(PChar(LText), #LArray, Length(LArray));
//show the array values
for i := 1 to Length(LArray) do
Write(LArray[i]);
Readln;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
If you want to do it yourself:
function xHexToBin(const HexStr: String): TBytes;
const HexSymbols = '0123456789ABCDEF';
var i, J: integer;
B: Byte;
begin
SetLength(Result, (Length(HexStr) + 1) shr 1);
B:= 0;
i := 0;
while I < Length(HexStr) do begin
J:= 0;
while J < Length(HexSymbols) do begin
if HexStr[I + 1] = HexSymbols[J + 1] then Break;
Inc(J);
end;
if J = Length(HexSymbols) then ; // error
if Odd(I) then
Result[I shr 1]:= B shl 4 + J
else
B:= J;
Inc(I);
end;
if Odd(I) then Result[I shr 1]:= B;
end;
2 hex chars represent 1 byte
The code i wrote earlier was pseudocode I wanted you to get the ideea. But if you need some code to paste here is the actual implementation:
program project1;
uses SysUtils,classes;
type
TByteArray = array of byte;
function StrToArray(const Hexstr: String): TByteArray ;
var
i: Integer;
begin
SetLength(Result, Length(Hexstr) div 2);
for i:=0 to (Length(Hexstr) div 2 - 1) do
Result[i]:= StrToInt('$' + Copy(Hexstr, (i * 2) + 1, 2));
end;
var
arr : TByteArray;
i : Integer;
begin
arr := StrToArray('0A0B0C0D');
for i:=0 to High(arr) do
WriteLn(arr[i]);
Readln;
end.
Btw coding is not about cuting and pasting ;)
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
SysUtils, Forms, StdCtrls, ExtCtrls, Classes;
type
{ TTextToHex_HexToBin }
TTextToHex_HexToBin = class(TForm)
Button1: TButton;
Edit1: TEdit;
Edit2: TEdit;
CheckTime: TImage;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure CheckTimeClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
end;
var
TextToHex_HexToBin: TTextToHex_HexToBin;
implementation
{$R *.lfm}
{ TTextToHex_HexToBin }
//hex to binary
function HextoBinary(const AHexStr: string):string;
var
i, j: Integer;
const
HexParts: array[0..$F] of string =
(
{0} '0000',{1} '0001',{2} '0010',{3} '0011',{4} '0100',{5} '0101',{6} '0110',{7} '0111',
{8} '1000',{9} '1001',{A} '1010',{B} '1011',{C} '1100',{D} '1101',{E} '1110',{F} '1111'
);
begin
SetLength(Result, 4 * AHexStr.Length);
j := 1;
for i := 1 to AHexStr.Length do
begin
case AHexStr[i] of
'0'..'9':
Move(HexParts[Ord(AHexStr[i]) - Ord('0')][1], Result[j], sizeof(char) * 4);
'A'..'F':
Move(HexParts[$A + Ord(AHexStr[i]) - Ord('A')][1], Result[j], sizeof(char) * 4);
'a'..'f':
Move(HexParts[$A + Ord(AHexStr[i]) - Ord('a')][1], Result[j], sizeof(char) * 4);
else
raise EConvertError.CreateFmt('Invalid hexadecimal string "%s".', [AHexStr]);
end;
Inc(j, 4);
end;
end;
procedure TTextToHex_HexToBin.Button1Click(Sender: TObject);
var
TB: TBytes;
WS: WideString;
S: string;
i: Integer;
begin
WS := Trim(Edit1.Caption);
TB := WideBytesOf(WS);
// WideString to Hexadecimal
S := '';
for i := Low(TB) to High(TB) do
S := S + IntToHex(TB[i], -1);
Edit2.Caption :=Trim(S);
// Hex to Binary
Memo1.Caption:= HextoBinary(Trim(S));
end;
procedure TTextToHex_HexToBin.CheckTimeClick(Sender: TObject);
begin
end;
procedure TTextToHex_HexToBin.FormCreate(Sender: TObject);
begin
end;
end.
[Result Show as Below]