Re: [Lazarus] DBGrid displays Float as integer
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
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
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
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
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
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
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
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
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?
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
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
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
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
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
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
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] Lazarus and Windows 10 IoT
Hi, 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 ?) Thanks -Laco. -- ___ Lazarus mailing list Lazarus@lists.lazarus-ide.org http://lists.lazarus-ide.org/listinfo/lazarus
Re: [Lazarus] Request for apply patch
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. There's no Server and Port entries in such dialog ? As far as I can say there are not. See also http://docwiki.embarcadero.com/Libraries/Seattle/en/Vcl.DBLogDlg.LoginDialogEx Server and Port you must specify in TSQLConnection component. When LoginPrompt is also set then DBLogin dialog registered in callback LoginDialogExProc will be called upon connecting ... asking from user UserName and Password. But if there will be demand for such functionality I think, we can add extended dialog ... but it will require more work (at least add also Database input box not only Server and Port and pass parameters forth and back to original TSQLConnection component) L. -- ___ Lazarus mailing list Lazarus@lists.lazarus-ide.org http://lists.lazarus-ide.org/listinfo/lazarus
[Lazarus] Request for apply patch
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
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
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
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
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
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
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
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
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
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
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
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 ? -Laco. -- ___ Lazarus mailing list Lazarus@lists.lazarus-ide.org http://lists.lazarus-ide.org/listinfo/lazarus
Re: [Lazarus] TThread.Synchronize
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
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
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: I remember in Delphi, I sometimes have to call CoInitialize and CoUninitialize. Not sure if FPC has to do the same. Have you tried that? I did debuging in Delphi looking at what is called and I have found, that when I add two other lines it works!: var Unknown: IUnknown; PersistStreamInit: IPersistStreamInit; begin Unknown := CreateComObject(CLASS_ScSamlightClientCtrl); // these two lines are necessary: OleCheck(Unknown.QueryInterface(IPersistStreamInit, PersistStreamInit)); OleCheck(PersistStreamInit.InitNew); FSamlightClientCtrl := Unknown as ScSamlightClientCtrl; ... end; I have no idea why they are needed, but may be that they perform some initialization of component ... I also wonder if other users can suffer from it ? -Laco. -- ___ Lazarus mailing list Lazarus@lists.lazarus-ide.org http://lists.lazarus-ide.org/listinfo/lazarus
Re: [Lazarus] ActiveX, TOLEControl
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
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
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
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
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
> > 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
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?
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 Strea
Re: [Lazarus] TLazIntfImage.Assign ?
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 ?
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?
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?
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 Exi