Login
Username:

Password:

Remember me



Lost Password?

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

Members: 1
Guests: 14

BSzili, more...

Browsing this Thread:   1 Anonymous Users



« 1 (2) 3 4 »


magorium
Chapter 2: Good programming habbits makes ... havoc ?
#11

Joined:
2011/6/30 19:50
Group:
Member
Posts: 1648
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, SysUtils, eventlog, FileUtil, Forms, Controls, Graphics, Dialogs;

type

  { TForm1 }

  TForm1 = class(TForm)
    EventLog1: TEventLog;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end; 

var
  Form1: TForm1; 

implementation

{$R *.lfm}

{ TForm1 }

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

procedure TForm1.FormDestroy(Sender: TObject);
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
  Forms, MainUnit
  { you can add units after this };

{$R *.res}

begin
  Application.Initialize;
  Application.CreateForm(TfrmMain, frmMain);
  Application.Run;
end.


Secondly here is the Main Form's layout:

object frmMain: TfrmMain
  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 btnDoNotPressMe: TButton
    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 mnsLog: TMenuItem
        Caption = 'Log'
        object mniLogWarning: TMenuItem
          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;
    mniDump: TMenuItem;
    mnuApplication: TMenuItem;
    mnsLog: TMenuItem;
    mniLogWarning: TMenuItem;
    mniLogError: TMenuItem;
    mniDebug: TMenuItem;
    mniLogInfo: TMenuItem;
    MenuItem1: TMenuItem;    // --
    mniQuit: TMenuItem;
    // Form's Components
    btnDoNotPressMe: TButton;
    edtEdit: TEdit;
    EventLog1: TEventLog;
    // Form-events
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormDeactivate(Sender: TObject);
    procedure FormMouseEnter(Sender: TObject);
    procedure FormMouseLeave(Sender: TObject);
    procedure FormClick(Sender: TObject);
    procedure mniDumpClick(Sender: TObject);
    procedure mniQuitClick(Sender: TObject);
    // Menu-Events
    procedure mnsLogClick(Sender: TObject);
    // form component-events
    procedure btnDoNotPressMeClick(Sender: TObject);
    procedure edtEditEditingDone(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end; 

var
  frmMain: TfrmMain;

implementation

{$R *.lfm}

Var
  EL : TEventLog;

{ TfrmMain }



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



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



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



procedure TfrmMain.FormCreate(Sender: TObject);
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 file. It cannot
     be changed when the log is activated.
  - .active activates/disactivates the actual logging. Be 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 etCustom. This means that if you use one of the
    log() functions it will use the custom messages. E.g. changing 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 inactive. It
     raises an exception when trying on an active logfile.
  - .TimeStampFormat can be adjusted to own preference
  (* IGNORE AS IT IS M$ WINDOWS 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(Sender: TObject);
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(Sender: TObject);
begin
  EL.Log(Self.name + ' Activate');  // log event into file
end;


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


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


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


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



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



procedure TfrmMain.mnsLogClick(Sender: TObject);
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
    1 : El.Error('User selected Error from menu');      // mniLogError
    2 : El.Debug('User selected Debug from menu');      // mniLogDebug
    3 : 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(Sender: TObject);
Var S: String;
begin
  // Dumps a component to logfile
  El.Log('-=-=-=-==-==-=-= begin dump =-=-=-==-==-=-=-');// log event into file
  S := 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(Sender: TObject);
begin
  Close;
end;



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



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


procedure TfrmMain.edtEditEditingDone(Sender: TObject);
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


Anonymous_Coward
Re: Magical Empire of FPC and Lazarus #1
#12

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


magorium
Re: Magical Empire of FPC and Lazarus #1
#13

Joined:
2011/6/30 19:50
Group:
Member
Posts: 1648
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


Anonymous_Coward
Re: Magical Empire of FPC and Lazarus #1
#14

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


magorium
Re: Magical Empire of FPC and Lazarus #1
#15

Joined:
2011/6/30 19:50
Group:
Member
Posts: 1648
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


ALB42
Re: Magical Empire of FPC and Lazarus #1
#16

Joined:
2011/4/18 7:10
From Germany
Group:
Member
Posts: 156
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


magorium
Re: Magical Empire of FPC and Lazarus #1
#17

Joined:
2011/6/30 19:50
Group:
Member
Posts: 1648
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


magorium
Chapter 3: Getting to know things
#18

Joined:
2011/6/30 19:50
Group:
Member
Posts: 1648
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
  ConfigFilename: String;
  ButtonPressCounter : Integer;

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

  ButtonPressCounter := 0;
  ButtonPressCounter := XMLConfig1.GetValue(XMLButtonPath, ButtonPressCounter);

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

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if XMLConfig1.modified then
  begin
    XMLConfig1.Flush;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Inc(ButtonPressCounter);
  XMLConfig1.SetValue(XMLButtonPath, ButtonPressCounter);
  (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
  Forms, Main
  { you can add units after this };

{$R *.res}

begin
  Application.Initialize;
  Application.CreateForm(TfrmMain, frmMain);
  Application.Run;
end.


The Main Unit's Form
object frmMain: TfrmMain
  Left = 363
  Height = 264
  Top = 245
  Width = 416
  Caption = 'Example3: XMLConfig'
  ClientHeight = 245
  ClientWidth = 416
  Menu = MainMenu
  LCLVersion = '0.9.30'
  object lbMainView: TListBox
    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 mnsProject: TMenuItem
        Caption = 'Project'
        object mniOpenProject: TMenuItem
          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(Filename: String);
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
  X := 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(XMLPath, ProjectTitle);
  // 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(XMLPath, ProjectMainUnitNr);
  // 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(XMLPath, UnitsCount);

  // 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(XMLPath, UnitXName);
    If UnitXname <> 'Missing' Then
     lbMainView.Items.Add(Format('Unit[%d].unitname = %s',[UnitIndex, UnitXname]));

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

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



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



procedure TfrmMain.mniOpenProjectClick(Sender: TObject);
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(Sender: TObject);
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(Sender: TObject);
begin
  Application.Terminate;
end;


procedure TfrmMain.mniQuitClick(Sender: TObject);
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


Anonymous_Coward
Re: Magical Empire of FPC and Lazarus #1
#19

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


magorium
Re: Magical Empire of FPC and Lazarus #1
#20

Joined:
2011/6/30 19:50
Group:
Member
Posts: 1648
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

Advanced Search
Top Posters
1 paolone
paolone 		3378
2 nikolaos
nikolaos 		3344
3 phoenixkonsole
phoenixkonsole 		2438
4 deadwood
deadwood 		2076
5 clusteruk
clusteruk 		2051
6 mazze
mazze 		1950
7 ncafferkey
ncafferkey 		1865
8 damocles
damocles 		1752
9 magorium
magorium 		1648
10 Kalamatee
Kalamatee 		1465
© 2004-2013 AROS Exec