How can I convert a fieldtype from ftFloat to ftBCD;
I tried
for i := 0 to FDataSet.FieldCount - 1 do begin
if FDataSet.Fields.Fields[i].DataType = ftFloat then begin
FDataSet.Fields.Fields[i].DataType := ftBCD;
end;
end;
But I get the error
[DCC Error] E2129 Cannot assign to a read-only property
Is there a way I can convert all dataset field that ftFloat to ftBCD ?
DataType is readonly Property of the Tfield created for a DataType.
This is done from Fielddefs using DefaultFieldClasses: array[TFieldType] of TFieldClass from DB.
If you need to change the DataType you will have to Free the Field and create anotherone fittinig your needs.
Below is shown an exmaple how this could be done.
type
TMyFieldInfo = Record
FieldName: String;
Size: Integer;
DataType: TFieldType;
FieldKind: TFieldKind;
end;
type
TFA= Array of TMyFieldInfo;
Procedure GetFields(DS:Tdataset;var FA:TFA);
var
I: Integer;
begin
SetLength(FA, DS.FieldCount);
for I := 0 to DS.FieldCount - 1 do
begin
FA[I].FieldName := DS.Fields[I].FieldName;
FA[I].DataType := DS.Fields[I].DataType;
FA[I].Size := DS.Fields[I].Size;
FA[I].FieldKind := fkdata;
end;
end;
Procedure SetFields(DS:Tdataset;var FA:TFA);
var
I: Integer;
F:TField;
begin
DS.Fields.Clear;
for I := Low(FA) to High(FA) do
begin
F := DefaultFieldClasses[FA[I].DataType].Create(DS);
With F do
begin
FieldName := FA[I].FieldName;
FieldKind := FA[I].FieldKind;
Size := FA[I].Size;
DataSet := DS;
end;
end;
end;
procedure TForm6.Button1Click(Sender: TObject);
var
L_FA: TFA;
I:Integer;
begin
MyDS.Open; // open to get the Fielddefs.
GetFields(MyDS,L_FA);
MyDS.Close; // close to be able to change the fields
for I := Low(L_FA) to High(L_FA) do
begin
if L_FA[i].DataType = ftFloat then
L_FA[i].DataType := ftBCD;
end;
SetFields(MyDS,L_FA);
MyDS.Open;
end;
Here is another way:
First, you need to dump the table into a file like this
ADOQuery.SaveToFile('C:\1.xml');
then find your field description in it, let's say it will be like this:
<s:datatype dt:type='float' dt:maxLength='8' rs:fixedlength='true' rs:maybenull='true'/>
and replace it with the other type description, like this:
<s:datatype dt:type='number' rs:dbtype='currency' dt:maxLength='25' rs:precision='25' rs:fixedlength='true' rs:maybenull='true'/>
now you need to load this file back, like this:
ADOQuery.LoadFromFile('C:\1.xml');
NO! Once you creates a Datafield you can not change it! It is because assigning a Filedtype is much more than just changeing an enum type property. Each field type is a specific class:
TintegerField etc...
So you can not change the FieldType for the same reason the can not make an TList in to a string
Excatly what are you trying to to ?
Jens Borrisholt
Related
I am working on a legacy code which contains some TQuery components. I was trying to create a function which convert the TQuery Parameters into TParameters so that i can assign them into the Parameters property of an ADO Component (Like ADOQuery or ADODataSet).
I tried the following which i got from internet.
function ConvertToADOParms(Owner: TADODataset; aParams: TParams): TParameters;
var i: integer;
begin
// Convert a standard TParams object to an ADO-specific TParameters object
Result :=nil;
try
if aParams = nil then exit;
Result :=TParameters.create( Owner, TParameter);
for i:=0 to aParams.count - 1 do
begin
if aParams[i] = nil then continue;
with Result.AddParameter do
begin
Name := aParams[i].Name;
Datatype :=aParams[i].DataType;
Direction :=TParameterDirection(aParams[i].ParamType);
Size :=aParams[i].size;
Value :=aParams[i].value;
end;
end;
except
on e:exception do
begin
Result :=nil;
showmessage('Could not convert standard parameter object to ADO parameter object: '+e.message);
end;
end;
end;
But i am getting Invalid Class Typecast Error. When i debug the code i found that the error occurs at this function in ADODB unit
function TParameters.GetCommand: TADOCommand;
begin
Result := GetOwner as TADOCommand;
end;
Help Please. I am Using Delphi 5
I don't make much sense of the function prototype. It requests an owner for the collection that is returned by the function and as such should IMHO be independent.
I would simply get rid of that and operate directly with the passed ADO object. For example:
procedure FillParamsADO(Params: TParams; Dataset: TADODataset);
var
i: Integer;
begin
Dataset.Parameters.Clear;
for i := 0 to Params.Count-1 do
begin
with Dataset.Parameters.AddParameter do
begin
Name := Params[i].Name;
DataType := Params[i].DataType;
Direction := TParameterDirection(Params[i].ParamType);
Size := Params[i].Size;
Value := Params[i].Value;
end;
end;
end;
I wonder how caught a row of a listview and transform object.
I carry an .xml file and play in a listview , after loading this file you need to double-click in a row, take all of the data line and throw in a LabelEdit , as shown in the code below .
procedure TForm1.LstbxDadosDblClick(Sender: TObject);
begin
if Assigned(TMensagem(LstbxDados.Items.Objects[LstbxDados.ItemIndex])) then
begin
with TMensagem(LstbxDados.Items.Objects[LstbxDados.ItemIndex]) do
begin
EdtPara.Text := Para;
EdtDe.Text := De;
EdtCabecalho.Text := Cabecalho;
EdtCorpo.Text := Corpo;
end;
end;
end;
TMensagem = class
private
FCorpo: String;
FCabecalho: String;
FPara: String;
FDe: String;
public
property Para : String read FPara write FPara;
property De : String read FDe write FDe;
property Cabecalho: String read FCabecalho write FCabecalho;
property Corpo : String read FCorpo write FCorpo;
end;
Many ways to edit an object where the current object can change at any time (like with a double click). Here is one of the easiest: save when the current object changes and save at the very end. Here is a quick and dirty solution.
Add a member to the form or global in the implementation section
FLastMensagem: TMensagem;
May want to initialize to nil on create or initialization (left to you). Now in the event save data when the TMensagem object changes
procedure TForm1.LstbxDadosDblClick(Sender: TObject);
var
LNewMensagem: TMensagem;
begin
LNewMensagem := TMensagem(LstbxDados.Items.Objects[LstbxDados.ItemIndex]));
if Assigned(LNewMensagem) then
begin
// When we switch, capture the dialog before updating it
if Assigned(FMensagem) and (LNewMensagem <> FLastMensagem) then
begin
FLastMensagem.Para := EdtPara.Text;
FLastMensagem.De := EdtDe.Text;
FLastMensagem.Cabecalho := EdtCabecalho.Text;
FLastMensagem.Corpo := EdtCorpo.Text;
end;
EdtPara.Text := LNewMensagem.Para;
EdtDe.Text := LNewMensagem.De;
EdtCabecalho.Text := LNewMensagem.Cabecalho;
EdtCorpo.Text := LNewMensagem.Corpo;
//Set the last dblclicked
FLastMensagem := LNewMensagem
end;
end;
Of course the very last edit needs to be saved, that you can do in say a form close (not sure what your full design is). For example
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Assigned(FLastMensagem) then
begin
FLastMensagem.Para := EdtPara.Text;
FLastMensagem.De := EdtDe.Text;
FLastMensagem.Cabecalho := EdtCabecalho.Text;
FLastMensagem.Corpo := EdtCorpo.Text;
end;
end;
I want to change the value of T according to a particular selection but it's not changing. Please have a look. The variable T has been declared along with Form1:TForm1 before 'implementation'. Basically, T should get assigned a linear or non linear equation depending upon the the selection of the respected radio buttons. I put a TEdit in the form so as to get an idea whether it is working or not. The last part is just a way to check by taking an example of Integer values.
Also, if I am not able to give a clear idea then just suggest me how to store a value of the concerned value using the Radiobuttons of the RadioGroup.
procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
if RadioGroup1.Items[RadioGroup1.ItemIndex] = 'Linear Tension' then
T:= 5;
if RadioGroup1.Items[RadioGroup1.ItemIndex] = 'Non-Linear tension' then
T:= 10;
end;
procedure TForm1.Edit1Change(Sender: TObject);
var
code: Integer;
value: Real;
begin
Val(Edit1.Text,value,code);
Edit1.Text := formatfloat('#.0', T);
end;
end.
It's really not a good idea to use a textual comparison for RadioGroup items. It's much better to simply use the ItemIndex directly:
procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
case RadioGroup1.ItemIndex of
0: T := 5;
1: T := 10;
else
raise Exception.Create('No item selected - should not get here');
end;
ShowMessage(FloatToStr(T));
end;
Do not compare the captions because you will have magic values in your code.
Declare a ValueObject containing the Value and the Name
type
TTensionValue = record
private
FValue : Integer;
FName : string;
public
constructor Create( AValue : Integer; const AName : string );
class function EMPTY : TTensionValue;
property Value : Integer read FValue;
property Name : string;
end;
TTensionValues = TList<TTensionValue>;
class function TTensionValue.EMPTY : TTensionValue;
begin
Result.FValue := 0;
Result.FName := '';
end;
constructor TTensionValue.Create( AValue : Integer; const AName : string );
begin
// Validation of AValue and AName
if AName = '' then
raise Exception.Create( 'AName' );
if AValue < 0 then
raise Exception.Create( 'AValue' );
FValue := AValue;
FName := AName;
end;
Prepare a List with valid entries
type
TForm1 = class( TForm )
...
procedure RadioGroup1Click( Sender: TObject );
private
FTensions : TTensionValues;
procedure PopulateTensions( AStrings : TStrings );
public
procedure AfterConstruction; override;
procedure BeforeDestruction; override;
end;
procedure TForm1.AfterConstruction;
begin
inherited;
FTensions := TTensionValues.Create;
FTensions.Add( TTensionValue.Create( 5, 'Linear Tension' ) );
FTensions.Add( TTensionValue.Create( 10, 'Non-Linear tension' ) );
end;
procedure TForm1.BeforeDestruction;
begin
FTenstions.Free;
inherited;
end;
Populate that list to the RadioGroup
procedure TForm1.PopulateTensions( AStrings : TStrings );
var
LValue : TTensionValue;
begin
AStrings.BeginUpdate;
try
AStrings.Clear;
for LValue in FTensions.Count - 1 do
AStrings.Add( LValue.Name );
finally
AStrings.EndUpdate;
end;
end;
procedure TForm1.FormShow( Sender.TObject );
begin
PopulateTensions( RadioGroup1.Items );
end;
Now you only ask the TensionList for the value
procedure TForm1.RadioGroup1Click( Sender: TObject );
begin
T := FTensions[RadioGroup1.ItemIndex].Value;
end;
The selected value now only rely on the chosen ItemIndex and not on the caption text.
From what I can tell, you're simply trying to change the value displayed on Edit1 when RadioGroup1 is clicked. To achieve this, all you'll need to do is move
Edit1.Text := formatfloat('#.0', T);
to the end of your RadioGroup1Click procedure.
I'm assuming Edit1Change is the onChange procedure of Edit1. If so, according to the documentation this procedure only gets called when the Text property already might have changed. So not only will this procedure not get called (how would delphi know you intend to use the value of T to change the text of Edit1?), when it does get called, it might result in a stack overflow, since changing the text value indirectly calls the onChange event. (though setting it to the same value it already had might not call it).
That being said, checking if a value is being changed properly, does not require a TEdit, a TLabel would be a better fit there. Though in your case, i would opt for simply placing a breakpoint and stepping through the code to see if the value get's changed correctly.
There are also some a lot of additional problems with your code, such as inconsistent formatting, magic values, bad naming conventions and lines of code that serve no purpose, I would suggest you read up on those before you get into bad habits.
The program I'm working on uses an if statement to add a line to the SQL for the contents of another combo box
procedure TFmNewGarage.ComboBoxCountryEnter(Sender: TObject);
begin
ADOQueryCountry.SQL.Clear;
ADOQueryCountry.SQL.Add('SELECT DISTINCT Country');
ADOQueryCountry.SQL.Add(' FROM TblBaseCar');
ADOQueryCountry.Open;
while not ADOQueryCountry.Eof do
begin
ComboBoxCountry.Items.Add(ADOQueryCountry['Country']);
ADOQueryCountry.Next;
end;
end;
procedure TFmNewGarage.ComboBoxCountryChange(Sender: TObject);
begin
SelA:=True;
ComboBoxManufacturer.Show;
ComboBoxCountry.Hide;
end;
procedure TFmNewGarage.ComboBoxManufacturerEnter(Sender: TObject);
begin
ADOQueryManufacturer.SQL.Clear;
ADOQueryManufacturer.SQL.Add('SELECT DISTINCT Manufacturer');
ADOQueryManufacturer.SQL.Add(' FROM TblBaseCar');
if SelA=true then
ADOQueryManufacturer.SQL.Add(' WHERE Country=(ComboBoxCountry.seltext)');
ADOQueryManufacturer.Open;
while not ADOQueryManufacturer.Eof do
begin
ComboBoxManufacturer.Items.Add(ADOQueryManufacturer['Manufacturer']);
ADOQueryManufacturer.Next;
end;
end;
At runtime this results in the error ComboBoxCountry.seltext has no default value, can anyone help me to rectify this?
SelText is not the property you should be using. You need the combobox Items value for the chosen ItemIndex:
var
Country: string;
begin
...
if ComboBoxCountry.ItemIndex <> -1 then
begin
Country := ComboBoxCountryItems[ComboBoxCountry.ItemIndex];
ADOQueryManufacturer.SQL.Add('WHERE Country = ' + QuotedStr(Country));
end;
end;
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);