~ubuntu-branches/ubuntu/lucid/fpc/lucid-proposed

« back to all changes in this revision

Viewing changes to fpcsrc/packages/extra/amunits/otherlibs/triton/examples/checkbox.pas

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-10-09 23:29:00 UTC
  • mfrom: (4.1.1 sid)
  • Revision ID: james.westby@ubuntu.com-20081009232900-553f61m37jkp6upv
Tags: 2.2.2-4
[ Torsten Werner ]
* Update ABI version in fpc-depends automatically.
* Remove empty directories from binary package fpc-source.

[ Mazen Neifer ]
* Removed leading path when calling update-alternatives to remove a Linitian
  error.
* Fixed clean target.
* Improved description of packages. (Closes: #498882)

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
 
PROGRAM CheckBoxGad;
2
 
 
3
 
uses triton, tritonmacros, utility;
4
 
 
5
 
{
6
 
   A demo in FPC Pascal using triton.library
7
 
 
8
 
   Updated for fpc 1.0.7
9
 
   09 Jan 2003
10
 
 
11
 
   nils.sjoholm@mailbox.swipnet.se
12
 
}
13
 
 
14
 
 
15
 
 
16
 
VAR
17
 
     App      : pTR_App;
18
 
     Project  : pTR_Project;
19
 
     close_me : BOOLEAN;
20
 
     trmsg    : pTR_Message;
21
 
     dummy    : Longint;
22
 
 
23
 
procedure CleanUp(why : string; err : longint);
24
 
begin
25
 
    if assigned(Project) then TR_CloseProject(Project);
26
 
    if assigned(App) then TR_DeleteApp(App);
27
 
    if why <> '' then writeln(why);
28
 
    halt(err);
29
 
end;
30
 
 
31
 
begin
32
 
 
33
 
     App := TR_CreateAppTags([TRCA_Name,'Triton CheckBox',
34
 
                              TRCA_Release,'1.0',
35
 
                              TRCA_Date,'03-06-1998',
36
 
                              TAG_DONE]);
37
 
 
38
 
     if App = nil then CleanUp('Can''t create application',20);
39
 
 
40
 
      ProjectStart;
41
 
      WindowID(1);
42
 
      WindowTitle('CheckBox');
43
 
         VertGroupA;
44
 
            Space;
45
 
            HorizGroupAC;
46
 
               Space;
47
 
               TextID('_CheckBox',10);
48
 
               Space;
49
 
               CheckBox(10);
50
 
               Space;
51
 
            EndGroup;
52
 
            Space;
53
 
         EndGroup;
54
 
      EndProject;
55
 
 
56
 
  Project := TR_OpenProject(App,@tritontags);
57
 
    IF Project = NIL THEN CleanUp('Can''t create Project',20);
58
 
      close_me := FALSE;
59
 
      WHILE NOT close_me DO BEGIN
60
 
        dummy := TR_Wait(App,0);
61
 
        REPEAT
62
 
          trmsg := TR_GetMsg(App);
63
 
          IF trmsg <> NIL THEN BEGIN
64
 
            IF (trmsg^.trm_Project = Project) THEN BEGIN
65
 
               CASE trmsg^.trm_Class OF
66
 
                 TRMS_CLOSEWINDOW : begin
67
 
                                     if TR_GetCheckBox(Project,10) then
68
 
writeln('CheckBox was on')
69
 
                                        else writeln('CheckBox was off');
70
 
                                     close_me := True;
71
 
                                    end;
72
 
                 TRMS_ERROR:        WriteLN(TR_GetErrorString(trmsg^.trm_Data));
73
 
                 TRMS_NEWVALUE    : begin
74
 
                                      IF trmsg^.trm_ID = 10 then begin
75
 
                                          if trmsg^.trm_Data = 0 then
76
 
writeln('CheckBox off')
77
 
                                            else writeln('CheckBox on');
78
 
                                      end;
79
 
                                    end;
80
 
               END;
81
 
            END;
82
 
            TR_ReplyMsg(trmsg);
83
 
          END;
84
 
        UNTIL close_me OR (trmsg = NIL);
85
 
      END;
86
 
   CleanUp('',0);
87
 
end.