Make Non-Windowed Component Data Aware - database

I have a non-windowed component with a date property. I would like to make this component data aware with read and write capabilities to a date field. (In other words, if I change the date at runtime, I would like to write the new date property value to the dataset.) I have googled for examples, but I haven't been able to find any. Found several read-only examples, e.g., TDbLabel, but none that allow changes to be written to the dataset. If anyone can point me to an example, I would be grateful.

Here is a generic code approach to your question
unit Unit1;
interface
uses
Classes
,DB
,DBCtrls
;
type
TDataAwareComponent = class(TComponent)
private
{ private declarations }
FDataLink : TFieldDataLink;
FFromDateChange : Boolean;
function GetDataField: string;
function GetDataSource: TDataSource;
function GetField: TField;
function GetReadOnly: Boolean;
procedure SetDataField(const Value: string);
procedure SetDataSource(const Value: TDataSource);
procedure SetReadOnly(const Value: Boolean);
function GetDateProperty: TDateTime;
procedure SetDateProperty(const Value: TDateTime);
protected
{ protected declarations }
procedure DataChange(Sender : TObject);
public
{ public declarations }
constructor Create(AOwner : TComponent);override;
destructor Destroy;override;
public
property Field : TField read GetField;
property DateProperty : TDateTime read GetDateProperty write SetDateProperty;
published
{ published declarations }
property DataSource : TDataSource read GetDataSource write SetDataSource;
property DataField : string read GetDataField write SetDataField;
property ReadOnly : Boolean read GetReadOnly write SetReadOnly;
end;
implementation
{ TDataAwareComponent }
{------------------------------------------------------------------------------}
constructor TDataAwareComponent.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FDataLink := TFieldDataLink.Create;
FDataLink.Control := Self;
FDataLink.OnDataChange := DataChange;
end;
{------------------------------------------------------------------------------}
destructor TDataAwareComponent.Destroy;
begin
FDataLink.Free;
FDataLink := nil;
inherited;
end;
{------------------------------------------------------------------------------}
procedure TDataAwareComponent.DataChange(Sender: TObject);
begin
// Here a visual object would display the underlying field value.
// For example if this component was a TEdit
// the code would be something like
{ if FDataLink.Active then
Self.Text := Field.AsString;
And on the exit event of the TEdit the code would be reversed
so the field can take the value the user entered.
Since you do not need any UI interaction propably this event
is useless to you.
}
// Of course there are more issues you should cover to
// have a complete working solution.
// This is only demostration code.
end;
{------------------------------------------------------------------------------}
function TDataAwareComponent.GetDataField: string;
begin
Result := FDataLink.FieldName
end;
{------------------------------------------------------------------------------}
function TDataAwareComponent.GetDataSource: TDataSource;
begin
Result := FDataLink.DataSource;
end;
{------------------------------------------------------------------------------}
function TDataAwareComponent.GetDateProperty: TDateTime;
begin
//You do not need a separate property since you can access directly the field value.
Result := 0;
if Assigned(Field) and (Field.DataType in [ftTime,ftDate,ftDateTime] then
Result := Field.AsDateTime;
end;
{------------------------------------------------------------------------------}
function TDataAwareComponent.GetField: TField;
begin
Result : FDataLink.Field;
end;
{------------------------------------------------------------------------------}
function TDataAwareComponent.GetReadOnly: Boolean;
begin
Result := FDataLink.ReadOnly;
end;
{------------------------------------------------------------------------------}
procedure TDataAwareComponent.SetDataField(const Value: string);
begin
FDataLink.FieldName := Value;
end;
{------------------------------------------------------------------------------}
procedure TDataAwareComponent.SetDataSource(const Value: TDataSource);
begin
FDataLink.DataSource := Value;
end;
{------------------------------------------------------------------------------}
procedure TDataAwareComponent.SetDateProperty(const Value: TDateTime);
begin
if Assigned(Field) then
begin
FFromDateChange := True;
try
Field.DataSet.Edit;
Field.Value := Value;
finally
FFromDateChange := False;
end;
end;
end;
{------------------------------------------------------------------------------}
procedure TDataAwareComponent.SetReadOnly(const Value: Boolean);
begin
FDataLink.ReadOnly := Value;
end;
{------------------------------------------------------------------------------}
end.

It'd be a bit of code, but if your component has events triggered when its value changes, then that could be used to send updated values to the dataset, if it's in the dsEdit state. You'd also need to handle the various TDataSource Events to know when the dataset is changing.

Related

Cannot assign value to object with array of records

I'm writing a simple object that contain array of records. Just like invoice.(ID,date,customer name and array of records about the items).
type
Trows = record
private
Fcode: string;
Qty: Double;
cena: Currency;
procedure Setcode(const value: string);
public
property code: string read Fcode write SetCode;
end;
Tcart = class(TObject)
private
Frow: array of Trows;
function Getrow(Index: Integer): Trows;
procedure Setrow(Index: Integer; const Value: Trows);
public
ID: integer;
CustName: string;
Suma: currency;
Payed: boolean;
constructor Create(const Num: Integer);
destructor Destroy;
function carttostr: string;
procedure setcode(Index: integer;val: string);
property Row[Index: Integer]: Trows read Getrow write setrow;
end;
Everything seems fine since I'm trying to change value of one record. I have found 3 ways to do it. First, and second worked ok, but I'd like to simplify the code modifying the value of this record like this:
cart.row[0].code:='333';
but it doesn't work.
What am I'm missing?
Here is the code:
procedure TForm1.Button1Click(Sender: TObject);
var
Arows: Trows;
begin
Cart:=Tcart.Create(0);
cart.custName:='Customer 1';
cart.Suma:=5.55;
cart.Payed:=false;
Arows.code:='123';
cart.setrow(0,Arows); // this way working
cart.setcode(0,'333'); // this way also working
cart.row[0].code:='555'; //this way doesn''t change value. How to make it work?
memo1.Lines.Text:=cart.carttostr;
end;
It doesn't work because your Row[] property returns a TRows record by value, which means the caller receives a copy of the original record. Any modifications you make to the copy are not reflected in the original.
You need to assign the copy back to the property to apply changes:
procedure TForm1.Button1Click(Sender: TObject);
var
Arows: Trows;
begin
...
Arows := cart.row[0];
Arows.code:='555';
cart.row[0] := Arows; // <-- equivalent to 'cart.setrow(0,Arows);'
...
end;

How to correctly declare an array property in Delphi?

I'm trying to create an array to store every item of a TStringList into an array which size may vary depending on the quantity of items in said TStringList.
I know my syntax is wrong and what I want is probably a dynamic array, so the [0..100] is probably wrong aswell but I could not find any alternative syntax online.
ProductAvailabilityResult = Class(TRemotable)
private
FResultArray : array[1..100] of string;
published
property ResultArray[Index: Integer]: array of string read FResultArray write FResultArray;
End;
And this is how I would invoke it and populate it. conditionList being my TStringList which I would populate into my array.
for I := 0 to conditionList.Count - 1 do
begin
aProductAvailabilityResult.ResultArray[I] := conditionList[I];
end;
In case you may or may not have alternative suggestions to what i'm doing, the reason for this setup is because it's a web service app sending results over a SOAP server, and I don't think my PHP/Soap client can read TStringLists, so I need to pass it to an array first.
Let me know, Thanks!
Your syntax for declaring an array property is close, but you need to use getter/setter methods instead of direct field access, and array properties cannot be declared as published:
type
ProductAvailabilityResult = class(TRemotable)
private
FResultArray : array of string;
function GetResultArray(Index: Integer): string;
function GetResultArrayCount: Integer;
procedure SetResultArray(Index: Integer; const Value: string);
procedure SetResultArrayCount(Value: Integer);
public
property ResultArray[Index: Integer]: string read GetResultArray write SetResultArray default;
property ResultArrayCount: Integer read GetResultArrayCount write SetResultArrayCount;
end;
function ProductAvailabilityResult.GetResultArray(Index: Integer): string;
begin
Result := FResultArray[Index];
end;
function ProductAvailabilityResult.GetResultArrayCount: Integer;
begin
Result := Length(FResultArray);
end;
procedure ProductAvailabilityResult.SetResultArray(Index: Integer; const Value: string);
begin
FResultArray[Index] := Value;
end;
procedure ProductAvailabilityResult.SetResultArrayCount(Value: Integer);
begin
SetLength(FResultArray, Value);
end;
Then you can do this:
aProductAvailabilityResult.ResultArrayCount := conditionList.Count;
for I := 0 to conditionList.Count - 1 do
begin
aProductAvailabilityResult[I] := conditionList[I];
end;
You might want to consider adding a method to copy strings from a source TStrings:
type
ProductAvailabilityResult = class(TRemotable)
private
...
public
procedure AssignStrings(AStrings: TStrings);
...
end;
procedure ProductAvailabilityResult.AssignStrings(AStrings: TStrings);
var
I: Integer;
begin
SetLength(FResultArray, AStrings.Count);
for I := 0 to AStrings.Count - 1 do
FResultArray[I] := AStrings[I];
end;
aProductAvailabilityResult.AssignStrings(conditionList);
You've declared an array property, albeit with some syntax errors. However, you state in the question and comments that you want a property that is a dynamic array. That's different from an array property.
Declare a dynamic array property like so:
type
ProductAvailabilityResult = class(TRemotable)
private
FResultArray: TArray<string>;
published
property ResultArray: TArray<string> read FResultArray write FResultArray;
end;
Populate it like this:
var
i: Integer;
List: TStringList;
par: ProductAvailabilityResult;
arr: TArray<string>;
....
List := ...;
par := ...;
SetLength(arr, List.Count);
for i := 0 to List.Count-1 do
arr[i] := List[i];
par.ResultArray := arr;

Lazarus setLength type mismatch

i am building a Compiler and i get this Error Code, when i compile the programm:
compiler_main.pas(55,4) Error: Type mismatch
the code is the following:
unit Compiler_main;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, SynEdit, Forms, Controls, Graphics, Dialogs,
StdCtrls, ExtCtrls;
type
{ TForm1 }
TForm1 = class(TForm)
GroupBox1: TGroupBox;
GroupBox2: TGroupBox;
Image1: TImage;
Image2: TImage;
Splitter1: TSplitter;
Splitter2: TSplitter;
SynEdit1: TSynEdit;
SynEdit2: TSynEdit;
SynEdit3: TSynEdit;
procedure Image1Click(Sender: TObject);
procedure Image2Click(Sender: TObject);
procedure setForCompiling(var dataSect: array of String; var textSect: array of String; var bssSect: array of String);
procedure setDataSect (var dataSect: array of String);
//////////FUNCTIONS////////////////////
function compile () : boolean;
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
var INTarray: array of integer;
implementation
{$R *.lfm}
{ TForm1 }
{
procedure Tform1.setTextSect (var textSect: array of String);
begin
end; }
procedure Tform1.setDataSect(var dataSect: array of String);
begin
setLength (dataSect, 1);
dataSect[0]:= 'section .data';
end;
procedure Tform1.setForCompiling(var dataSect: array of String; var textSect: array of String; var bssSect: array of String);
begin
Synedit2.Lines.Clear;
Synedit3.Lines.Clear;
setDataSect (dataSect);
end;
function getMistake (mistake: boolean) : boolean;
begin
if mistake = false then
begin
getMistake:= true;
end else
begin
getMistake:= false;
end;
end;
function Tform1.compile() : boolean;
var momLine : integer = 0;
var totalLines : integer;
var posBracketOpen : Byte;
var posBracketClose : Byte;
var posTextBracketOpen : Byte;
var posTextBracketClose: Byte;
var mistake : boolean = false;
var dataASM : array of string;
var textASM : array of string;
var bssASM : array of String;
begin
setForCompiling(dataASM, textASM, bssASM);
totalLines:= synEdit1.lines.count;
while momline < totalLines do
begin
inc (momline);
end;
compile:= getMistake (mistake);
end;
procedure TForm1.Image1Click(Sender: TObject);
begin
Showmessage ('Ein deutscher Compiler, programmiert von NONAME. NUR UNTER LINUX BENUTZBAR!');
end;
procedure TForm1.Image2Click(Sender: TObject);
begin
if Compile = true then
begin
Synedit3.Lines.add ('Fehlerfrei Compiliert!');
end else
begin
Synedit3.Lines.add ('Es wurde mindestens ein Fehler festgestellt! Bitte korrigiere diesen.');
end;
end;
end.
my Programm is programmed in Lazarus and bases on NASM and gets Compiled in the newest Laz-version in Linux.
I hope, you can help me.
Ok, it works now.
This is the setLength that generates error:
procedure Tform1.setDataSect(var dataSect: array of String);
begin
setLength (dataSect, 1);
dataSect[0]:= 'section .data';
end;
This code is incorrect because dataSect is not a dynamic array as you would expect but an open array parameter that you can't change.
You will need to change your function declaration to not use open array:
first use builtin type TStringDynArray (I am not sure if it available in Lazarus), or declare it like
type TStringDynArray = array of string;
Then use this type everywhere instead array of string.
procedure Tform1.setDataSect(dataSect: TStringDynArray);
begin
setLength (dataSect, 1);
dataSect[0]:= 'section .data';
end;
Also you don't need to use var parameter var dataSect: TStringDynArray - dynamic arrays are always passed by reference and all changes will be applied to original array, if you want to prevent this - you will need to explicitly create new copy of array like NewDataSect := Copy(dataSect);

How to save multiple images from database to TMemoryStream at runtime and extract them later on

I am creating a project at delphi(RAD Studio). There are images stored at database table at some rows. I want to extract images at runtime (for which I am using Array of TMemoryStream) and show them at frxReport.
My code snippet as follows
Public variable TStream is declared as
Stream2 : Array of TStream; i,k: integer
Code segment for view button click event, which is placed on MainForm and expected to show frxReport.
`
procedure TFrmMain.btnViewClick(Sender: TObject);
begin
i := 0;
k := 0;
UniTable1.SQL.Text := 'Select * from userplays order by id';
UniTable1.Execute;
rowcount := UniTable1.RecordCount;
SetLength(myid, rowcount);
SetLength(mydesc, rowcount);
SetLength(myimg, rowcount);
SetLength(Stream2, rowcount);
while not UniTable1.Eof do
begin
try
Stream2[k] := TMemoryStream.Create;
myid[k] := UniTable1.FieldByName('id').Value;
Stream2[k] := UniTable1.CreateBlobStream(TBlobField(UniTable1.FieldByName('image')), bmRead);
mydesc[k] := UniTable1.FieldByName('description').Value;
UniTable1.Next;
inc(k);
finally
//Stream2[k].Free;
end;
end;
frxUserDataSet1.RangeEnd := reCount;
frxUserDataSet1.RangeEndCount := rowcount;
frxReport1.ShowReport;
i := 0;
end;
`
However this method is not loading any image to Stream2 array. There is an option to use array of JPEGImage however if JPEGImage array used then it would be problem to display it on frxRaport at
procedure TFrmMain.frxReport1GetValue(const VarName: string; var Value: Variant);
`
Graphic := TJPEGImage.Create;
Graphic.LoadFromStream(Stream2[j]);
TfrxPictureView(frxreport1.FindObject('Picture1')).Picture.Graphic := Graphic;
`
Kindly let me know how to do this.
However this method is not loading any image to Stream2 array
In your current code you are first assigning a newly created TMemoryStream to Stream2[k]:
Stream2[k] := TMemoryStream.Create;
then you are throwing the TMemoryStream away (creating a memory leak) and replacing it with the blob stream you create:
Stream2[k] := UniTable1.CreateBlobStream(TBlobField(UniTable1.FieldByName('image')), bmRead);
But you never read from the blob stream.
Here's the while loop rewritten (untested)
var
blobstream: TStream;
Stream2: array of TMemoryStream;
....
// read 'id', 'description' and 'image' fields to respective arrays
while not UniTable1.Eof do
begin
myid[k] := UniTable1.FieldByName('id').Value;
mydesc[k] := UniTable1.FieldByName('description').Value;
blobstream := UniTable1.CreateBlobStream(TBlobField(UniTable1.FieldByName('image')), bmRead);
try
Stream2[k] := TMemoryStream.Create;
Stream2[k].LoadFromStream(blobstream);
finally
blobstream.Free;
end;
UniTable1.Next;
inc(k);
end;
Btw, I would recommend to define a record to hold the id, description and image together, and then an array of those records, instead of three separate arrays. Much simpler to manage only one array instead of three.
I think in your situation most obvious thing would be just connect existing DataSet ( Unitable1) directly into DataBand in frxReport. I don't see why you would need to use frxUserDataset instead of frxDBDataset with its DataSet property set to Unitable1 since you created it anyway.
If you really need a list of objects then I would take a different approach.
Your multiple global variables look ugly and are dangerous (i,k...)
I would create a class that holds your data and populate this data into a
TObjectList from System.Generics.Collection:
unit DataPack;
interface
uses ExtCtrls...System.SysUtils;
type
TMyDataPack = class(TObject)
private
Query: TFDQuery; //O r TUniQery
_MyId: Integer;
_MyDescription: String;
_MyImage: TImage;
_Loaded: Boolean;
function LoadData: boolean;
protected
public
constructor Create(Data: TFDQuery); //Or Uniquery
property MyId: Integer read _MyId;
property MyDescription: String read _MyDescription;
property MyImage: TImage read _MyImage;
property Loaded: Boolean read _Loaded;
end;
implementation
{ TMyDataPack }
constructor TMyDataPack.Create(Data: TFDQuery);
begin
Inherited Create;
Query:=Data;
_Loaded:=true;
if not (LoadData) then
_Loaded:=false;
end;
function TMyDataPack.LoadData: boolean;
var
Stream: TStream;
begin
Stream:= TStream.Create;
Stream:=Query.CreateBlobStream(TBlobField(Query.FieldByName('image')), bmRead);
try
_MyImage:=TImage.Create(nil);
_MyImage.Picture.Bitmap.LoadFromStream(Stream);
_MyDescription:=Query.FieldByName('description').AsString;
_MyId:=Query.FieldByName('CategoryId').AsInteger;
except on E: Exception do
begin
FreeAndNil(Stream);
FreeAndNil(_MyImage);
Exit(false);
end;
end;
FreeAndNil(Stream);
Result:=true;
end;
end.
Then in your main code:
procedure TMain.Button2Click(Sender: TObject);
var
DataRow: TMyDataPack;
List: TObjectList<TMyDataPack>;
Num: integer;
CurrentImage: TImage;
CurrentDescription: String;
CurrentId: integer;
begin
UniTable1.SQL.Text:='SELECT * FROM Userplays';
UniTable1.Open();
List:=TObjectList<TMyDataPack>.Create;
while not (UniTable1.Eof) do
begin
DataRow:=TMyDataPack.Create(UniTable1);
if(DataRow.Loaded) then
List.Add(DataRow);
UniTable1.Next;
End;
for Num:=0 to List.Count do
begin
CurrentDescription:=List[Num].MyDescription;
CurrentImage:=List[Num].MyImage;
CurrentId:=List[Num].MyId;
//List[Num].MyImage.Picture.SaveToFile('Some'+IntToStr(Num)+'.bmp');
// You might save it to file then...
end;
end;
end.
Then pass an ObjectList further, just remember to free it at the end.
You might further expand it by creating class factory to create different objects if you'd need for example use different database with same data,
perform check if image is actually Bmp or Jpg and so on.
You might even just pass a query without setting it's SQL and get TobjectList as property.

Index operator property on 2D Array in Delphi

I'm aware that in Delphi, when you want to allow the use of the index operator, [], you must do something like,
property Item[index: integer]: integer read GetData; default;
How would one go about implementing a multidimensional array in Delphi such that it allows the use of something like:
matrix := TMatrix<integer>.Create(3,3);
matrix[0][2] := 5;
WriteLn(matrix[0][2]);
You can't use [][] like that. But you can declare multiple indexes in a single property instead, eg:
type
TMatrix<T> = class
private
function GetData(index1, index2: Integer): T;
procedure SetData(index1, index2: Integer; value: T);
public
constructor Create(dim1, dim2: Integer);
property Item[index1, index2: Integer]: T read GetData write SetData; default;
end;
Then you can do this:
matrix := TMatrix<integer>.Create(3,3);
matrix[0, 2] := 5;
WriteLn(matrix[0, 2]);
If you wish, you can use [][] to access elements. If your type is an array (two-dimensional or jagged dynamic) then this method of accessing the elements is baked into the language. For a user-defined type then you need to implement it.
There is no way to implement [][] in a single step in a user-defined type. What you need to do is break the process into two separate parts. The first part is to implement [] to return a row of your matrix. Then implement [] on that row to return an element. Here is an example:
type
TMatrix<T> = class
public
type
TRow = record
private
FMatrix: TMatrix<T>;
FRowIndex: Integer;
function GetItem(ColIndex: Integer): T; inline;
procedure SetItem(ColIndex: Integer; const Value: T); inline;
public
property Items[ColIndex: Integer]: T read GetItem write SetItem; default;
end;
private
FData: TArray<TArray<T>>;
function GetRow(RowIndex: Integer): TRow; inline;
public
constructor Create(RowCount, ColCount: Integer);
property Rows[RowIndex: Integer]: TRow read GetRow; default;
end;
{ TMatrix<T>.TRow }
function TMatrix<T>.TRow.GetItem(ColIndex: Integer): T;
begin
Result := FMatrix.FData[FRowIndex, ColIndex];
end;
procedure TMatrix<T>.TRow.SetItem(ColIndex: Integer; const Value: T);
begin
FMatrix.FData[FRowIndex, ColIndex] := Value;
end;
{ TMatrix<T> }
constructor TMatrix<T>.Create(RowCount, ColCount: Integer);
begin
inherited Create;
SetLength(FData, RowCount, ColCount);
end;
function TMatrix<T>.GetRow(RowIndex: Integer): TRow;
begin
Result.FMatrix := Self;
Result.FRowIndex := RowIndex;
end;
However, having shown that this is possible, I would suggest that is more idiomatic to use an array property with two indices. That would mean that you would access the matrix with M[Row,Col] rather than M[Row][Col]. This particular idiom (M[Row,Col]) is not found in all languages so you may be unfamiliar with it. Supporting that might look like this:
type
TMatrix<T> = class
public
type
TRow = record
private
FMatrix: TMatrix<T>;
FRowIndex: Integer;
function GetItem(ColIndex: Integer): T; inline;
procedure SetItem(ColIndex: Integer; const Value: T); inline;
public
property Items[ColIndex: Integer]: T read GetItem write SetItem; default;
end;
private
FData: TArray<TArray<T>>;
function GetRow(RowIndex: Integer): TRow; inline;
function GetItem(RowIndex, ColIndex: Integer): T; inline;
procedure SetItem(RowIndex, ColIndex: Integer; const Value: T); inline;
public
constructor Create(RowCount, ColCount: Integer);
property Rows[RowIndex: Integer]: TRow read GetRow;
property Items[RowIndex, ColIndex: Integer]: T read GetItem write SetItem; default;
end;
{ TMatrix<T>.TRow }
function TMatrix<T>.TRow.GetItem(ColIndex: Integer): T;
begin
Result := FMatrix.FData[FRowIndex, ColIndex];
end;
procedure TMatrix<T>.TRow.SetItem(ColIndex: Integer; const Value: T);
begin
FMatrix.FData[FRowIndex, ColIndex] := Value;
end;
{ TMatrix<T> }
constructor TMatrix<T>.Create(RowCount, ColCount: Integer);
begin
inherited Create;
SetLength(FData, RowCount, ColCount);
end;
function TMatrix<T>.GetRow(RowIndex: Integer): TRow;
begin
Result.FMatrix := Self;
Result.FRowIndex := RowIndex;
end;
function TMatrix<T>.GetItem(RowIndex, ColIndex: Integer): T;
begin
Result := FData[RowIndex, ColIndex];
end;
procedure TMatrix<T>.SetItem(RowIndex, ColIndex: Integer; const Value: T);
begin
FData[RowIndex, ColIndex] := Value;
end;
Note that in this version we have elected to make Items be the default property. Which means that if you want to access a row you would have to name the Rows property explicitly: M.Rows[RowIndex].

Resources