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

« back to all changes in this revision

Viewing changes to fpcsrc/packages/extra/ptc/formati.inc

  • 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
 
{
2
 
    Free Pascal port of the OpenPTC C++ library.
3
 
    Copyright (C) 2001-2003  Nikolay Nikolov (nickysn@users.sourceforge.net)
4
 
    Original C++ version by Glenn Fiedler (ptc@gaffer.org)
5
 
 
6
 
    This library is free software; you can redistribute it and/or
7
 
    modify it under the terms of the GNU Lesser General Public
8
 
    License as published by the Free Software Foundation; either
9
 
    version 2.1 of the License, or (at your option) any later version.
10
 
 
11
 
    This library is distributed in the hope that it will be useful,
12
 
    but WITHOUT ANY WARRANTY; without even the implied warranty of
13
 
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
14
 
    Lesser General Public License for more details.
15
 
 
16
 
    You should have received a copy of the GNU Lesser General Public
17
 
    License along with this library; if not, write to the Free Software
18
 
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
19
 
}
20
 
 
21
 
Constructor TPTCFormat.Create;
22
 
 
23
 
Begin
24
 
  { defaults }
25
 
  Fformat.r := 0;
26
 
  Fformat.g := 0;
27
 
  Fformat.b := 0;
28
 
  Fformat.a := 0;
29
 
  Fformat.bits := 0;
30
 
  Fformat.indexed := False;
31
 
 
32
 
  { initialize hermes }
33
 
  If Not Hermes_Init Then
34
 
    Raise TPTCError.Create('could not initialize hermes');
35
 
End;
36
 
 
37
 
Constructor TPTCFormat.Create(_bits : Integer);
38
 
 
39
 
Begin
40
 
  { check bits per pixel }
41
 
  If _bits <> 8 Then
42
 
    Raise TPTCError.Create('unsupported bits per pixel');
43
 
 
44
 
  { indexed color }
45
 
  Fformat.r := 0;
46
 
  Fformat.g := 0;
47
 
  Fformat.b := 0;
48
 
  Fformat.a := 0;
49
 
  Fformat.bits := _bits;
50
 
  Fformat.indexed := True;
51
 
 
52
 
  { initialize hermes }
53
 
  If Not Hermes_Init Then
54
 
    Raise TPTCError.Create('could not initialize hermes');
55
 
End;
56
 
 
57
 
Constructor TPTCFormat.Create(_bits : Integer; _r, _g, _b, _a : int32);
58
 
 
59
 
Begin
60
 
  { check bits per pixel }
61
 
  If ((_bits And 7) <> 0) Or (_bits <= 0) Or (_bits > 32) Then
62
 
    Raise TPTCError.Create('unsupported bits per pixel');
63
 
 
64
 
  { direct color }
65
 
  Fformat.r := _r;
66
 
  Fformat.g := _g;
67
 
  Fformat.b := _b;
68
 
  Fformat.a := _a;
69
 
  Fformat.bits := _bits;
70
 
  Fformat.indexed := False;
71
 
 
72
 
  { initialize hermes }
73
 
  If Not Hermes_Init Then
74
 
    Raise TPTCError.Create('could not initialize hermes');
75
 
End;
76
 
 
77
 
Constructor TPTCFormat.Create(_bits : Integer; _r, _g, _b : int32);
78
 
 
79
 
Begin
80
 
  { check bits per pixel }
81
 
  If ((_bits And 7) <> 0) Or (_bits <= 0) Or (_bits > 32) Then
82
 
    Raise TPTCError.Create('unsupported bits per pixel');
83
 
 
84
 
  { direct color }
85
 
  Fformat.r := _r;
86
 
  Fformat.g := _g;
87
 
  Fformat.b := _b;
88
 
  Fformat.a := 0;
89
 
  Fformat.bits := _bits;
90
 
  Fformat.indexed := False;
91
 
 
92
 
  { initialize hermes }
93
 
  If Not Hermes_Init Then
94
 
    Raise TPTCError.Create('could not initialize hermes');
95
 
End;
96
 
 
97
 
Constructor TPTCFormat.Create(Const format : TPTCFormat);
98
 
 
99
 
Begin
100
 
  { initialize hermes }
101
 
  If Not Hermes_Init Then
102
 
    Raise TPTCError.Create('could not initialize hermes');
103
 
 
104
 
  Hermes_FormatCopy(@format.Fformat, @Fformat)
105
 
End;
106
 
 
107
 
Destructor TPTCFormat.Destroy;
108
 
 
109
 
Begin
110
 
  Hermes_Done;
111
 
  Inherited Destroy;
112
 
End;
113
 
 
114
 
Procedure TPTCFormat.Assign(Const format : TPTCFormat);
115
 
 
116
 
Begin
117
 
  If Self = format Then
118
 
    Raise TPTCError.Create('self assignment is not allowed');
119
 
  Hermes_FormatCopy(@format.Fformat, @Fformat)
120
 
End;
121
 
 
122
 
Function TPTCFormat.Equals(Const format : TPTCFormat) : Boolean;
123
 
 
124
 
Begin
125
 
  Equals := Hermes_FormatEquals(@format.Fformat, @Fformat);
126
 
End;
127
 
 
128
 
Function TPTCFormat.direct : Boolean;
129
 
 
130
 
Begin
131
 
  direct := Not Fformat.indexed;
132
 
End;
133
 
 
134
 
Function TPTCFormat.bytes : Integer;
135
 
 
136
 
Begin
137
 
  bytes := Fformat.bits Shr 3;
138
 
End;