I Have a script in db cross tab in fast report and I whant display value format from string to number(%2.0n) and separator ,
procedure DBCross1OnPrintCell(Memo: TfrxMemoView; RowIndex, ColumnIndex, CellIndex: Integer; RowValues, ColumnValues, Value: Variant);
begin
if ColumnIndex = 0 then
if Value <> null then
Set('Var0', Value)
else
Set('Var0', 0);
if DBCross1.IsGrandTotalColumn(ColumnIndex) then
Memo.Text :=VarToStr(value- Get('Var0'));
end;
procedure DBCross1OnPrintCell(Memo: TfrxMemoView; RowIndex, ColumnIndex, CellIndex: Integer; RowValues, ColumnValues, Value: Variant);
begin
if ColumnIndex = 0 then
if Value <> null then
Set('Var0', Value)
else
Set('Var0', 0);
if DBCross1.IsGrandTotalColumn(ColumnIndex) then
Memo.Text := Format('%2.0n', [StrToFloat(VarToStr(value- Get('Var0')))]);
end;
Related
I'm trying to sort a string grid filled with scores and strings like so:
via a sorted string list which is sorted by single columns from the grid called SUB 1, SUB 2, FINAL, TOTAL respectively (all these columns work except FINAL) and I'm not getting the results I need in the FINAL column.
I'm trying to get the column sorted like so, for example :
24
20
12
5
DNF
EXE
WE
but I'm getting this result instead (the result I do not want):
DNF
EXE
WE
24
20
12
5
In what way could I change my code to sort the grid as I want to sort it?
My code:
function Compare2(
List : TStringList;
Index1 : Integer;
Index2 : Integer) : Integer;
begin
//comparer for custom sort used in SortLTSGrid
if List[Index1] = List[Index2] then
Result := 0
else if List[Index1] < List[Index2] then
Result := 1
else
Result := -1;
end;
procedure TfrmPuntehou.SortLTSGrid(var grid: TStringGrid; columntotal: Integer);
var
TheList : TStringList;
i,l,iCount,m:integer;
const
separator = ',';
const
arrCodes:array[1..10] of string = ('DNF','DNS','WD','WE','DNA','OD','RD','EXR','EXE','PP');
begin
//sorts grid largest to smallest according to one column
//get grid row amount
iCount:=grid.RowCount - 1;
//create and fill the string list
TheList := TStringList.Create;
//fill the list
for i := 1 to (iCount) do
begin
for l := 1 to Length(arrCodes) do
begin
if grid.Rows[i].Strings[columntotal] = arrCodes[l] then
begin
TheList.Add('0'+separator+grid.Rows[i].Text);
end;
end;
TheList.Add(grid.Rows[i].Strings[columntotal]+separator+grid.Rows[i].Text);
end;
//try block to sort and write all strings in the list to the grid correctly
try
TheList.CustomSort(Compare2);
for i:= 1 to (iCount) do
begin
grid.Rows[i].Text := TheList.Strings[(i-1)] ;
end;
//fill the row numbers
for m := 1 to iCount do
begin
grid.Cells[0,m]:= IntToStr(m);
end;
finally
TheList.Free;
end;
end;
You can use two different lists to store items, and two different sorting functions (because you want to sort them in different direction; numbers will be ordered as decreasing and strings will be ordered as ascending) to sort lists. Sort the lists separately, and than merge them.
Please consider #David Heffernan's performance warning.
program Project3;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils, System.Classes;
var
slStrings, slNumbers:TStringList;
test:string;
function CompareForNumbers(
List : TStringList;
Index1 : Integer;
Index2 : Integer) : Integer;
var
val1, val2:Integer;
begin
val1 := StrToInt(List[Index1]);
val2 := StrToInt(List[Index2]);
if val1 = val2 then
Result := 0
else if val1 < val2 then
Result := 1
else
Result := -1;
end;
function CompareForStrings(
List : TStringList;
Index1 : Integer;
Index2 : Integer) : Integer;
begin
if List[Index1] = List[Index2] then
Result := 0
else if List[Index1] > List[Index2] then
Result := 1
else
Result := -1;
end;
begin
slStrings := TStringList.Create();
slNumbers := TStringList.Create();
try
slStrings.Add('EXE');
slStrings.Add('WE');
slStrings.Add('DNF');
slNumbers.Add('5');
slNumbers.Add('20');
slNumbers.Add('24');
slNumbers.Add('12');
slNumbers.CustomSort(CompareForNumbers);
slStrings.CustomSort(CompareForStrings);
slNumbers.AddStrings(slStrings);
Writeln(slNumbers.Text);
Readln(test);
finally
slStrings.Free();
slNumbers.Free();
end;
end.
To use single list to handle #David Heffernan's performance warning, i've write this;
program Project3;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils, System.Classes;
var
slStrings:TStringList;
test:string;
function Compare(
List : TStringList;
Index1 : Integer;
Index2 : Integer) : Integer;
var
val1, val2:Integer;
val1integer, val2integer:Boolean;
begin
val1integer := TryStrToInt(List[Index1], val1);
val2integer := TryStrToInt(List[Index2], val2);
if val1integer and val2integer then
begin
if val1 = val2 then
Result := 0
else if val1 < val2 then
Result := 1
else
Result := -1;
end
else if (not val1integer) And (not val2integer) then
begin
if List[Index1] = List[Index2] then
Result := 0
else if List[Index1] > List[Index2] then
Result := 1
else
Result := -1;
end
else
begin
if val1integer then
Result := -1
else
Result := 1;
end;
end;
begin
slStrings := TStringList.Create();
try
slStrings.Add('EXE');
slStrings.Add('5');
slStrings.Add('WE');
slStrings.Add('20');
slStrings.Add('DNF');
slStrings.Add('24');
slStrings.Add('12');
slStrings.Add('A');
slStrings.Add('6');
slStrings.Add('E');
slStrings.Add('B');
slStrings.Add('4');
slStrings.Add('T');
slStrings.Add('444');
slStrings.CustomSort(Compare);
Writeln(slStrings.Text);
Readln(test);
finally
slStrings.Free();
end;
end.
I believe you want to sort times by shortest to longest first, then all text alphabetically (although that is arguable).
I would not modify the texts in the way that you do. Instead I would simply modify the comparer function and pass the texts 'as is'.
To test it I used a TMemo, but the principle applies to the tables - just copy the appropriate column to the string list.
function Compare2(
List : TStringList;
Index1 : Integer;
Index2 : Integer) : Integer;
var
i1IsNumeric, i2IsNumeric : boolean;
i1, i2 : integer;
begin
//comparer for custom sort used in SortLTSGrid
i1IsNumeric := TryStrToInt( List[Index1], i1 );
i2IsNumeric := TryStrToInt( List[Index2], i2 );
if i1IsNumeric and (not i2IsNumeric) then
begin
Result := -1;
end
else if i2IsNumeric and (not i1IsNumeric) then
begin
Result := 1;
end
else if i1IsNumeric then
begin
Result := Sign( i1-i2);
end
else
begin
Result := CompareStr( List[Index1], List[Index2] );
end;
end;
Here is my test routine using a memo
procedure TForm4.Button1Click(Sender: TObject);
var
iList : TStringList;
begin
iList := TStringList.Create;
try
iList.Assign( Memo1.Lines );
iList.CustomSort( Compare2 );
Memo1.Lines.Assign( iList );
finally
iList.Free;
end;
end;
Your routine would be more like (although this I have not tested)
procedure TfrmPuntehou.SortLTSGrid(var grid: TStringGrid; columntotal: Integer);
var
TheList : TStringList;
i,l,iCount,m:integer;
const
separator = ',';
const
arrCodes:array[1..10] of string = ('DNF','DNS','WD','WE','DNA','OD','RD','EXR','EXE','PP');
begin
//sorts grid largest to smallest according to one column
//get grid row amount
iCount:=grid.RowCount - 1;
//create and fill the string list
TheList := TStringList.Create;
//fill the list
for i := 1 to (iCount) do
begin
TheList.Add(grid.Rows[i].Text);
end;
//try block to sort and write all strings in the list to the grid correctly
try
TheList.CustomSort(Compare2);
for i:= 1 to (iCount) do
begin
grid.Rows[i].Text := TheList.Strings[(i-1)] ;
end;
//fill the row numbers
for m := 1 to iCount do
begin
grid.Cells[0,m]:= IntToStr(m);
end;
finally
TheList.Free;
end;
end;
when trying to access the value of a field it does not allow me to obtain it, I am doing it in OnFiltered of the DataSet.
procedure TFrm_Transactions.qry_personal_trxsFilterRecord(DataSet: TDataSet; var Accept: Boolean);
var
vprs, vtrxs: string;
begin
if qry_personal_trxs.FindField('TRANSACTIONS') = nil then
accept := True
else
begin
vprs := DataSet.FieldByName('PERSONAL').AsString;
vtrxs := DataSet.FieldByName('TRANSACTIONS').AsString;
accept := (vprs = vPersonal) and (pos(',' + vTransaction + ',', vtrxs) > 0);
end;
end;
I need to validate the new value of a TField based on the previos value of the field itself.
e.g: the field's value can only be changed to bigger values
procedure TForm1.FldOnValidate(AField : TField);
begin
if(???) then
raise Exception.Create('The new value is not bigger than the previous one');
end;
procedure TForm1.FormCreate(Sender: TObject);
var
Dst : TClientDataSet;
Fld : TIntegerField;
begin
//dataset
Dst := TClientDataSet.Create(Self);
Dst.FieldDefs.Add('TEST', ftInteger, 0);
Dst.CreateDataSet();
Dst.Active := True;
Fld := Dst.Fields[0] as TIntegerField;
Dst.Append();
Fld.AsInteger := 5;
Dst.Post();
Fld.OnValidate := FldOnValidate;
//this should be ok (from 5 to 6)
Dst.Edit;
Fld.AsInteger := 6;
Dst.Post;
//this should not pass the validation (from 6 to 5)
Dst.Edit;
Fld.AsInteger := 5;
end;
I've tried to check the OldValue, NewValue, AsVariant and Value properties but I always get the new value:
procedure TForm1.FldOnValidate(AField : TField);
begin
ShowMessage(
'OldValue = ' + VarToStr(AField.OldValue) + sLineBreak +
'NewValue = ' + VarToStr(AField.NewValue) + sLineBreak +
'AsVariant = ' + VarToStr(AField.AsVariant) + sLineBreak +
'Value = ' + VarToStr(AField.Value)
);
end;
Hope someone could enlighten me about that
Use Unassigned
procedure TForm1.FldOnValidate(AField : TField);
begin
if Sender.OldValue <> Unassigned then
if Sender.NewValue <= Sender.OldValue then
raise Exception.Create('The new value is not bigger than the previous one');
end;
But the right place is OnChange event
procedure TForm1.ClientDataSet1ValChange(Sender: TField);
begin
if Sender.OldValue <> Unassigned then
if Sender.NewValue <= Sender.OldValue then
raise Exception.Create('The new value is not bigger than the previous one');
end;
I'm a student and stuck on Delphi Validation. Here is my code:
begin
valid := true;
for I:=1 to Length(edtvalue.Text) do
if not (edtvalue.Text[I] in ['0'..'9','.'] )then
valid:= false;
if not valid then
begin
showmessage ('This item is not within the range');
DataItem1 := 0;
end
else
dataitem1 := strtofloat(edtvalue.Text);
This code reads in a value that the user inputs and checks whether it actually is an integer and detects when a user inputs letters.
However when the user inputs something else (e.g. + or #) the code doesn't work and breaks the system. Is there a way I can fix this please?
Thanks in advance
Use TryStrToFloat :
var
F: Double;
begin
if not TryStrToFloat(edtvalue.Text, F) then
showmessage ('This item is not within the range');
else
dataitem1 := F;
end;
Or if you want to set DataItem1 to 0 when error :
var
F: Double;
begin
if not TryStrToFloat(edtvalue.Text, F) then
begin
showmessage ('This item is not within the range');
DataItem1 := 0;
end
else
dataitem1 := F;
end;
Also you can create a Function to do that , like :
function IsFloat(Str: string): Boolean;
var
I: Double;
C: Integer;
begin
Val(Str, I, C);
Result := C = 0;
end;
I changed to use TryStrToFloat as recommended by David in the comments, you just need to declare that val variable:
var
val: Extended;
begin
val := 0;
if not TryStrToFloat(edtvalue.Text, val) then
showmessage ('This item is not within the range');
dataitem1 := val;
end;
I have a string like so:
Directory=Voice Active Directory A,ID=VT-AD1,Location=Canada,UserName=admin,Password=passw0rd,Selector=AD1
I'm writing a function that will receive this value as parameter and another parameter as UserName
I need to find the value against key UserName from the given string which is admin
I'm searching if there is a RegEx within oracle to help out here.
Here is what I have made so far:
CREATE OR REPLACE FUNCTION GET_CSV_FIELD(Parameter_RowData IN CLOB, Parameter_Field_Name IN VARCHAR2 )
RETURN VARCHAR2
AS
Found_Index INTEGER;
End_Index INTEGER;
Pair_Index INTEGER;
Return_Result VARCHAR2(4000);
BEGIN
Found_Index := INSTR(Parameter_RowData, Parameter_Field_Name);
IF Found_Index > 0 THEN
End_Index := INSTR(Parameter_RowData, ',', Found_Index);
Pair_Index := INSTR(Parameter_RowData, '=', Found_Index);
IF End_Index = 0 THEN
Return_Result := '';
RETURN Return_Result;
END IF;
IF Pair_Index = 0 THEN
Return_Result := '';
RETURN Return_Result;
END IF;
Return_Result := SUBSTR(Parameter_RowData, Pair_Index + 1, End_Index - Pair_Index - 1);
ELSE
Return_Result := '';
END IF;
RETURN Return_Result;
END;
Any better method? Thanks.
You can do this with regular expressions:
select substr(regexp_substr(str, 'UserName=[^,]+'), 10)
The general method would be
select substr(regexp_substr(str, v_param || '=[^,]+'), length(v_param) + 2)