← Back to branch summary

~ubuntu-branches/ubuntu/dapper/fpc/dapper

« back to all changes in this revision

Viewing changes to fcl/tests/tstelgtk.pp

  • Committer: Bazaar Package Importer
  • Author(s): Carlos Laviola
  • Date: 2004-08-12 16:29:37 UTC
  • mfrom: (1.2.1 upstream) (2.1.1 warty)
  • Revision ID: james.westby@ubuntu.com-20040812162937-moo8ulvysp1ln771
Tags: 1.9.4-5
http://bugs.debian.org/265265
fp-compiler: needs ld, adding dependency on binutils.  (Closes: #265265)

Show diffs side-by-side

added added

removed removed

Lines of Context:
fcl/tests/tstelgtk.pp
 
1
{$mode objfpc}
 
2
{$H+}
 
3
{$apptype gui}
 
4
 
 
5
{$ifdef win32}
 
6
{$R fclel.res}
 
7
{$endif}
 
8
 
 
9
program tstelgtk;
 
10
 
 
11
uses gdk,gtk,fpgtk,fpgtkext,classes,sysutils,eventlog;
 
12
 
 
13
{ ---------------------------------------------------------------------
 
14
    Main form class
 
15
  ---------------------------------------------------------------------}
 
16
  
 
17
 
 
18
Type
 
19
  TMainForm = Class(TFPGtkWindow)
 
20
    FEventLog : TEventLog;
 
21
    RGFrame : TFPgtkFrame;
 
22
    FHBox : TFPgtkHBox;
 
23
    RGBox,
 
24
    FVBox : TFPgtkVBox;
 
25
    BSend : TFPgtkButton;
 
26
    RGMsgType : TFPgtkRadioButtonGroup;
 
27
    FLMsg : TFPGtkLabel;
 
28
    FMsg : TFPGtkEntry;
 
29
    Procedure BSendClicked(Sender : TFPgtkObject; Data : Pointer);
 
30
  Public
 
31
    Constructor Create;
 
32
    Destructor Destroy; override;
 
33
    Procedure CreateWindow;
 
34
    Procedure SendEvent;
 
35
  end;
 
36
 
 
37
ResourceString
 
38
  SCaption        = 'Free Pascal Event Log Demo';
 
39
  SEventlogDemo   = 'TestEventlogClass';
 
40
  SMessage        = 'Message text:';
 
41
  SMsgType        = 'Message type:';
 
42
  SSend           = 'Send message';
 
43
  SInformation    = 'Information';
 
44
  SWarning        = 'Warning';
 
45
  SError          = 'Error';
 
46
  SDebug          = 'Debug'; 
 
47
 
 
48
{ ---------------------------------------------------------------------
 
49
    Form Creation
 
50
  ---------------------------------------------------------------------}
 
51
    
 
52
Constructor TMainForm.Create;
 
53
 
 
54
begin
 
55
  Inherited create (gtk_window_dialog);
 
56
  Createwindow;
 
57
end;
 
58
 
 
59
Procedure TMainForm.CreateWindow;
 
60
 
 
61
  Procedure AddRG(C : String);
 
62
  
 
63
  Var
 
64
    RB : TFPgtkRadioButton;
 
65
 
 
66
  begin
 
67
    RB:= TFPgtkRadioButton.CreateWithLabel(RGmsgType,C);
 
68
    RGBox.Packstart(RB,False,False,2);
 
69
    rb.TheLabel.Justify:=GTK_JUSTIFY_LEFT;
 
70
  end;
 
71
 
 
72
Var
 
73
  S : TStrings;
 
74
 
 
75
begin
 
76
  BSend:=TFPGtkButton.CreateWithlabel(SSend);
 
77
  BSend.ConnectCLicked(@BSendClicked,Nil);
 
78
  RGFrame:=TFpgtkFrame.Create;
 
79
  RGFrame.Text:=SMsgType;
 
80
  RGBox:=TFPgtkVBox.Create;
 
81
  RGFRame.Add(RGBox);
 
82
  S:=TstringList.Create;
 
83
  try
 
84
    With S do
 
85
      begin
 
86
      Add(SInformation);
 
87
      Add(SWarning);
 
88
      Add(SError);
 
89
      Add(SDebug);
 
90
      end;
 
91
     RGMsgType:=RadioButtonGroupCreateFromStrings(S,Nil);
 
92
     RGMsgType.PackInBox(RGBox,True,False,False,2);
 
93
  Finally
 
94
    S.Free;
 
95
  end;  
 
96
  FLMsg:=TfpGtkLabel.Create(SMessage);
 
97
  FMsg:=TfpGtkEntry.Create;
 
98
  FHBox:=TFPgtkHbox.Create;
 
99
  FHBox.PackStart(FLMsg,False,False,2);
 
100
  FHBox.PackStart(FMsg,True,True,2);
 
101
  Title:=SCaption;
 
102
  FVBox:=TFPgtkVBox.Create;
 
103
  FVBox.Homogeneous:=False;
 
104
  FVBox.PackStart(FHBox,False,False,2);
 
105
  FVBox.PackStart(RGFrame,False,False,2);
 
106
  FVBox.PackStart(BSend,true,false,2);
 
107
  Add(FVBox);
 
108
  FMsg.GrabFocus;
 
109
  FEventLog:=TEventlog.Create(Nil);
 
110
  FEventLog.Identification:=SEventLogDemo;
 
111
  FEventLog.RegisterMessagefile('');
 
112
  FEventLog.Active:=True;
 
113
end;
 
114
 
 
115
Destructor TMainForm.Destroy;
 
116
 
 
117
begin
 
118
  FEventLog.Active:=False;
 
119
  FEventLog.Free;
 
120
  Inherited;
 
121
end;
 
122
 
 
123
{ ---------------------------------------------------------------------
 
124
    Callback events
 
125
  ---------------------------------------------------------------------}
 
126
  
 
127
Procedure TMainForm.BSendClicked(Sender : TFPgtkObject; Data : Pointer);
 
128
 
 
129
begin
 
130
  SendEvent;
 
131
end;
 
132
 
 
133
 
 
134
Procedure TMainForm.SendEvent;
 
135
 
 
136
Var
 
137
  E : TEventType;
 
138
 
 
139
begin
 
140
  Case RGMsgType.ActiveButtonIndex of 
 
141
    0 : E:=etinfo;
 
142
    1 : E:=etWarning;
 
143
    2 : E:=etError;
 
144
    3 : E:=etDebug;
 
145
  end;
 
146
  FEventLog.log(E,FMsg.Text);
 
147
end;
 
148
  
 
149
{ ---------------------------------------------------------------------
 
150
    Program.
 
151
  ---------------------------------------------------------------------}
 
152
  
 
153
begin
 
154
  application := TFPgtkApplication.Create;
 
155
  application.MainWindow := TMainForm.Create;
 
156
  application.Run;
 
157
  application.Free;
 
158
end.
 
 
b'\\ No newline at end of file'