freepascal.compiler/packages/fcl-base/examples/tstelgtk.pp

{$mode objfpc}
{$H+}
{$apptype gui}

program tstelgtk;

uses gdk,gtk,fpgtk,fpgtkext,classes,sysutils,eventlog;

{ ---------------------------------------------------------------------
    Main form class
  ---------------------------------------------------------------------}


Type
  TMainForm = Class(TFPGtkWindow)
    FEventLog : TEventLog;
    RGFrame : TFPgtkFrame;
    FHBox : TFPgtkHBox;
    RGBox,
    FVBox : TFPgtkVBox;
    BSend : TFPgtkButton;
    RGMsgType : TFPgtkRadioButtonGroup;
    FLMsg : TFPGtkLabel;
    FMsg : TFPGtkEntry;
    Procedure BSendClicked(Sender : TFPgtkObject; Data : Pointer);
  Public
    Constructor Create;
    Destructor Destroy; override;
    Procedure CreateWindow;
    Procedure SendEvent;
  end;

ResourceString
  SCaption        = 'Free Pascal Event Log Demo';
  SEventlogDemo   = 'TestEventlogClass';
  SMessage        = 'Message text:';
  SMsgType        = 'Message type:';
  SSend           = 'Send message';
  SInformation    = 'Information';
  SWarning        = 'Warning';
  SError          = 'Error';
  SDebug          = 'Debug';

{ ---------------------------------------------------------------------
    Form Creation
  ---------------------------------------------------------------------}

Constructor TMainForm.Create;

begin
  Inherited create (gtk_window_dialog);
  Createwindow;
end;

Procedure TMainForm.CreateWindow;

  Procedure AddRG(C : String);

  Var
    RB : TFPgtkRadioButton;

  begin
    RB:= TFPgtkRadioButton.CreateWithLabel(RGmsgType,C);
    RGBox.Packstart(RB,False,False,2);
    rb.TheLabel.Justify:=GTK_JUSTIFY_LEFT;
  end;

Var
  S : TStrings;

begin
  BSend:=TFPGtkButton.CreateWithlabel(SSend);
  BSend.ConnectCLicked(@BSendClicked,Nil);
  RGFrame:=TFpgtkFrame.Create;
  RGFrame.Text:=SMsgType;
  RGBox:=TFPgtkVBox.Create;
  RGFRame.Add(RGBox);
  S:=TstringList.Create;
  try
    With S do
      begin
      Add(SInformation);
      Add(SWarning);
      Add(SError);
      Add(SDebug);
      end;
     RGMsgType:=RadioButtonGroupCreateFromStrings(S,Nil);
     RGMsgType.PackInBox(RGBox,True,False,False,2);
  Finally
    S.Free;
  end;
  FLMsg:=TfpGtkLabel.Create(SMessage);
  FMsg:=TfpGtkEntry.Create;
  FHBox:=TFPgtkHbox.Create;
  FHBox.PackStart(FLMsg,False,False,2);
  FHBox.PackStart(FMsg,True,True,2);
  Title:=SCaption;
  FVBox:=TFPgtkVBox.Create;
  FVBox.Homogeneous:=False;
  FVBox.PackStart(FHBox,False,False,2);
  FVBox.PackStart(RGFrame,False,False,2);
  FVBox.PackStart(BSend,true,false,2);
  Add(FVBox);
  FMsg.GrabFocus;
  FEventLog:=TEventlog.Create(Nil);
  FEventLog.Identification:=SEventLogDemo;
  FEventLog.RegisterMessagefile('');
  FEventLog.Active:=True;
end;

Destructor TMainForm.Destroy;

begin
  FEventLog.Active:=False;
  FEventLog.Free;
  Inherited;
end;

{ ---------------------------------------------------------------------
    Callback events
  ---------------------------------------------------------------------}

Procedure TMainForm.BSendClicked(Sender : TFPgtkObject; Data : Pointer);

begin
  SendEvent;
end;


Procedure TMainForm.SendEvent;

Var
  E : TEventType;

begin
  Case RGMsgType.ActiveButtonIndex of
    0 : E:=etinfo;
    1 : E:=etWarning;
    2 : E:=etError;
    3 : E:=etDebug;
  end;
  FEventLog.log(E,FMsg.Text);
end;

{ ---------------------------------------------------------------------
    Program.
  ---------------------------------------------------------------------}

begin
  application := TFPgtkApplication.Create;
  application.MainWindow := TMainForm.Create;
  application.Run;
  application.Free;
end.