Визуализация и увеличение. DirectX и прочая графика

unit Interferon;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus, Vcl.ExtCtrls, Math, Jpeg,
  Vcl.ExtDlgs, Vcl.StdCtrls, GdiPlus;
 
type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  maxx, maxy: integer;
  ItD: array of array of integer;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.FormCreate(Sender: TObject);
var
  x,y,i,j:integer;
  f:file;
begin
{Это мы открываем файлик}
  AssignFile(f, 'Useful.kfb');
  Reset(f, 1);
  Seek(f, 3);
  BlockRead(f, maxx, 4);
  BlockRead(f, maxy, 4);
  SetLength(ItD, maxx, maxy);
  for i := 0 to maxx - 1 do
    BlockRead(f, ItD[i, 0], maxy * SizeOf(integer));
  CloseFile(f);
  SetLength(Itd, maxx, maxy);
{Теперь ItD открыт. Он длиной 1920х1080.}
 
//Визуализация
 
//Увеличение в 2 раза (до 3840х2160 здесь)
end;
 
end.

m := TMemoryStream.Create;
m.LoadFromFile( filename );
 
glGenTextures( 1, @FTexData );
glBindTexture( GL_TEXTURE_2D, FTexData );
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT);
 glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT);
 glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST);
 glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
 glTexImage2D(GL_TEXTURE_2D, 0, GL_LUMINANCE32I_EXT, 1920, 1080, 0, GL_LUMINANCE_INTEGER_EXT, GL_INT, m.Memory );
 
m.Free;

glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST);

type Tcolor = packed record
  r:byte;
  g:byte;
  b:byte;
end;
 
var pal:array[0..4096] of TColor;
 
procedure TForm1.Loadcustompalette4096width1Click(Sender: TObject);
var
  bmp:tbitmap;
  i:integer;
begin
//Палитра обязательно должна быть 4096 пикселов в ширину
  bmp:=TBitMap.Create; bmp.LoadFromFile('Palette.bmp');
  for I := 0 to 4095 do
      begin
        pal[i].r:=GetRValue(bmp.Canvas.Pixels[i,1]);
        pal[i].g:=GetgValue(bmp.Canvas.Pixels[i,1]);
        pal[i].b:=GetbValue(bmp.Canvas.Pixels[i,1]);
      end;
end;

var
    i,maxx,maxy:longint;
    f:file;
begin
  AssignFile(f,'Useful.kfb');
  Reset(f, 1); //Открываем файл для чтения/записи с минимальным блоком доступа в 1 байт.
  Seek(f, 3); //Пропускаем первые 3 байта.
  BlockRead(f, MaxX, 4);
  BlockRead(f, MaxY, 4);
  SetLength(IterDat, MaxX, MaxY);
for i := 0 to MaxX-1 do
    BlockRead(f, IterDat[i, 0], MaxY * SizeOf(Integer));
  CloseFile(f);

var
  IterDat:array of array of longint;
  MAxx,Maxy:integer;
 
function MinSearch:longint;
var i,j:integer;
    min:longint;
begin
min:=2147483647;
for I := 0 to maxx-1 do
  for j := 0 to maxy-1 do
      if (IterDat[i,j]>0) then
          if (min>IterDat[i,j]) then min:=IterDat[i,j];
      exit(min);
end;
 
function MaxSearch:longint;
var i,j:integer;
    max:longint;
begin
max:=0;
for I := 0 to maxx-1 do
  for j := 0 to maxy-1 do
      if (i<>maxx div 2) and (j<>maxy div 2) then
          if (max<IterDat[i,j]) then max:=IterDat[i,j];
      exit(max);
end;
 
procedure Visualize();
var
    step,ms:real;
    min,max,x,y:longint;
    BitMap:TBitmap;
begin
BitMap:=TBitMap.create; BitMap.SetSize(Maxx,Maxy);
      Min:=MinSearch();
      Max:=MaxSearch();
      Step:=4095/(Max+1-Min);
      index := 0; // cnt := 0;
      ms := min * step;
      for y := 0 to maxy-1 do
        for x := 0 to maxx-1 do
            if (IterDat[x,y]>=max) then
              begin
                 BitMap.canvas.Pixels[x,y]:=clBlack;
              end else
            if (IterDat[x,y]>=0) then
              begin
                    BitMap.canvas.pixels[x,y]:=pal[round((IterDat[x,y])*step-ms) mod 4095];
              end;
end;

ОткрытьПалитру()
zom:=exp(ln(2)/300);
for i:=1 to 300 do
begin
Открыть();
Визуализировать();
Zoom:=exp(ln(zom),i-1);
Растянуть(round(maxx*zoom),round(maxy*zoom));
СохранитьВJPEG(Format('%d',[i]));
end;

exp(ln(zoom)*(i-1))

procedure TForm1.f1Click(Sender: TObject);
var
    x,y,i:longint;
    f:file;
begin
  OpenMap.Execute();
  {-------------------------}
  AssignFile(f,'Useful.kfb');
  Reset(f, 1); //Открываем файл для чтения/записи с минимальным блоком доступа в 1 байт.
  Seek(f, 3); //Пропускаем первые 3 байта.
  {Читаем MaxX и MaxY}
  BlockRead(f, MaxX, 4);
  BlockRead(f, MaxY, 4);
  //Выделяем память для массива.
  SetLength(IterDat, MaxX, MaxY);
  //Читаем данные в массив.
for i := 0 to MaxX-1 do
    BlockRead(f, IterDat[i, 0], MaxY * SizeOf(Integer));
  //Закрываем файл.
  CloseFile(f);
  {-------------------------}
  Form1.Image1.Width:=Maxx; Form1.Image1.Height:=MaxY;
    Form1.Image1.Picture := nil; // <--- Вот тут
  Form1.Image1.Picture.Bitmap.SetSize(Form1.Image1.Width, Form1.Image1.Height);
  MyBMInfo.bmiHeader.biSize := SizeOf(MyBMInfo.bmiHeader);
  res := GetDIBits(Form1.Image1.Canvas.Handle, Form1.Image1.Picture.Bitmap.Handle, 0, MyBMInfo.bmiHeader.biHeight, nil, MyBMInfo, DIB_RGB_COLORS);
  if res = 0 then ShowMessage('error first getdibits');
  SetLength(buffer, MyBMInfo.bmiHeader.biSizeImage{div SizeOf(RGBTRIPLE)});
  MyBMInfo.bmiHeader.biBitCount := 32;
  MyBMInfo.bmiHeader.biCompression := BI_RGB;
  MyBMInfo.bmiHeader.biHeight := Abs(MyBMInfo.bmiHeader.biHeight);
 
  res := GetDIBits(Form1.Image1.Canvas.Handle, Form1.Image1.Picture.Bitmap.Handle, 0, MyBMInfo.bmiHeader.biHeight, Buffer, MyBMInfo, DIB_RGB_COLORS);
 
  Visualize;
end;
 
procedure Visualize;
var
    step,ms:real;
    min,max,index,ColorIndex,x,y:longint;
begin
  Form1.Image1.Canvas.Brush.Color:=clBlack;
  form1.Image1.Canvas.Rectangle(0,0,form1.Image1.width,form1.Image1.Height);
  case COLORMETHOD of
  1:begin
      Min:=MinSearch();
      Max:=MaxSearch();
      Step:=4095/(Max+1-Min);
      index := 0; // cnt := 0;
      ms := min * step;
      for y := 0 to maxy-1 do
        for x := 0 to maxx-1 do
          begin
            if (IterDat[x,y]>=max) then
              begin
                buffer[index] := 0;           // red
                buffer[index+1] := 0;         // green
                buffer[index+2] := 0;         // blue
              end else
            if (IterDat[x,y]>0) then
              begin
                ColorIndex := round((IterDat[x,y])*step-ms) mod 4096;
                buffer[index] := pal[ColorIndex].B;     // red
                buffer[index+1] := pal[ColorIndex].G;   // green
                buffer[index+2] := pal[ColorIndex].R;   // blue
              end;
            inc(index, 4)
          end;
    end;
    res := SetDIBits(Form1.Image1.Canvas.Handle, Form1.Image1.Picture.Bitmap.Handle, 0,
      MyBMInfo.bmiHeader.biHeight, Buffer, MyBMInfo, DIB_RGB_COLORS);