i have an code for call a defined name in excel like nms[1].Name
from code :
procedure TForm2.Button1Click(Sender: TObject);
var
Excel,Workbook : variant;
ExcelFileName,name:string;
nms,wks :Variant;
begin
if not OpenDialog1.Execute then Exit;
Excel := CreateOleObject('Excel.Application');
ExcelFileName := OpenDialog1.FileName;
Workbook := Excel.WorkBooks.Open(OpenDialog1.FileName);
nms := Excel.ActiveWorkbook.Names;
wks := Workbook.worksheets[1];
name := nms[1].Name; --> i found error in here member not found
...
end;
Related
I followed Martin's answer here to create UI for 4 license pages in my Inno Setup installer.
The code looks like below (work in progress..)
[Files]
Source: "license2_english.txt"; Flags: dontcopy
Source: "license3_english.txt"; Flags: dontcopy
Source: "license4_english.txt"; Flags: dontcopy
[Code]
var
SecondLicensePage: TOutputMsgMemoWizardPage;
License2AcceptedRadio: TRadioButton;
License2NotAcceptedRadio: TRadioButton;
ThirdLicensePage: TOutputMsgMemoWizardPage;
License3AcceptedRadio: TRadioButton;
License3NotAcceptedRadio: TRadioButton;
FourthLicensePage: TOutputMsgMemoWizardPage;
License4AcceptedRadio: TRadioButton;
License4NotAcceptedRadio: TRadioButton;
procedure CheckLicense2Accepted(Sender: TObject);
begin
// Update Next button when user (un)accepts the license
WizardForm.NextButton.Enabled := License2AcceptedRadio.Checked;
end;
procedure CheckLicense3Accepted(Sender: TObject);
begin
// Update Next button when user (un)accepts the license
WizardForm.NextButton.Enabled := License3AcceptedRadio.Checked;
end;
procedure CheckLicense4Accepted(Sender: TObject);
begin
// Update Next button when user (un)accepts the license
WizardForm.NextButton.Enabled := License4AcceptedRadio.Checked;
end;
function CloneLicenseRadioButtonL2(Source: TRadioButton): TRadioButton;
begin
Result := TRadioButton.Create(WizardForm);
Result.Parent := SecondLicensePage.Surface;
Result.Caption := Source.Caption;
Result.Left := Source.Left;
Result.Top := Source.Top;
Result.Width := Source.Width;
Result.Height := Source.Height;
Result.Anchors := Source.Anchors;
Result.OnClick := #CheckLicense2Accepted;
end;
function CloneLicenseRadioButtonL3(Source: TRadioButton): TRadioButton;
begin
Result := TRadioButton.Create(WizardForm);
Result.Parent := ThirdLicensePage.Surface;
Result.Caption := Source.Caption;
Result.Left := Source.Left;
Result.Top := Source.Top;
Result.Width := Source.Width;
Result.Height := Source.Height;
Result.Anchors := Source.Anchors;
Result.OnClick := #CheckLicense3Accepted;
end;
function CloneLicenseRadioButtonL4(Source: TRadioButton): TRadioButton;
begin
Result := TRadioButton.Create(WizardForm);
Result.Parent := FourthLicensePage.Surface;
Result.Caption := Source.Caption;
Result.Left := Source.Left;
Result.Top := Source.Top;
Result.Width := Source.Width;
Result.Height := Source.Height;
Result.Anchors := Source.Anchors;
Result.OnClick := #CheckLicense4Accepted;
end;
//Create license wizards
procedure InitializeWizard();
var
LicenseFileNameL2: string;
LicenseFileNameL3: string;
LicenseFilenameL4: string;
LicenseFilePathL2: string;
LicenseFilePathL3: string;
LicenseFilePathL4: string;
begin
Log(Format('Temp : %s', [ExpandConstant('{tmp}')]));
// Create second license page, with the same labels as the original license page
SecondLicensePage :=
CreateOutputMsgMemoPage(
wpLicense, SetupMessage(msgWizardLicense), SetupMessage(msgLicenseLabel),
SetupMessage(msgLicenseLabel3), '');
// Create third license page, with the same labels as the original license page
ThirdLicensePage :=
CreateOutputMsgMemoPage(
wpLicense, SetupMessage(msgWizardLicense), SetupMessage(msgLicenseLabel),
SetupMessage(msgLicenseLabel3), '');
FourthLicensePage :=
CreateOutputMsgMemoPage(
wpLicense, SetupMessage(msgWizardLicense), SetupMessage(msgLicenseLabel),
SetupMessage(msgLicenseLabel3), '');
// Shrink license box to make space for radio buttons
SecondLicensePage.RichEditViewer.Height := WizardForm.LicenseMemo.Height;
ThirdLicensePage.RichEditViewer.Height := WizardForm.LicenseMemo.Height;
FourthLicensePage.RichEditViewer.Height := WizardForm.LicenseMemo.Height;
// Load license
// Loading ex-post, as Lines.LoadFromFile supports UTF-8,
// contrary to LoadStringFromFile.
LicenseFileNameL2 := 'license2_english.txt';
LicenseFileNameL3 := 'license3_english.txt';
LicenseFileNameL4 := 'license4_english.txt';
LicenseFilePathL2 := ExpandConstant('{tmp}\' + LicenseFileNameL2);
LicenseFilePathL3 := ExpandConstant('{tmp}\' + LicenseFileNameL3);
LicenseFilePathL4 := ExpandConstant('{tmp}\' + LicenseFileNameL4);
ExtractTemporaryFile(LicenseFileNameL2);
ExtractTemporaryFile(LicenseFileNameL3);
ExtractTemporaryFile(LicenseFileNameL4);
SecondLicensePage.RichEditViewer.Lines.LoadFromFile(LicenseFilePathL2);
ThirdLicensePage.RichEditViewer.Lines.LoadFromFile(LicenseFilePathL3);
FourthLicensePage.RichEditViewer.Lines.LoadFromFile(LicenseFilePathL4);
DeleteFile(LicenseFilePathL2);
DeleteFile(LicenseFilePathL3);
DeleteFile(LicenseFilePathL4);
// Clone accept/do not accept radio buttons for the second license
License2AcceptedRadio :=
CloneLicenseRadioButtonL2(WizardForm.LicenseAcceptedRadio);
License2NotAcceptedRadio :=
CloneLicenseRadioButtonL2(WizardForm.LicenseNotAcceptedRadio);
License3AcceptedRadio :=
CloneLicenseRadioButtonL3(WizardForm.LicenseAcceptedRadio);
License3NotAcceptedRadio :=
CloneLicenseRadioButtonL3(WizardForm.LicenseNotAcceptedRadio);
License4AcceptedRadio :=
CloneLicenseRadioButtonL4(WizardForm.LicenseAcceptedRadio);
License4NotAcceptedRadio :=
CloneLicenseRadioButtonL4(WizardForm.LicenseNotAcceptedRadio);
// Initially not accepted
License2NotAcceptedRadio.Checked := True;
License3NotAcceptedRadio.Checked := True;
License4NotAcceptedRadio.Checked := True;
end;
procedure CurPageChanged(CurPageID: Integer);
begin
// Update Next button when user gets to second license page
if CurPageID = SecondLicensePage.ID then
begin
CheckLicense2Accepted(nil);
end;
end;
procedure CurPageChangedL3(CurPageID: Integer);
begin
// Update Next button when user gets to second license page
if CurPageID = ThirdLicensePage.ID then
begin
CheckLicense3Accepted(nil);
end;
end;
procedure CurPageChangedL4(CurPageID: Integer);
begin
// Update Next button when user gets to second license page
if CurPageID = FourthLicensePage.ID then
begin
CheckLicense4Accepted(nil);
end;
end;
With this code, I see the following issues:
License 4 page comes up before License 2 and 3
In page 2, initially the radio button is initialized to "I do not accept". In this case the "Next" button is enabled and user can move to the next screen.
Image shows Next button enabled even when "I do not accept is selected". Also License 4 is coming before License 2
I know I have made a basic mistake somewhere when I tried to expand Martin's answer to cover additional licenses, but I couldn't figure it out yet.
Let me know if anyone has a idea to fix/debug this.
Thanks!
a
I'm not gonna try to fix your issues as the way you triplicated all the code is pretty inefficient and hard to maintain. Factor out the creation of the additional license pages instead. Something like this:
[Setup]
LicenseFile=license1.txt
[Files]
Source: "license2.txt"; Flags: dontcopy
Source: "license3.txt"; Flags: dontcopy
Source: "license4.txt"; Flags: dontcopy
[Code]
var
LicenseAcceptedRadioButtons: array of TRadioButton;
procedure CheckLicenseAccepted(Sender: TObject);
begin
// Update Next button when user (un)accepts the license
WizardForm.NextButton.Enabled :=
LicenseAcceptedRadioButtons[TComponent(Sender).Tag].Checked;
end;
procedure LicensePageActivate(Sender: TWizardPage);
begin
// Update Next button when user gets to second license page
CheckLicenseAccepted(LicenseAcceptedRadioButtons[Sender.Tag]);
end;
function CloneLicenseRadioButton(
Page: TWizardPage; Source: TRadioButton): TRadioButton;
begin
Result := TRadioButton.Create(WizardForm);
Result.Parent := Page.Surface;
Result.Caption := Source.Caption;
Result.Left := Source.Left;
Result.Top := Source.Top;
Result.Width := Source.Width;
Result.Height := Source.Height;
// Needed for WizardStyle=modern / WizardResizable=yes
Result.Anchors := Source.Anchors;
Result.OnClick := #CheckLicenseAccepted;
Result.Tag := Page.Tag;
end;
var
LicenseAfterPage: Integer;
procedure AddLicensePage(LicenseFileName: string);
var
Idx: Integer;
Page: TOutputMsgMemoWizardPage;
LicenseFilePath: string;
RadioButton: TRadioButton;
begin
Idx := GetArrayLength(LicenseAcceptedRadioButtons);
SetArrayLength(LicenseAcceptedRadioButtons, Idx + 1);
Page :=
CreateOutputMsgMemoPage(
LicenseAfterPage, SetupMessage(msgWizardLicense),
SetupMessage(msgLicenseLabel), SetupMessage(msgLicenseLabel3), '');
Page.Tag := Idx;
// Shrink license box to make space for radio buttons
Page.RichEditViewer.Height := WizardForm.LicenseMemo.Height;
Page.OnActivate := #LicensePageActivate;
// Load license
// Loading ex-post, as Lines.LoadFromFile supports UTF-8,
// contrary to LoadStringFromFile.
ExtractTemporaryFile(LicenseFileName);
LicenseFilePath := ExpandConstant('{tmp}\' + LicenseFileName);
Page.RichEditViewer.Lines.LoadFromFile(LicenseFilePath);
DeleteFile(LicenseFilePath);
// Clone accept/do not accept radio buttons
RadioButton :=
CloneLicenseRadioButton(Page, WizardForm.LicenseAcceptedRadio);
LicenseAcceptedRadioButtons[Idx] := RadioButton;
RadioButton :=
CloneLicenseRadioButton(Page, WizardForm.LicenseNotAcceptedRadio);
// Initially not accepted
RadioButton.Checked := True;
LicenseAfterPage := Page.ID;
end;
procedure InitializeWizard();
begin
LicenseAfterPage := wpLicense;
AddLicensePage('license2.txt');
AddLicensePage('license3.txt');
AddLicensePage('license4.txt');
end;
I need help with creating my music player, I'm receiving the same error and can't seem to get past it. Thank you.
I've attached my code below, as well as my errors.
Errors:
Free Pascal Compiler version 2.6.4 [2014/02/26] for i386 Copyright (c)
1993-2014 by Florian Klaempfl and others Target OS: Darwin for i386
Compiling MusicPlayer.pas
MusicPlayer.pas(82,37) Error: Incompatible type for arg no. 1: Got "ShortString", expected "Album"
MusicPlayer.pas(138,31) Error: Incompatible type for arg no. 1: Got
"albumArray", expected "Album"
MusicPlayer.pas(164,44) Error: Incompatible type for arg no. 1: Got "albumArray", expected "Album"
MusicPlayer.pas(174) Fatal: There were 3 errors compiling module,
stopping Fatal: Compilation aborted Error: /usr/local/bin/ppc386
returned an error exitcode (normal if you did not specify a source
file to be compiled)
program MusicPlayer;
uses TerminalUserInput;
type
Track = record
trackName: String;
location: String;
end;
TrackArray = array of Track;
Album = record
albumName: String;
artistName: String;
genre: String;
track: TrackArray;
// key: Integer;
trackNum: Integer;
fileName: String;
end;
albumArray = array of Album;
function GetAlbums(): albumArray;
var
// anAlbum: Album;
//albums: albumArray;
fileName: String;
myFile: TextFile;
numOfAlb: Integer;
trackNum: Integer;
i: Integer;
j: Integer;
begin
fileName := ReadString('Enter filename: ');
AssignFile(myFile, fileName);
// AssignFile(myFile, 'albums.dat');
Reset(myFile);
ReadLn(myFile, numOfAlb);
setLength(result, numOfAlb);
for i:= 0 to High(result) do
begin
ReadLn(myFile, result[i].albumname);
ReadLn(myFile, result[i].artistName);
ReadLn(myFile, result[i].genre);
ReadLn(myFile, trackNum);
setLength(result[i].track, trackNum);
for j:= 0 to trackNum -1 do
begin
ReadLn(myFile, result[i].track[j].trackName);
ReadLn(myFile, result[i].track[j].location);
end;
end;
end;
procedure DisplayAlbum(a: Album);
var
//t: Track;
i: Integer;
begin
WriteLn('Album name is: ', a.albumName);
WriteLn('Album artist name is: ', a.artistName);
WriteLn('Album genre is: ', a.genre);
WriteLn('Number of tracks are: ', a.trackNum);
for i:= 0 to High(a.track) do
begin
WriteLn('Track name is: ', a.track[i].trackName);
WriteLn('Album name is: ', a.track[i].location);
end;
end;
function PrintAllGenres(albums: albumArray): albumArray;
var
i: Integer;
begin
for i := 0 to High(albums) do
begin
DisplayAlbum(albums[i].genre);
end;
end;
procedure SelectAlbum(const albums: albumArray);
var
val: Integer;
i: Integer;
begin
WriteLn('<< Welcome to the Track Player >>');
val := ReadInteger('Enter an Album''s key number: ');
for i := 0 to High(albums) do
begin
WriteLn('Album is now playing.');
end;
if (i > High(albums)) then
begin
WriteLn('Album was not found, now returning to Main Menu ');
end;
end;
function UpdateAlbum(a: Album): Album;
begin
a.albumName := ReadString('Please enter a new name for this album: ');
a.genre := ReadString('Please enter a new genre for this album: ');
end;
// function UpdateAlbums(): albumArray;
// var
// val: Integer;
// i: Integer;
// begin
// WriteLn('<< Album Updater >>');
// val := ReadInteger('Enter an Album''s key number: ');
// if (val = True) then
// WriteLn('Album was found.')
// else
// WriteLn('Album was not found, now returning to Main Menu ');
// end;
procedure DisplayAlbums(albums: albumArray);
var
val: Integer;
begin
repeat
WriteLn('<< Displaying Albums >>');
WriteLn('1. Display all albums');
WriteLn('2. Display genre');
WriteLn('3. Return to main menu');
val := ReadInteger('Enter a number to enter menu: ');
case val of
1: DisplayAlbum(albums);
2: PrintAllGenres(albums);
end;
until val = 3;
end;
procedure Main();
var
albums: albumArray;
val: Integer;
begin
repeat
WriteLn('<< Text Music Player Menu >>');
WriteLn('1. Read in Albums');
WriteLn('2. Display Albums');
WriteLn('3. Select an Album to play');
WriteLn('4. Update an existing Album');
WriteLn('5. Quit');
val := ReadInteger('Enter a number to enter menu: ');
case val of
1: albums := GetAlbums();
2: DisplayAlbums(albums);
3: SelectAlbum(albums);
4: albums := UpdateAlbum(albums);
end;
until val = 5;
end;
begin
Main();
end.
In your code you have written
procedure DisplayAlbum(a: Album);
which means that you need to pass an Album to the procedure, but on line 82 you have written
DisplayAlbum(albums[i].genre);
genre is a field of an Album while you should pass a whole Album
Change line 82 to
DisplayAlbum(albums[i]);
I leave the other errors for you yourself to work out, the errors are very similar, and you should now be able to sort them out.
As I told you yesterday, you may want to (or actually, need to) speak with your tutor to get a better understanding.
So i'm working on this pascal application which has a menu where you can do multiple things.
After entering an album (which is what my program does) and trying to edit it by writing over the current album I get an error as shown in the image.
There have been no errors when compiling except the warning:
(100,9) Warning: Function result variable does not seem to initialized
Here is my code:
program MusicPlayer;
uses TerminalUserInput;
type
// You should have a track record
TrackRec = record
name: String;
location: String;
end;
type TrackArray = array of TrackRec;
GenreType = (Pop, Rap, Rock, Classic);
AlbumRec = Record
name: String;
genre: GenreType;
location: array of TrackRec; // this and track should be track: array of TrackRec
numberOfTracks: Integer;
tracks: TrackArray;
end;
type AlbumArray = array of AlbumRec; // this should be an array of AlbumRec
function ReadGenre(prompt: String): GenreType;
var
option: Integer;
begin
WriteLn('Press 1 for Pop');
WriteLn('Press 2 for Rap');
WriteLn('Press 3 for Rock');
WriteLn('Press 4 for Classic');
option := ReadInteger(prompt);
while (option<1) or (option>3) do
begin
WriteLn('Please enter a number between 1-4');
option := ReadInteger(prompt);
end;
case option of
1: result := Pop;
2: result := Rap;
3: result := Rock;
else
result := Classic;
end;
end;
function CheckLength(prompt: string): Integer;
var
i: Integer;
begin
i := ReadInteger(prompt);
while (i < 0) or (i > 20) do
begin
WriteLn('Please enter a number between 1-20');
i := ReadInteger(prompt);
end;
result := i;
end;
function ReadTracks(count: Integer): TrackArray;
var
i: Integer;
begin
setLength(result, count);
for i := 0 to High(result) do
begin
result[i].name := ReadString('Track Name: ');
result[i].location := ReadString('Track Location: ');
end;
end;
function ReadAlbum(): AlbumRec;
begin
result.name := ReadString('What is the name of the album?');
result.genre := ReadGenre('What is the genre of the album?');
result.numberOfTracks := CheckLength('How many tracks are in the album?');
result.tracks := ReadTracks(result.numberOfTracks);
end;
function ReadAlbums(count: Integer): AlbumArray;
var
i: Integer;
begin
SetLength(result, count);
for i := 0 to High(result) do
begin
result[i] := ReadAlbum();
end;
end;
function ChangeAlbum(count: Integer): AlbumArray;
var
i: Integer;
begin
for i := count to count do
begin
result[i] := ReadAlbum();
end;
end;
procedure PrintAlbum(count: Integer; album: array of AlbumRec);
var
i: Integer;
begin
if count = 1 then
begin
for i := 0 to High(album) do
begin
WriteLn('Album Number: ', i);
WriteLn('Album name is: ', album[i].name);
WriteLn('Album genre is: ', album[i].genre);
end
end;
for i := 1 to count - 1 do
begin
WriteLn('Album name is: ', album[i].name);
WriteLn('Album genre is: ', album[i].genre);
end;
end;
procedure PrintTrack(tracks: TrackArray);
var
i: Integer;
begin
i := ReadInteger('Which track number do you wish to play?');
i := i - 1;
WriteLn('Now playing track: ', tracks[i].name);
WriteLn('Track location: ', tracks[i].location);
end;
function CheckIfFinished(): Boolean;
var answer: String;
begin
WriteLn('Do you want to enter another set of tracks? ');
ReadLn(answer);
LowerCase(answer);
case answer of
'no': result := true;
'n': result := true;
'x': result := true;
else
result := false;
end;
end;
procedure Main();
var
i, count, select, change: Integer;
albums: AlbumArray;
begin
WriteLn('Please select an option: ');
WriteLn('-------------------------');
WriteLn('1. Read Albums');
WriteLn('2. Display Albums');
WriteLn('3. Select an Album');
WriteLn('4. Update an Album');
WriteLn('5. Exit');
WriteLn('-------------------------');
repeat
i := ReadInteger('Your Option:');
case i of
1:
begin
count := ReadInteger('How many albums: ');
albums := ReadAlbums(count);
end;
2:
begin
WriteLn('1. Display All Albums');
WriteLn('2. Display All Albums by Genre');
select := ReadInteger('Your Option: ');
if i = 1 then
begin
PrintAlbum(select, albums);
end;
// if i = 2 then
// WriteLn('1. Pop');
// WriteLn('2. Rap');
// WriteLn('3. Rock');
// WriteLn('4. Classic');
// albums := ReadAlbums(count);
end;
3:
begin
select := ReadInteger('Which album would you like to play? ');
PrintAlbum(select, albums);
PrintTrack(albums[select-1].tracks);
end;
4:
begin
change := ReadInteger('Which album would you like to edit?');
albums := ChangeAlbum(change);
end;
end;
until i = 5;
end;
begin
Main();
end.
The function that the warning refers to, on line 100, is
function ChangeAlbum(count: Integer): AlbumArray;
var
i: Integer;
begin
for i := count to count do
begin
result[i] := ReadAlbum();
end;
end;
The warning says:
Warning: Function result variable does not seem to initialized
And indeed the result variable has not been initialized.
The design of the function is wrong though. You are trying to modify an existing element in an array. You should not be returning a new array. The function is not necessary though. You should simply remove it. Then you need to look at the one place where you call the function.
change := ReadInteger('Which album would you like to edit?');
albums := ChangeAlbum(change);
You should instead code that like this:
change := ReadInteger('Which album would you like to edit?');
albums[change] := ReadAlbum();
I've not checked anything else in your program. I would not be surprised if there are other problems. I've just tried to address the specific question that you asked.
i used a httpd to request some data from internet
function requestToServer(lParamList: TStringList) : string;
var
userDataString : string;
lHTTP: TIdHTTP;
serverResponce : string;
aobj: ISuperObject;
begin
application.ProcessMessages;
TThread.CreateAnonymousThread(
procedure
begin
lHTTP := TIdHTTP.Create(nil);
try
serverResponce := lHTTP.Post('http://domain.com/mjson.php', lParamList);
application.ProcessMessages;
aobj:= SO(serverResponce);
try
X := aobj['dta'].AsArray;
Except
form2.Memo1.Lines.Add('errr');
end;
if aobj['result'].AsString = 'lr_102' then
begin
form2.Label3.Text:='Saved token expired.';
form2.Rectangle2.Visible:=true;
end
else if aobj['result'].AsString = 'lr_103' then
begin
form2.Label3.Text:='Auto login.';
//load device data
form2.allDeviceListData := X;
form2.Hide;
form1.show;
end;
// globalReachedServer:=true;
finally
lHTTP.Free;
lParamList.Free;
end;
TThread.Synchronize(nil,
procedure
begin
end);
end
).Start();
end;
but after reach this function
the application show a black page and dont do anything until manually close
how can i do a web request at the background and with out hanging on fire-monkey !?
what a bout using REST is it better to access web service's?
Your code is not thread-safe. Your thread is directly accessing UI controls without synchronizing with the main UI thread. That alone can cause problems.
Also, all of the variables declared in the var section of requestToServer() should be moved into the var section of the anonymous procedure instead, since requestToServer() does not use them, so they can be completely local to the thread instead. The only thing the anonymous procedure should be capturing is the lParamList content.
Try something more like this:
function requestToServer(lParamList: TStringList) : string;
var
Params: TStringList;
Thread: TThread;
begin
Params := TStringList.Create;
try
Params.Assign(lParamList);
except
Params.Free;
raise;
end;
TThread.CreateAnonymousThread(
procedure
var
lHTTP: TIdHTTP;
serverResponce : string;
aObj: ISuperObject;
begin
try
try
lHTTP := TIdHTTP.Create(nil);
try
serverResponce := lHTTP.Post('http://domain.com/mjson.php', lParamList);
aObj := SO(serverResponce);
if aObj['result'].AsString = 'lr_102' then
begin
TThread.Queue(nil,
procedure
begin
form2.Label3.Text := 'Saved token expired.';
form2.Rectangle2.Visible := true;
end
);
end
else if aObj['result'].AsString = 'lr_103' then
begin
X := aObj['dta'].AsArray;
TThread.Queue(nil,
procedure
begin
form2.Label3.Text := 'Auto login.';
//load device data
form2.allDeviceListData := X;
form2.Hide;
form1.show;
end
);
end;
// globalReachedServer := true;
finally
lHTTP.Free;
end;
finally
Params.Free;
end;
except
TThread.Queue(nil,
procedure
begin
form2.Memo1.Lines.Add('errr');
end
);
end;
end
).Start;
end;
I'm using Delphi 5 + BDE + Oracle. I have the following function:
class function TClientDataSetFactory.GetClientDataSet(
const qryGen: TDataSet): TClientDataSet;
var
dspDados: TDataSetProvider;
begin
Result := nil;
try
try
Result := TClientDataSet.Create(nil);
dspDados := TDataSetProvider.Create(Result);
dspDados.DataSet := qryGen;
qryGen.Active := True;
qryGen.First;
Result.Data := dspDados.Data;
Result.First;
except
on E: Exception do
begin
raise;
end;
end;
finally
end;
end;
so, when a run this:
var
qryGen: TQuery;
cdsGen: TClientDataSet;
begin
qryGen := nil;
try
try
qryGen := CriaQuery();
qryGen.SQL.Text :=
'SELECT SUM(TOTAL) AS TOTAL FROM MYTABLE';
cdsGen := TClientDataSetFactory.GetClientDataSet(qryGen);
ShowMessageFmt('Total: %f', [cdsGen.FieldByName('TOTAL').AsFloat]);
except
on E: Exception do
begin
raise;
end;
end;
finally
if Assigned(qryGen) then FreeAndNil(qryGen);
end;
end;
i got "159,00" but, if i run this:
ShowMessageFmt('Total: %f', [qryGen.FieldByName('TOTAL').AsFloat]);
i got "159,25".
can someone help me?
I solved the problem with another solution.
type
TInternalQuery = class(TQuery)
protected
procedure InternalInitFieldDefs; override;
public
constructor Create(AOwner: TComponent; const qryGen: TQuery); reintroduce;
end;
constructor TInternalQuery.Create(AOwner: TComponent; const qryGen: TQuery);
var
intCont: Integer;
begin
inherited Create(AOwner);
Self.DatabaseName := qryGen.DatabaseName;
Self.UpdateObject := qryGen.UpdateObject;
Self.SQL.Text := qryGen.SQL.Text;
for intCont := 0 to Self.ParamCount - 1 do
begin
Self.Params[intCont].Value := qryGen.Params[intCont].Value;
end;
end;
procedure TInternalQuery.InternalInitFieldDefs;
var
intCont: Integer;
begin
inherited InternalInitFieldDefs;
for intCont := 0 to FieldDefs.Count - 1 do
begin
if (FieldDefs[intCont].Size = 0) and (FieldDefs[intCont].DataType = ftBCD) then
begin
FieldDefs[intCont].Precision := 64;
FieldDefs[intCont].Size := 32;
end;
end;
end;
the problem is ((FieldDefs[intCont].Size = 0) and (FieldDefs[intCont].DataType = ftBCD)). when ClientDataSet is created, the field is truncated, because when oracle has a function like "SUM(TOTAL)" the result field is created with size 0, so the clientdataset handle the field as Integer field.
Try with
ShowMessageFmt('Total: %n', [cdsGen.FieldByName('TOTAL').AsFloat])
or this
cdsGen := TClientDataSetFactory.GetClientDataSet(qryGen);
**(cdsGen.FieldByName('Total') as TFloatField).DisplayFormat := '0.00';**
ShowMessageFmt('Total: %f', [cdsGen.FieldByName('TOTAL').AsFloat])