Login
Username:

Password:

Remember me



Lost Password?

Register now!
Main Menu
Who's Online
16 user(s) are online (13 user(s) are browsing Forum)

Members: 0
Guests: 16

more...

Browsing this Thread:   1 Anonymous Users



« 1 (2) 3 4 »


Chapter 2: Good programming habbits makes ... havoc ?

Joined:
2011/6/30 19:50
Group:
Member
Posts: 2762
Offline
Chapter 2: Good programming habbits makes ... havoc ?

Please also take a look at:
- The Lazarus documentation
- A small intro called "Developing a GUI Application with Lazarus" in english by some dutch guy.
- ALB42's blog for his progress
- azvareths blog for a more graphical approach


This chapter is about:
- some LCL stuff working out-of-the-box.
- i do not understand AROS' shell
- even LCL components can have bad design

One of the first thing a programmer _should_ do is inform himself about what is happening around in his code. Even more, the user should know that also, so the user can return informative information to the developer when things goes wrong. Well, that is the theoretical part
IMHO in practice it mostly means the developer (not you ofcourse) codes and releases the project and the user is often stuck with bad programming habbits and erraneous programs. The user complains and the developer implement workarounds or, in the worst case is unable to determine his mistakes. Yeah yeah i know i have a weird look on things

Why do i tell all this ?

LCL has a nice component that can inform both developer and user about what happens in the program. This component is called TLogEvent.
AFAIK the component originates from the Windows platform, enabling the programmer to log events into windows event-database. Because it has found its way into the LCL it was adjusted so it could also write to a file on disk instead of into the event-database.

That's why i asked myself: Wouldn't it be nice to have something like that in FPC AROS ? It sure beats all those writeln's.

So i started testing and it turns out the component works. I did not see ALB42 mentioning anything about this component, so my guess is it's a native lcl component (depending only on internal fpc/lcl code) that works out-of-the-box when the code is compiled.

That having said i also mention some caveats upfront. They are:

- The logfile in which the events are being logged is continously in a 'open'-state. This means that when your application crashes the logfile is almost always being destroyed in the process. Not only that, it could also mean that during the crash-process the logger is trying to write something to the file resulting in complete drive-havoc. This kind of behaviour is IMHO very bad, and should absolutely not being used. But i am not a lazarus developer.

- You have to update your FPC installation, using at least the version dated 26/07/2011 because otherwise the component is unable to write the correct date into the logfile. Luckily for us ALB42 fixed that :thumbsup: plus he added new cool things :even cooler: to try out yourself :sowhatareyouwaitingfor?:

In the mean while the good news is that the component is usable, in that it log messages into a logfile so your messages can be added and logged.

When compiling my project, i noticed that FPC was presenting me with a new message. The message itself is not so important, but i thought it would be nice to copy that message into a document for reference. So i looked at the shell-menu and under the review menu i could find a menu entery called "save as plain text". So my initial thought was ok, so i can copy the contents of the whole shell into a file on disk. That would be one nice feature to have indeed. So i tried and tried. It just does not work for me. Does anyone knows if this is supppose to work on a vanilla icaros 1.3.1 installation ?

So how do we use this component ?

1) Startup lazarus and create a new application.
2) On the form drop a TEventlog Component (you can find it under the system tab)
3) Just to be sure, change the LogType in the properties panel of the objectinspector from ltSystem into ltFile
4) Using the object inspector add 2 events to the main form .OnCreate and .OnDestroy.
5) Add the line EventLog1.Info('AnyMessageYouLike'); to both Events.
6) Compile and run

That shoud be easy enough

The actions described above should result in something like this:

unit Unit1

{
$mode objfpc}{$H+}

interface

uses
  Classes
SysUtilseventlogFileUtilFormsControlsGraphicsDialogs;

type

  
TForm1 }

  
TForm1 = class(TForm)
    
EventLog1TEventLog;
    
procedure FormCreate(SenderTObject);
    
procedure FormDestroy(SenderTObject);
  private
    { private 
declarations }
  public
    { public 
declarations }
  
end

var
  
Form1TForm1

implementation

{$R *.lfm}

TForm1 }

procedure TForm1.FormCreate(SenderTObject);
begin
  EventLog1
.Info('A Form Was Created');
end;

procedure TForm1.FormDestroy(SenderTObject);
begin
  EventLog1
.Info('A form Was Destroyed');
end;

end.



In order to make this component a bit more explanetory i have made a little example which basicly shows the same thing but a bit more practical. It has comments and all, so that i am able to bore people even more

If one would adapt this example then it could even be used in order to aid ALB42 in his development as you can checkout which events and properties are working correctly in the AROS version.

If you checkout this example on both windows and AROS you will notice that e.g. the MouseEnter and MouseLeave events are not fired in AROS. If this would be desirable or even possible is a completely other matter ofcourse.

So, i will shutup now and paste my code into here for others to see, use and abuse Just to make things clear: i do not take any responsibility whatsoever !!

First the Project file:

program project1;

{
$mode objfpc}{$H+}

uses
  
{$IFDEF UNIX}{$IFDEF UseCThreads}
  
cthreads,
  {
$ENDIF}{$ENDIF}
  
Interfaces// this includes the LCL widgetset
  
FormsMainUnit
  
you can add units after this };

{
$R *.res}

begin
  Application
.Initialize;
  
Application.CreateForm(TfrmMainfrmMain);
  
Application.Run;
end.


Secondly here is the Main Form's layout:

object frmMainTfrmMain
  Left 
312
  Height 
100
  Top 
189
  Width 
193
  Caption 
'EventLog Example'
  
ClientHeight 81
  ClientWidth 
193
  Menu 
MainMenu1
  OnActivate 
FormActivate
  OnClick 
FormClick
  OnCreate 
FormCreate
  OnDeactivate 
FormDeactivate
  OnDestroy 
FormDestroy
  OnMouseEnter 
FormMouseEnter
  OnMouseLeave 
FormMouseLeave
  LCLVersion 
'0.9.30'
  
object btnDoNotPressMeTButton
    Left 
40
    Height 
23
    Top 
40
    Width 
107
    AutoSize 
True
    Caption 
'Do Not Press Me'
    
OnClick btnDoNotPressMeClick
    TabOrder 
0
  end
  object edtEdit
TEdit
    Left 
40
    Height 
21
    Top 
8
    Width 
104
    OnEditingDone 
edtEditEditingDone
    TabOrder 
1
    Text 
'Type Something'
  
end
  object EventLog1
TEventLog
    LogType 
ltSystem
    Active 
False
    RaiseExceptionOnError 
False
    DefaultEventType 
etCustom
    CustomLogType 
0
    EventIDOffset 
0
    left 
152
    top 
8
  end
  object MainMenu1
TMainMenu
    left 
8
    top 
8
    object mnuApplication
TMenuItem
      Caption 
'Application'
      
object mnsLogTMenuItem
        Caption 
'Log'
        
object mniLogWarningTMenuItem
          Caption 
'Warning'
          
OnClick mnsLogClick
        end
        object mniLogError
TMenuItem
          Caption 
'Error'
          
OnClick mnsLogClick
        end
        object mniDebug
TMenuItem
          Caption 
'Debug'
          
OnClick mnsLogClick
        end
        object mniLogInfo
TMenuItem
          Caption 
'Info'
          
OnClick mnsLogClick
        end
      end
      object mniDump
TMenuItem
        Caption 
'Dump MainForm into LogFile'
        
OnClick mniDumpClick
      end
      object MenuItem1
TMenuItem
        Caption 
'-'
      
end
      object mniQuit
TMenuItem
        Caption 
'Quit'
        
OnClick mniQuitClick
      end
    end
  end
end




Then the Main Unit

{
Title  Just _an_ example on how to log events using TEventLog
Author 
Magorium
Date   
31 juli 2011
Note   
: Use and abuse at your own risk.
===============================================================================
This is an example for testing ALB42's version of Freepascal + LCL for/on AROS.

It shows how to use the TEventlog Component. The functionality of this
component can be incoorporated into real life applications and could
be a helpfull tool when it comes to debugging the application.

The example proves that some of the LCL components components can be used
out-of-the-box without being adapted especially for AROS. This '
feature' comes
from the fact that some components are written platform-independently and
therefore do not need to be adapted for AROS. This is for example also true
for the TAction-, TActionList- and TDatamodule -components. although not all
functionality has been verified.

This example also shows how the published properties of a component can be
converted into a string.
}


unit MainUnit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, eventlog, FileUtil, Forms, Controls, Graphics, Dialogs,
  StdCtrls, Menus;

type

  { TfrmMain }

  TfrmMain = class(TForm)
    // Form'
s menu
    MainMenu1
TMainMenu;
    
mniDumpTMenuItem;
    
mnuApplicationTMenuItem;
    
mnsLogTMenuItem;
    
mniLogWarningTMenuItem;
    
mniLogErrorTMenuItem;
    
mniDebugTMenuItem;
    
mniLogInfoTMenuItem;
    
MenuItem1TMenuItem;    // --
    
mniQuitTMenuItem;
    
// Form's Components
    
btnDoNotPressMeTButton;
    
edtEditTEdit;
    
EventLog1TEventLog;
    
// Form-events
    
procedure FormCreate(SenderTObject);
    
procedure FormDestroy(SenderTObject);
    
procedure FormActivate(SenderTObject);
    
procedure FormDeactivate(SenderTObject);
    
procedure FormMouseEnter(SenderTObject);
    
procedure FormMouseLeave(SenderTObject);
    
procedure FormClick(SenderTObject);
    
procedure mniDumpClick(SenderTObject);
    
procedure mniQuitClick(SenderTObject);
    
// Menu-Events
    
procedure mnsLogClick(SenderTObject);
    
// form component-events
    
procedure btnDoNotPressMeClick(SenderTObject);
    
procedure edtEditEditingDone(SenderTObject);
  private
    { private 
declarations }
  public
    { public 
declarations }
  
end

var
  
frmMainTfrmMain;

implementation

{$R *.lfm}

Var
  
EL TEventLog;

TfrmMain }



// ============================================================================
//
//        Helper Routines
//
// ============================================================================



Function ConvertComponentToString(ComponentTComponent): String;
//
// Convert properties of Component to Result string
//
var
  
ComponentStream TMemoryStream;
  
StringStream TStringStream;
  
String;
begin
  ComponentStream 
:= TMemoryStream.Create;
  try
    
StringStream := TStringStream.Create(s);
    Try
      
ComponentStream.WriteComponent(Component);
      
ComponentStream.Seek(0soBeginning);
      
ObjectBinaryToText(ComponentStreamStringStream);
      
StringStream.Seek(0soFromBeginning);
      
Result := StringStream.DataString;
    
finally
      StringStream
.Free;
    
end;
  
finally
    ComponentStream
.Free;
  
end;
end;



// ============================================================================
//
//        Form Events
//
// ============================================================================



procedure TfrmMain.FormCreate(SenderTObject);
begin
  EL 
:= Self.EventLog1;             // use a litle shortcut to access EventLog1
  
EL.Active := false;               // make sure Eventlog is inactive

  
{
  
initialize here other settings of the eventlog component:

  
Properties are:
  - .
appendcontent would enable to add to the logfile instead of rewriting on
     every start of the application
Alas it is currently not implemented in my
     version of lazarus
.
  - .
Identification can be set (defaults to application.exename when empty)
  - .
logtype is used to write events into eventdatabase or to fileIt cannot
     be changed when the log is activated
.
  - .
active activates/disactivates the actual loggingBe aware that this
     rewrites the log file on disk at each activation 
(If .appendcontent is
     missing fromlazarus
).
  - .
raiseexceptiononerror raises an exception if something went wrong writing
     to the logfile
.
  - .
defaulteventtype is only used by the various "log" functions of the
    component
It Defaults to etCustomThis means that if you use one of the
    log
() functions it will use the custom messagesE.gchanging this to
    etInfo let the log
() function put out a Info message to the logfile.
  - .
filename of the logfile that can be changed when logging is inactiveIt
     raises an exception when trying on an active logfile
.
  - .
TimeStampFormat can be adjusted to own preference
  
(* IGNORE AS IT IS MWINDOWS ONLY
  
- .Customlogtype

  custom messages setup using the components events
  
- .OnGetCustomCategory
  
- .OnGetCustomEventID
  
- .InGetCustomEvent
  
*)
  }
  
EL.Identification := 'My Experiment with TEventLog';
  
EL.LogType := ltFile;             // make events being logged to file
  
EL.DefaultEventType := etInfo;    // set default etInfo event
  
EL.Active := True;                // now that everything is setup, activate

  
EL.Log(Self.name ' Create');    // log a messaga into the log
end;


procedure TfrmMain.FormDestroy(SenderTObject);
begin
  EL
.Log(Self.name ' Destroy');   // log a message into the logfile
  
EL.Active := False;               // just to be sure deactivate logging
end;


procedure TfrmMain.FormActivate(SenderTObject);
begin
  EL
.Log(Self.name ' Activate');  // log event into file
end;


procedure TfrmMain.FormDeactivate(SenderTObject);
begin
  EL
.Log(Self.name ' Deactivate'); // log event into file
end;


procedure TfrmMain.FormMouseEnter(SenderTObject);
begin
  EL
.Log(Self.name ' MouseEnter');  // log event into file
end;


procedure TfrmMain.FormMouseLeave(SenderTObject);
begin
  EL
.Log(Self.name ' MouseLeave');  // log event into file
end;


procedure TfrmMain.FormClick(SenderTObject);
begin
  EL
.Log(Self.name ' Click');       // log event into file
end;



// ============================================================================
//
//        Menu Events
//
// ============================================================================



procedure TfrmMain.mnsLogClick(SenderTObject);
begin
  
// selected one of the menuitems of submenu Log

  // Determine which menu-item was activated
  
Case (sender as TMenuItem).MenuIndex of
    0 
El.Warning('User selected Warning from menu');  // mniLogWarning
    
El.Error('User selected Error from menu');      // mniLogError
    
El.Debug('User selected Debug from menu');      // mniLogDebug
    
El.Info('User selected Info from menu');        // mniLogInfo
    
else begin                                          // something went wrong
      
EL.Error('%s menuindex %d is beyond recognition',
               [(
Sender as TComponent).name,(sender as TMenuItem).MenuIndex]);
      exit;
    
end;
  
end;

  
ShowMessage('Message was written into log');   // show inforative msg to user
end;


procedure TfrmMain.mniDumpClick(SenderTObject);
Var 
SString;
begin
  
// Dumps a component to logfile
  
El.Log('-=-=-=-==-==-=-= begin dump =-=-=-==-==-=-=-');// log event into file
  
:= ConvertComponentToString(Self);                   // convert cmp 2 str
  
El.Log(S);                                             // dump cmp into file
  
El.Log('-=-=-=-==-==-=-=  end dump  =-=-=-==-==-=-=-');// log event into file
  
ShowMessage('The Main Form was dumped into the log');  // show a message
end;


procedure TfrmMain.mniQuitClick(SenderTObject);
begin
  Close
;
end;



// ============================================================================
//
//        Other Component Events
//
// ============================================================================



procedure TfrmMain.btnDoNotPressMeClick(SenderTObject);
begin
  EL
.Warning('User has low IQ or bad reading skills');   // log event into file
  
Application.Terminate;
end;


procedure TfrmMain.edtEditEditingDone(SenderTObject);
begin
  EL
.Info('%s User entered %s',[(Sender as TEdit).Name,(Sender as TEdit).Text]);
end;


end.




And finally i attached a little picture of my example at the bottom

(red: removed typo from project file)

Attach file:



png  TestEventsPicture.png (4.51 KB)
2666_4e35ae5e07599.png 201X127 px

Posted on: 2011/7/31 12:34

Edited by magorium on 2011/7/31 15:33:30
Edited by magorium on 2011/7/31 15:34:17
Transfer the post to other applications Transfer


Re: Magical Empire of FPC and Lazarus #1

Joined:
2011/7/27 8:24
From Sweden
Group:
Member
Posts: 70
Offline
nice...

That could be usable...

Thanks for pointing that out... I think I will use it...

Posted on: 2011/7/31 13:37
_________________
http://aros-fpc.blogspot.com/
Transfer the post to other applications Transfer


Re: Magical Empire of FPC and Lazarus #1

Joined:
2011/6/30 19:50
Group:
Member
Posts: 2762
Offline
Quote:
Thanks for pointing that out...


No problemo. Just another component that can be used.

Still figuring out what can and can't be used. it would be nice to create a list of some sort. Alas, too many things at once.

BTW: how is your calculator coming along ? Any time soon we can admire it on aminet or aros archives ? Or do you just leave it on your blog ?

Posted on: 2011/7/31 14:38
Transfer the post to other applications Transfer


Re: Magical Empire of FPC and Lazarus #1

Joined:
2011/7/27 8:24
From Sweden
Group:
Member
Posts: 70
Offline
well... it is just as everything else there, a test app...

I could post it on my blog, and let it be for the other "beginners" to "fix" the missing parts...

I put it there when I have the time... tomorrow perhaps?

missing stuff!
Windows resize from app... normal <-> programmer mode
Binary and logical op (aka it is a basic calc now)
? more ?

weird stuff
See video at blog...



Posted on: 2011/8/1 10:40
_________________
http://aros-fpc.blogspot.com/
Transfer the post to other applications Transfer


Re: Magical Empire of FPC and Lazarus #1

Joined:
2011/6/30 19:50
Group:
Member
Posts: 2762
Offline
Hi, Anonymous_Coward

Quote:
well... it is just as everything else there, a test app...


Perhaps, but it is getting more advanced then default zunecalc calculator

Quote:
I could post it on my blog, and let it be for the other "beginners" to "fix" the missing parts...
I put it there when I have the time... tomorrow perhaps?


Please do not rush on my account. I just thought it can be a good idea to actually show to others that fpf + lcl can be used for developing tools that actually work.
Unfortunately i have no time todo such things atm.

Quote:
missing stuff!
Windows resize from app... normal <-> programmer mode
Binary and logical op (aka it is a basic calc now)
? more ?


Dunno, you tell me
I take it you already tried to solve things ? Or is lack of time the main thing here ? Alas also some things are still missing in lcl... i know...

Just in case. If you distribute the executable, do not forget to set optimalization and when compiled to use the strip command.

hmz, come to think of it that probably deserves a complete chapter . How to optimize things etc...

cu

Posted on: 2011/8/1 11:00
Transfer the post to other applications Transfer


Re: Magical Empire of FPC and Lazarus #1

Joined:
2011/4/18 7:10
From Germany
Group:
Member
Posts: 239
Offline
Nice Work...

hmm yes of course, Components which do not need the GUI should work already.
I'm thinking about a test suite for easier development, like FPCUnit.

Posted on: 2011/8/2 10:04
Transfer the post to other applications Transfer


Re: Magical Empire of FPC and Lazarus #1

Joined:
2011/6/30 19:50
Group:
Member
Posts: 2762
Offline
Quote:
hmm yes of course, Components which do not need the GUI should work already.


So if i take that literally then i read that i should be able to create a daemonapp ?

Posted on: 2011/8/6 19:45
Transfer the post to other applications Transfer


Chapter 3: Getting to know things

Joined:
2011/6/30 19:50
Group:
Member
Posts: 2762
Offline
Other suggested and interresting places:
- The Lazarus reference documentation
- Lazarus (IDE) tutorial for beginners
- ALB42's blog for his progress of FPC+LCL
- HEA's blog for examples, pictures and his experiences


Chapter 3: Getting to know things.

This chapter is about:
- another lcl component working out-of-the-box
- a little hidden surprise
- some usefull functions
- conditional compiling


This time just more interresting things to discover. So, what is it about this time ?

Well, if you are like me when it comes to developing tools and utilities, chances are that there are a bunch of variables nicely tucked away somewhere. Mostly created in a hurry with some default values stored in them. Eventually there comes a point that some of those variables need to have some more influence on the program and need some sort of manipulation. I guess changing them visually should not be too much of a problem with using such a RAD tool like lazarus. But what to do with those changes ? How do you keep those changes permantly ? What to do with such things as e.g. the last chosen directory by the user ?

Well, normally we write them to disk for a more permanent storage. So we will. But how todo that ?

There are numerous paths that can be chosen. We can write things to disk the old fashioned filewrite way, or one could use a little more modern Filestream to do that. Or should we perhaps use an inifile ?
Nah, almost every program these days uses XML for that sort of things. Do not ask me why, because i have absolutely no clue whatsoever. So with this chapter we will step into the twilight-zone called xml.

So let's start:
1) Create a new application
2) Drop a TXMLConfig component on top of the form (system tab).
3) Drop a button on the form
4) add events Form.OnCreate, Form.OnDestroy and Button.OnClick
5) add some code, so that things look something like this:

Var
  
ConfigFilenameString;
  
ButtonPressCounter Integer;

procedure TForm1.FormCreate(SenderTObject);
begin
  ConfigFileName 
:= ExtractFilePath(Application.exename) + 'mysettings.xml';
  
XMLConfig1.filename := ConfigFilename;

  
ButtonPressCounter := 0;
  
ButtonPressCounter := XMLConfig1.GetValue(XMLButtonPathButtonPressCounter);

  
Button1.Caption:= 'Pressed ' IntToStr(ButtonPressCounter);
end;

procedure TForm1.FormDestroy(SenderTObject);
begin
  
if XMLConfig1.modified then
  begin
    XMLConfig1
.Flush;
  
end;
end;

procedure TForm1.Button1Click(SenderTObject);
begin
  Inc
(ButtonPressCounter);
  
XMLConfig1.SetValue(XMLButtonPathButtonPressCounter);
  (
Sender as TButton).Caption := 'Pressed ' IntToStr(ButtonPressCounter);
end;


So, what does all this do ?

Everytime the button is pressed a value of a counter is being increased. Then this value is being stored by using the XMLConfig component.
If the form get's destroyed the contents of the XMLConfig component get's flushed onto disk (Actually the component does that on it's own already so the code in the .OnDestroy event could have been omitted, but it shows how to do it on demand).
Now that all this have been done we only have to restore the last known value from disk when the form is created. The value of ButtonPressCounter is being stored and restored to disk in a xml file, so each time you start this application the application will present the last used value of ButtonPressCounter.
Oh, before i forget: i use an older version of lazarus to develop and i noticed fpc for aros complaining something about unit XMLCfg and symbol TXMLConfig being deprecated. Just ignore like i did. As long as things work, they work

Also my distribution of lazarus came with a more comprehensive example and can be found in the fcl-base examples directory. Perhaps you can take a look there to learn more. And for the ones who payed a little attention, this component has a small hidden surprise tucked away called DOM. Yes, a complete DOM-parser is at your disposal to use and abuse

There are some other interresting functions tucked away in lazarus that makes use of the TXMLConfig component like the functions WriteComponentToXMLConfig and ReadComponentFromXMLConfig in the LazXMLForms unit (can be found in the converter directory from the lazarus sources).

I had a nice little overall project prepared to show here this time. It used a more visual approach using the TXMLPropStorage component (if you want to experiment and try for yourself then perhaps taking a look here might be helpfull). But for some reason Murphy honoured me with a visit, so instead i made a little example about practical use of the TXMLConfig component.

In that regard it turned out nicely imho and could serve as a starting-point to extend the editor that HEA is working on.

The example below shows how one can read part of a .lpi file as well as how to use conditional compilation of code (i didn't think it is necessary to spend more time to it then this).
This time no fancy pictures and as always use at your own risk and please do not confuse XMLcfg with Laz_XMLCfg unit as they are different.

The Project File:
program ExampleCh3;

{
$mode objfpc}{$H+}

uses
  
{$IFDEF UNIX}{$IFDEF UseCThreads}
  
cthreads,
  {
$ENDIF}{$ENDIF}
  
Interfaces// this includes the LCL widgetset
  
FormsMain
  
you can add units after this };

{
$R *.res}

begin
  Application
.Initialize;
  
Application.CreateForm(TfrmMainfrmMain);
  
Application.Run;
end.


The Main Unit's Form
object frmMainTfrmMain
  Left 
363
  Height 
264
  Top 
245
  Width 
416
  Caption 
'Example3: XMLConfig'
  
ClientHeight 245
  ClientWidth 
416
  Menu 
MainMenu
  LCLVersion 
'0.9.30'
  
object lbMainViewTListBox
    Left 
0
    Height 
245
    Top 
0
    Width 
416
    Align 
alClient
    ItemHeight 
0
    TabOrder 
0
  end
  object OpenDialog1
TOpenDialog
    left 
80
    top 
16
  end
  object MainMenu
TMainMenu
    left 
136
    top 
16
    object mnuProgram
TMenuItem
      Caption 
'Program'
      
object mnsProjectTMenuItem
        Caption 
'Project'
        
object mniOpenProjectTMenuItem
          Caption 
'Open...'
          
OnClick mniOpenProjectClick
        end
        object mniCloseProject
TMenuItem
          Caption 
'Close'
          
Visible False
        end
      end
      object mniLine1
TMenuItem
        Caption 
'-'
      
end
      object mniAbout
TMenuItem
        Caption 
'About'
        
OnClick mniAboutClick
      end
      object mniHelp
TMenuItem
        Caption 
'Help'
        
Enabled False
        Visible 
False
      end
      object mniLine2
TMenuItem
        Caption 
'-'
      
end
      object mniStop
TMenuItem
        Caption 
'Stop ?'
        
Enabled False
        OnClick 
mniStopClick
      end
      object mniQuit
TMenuItem
        Caption 
'Quit'
        
OnClick mniQuitClick
      end
    end
  end
end


The Main Unit Itself
{
Title  Just _an_ example on how to read xml/config files
Author 
Magorium
Date   
7 august 2011
Note   
: Use and abuse at your own risk.
===============================================================================
This is an example for testing ALB42's version of Freepascal + LCL for/on AROS.

It shows usage of the TXMLConfig Component. Here it is used non-visual and
"on-the-fly". When the user selects the menuitem the example will try to read
the user selected and so-called .lpi file (Lazarus Project Information
File) and extract some information from it and displays this on the form'
s
listbox
.

More information about TXMLConfig and it's use can be found in the lazarus
source where it is heavily used (e.g. see: idecompileroptions.pp). A more
simple example can be found in fpc source (see: packagesfcl-baseexamples
cfgtest.pp)

The FPC 2.5.1 (aros) compiler is warning when compiling with two messages:
1) Warning: Unit "xmlcfg" is deprecated
2) Warning: Symbol "TXMLConfig" is deprecated
Well, it works and they forgot to tell what should be used instead..

Also introduced in this example is the use of conditional compiling of
specific parts of source in order to make up for those differences between
aros and windows (my dev-OS) but can also be adapted for other operating
systems such as linux and morphos etc.
}

(*  TXMLConfig Component short overview:
    ===========================================================================
    .Clear
     Clears all the nodes from the XML.

    .DeletePath
     Deletes the complete given path from the xml. It removes a complete node.

     .DeleteValue
      Deletes the given pathvalue from the xml. It takes empty paths into
      account.

    .Filename
     The filename of the xml file on disk. If it changes when a xml document
     is already loaded it will flush the old filename to disk first, and
     destroys it from memory. Then, if Startempty is false it will load the
     new xmlfile otherwise it will create a new empty xml with the given
     filename.

    .Flush
     If the XML was modified it will write the xml nodes from memory to disk.

    .GetValue
     Get the value from the given path from the xml. If the given path/value
     does not exist it will return the given default-value

    .Modified
     Tells if the xml in memory has changed or not.

    .SetDeleteValue
     Set the value using the given path into the xml. If the given Value is
     equal to the given defaultvalue the DeleteValue() function is called using
     the given path/value

    .SetValue
     Set the value using the given path into the xml. If the path/value
     does not exist it will be created.

    .StartEmpty
     Forces to start with an empty xml file. Does it also when a xmlfile is
     already open and this property is being set to true when it was false.

    .UseEscaping
     Defaults to true. If escaping is used then all characters not being a..z,
     A..Z, 0..9, "." , "-" and "_" are treated/handled as escaped chars.

    .Rootname
     Defaults to "CONFIG" and is the name of the root-node of the xmlfile.
     Lazarus configuration files always seem to start with this CONFIG keyword
     as root.
    ===========================================================================
*)



unit Main;


{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, XMLCfg, FileUtil, Forms, Controls, Graphics, Dialogs,
  StdCtrls, Menus;

type

  { TfrmMain }

  TfrmMain = class(TForm)
    lbMainView: TListBox;
    MainMenu: TMainMenu;
    mnuProgram: TMenuItem;
    mnsProject: TMenuItem;
    mniOpenProject: TMenuItem;
    mniCloseProject: TMenuItem;     // Hidden on purpose, no implementation
    mniLine1: TMenuItem;
    mniAbout: TMenuItem;
    mniHelp: TMenuItem;             // Hidden on purpose, no implementation
    mniLine2: TMenuItem;
    mniStop: TMenuItem;             // Disabled on purpose, aros ignores
    mniQuit: TMenuItem;
    OpenDialog1: TOpenDialog;
    procedure mniOpenProjectClick(Sender: TObject);
    procedure mniAboutClick(Sender: TObject);
    procedure mniStopClick(Sender: TObject);
    procedure mniQuitClick(Sender: TObject);
  private
    { private declarations }
    // Performs actual processing of a Lazarus Project Information File
    Procedure OpenLaPrIn(Filename: String);
  public
    { public declarations }
  end; 

var
  frmMain: TfrmMain;

implementation

{$R *.lfm}

{
Uses
  DOM, XMLRead; <- yes these can be used also in aros ;-)
}

  // These ifdefs are here for conditional compilation
  // if compiled on aros only the ifdef aros code is being compiled
  // if compiled on windows only the ifdef windows is being compiled
  // ifdef linux could also be added accordingly.
  // for more information about these sort of things see the FPC
  // programmers guide
  // Please note that when this get'
s compiled on a differnet machine
  
// then aros or windows the NL constant will not be defined, therefore
  // resulting in an error because this constant is used elsewhere in this
  // example. This was done deliberately.

{$ifdef aros}
   
// This get's compiled when compiling on/for aros

Const
  
NL #10;      // Define a bogus newline for AROS requester
{$endif}

{
$ifdef windows}
   
// This get's compiled when compiling on/for windows

Const
  
NL =  #13;     // Define a bogus newline for windows requester
{$endif}



TfrmMain }


// ============================================================================
//
//        Form Helper Routines
//
// ============================================================================



procedure TfrmMain.OpenLaPrIn(FilenameString);
var
  
X             TXMLConfig// Used to read the XML file
  
ProjectTitle  String;     // A var-helper to store the title of the project
  
ProjectMainUnitNr,          // A var-helper to store the nr of the main unit
                              // of the project (often a .lpr)
  
UnitsCount,                 // A var-helper to store the nr of units within
                              // the project
  
UnitIndex     Integer;    // An index to the units-list
  
UnitXname,                  // A var-helper to store the unitname of a unit
  
UnitXfilename String;     // A var-helper to store the filename of a unit
  
XMLPathHelp   String;     // Helper to create nodepath for xml
  
XMLPath       String;     // a var-helper to store nodepath for xml

begin
  
// Create an instance of TXMLConfig so we can read the XML
  
:= TXMLConfig.Create(nil);

  
// Set the filename of the xml-file
  
X.Filename := FileName;

  
// Display the filename into the listbox
  
lbMainView.Items.Add(Format('Project Filename: %s',[Filename]));

  
// -----------------------------------------------
  // Try to retrieve the project's title if it exist
  // -----------------------------------------------

  // Setup a little help to retrieve nodes easier
  
XMLPathHelp := 'ProjectOptions/General/%s/Value';

  
// Set the according node path
  
XMLPath      := Format(XMLPathHelp,['Title']);

  
// Set the default Project-title

  
ProjectTitle := 'Missing';

  
// Get the node-value and in case of n/a return 'Missing'
  
ProjectTitle := X.GetValue(XMLPathProjectTitle);
  
// The part above could also have been done with:
  // ProjectTitle := X.GetValue('ProjectOptions/General/Title/Value','Missing')

  // Check if the Project Title was missing if not then display in Listbox
  
If ProjectTitle <> 'Missing' then
  lbMainView
.Items.Add(Format('Project Title: %s',[ProjectTitle]));

  
// ----------------------------------------------
  // Try to retrieve the project's main unit number
  // ----------------------------------------------

  // Set the according node path
  
XMLPath      := Format(XMLPathHelp,['MainUnit']);

  
// Set the default Project-MainUnit Number
  
ProjectMainUnitNr := -1;

  
// Get the node-value and in case of n/a return -1
  
ProjectMainUnitNr := X.GetValue(XMLPathProjectMainUnitNr);
  
// The part above could also have been done with:
  // ProjectMainUnitNr := X.GetValue('ProjectOptions/General/MainUnit/Value',-1)

  // Check if the node request delivered our request
  
If ProjectMainUnitNr <> -1 then
  lbMainView
.Items.Add(Format('Project Main Unit#: %d',[ProjectMainUnitNr]));


  
// ------------------------------------
  // Try to find how many units there are
  // ------------------------------------

  // Set the according node path
  
XMLPath      := 'ProjectOptions/Units/Count';
  
UnitsCount   := 0;

  
UnitsCount := X.GetValue(XMLPathUnitsCount);

  
// Show Number of units in listbox
  
lbMainView.Items.Add(Format('Project # units: %d',[UnitsCount]));


  
// -----------------------------------------
  // Try to retrieve information for each unit
  // -----------------------------------------
  // Remark: The project file (.lpr) is seen as a ordinairy unit

  // By now, setting up a helper actually makes sense :-)
  
XMLPathHelp := 'ProjectOptions/Units/Unit%d/%s/Value';

  For 
UnitIndex := 0 to UnitsCount do
  
begin
    
// retrieve the name of the Unit with index UnitIndex
    
XMLPath := Format(XMLPathHelp,[UnitIndex'UnitName']);

    
UnitXname := 'Missing';
    
UnitXname := X.GetValue(XMLPathUnitXName);
    If 
UnitXname <> 'Missing' Then
     lbMainView
.Items.Add(Format('Unit[%d].unitname = %s',[UnitIndexUnitXname]));

    
// retrieve the filename of the Unit with index UnitIndex
    
XMLPath := Format(XMLPathHelp,[UnitIndex'Filename']);
    
UnitXfilename := 'Missing';
    
UnitXfilename := X.GetValue(XMLPathUnitXfilename);
    If 
UnitXfilename <> 'Missing' Then
     lbMainView
.Items.Add(Format('Unit[%d].filename = %s',[UnitIndexUnitXfilename]));
  
end;

  
// give back the memory that x occupies
  
x.free;
end;



// ============================================================================
//
//        Form Events
//
// ============================================================================



procedure TfrmMain.mniOpenProjectClick(SenderTObject);
begin
  Opendialog1
.DefaultExt:= '.lpi';


{
$ifdef aros}
  
Opendialog1.filter := '#?.lpi';
{
$endif}

{
$ifdef windows}
  
Opendialog1.filter := 'Lazarus project Information|*.lpi';
{
$endif}

  
OpenDialog1.Title := 'Select a Lazarus Project Information File';

  If 
Opendialog1.execute then
  begin
    
// dialog was succesfull so let's get to business

    // It's common practice to stall visual updates
    // remark: not implemented/working in aros ?
    
lbMainView.Items.BeginUpdate;

    
// Show some divider line
    
lbMainView.Items.Add('====================================================');

    
// Actually open and try to read the .lpi file
    
OpenLaPrIn(OpenDialog1.Filename);

    
// Show some divider line
    
lbMainView.Items.Add('====================================================');

    
// when all is done let system perform visual update
    // remark: not implemented/working in aros ?
    
lbMainView.Items.EndUpdate;
  
end;
end;


procedure TfrmMain.mniAboutClick(SenderTObject);
Const
  
AboutString =
  
' This is an example on how' NL +
  
' to read an XML-' NL +
  
' configuration file' NL NL +
  
' 2011 magorium';
begin
  
// Show some lame about message
  
ShowMessage(AboutString);
end;


procedure TfrmMain.mniStopClick(SenderTObject);
begin
  Application
.Terminate;
end;


procedure TfrmMain.mniQuitClick(SenderTObject);
begin
  
// just close this form. As this is the mainform of the application
  // the application will end as a result
  
Close;
end;


end.


Hopefully enjoy,

Posted on: 2011/8/6 19:59
Transfer the post to other applications Transfer


Re: Magical Empire of FPC and Lazarus #1

Joined:
2011/7/27 8:24
From Sweden
Group:
Member
Posts: 70
Offline
Thanks!

Posted on: 2011/8/7 5:34
_________________
http://aros-fpc.blogspot.com/
Transfer the post to other applications Transfer


Re: Magical Empire of FPC and Lazarus #1

Joined:
2011/6/30 19:50
Group:
Member
Posts: 2762
Offline
Well, i thank you instead

I started out testing the component with .lpi file as a test to see if it worked. Then i moved on to other things when things went wrong (murphy). So i had to do things fast based upon my first .lpi attempt.
And the idea for that came from your editor.

So thank you, for the idea

Posted on: 2011/8/7 6:35
Transfer the post to other applications Transfer



« 1 (2) 3 4 »



You can view topic.
You cannot start a new topic.
You cannot reply to posts.
You cannot edit your posts.
You cannot delete your posts.
You cannot add new polls.
You cannot vote in polls.
You cannot attach files to posts.
You cannot post without approval.

[Advanced Search]


Search
Top Posters
1 paolone
paolone
3623
2 nikolaos
nikolaos
3451
3 phoenixkonsole
phoenixkonsole
2916
4 magorium
magorium
2762
5 deadwood
deadwood
2284
6 clusteruk
clusteruk
2052
7 ncafferkey
ncafferkey
2044
8 mazze
mazze
2030
9 damocles
damocles
1787
10 Kalamatee
Kalamatee
1695
© 2004-2013 AROS Exec