Luxophia

1
unit LUX.Color.Map.D2;
2

3
interface //#################################################################### ■
4

5
uses System.UITypes,
6
     FMX.Graphics,
7
     LUX, LUX.D2, LUX.Color, LUX.Map.D2;
8

9
type //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【型】
10

11
     //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【レコード】
12

13
     //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【クラス】
14

15
     //%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TTexture2D
16

17
     TTexture2D = class( TBricArray2D<TSingleRGBA> )
18
     private
19
     protected
20
       _Gamma :Single;
21
     public
22
       constructor Create; overload;
23
       constructor Create( const FileName_:String ); overload;
24
       ///// プロパティ
25
       property Gamma :Single read _Gamma write _Gamma;
26
       ///// メソッド
27
       procedure LoadFromBitmap( const Bitmap_:TBitmap );
28
       procedure LoadFromFile( const FileName_:String );
29
       function Interp( const X_,Y_:Single ) :TSingleRGBA; overload;
30
       function Interp( const P_:TSingle2D ) :TSingleRGBA; overload;
31
     end;
32

33
//const //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【定数】
34

35
//var //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【変数】
36

37
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【ルーチン】
38

39
implementation //############################################################### ■
40

41
uses System.Math;
42

43
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【レコード】
44

45
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【クラス】
46

47
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TTexture2D
48

49
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& private
50

51
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& protected
52

53
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& public
54

55
constructor TTexture2D.Create;
56
begin
57
     inherited;
58

59
     _Gamma := 2.2;
60
end;
61

62
constructor TTexture2D.Create( const FileName_:String );
63
begin
64
     Create;
65

66
     LoadFromFile( FileName_ );
67
end;
68

69
/////////////////////////////////////////////////////////////////////// メソッド
70

71
procedure TTexture2D.LoadFromBitmap( const Bitmap_:TBitmap );
72
var
73
   RecG :Single;
74
   B :TBitmapData;
75
   X, Y :Integer;
76
   P :PAlphaColor;
77
begin
78
     RecG := 1 / _Gamma;
79

80
     BricX := Bitmap_.Width ;
81
     BricY := Bitmap_.Height;
82

83
     Bitmap_.Map( TMapAccess.Read, B );
84

85
     for Y := 0 to BricY-1 do
86
     begin
87
          P := B.GetScanline( Y );
88

89
          for X := 0 to BricX-1 do
90
          begin
91
               Bric[ X, Y ] := GammaCorrect( TSingleRGBA( P^ ), RecG );  Inc( P );
92
          end;
93
     end;
94

95
     Bitmap_.Unmap( B );
96
end;
97

98
procedure TTexture2D.LoadFromFile( const FileName_:String );
99
var
100
   B :TBitmap;
101
begin
102
     B := TBitmap.Create;
103

104
     B.LoadFromFile( FileName_ );
105

106
     LoadFromBitmap( B );
107

108
     B.Free;
109
end;
110

111
function TTexture2D.Interp( const X_,Y_:Single ) :TSingleRGBA;
112
var
113
   X1, Y1, Xi, Yi :Integer;
114
   X, Y, Xd, Yd :Single;
115
   C00, C01,
116
   C10, C11,
117
   C0, C1 :TSingleRGBA;
118
begin
119
     X1 := BricX-1;
120
     Y1 := BricY-1;
121

122
     if X_ <= 0 then X := 0
123
                else
124
     if X_ >= 1 then X := X1
125
                else X := X1 * X_;
126

127
     if Y_ <= 0 then Y := 0
128
                else
129
     if Y_ >= 1 then Y := Y1
130
                else Y := Y1 * Y_;
131

132
     Xi := Floor( X );  if Xi > X1 then Xi := X1;  Xd := X - Xi;
133
     Yi := Floor( Y );  if Yi > Y1 then Yi := Y1;  Yd := Y - Yi;
134

135
     C00 := Bric[ Xi+0, Yi+0 ];  C01 := Bric[ Xi+1, Yi+0 ];
136
     C10 := Bric[ Xi+0, Yi+1 ];  C11 := Bric[ Xi+1, Yi+1 ];
137

138
     C0 := ( C01 - C00 ) * Xd + C00;
139
     C1 := ( C11 - C10 ) * Xd + C10;
140

141
     Result := ( C1 - C0 ) * Yd + C0;
142
end;
143

144
function TTexture2D.Interp( const P_:TSingle2D ) :TSingleRGBA;
145
begin
146
     with P_ do Result := Interp( X, Y );
147
end;
148

149
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【ルーチン】
150

151
//############################################################################## □
152

153
initialization //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 初期化
154

155
finalization //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 最終化
156

157
end. //######################################################################### ■
158