How to prevent automatic selection of entire text on focusing TCxMemo?
Currently I fight against that by scrolling the memo to the end on every keystroke:
procedure TMyForm.ScrollMemoToTheEnd(AMemo: TCxMemo);
begin
AMemo.SelLength := 0;
AMemo.SelStart := Length(AMemo.Text);
AMemo.InnerControl.Perform(EM_SCROLLCARET, 0, 0);
end;
procedure TMyForm.BarCodeMemoKeyPress(Sender: TObject; var Key: Char);
begin
inherited;
ScrollMemoToTheEnd(BarCodeMemo);
if Key = #13 then begin
ParseBarCode(BarCodeMemo.Text);
end else
if Key >= #32 then begin
// Allow adding characters only at the end
BarCodeMemo.Text := BarCodeMemo.Text + Key;
ScrollMemoToTheEnd(BarCodeMemo);
Key := #0;
end;
end;
I tried following:
procedure TMyForm.BarCodeMemoEnter(Sender: TObject);
begin
inherited;
ScrollMemoToTheEnd(BarCodeMemo);
end;
the BarCodeMemoEnter is called, but the ScrollMemoToTheEnd call makes no effect.
I think, there should be some property in TCxMemo to control this behaviour.
Related
I'm working on porting a set of paradox tables to SQLite. In order to do so, I created a test application that simulates (somewhat) the current usage scenario: multiple users accessing the same DB file and performing simultaneous read and writes.
The application is very simple: it will start several threads that each create a connection, opens a table and will randomly read, update or insert inside the table.
Almost immediately, The application encounters a "database table locked" error. I have tried several things to attempt to work around it but nothing seems to work. What am I doing wrong ?
Here is the code internal to the threads:
procedure testDB(TargetFolder: string);
var
Conn: TFDConnection;
Table: TFDTable;
i: Integer;
begin
randomize;
Conn := TFDConnection.Create(nil);
try
Conn.DriverName := 'SQLite';
Conn.LoginPrompt := false;
Conn.Params.clear;
Conn.Params.Database := TPath.Combine(TargetFolder, 'testDB.sdb');
Conn.Params.Add('DriverID=SQLite');
// all this is the result of several attemp to fix the table locking error. none worked
Conn.Params.Add('LockingMode=Normal');
Conn.Params.Add('Synchronous=Normal');
Conn.UpdateOptions.UpdateMode := TUpdateMode.upWhereAll;
Conn.UpdateOptions.LockWait := True;
Conn.UpdateOptions.LockMode := TFDLockMode.lmPessimistic;
Conn.UpdateOptions.LockPoint := TFDLockPoint.lpImmediate;
Conn.UpdateOptions.AssignedValues := [uvLockMode,uvLockPoint,uvLockWait];
Conn.Open();
Conn.ExecSQL('CREATE TABLE IF NOT EXISTS ''test'' (''ID'' INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT UNIQUE,''data1'' TEXT NOT NULL,''data2'' INTEGER NOT NULL)');
Table := TFDTable.Create(nil);
try
table.Connection := Conn;
while True do
begin
case Trunc(Random(10)) of
0..3:
begin
table.Open('test');
try
if table.Locate('data1', 'name'+intToStr(Trunc(Random(10))),[TLocateOption.loCaseInsensitive]) then
begin
table.Edit;
table.FieldByName('data2').AsInteger := table.FieldByName('data2').AsInteger + 1;
table.Post;
end;
finally
table.close;
end;
end;
4..8:
begin
table.Open('test');
try
i := Trunc(Random(10));
if not table.Locate('data1', 'name'+ i.ToString,[TLocateOption.loCaseInsensitive]) then
begin
table.AppendRecord([null, 'name'+ i.ToString, 0]);
end;
finally
table.close;
end;
end
else
break;
end;
end;
finally
FreeAndNil(Table);
end;
finally
FreeAndNil(Conn);
end;
end;
Thanks to Victoria, I managed to find the right parameters.
Conn := TFDConnection.Create(nil);
try
Conn.DriverName := 'SQLite';
Conn.LoginPrompt := false;
Conn.Params.clear;
Conn.Params.Database := TPath.Combine(TargetFolder, 'testDB.sdb');
Conn.Params.Add('DriverID=SQLite');
Conn.Params.Add('SharedCache=False');
Conn.Params.Add('LockingMode=Normal');
Conn.Params.Add('Synchronous=Normal');
Conn.UpdateOptions.LockWait := True;
Conn.Open();
Thanks again
I am trying to save binary encoded data in SQLite database and I am able to save the values but there are few characters that are getting lost after saving and closing the dataset.
The inserted data looks like this.
The highlighted text is getting lost when I load the saved record in a grid or table.
Create SQLite connection:
procedure CreateSQLiteDB(ASQLiteDB: string);
begin
FDConnection1.Params.Values['Database'] := 'DB_MOBILE';
FDConnection1.Connected := true;
end;
Copy table schema from an existing dataset:
procedure CopyTableSchemaFrom(ADataset: TDataset;
ATableNm: string);
var
i: Integer;
AField: TField;
procedure L_CopyFieldDefToSQLiteTable(AName: string; aType: TDataType;
ASize: Integer; AIsRqrd: Boolean);
var
LFldSz: Integer;
begin
LFldSz:= 0;
case aType of
ftString, ftWideString, ftBCD, ftBytes, ftVarBytes, ftBlob, ftMemo, ftGraphic: LFldSz:= ASize;
end;
tblSQLite.FieldDefs.Add(AName, aType, LFldSz, AIsRqrd);
end;
begin
if ADataset = nil then
Assert(false, 'Unassigned argument supplied in ADataset.');
if Trim(ATableNm) = '' then
Assert(false, 'Empty argument supplied in ATableNm.');
// SQLite Table name should be same as .DBF file name
tblSQLite.TableName := ATableNm;
{ Loop through the field in source dataset and copy them to SQLite table. }
for i := 0 to ADataset.FieldCount - 1 do
begin
AField := ADataset.Fields[i];
if AField = nil then
Continue;
L_CopyFieldDefToSQLiteTable(AField.FieldName, AField.DataType,
AField.DataSize, AField.Required);
end;
tblSQLite.CreateDataSet;
end;
Copy value from existing dataset to SQLite;
procedure CopyDataFrom(ASrc: TDataset;
ASQLiteTblNm: string);
var
i: Integer;
begin
if ASrc = nil then
Assert(false, 'Unassigned argument supplied in ASrc.');
if Trim(ASQLiteTblNm) = '' then
Assert(false, 'Empty argument supplied in ASQLiteTblNm.');
tblSQLite.Close;
tblSQLite.CachedUpdates := true;
tblSQLite.Active := true;
ASrc.First;
while not ASrc.Eof do
begin
tblSQLite.Insert;
for i := 0 to ASrc.FieldCount - 1 do
begin
tblSQLite.Fields[i].Value := ASrc.Fields[i].Value;
end;
ASrc.Next;
end;
tblSQLite.ApplyUpdates;
tblSQLite.CommitUpdates;
end;
I have following script to update local table, by reading a remote source table. Script is running fine without any error. This post is to clarify properly about, How the cursor works.
I read data from remote source table Source_Product and initially insert into temp table VW_PRODUCT. After that I insert or update my PRODUCT table.
My questions are.
1) When does the product_cursor load the data? Is it when we try to read the cursor in the for loop? or when ever declare the cursor it loads the data?
2) This script runs daily. If the product_cursor runs as soon as it declare, then VW_PRODUCT has previous day data. Because still the today data is not inserted to VW_PRODUCT table ( insert query is available after the cursor declaration). So the product_cursor will not have any record after minus. Because ysterday_data minus ysterday_data is zero. So how can it update or insert the latest data to PRODUCT according to below script?
SET serveroutput ON SIZE 1000000;
DECLARE
CURSOR product_cursor
IS
SELECT V.PRODUCTID,
V.PACKAGEID'
V.ENDDATE
FROM VW_PRODUCT V
MINUS
SELECT E.PRODUCTID,
E.PACKAGEID,
E.ENDDATE
FROM PRODUCT E;
/*The delete data*/
CURSOR product_cursor_del
IS
SELECT E.PRODUCTID FROM PRODUCT E WHERE (E.ENDDATE > SYSDATE OR E.ENDDATE IS NULL)
MINUS
SELECT V.PRODUCTID FROM VW_PRODUCT V;
/* Variable Declaration*/
v_total NUMBER (10);
v_inserted NUMBER (10);
v_updated NUMBER (10);
v_deleted NUMBER (10);
v_rows_inserted NUMBER (10);
v_productid PRODUCT.PRODUCTID%TYPE;
v_count NUMBER (10);
v_commit_point NUMBER := 25;
BEGIN
v_total := 0;
v_count := 0;
v_inserted := 0;
v_updated := 0;
v_deleted := 0;
v_rows_inserted := 0;
EXECUTE IMMEDIATE 'TRUNCATE TABLE VW_PRODUCT';
INSERT INTO VW_PRODUCT
SELECT * FROM Source_Product;
SELECT COUNT (*)
INTO v_rows_inserted
FROM VW_PRODUCT;
COMMIT;
/*delete data*/
FOR product_rec IN product_cursor_del
LOOP
BEGIN
v_total := v_total + 1;
update product set enddate = sysdate
WHERE productid = product_rec.productid and enddate is null;
v_deleted := v_deleted + 1;
v_count := v_count + 1;
IF (v_count >= v_commit_point)
THEN
COMMIT;
v_count := 0;
END IF;
EXCEPTION
WHEN OTHERS
THEN
BEGIN
DBMS_OUTPUT.put_line ( 'Exception with product: ' );
END;
END;
END LOOP;
FOR product_rec IN product_cursor
LOOP
BEGIN
v_total := v_total + 1;
SELECT productid
INTO v_productid
FROM product
WHERE productid = product_rec.productid;
update PRODUCT
set PACKAGEID = product_rec.PACKAGEID,
ENDDATE = product_rec.ENDDATE
WHERE PRODUCTID = product_rec.PRODUCTID;
v_updated := v_updated + 1;
EXCEPTION
WHEN NO_DATA_FOUND
THEN
INSERT INTO PRODUCT
(PRODUCTID,PACKAGEID,ENDDATE)
VALUES
(product_rec.PRODUCTID,
product_rec.PACKAGEID,
product_rec.ENDDATE);
v_inserted := v_inserted + 1;
v_count := v_count + 1;
IF (v_count >= v_commit_point)
THEN
COMMIT;
v_count := 0;
END IF;
WHEN OTHERS
THEN
raise_application_error ('Error );
END;
END LOOP;
IF (v_total >= 1)
THEN
COMMIT;
END IF;
END;
/
In a nutshell, to answer your basic questions,
A cursor doesn't store any result set, it is a pointer used to fetch rows from a result set.
Memory is not consumed at declare stage.
It is the FETCH statement when you are actually using the cursor. The FETCH statement retrieves rows from the result set and places them into an area in the memory. You could fetch the rows one at a time, several at a time, or all at once.
The FETCH statement performs the following operations:
Reads the data for the current row in the result set into the output
PL/SQL variables.
Moves the pointer to the next row in the result set.
Take a look at working with cursors.
I've been doing my university project and I've stumbled upon problem I cannot solve.
After declaring variable (a pointer to TButton) I cannot use it. I'll copy a part of my code to help show the problem.
So before the implementation I have
private
prevButton : ^TButton;
After that I use OnClick procedure with my buttons
procedure TForm2.MissingButtonClick(Sender : TObject);
var
b : TButton;
begin
b := Sender as TButton;
prevButton := #b;
showmessage(prevButton^.Caption);
end;
And caption is shown no problem. But then when I use my OnClick procedure and try to change labels caption I get access violation.
procedure TForm2.LabelClick(Sender : TObject);
var
l : TLabel;
begin
l := Sender as TLabel;
if prevButton = nil then
showmessage('nil');
if prevButton <> nil then begin
showmessage(prevButton^.Caption);
l.Caption := (prevButton^.Caption);
prevButton^.OnClick := #AlreadyClicked;
prevButton^.Free;
prevButton^ := nil;
prevButton := nil;
refreshLabels(words);
end;
end;
So here is the question, why can't I use my variable in this procedure if I could use it without problem second earlier in other procedure.
Cheers.
Your code is severely flawed in several places.
First, the initial declaration is incorrect. A variable of type TButton is already a pointer, so you don't have to dereference it:
private
prevButton: TButton;
You also don't have to dereference it when assigning to it or using it:
procedure TForm2.MissingButtonClick(Sender : TObject);
begin
prevButton := TButton(Sender);
showmessage(prevButton.Caption);
end;
I'm not sure what your LabelClick event is trying to accomplish. If you free prevButton, you also invalidate the original button to which you pointed it. In other words, if you assigned prevButton := Button1;, and then prevButton.Free;, you've also freed Button1, and I don't think that's your intent. You can safely assign nil to prevButton, but don't free it also:
prevButton := nil; // No longer points to existing object instance
If you want to change the OnClick of an existing button, don't jump through all of those hoops:
// Assign this to the button's OnClick in the Object Inspector
procedure TForm1.Button1FirstClick(Sender: TObject);
begin
ShowMessage('First time I was clicked');
Button1.OnClick := #Button1AfterClicked;
end;
// Create these two in the code editor, and declare it in the
// form declaration, but don't assign it to an event of the button
// in the Object Inspector
procedure TForm1.Button1AfterClick(Sender: TObject);
begin
ShowMessage('Second time clicked');
Button1.OnClick := #Button1MoreClicks;
end;
procedure TForm1.Button1MoreClicks(Sender: TObject);
begin
ShowMessage('Third and later clicks');
end;
I am trying to figure out how loop through a hierarchy, I don't know how to put in PLSQL. What I am trying to achieve: I want to know what department is 10 steps above me in a hierarchy:
Say I have a table with a department and a parent department. I want to perform this kind of operation:
select my_department from table_departments as v_department
FOR counter in 1...9
LOOP
v_department:=
(SELECT parent_department
FROM table_department_hierarchy
WHERE child_department=v_department)
END LOOP as top_department;
I can't figure out the correct syntax, is there a brave soul out there who can help me?
Your method with corrected PL/SQL syntax would be something like:
begin
select my_department into v_department from table_departments;
FOR counter in 1...9
LOOP
SELECT parent_department
INTO v_department
FROM table_department_hierarchy
WHERE child_department=v_department;
END LOOP:
END;
However you could perhaps get it all in one statement something like this:
SELECT parent_department
INTO v_department
FROM
( SELECT parent_department, level as lvl
FROM table_department_hierarchy
CONNECT BY child_department = PRIOR parent_department
START WITH child_department = v_department
)
WHERE lvl = 9;
See Oracle docs on hierarchical queries
This is a large pl/sql procedure that i wrote a long while ago that was meant to traverse a employee/boss reporting tree all the way to the top (CEO). This version was specific to Peoplesoft but it as long as your reading something that has a parent/child relationship in a record it will work on anything.... I have other more dynamic versions of this but this maybe the simplest to decipher. I removed some fluff stuff that you won't care about. Also this particular solution delivers to a table for many different reasons because reporting tools can consume it...
Also it determines levels dynamically so you don't have to know how many levels there are as you would with a connect by solution.
Hope it helps:
CREATE OR REPLACE PROCEDURE DW."SPW_T_RESOURCE_HIERARCHY" (iCommit In Integer Default 1000,
pdBegin In Date Default trunc(Sysdate) - 3,
pdEnd In Date Default trunc(Sysdate) + 1,
vTruncate In Varchar2 Default 'Y' ) Is
------------------------------------------------------
-- DECLARATIONS
------------------------------------------------------
Cursor curDataSource Is
---**********************************----
---****BEGIN CUSTOMIZE THIS BLOCK****----
---**********************************----
Select
Eh.empl_id F_DESCENDANT_ID
,Eh.Super_Empl_Id F_IMMEDIATE_ANCESTOR_ID
From
Employee_Header EH
Where
EH.SUPER_EMPL_ID IS NOT NULL OR EH.TERM_DATE IS NULL;
---**********************************----
---****END CUSTOMIZE THIS BLOCK******----
---**********************************----
dNow Date := Sysdate;
iTotalRows Integer := 0;
iTotalErrors Integer := 0;
---**********************************----
---****BEGIN CUSTOMIZE THIS BLOCK****----
---**********************************----
vDescendentID Varchar2(20);
iDescendentLevel Integer := 1;
iAncestorLevel Integer := 0;
vAncestorID Varchar2(20);
vTmpAncestorID Varchar2(20);
vTmpEmployeeID Varchar2(20);
---**********************************----
---****END CUSTOMIZE THIS BLOCK******----
---**********************************----
------------------------------------------------------
-- END DECLARATIONS
------------------------------------------------------
------------------------------------------------------
-- BEGIN MAIN
------------------------------------------------------
Begin
-- Loop over source records
For recDataSource In curDataSource
Loop
iDescendentLevel := 1;
vAncestorID := recDataSource.f_Immediate_Ancestor_Id;
-- Start Transaction
Begin
while (Trim(vAncestorID) is not null)
loop
Begin
-- Fetch Next Ancestor
Select EH.SUPER_EMPL_ID
Into vTmpAncestorID
From
EMPLOYEE_HEADER EH
Where
EH.EMPL_ID = vAncestorID;
Exception
When Others Then
vTmpAncestorID := null;
End;
If NVL(vTmpAncestorID,'-XYZ-') = NVL(vAncestorID,'-123-') Then
vTmpAncestorID := null;
End If;
vAncestorID := vTmpAncestorID;
iDescendentLevel := iDescendentLevel + 1;
end loop;
-- Insert Resource Base
Insert Into T_RESOURCE_HIERARCHY
(
T_RESOURCE_HIERARCHY.F_HIERARCHY_NAME,
T_RESOURCE_HIERARCHY.F_DESCENDANT_LEVEL,
T_RESOURCE_HIERARCHY.F_DESCENDANT_ID,
T_RESOURCE_HIERARCHY.F_ANCESTOR_LEVEL,
T_RESOURCE_HIERARCHY.F_ANCESTOR_ID
)
Values
(
'Physical Org Chart',
iDescendentLevel,
recDataSource.f_Descendant_Id,
To_Number(Decode(iDescendentLevel,1,2,iDescendentLevel) - 1),
NVL(recDataSource.f_Immediate_Ancestor_Id,'ROOT')
);
-- Insert MySelf Into Resource Base as well for full hierarchy research
Insert Into T_RESOURCE_HIERARCHY
(
T_RESOURCE_HIERARCHY.F_HIERARCHY_NAME,
T_RESOURCE_HIERARCHY.F_DESCENDANT_LEVEL,
T_RESOURCE_HIERARCHY.F_DESCENDANT_ID,
T_RESOURCE_HIERARCHY.F_ANCESTOR_LEVEL,
T_RESOURCE_HIERARCHY.F_ANCESTOR_ID
)
Values
(
'Physical Org Chart',
iDescendentLevel,
recDataSource.f_Descendant_Id,
iDescendentLevel,
NVL(recDataSource.f_Descendant_Id,'ROOT')
);
-- Now Its Time To Climb The Tree
-- For This Employee
vAncestorID := recDataSource.f_Immediate_Ancestor_Id;
iAncestorLevel := iDescendentLevel-1;
vTmpAncestorID := null;
-- Loop over parents
while (Trim(vAncestorID) is not null)
loop
Begin
-- Fetch Next Ancestor
Select EH.SUPER_EMPL_ID
Into vTmpAncestorID
From
EMPLOYEE_HEADER EH
Where
EH.EMPL_ID = vAncestorID;
Exception
When Others Then
vTmpAncestorID := null;
End;
If NVL(vTmpAncestorID,'-XYZ-') = '-XYZ-' Then
vTmpAncestorID := null;
End If;
vAncestorID := vTmpAncestorID;
iAncestorLevel := iAncestorLevel - 1;
If vAncestorID is not null Then
-- Insert Resource Base
Insert Into T_RESOURCE_HIERARCHY
(
T_RESOURCE_HIERARCHY.F_HIERARCHY_NAME,
T_RESOURCE_HIERARCHY.F_DESCENDANT_LEVEL,
T_RESOURCE_HIERARCHY.F_DESCENDANT_ID,
T_RESOURCE_HIERARCHY.F_ANCESTOR_LEVEL,
T_RESOURCE_HIERARCHY.F_ANCESTOR_ID
)
Values
(
'Physical Org Chart',
iDescendentLevel,
recDataSource.f_Descendant_Id,
iAncestorLevel,
vAncestorID
);
End If;
end loop;
-- TRANSACTION EXCEPTION HANDLING
Exception
When Others Then
End;
-- ASSIGN HOW MANY RECORDS PROCESSED
iTotalRows := curDataSource%Rowcount;
-- CONDITIONAL/INCREMENTAL TRANSACTION COMMIT
If Mod(iTotalRows, iCommit) = 0
Then
Commit;
End If;
End Loop;
-- FINAL COMMIT AND MD UPDATE
Commit;
-- MAIN EXCEPTION HANDLING
Exception
When Others Then
Begin
iExceptionCode := Sqlcode;
vExceptionMessage := Sqlerrm;
Raise_application_error(Sqlcode, Sqlerrm);
End;
------------------------------------------------------
-- END MAIN
------------------------------------------------------
End SPW_T_RESOURCE_HIERARCHY;
/
Please, check the following example. Not tested, but believe :)
DECLARE
G_EMPLOYEE_ID NUMBER:=1880;
FUNCTION GET_MANAGER(V_EMPLOYEE_ID NUMBER) RETURN NUMBER IS
V_MANAGER_ID NUMBER;
BEGIN
SELECT ID_MANAGER INTO V_MANAGER_ID FROM EMPLOYEES WHERE EMPLOYEE_ID = V_EMPLOYEE_ID;
RETURN V_MANAGER_ID;
EXCEPTION
WHEN OTHERS THEN
RETURN NULL;
END;
BEGIN
LOOP
DBMS_OUTPUT.PUT_LINE('EMPLOYEE:' || G_EMPLOYEE_ID);
G_EMPLOYEE_ID := GET_MANAGER(G_EMPLOYEE_ID);
DBMS_OUTPUT.PUT_LINE('MANAGER:' || G_EMPLOYEE_ID);
EXIT WHEN G_EMPLOYEE_ID IS NULL;
END LOOP;
END;
Another great option (primary) is CONNECT BY, START WITH