1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:

unit UBigBMP;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, graphics, dglOpenGL, glBitmap;
  
type
  TBitmapArray2 = array of array of TBitmap;
  TglBitmap2DArray2 = array of array of TglBitmap2D;
  TBigBMP = class
    destructor Destroy; override;
  private
    Textures: TglBitmap2DArray2;
    dList: TGLUInt;
    function SplitBitmapToArray(aBMP: TBitmap; maxw, maxh: integer; var rwidth, rheight: integer): TBitmapArray2;
  public
    function LoadFromFile(pFilename: string; maxwidth, maxheight: integer): boolean;
    procedure Render;
  end;

implementation

function NextPOT(a: integer): integer;
const
  arr_pot: array[0..7] of integer = (8, 16, 32, 64, 128, 256, 512, 1024);
var
  i: integer;
begin
  for i := 0 to 7 do
    if (a <= arr_pot[i]) then
    begin
      result := arr_pot[i];
      exit;
    end;
  result := 1024;
end;

function ceil(a: single): integer;
begin
  if (frac(a) < 0.5) then
    a += 0.5;
  result := round(a);
end;

function min(a, b: integer): integer;
begin
  if a < b then
    result := a else
      result := b;
end;

procedure FreeBitmapArray(aBMPArray: TBitmapArray2);
var
  i, j: integer;
begin
  for i := 0 to high(aBMPArray) do
    for j := 0 to high(aBMPArray[i]) do
      aBMPArray[i, j].Free;
end;

procedure FreeglBitmap2DArray(aBitmaps: TglBitmap2DArray2);
var
  i, j: integer;
begin
  for i := 0 to high(aBitmaps) do
    for j := 0 to high(aBitmaps[i]) do
      aBitmaps[i, j].Free;
end;

destructor TBigBMP.Destroy;
begin
  FreeGLBitmap2DArray(Textures);
  inherited Destroy;
end;

function TBigBMP.SplitBitmapToArray(aBMP: TBitmap; maxw, maxh: integer; var rwidth, rheight: integer): TBitmapArray2;
var
  w, h,
  mw, mh,
  cw, ch,
  i, j: integer;
  pw, ph: single;
begin
  w := aBMP.width;
  h := aBMP.height;
  mw := min(NextPot(w), NextPot(maxw));
  mh := min(NextPot(h), NextPot(maxh));
  rwidth := mw;
  rheight := mh;
  pw := w / mw;
  ph := h / mh;
  cw := ceil(pw);
  ch := ceil(ph);
  setlength(result, cw, ch);
  for i := 0 to (cw - 1) do
    for j := 0 to (ch - 1) do
    begin
      result[i, j] := TBitmap.Create;
      with result[i, j] do
      begin
        width := mw;
        height := mh;
        Canvas.CopyRect(Rect(0, 0, mw, mh), ABMP.Canvas, Rect(i * mw, j * mh, (i + 1) * mw, (j + 1) * mh));
      end;
    end;
end;

function TBigBMP.LoadFromFile(pFilename: string; maxwidth, maxheight: integer): boolean;
var
  i, j,
  rwidth, rheight: integer;
  aStream: TStream;
  aBMP: TBitmap;
  aBMPArray: TBitmapArray2;
begin
  result := false;
  try
    if fileexists(pfilename) then
    begin
      aBMP := TBitmap.Create;
      try
        aBMP.loadfromfile(pfilename);
        aBMPArray := SplitBitmapToArray(aBMP, maxwidth, maxheight, rwidth, rheight);
      finally
        aBMP.Free;
      end;
      FreeGLBitmap2DArray(Textures);
      setlength(Textures, length(aBMPArray));
      aStream := TMemoryStream.Create;
      try
        for i := 0 to high(aBMPArray) do
        begin
          setlength(Textures[i], length(aBMPArray[i]));
          for j := 0 to high(aBMPArray[i]) do
          begin
            Textures[i, j] := TglBitmap2D.Create;
            aStream.Position := 0;
            aBMPArray[i, j].SaveToStream(aStream);
            with Textures[i, j] do
            begin
              aStream.Position := 0;
              LoadFromStream(aStream);
              GenTexture;
            end;
          end;
        end;
      finally
        aStream.Free;
        FreeBitmapArray(aBMPArray);
      end;
    end;
  except
    aBMP.Free;
    FreeBitmapArray(aBMPArray);
    exit;
  end;
  dList := glGenLists(1);
  glNewList(dList, GL_COMPILE);
    for i := 0 to high(Textures) do
      for j := 0 to high(Textures[i]) do
      begin
        Textures[i, j].Bind;
        glBegin(GL_QUADS);
          glTexCoord2f(0, 1); glVertex3f( i      * rwidth, (j + 1) * rheight, 0);
          glTexCoord2f(1, 1); glVertex3f((i + 1) * rwidth, (j + 1) * rheight, 0);
          glTexCoord2f(1, 0); glVertex3f((i + 1) * rwidth,  j      * rheight, 0);
          glTexCoord2f(0, 0); glVertex3f( i      * rwidth,  j      * rheight, 0);
        glEnd;
      end;
  glEndList;
  result := true;
end;

procedure TBigBMP.Render;
begin
  glCallList(dList);
end;

end.                    

1:
2:
3:
4:

  // BigBMP
  BigBMP := TBigBMP.Create;
  if Opendialog1.execute then
    BigBMP.loadfromfile(opendialog1.filename, 512, 512);                    

1:

  BigBMP.Render;