Using Delphi Steema TeeChart component, if I link a BarSeries to a dataset using the user interface, it shows up fine, but if I do it using code (which I need to), it's only showing one bar, even when I have several records in the database. What am I doing wrong?
Code:
var
i:Integer;
Bar:TBarSeries;
begin
ADataSet.Close;
ADataSet.LoadFromDataSet(mtbl);
ADataSet.Active := true;
ADataSet.First;
ASource.DataSet := ADataSet;
Bar := TBarSeries.Create(AChart);
Bar.Assign(Series2);
Bar.ParentChart := AChart;
Bar.DataSource := ASource;
Bar.XLabelsSource := 'Date';
Bar.YValues.ValueSource := 'Load';
for i := 0 to AChart.SeriesCount - 1 do
begin
AChart.Series[i].CheckDataSource;
end;
ADataSet is a DevExpress MemData (TdxMemData). When I run the program, the X axis is only showing one bar, the first record in the dataset, even though I have 4 records in the dataset.
This code works for me (using an Access database with fields ID and Height, I dropped a TDBChart, TADODataSet, and a TButton on a form):
procedure TForm1.Button1Click(Sender: TObject);
var
Bar : TBarSeries;
begin
ADODataSet1.Close;
ADODataSet1.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;...';
Bar := TBarSeries.Create(DBChart1);
DBChart1.AddSeries(Bar);
Bar.ParentChart := DBChart1;
Bar.DataSource := ADODataSet1;
Bar.XLabelsSource := 'ID';
Bar.YValues.ValueSource := 'Height';
ADODataSet1.Active := true;
end;
Note that the Datasource should be a TTable, TQuery, or TDataSet (not a TDataSource - go figure!).
Hope this helps.
TChart refreshes the query each time you set
ADataSet.Active := true;
so, move this command to the end of your block (e.g. after you've set up the series properties).
Related
I use the Drag and Drop Component Suite for Delphi.
I try to create a drag & drop area which accepts files (ie, from Windows Explorer) and data (ie, from Outlook attachments). So, I use the demo (CombatTargetDemo) to learn how it works, and after this I create a wrapper class which creates a TDropComboTarget object:
constructor TDragAndDrop.Create( vpntOwner: TWinControl);
begin
fpntDragAndDrop := TDropComboTarget.Create(vpntOwner);
fpntDragAndDrop.Name := 'DropComboTarget_'+vpntOwner.Name;
fpntDragAndDrop.DragTypes := [dtCopy, dtLink];
fpntDragAndDrop.OnDrop := DropFiles;
fpntDragAndDrop.Target := vpntOwner;
fpntDragAndDrop.Formats := [mfFile, mfData];
end;
procedure TDragAndDrop.DropFiles(Sender: TObject; ShiftState: TShiftState; Point: TPoint; var Effect: Integer);
var
intCnt: Integer;
pntStream: TStream;
strFileName: String;
strDragAndDropFile: String;
begin
try
fstlDroppedFilePaths.Clear;
fstlDroppedFilePaths.Assign(fpntDragAndDrop.Files);
for intCnt := 0 to fpntDragAndDrop.Data.Count-1 do begin
strFileName := fpntDragAndDrop.Data.Names[intCnt];
if (strFileName = '') then begin
strFileName := IntToStr(intCnt)+'_'+FormatDateTime('yyyymmddhhnnss', Now())+'.dat';
end;
strDragAndDropFile := GetDragAndDropSavePath+strFileName;
pntStream := TFileStream.Create(strDragAndDropFile, fmCreate);
try
pntStream.CopyFrom(fpntDragAndDrop.Data[intCnt], fpntDragAndDrop.Data[intCnt].Size);
finally
pntStream.Free;
end;
if FileExists(strDragAndDropFile, false) then begin
fstlDroppedFilePaths.Add(strDragAndDropFile);
end;
end;
except
end;
end;
First of all, the code works.
If I drop a Windows Explorer file on the area:
fpntDragAndDrop.Files.Count is 1 (contains the path+name from file)
fpntDragAndDrop.Data.Count is 1 (contains the file as a stream)
If I drop a file from Outlook on the area:
fpntDragAndDrop.Files.Count is 0 (contains nothing)
fpntDragAndDrop.Data.Count is 1 (contains the file as a stream)
Now my problem:
If I drop very large files from Windows Explorer, the component does the following:
Read the file header and add an item to fpntDragAndDrop.Files
Create a TMemoryStream and try to load the data from the file into the stream
Step 1 is perfect, but on step 2 I get an exception because of insufficient memory.
My solution:
I want that the component does Step 1. If Step 1 gives a result, then the component should skip Step 2. After this, the variables in the DropFiles procedure should have the following values:
If I drop a Windows Explorer file on the area:
fpntDragAndDrop.Files.Count is 1 (contaims the path+name from the file)
fpntDragAndDrop.Data.Count is 0 (No memory stream is loaded)
If I drop a file from Outlook on the area:
fpntDragAndDrop.Files.Count is 0 (comtains nothing)
fpntDragAndDrop.Data.Count is 1 (contains the file as a stream)
Does somebody have an idea? Or maybe the component has a setting for that?
I'm not overly familiar with this suite, but just browsing through its source, I think you can use the OnAcceptFormat event to reject formats you don't want on a per-drop basis.
So, even though you have enabled drops of mfData doesn't mean you have to actually accept a dropped stream (TDataStreamDataFormat) if a file path (TFileDataFormat or TFileMapDataFormat) is available. So, query the fpntDragAndDrop.DataObject to see what formats it actually holds, such as by passing it to the HasValidFormats() method of the various formats in the fpntDragAndDrop.DataFormats property.
For example:
fpntDragAndDrop.OnAcceptFormat := AcceptStreams;
...
procedure TDragAndDrop.AcceptStreams(Sender: TObject;
const DataFormat: TCustomDataFormat; var Accept: boolean);
var
Fmt: TCustomDataFormat;
i: Integer;
begin
if DataFormat is TDataStreamDataFormat then
begin
// FYI, TFileDataFormat should be in DataFormats[0],
// and TFileMapDataFormat should be in DataFormats[5],
// if you want to avoid this loop...
for i := 0 to fpntDragAndDrop.DataFormats.Count-1 do
begin
Fmt := fpntDragAndDrop.DataFormats[i];
if (Fmt <> DataFormat) and ((Fmt is TFileDataFormat) or (Fmt is TFileMapDataFormat)) then
begin
if Fmt.HasValidFormats(fpntDragAndDrop.DataObject) then
begin
Accept := False;
Exit;
end;
end;
end;
end;
Accept := True; // should already be True by default...
end;
I want to use LiveBindings to connect a database table to a StringGrid, but I don't want to use the LiveBindings Designer, I want to do it manually via code. The documentation is in my opinion nearly not existing, which makes it more complicated than it should be.
I created a FMX application with my Delphi 10.3 and this is the code I wrote to do all I need:
procedure TForm_LiveBindings.CornerButton_Click(Sender: TObject);
var
aLinkTableToDataSource: TLinkGridToDataSource;
aConnection: TADOConnection;
aQuery: TADOQuery;
aBindSource: TBindSourceDB;
begin
aConnection:= TADOConnection.Create(self);
aQuery:= TADOQuery.Create(self);
aBindSource:= TBindSourceDB.Create(self);
aLinkTableToDataSource:= TLinkGridToDataSource.Create(self);
// Connection is set up here
aQuery.Connection := aConnection;
aQuery.SQL.Text := 'SELECT * FROM TestTable';
aQuery.Active := True;
aBindSource.DataSource.DataSet := aQuery;
aBindSource.DataSource.AutoEdit := True;
aBindSource.DataSource.Enabled := True;
aLinkTableToDataSource.DataSource := aBindSource;
aLinkTableToDataSource.GridControl := StringGrid1;
end;
The result: my StringGrid shows the table headers, but the rows stay empty. Which means the connection between the table and the string grid is existing, the columns have the correct header, but the content is not shown. So where did I go wrong?
Another question: is the StringGrid a good choice for displaying my database table or are there better solutions?
Thank a lot for your answers!
The example below shows all the code necessary to set up and populate a TStringGrid and a TGrid
using Live Bindings. It uses a TClientDataSet as the dataset so that it is completely self-
contained.
A bit of experimenting should satisfy you that setting up Live Bindings in code is actually
quite simple, but sensitive to the order of steps. Far more so than using VCL and traditional db-aware controls, Live Bindings seems require connecting up exactly the right things in the right way for it to work correctly. Note that unlike your code, my code does not touch the BindSorce's Datasource property, because it just isn't necessary.
type
TForm2 = class(TForm)
ClientDataSet1: TClientDataSet;
Grid1: TGrid;
StringGrid1: TStringGrid;
procedure FormCreate(Sender: TObject);
private
public
end;
[...]
procedure TForm2.FormCreate(Sender: TObject);
var
AField : TField;
BindSourceDB1 : TBindSourceDB;
LinkGridToDataSourceBindSourceDB1 : TLinkGridToDataSource;
LinkGridToDataSourceBindSourceDB2 : TLinkGridToDataSource;
begin
AField := TIntegerField.Create(Self);
AField.FieldName := 'ID';
AField.FieldKind := fkData;
AField.DataSet := ClientDataSet1;
AField := TStringField.Create(Self);
AField.FieldName := 'Name';
AField.Size := 20;
AField.FieldKind := fkData;
AField.DataSet := ClientDataSet1;
BindSourceDB1 := TBindSourceDB.Create(Self);
BindSourceDB1.DataSet := ClientDataSet1;
LinkGridToDataSourceBindSourceDB1 := TLinkGridToDataSource.Create(Self);
LinkGridToDataSourceBindSourceDB1.DataSource := BindSourceDB1;
LinkGridToDataSourceBindSourceDB1.GridControl := Grid1;
LinkGridToDataSourceBindSourceDB2 := TLinkGridToDataSource.Create(Self);
LinkGridToDataSourceBindSourceDB2.DataSource := BindSourceDB1;
LinkGridToDataSourceBindSourceDB2.GridControl := StringGrid1;
ClientDataSet1.IndexFieldNames := 'ID';
ClientDataSet1.CreateDataSet;
ClientDataSet1.InsertRecord([1, 'AName']);
ClientDataSet1.InsertRecord([2, 'AnotherName']);
ClientDataSet1.InsertRecord([3, 'ThirdName']);
ClientDataSet1.InsertRecord([4, 'FourthName']);
ClientDataSet1.InsertRecord([5, 'FifthName']);
ClientDataSet1.First;
end;
Answering late, but maybe it helps someone. LinkGrid must be Activate by
aLinkTableToDataSource.Active:= True;
The TListBox called lboMtrlList is populated with records from the database. The data displays properly when I run the application. When I click on any item in the list, shows the error:
Index out of range (-1)
despite the list not being empty.
Here's the code for populating the lboMtrlList:
procedure TfrmMakeQuote.FormCreate(Sender: TObject);
begin
con := TFDConnection.Create(nil);
query := TFDQuery.Create(con);
con.LoginPrompt := false;
con.Open('DriverID=SQLite;Database=C:\Users\katiee\Documents\Embarcadero\Studio\Projects\ProgramDatabase;');
query.Connection := con;
performQuery;
query.SQL.Text :=
'SELECT [Material Description] FROM MtrlDatabase ORDER BY MtrlID';
try
query.Open;
lboMtrlList.Items.Clear;
while not query.EOF do
begin
lboMtrlList.Items.Add(query.Fields[0].AsString);
query.Next;
end;
finally
query.Close;
end;
//ledtDesc.Height := 81;
//ledtNotes.Height := 51;
end;
I want to be able to double click on an item in the lboMtrlList and move it to another TListBox called lboSelectedMtrl. Here's the code:
procedure TfrmMakeQuote.lboMtrlListDblClick(Sender: TObject);
begin
lboMtrlList.Items.Add(lboSelectedMtrl.Items.Strings[lboSelectedMtrl.ItemIndex]);
end;
I want to be able to double click on an item in the lboMtrlList and move it to another TListBox called lboSelectedMtrl.
Your code is doing the opposite of that. It is trying to move an item from lboSelectedMtrl to lboMtrlList. You are getting the bounds error because there is no item selected in lboSelectedMtrl (lboSelectedMtrl.ItemIndex is -1).
Swap the ListBox variables, and add some error checking:
procedure TfrmMakeQuote.lboMtrlListDblClick(Sender: TObject);
var
Idx: Integer;
begin
Idx := lboMtrlList.ItemIndex;
if Idx <> -1 then
lboSelectedMtrl.Items.Add(lboMtrlList.Items.Strings[Idx]);
end;
I'm trying to change the visible text (value) of a DBLookupComboBox, using :
DBLookupComboBox1.KeyValue:=S;
and
DBLookupComboBox2.KeyValue:=X;
If the KeyValue and S are strings, then everything works fine, and I can set the value.
But when the KeyValue is an integer/Int64 (UID in the DB), and X is an Int64 variable - it doesn't work, and nothing changes.
So for an example, i need to set "Amsterdam" in DBLookupComboBox1, and 1500 in DBLookupComboBox2.
"Amsterdam" from the "City" field of the users, and 1500 as the UID.
What am I doing wrong please?
Thanks
This code is Important for you:
lkcbbArzSource.KeyValue:=2;//c(or another number);
lkcbbArzSource is a dbLookupComboBox object and you can insert only a number in this!why? because is numeric and another side of that there is a field that show a text or String of that numeric in combo.
in below sample code you can see a dbLookupComboBox how to menage and fill with Data-set and add in a grid :
rzSource.Enabled:= True;
lkcbbArzSource.Font.Size:=8;
lkcbbArzSource.Tag := V_Counter;
lkcbbArzSource.Visible:= True;
lkcbbArzSource.Enabled:= True;
lkcbbArzSource.Font.Name:='tahoma';
lkcbbArzSource.ListSource := myDsrSource;
lkcbbArzSource.KeyField := 'Code';
lkcbbArzSource.ListField := 'Des';
lkcbbArzSource.KeyValue:= IntToStr(FieldByName('P_ARZSOURCE').AsInteger);
lkcbbArzSource.OnChange := myBicLookUpChange;
SGrid2.Objects[look_col,lkcbbArzSource.Tag]:= lkcbbArzSource;
SGRID2.Objects[look_col,V_Counter] := nil;
Setting the KeyValue calls the SetKeyValue of the TDBLookupControl which in Delphi 7 appears as:
procedure TDBLookupControl.SetKeyValue(const Value: Variant);
begin
if not VarEquals(FKeyValue, Value) then
begin
FKeyValue := Value;
KeyValueChanged;
end;
end;
procedure TDBLookupComboBox.KeyValueChanged;
begin
if FLookupMode then
begin
FText := FDataField.DisplayText;
FAlignment := FDataField.Alignment;
end else
if ListActive and LocateKey then
begin
FText := FListField.DisplayText;
FAlignment := FListField.Alignment;
end else
begin
FText := '';
FAlignment := taLeftJustify;
end;
Invalidate;
end;
As you can see, your variable x is used as part of a LocateKey.
function TDBLookupControl.LocateKey: Boolean;
var
KeySave: Variant;
begin
Result := False;
try
KeySave := FKeyValue;
if not VarIsNull(FKeyValue) and FListLink.DataSet.Active and
FListLink.DataSet.Locate(FKeyFieldName, FKeyValue, []) then // << ---here
begin
Result := True;
FKeyValue := KeySave;
end;
except
end;
end;
Stepping into these procedures and functions should help you to debug your issue. All are located in the DbCtrls unit..
I have used this and solved my problem.
Use this lines of code at Form1.OnShow :
DBLookupComboBox1.ListSource.DataSet.Locate('City', 'Amsterdam', []);
DBLookupComboBox1.ListSource.DataSet.FieldByName(DBLookupComboBox1.KeyField).Value;
DBLookupComboBox2.ListSource.DataSet.Locate('UID', '1500', []);
DBLookupComboBox2.ListSource.DataSet.FieldByName(DBLookupComboBox2.KeyField).Value;
I am relatively new to FireDAC. I want to be able to call a stored procedure "on the fly", dynamically. So far I have the following:
function TForm21.ExecuteStoredProc(aSPName: string; aParams: TADParams): Boolean;
var
LSP: TADStoredProc;
i: Integer;
begin
LSP := TADStoredProc.Create(nil);
try
LSP.Connection := ADConnection1;
LSP.StoredProcName := aSPName;
LSP.Prepare;
for i := 0 to aParams.Count - 1 do
begin
LSP.Params[i].Value := aParams[i].Value;
end;
LSP.ExecProc;
finally
LSP.Free;
end;
Result := True;
end;
I call it with
procedure TForm21.Button1Click(Sender: TObject);
var
LParams: TADParams;
begin
LParams := TADParams.Create;
LParams.Add.Value := 612;
LParams.Add.Value := '2008';
ExecuteStoredProc('HDMTEST.dbo.spARCHIVE_HISTORY_DATA', LParams);
end;
However, the stored procedure fails to execute. That is, the code runs fine, no error message is shown, but the stored procedure doesn't run.
Further info -- it runs fine if I drop a component and set up the params in code.
Anyone have any idea what I am missing?
Seeing as this q has been left unanswered for a while, I thought I'd try to get the code working without using the clues from the comments and found it not quite as easy as I'd imagined.
I immediately got stuck with the SP params. I found this
http://docwiki.embarcadero.com/RADStudio/XE5/en/TFDQuery,_TFDStoredProc_and_TFDUpdateSQL_Questions
which says
"If you have difficulties with manual definition of parameters,
populate the Params collection automatically and check how the
parameters are defined. Then compare that to your code. "
but I couldn't find a way of "automatically" populating the Params. I asked on the EMBA
FireDac newsgroup and the FD author, Dimitry Arefiev, kindly explained that
you can do that by checking that the FetchOptions include fiMeta, and then clearing and setting the FDStoredProc's StoredProcName.
Using a StoredProc in the pubs demo database on my SqlServer defined as follows:
create procedure test(#ANumber int, #AName varchar(20))
as
begin
select
#ANumber * 2 as "Number",
#AName + #AName as "Name"
end
I changed a couple of sections of the OP's code like this
[...]
LSP.Params.Clear;
LSP.StoredProcName := '';
LSP.FetchOptions.Items := LSP.FetchOptions.Items + [fiMeta];
LSP.StoredProcName := aSPName;
LSP.Prepare;
Assert(LSP.ParamCount > 0);
for i := 0 to aParams.Count - 1 do
begin
LSP.Params.ParamByName(aParams[i].Name).Value := aParams[i].Value;
end;
[...]
procedure TForm21.Button1Click(Sender: TObject);
var
LParams: TFDParams;
Param : TFDParam;
begin
LParams := TFDParams.Create;
Param := LParams.Add;
Param.Name := '#ANumber';
Param.Value := 612;
Param := LParams.Add;
Param.Name := '#AName';
Param.Value := '2008';
ExecuteStoredProc('test', LParams);
end;
and it worked fine.
The OP mentions in the q he'd first had the problem that the SP failed to execute
but that he'd found that it worked if he "[dropped] a component and set up the params in code" so I thought I'd include here a console application where of course necessarily everything is done in code. This wasn't difficult, but the time it took me to get the Uses clause right is my main reason for posting this as an answer, for future reference. W/o the correct uses, you get errors complaining about various class factories being missing.
Console app (created and tested in XE6):
program ConsoleStoredProcProject3;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils, FireDac.DApt, FireDAC.Stan.Def, FireDAC.Stan.ASync,
FireDAC.Stan.Param, FireDAC.Stan.Option, FireDAC.Comp.Client,
FireDAC.Phys.MSSQL, VCL.ClipBrd;
procedure TestSP;
var
Connection : TFDConnection;
StoredProc : TFDStoredProc;
Param : TFDParam;
begin
Connection := TFDConnection.Create(Nil);
Connection.DriverName := 'MSSQL';
Connection.Params.Values['Server'] := // your server name'';
Connection.Params.Values['Database'] := 'pubs';
Connection.Params.Values['user_name'] := 'user'; // adjust to suit
Connection.Params.Values['password'] := 'password'; // ditto
Connection.LoginPrompt := False;
Connection.Connected := True;
StoredProc := TFDStoredProc.Create(Nil);
StoredProc.Connection := Connection;
StoredProc.FetchOptions.Items := StoredProc.FetchOptions.Items + [fiMeta];
StoredProc.StoredProcName := 'test';
StoredProc.Prepare;
Param := StoredProc.Params.ParamByName('#ANumber');
Param.Value := 333;
Param := StoredProc.Params.ParamByName('#AName');
Param.Value := 'A';
StoredProc.Active := True;
WriteLn(StoredProc.FieldByName('Number').AsInteger);
WriteLn(StoredProc.FieldByName('Name').AsString);
ReadLn;
end;
begin
try
TestSP;
except
on E: Exception do
Clipboard.AsText := E.Message;
end;
end.