← Back to branch summary

~ubuntu-branches/debian/lenny/fpc/lenny

« back to all changes in this revision

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

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-05-17 17:12:11 UTC
  • mfrom: (3.1.9 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080517171211-9qi33xhd9evfa0kg
Tags: 2.2.0-dfsg1-9
http://bugs.debian.org/477743
[ Torsten Werner ]
* Add Mazen Neifer to Uploaders field.

[ Mazen Neifer ]
* Moved FPC sources into a version dependent directory from /usr/share/fpcsrc
  to /usr/share/fpcsrc/${FPCVERSION}. This allow installing more than on FPC
  release.
* Fixed far call issue in compiler preventing building huge binearies.
  (closes: #477743)
* Updated building dependencies, recomennded and suggested packages.
* Moved fppkg to fp-utils as it is just a helper tool and is not required by
  compiler.

Show diffs side-by-side

added added

removed removed

Lines of Context:
fpcsrc/packages/extra/amunits/otherlibs/triton/examples/palette.pas
 
1
PROGRAM Palette;
 
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
  11 Jan 2003.
 
10
 
 
11
  nils.sjoholm@mailbox.swipnet.se
 
12
}
 
13
 
 
14
 
 
15
 
 
16
var
 
17
  Triton_App : pTR_App;
 
18
  Project : pTR_Project;
 
19
  close_me : boolean;
 
20
  trmsg : pTR_Message;
 
21
  dummy : longint;
 
22
 
 
23
 
 
24
begin
 
25
 
 
26
    Triton_App := TR_CreateAppTags([
 
27
                     TRCA_Name,'Triton Palette Demo',
 
28
                     TRCA_Release,'1.0',
 
29
                     TRCA_Date,'03-06-1998',
 
30
                     TAG_DONE]);
 
31
 
 
32
    if Triton_App <> nil then begin
 
33
      ProjectStart;
 
34
      WindowID(1);
 
35
      WindowTitle('Palette');
 
36
         HorizGroupA;
 
37
            Space;
 
38
            VertGroupA;
 
39
               Space;
 
40
               CenteredTextID('_Palette',7);
 
41
               Space;
 
42
               PaletteGadget(1,7);
 
43
               Space;
 
44
            EndGroup;
 
45
            Space;
 
46
         EndGroup;
 
47
      EndProject;
 
48
 
 
49
  Project := TR_OpenProject(Triton_App,@tritontags);
 
50
    IF Project <> NIL THEN BEGIN
 
51
      close_me := FALSE;
 
52
      WHILE NOT close_me DO BEGIN
 
53
        dummy := TR_Wait(Triton_App,0);
 
54
        REPEAT
 
55
          trmsg := TR_GetMsg(Triton_App);
 
56
          IF trmsg <> NIL THEN BEGIN
 
57
            IF (trmsg^.trm_Project = Project) THEN BEGIN
 
58
               CASE trmsg^.trm_Class OF
 
59
                 TRMS_CLOSEWINDOW : begin
 
60
                                       writeln('Your final colour was ',TR_GetValue(Project,7));
 
61
                                       close_me := True;
 
62
                                    end;
 
63
                 TRMS_ERROR:        WriteLN(TR_GetErrorString(trmsg^.trm_Data));
 
64
                 TRMS_NEWVALUE    : IF trmsg^.trm_ID = 7 then writeln('You picked colour ',trmsg^.trm_Data);
 
65
               END;
 
66
            END;
 
67
            TR_ReplyMsg(trmsg);
 
68
          END;
 
69
        UNTIL close_me OR (trmsg = NIL);
 
70
      END;
 
71
     TR_CloseProject(Project);
 
72
   end;
 
73
   TR_DeleteApp(Triton_App);
 
74
   END ELSE writeln('Can''t create Application',20);
 
75
end.