Misiekd mi chodzi o zapis bitmapy do pliku rekordowego, a nie oddzielnego pliku bmp
Ostatecznie wymęczyłem coś takiego:
//rekord - nagłówek BMP
Type
TBmpHeader = Packed Record
bfType1 : Byte;
bfType2 : Byte;
bfSize : LongInt;
bfReserved1 : Word;
bfReserved2 : Word;
bfOffBits : LongInt;
biSize : LongInt;
biWidth : LongInt;
biHeight : LongInt;
biPlanes : Word;
biBitCount : Word;
biCompression : LongInt;
biSizeImage : LongInt;
biXPelsPerMeter : LongInt;
biYPelsPerMeter : LongInt;
biClrUsed : LongInt;
biClrImportant : LongInt;
End;
//rekord z danymi do którego zapisane ma być zdjęcie bmp i inne dane
type
TMainRecord = Record
//nagłówek obrazka bmp
bfType1 : Byte;
bfType2 : Byte;
bfSize : LongInt;
bfReserved1 : Word;
bfReserved2 : Word;
bfOffBits : LongInt;
biSize : LongInt;
biWidth : LongInt;
biHeight : LongInt;
biPlanes : Word;
biBitCount : Word;
biCompression : LongInt;
biSizeImage : LongInt;
biXPelsPerMeter : LongInt;
biYPelsPerMeter : LongInt;
biClrUsed : LongInt;
biClrImportant : LongInt;
//wartości poszczególnych pikseli zapisane do tablic
pixelsR : array[1..5000, 1..5000] of BYTE; //czerwony
pixelsG : array[1..5000, 1..5000] of BYTE; //zielony
pixelsB : array[1..5000, 1..5000] of BYTE; //niebieski
//pozostałe zmienne niezwiązane z obrazkiem zapisane do pliku rekordowego
a, b, c : integer;
tekst : string[100];
znak : char;
End;
//długość i wysokość obrazka
var
Wysokosc, Dlugosc : integer;
pixelsR : array[1..5000, 1..5000] of byte;
pixelsG : array[1..5000, 1..5000] of byte;
pixelsB : array[1..5000, 1..5000] of byte;
procedure Open_Bitmap( sciezka : string );
var
plik : File;
BMP : TBmpHeader;
i, j : Integer;
kolor : TColor;
Begin
AssignFile( plik, sciezka);
Reset(plik, 1);
//wczytanie nagłówka
Blockread (plik, BMP, Sizeof(BMP) );
Wysokosc := BMP.biHeight;
Dlugosc := BMP.biWidth;
//wczytanie poszczególnych pikseli obrazka
for i := 1 to Dlugosc do
begin
for j := 1 to Wysokosc do
begin
BlockRead(plik, pixelsB[i][j], 1);
BlockRead(plik, pixelsG[i][j], 1);
BlockRead(plik, pixelsR[i][j], 1);
//wyświetlenie obrazka do komponentu Image1- obrazek jest niestety odwrócony
//kolor := RGB(pixelsR[i][j], pixelsG[i][j], pixelsB[i][j]);
//Form1.Image1.Canvas.Pixels[i, j] := kolor;
end;
end;
CloseFile(plik);
end;
Procedure Save_bmp_to_REC( path : string);
var
plik : file of TMainRecord;
dataMain : TMainRecord;
dataBmp : TBmpHeader;
i, j : integer;
Begin
assign(plik, path );
rewrite(plik);
//zapis nagłówka
With dataBMP do
begin
dataMain.bfType1 := bfType1;
dataMain.bfType2 := bfType2;
dataMain.bfSize := bfSize ;
dataMain.bfReserved1 := bfReserved1;
dataMain.bfReserved2 := bfReserved2;
dataMain.bfOffBits := bfOffBits;
dataMain.biSize := biSize;
dataMain.biWidth := biWidth;
dataMain.biHeight := biHeight;
dataMain.biPlanes := biPlanes;
dataMain.biBitCount := biBitCount;
dataMain.biCompression := biCompression;
dataMain.biSizeImage := biSizeImage;
dataMain.biXPelsPerMeter := biXPelsPerMeter;
dataMain.biYPelsPerMeter := biYPelsPerMeter;
dataMain.biClrUsed := biClrUsed;
dataMain.biClrImportant := biClrImportant;
end;
//zapis pikseli - przekopiowanie wartości z tablicy globalnej
//Tu pojawia się bład w związku z tablicami w rekordzie TMainRecord
//stack overflow
for i := 1 to Dlugosc do
begin
for j := 1 to Wysokosc do
begin
dataMain.pixelsB[i][j] := pixelsB[i][j];
dataMain.pixelsG[i][j] := pixelsG[i][j];
dataMain.pixelsR[i][j] := pixelsR[i][j];
end;
end;
//zapis pozostałych danych do rekordu
dataMain.znak := 'a';
// ... itd.
write(plik, dataMain);
close(plik);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Open_Bitmap('C:\test.BMP'); //przykładowa bitmapa
Save_bmp_to_REC('D:\rekordfile.end');
end;
Ale niestety procedura zapisuje poprawnie tylko nagłówek pliku bmp, gdy chce zapisać piksele do tablicy w rekordzie TMainRecord (wcześniej wczytane do tablicy globalnej) wywala błąd stack overflow i zamyka aplikacje, i drugi problem obrazek wczytany jest do odwrotnie :|