Re: [Lazarus] DBGrid displays Float as integer

[LacaK via lazarus]

If i execute: "SELECT CAST(AVG(km_gelaufen) *AS REAL*) FROM laufdaten" 
the known problem of integer only shows up again.


BUT:

If i execute this "SELECT CAST(AVG(km_gelaufen)  AS REAL) FROM 
laufdaten " in SQliteStudio it works as it should.



Ok then it is clear that SQLite produces result as expected


Is DBgrid or Zeos Access components  the culpit? I don't know.


Do you use Zeos components not SQLdb (TSQLQuery)?
Can you test datatype of TField created at runtime?
For example place somewhere after dataset is Open-ed something like: 
ShowMessage(Fieldtypenames[Query1.Fields[0].DataType]);


L.
-- 
___
lazarus mailing list
lazarus@lists.lazarus-ide.org
https://lists.lazarus-ide.org/listinfo/lazarus

Re: [Lazarus] DBGrid displays Float as integer

[LacaK via lazarus]

Hi,

IMO AVG() should produce floating point result.

https://www.sqlite.org/lang_aggfunc.html#aggfunclist: The result of 
avg() is always a floating point value whenever there is at least one 
non-NULL input even if all inputs are integers.


In SQLite plays role column affinity. I expect that "km_gelaufen" is of 
NUMERIC or REAL affinity.


What result (in TDBGrid) gives: SELECT CAST(AVG(km_gelaufen)  AS REAL) 
FROM laufdaten ?


L.



Ok, *solution* is to CAST AS Varchar the result:

SELECT CAST(AVG(km_gelaufen)  AS VARCHAR) FROM laufdaten

But  i don't understand why i do have to cast the result ...


-- 
___
lazarus mailing list
lazarus@lists.lazarus-ide.org
https://lists.lazarus-ide.org/listinfo/lazarus

Re: [Lazarus] Dbnavigator won't post to MSACESS db

[LacaK via lazarus]

In my written code, yes. And I have no problems writing to the table 
that way. But using the Dbnavigator post button won’t work.


Then I suspect that is your problem.
The Dbnavigator post button only does a post, never ApplyUpdates and 
transaction commit.


The ApplyUpdates can be automated with the sqoAutoApplyUpdates option 
of the
TSQLQuery, but the transaction commit should be implemented for 
example in the

AfterApplyUpdates event.


There is also sqoAutoCommit ...
L.



Michael.


Sent from my iPhone

On Dec 10, 2023, at 03:29, Michael Van Canneyt via lazarus 
 wrote:





On Fri, 8 Dec 2023, Larry Dalton via lazarus wrote:

I am using lazarus v2.2.6 on Windows 11.
The form uses the following components:
MBCCGator: TDBNavigator;
 MBCCGrid: TDBGrid;
 MBCCSource: TDataSource;
 MBCC_Connector: TODBCConnection;
 MBCCQuery: TSQLQuery;
 MBCC_Trans: TSQLTransaction;    MBCCQuery: TSQLQuery;
 also includes several TDBEdits.

 It connects to an MSAccess Database, with a table named MBCC_2023.
I have no trouble accessing the database, and reading the records. 
I can
use MBCCGator to navigate the database. However, it will NOT post a 
new
record or a changed record to the  table. I don't get any error 
codes. It

just won't  store. Help is requested.


Are you calling applyupdates and committing the transaction ?

Michael.
--
___
lazarus mailing list
lazarus@lists.lazarus-ide.org
https://lists.lazarus-ide.org/listinfo/lazarus

--
___
lazarus mailing list
lazarus@lists.lazarus-ide.org
https://lists.lazarus-ide.org/listinfo/lazarus




--
___
lazarus mailing list
lazarus@lists.lazarus-ide.org
https://lists.lazarus-ide.org/listinfo/lazarus

Re: [Lazarus] TSQLConnector for MySQL non-standard port

[LacaK via lazarus]

Hello,
try use "Params" and put there "Port="
-Laco.


Hi,

I would like to use a non-standard port for my MySQL-connection. Is 
this possible ? If so, how ?

Standard port is 3306.
I tried to add my non-standard port to the hostname 
(:), but that does not work: 'TMySQL57Connection 
: Server connect failed.'
Sniffing the network on that port gives nothing, so there is no 
attempt to connect.
MySQLWorkbench with the same parameters works OK, so there is a server 
listening on that port.


Koenraad.


--
___
lazarus mailing list
lazarus@lists.lazarus-ide.org
https://lists.lazarus-ide.org/listinfo/lazarus

Re: [Lazarus] Mantis vs GitLab issue tracker

[LacaK via lazarus]

is it just my impression that Mantis was more feature rich an had 
better 

layout?

An example: Mantis has "Reported by me".


You can find this in your 'issues' list?


It is my impression too.
I would like to see panels (like in 
https://gitlab.com/groups/freepascal.org/-/boards):

- Reported by me (filter Author="my account")
- Assigned to me (filter Asignee="my account")
- Unassigned (filter Asignee=None)
- (Resolved); here is sufficient for me list of recently changed 
issues as is there already
In other words : is there way how to add custom boards based on above 
filters?


I can create new boards, but not with the filters you want. There is 
no 'active user' filter. (i.e. "me" or so)


I can create lists filtered on label, assignee or milestone.


Ok I understand.
If there is no straight forward, simple way then IMO no need to 
complicate things.

I am here as pure user and I am asking for simple solutions ;-)
I only shared impression that GitLab issue tracker is for me also less 
intuitive and practical compared to Mantis.
(of course I accept others developers arguments related to maintenance 
cost of GitLab versus Mantis and so on ...)

L.

--
___
lazarus mailing list
lazarus@lists.lazarus-ide.org
https://lists.lazarus-ide.org/listinfo/lazarus

Re: [Lazarus] Mantis vs GitLab issue tracker

[LacaK via lazarus]

  
is it just my impression that Mantis was more feature rich an had better layout?

An example: Mantis has "Reported by me".

It is my impression too.
I would like to see panels (like in 
https://gitlab.com/groups/freepascal.org/-/boards):

- Reported by me (filter Author="my account")
- Assigned to me (filter Asignee="my account")
- Unassigned (filter Asignee=None)
- (Resolved); here is sufficient for me list of recently changed issues 
as is there already
In other words : is there way how to add custom boards based on above 
filters?

L.

--
___
lazarus mailing list
lazarus@lists.lazarus-ide.org
https://lists.lazarus-ide.org/listinfo/lazarus

Re: [Lazarus] TSql57 replacement

[LacaK via lazarus]

Is there another way to connect now? I don't want to install Mysql 57.

Cann't you use TMySQL57Connection with SkipLibraryVersionCheck property 
set to True?


-Laco.


--
___
lazarus mailing list
lazarus@lists.lazarus-ide.org
https://lists.lazarus-ide.org/listinfo/lazarus

Re: [Lazarus] LazDataDesktop: transaction handling

[LacaK via lazarus]

If data of underlaying TSQLQuery are presented and edited only thorought 
this DBGrid then I would add to TSQLQuery option "sqoAutoApplyUpdates".

(I am not familiar with architecture of LazDataDesktop)
Which causes that on every Post/Delete updates are applied to database.
There will remain option to commit or rollback changes.
L.

Dňa 4.9.2019 o 20:02 Ondrej Pokorny via lazarus napísal(a):


Hello (Michael)!

I started to use LazDataDesktop because PgAdmin4 is horrible.

I have a problem with transactions with Postgres connection (well I 
tested only Postgres connection).


I found out that when using the SQL editor, I can type "COMMIT" and 
"ROLLBACK" - so far so good. (Well I would like to have a tool button 
for these commands but OK for now - I may add them in the future.)


The real problem: I cannot apply edited data from the DB grid. I keep 
getting this error:


I have clicked on the tick button - it got disabled. I have also 
clicked on the button next to refresh - well I don't know that the 
button does because it has no hint and caption, but I clicked on it 
nevertheless :) :


But still I get the error above and the data is not written.

How can I commit the changes made in the data grid?

Thanks
Ondrej


-- 
___
lazarus mailing list
lazarus@lists.lazarus-ide.org
https://lists.lazarus-ide.org/listinfo/lazarus

Re: [Lazarus] freetds + lazarus cannot get around "some character(s) could not be converted" error

[LacaK via lazarus]

Hello,


I am attempting to write a Lazarus program using a TMSSQLConnection on 
Linux (Ubuntu 16.04 64 bit) with FreeTDS. Whenever I try to apply 
updates on my TSQLQuery component and commit the transaction on its 
associated TSQLtransaction component I receive this error:


An error occurred while applying the updates in a record:
Connection : Error 2403 :
Attempt to initiate a new Adaptive Server operation with results
pending
Some character(s) could not be converted into client's character
set.  Unconverted bytes were changed to question marks ('?')
Some character(s) could not be converted into client's character
set.  Unconverted bytes were changed to question marks ('?')
Some character(s) could not be converted into client's character
set.  Unconverted bytes were changed to question marks ('?')
Some character(s) could not be converted into client's character
set.  Unconverted bytes were changed to question marks ('?')
.

Press OK to ignore and risk data corruption.
Press Abort to kill the program


If I press OK the updates are not actually applied. It looks like no 
matter what I do I cannot edit field values and have them applied to 
the SQL server database.


I have tried changing the freetds.conf file to include the following:

[global]
client charset = UTF-8


probably try add also:

dump file = freetds.log

then you can look into log file what and when actually happens ...




I have even tried setting the charset property on the TMSSQLConnection 
to UTF-8.


Yes it is needed

What verision of FPC/Lazarus do you use?
Do you have DefaultSystemCodePage = UTF8 ?
Can you try with TRUNK or 3.2 branch?

What is version of remote SQL Server ?

-Laco.


-- 
___
lazarus mailing list
lazarus@lists.lazarus-ide.org
https://lists.lazarus-ide.org/listinfo/lazarus

Re: [Lazarus] How to deploy a Lazarus app for Windows?

[LacaK via Lazarus]

I remember using these:

http://nsis.sourceforge.net/Main_Page
http://www.jrsoftware.org/isinfo.php



If you need installer in Microsoft Installation Package format (*.msi) 
then you can look at WiX toolset: http://wixtoolset.org and WixEdit: 
http://wixedit.sourceforge.net/

-Laco.

--
___
Lazarus mailing list
Lazarus@lists.lazarus-ide.org
http://lists.lazarus-ide.org/listinfo/lazarus

Re: [Lazarus] Request for apply patch

[LacaK via Lazarus]

Hi Lazarus Developers,
can somebody please look at and if all okay apply patch in bug report
http://bugs.freepascal.org/view.php?id=27764
There is one new unit which implements simple Delphi compatible 
Database

Login Dialog.


Hi, I have updated patch attached to #27764 (Database Login Dialog) with 
all controls positioned using anchoring

Please review and let me know if anything more should be improved.
Thanks
-Laco.

--
___
Lazarus mailing list
Lazarus@lists.lazarus-ide.org
http://lists.lazarus-ide.org/listinfo/lazarus

Re: [Lazarus] Linux 64 to Linux ARC crosscompile was:Lazarus and Windows 10 IoT

[LacaK via Lazarus]

Alternate solution to my modified question (Cross-compile from Windows 
to Linux/ARM):


- Download FpcUpDeluxe executable from 
https://github.com/newpascal/fpcupdeluxe/releases (in my case 1.2.0m)

- Run it and choose InstallDir (for example D:\TEMP\fpcupdeluxe)
- Select FPC and Lazarus version (for example FPC 3.0.2 and Lazarus trunk)
- Click "Install/update FPC+Laz" (FPC and Lazarus sources will be 
downloaded from SVN and build)
- Then select CPU=arm, OS=Linix and click "Install cross-compiler" 
(cross-compiler and FPC unit will be compiled)


It is easy and awesome! Thank you very much for FpcUp[Deluxe]!

Unfortunately there is not mentioned on:
 
http://wiki.freepascal.org/Lazarus_on_Raspberry_Pi#Cross_compiling_for_the_Raspberry_Pi_from_Windows
 and
 http://wiki.freepascal.org/fpcup#Linux_ARM_cross_compiler ,
that this whole process is covered by FpcUpDeluxe and user is not 
required do anything manualy ;-)


P.S.1
Only drawback, which I faced is, that I can not build current stable 
release of FPC 3.0.2 and Lazarus 1.6.4 using FpcUpDeluxe 
(fpcupdeluxe-i386-win32.exe on Win8.1 64bit)
Program freezes and last entry in log is: Lazarus: lazbuild could not be 
found, so cannot build USERIDE.

(configuration which works for me is FPC 3.0.2 + Lazarus trunk)

P.S.2
Interesting idea would be create utility which will build only 
cross-compilers based on FPC already installed (like does FpcUpDeluxe 
but without need/overhead of SVN checkout and Lazarus build 
functionality). May be only ZIP archive with needed utilities + script 
which will do needed tasks.

--
___
Lazarus mailing list
Lazarus@lists.lazarus-ide.org
http://lists.lazarus-ide.org/listinfo/lazarus

Re: [Lazarus] Linux 64 to Linux ARC crosscompile was:Lazarus and Windows 10 IoT

[LacaK via Lazarus]

I am sure taht this question was already asked, but I can not find 
clear answer.


Is there possibility to create Lazarus application with GUI which 
will run on Raspberi Pi - ARM - Windows 10 IoT ?

(Target OS=Win32, Target CPU=Arm ?)

If not, is there possibility to create same application for Raspberi 
Pi - ARM - Linux ?
(Target OS=Linux, Target CPU=Arm ? ... can I crosscompile from 
Linux/i386 to Linux/Arm ?)


The latter definitely should work.
Is there any tutorial how-to-do-it other than 
http://wiki.lazarus.freepascal.org/Setup_Cross_Compile_For_ARM ?


What I did is:
1. Install Ubuntu Linux 16.04 (64 bit) into VirtualBox on Windows
2. Install Lazarus for Linux (I can compile application for host platform)
3. Try install 
https://sourceforge.net/projects/freepascal/files/Linux/3.0.2/fpc-3.0.2.arm-linux-eabihf-raspberry.tar/download 
using supplied install.sh

(some errors were reported as: Syntax error: Word unexpected (expecting"(")
After step 3 I cannot run Lazarus (probably fp.cfg was corrupted)

-Laco.

--
___
Lazarus mailing list
Lazarus@lists.lazarus-ide.org
http://lists.lazarus-ide.org/listinfo/lazarus

Re: [Lazarus] Writing >1000 TBufDataset records to file is extremely slow

[LacaK via Lazarus]

But now another issue is coming up: If I increase the number of 
records to 40,000 population of records slows down after about 
10,000 records, speeds up again, and comes to an apparant 
stand-still for 32900 records. After waiting some time the record 
counter (which is incremented in steps of 100 in my demo) goes up to 
33000. Then I gave up.

Try call MergeChangeLog regulary on every 1000 rows for example.
If does not help, attach your test program, so we can reproduce ...


Yes, this is the solution. Thank you. MergeChangeLog definitely should 
be documented in a better way.

You can report bug report about it or add it to wiki yourself
 - There is http://wiki.freepascal.org/TBufDataset but it seems that 
there is only one line of text ;-)
 - in FCL documentation 
http://www.freepascal.org/docs-html/current/fcl/db/index.html I can not 
find TBufDataset at all

L.

--
___
Lazarus mailing list
Lazarus@lists.lazarus-ide.org
http://lists.lazarus-ide.org/listinfo/lazarus

Re: [Lazarus] Writing >1000 TBufDataset records to file is extremely slow

[LacaK via Lazarus]

Try call FExportDataset.MergeChangeLog before:
  WriteLn('Saving...'); 

Does anything in your timing changed ?


Ah - that's it. TBufDataset saves the records instantly now. Probably, 
this should go into the official wiki site for TBufDataset.


But now another issue is coming up: If I increase the number of 
records to 40,000 population of records slows down after about 10,000 
records, speeds up again, and comes to an apparant stand-still for 
32900 records. After waiting some time the record counter (which is 
incremented in steps of 100 in my demo) goes up to 33000. Then I gave up.

Try call MergeChangeLog regulary on every 1000 rows for example.
If does not help, attach your test program, so we can reproduce ...

L.

--
___
Lazarus mailing list
Lazarus@lists.lazarus-ide.org
http://lists.lazarus-ide.org/listinfo/lazarus

Re: [Lazarus] Writing >1000 TBufDataset records to file is extremely slow

[LacaK via Lazarus]

Try call FExportDataset.MergeChangeLog before:
  WriteLn('Saving...'); 

Does anything in your timing changed ?
-Laco.
--
___
Lazarus mailing list
Lazarus@lists.lazarus-ide.org
http://lists.lazarus-ide.org/listinfo/lazarus

[Lazarus] Request for apply patch

[LacaK via Lazarus]

Hi Lazarus Developers,
can somebody please look at and if all okay apply patch in bug report 
http://bugs.freepascal.org/view.php?id=27764
There is one new unit which implements simple Delphi compatible Database 
Login Dialog.

Thanks
-Laco.
--
___
Lazarus mailing list
Lazarus@lists.lazarus-ide.org
http://lists.lazarus-ide.org/listinfo/lazarus

Re: [Lazarus] SQLite & DB Aware Components

[LacaK via Lazarus]

Dňa 1.12.2016 o 21:40 Martin Collins via Lazarus napísal(a):

On 01/12/16 16:15, Martin Collins via Lazarus wrote:

 From what I understand, SQLite TEXT type has no set length so db aware
components treat it as a memo. Therefore when I assign a TEXT field to a
db aware component, all that appears in the component is "(MEMO)", even
though most of my TEXT fields are only up to 10-30 characters long.
Solutions offered on-line suggest using a dbmemo (which I have for my
longer TEXT fields as that's what I want), but I need to use dbgrids,
dbedits, dbcomboboxs, etc for the shorter TEXT fields.


I have found a solution to my problem, with thanks to the following link:

http://www.tweaking4all.com/software-development/lazarus-development/lazarus-pascal-getting-started-with-sqlite/#ATEXTfieldshowsamemoinaDBGrid

The answer was altering my SQL Query text, from something like this:

SELECT
   "Filename",
   "Date"
FROM
   "mytable";

to this:

SELECT
   CAST( "Filename" AS VARCHAR) AS "Filename",
   "Date"
FROM
   "mytable";

Casting it as a different type in the SQL statement worked!

You are not required to that if you have declared table "mytable" as:
CREATE TABLE "mytable" (
 FileName varchar(100),
 Date datetime
)

-Laco
--
___
Lazarus mailing list
Lazarus@lists.lazarus-ide.org
http://lists.lazarus-ide.org/listinfo/lazarus

Re: [Lazarus] Lazarus and MySQL 5.7

[LacaK via Lazarus]

What version of Lazarus can connect to MySQL 5.7 using TSqlConnector?
My laptop has 1.6 and does not seem to be able to connect using that
component.

I added TMySQL57Connection to trunk (1.7).


Thank you Mattias.
-Laco.
--
___
Lazarus mailing list
Lazarus@lists.lazarus-ide.org
http://lists.lazarus-ide.org/listinfo/lazarus

Re: [Lazarus] Lazarus and MySQL 5.7

[LacaK via Lazarus]

Hi,
Please create bug report on http://bugs.freepascal.org and attach your 
modified files (at least ;-))

-Laco.


Sorry, the link below is broken.

This is the good one:

http://www.bononiadocta.it/Lazarus/Sqldb.tar.bz2


Il 22/11/2016 01:37, Giuliano Colla ha scritto:
I cannot contribute the patch right now because I didn't make it on 
an SVN version, but whoever is interested can get a patched version 
of SqlDBLaz for Lazarus 1.6 supporting MySql 5.7 from this link:


/www.bononiadocta.it/Lazarus/Sqldb.tar.bz2

Just use it to replace the sqldb folder in the 
$PATH$TO$LAZARUS/components folder and rebuild the IDE.




-- 
___
Lazarus mailing list
Lazarus@lists.lazarus-ide.org
http://lists.lazarus-ide.org/listinfo/lazarus

Re: [Lazarus] Open Office dbase

[LacaK via Lazarus]

You can use TDBF component or TODBCConnection (from FCL DB)  with dBase 
or FoxPro driver (I do not known if exists for Linux)

-Laco.


I have an application that creates dbase files and writes information 
to them. I now need a procedure that will open the newly filled table 
so that it can be manually edited and printed. Some of the users are 
on Linux and some on Windows 7 and later. A couple of them are using 
Excel on the Windows  boxes while the rest are using OpenOffice Libre. 
What is the best way to open those applications to the newly created 
tables with Lazarus?





-- 
___
Lazarus mailing list
Lazarus@lists.lazarus-ide.org
http://lists.lazarus-ide.org/listinfo/lazarus

Re: [Lazarus] TThread.Synchronize

[LacaK via Lazarus]

Dňa 26.10.2016 o 11:17 Michael Schnell via Lazarus napísal(a):

On 26.10.2016 07:57, LacaK via Lazarus wrote:

procedure TRefreshFileListThread.Execute;
begin
  while not Terminated do begin
Synchronize(@MyForm.UpdateFileList); // UpdateFileList is method 
which clears listbox and then adds files in given shared folder

Sleep(1);
  end;
This only makes sense if the actual file list generation (all but the 
GUI update) is done in not shown code in the thread before Synchonize 
is called.

no.
thread code is all what you see above.
my intention was use thread only for periodical refresh of list



Otherwise you just could use TTimer.
probably yes. I do not remember why I have used thread for it. May be I 
do not wanted dependency on ExtCtrls ...
Btw. when TTimer is executing OnTimer method, which does not finishes 
until next Interval is elapsed, is again called OnTimer ? Or next 
OnTimer is performed only when prior OnTimer finished ?


-Laco.

--
___
Lazarus mailing list
Lazarus@lists.lazarus-ide.org
http://lists.lazarus-ide.org/listinfo/lazarus

Re: [Lazarus] TThread.Synchronize

[LacaK via Lazarus]

Big Thanks to all. Now I understand what is happening ... probably I wil 
use critical section to block access from thread when code in main 
thread is performed ...

-Laco.




ShowModal() for a modal form will call it.

[...]
I did test in Delphi and Delphi seems also perform synchronize upon
ShowModal

Yes.



Nowhere is it stated or guaranteed that synchronisation cannot happen
in a GUI event
handler.

But cann't happen if nobody calls ProcessMessages or CheckSynchronize
explicitly.
So if user code is executed in event handler then this execution cann't
be interrupted by thread waiting for "synchronization"

Yes.
Unless you call something that does call HandleMessages/ProcessMessages
or CheckSynchronize.

  

Any code at any time can call the GUI message loop. A modal form is
just one instance.

ModalForm is IMO one example but may be alone in LCL ... as there are no
more controls which do same, does not ?

The dialogs like TOpenDialog and ShowMessage call it.
Another example is reading the Clipboard on gtk and retrieving files in
TShellTreeView.


Mattias

--
___
Lazarus mailing list
Lazarus@lists.lazarus-ide.org
http://lists.lazarus-ide.org/listinfo/lazarus

Re: [Lazarus] TThread.Synchronize

[LacaK via Lazarus]

ShowModal() for a modal form will call it.


Ah really?
It happens in my application!


Then that is  your problem.

:-)))



But is it correct behavior ? IMO it is against thread safety, which 
should Synchronize guarantee!


The two issues are completely unrelated. The current behaviour is 
correct.
I did test in Delphi and Delphi seems also perform synchronize upon 
ShowModal




Nowhere is it stated or guaranteed that synchronisation cannot happen 
in a GUI event
handler. 


But cann't happen if nobody calls ProcessMessages or CheckSynchronize 
explicitly.
So if user code is executed in event handler then this execution cann't 
be interrupted by thread waiting for "synchronization"



Any code at any time can call the GUI message loop. A modal form is
just one instance.


ModalForm is IMO one example but may be alone in LCL ... as there are no 
more controls which do same, does not ?

So in my mind it is very specific case, which should be documented.
Of course there can be any user defined control which will do same ...



Your code must be able to deal with this.


Yes, thanks

-Laco.

--
___
Lazarus mailing list
Lazarus@lists.lazarus-ide.org
http://lists.lazarus-ide.org/listinfo/lazarus

Re: [Lazarus] TThread.Synchronize

[LacaK via Lazarus]

Check for Application.ProcessMessages and CheckSynchronize calls. 
These process synchronize queue, if I am not mistaken.


I do not call CheckSynchronize nor ProcessMessages in my application.
So only any LCL component or widget set can call it in background ?


ShowModal() for a modal form will call it.


Ah really?
It happens in my application!

Basicaly I have one form MyForm with one background thread, which every 
10 sec. checks for files in shared folder and adds them to listbox 
visible to user:

procedure TRefreshFileListThread.Execute;
begin
  while not Terminated do begin
Synchronize(@MyForm.UpdateFileList); // UpdateFileList is method 
which clears listbox and then adds files in given shared folder

Sleep(1);
  end;

When new file is shown then user can click on button, which imports data 
from this file:
Before import is shown another form with question about "Do you want 
really import file XYZ ?"


Do you say, that when this "question form" is shown it can release call 
to MyForm.UpdateFileList ?

Now I did quick test and it seems, that it is so!

But is it correct behavior ? IMO it is against thread safety, which 
should Synchronize guarantee!
While "main thread" is executing others threads should wait in queue ... 
if not fixable, then can it be documented?, because this is exception 
which is not intuitive


-Laco.
--
___
Lazarus mailing list
Lazarus@lists.lazarus-ide.org
http://lists.lazarus-ide.org/listinfo/lazarus

Re: [Lazarus] TThread.Synchronize

[LacaK via Lazarus]

I do not call CheckSynchronize nor ProcessMessages in my application.
So only any LCL component or widget set can call it in background ?


It should be easy for you to set a breakpoint into MyForm.MyMethod and 
check the call stack.



But error (AV) happens only in production and only sometimes.
Is there any way how to write call stack into file ?
TIA
-Laco.

--
___
Lazarus mailing list
Lazarus@lists.lazarus-ide.org
http://lists.lazarus-ide.org/listinfo/lazarus

Re: [Lazarus] TThread.Synchronize

[LacaK via Lazarus]

Check for Application.ProcessMessages and CheckSynchronize calls. 
These process synchronize queue, if I am not mistaken.


I do not call CheckSynchronize nor ProcessMessages in my application.
So only any LCL component or widget set can call it in background ?


From Delphi doc:
"Synchronize causes the call specified by AMethod to be executed using 
the main thread, thereby avoiding multithread conflicts.
If you are unsure whether a method call is thread-safe, call it from 
within the Synchronize method to ensure that it executes in the main thread.
Execution of the current thread is suspended while the method executes 
in the main thread. "


Looking from where is called CheckSynchronize:

- TWin32WidgetSet.AppProcessMessages

- win32callback.inc:
 case Msg of
  WM_NULL:
  if (Window = Win32WidgetSet.AppHandle) then
  begin
CheckSynchronize;
...

Cann't something send WM_NULL to application which can as reaction run 
sheduled thread ?
WM_NULL sends HandleWakeMainThread() which is handler stored in variable 
WakeMainThread


Messages in win32callback are processed by "main thread" only, so 
execution cann't happen while form method is executed ?


-Laco.


-Laco.


--
___
Lazarus mailing list
Lazarus@lists.lazarus-ide.org
http://lists.lazarus-ide.org/listinfo/lazarus

Re: [Lazarus] TThread.Synchronize

[LacaK via Lazarus]

My understanding is that, Synchronize schedules execution of 
MyForm.MyMethod to main thread, so method is not executed until 
control is returned from event handler in MyForm. Right?
TThread.Synchronze pushes the procedure that is given as a parameter 
(including it's Self pointer) to the event queue and then the Therad 
that called TThread.Synchronize is stalled.

ok

Some time later the main (GUI) thread will execute the scheduled 
procedure. When this call returns, the thread that called 
TThread.Synchronize is activated.

ok

but what is relation between "main thread" and this "sheduled procedure" 
? Can "sheduled procedure" jump into execution while main thread is 
still executing prior called form method ?




There also is TThread.Queue that works identically, only without 
stalling the thread.

yes, but I do not want this



But in my case happens, that method is executed while execution of 
event handler does not finished yet ... is it expected behavior ?


What is "that method"? If same is called by the thread after 
TThread.Synchronize, IMHO this can't be correct.


Yes this can happen.
MyForm.MyMethod is called also from event handler and also is used in 
Synchronize(@MyForm.MyMethod)

How can this happen/play role?

I have suspection that somewhere in Win32 widgetset is called 
CheckSynchronize as reaction on some message or so, which releases 
execution of MyForm.MyMethod ... but it is inappropriate, does not ?


-Laco.

--
___
Lazarus mailing list
Lazarus@lists.lazarus-ide.org
http://lists.lazarus-ide.org/listinfo/lazarus

[Lazarus] TThread.Synchronize

[LacaK via Lazarus]

Hi *,

I have form on which is button. When user clicks button OnClick event 
handler is called (it is method of form). Processing of this method 
takes some time say 1 minute.
In the background is operating another thread which every 10 seconds 
calls Synchronize(@MyForm.MyMethod).


My understanding is that, Synchronize schedules execution of 
MyForm.MyMethod to main thread, so method is not executed until control 
is returned from event handler in MyForm. Right?


But in my case happens, that method is executed while execution of event 
handler does not finished yet ... is it expected behavior ?
If not is there any workaroud which enables me to hold thread until 
event handler finishes ?


Thanks

-Laco.

--
___
Lazarus mailing list
Lazarus@lists.lazarus-ide.org
http://lists.lazarus-ide.org/listinfo/lazarus

Re: [Lazarus] ActiveX, TOLEControl

[LacaK via Lazarus]

Hi *,

I need help with OCX component (not visual I guess), which I need use 
in Lazarus application (to control another application, which 
supplies this OCX control).
I have imported type library using importtl.exe (new unit was created 
successfully)


Then in program I have created instance:
  v := CreateOleObject('SCAPS.ScSamlightClientCtrl');
or
  intf := CreateComObject(CLASS_ScSamlightClientCtrl) as 
_DSamlight_client_ctrl_ocx;

What is the type of your V or intf  variable?


V: OLEVariant;
intf: _DSamlight_client_ctrl_ocx;

I am wild guessing maybe they are not proper referenced type so the 
object is created and then immediately freed.


There is something strange behind scene. I have tried various methods:

var
  v1: OLEVariant;
  v2: ScSamlightClientCtrl;
  v: variant;
  ax: TActiveXContainer;
  disp: IDispatch;
  i: integer;

begin
  v1 := CreateOLEObject('SCAPS.ScSamlightClientCtrl');
  i := v1.scIsRunning;  // exception here

  v2 := CoScSamlightClientCtrl.Create;
  i := v2.scIsRunning;  // exception here

  ax := TActiveXContainer.Create(Self);
  //ax.OleClassName := 'SCAPS.ScSamlightClientCtrl';
  CoCreateInstance(CLASS_ScSamlightClientCtrl, nil, 
CLSCTX_INPROC_SERVER or CLSCTX_LOCAL_SERVER, IDispatch, disp);

  ax.ComServer:=disp;
  ax.Active := True;
  v := disp;
  i := v.scIsRunning;  // exception here

So in every case it returns exception when I try call first time 
interface method ...

I am not familiar with ActiveX technology so I have no idea what is wrong ?

-Laco.

--
___
Lazarus mailing list
Lazarus@lists.lazarus-ide.org
http://lists.lazarus-ide.org/listinfo/lazarus

[Lazarus] ActiveX, TOLEControl

[LacaK via Lazarus]

Hi *,

I need help with OCX component (not visual I guess), which I need use in 
Lazarus application (to control another application, which supplies this 
OCX control).
I have imported type library using importtl.exe (new unit was created 
successfully)


Then in program I have created instance:
  v := CreateOleObject('SCAPS.ScSamlightClientCtrl');
or
  intf := CreateComObject(CLASS_ScSamlightClientCtrl) as 
_DSamlight_client_ctrl_ocx;


But all next attampts using any interface method fail with EOleSysError 
"Catastrophic failure" (ErrorCode=-2147418113)


In Delphi it works, but only when I use TOLEControl descendant created 
by Delphi's import of ActiveX (into _TLB unit)

In Delphi I have :

TScSamlightClientCtrl = class(TOleControl)
...

but in Lazarus I have no equivalent? (When I Delphi I do same as in 
Lazarus I get same error also in Delphi)


I do not know exacly what to ask here ?
What is purpose of TOleControl and what TOleControl did more than I can 
do in Lazarus ?

Can I somehow workaround it in Lazarus ?

In short what I have imported from type lib in Lazarus is interface:
 _DSamlight_client_ctrl_ocx = dispinterface
   ['{05D31AA6-1306-4DA0-9AE2-A8771FF6FA94}']
   function ScIsRunning:Integer;dispid 1;
  ... etc.
end;

and CoClass:
  Class Function CoScSamlightClientCtrl.Create: _DSamlight_client_ctrl_ocx;
  begin
Result := CreateComObject(CLASS_ScSamlightClientCtrl) as 
_DSamlight_client_ctrl_ocx;

  end;

I can create instance calling CoScSamlightClientCtrl.Create, but as I 
wrote I can not use any method ...


Can somebody give any help ?

Thanks

-Laco.


--
___
Lazarus mailing list
Lazarus@lists.lazarus-ide.org
http://lists.lazarus-ide.org/listinfo/lazarus

Re: [Lazarus] TDBEdit, TStringField Size, DataSize, DisplayWidth and MaxLength

[LacaK via Lazarus]

Dňa 14.10.2016 o 10:08 Tony Whyman via Lazarus napísal(a):


On 14/10/16 06:43, LacaK via Lazarus wrote:
I do not know IBX, but don't you use overriden 
TDataSet.InternalInitFieldDefs ? It will allow you put extra info 
into FieldDef and then use overriden TDataSet.CreateFields, which 
will allow you pass extra info from TIBFieldDef into TIBStringField 
for example ...

(AFAICS Zeos do it in this way also)

That is basically what IBX does.


Not only IBX I think ;-) I suppose that all TDataSet descendants must 
follow this, because in Delphi is TFieldDef.CreateField also not virtual.
Probably there is logic, why it is designed as is (may be 
CreateFields/BindFields should care about TFieldDef->TField).


My point is that it would be better to put the passing of the extra 
info into a subclassed TFieldDef rather than have it in TIBCustomDataSet. 


I understand, but I think, that you must care also about persistent 
fields, where you must hook into BindFields
(in all cases there are only 3 lines of code in CreateFields which 
iteratte over FieldDefs and create field so IMO no big problem override it)


-Laco.

--
___
Lazarus mailing list
Lazarus@lists.lazarus-ide.org
http://lists.lazarus-ide.org/listinfo/lazarus

Re: [Lazarus] TDBEdit, TStringField Size, DataSize, DisplayWidth and MaxLength

[LacaK via Lazarus]

I am aware of it. I have not added all other MBCS because ! I doubt, 
which are realy used nowadays.
My guess is that UTF-8 is far most used / supported as client 
character set.

No problem to add them if there will be real demand from users ...
Perhaps the correct answer is to let the database driver work this one 
out rather than have a fixed decision in the FCL.


I would suggest the following change:

function TStringField.GetDataSize: Integer;


My intention was made TStringField independent from TFieldDef, at least 
because we can have FieldDef=nil (for lookup, calculated fields)
Of course I can introduce class procedure (or regular procedure), with 
ACodePage parameter, which will be called from TStringField and 
TFieldDef, so all code will be in one place.





In IBX, I have already done this using TIBFieldDef and TIBStringField 
as subclasses in order to pass character set information. However, 
because TFieldDef.CreateField is non-virtual, the implementation is 
not as elegant as it should be. That is the extra info is added to the 
TIBStringField as the dataset is opened


I do not know IBX, but don't you use overriden 
TDataSet.InternalInitFieldDefs ? It will allow you put extra info into 
FieldDef and then use overriden TDataSet.CreateFields, which will allow 
you pass extra info from TIBFieldDef into TIBStringField for example ...

(AFAICS Zeos do it in this way also)

-Laco.

rather than when the field is created. It is also less maintainable as 
the functionality should be in TIBFieldDef rather than in a different 
class altogether.


Making those two methods virtual is the most important change. I can 
live with TStringField.GetDataSize as it is because that is already 
virtual and a future TIBStringField can readily override it.


Tony Whyman
MWA


-- 
___
Lazarus mailing list
Lazarus@lists.lazarus-ide.org
http://lists.lazarus-ide.org/listinfo/lazarus

Re: [Lazarus] Teaching Pascal at College

[LacaK via Lazarus]

I would also caution against starting on GUI programming too early.

+1
(few years ago I have teached programing on school in our city. I am not 
a techaer, but school lost teacher and was not able to find someone else)
I have used FreePascal + Lazarus for my courses, but we have used only 
project type of "Program" (so no LCL GUI), exactly for reasons what was 
mentioned.


I understand, that black/white window does not look modern. You can 
introduce 2 courses:

1. Introduction to Pascal (Object Pascal)
2. GUI programing

L.

--
___
Lazarus mailing list
Lazarus@lists.lazarus-ide.org
http://lists.lazarus-ide.org/listinfo/lazarus

Re: [Lazarus] TDBEdit, TStringField Size, DataSize, DisplayWidth and MaxLength

[LacaK via Lazarus]

> > Which FPC version is this likely to be released in?> 3.0.2 - no3.0.4 - ? 3.2.0 - yes> On a quick review of the code, all seems good. Just one point: >GetDataSize seems to acknowledge CP_UTF8 as the only multibyte >character set. The Firebird character set GB18030 (Chinese >characters) is multi-byte (see wikipedia) and has code page 54936. I >believe PostgreSQL also supports it.I am aware of it. I have not added all other MBCS because I doubt, 
 which are realy used nowadays.My guess is that UTF-8 is far most used / supported as client character set.No problem to add them if there will be real demand from users ...-Laco.
-- 
___
Lazarus mailing list
Lazarus@lists.lazarus-ide.org
http://lists.lazarus-ide.org/listinfo/lazarus

Re: [Lazarus] TDBEdit, TStringField Size, DataSize, DisplayWidth and MaxLength

[LacaK via Lazarus]

An IBX user came to me with a problem and the problem seems to be a 
deep seated disconnect between multi-byte character sets, 
TStringField.Size and TDBEdit.MaxLength. Something needs to give - but 
I am not sure what should.


Firstly documentation:

If you go back to Delphi, TField.DataSize is the memory needed to hold 
the Field's value. The DisplayWidth is the number of characters to be 
displayed, and Size is, for datatype ftstring, "the maximum number of 
characters in the string".

Right. TStringField.Size is size of characters, not bytes

How literally this last definition should be taken, I'm not sure, as 
it may well have been written assuming a single byte character set.


On the other hand, the FPC documentation is consistent with Delphi for 
DisplayWidth and DataSize, but more opaque for TField.Size where it is 
the "logical size" - whatever that means, although TStringField is 
more definitive by saying it is the maximum size (in characters) - 
their brackets not mine.


That seems to be consistent with TDBEdit.Maxlength which should be the 
maximum number of characters that can appear in the control and, if 
you look at the code, TDBEdit will source the default value from 
FDatalink.Size (And also seems to ignore DisplayWidth).

TDBEdit.MaxLength must correspond to TStringField.Size



The problem comes when you look at the code for TStringField.GetValue, 
where it starts off as:


function TStringField.GetValue(var AValue: string): Boolean;

var Buf, TBuf : TStringFieldBuffer;
DynBuf, TDynBuf : Array of char;

begin
  if DataSize <= dsMaxStringSize then
begin
Result:=GetData(@Buf);
Buf[Size]:=#0;  //limit string to Size
If Result then
  begin
...

Look at TRUNK, there is already changed code, which takes DataSize ;-)



If nothing else, this is a "bug in waiting". TStringField.GetDataSize 
always returns "Size+1", so "Buff[Size]:=#0; should work - but only as 
long as the virtual method "GetDataSize" is not overridden (GetValue 
is non-virtual) and Size is the byte length of the string!
in TRUNK is GetDataSize changed also, it takes into account Fields 
CharSet and for UTF8 returns 4*Size+1




There is a built-in assumption here that "Size" is the byte length of 
the string and not the character length.

this assumption came from old Delphi days, where it was so for SBCS

If you have a multi-byte character set and set size to the number of 
characters and DataSize to e.g. for UTF8 4*(no of characters)+1, then 
you will get string corruption as a result of the above.




IBX handles multi-byte character sets and does so by defining 
TIBStringField as a subclass of TStringFIeld and setting size to the 
byte length and the Default DisplayWidth to the character width. This 
is compatible with TStringField as it works today. It also seems to be 
compatible with TDBGrid, which uses Field.DisplayWidth. However, it 
does result in TDBEdit accepting too many characters.


What should be done?

It's a problem. Ideally, the TStringField code should be aligned with 
the documentation. However, that could break existing code and would 
need to handled carefully. TStringFIeld also needs fixing i.e. to 
Buf[DataSize-1]:=#0 in order to make this a reality.
Size must be character size (used for visual components if they handle 
characters)

DataSize must be byte size (used for record buffers to store character data)



Alternatively, the documentation could be amended to reflect the 
implementation. This means that TDBEdit (and maybe more) have to be 
updated - but why doesn't TDBEdit respect the DisplayWidth property 
anyway?


Perhaps, it is also about time that TStringField got a characterWidth 
property to hold the maximum number of bytes for each character. That 
would at least allow the DataSize to be automatically computed from 
the character width.

There is new TFieldDef.CharSize which says how many bytes is one character



If I had to write a bug report today, I would write it to avoid 
changes to IBX - but then is that the right answer?

Please look at changes in TRUNK.
May be that not all is perfect, but you will see there direction ...

-Laco.

--
___
Lazarus mailing list
Lazarus@lists.lazarus-ide.org
http://lists.lazarus-ide.org/listinfo/lazarus

[Lazarus] Jpeg Exif reader was: TImage shows loaded image rotated by 90?

[LacaK via Lazarus]

Attached improved code.
(as far as there is a lot of Exif tags, not all are parsed and placed in 
FExif record, but all are in FIFD array)

-Laco.


I have created small Exif reader for my own needs.
I have looked also in FCL TFPReaderJpeg (which uses pasjpeg) if there
is
no support, but I do not see.
If there would be interest for extending functionality of this reader
to
support reading of Exif information I can prepare patch.

Here is my simple implementation if somebody is interested:

unit JpegExif;

{$IFDEF FPC}
  {$mode objfpc}
{$ENDIF}
{$H+}

interface

uses
  Classes, SysUtils;

type

  { TJpegExifReader }

  TJpegExifReader = class
private
  type
TIFDEntry = record
  TagNo: Word;
  DataType: Word;
  Count: DWord;
  Value: DWord; // This  tag  records  the  offset  from  the  start  
of  the  TIFF  header  to  the  position  where  the  value  itself  is  
recorded.
// In cases where the value fits in 4 bytes, the value 
itself is recorded. If the value is smaller than 4 bytes, the value is stored 
in the 4-byte area starting from the left, i.e., from the lower end
end;

TExifData = record
  Make,
  Model,
  Software,
  DateTime,
  Artist: string;
  Orientation: smallint;
  XResolution,
  YResolution: double;
  ResolutionUnit: smallint;
  ExposureTime: double;
  FNumber: double;
  ColorSpace: Word;
  ImageUniqueID: string;
end;

  var
FBA: Word;

  function Swap(w: Word): Word; overload;
  function Swap(dw: DWord): DWord; overload;
public
  FIFD: array of TIFDEntry;
  FExif: TExifData;
public
  constructor Create(const FileName: string); overload;
  constructor Create(Stream: TFileStream); overload;

  function Orientation: smallint;
  function XResolution: double;
  function YResolution: double;
  function ResolutionUnit: string;
  function DateTime: TDateTime;
  end;


implementation

{ TJpegExifReader }

function TJpegExifReader.Swap(w: Word): Word;
begin
  if FBA = $4D4D then
// Motorola align: first byte in data is highest byte (big endian)
Result := BEtoN(w)
  else
// Intel align: first byte in data is lowest byte (little endian)
Result := LEtoN(w);
end;
function TJpegExifReader.Swap(dw: DWord): DWord;
begin
  if FBA = $4D4D then
Result := BEtoN(dw)
  else
Result := LEtoN(dw);
end;

constructor TJpegExifReader.Create(const FileName: string);
var
  Stream: TFileStream;
begin
  Stream := TFileStream.Create(FileName, fmOpenRead+fmShareDenyWrite);
  try
Create(Stream);
  finally
Stream.Free;
  end;
end;

constructor TJpegExifReader.Create(Stream: TFileStream);
type
  TRATIONAL=record
numerator: dword;
denominator: dword;
  end;

var
  b: Byte;
  w, Marker, Size: Word;
  dw: DWord;
  i,c: Integer;
  S: AnsiString;
  R: TRATIONAL;
  D: Double;

  function ReadIFD(Offset: DWord): integer;
  var i,j: integer;
  begin
Stream.Position := 12 + Offset;
Stream.Read(w, SizeOf(w)); // No of IFD entries
Dec(Size, 2);
Result := Swap(w);
j := Length(FIFD);
SetLength(FIFD, j+Result);
// Read IFD entries
for i:=j to j+Result-1 do begin
  Stream.Read(FIFD[i], SizeOf(TIFDEntry));
  Dec(Size, SizeOf(TIFDEntry));
  FIFD[i].TagNo:= Swap(FIFD[i].TagNo);
  FIFD[i].DataType := Swap(FIFD[i].DataType);
  FIFD[i].Count:= Swap(FIFD[i].Count);
end;
Stream.Read(dw, SizeOf(dw));   // Offset to next IFD (0=last)
  end;

begin
  inherited Create;

  Stream.Position := 0;
  Stream.Read(w,SizeOf(w));
  if w <> NtoLE($D8FF) then Exit;  // 0-1: Jpeg SOI (Start of image: FFD8)
  Stream.Read(Marker, SizeOf(w));  // 2-3: Application marker
  Stream.Read(Size, SizeOf(Size)); // 4-5: Size of APP1 data area (high 
byte first)
  Size := BEtoN(Size);
  Dec(Size, 2);
  Stream.Read(dw, SizeOf(dw)); // 6-9: 'Exif' of 'JFIF'
  Dec(Size, 4);
  // APP0 (Application marker: FFE0) and 'JFIF'
  if (Marker = NtoLE($E0FF)) and (dw = NtoLE($4649464A)) then
begin
Stream.Read(b, 1); // 10: 0
Stream.Read(w, SizeOf(w)); // 11-12: JFIF version
Stream.Read(b, 1); // 13: Density units (1-in, 2-px)
FExif.ResolutionUnit := b+1;
Stream.Read(w, SizeOf(w)); // 14-15: XDensity
FExif.XResolution := BEtoN(w);
Stream.Read(w, SizeOf(w)); // 16-17: YDensity
FExif.YResolution := BEtoN(w);
end
  // APP1 (Application marker: FFE1) and 'Exif'
  else if (Marker = NtoLE($E1FF)) and (dw = NtoLE($66697845)) then
begin
Stream.Read(w, SizeOf(w));
if w <> NtoLE($) then Exit;// 10-11: 
Dec(Size, 2);
// TIFF header
Stream.Read(FBA, SizeOf(FBA)); // 12-13: byte order
if (FBA<>$4949) and (FBA<>$4D4D) then Exit; // 4949=Intel, 4D4D=Motorola

Re: [Lazarus] TLazIntfImage.Assign ?

[LacaK via Lazarus]

IMO it can be removed - obviously there are not any side
effects any more.

Ok, I will remove it ...

Thanks ;-)
-Laco
--
___
Lazarus mailing list
Lazarus@lists.lazarus-ide.org
http://lists.lazarus-ide.org/listinfo/lazarus

[Lazarus] TLazIntfImage.Assign ?

[LacaK via Lazarus]

Hi,

Please look at implementation :

procedure TLazIntfImage.Assign(Source: TPersistent);
var
  Src: TLazIntfImage;
  Desc: TRawImageDescription;
begin
  if Source is TLazIntfImage then begin
  Src:=TLazIntfImage(Source);
  Desc:=Src.DataDescription;
  Desc.Width:=0; // avoid side effects
  Desc.Height:=0; // avoid side effects
  DataDescription:=Src.DataDescription;
  end;
  inherited Assign(Source);
end;

Why we set Desc.Width and Height to 0 and later we do not use "Desc" , 
but "Src.DataDescription" ?


-Laco.

--
___
Lazarus mailing list
Lazarus@lists.lazarus-ide.org
http://lists.lazarus-ide.org/listinfo/lazarus

Re: [Lazarus] TImage shows loaded image rotated by 90?

[LacaK via Lazarus]

I have created small Exif reader for my own needs.
I have looked also in FCL TFPReaderJpeg (which uses pasjpeg) if there 
is no support, but I do not see.
If there would be interest for extending functionality of this reader 
to support reading of Exif information I can prepare patch.


There is interest :)


Hm, looking deeper into TFPCustomImageReader architecture intention of 
such readers is constitute TFPCustomImage.
Now I am not sure where metadata (Exif) should go ? (As far as 
TFPCustomImage holds only true image data)


I can extend TFPReaderJpeg, by adding boolean option ("ReadExif") either 
to constructor or as a standalone property, which will signal to reader 
if read also this kind of data.
If set to true then in "InternalRead" I can read from supplied stream 
and store them in record inside TFPReaderJpeg ... so user must ask 
reader later to obtain exif data


Or do not touch TReaderJpeg and add only new "helper" class which will 
read from supplied stream exif data (just as in source which I have 
attached to my prior mail)


What do you prefer ?

-Laco.

--
___
Lazarus mailing list
Lazarus@lists.lazarus-ide.org
http://lists.lazarus-ide.org/listinfo/lazarus

Re: [Lazarus] TImage shows loaded image rotated by 90?

[LacaK via Lazarus]

I have created small Exif reader for my own needs.
I have looked also in FCL TFPReaderJpeg (which uses pasjpeg) if there is 
no support, but I do not see.
If there would be interest for extending functionality of this reader to 
support reading of Exif information I can prepare patch.


Here is my simple implementation if somebody is interested:


  { TJpegExifReader }

  TJpegExifReader = class
private
  type
TIFDEntry = record
  TagNo: Word;
  DataType: Word;
  Count: DWord;
  Value: DWord; // This  tag  records  the  offset  from the  
start  of  the  TIFF  header  to  the  position  where  the value  
itself  is  recorded.
// In cases where the value fits in 4 bytes, 
the value itself is recorded. If the value is smaller than 4 bytes, the 
value is stored in the 4-byte area starting from the left, i.e., from 
the lower end

end;

TExifData = record
  Make,
  Model,
  Software,
  DateTime: string;
  Orientation: smallint;
  XResolution,
  YResolution: double;
  ResolutionUnit: smallint;
end;

  var
FBA: Word;

  function Swap(w: Word): Word; overload;
protected
  FIFD: array of TIFDEntry;
  FExif: TExifData;
public
  constructor Create(const FileName: string); overload;
  constructor Create(Stream: TFileStream); overload;

  function Orientation: smallint;
  function XResolution: double;
  function YResolution: double;
  function ResolutionUnit: string;
  function DateTime: TDateTime;
  end;

{ TJpegExifReader }

function TJpegExifReader.Swap(w: Word): Word;
begin
  if FBA = $4D4D then
// Motorola align: first byte in data is highest byte (big endian)
Result := BEtoN(w)
  else
// Intel align: first byte in data is lowest byte (little endian)
Result := LEtoN(w);
end;

constructor TJpegExifReader.Create(const FileName: string);
var
  Stream: TFileStream;
begin
  Stream := TFileStream.Create(FileName, fmOpenRead+fmShareDenyWrite);
  try
Create(Stream);
  finally
Stream.Free;
  end;
end;

constructor TJpegExifReader.Create(Stream: TFileStream);
type
  TRATIONAL=record
numerator: dword;
denominator: dword;
  end;
var
  w, Size: word;
  dw: dword;
  n,i,c: integer;
  S: AnsiString;
  R: TRATIONAL;
  D: double;
begin
  inherited Create;

  Stream.Position := 0;
  Stream.Read(w,SizeOf(w));
  if w <> NtoLE($D8FF) then Exit;  // 0-1: Jpeg SOI (Start of 
image: FFD8)

  Stream.Read(w, SizeOf(w));
  if w <> NtoLE($E1FF) then Exit;  // 2-3: APP1 (Application 
marker: FFE1)
  Stream.Read(Size, SizeOf(Size)); // 4-5: Size of APP1 data area 
(high byte first)

  Size := BEtoN(Size);
  Dec(Size, 2);
  // Exif
  Stream.Read(dw, SizeOf(dw));
  if dw <> NtoLE($66697845) then Exit; // 6-9: 'Exif'
  Stream.Read(w, SizeOf(w));
  if w <> NtoLE($) then Exit;  // 10-11: 
  Dec(Size, 6);
  // TIFF header
  Stream.Read(FBA, SizeOf(FBA));   // 12-13: byte order
  if (FBA<>$4949) and (FBA<>$4D4D) then Exit; // 4949=Intel, 4D4D=Motorola
  Stream.Read(w, SizeOf(w));
  if Swap(w) <> $002A then Exit;   // Tag Mark
  Stream.Read(dw, SizeOf(dw)); // Offset to first IFD (usualy 8)
  Dec(Size, 8);

  // IFD: Image file directory
  SetLength(FIFD, 0);
Stream.Read(w, SizeOf(w)); // No of IFD entries
Dec(Size, 2);
n := Swap(w);
SetLength(FIFD, Length(FIFD)+n);
// Read IFD entries
for i:=0 to n-1 do begin
  Stream.Read(FIFD[i], SizeOf(TIFDEntry));
  Dec(Size, SizeOf(TIFDEntry));
end;
Stream.Read(dw, SizeOf(dw));   // Offset to next IFD (0=last)

  // Parse IFD entries
  for i:=0 to n-1 do begin
case Swap(FIFD[i].DataType) of
  1: w:=1; // unsigned byte
  2: w:=1; // ascii string (terminated with 0)
  3: w:=2; // unsigned short (2 bytes)
  4: w:=4; // unsigned long (4 bytes)
  5: w:=8; // unsigned rational (4+4 long)
  else w:=1;
end;
c := w * Swap(FIFD[i].Count);

if c > 4 then begin
  // Value contains offset from TIFF header to data
  Stream.Position := 12 + Swap(FIFD[i].Value);
  case Swap(FIFD[i].DataType) of
2: begin
   Dec(c);
   SetLength(S, c);
   Stream.Read(S[1], c);
   end;
5: begin
   Stream.Read(R, SizeOf(R));
   D := R.numerator / R.denominator;
   end;
  end;
end
else
  case Swap(FIFD[i].DataType) of
3: w := Swap(FIFD[i].Value);
  end;

case Swap(FIFD[i].TagNo) of
  $010F: FExif.Make := S;
  $0110: FExif.Model := S;
  $0112: FExif.Orientation := w;
  $011A: FExif.XResolution := D;
  $011B: FExif.YResolution := D;
  $0128: FExif.ResolutionUnit := w;
  $0131: FExif.Software := S;
  $0132: FExif.DateTime := S;
  $8769: // offset to