[Base] Access2Base - Last version: 6.3

Discussions about using 3rd party extension with OpenOffice.org
JPL
Volunteer
Posts: 130
Joined: Fri Mar 30, 2012 3:14 pm

[Base] Access2Base - Last version: 6.3

Post by JPL »

Access2Base is an OpenOffice/LibreOffice extension for (business or personal) application developers and advanced users.
It provides a AOO/LibO Basic library of macros implementing a number of functionalities - directly inspired by MSAccess. The macros are callable from an OpenOffice/LibreOffice Base application.

:arrow: Version 0.9.1 has been released on 01-may-2013.

Main enhancements:
- a performance improvement when processing very large (up to 1000+ items) listboxes.
- a workaround has been implemented to survive the LibreOffice 4.0 bug described in BugZilla.
- the implementation of the SysCmd method for the management of status bars.
- a Dialog object and its controls for managing dialogs like you could manage forms before
- the Format property may be set programmatically for date and time controls.
- the addition of the OpenSQL action to open a datasheet containing the data described by the provided SELECT SQL statement.

The Dialog object is illustrated with a nice Calculator widget:
Calculator.png
More info: If you have questions, suggestions, bugs or other topics about the Access2Base extension (especially version 0.9.1) you would like to discuss, I suggest you post a reply to this thread.

JPL

PS the thread about release 0.9.0 is here
Last edited by JPL on Wed Nov 20, 2019 10:40 am, edited 1 time in total.
Kubuntu 22.04 / LibO 7.5
Access2Base (LibO).
BaseDocumenter extension (LibO)
ScriptForge (LibO)
Documentation on https://help.libreoffice.org/latest/en- ... bPAR=BASIC
greypelican
Posts: 3
Joined: Tue Feb 04, 2014 10:06 pm

Re: [BASE] Access2Base - version 0.9.1 released

Post by greypelican »

JPL Many thanks for your design of A2B. It has given me a greta boost as I was going round in circles with getting to understand UNO apis.

I am in process of migrating my access db. Something that I have been wanting to do since I went onto a Mac some eight years ago. Talk about procrastination! Anyway, decided on MySql and installed.

Can talk very happy with MySql either via terminal console or through Ooo. Tables migrated long handed by re-creation but data batch INSERTEd via text files. Am now at converting VBA modules. That's when I discovered Access2Base.

My problem is currently that I cannot seem to overcome the insertion of dates as a variable. In the following snippet, the date "04/02/2014" is a literal only because of the multiple attempts that I was making. Within the module it is derived from a form field as entered by the user.

code:

Set orsRecords = Application.CurrentDb().OpenRecordset("TransportDb.Paymast")
With orsRecords
.AddNew ' Fields initialised with the default value
.Fields("payweek").Value = payweek
.Fields("shiftdate").Value = "04/02/2014"
.Fields("startime").Value = shiftstartime

:code end

Within the MySql terminal, I can enter the date as 'yyyy-mm-dd' (with single quotes).
I have placed Date() as the value and that was accepted without problems. Date() equates to dd/mm/yyyy format.

Can you please advise as to how I should code my variable as a Value?

Kind regards
OpenOffice 4.0.1 on MacOS 10.7 with MySql 5.6 on my way from msaccess
JPL
Volunteer
Posts: 130
Joined: Fri Mar 30, 2012 3:14 pm

Re: [BASE] Access2Base - version 0.9.1 released

Post by JPL »

JPL, Many thanks for your design of A2B. It has given me a greta boost as I was going round in circles with getting to understand UNO apis.
Thanks for your feedback !
Can you please advise as to how I should code my variable as a Value?
The answer is simple. I refer to the documentation on here.

The argument of the Value property should be a Basic variable of type Date (VarType = 7).
Use the Basic built-in date functions to
- build the argument (f.i. DateSerial, TimeSerial, Now, ..)
- process the returned value (f.i. DatePart)

Hoping this will help.
JPL

PS as you probably know Access2Base 1.0.0 has been released in december 2013.
Kubuntu 22.04 / LibO 7.5
Access2Base (LibO).
BaseDocumenter extension (LibO)
ScriptForge (LibO)
Documentation on https://help.libreoffice.org/latest/en- ... bPAR=BASIC
greypelican
Posts: 3
Joined: Tue Feb 04, 2014 10:06 pm

Re: [BASE] Access2Base - version 0.9.1 released

Post by greypelican »

JpL Many thanks for prompt return.

The problem is not surrounding the construction of the date variable but more of pushing it into sql. I can enter manually through the terminal console without any problems. But from within the Basic module I get error #1513 whichever way I structure my date. I have gone through all the permutations (that I can think of) and combinations of single and double quotes.
Each time the same error is thrown out. FATAL Error #1513 (Value "2013-12-20" is invalid for property 'Value') occurred in a call to function 'Field.setValue'

Code: Select all

Set orsRecords = Application.CurrentDb().OpenRecordset("TransportDb.Paymast")
	With orsRecords	
		.AddNew				'	Fields initialised with the default value
		.Fields("payweek").Value = payweek
		.Fields("shiftdate").Value = "'2013-12-20'"
		.Fields("startime").Value = shiftstartime

My Ooo locale is set for UK format.

Any more thoughts?
OpenOffice 4.0.1 on MacOS 10.7 with MySql 5.6 on my way from msaccess
JPL
Volunteer
Posts: 130
Joined: Fri Mar 30, 2012 3:14 pm

Re: [BASE] Access2Base - version 0.9.1 released

Post by JPL »

The problem is not surrounding the construction of the date variable but more of pushing it into sql.
I believe you're wrong. You have not to worry about the SQL. The API will take care of that.

Instead of

Code: Select all

      .Fields("shiftdate").Value = "'2013-12-20'"
try something like

Code: Select all

      .Fields("shiftdate").Value = DateSerial(2013, 12, 20)
or alternatively

Code: Select all

      .Fields("shiftdate").Value = DateValue("12/20/2013")
Personally I prefer DateSerial as it is independent from locale settings. DateValue seems sensitive to DD/MM/YYYY, MM/DD/YYYY etc. formats.

StarBasic has also the CDateFromIso and CDateToIso functions to provide conversions from strings to date variables.

Please tell us if solved.
JPL
Kubuntu 22.04 / LibO 7.5
Access2Base (LibO).
BaseDocumenter extension (LibO)
ScriptForge (LibO)
Documentation on https://help.libreoffice.org/latest/en- ... bPAR=BASIC
greypelican
Posts: 3
Joined: Tue Feb 04, 2014 10:06 pm

Re: [BASE] Access2Base - version 0.9.1 released

Post by greypelican »

:super: JPL

Spot on! Many thanks.

I was using date value but assigning prior to the .Value statements.

Kind regards.
OpenOffice 4.0.1 on MacOS 10.7 with MySql 5.6 on my way from msaccess
User avatar
Steve R.
Posts: 163
Joined: Mon Sep 21, 2009 12:06 am
Location: Morehead City, North Carolina

Re: [BASE] Access2Base - version 0.9.1 released

Post by Steve R. »

Thanks very much!!! My database programming has been in MS Access and I am in the process of converting my MS Access databases to Base.
I'm still at the "bottom" of the Base learning curve so I anticipate it will be a while before I have in-depth questions/comments.
Being able to use MS Access syntax, which I know, has been very useful.
Ubuntu 16.04 and Windows 10
Ncr
Posts: 1
Joined: Sat Feb 22, 2014 12:58 am

Re: [BASE] Access2Base - version 0.9.1 released

Post by Ncr »

I must say
Nice work JPL!
This is my third attempt on Base through the years and this time Access2base almost convinced me.
I sympathize with the concept of community-driven software, never joined but have been using write for years.
Base works well with foreign database files.
But the front-end is such a crap! Building reports is a pain, even with oracle report builder, and the forms make me wanting to go back to Office97, when i started using VBA. Error messages appear for the strangest reasons!
I think i will stay with access runtime until somebody improves the look and feel of Base.
But i think your effort is a major one. Keep up the good work!
Openoffice 4 on windows 7
muse79
Posts: 11
Joined: Sat Feb 22, 2014 8:50 pm

Re: [BASE] Access2Base - version 0.9.1 released

Post by muse79 »

I'd just like to say Access2Base has been invaluable to me. After switching from MS Access to Libre Office and having a good foundation in coding, I found it frustrating to write macros. With Access2Base it has been a lot easier. I'm much more confident with being able to write macros for my range of needs now. There's been a few hiccups along the way and I'm sure there will be more but I couldn't have got any where near as far as I have without it. Thank you!
libreoffice 4.2 Windows 7 64bit
KurtJ
Posts: 3
Joined: Tue Aug 26, 2014 7:21 pm

Trouble setting fields to Null in Edit/Update loops

Post by KurtJ »

Using version 1.0.0 of Access2Base in LibreOffice 3.6.

Hi, I appreciate the work you have done making BASE actually useful. I used it to construct a biological medium database for work use, now I'm messing around with a recipe database and ran into what may have been a small oversight. I tried to look at your code, but I don't have the necessary comprehension of the BASE programming models, to attempt fixing it myself.

I am unable to set database fields to Null in an Edit/Update Loop, in both text and numerical fields. The error message is "Error #1513 (Value '[NULL]' is invalid for property 'Value') occurred in a call to function 'Field.setValue'"

Here is the test code. Putting in any string here, the code runs fine, or if it is a numerical field, any number. However it would be useful to be able to return a field to Null so you can avoid workarounds like a space character, or using an update query later. Thanks.

Code: Select all

Dim frmRecipes As Object
Dim numID As Object
Dim strSQL1 As String
frmRecipes = Forms("frmRecipes")
numID = frmRecipes.Controls("numID")

strSQL1 = "SELECT ""tblRecipeIngredients"".* FROM ""tblRecipeIngredients"" WHERE ""RecipesChild"" = " & numID.Value

Dim rstRecipeIngredients As Object
Set rstRecipeIngredients = CurrentDB.OpenRecordset(strSQL1)

With rstRecipeIngredients
	If Not .BOF Then	' An empty recordset has both .BOF and .EOF set to True
		Do While Not .EOF
			.Edit
			'Null, "Null", dbNull, NULL, [NULL], [EMPTY], EMPTY do not work below.
			.Fields("TotalQtyFraction").Value = Null
			.Update
			'Go to next record
			.MoveNext
		Loop 'Do While Not .EOF
	End If 'If Not .BOF
.mClose()
End With
Last edited by KurtJ on Wed Aug 27, 2014 1:20 pm, edited 1 time in total.
LibreOffice 3.6 on Win 7
JPL
Volunteer
Posts: 130
Joined: Fri Mar 30, 2012 3:14 pm

Re: [BASE] Access2Base - version 0.9.1 released

Post by JPL »

@KurtJ,

can you confirm that the field "TotalQtyFraction" may receive a Null value, i.e. the attribute "Entry required" is set to 'No' when you design/edit the table ?

BTW you might use next statement:

Code: Select all

strSQL1 = "SELECT [tblRecipeIngredients].* FROM [tblRecipeIngredients] WHERE [RecipesChild] = " & numID.Value
which is more readable, if you prefer.

JPL
Kubuntu 22.04 / LibO 7.5
Access2Base (LibO).
BaseDocumenter extension (LibO)
ScriptForge (LibO)
Documentation on https://help.libreoffice.org/latest/en- ... bPAR=BASIC
KurtJ
Posts: 3
Joined: Tue Aug 26, 2014 7:21 pm

Re: Trouble setting fields to Null in Edit/Update loops

Post by KurtJ »

Yes, the field can receive a null value. My workaround was to use an update query after the loops, setting the field to Null by SQL and that works fine.

I wanted to add that the two types of fields I have tested with this code are VARCHAR and DOUBLE. The code below is for the DOUBLE field.

Code: Select all

'Run update query to replace 0 with null, doesn't work inside edit/update loop.
Dim strSQL3 As String
strSQL3 = "UPDATE [tblRecipeIngredients] SET [TotalQtyWhole] = Null WHERE [RecipesChild] = " & numID.Value & " AND [TotalQtyWhole] = 0"
DoCmd.RunSQL(strSQL3)
LibreOffice 3.6 on Win 7
JPL
Volunteer
Posts: 130
Joined: Fri Mar 30, 2012 3:14 pm

Re: [Base] Access2Base - version 0.9.1 released

Post by JPL »

@ KurtJ

nice to see the SQL workaround working better than the Value property ...
Indeed it seems to be a bug ... that is not even corrected in Access2Base 1.1.0 :(

To correct the code manually:
In module Fields of the Access2Base library, replace line 485

Code: Select all

					If Column.IsNullable = com.sun.star.sdbc.ColumnValue.NULLABLE Then Column.updateNull() Else Goto Trace_Null
with next lines:

Code: Select all

					If Column.IsNullable = com.sun.star.sdbc.ColumnValue.NULLABLE Then
						Column.updateNull()
						Goto Exit_Function
					Else
						Goto Trace_Null
					End If
I will prepare a patch for the LibreOffice 4.2 and 4.3 users.
 Edit: (31-aug-2014) A correction has been inserted in LibreOffice 4.2.7 and 4.3.2+ releases. 
Thanks for your contribution to a better software.
JPL
Last edited by JPL on Sun Aug 31, 2014 4:00 pm, edited 1 time in total.
Kubuntu 22.04 / LibO 7.5
Access2Base (LibO).
BaseDocumenter extension (LibO)
ScriptForge (LibO)
Documentation on https://help.libreoffice.org/latest/en- ... bPAR=BASIC
KurtJ
Posts: 3
Joined: Tue Aug 26, 2014 7:21 pm

Setting Null issue fixed.

Post by KurtJ »

JPL,

This fixed the issue, and now I'm setting Null in both types of fields.

I could mention here also that edit/update loops only work on single table queries with all fields selected. On multi-table queries or if only a few fields are selected in the recordset, an error is generated. It took me a while to puzzle this one out, since it isn't mentioned in your help file. I had been guessing it was a limitation in the BASE programming model.

It always impressed me you did all this work for no pay or recognition. That may be a sign of an outstanding character.
LibreOffice 3.6 on Win 7
User avatar
Steve R.
Posts: 163
Joined: Mon Sep 21, 2009 12:06 am
Location: Morehead City, North Carolina

Re: [Base] Access2Base - Sample Code Using a Global Variable

Post by Steve R. »

After a bit of experimentation, I was able to incorporate the global variable "intStoryNUM" into the SQL string.
Both examples accomplish the same task.

Code: Select all

Openform strAddAuthorForm, , ,  """StoryIDNUM""  = '" + intStoryNUM + "'", acFormReadOnly

Code: Select all

Openform strAddAuthorForm, , , ,acFormReadOnly,	
strSQL = "SELECT * FROM [tblStoryList] WHERE [StoryIDNUM]  = '" + intStoryNUM + "'"
Forms(strAddAuthorForm).RecordSource = strSQL
I hope that you can include these code snippets in your website as additional examples. Thank-you JPL for developing Access2Base.
Ubuntu 16.04 and Windows 10
estelondono
Posts: 1
Joined: Sat Jun 10, 2017 1:11 am

Re: [Base] Access2Base - version 0.9.1 released

Post by estelondono »

Hi there!

First, thank you for all your great work with Access2Base. It really makes everything more easy for people like me coming from windows to Linux and from Windows Office to LibreOffice (and not coming back ;) ). I'm using LibreOffice 5.3 in Linux Lite 3.4 (Ubuntu 16.04) and I'm having a problem passing some info from one form to another.
I'm in a form and when I click in a text field it opens another form with info. In this form you can change everything. Even add new records. Then, you click in the field with the value you want and pass to the form of origin. The value is shown in the text field in that first form. The value I'm passing is and Id (key record) type BIGINT. In both tables are the same type.
The problem is when I try to save this record. LibreOffice tells me
Error registering record in the Data Base
An entry is needed in the field <<id_tipo>>. Write the value

(I translated it from Spanish :? )
So I have to (re)type the value where the same value is shown for the record to be saved. What am I doing wrong?
The Basic Code that passes the value from one form to the other is

Code: Select all

Sub pasaDatoInfoCliente(poEvent as Object)
	Dim oForm as Object, dForm as Object
	Dim oControl as Object, dControl as Object, valor as String
	
	Set oForm = Events(poEvent).Source.Parent	'Form of origin
	Set dForm = Forms("formDATOS_CLIENTES")	'Form of destiny
	Set oControl = oForm.Controls("id_tipo_dato")	'Control of origin
	Set dControl = dForm.Controls("fmtid_tipo_dato")	'Control of destiny
	valor = oControl.Value						'Value to pass to dForm | I tried with oControl.Text also but doesn't solve the problem
	
	dControl.Setfocus	'This was to see if it solved my problem. No success
	DoCmd.mClose(acForm, "formTIPOS_DATOS")	'No matter where I put this line, it doesn't solve my problem.
	dControl.setProperty("Value", valor)			'I'm using this syntax because dControl.Value = valor doesn't work
	dForm.Refresh		'This was also to solve the problem but also no success.
	
End Sub
If you can help me, it would be of great help to me.

Thank you again for your great work!

PS: I hope my English is good enough for you to understand me :D
OpenOffice 5.3 on Ubuntu 16.04
paco
Posts: 3
Joined: Wed Nov 30, 2016 12:01 pm

Re: [Base] Access2Base - version 0.9.1 released

Post by paco »

As everybody who knows your work, I want to congratulate you heartily for it: it is magnificent and very useful.

After that, I just want to report a minor quirk that I have experienced, just in case it is of some general interest. I am just trying to write a little macro for getting information about the versions of the application that is being used and the database engine also in use. This should be pretty easy as

MsgBox Application.Version
and
MsgBox CurrentDb().Version

should be enough. The surprising thing is that whereas the first instruction works as expected as well in OpenOffice 4.1.3 as in LibreOffice 5.2.3.3, the second one does it only in OpenOffice, LibreOffice providing an error message to the effect that the *Version* property or method is not found.

On a similar vein I have been also unable to get the name of the current database by way of *CurrentDb().Name* in LibreOffice (it just says *database*), although I understand that *Name* is a valid property of such an object.

Kind regards
Windows 7 + Apache OpenOffice 4.1.3.
JPL
Volunteer
Posts: 130
Joined: Fri Mar 30, 2012 3:14 pm

Re: [Base] Access2Base - difference beween LO and AOO

Post by JPL »

@paco

Behaviours could be different between LO and AOO if the Access2Base versions are different.

The A2B version integrated with LO 5.2 is 1.5.0.

Check if the A2B extension installed under AOO is not more recent ? In particular the Version property for database objects has been introduced in A2B 1.6.0.

Thanks a lot for using and appreciating Access2Base.
JPL
Kubuntu 22.04 / LibO 7.5
Access2Base (LibO).
BaseDocumenter extension (LibO)
ScriptForge (LibO)
Documentation on https://help.libreoffice.org/latest/en- ... bPAR=BASIC
gelinp
Posts: 35
Joined: Mon Oct 09, 2017 9:27 pm

Re: [Base] Access2Base - version 0.9.1 released

Post by gelinp »

I'm using LIbreoffice 5.4.1.2 With HSQLDB 2.4.0 as client/server connection with JDBC. The access2base version is 1.7.0.

The code below is working, but it take too long time, about 6 secondes to display 373 records ...It tkae a very long time with GetRowsc(). How can I optimize this call ? I tried already with MoveNext calls, but it's the same problem.

Thank you for your response.
Patrick

Rem -------------------------------------------
Rem InitListChoix
Rem
Function InitListChoix(FKFonds As Integer, SFilter As String) As Array
Rem Dim RowSet As Object
Dim RowNumber, numRows As Integer
Dim ColIndiceClasse As Integer
Dim oRecordset As Object
Dim vVarRecords As Variant

Rem Initialisation du plan de classement ...
Set oRecordset = Application.CurrentDb().OpenRecordset("SELECT CONCAT([INDICE], ' : ', [CLASSE]) AS INDICECLASSE" & _
" FROM [IDXLESCLASSESPC], [AUTLESFONDSDOCUMENTAIRES]" & _
" WHERE [AUTLESFONDSDOCUMENTAIRES].[ID] = " & FKFonds & _
" AND [IDXLESCLASSESPC].[FKPLAN] = [AUTLESFONDSDOCUMENTAIRES].[FKPLANCLASSEMENT] ORDER BY INDICE ASC", _
dbOpenForwardOnly,,dbReadOnly)
Rem
With oRecordset
.Filter = SFilter
Set vVarRecords = .GetRows(1024)
numRows = UBound(vVarRecords,2) + 1
Redim ArrayListChoix(numRows) As String
RowNumber = 0
Do while RowNumber < numRows
ArrayListChoix(RowNumber) = vVarRecords(0, RowNumber)
RowNumber = RowNumber + 1
Loop
.mClose()
End With

InitListChoix = ArrayListChoix
End Function
Libreoffice 6.4.6.2, Kernel: 5.4.0-52-generic x86_64 bits: 64
Desktop: Cinnamon 4.4.8 Distro: Linux Mint 19.3 Tricia
gelinp
Posts: 35
Joined: Mon Oct 09, 2017 9:27 pm

Re: [Base] Access2Base - version 0.9.1 released

Post by gelinp »

Hi,

I'm using Debian Stretch, Libreoffice 5.4.1.2, Access2base 1.7.0, HSQLDB Client/server connection with JDBC, Java is :

java version "1.8.0_144"
Java(TM) SE Runtime Environment (build 1.8.0_144-b01)
Java HotSpot(TM) Server VM (build 25.144-b01, mixed mode)


The code below is running, but too long ... It take around 6 secondes to load 373 records. I tried with MoveNext method, it's the same. With native LibreOffice API it take around 1 seconde only ... So what is the problem ? How to optimize ?

Thank you for your response.
Patrick

Code: Select all

Rem -------------------------------------------
Rem InitListChoix
Rem
Function InitListChoix(FKFonds As Integer, SFilter As String) As Array
	Rem Dim RowSet As Object
	Dim RowNumber, numRows As Integer
	Dim ColIndiceClasse As Integer 
	Dim oRecordset As Object 	
	Dim vVarRecords As Variant
	
	Rem Initialisation du plan de classement ...	
	Set oRecordset = Application.CurrentDb().OpenRecordset("SELECT CONCAT([INDICE], ' : ', [CLASSE]) AS INDICECLASSE" & _ 
				" FROM [IDXLESCLASSESPC], [AUTLESFONDSDOCUMENTAIRES]" & _
				" WHERE [AUTLESFONDSDOCUMENTAIRES].[ID] = " & FKFonds & _
				" AND [IDXLESCLASSESPC].[FKPLAN] = [AUTLESFONDSDOCUMENTAIRES].[FKPLANCLASSEMENT] ORDER BY INDICE ASC", _
				dbOpenForwardOnly,,dbReadOnly)				
	Rem 
	With oRecordset
		.Filter = SFilter		
		
		Set vVarRecords = .GetRows(1024)
		numRows = UBound(vVarRecords,2) + 1				
		Redim ArrayListChoix(numRows) As String		
	
		RowNumber = 0	
		Do while RowNumber < numRows
			ArrayListChoix(RowNumber) =  vVarRecords(0, RowNumber) 
			RowNumber = RowNumber + 1
		Loop
		.mClose()		
	End With
		
	InitListChoix = ArrayListChoix
End Function
Libreoffice 6.4.6.2, Kernel: 5.4.0-52-generic x86_64 bits: 64
Desktop: Cinnamon 4.4.8 Distro: Linux Mint 19.3 Tricia
JPL
Volunteer
Posts: 130
Joined: Fri Mar 30, 2012 3:14 pm

Re: [Base] Access2Base - version 0.9.1 released

Post by JPL »

Hi,

as a preamble ... remember that Access2Base adds an API above the standard UNO interface. This means - in all cases - a certain overhead.

Anyway, let's start the debugging of your case.

How is the processing time spent ?
Is it on the OpenRecordset operation ?
Or on the GetRows() ?

Can you post the - more native - code that you used to compare processing times ?

JPL
Kubuntu 22.04 / LibO 7.5
Access2Base (LibO).
BaseDocumenter extension (LibO)
ScriptForge (LibO)
Documentation on https://help.libreoffice.org/latest/en- ... bPAR=BASIC
gelinp
Posts: 35
Joined: Mon Oct 09, 2017 9:27 pm

Re: [Base] Access2Base - version 0.9.1 released

Post by gelinp »

Hi,

I'm back, Thank you for your response !

The time spent a lot with GetRows call. OpenRecorset with Move is about 240 ticks, and GetRows about 3656 ticks...

I tested with 2 configration :
Configuration 01 : Linux Debian (There is a bug with LibreOffice, and I needed to add a patch into the Kernel to use base) :
- Access2Bas recorsdset object with InitListChoixAccess2Base function : ticks are about 3890, 3908, 4027, 2952 ...
- LibreOffice native rowset with InitListChoixBase : ticks are about 779, 819, 790 ...

Configuration 02 : Windows 7 Professionnel + LibreOffice 5.2.6.2 + HSQLDB 2.4.0
- Access2Bas recorsdset object with InitListChoixAccess2Base function : ticks are about 970, 940, 867, 914 ... So It's better than with my Linux Debian !. It's closed to LibreOffice native Rowset call. So it's OK.

CONCLUSION : Finaly, may be the problem will be the patch with Debian Kernel about the security issue and Side effects on LibreOffice...

I publish working code below. Sorry, there is a lot of tests :

File DlgSelectCotationClassfor the object to manage the dialog :

Code: Select all

REM  *****  BASIC  *****
Option Compatible
Option ClassModule

Option Explicit
Option Base 0



Rem ------------------------------------------------------------
Rem
Rem VARIABLES PRIVEES
Rem
Rem ------------------------------------------------------------
Global _ThisDlgSingleton As Object
Global _oRecordset As Object
Global _ArrayListChoix(1) As String
Global vVarRecords As Variant

Rem ------------------------------------------------------------
Rem
Rem CONSTRUTEUR / DESTRUCTEUR
Rem
Rem ------------------------------------------------------------
Private Sub Class_Initialize()	
End Sub


Private Sub Class_Terminate()
End Sub



Rem ------------------------------------------------------------
Rem
Rem CLASS GET/LET/SET PROPERTIES
Rem
Rem ------------------------------------------------------------

Rem ------------------------------------------------------------
Rem  Get ArrayListChoix
Rem
Public Property Get SelectedCotation As String
	Dim SItem As String
	Dim pos As Integer
	
	On Error goto Erreur :

	Debug_Trace(Name, "SelectedItem")		
	SItem = _ThisDlgSingleton.getControl("ListBoxClasses").SelectedItem	
	Debug_Trace(Name, "InStr")		
	pos = InStr(1,SItem,":",1)	
	Debug_Trace(Name, "SelectedCotation")				
	SelectedCotation = Mid(SItem, 1, pos-1)
	Debug_Trace(Name, "Fin")
	Exit Property
Erreur:
	Debug_Catch(Name, "SelectedCotation")		
End Property

Rem ------------------------------------------------------------
Rem
Rem METHODES DE CLASSE
Rem
Rem ------------------------------------------------------------

Rem ------------------------------------------------------------
Rem InitListChoixAccess2Base
Rem
Private Function InitListChoixAccess2Base(FKFonds As Integer, Optional SFilter As String) As Array
	Dim RowNumber, numRows As Integer 
	Dim t As Long

	On Error goto Erreur :
			
	Rem Initialisation du plan de classement ...	
	Rem if not isEmpty(_ArrayListChoix) > 1 Then
		Rem Debug_Trace(Name, "ARRAYLISTCHOIX ALREADY GO")
		Rem InitListChoixAccess2Base = _ArrayListChoix
	Rem Exit Function
	Rem End If
	
	Rem Debug_Trace(Name, "OPENRECORDSET(...)")
	Rem t = GetSystemTicks
	Set _oRecordset = Application.CurrentDb().OpenRecordset("SELECT CONCAT([INDICE], ' : ', [CLASSE]) AS INDICECLASSE" & _ 
		" FROM [IDXLESCLASSESPC], [AUTLESFONDSDOCUMENTAIRES]" & _
		" WHERE [AUTLESFONDSDOCUMENTAIRES].[ID] = " & FKFonds & _
		" AND [IDXLESCLASSESPC].[FKPLAN] = [AUTLESFONDSDOCUMENTAIRES].[FKPLANCLASSEMENT] ORDER BY INDICE ASC",,,dbReadOnly) Rem dbOpenForwardOnly

	With _oRecordset
		Rem Debug_Trace(Name, ".Filter")
		if not IsMissing(SFilter) Then .Filter = SFilter		
	
		Rem Debug_Trace(Name, ".SetOrderBy")
		Rem .SetOrderBy = "INDICE ASC"		
	
		Rem Debug_Trace(Name, ".MoveLast/first")
		.MoveLast() 
		Rem t = GetSystemTicks - t
		Rem MsgBox("Nombre de ticks OpenRecordset + MoveLast : " & t)
		
		.MoveFirst()
		
		Rem Debug_Trace(Name, ".GetRows")
		Rem t = GetSystemTicks
		Set vVarRecords = .GetRows(1024)
		Rem t = GetSystemTicks - t
		Rem MsgBox("Nombre de ticks GetRows : " & t)
		
		Rem Debug_Trace(Name, "numRows = ...")
		
		numRows = UBound(vVarRecords,2) Rem + 1		
		
		Rem Fetch recordsets to _ArrayListChoix
		Rem Debug_Trace(Name, "Redim _ArrayListChoix(" & numRows + 1 & ")")
		Redim _ArrayListChoix(numRows+1) As String
		
		Rem Debug_Trace(Name, "Fetch des recordsets dans _ArrayListChoix")			
		RowNumber = 0	
		Do while RowNumber < numRows
			_ArrayListChoix(RowNumber) =  vVarRecords(0, RowNumber) Rem .Fields("INDICECLASSE").Value 
			RowNumber = RowNumber + 1
		Loop
		.mClose()
	End With		
		
	Rem Trace _ArrayListChoix
	Rem RowNumber = 0
	Rem Do while RowNumber < numRows
	Rem Debug_Trace(Name, _ArrayListChoix(RowNumber))
	Rem RowNumber = RowNumber + 1
	Rem Loop
	Rem Debug_Trace(Name, "Affectation de la valeur retour InitListChoixAccess2Base")	
	InitListChoixAccess2Base = _ArrayListChoix
	Exit Function

Erreur:
	Debug_Catch(Name, "InitListChoixAccess2Base")
End Function

Rem ------------------------------------------------------------
Rem InitListChoixBase
Rem
Private Function InitListChoixBase(FKFonds As Integer, Optional SFilter As String) As Array
	Dim RowSet As Object
	Dim I As Integer
	Dim upperbound As Variant
	 	

		Set RowSet = CreateUnoService("com.sun.star.sdb.RowSet")
		With RowSet
			.DataSourceName=ConvertToURL("/home/#####/TypodocOOoHSQLDBclient.odb") rem 
			.CommandType=com.sun.star.sdb.CommandType.COMMAND
			.command="SELECT CONCAT(INDICE, ' : ', CLASSE) AS INDICECLASSE" & _ 
				" FROM IDXLESCLASSESPC, AUTLESFONDSDOCUMENTAIRES" & _
				" WHERE AUTLESFONDSDOCUMENTAIRES.ID=" & FKFonds & _
				" AND IDXLESCLASSESPC.FKPLAN=AUTLESFONDSDOCUMENTAIRES.FKPLANCLASSEMENT" 
				if not IsMissing(SFilter) Then .command = .command & SFilter 
				.command = .command & " ORDER BY INDICE"
			.execute()
		End With
		RowSet.last() : RowSet.First()
	
		Rem Fetch du plan de classement 
		Rem SingeltonListBox.RemoveItems(0,ControlListBoxClasses.ItemCount)
		
		Rem Le rang des items commence à 0
		upperbound = RowSet.RowCount
		Redim _ArrayListChoix(upperbound) As String
		I = 0
		RowSet.BeforeFirst()
		While RowSet.Next
		 	_ArrayListChoix(I) = RowSet.Columns.getByName("INDICECLASSE").String
		 	I = I + 1
		Wend
		
	InitListChoixBase = _ArrayListChoix
End Function


Rem ------------------------------------------------------------
Rem SelectFondsAndFilter
Rem
Private Sub UpdateEtat(FKFonds As Integer)

	Dim RowSet As Object
	Dim CtrlTxtEtat As Object
	
	Rem Actualiser la barre d'état avec le nom du plan de classement courrant
	Set CtrlTxtEtat = _ThisDlgSingleton.getControl("CtlTxtEtatPlanClassement")
	
	Set RowSet = CreateUnoService("com.sun.star.sdb.RowSet")
	With RowSet
		.DataSourceName=ConvertToURL("/home/gelinp/04_PROGRAMATION/projets/TypodocOoo/TypodocOOoHSQLDBclient.odb")
		.CommandType=com.sun.star.sdb.CommandType.COMMAND
		.command="SELECT PLAN FROM AUTLESFONDSDOCUMENTAIRES, AUTLESPLANSCLASSEMENT " & _
			" WHERE AUTLESFONDSDOCUMENTAIRES.ID = " & FKFonds & _
			" AND FKPLANCLASSEMENT = AUTLESPLANSCLASSEMENT.ID"
			.execute()
	End With
	RowSet.last() : RowSet.First()
	
	Rem Actauliser la barre d'état avec le nombre de classes du plan de classement courrant	
	CtrlTxtEtat.Text = "Plan de classement : " & RowSet.Columns.getByName("PLAN").String	
	With RowSet
		.command="SELECT COUNT(IDXLESCLASSESPC.ID) AS NBCLASSES FROM AUTLESFONDSDOCUMENTAIRES, IDXLESCLASSESPC " & _
			" WHERE AUTLESFONDSDOCUMENTAIRES.ID = " & FondsCourrent & _
			" AND IDXLESCLASSESPC.FKPLAN = AUTLESFONDSDOCUMENTAIRES.FKPLANCLASSEMENT"	
		.execute()
	End With
	RowSet.last() : RowSet.First()
	CtrlTxtEtat.Text = CtrlTxtEtat.Text & "  [ " & RowSet.Columns.getByName("NBCLASSES").String & " classes ]"
End Sub

Rem ------------------------------------------------------------
Rem Open
Rem
Function OpenDialog(FKfonds As Integer) As Integer
	Const DlgName = "DlgSelectCotation"
	Const LibraryName = "Standard"
	
	Dim Library As OBject
	Dim ObjDlgTemp As Object
	Dim CtrlList As OBject
	Dim t As Long
			
	On Error goto Erreur :
	
	Rem --------------------------------------	
	Rem Etape 1 : Chargement de la boite de dialogue
	If Not(DialogLibraries.hasByName(LibraryName)) Then
		MsgBox "Erreur : Impossible de trouver la librairie '" & LibraryName & "'"
		Exit Function
	End If	
	DialogLibraries.LoadLibrary(LibraryName)
	Set Library = DialogLibraries.getByName(LibraryName)	
	
	If Not (Library.hasByName(DlgName)) Then
		MsgBox "Erreur : Impossible de trouver la boite de dialogue '" & DlgName & "'"
		Exit Function
	End If	
	Set ObjDlgTemp = Library.getByName(DlgName)	
	Set _ThisDlgSingleton = CreateUnoDialog(ObjDlgTemp)	
	
	Debug_Assert(Name, not IsNull( _ThisDlgSingleton), 13, "OpenDialog 01")	
	Set CtrlList = _ThisDlgSingleton.getControl("ListBoxClasses")	
	Debug_Assert(Name, not isNull(CtrlList), 13, "OpenDialog 02")	

	t = GetSystemTicks
	CtrlList.Model.StringItemList = InitListChoixBase(FKfonds)
	t = GetSystemTicks - t
	MsgBox("Nombre de ticks InitListChoixBase = " & t)
	
	Rem UpdateEtat(FKfonds)
	OpenDialog = _ThisDlgSingleton.execute()
	Exit Function
	
Erreur:
	Debug_Catch(Name, "OpenDialog")
End Function

Rem ------------------------------------------------------------
Rem Close
Rem
Public Sub CloseDialog()
	Dim CtrlList As Object
	
	On Error goto Erreur :
	
	Set CtrlList = _ThisDlgSingleton.getControl("ListBoxClasses")
	CtrlList.Model.StringItemList = Array(1)
	_ThisDlgSingleton.Dispose
	Exit Sub
	
Erreur:
	Debug_Catch(Name, "CloseDialaog")
End Sub

Rem ------------------------------------------------------------
Rem Bouton_Filtrer
Rem 
Public Sub Bouton_Filtrer(Event As Object)
	Dim CtlTxtIndiceFilter As Object
	Dim CtlTxtClassFilter As OBject
	Dim CtrlList As Object
	Dim TxtIndiceFilter, TxtClassFilter, SFilter As String
	Dim vVarRecords As Variant
	Dim RowNumber, numRows As Integer
	
	Rem Build String filter
 	Set CtlTxtIndiceFilter = _ThisDlgSingleton.getControl("CtlTxtIndiceFilter")
	Set CtlTxtClassFilter = _ThisDlgSingleton.getControl("CtlTxtClassFilter")
	Set CtrlList = _ThisDlgSingleton.getControl("ListBoxClasses")
	
	TxtIndiceFilter = Trim(CtlTxtIndiceFilter.Text)
	TxtClassFilter = Trim(CtlTxtClassFilter.Text)
	CtlTxtIndiceFilter.Text = TxtIndiceFilter 
	CtlTxtClassFilter.Text = TxtClassFilter	
	
	If TxtIndiceFilter Like "\**" Then TxtIndiceFilter = "*"
	If TxtClassFilter Like "\**" Then TxtClassFilter = "*"
	SFilter = ""
	
	if (Len(TxtIndiceFilter) > 0 AND StrComp(TxtIndiceFilter,"*") <> 0) _
			OR (Len(TxtClassFilter) > 0 AND StrComp(TxtClassFilter,"*") <> 0) Then
		SFilter = "IDXLESCLASSESPC.INDICE LIKE '" & TxtIndiceFilter & "*'" & _
					" AND IDXLESCLASSESPC.CLASSE LIKE '*" & TxtClassFilter
		if Len(TxtClassFilter) > 0 Then SFilter = SFilter & "*" 
		SFilter = SFilter & "'"
	EndIf

	Rem ReOpen Recordset with Filter and update _ArrayListChoix
	With _oRecordset
		.Filter = SFilter		
		.OpenRecorset()		 Rem apply filter	
		
		Rem get array of records	
		Set vVarRecords = .GetRows(1024)
		numRows = UBound(vVarRecords,2) + 1		
		
		Rem copy records to ArraylistChoix
		Redim _ArrayListChoix(numRows) As String			
		RowNumber = 0	
		Do while RowNumber < numRows
			_ArrayListChoix(RowNumber) =  vVarRecords(0, RowNumber) Rem .Fields("INDICECLASSE").Value 
			RowNumber = RowNumber + 1
		Loop
		.mClose()		
	End With
			
	CtrlList.Model.StringItemList = _ArrayListChoix	
End Sub



File to test and debug

Code: Select all

Rem ***************************************************
Rem p 181 : Fichiers
Rem p 190 : mécanismes interception erreurs
Rem p194 : Code d'erreur OooBasic
Rem ***************************************************
Option Explicit

Global CONST DEBUG = true
Global FichierDebugExiste As Boolean 'default = false
CONST NomFichier = "/home/gelinp/04_PROGRAMATION/projets/TypodocOoo/log.txt"

Rem ***************************************************
Rem TEST UNITAIRE
Rem ***************************************************
Sub Main
	
	On Error goto Erreur :
	
	Debug_Trace(Name, "Hello World !")
	Debug_Trace(Name, ThisDatabaseDocument.URL)
	Debug_Assert(Name, false, 13, "Assert n°1")	
	Exit Sub
	
Erreur: 
	Debug_Catch(Name, "Main")		
End Sub


Rem ***************************************************
Rem Debug_Fabrique
Rem ***************************************************
Function Debug_Fabrique As Integer

	Dim f1 As Integer
	
	On Error goto Erreur

	if (not DEBUG) then 
		Debug_Fabrique = 0
		Exit Function
	endif
	
	f1 = FreeFile
	
	if (not FichierDebugExiste) Then		
		Rem Fichier ouvert pour (re)écriture avec effacement 
		Rem du contenu précédent
		Open NomFichier For Output As #f1
		FichierDebugExiste = true
		Write #f1, " *** DEBUT DU MODE DEBUG *** / Date-heure : " & Now
	else
		Open NomFichier For Append As #f1
	Endif
	
	Debug_Fabrique = f1	
	Exit Function
	
Erreur:
	FichierDebugExiste = false
	Debug_Fabrique = O
	print "Problème de création du fichier debug !!"
End Function

Rem ***************************************************
Rem Debug_Close
Rem ***************************************************
Sub Debug_Close(f1 As Integer)

	On Error Resume Next
	if not DEBUG then exit Sub
	
	Rem Ferme le fichier de traces
	Close #f1
End Sub

Rem ***************************************************
Rem Debug_Catch
Rem ***************************************************
Sub Debug_Catch(Module As String, Appelant As String)
	
	Dim f1 As Integer
	
	On Error Resume Next
	if not DEBUG then exit Sub
		
	f1 = Debug_Fabrique
	Write #f1, "[" & Module & "::" & Appelant & "] CATCH : Ligne " & _
			Erl & ", Erreur n° : " & Err & " - " & Error		 
	Debug_Close(f1)
End Sub

Rem ***************************************************
Rem Debug_Trace
Rem ***************************************************
Sub Debug_Trace(Module As String, Trace as String)

	Dim f1 As Integer
	
	On Error Resume Next
	if not DEBUG then exit Sub
		
	f1 = Debug_Fabrique
	Write #f1, "[" & Module & "] TRACE : " & Trace
	Debug_Close(f1)
End Sub

Rem ***************************************************
Rem Debug_Assert
Rem ***************************************************
Sub Debug_Assert(Module As String, Test As Boolean, CodeErr As Integer, Flag As String)

	Dim f1 As Integer
		
	On Error Resume Next
	if not DEBUG then exit Sub

	
	if not Test Then
		f1 = Debug_Fabrique	
		Write #f1, "[" & Module & "] ASSERTION FAILED ( " & Flag & " )"
		Debug_Close(f1)
		Err CodeErr
	Else
		f1 = Debug_Fabrique	
		Write #f1, "[" & Module & "] ASSERTION SUCCESS ( " & Flag & " )"
		Debug_Close(f1)
	Endif	
End Sub
Libreoffice 6.4.6.2, Kernel: 5.4.0-52-generic x86_64 bits: 64
Desktop: Cinnamon 4.4.8 Distro: Linux Mint 19.3 Tricia
gelinp
Posts: 35
Joined: Mon Oct 09, 2017 9:27 pm

Re: [Base] Access2Base - version 0.9.1 released

Post by gelinp »

I've got an error messge traying to define RowSource with a combobox (or listbox) into a Dialog box :

L'erreur #1512 (La propriété 'RowSourceType' n'est pas applicable dans ce contexte) s'est produite dans un appel à la fonction 'Control.setRowSourceType'

The RowSourceType documentation say : "The RowSourceType property is not applicable to list- or comboboxes located in a Dialog." Ok, but I can't find any alternative into Access2BAse documentation, nothing into RowSource help, nothing into snippets code, nothing into Google ... Do I need to use native Base APIs with Combobox/ListBox into Dialogs ? What about big list and memory management ?

Could you explain a little bit ore about initialisation with Combobox/listbox into Dialogs ?

Thanks
Patrick
Libreoffice 6.4.6.2, Kernel: 5.4.0-52-generic x86_64 bits: 64
Desktop: Cinnamon 4.4.8 Distro: Linux Mint 19.3 Tricia
JPL
Volunteer
Posts: 130
Joined: Fri Mar 30, 2012 3:14 pm

Re: [Base] Access2Base - version 0.9.1 released

Post by JPL »

@gelinp,

The values displayed in a list- or combobox belonging to a dialog cannot be provided directly by a database table or query. That's why the RowSourceType cannot be got nor set and an error is raised.
To initialize the values in such a box set the RowSource property to a list of string values separated by a semicolon (";") bundled in one single string ("as if" the RowSourceType was = com.sun.star.form.ListSourceType.VALUELIST)

You are right about the lack of documentation about this specific case :( . I will update it in a later release.

Hoping this will help.
JPL
Kubuntu 22.04 / LibO 7.5
Access2Base (LibO).
BaseDocumenter extension (LibO)
ScriptForge (LibO)
Documentation on https://help.libreoffice.org/latest/en- ... bPAR=BASIC
gelinp
Posts: 35
Joined: Mon Oct 09, 2017 9:27 pm

Re: [Base] Access2Base - version 0.9.1 released

Post by gelinp »

Hi,

Thank you for your response. In fact, I've already tested your solutin and the error message is :

L'erreur #1512 (La propriété 'RowSourceType' n'est pas applicable dans ce contexte) s'est produite dans un appel à la fonction 'Control.setRowSourceType'

The source code to test is :

Code: Select all

Public Sub Start(oDialog As Object, Optional SFiltre As String)
	
	On Local Error Goto Error_Function
	
	Set _ThisDlgAuteurs = oDialog
	Rem _InitListeAuteurs(sFiltre)
	oDialog.Controls("ListBoxAuteurs").RowSource = "Item01;Item02"
	oDialog.Controls("ListBoxAuteurs").RowSourceType = com.sun.star.form.ListSourceType.VALUELIST
	
Exit_Sub:
	Exit Sub
Error_Function:
	TraceError("ERROR", Err, "ShowError", Erl)
	Goto Exit_Sub	
End Sub
By the way I use also a source code with a ClassModule to control my dialog. But I 've got an error with method CmdFiltrerAuteurs to catch event of butons, because LibreOffice link macros to events and doesn't take care about ClassModule instance ... So a ClassModule method called by an event is like a static method, without any access to instances of the class module... Even global Global _ThisDlgAuteurs As Object is not reachable into my method CmdFiltrerAuteurs. So I tried to get instance dialog with ccess2base functions like this :

Code: Select all

[...]
Set oeEvent = Events(poEvent)
Set oDialog = oeEvent.Source.Parent
[...]
But the first line trigger an other error ! I can't understand what is wrong, it looks like a problem with ModulClass module instance management ...

The complet source code of dialog ClassModule DlgSelectAuteursClass.

Code: Select all

REM  *****  BASIC  *****
Option Compatible
Option ClassModule

Option Explicit
Option Base 0

Global _ThisDlgAuteurs As Object


Rem ------------------------------------------------------------
Rem
Rem CONSTRUTEUR / DESTRUCTEUR
Rem
Rem ------------------------------------------------------------
Private Sub Class_Initialize()
	_ThisDlgAuteurs = Nothing		
End Sub


Private Sub Class_Terminate()
	Erase _ThisDlgAuteurs
End Sub

Public Property Get SelectedAuteur As String
	Dim SItem As String
	Dim pos As Integer
	
	On Error goto Erreur :

	SelectedAuteur = _ThisDlgAuteurs.Controls("ComboBoxAuteurs").Text
	Exit Property
	
Erreur:
	Debug_Catch(Name, "SelectedAuteur")
End Property



Public Sub CmdSupprimerAuteur(Event As Object)
	Debug_Trace(Name, "CmdSupprimerAuteur")
End Sub

Public Sub CmdModifierAuteur(Event As Object)
	Debug_Trace(Name, "CmdModifierAuteur")
End Sub

Public Sub CmdSelectionnerAuteur(Event As Object)
	Debug_Trace(Name, "CmdSelectionnerAuteur")
End Sub

Public Sub CmdNouvelAuteur(Event As Object)
End Sub


Rem ------------------------------------------------------------
Rem Start
Rem
Public Sub Start(oDialog As Object, Optional SFiltre As String)
	
	On Local Error Goto Error_Function
	
	Set _ThisDlgAuteurs = oDialog
	Rem _InitListeAuteurs(sFiltre)
	oDialog.Controls("ListBoxAuteurs").RowSource = "Item01;Item02"
	oDialog.Controls("ListBoxAuteurs").RowSourceType = com.sun.star.form.ListSourceType.VALUELIST
	
Exit_Sub:
	Exit Sub
Error_Function:
	TraceError("ERROR", Err, "ShowError", Erl)
	Goto Exit_Sub	
End Sub

Rem ------------------------------------------------------------
Rem InitListeAuteurs
Rem
Private Sub _InitListeAuteurs(sFiltre As String)
	Dim ocListBoxAuteurs As Object
	Dim orsRecords As Object
	Dim aRow() As Variant
	Dim I As Long
	Dim sSQL As String	
	Const IndiceAuteurs = 0
	
	On Local Error Goto Error_Sub	
	if isNUll(_ThisDlgAuteurs) OR (not _ThisDlgAuteurs.IsLoaded) then exit Sub
	
	Set ocListBoxAuteurs = _ThisDlgAuteurs.Controls("ListBoxAuteurs")
	
	Rem Parametrage et execution du recordset de la liste des auteurs
	sSQL = "SELECT [AUTEUR] FROM [AUTLESAUTEURS] "
	if not IsMissing(SFiltre) Then sSQL = sSQL & "WHERE [AUTEUR] LIKE '*" & sFiltre & "*'"
	sSQL = sSQL & " ORDER BY [AUTEUR] ASC"
	orsRecords= Application.CurrentDb().OpenRecordset(sSQL, , , dbReadOnly)

	with orsRecords
		.MoveLast() : .MoveFirst()
		I = 0
		Do While Not .EOF
			aRow = .GetRows(1)
			ocListBoxAuteurs.addItem(aRow(IndiceAuteurs,0))
			I = I + 1	
		Loop
		.mclose()
		Rem ocListBoxAuteurs.Requery
	End With 
		
Exit_Sub:
	Exit Sub
Error_Sub:
	TraceError("ERROR", Err, "ShowError", Erl)
	Goto Exit_Sub
End Sub
			


Rem -----------------------------------------
Rem Filtrer_Auteurs
Rem 
Rem Filtrer la liste des auteurs selon le motif
Rem défini par les premiers caractères saisies
Rem dans la zone de filtre. L'évènement est 
Rem déclenché après chaque caractère frappé.
Rem
Public Sub CmdFiltrerAuteurs(poEvent As Object)
	Dim ocTxtField As Object
	Dim sFiltre As String
	Dim oeEvent As Object
	Dim oDialog As Object
	
	On Local Error Goto Error_Sub
	Rem if isNUll(_ThisDlgAuteurs) OR (not _ThisDlgAuteurs.IsLoaded) then exit Sub
	
	Rem if not _ThisDlgAuteurs.isLoaded then exit Sub
	Set oeEvent = Events(poEvent)
	Set oDialog = oeEvent.Source.Parent
	Set ocTxtField = oDialog.Controls("TextFieldFiltre")
	sFiltre = ocTxtField.Text
	Rem _InitListeAuteurs(sFiltre)		
	Exit Sub
	
Exit_Sub:
	Exit Sub
Error_Sub:
	TraceError("ERROR", Err, "ShowError", Erl)
	Goto Exit_Sub
End Sub

Belows is the code to call the dialog ClassModule DlgSelectAuteursClass :

Code: Select all

Rem -------------------------------------------
Rem Form_KeyDown
Rem
Private Sub FormNotice_AuteursKeyDown(oEvent As Object)
	Dim oMainForm As Object
	Dim oFormCtrlAuteurs As Object 
	Dim oFormFieldAuteurs As Object 
	Dim oDialog, oControlDialog As Object	
	Dim sSelectedAuteur As String
	Dim sAuteurs As String
	
	On Error goto Erreur :
		
	If not (oEvent.KeyCode = 771) Then Exit Sub	Rem 771 = F4
		
	Set oMainForm = Application.Forms("FORM_NOTICES_BIBLIOGRAPHIQUES")	
	Set oFormCtrlAuteurs = oMainForm.Controls("AUTEURS")
	Set oFormFieldAuteurs = oMainForm.Controls("AUTEURS")					
	
	Rem Instanciation de la boite de dialogue (encore non visible)
	Set oDialog = Application.AllDialogs("DlgSelectAuteurs")
	oDialog.Start
		
	Rem Instanciation et initialisation du controleur de la 
	Rem boite de dialogue
	Set oControlDialog = new DlgSelectAuteursClass
	oControlDialog.Start(oDialog,"*")
	
	Rem Affichage de la boite de dialogue et ajout du nouvel auteur si OK
	If oDialog.Execute = dlgOK then		

		Rem Récupération de l'auteur sélectionné dans la boite de dialogue
		sSelectedAuteur = oControlDialog.SelectedAuteur

		Rem Si le nouvel auteur n'est pas déjà présent alors on l'ahoute
		If InStr(1, Auteurs, Trim(sSelectedAuteur)) = 0 AND Len(sSelectedAuteur) > 0 then 

			Rem Formatage de la valeur saisie par l'utilisateur
			sSelectedAuteur = Join(Split(Trim(sSelectedAuteur), "\","/"))
			sSelectedAuteur = Join(Split(sSelectedAuteur, ";",","))		
			sSelectedAuteur = Join(Split(sSelectedAuteur, ".",","))
			sSelectedAuteur = Join(Split(sSelectedAuteur, "_","-"))						
			
			Rem Ajout du nouvel auteur en fin de chaine 
			Rem (a remplacer par une insertion à l'endroit de la selection)
			sAuteurs = Trim(oFormFieldAuteurs.text)
			sAuteurs = sAuteurs & sSelectedAuteur & " / "
			oFormFieldAuteurs.UpdateString(sAuteurs)
		End If
	End If
	
	Rem Netoyage des objets temporaires de gestion de la boite de dialogue
	oDialog.Terminate
	Erase oControlDialog
	Exit Sub	

Erreur: 
	Debug_Catch(Name, "Form_KeyDown")
End Sub
Libreoffice 6.4.6.2, Kernel: 5.4.0-52-generic x86_64 bits: 64
Desktop: Cinnamon 4.4.8 Distro: Linux Mint 19.3 Tricia
JPL
Volunteer
Posts: 130
Joined: Fri Mar 30, 2012 3:14 pm

Re: [Base] Access2Base - version 0.9.1 released

Post by JPL »

@gelinp

1. Remove the line

Code: Select all

oDialog.Controls("ListBoxAuteurs").RowSourceType = com.sun.star.form.ListSourceType.VALUELIST
2. Do not anchor events to subs in class modules ! Move the subs to another usual module.

JPL
Kubuntu 22.04 / LibO 7.5
Access2Base (LibO).
BaseDocumenter extension (LibO)
ScriptForge (LibO)
Documentation on https://help.libreoffice.org/latest/en- ... bPAR=BASIC
gelinp
Posts: 35
Joined: Mon Oct 09, 2017 9:27 pm

Re: [Base] Access2Base - version 0.9.1 released

Post by gelinp »

Ok, thank you for your response ! Now it's running. So my basic modul doesn't use class if I use events, and the code to build my combox is :

Code: Select all

Rem ------------------------------------------------------------
Rem InitListeAuteurs
Rem
Sub _InitListeAuteurs(sFiltre As String)
	Dim occbAuteurs As Object
	Dim orsRecords As Object
	Dim aRow() As Variant
	Dim sSQL As String	
	Const IndiceAuteurs = 0
	Dim sItems As String
	
	On Local Error Goto Error_Sub
		
	If isNUll(_ThisDlgAuteurs) OR (not _ThisDlgAuteurs.IsLoaded) then exit Sub
	Set occbAuteurs = _ThisDlgAuteurs.Controls("cbAuteurs")
	
	Rem Parametrage et execution du recordset de la liste des auteurs
	sSQL = "SELECT [AUTEUR] FROM [AUTLESAUTEURS] "
	if not IsMissing(SFiltre) Then sSQL = sSQL & "WHERE [AUTEUR] LIKE '*" & sFiltre & "*'"
	sSQL = sSQL & " ORDER BY [AUTEUR] ASC"

	orsRecords= Application.CurrentDb().OpenRecordset(sSQL, , , dbReadOnly)

	with orsRecords
	
	if orsRecords.RecordCount = 0 then 
		MsgBox("Aucun auteur correspondant au filtre : " & sFiltre)
		Exit Sub
	End If
	.MoveLast() : .MoveFirst()
	aRow = .GetRows(1)
	if not isNull(aRow) then	
		sItems =  aRow(IndiceAuteurs,0)
		Do While Not .EOF
			aRow = .GetRows(1)
			sItems = sItems & ";" & aRow(IndiceAuteurs,0)
		Loop
	End If
	_ThisDlgAuteurs.Controls("cbAuteurs").RowSource = sItems
	_ThisDlgAuteurs.Controls("cbAuteurs").ListIndex = 0
	.mclose()
	
	End With 
		
Exit_Sub:
	Exit Sub
Error_Sub:
	TraceError("ERROR", Err, "ShowError", Erl)
	Goto Exit_Sub
End Sub			
Libreoffice 6.4.6.2, Kernel: 5.4.0-52-generic x86_64 bits: 64
Desktop: Cinnamon 4.4.8 Distro: Linux Mint 19.3 Tricia
gelinp
Posts: 35
Joined: Mon Oct 09, 2017 9:27 pm

Re: [Base] Access2Base - version 0.9.1 released

Post by gelinp »

Hi,

I've got a problem to flush value from a listbox to a foreign key, which is used to synchronize a subform. So how to force flushing data from control to current recordset field ? I tried something like this into the event 'modified' send by the listbox cZCTYPEDOC:

Code: Select all

oSubFormRecords.Recordset.Fields("FKREGLEGESTION").Value = cZCTYPEDOC.Value
But I've got error message :
L'erreur #1545 (Erreur de séquence lors de la mise à jour d'un Recordset) s'est produite dans un appel à la fonction 'Field.setValue'
Thank you for your help.
Patrick
Libreoffice 6.4.6.2, Kernel: 5.4.0-52-generic x86_64 bits: 64
Desktop: Cinnamon 4.4.8 Distro: Linux Mint 19.3 Tricia
JPL
Volunteer
Posts: 130
Joined: Fri Mar 30, 2012 3:14 pm

Re: [Base] Access2Base - version 0.9.1 released

Post by JPL »

@gelinp

setting a value in a field of a recordset requires to use the AddNew or Edit methods.

Something like:

Code: Select all

Dim oRecordset As Object
     Set oRecordset = oSubFormRecords.Recordset
     oRecordset.Edit
          oRecordset.Fields("FKREGLEGESTION").Value = cZCTYPEDOC.Value
     oRecordset.Update
JPL
Kubuntu 22.04 / LibO 7.5
Access2Base (LibO).
BaseDocumenter extension (LibO)
ScriptForge (LibO)
Documentation on https://help.libreoffice.org/latest/en- ... bPAR=BASIC
gelinp
Posts: 35
Joined: Mon Oct 09, 2017 9:27 pm

Re: [Base] Access2Base - version 0.9.1 released

Post by gelinp »

Thank you for your response JPL :-)

An other important problem is problem of reentrance of the events. I've got the problem with Form event moving next records. the problem comes from several things :
  • A repeat delay may be active with form navigation bar (And I can't find how to cancel it)
  • The form control may trigger two events (one from "com.sun.star.form.FmXFormController" and the other from "com.sun.star.comp.forms.ODatabaseForm"
I've tried to use other Uno API like ThisDatabaseDocument.lockControllers but but this only freezes the interface, without preventing the sending of multiple messages from the control or the model of the mainform. I've a look into uno framework about thread, mutex and addActionLock but I still can not use them in the basic macros, I have not yet understood if it would be possible...

it's a blocking problem, if I can not fix it I can not use LibreOffice interface anymore ...

Could you tell me if Access2Base could propose a solution to manage reentrancy (Mutex, Lock controler events, ...) ? I have not yet understood which object broadcast the messages for next records, or change records content (update, delete, refresh...).

Note : I tried t use wait call with reentrancy call (with a watch dog as timout but this fail too because LibreOffice execute first the reentrancy event and freeze first one, so the the re-entrant call to the priority... It could be a good solution, taking acount last event only but then I can't find how to kill the thread of the first event ...
---------------------------
SOLUTION : I respond to myself because I've got a solution from maillinglist. I could add a comand Buton to go next record with no replay property. And then use "ACCEPT ACTION" event on same comand button in order to refuse other reetrant events. To do this, you have to use signature like "Sub AcceptActionListner(Event As Object) As Boolean" and use a global Flag variable to detect reentrance and return false.
Last edited by gelinp on Thu Jan 25, 2018 9:48 pm, edited 1 time in total.
Libreoffice 6.4.6.2, Kernel: 5.4.0-52-generic x86_64 bits: 64
Desktop: Cinnamon 4.4.8 Distro: Linux Mint 19.3 Tricia
Post Reply