← Back to branch summary

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

« back to all changes in this revision

Viewing changes to fpcsrc/packages/extra/ptc/examples/con_info.pp

  • 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/ptc/examples/con_info.pp
 
1
{
 
2
Ported to FPC by Nikolay Nikolov (nickysn@users.sourceforge.net)
 
3
}
 
4
 
 
5
{
 
6
 Info example for OpenPTC 1.0 C++ Implementation
 
7
 Copyright (c) Glenn Fiedler (ptc@gaffer.org)
 
8
 This source code is in the public domain
 
9
}
 
10
 
 
11
Program InfoExample;
 
12
 
 
13
{$MODE objfpc}
 
14
 
 
15
Uses
 
16
  ptc;
 
17
 
 
18
Procedure print(Const format : TPTCFormat);
 
19
 
 
20
Begin
 
21
  { check format type }
 
22
  If format.direct Then
 
23
    { check alpha }
 
24
    If format.a = 0 Then
 
25
      { direct color format without alpha }
 
26
      Write('Format(', format.bits:2, ',$', HexStr(format.r, 8), ',$', HexStr(format.g, 8), ',$', HexStr(format.b, 8), ')')
 
27
    Else
 
28
      { direct color format with alpha }
 
29
      Write('Format(', format.bits:2, ',$', HexStr(format.r, 8), ',$', HexStr(format.g, 8), ',$', HexStr(format.b, 8), ',$', HexStr(format.a, 8), ')')
 
30
  Else
 
31
    { indexed color format }
 
32
    Write('Format(', format.bits:2, ')');
 
33
End;
 
34
 
 
35
Var
 
36
  console : TPTCConsole;
 
37
 
 
38
Begin
 
39
  console := Nil;
 
40
  Try
 
41
    Try
 
42
      Writeln('[ptc version]');
 
43
      { print ptc version string define }
 
44
      Writeln(PTC_VERSION);
 
45
      Writeln;
 
46
 
 
47
      { create console }
 
48
      console := TPTCConsole.Create;
 
49
 
 
50
      { open the console }
 
51
      console.open('Info example');
 
52
 
 
53
      { print console data }
 
54
      Writeln('[console data]');
 
55
      Writeln('name   = ', console.name);
 
56
      Writeln('title  = ', console.title);
 
57
      Writeln('width  = ', console.width);
 
58
      Writeln('height = ', console.height);
 
59
      Writeln('pages  = ', console.pages);
 
60
      Writeln('pitch  = ', console.pitch);
 
61
      Write('format = ');
 
62
      print(console.format);
 
63
      Writeln;
 
64
      Writeln;
 
65
 
 
66
      { print console information }
 
67
      Writeln('[console information]');
 
68
      Writeln(console.information);
 
69
    Finally
 
70
      console.close;
 
71
      console.Free;
 
72
    End;
 
73
  Except
 
74
    On error : TPTCError Do
 
75
      { report error }
 
76
      error.report;
 
77
  End;
 
78
End.