Новичок
Профиль
Группа: Участник
Сообщений: 22
Регистрация: 31.10.2004
Репутация: нет
Всего: нет
|
Народ ну помогите же пожалуйста.!!! Как преобразовать не используя явно bitmap.pixelformat. У меня есть модуль позволяющий открыть BMP, надо туда добавить сохранений с возможностью выбора цветов. Переменная FF определяет с какой цветностью сохранять (24 bit, 256,16 или 2 цвета). Но нужно сделать процедуру SaveBMP преобразуя изображение попиксельно. Вот код модуля. | Код |
unit SeeBMP;
interface
uses
Windows, SysUtils, Graphics, Dialogs, Math;
procedure readBMP(name:string; var Bm:TBitmap);
procedure SaveBMP(Bm:TBitmap; FF:Integer; Var name:string);
implementation
procedure readBMP(name:string; var Bm:TBitmap);
type
TBuf = array [0..MaxWord] of Byte;
Palit256 = array[0..255] of Longword;
Palit16 = array[0..15] of Longword;
Palit1 = array[0..1] of Longword;
filetitle=record
FileType:word;
FileSize:Longword;
Reserve:Longword;
BMPOffs:Longword;
Size:Longword;
Width:Longword;
Height:Longword;
Planes:word;
BitPerPixel:word;
Compress:Longword;
SizeOfBMP:Longword;
HorRez:Longword;
VertRez:Longword;
ColorUsed:Longword;
ColorImportant:Longword;
end;
var
buf: ^Tbuf;
pal256: palit256;
pal16: palit16;
pal1: palit1;
KK: array [1..8] of byte;
f:file;
ft:filetitle;
BMPformat, Rle:boolean;
i,j,x,y,t,z,s,ss:integer;
BitPerPixel:integer;
K,L,M: byte;
begin
If name=''
AssignFile(f,name);
reset(f,1);
{чтение заголовка файла}
blockread(f,ft.FileType,2);
if ft.FileType=19778 then
begin
blockread(f,ft.FileSize,4);
blockread(f,ft.Reserve,4);
blockread(f,ft.BMPOffs,4);
blockread(f,ft.Size,4);
blockread(f,ft.Width,4);
blockread(f,ft.Height,4);
blockread(f,ft.Planes,2);
blockread(f,ft.BitPerPixel,2);
blockread(f,ft.Compress,4);
blockread(f,ft.SizeOfBMP,4);
blockread(f,ft.HorRez,4);
blockread(f,ft.VertRez,4);
blockread(f,ft.ColorUsed,4);
blockread(f,ft.ColorImportant,4);
{построение изображения из файла}
BM.width := ft.width;
BM.height := ft.height;
{изображение без палитры и без сжатия}
if (ft.BitPerPixel=24) and (ft.Compress=0) then
begin
{начинаем читать файл}
GetMem(Buf, ft.SizeOfBMP);
BlockRead(f, Buf^, ft.SizeOfBMP);
BM.pixelformat := pf24bit;
I:=0;
for y := Bm.height - 1 downto 0 do
begin
for x := 0 to BM.width - 1 do
begin
t:=0;
t:=Buf^[i] shl 16 + Buf^[i+1] shl 8 + Buf^[i+2];
Bm.Canvas.Pixels[x,y]:=t;
Inc(i,3);
end;
Inc(i, BM.Width mod 4);
end;
FreeMem(buf);
end;
{изображение с палитрой 8bit и без сжатия}
if (ft.BitPerPixel=8) and (ft.Compress=0) then
begin
{начинаем читать файл}
BM.pixelformat := pf8bit;
{пропускаем описание файла}
for i:=0 to 255 do
blockread(f,Pal256[i],4);
GetMem(Buf, ft.SizeOfBMP);
BlockRead(f, Buf^, ft.SizeOfBMP);
I:=0;
for y := Bm.height - 1 downto 0 do
begin
for x := 0 to BM.width - 1 do
begin
t:=0;
z:=0;
t:=pal256[Buf^[i]] shl 24;
t:=t shr 8;
z:=pal256[Buf^[i]] shl 16;
z:=z shr 24;
t:=t or z shl 8;
t:=t or pal256[Buf^[i]] shr 16;
Bm.Canvas.Pixels[x,y]:=t;
Inc(i);
end;
If Bm.Width mod 4<>0 then Inc(i,4-BM.Width mod 4);
end;
Freemem(buf);
end;
{изображение с палитрой 4bit и без сжатия}
if (ft.BitPerPixel=4) and (ft.Compress=0) then
begin
{начинаем читать файл}
If Bm.Width mod 2=1 then Bm.Width:=Bm.Width+1;
BM.pixelformat := pf4bit;
{пропускаем описание файла}
for i:=0 to 15 do
blockread(f,Pal16[i],4);
GetMem(Buf, ft.SizeOfBMP);
BlockRead(f, Buf^, ft.SizeOfBMP);
I:=0;
for y := Bm.height - 1 downto 0 do
begin
x:=0;
repeat
T:=0;
z:=0;
KK[1]:=(Buf^[i]) shr 4;
KK[2]:=(Buf^[i]) shl 4;
KK[2]:=KK[2] shr 4;
t:=pal16[kk[1]] shl 24;
t:=t shr 8;
z:=pal16[kk[1]] shl 16;
z:=z shr 24;
t:=t or z shl 8;
t:=t or pal16[kk[1]] shr 16;
Bm.Canvas.Pixels[x,y]:=t;
t:=pal16[kk[2]] shl 24;
t:=t shr 8;
z:=pal16[kk[2]] shl 16;
z:=z shr 24;
t:=t or z shl 8;
t:=t or pal16[kk[2]] shr 16;
Bm.Canvas.Pixels[x+1,y]:=t;
x:=x+2;
Inc(i);
until x>=BM.width - 1;
If Bm.Width mod 8<>0 then Inc(i,4-Bm.Width mod 8 div 2);
end;
FreeMem(buf);
end;
{изображение с палитрой 1bit и без сжатия}
if (ft.BitPerPixel=1) and (ft.Compress=0) then
begin
{начинаем читать файл}
If Bm.Width mod 2=1 then Bm.Width:=Bm.Width+1;
BM.pixelformat := pf4bit;
{пропускаем описание файла}
for i:=0 to 1 do
blockread(f,Pal1[i],4);
GetMem(Buf, ft.SizeOfBMP);
BlockRead(f, Buf^, ft.SizeOfBMP);
I:=0;
for y := Bm.height - 1 downto 0 do
begin
x:=0;
repeat
KK[1]:=Buf^[i] shr 7;
KK[2]:=Buf^[i] shl 1;
KK[2]:=KK[2] shr 7;
KK[3]:=Buf^[i] shl 2;
KK[3]:=KK[3] shr 7;
KK[4]:=Buf^[i] shl 3;
KK[4]:=KK[4] shr 7;
KK[5]:=Buf^[i] shl 4;
KK[5]:=KK[5] shr 7;
KK[6]:=Buf^[i] shl 5;
KK[6]:=KK[6] shr 7;
KK[7]:=Buf^[i] shl 6;
KK[7]:=KK[7] shr 7;
KK[8]:=Buf^[i] shl 7;
KK[8]:=KK[8] shr 7;
For j:=1 to 8 do
begin
t:=0;
z:=0;
t:=pal1[KK[j]] shl 24;
t:=t shr 8;
z:=pal1[KK[j]] shl 16;
z:=z shr 24;
t:=t or z shl 8;
t:=t or pal1[KK[j]] shr 16;
Bm.Canvas.Pixels[x+j-1,y]:=t;
end;
x:=x+8;
Inc(i);
until x>=BM.width - 1;
If Bm.Width mod 32<>0 then Inc(i,4-ceil(Bm.Width mod 32 / 8));
end;
Freemem(buf);
end;
{изображение с палитрой 4bit и со сжатием}
if (ft.BitPerPixel=4) and (ft.Compress=2) then
begin
{начинаем читать файл}
BM.pixelformat := pf4bit;
Rle:=false;
{пропускаем описание файла}
for i:=0 to 15 do
blockread(f,Pal16[i],4);
GetMem(Buf, ft.SizeOfBMP);
BlockRead(f, Buf^, ft.SizeOfBMP);
I:=0;
X:=0;
y := Bm.height - 1;
Repeat
If Buf^[i]=0 then
Begin
inc(i);
If Buf^[i]=0 then
begin
y:=y-1;
x:=0;
end;
If Buf^[i]=1 then
begin
RlE:=true;
FreeMem(buf);
Exit;
end;
If Buf^[i]=2 then
begin
x:=x+Buf[i+1];
y:=y-Buf[i+2];
i:=i+2;
end;
If Buf^[i]>2 then
Begin
S:=Buf^[i];
ss:=s;
repeat
Inc(i);
KK[1]:=(Buf^[i]) shr 4;
KK[2]:=(Buf^[i]) shl 4;
KK[2]:=KK[2] shr 4;
t:=pal16[kk[1]] shl 24;
t:=t shr 8;
z:=pal16[kk[1]] shl 16;
z:=z shr 24;
t:=t or z shl 8;
t:=t or pal16[kk[1]] shr 16;
Bm.Canvas.Pixels[x,y]:=t;
S:=S-1;
X:=x+1;
If s>0 then
Begin
t:=pal16[kk[2]] shl 24;
t:=t shr 8;
z:=pal16[kk[2]] shl 16;
z:=z shr 24;
t:=t or z shl 8;
t:=t or pal16[kk[2]] shr 16;
Bm.Canvas.Pixels[x,y]:=t;
s:=s-1;
x:=x+1;
end;
until s<=0;
If ss mod 4 <> 0 then inc(i,(4-ss mod 4) div 2);
end;
end
else
Begin
S:=Buf^[i];
inc(i);
KK[1]:=(Buf^[i]) shr 4;
KK[2]:=(Buf^[i]) shl 4;
KK[2]:=KK[2] shr 4;
repeat
t:=pal16[kk[1]] shl 24;
t:=t shr 8;
z:=pal16[kk[1]] shl 16;
z:=z shr 24;
t:=t or z shl 8;
t:=t or pal16[kk[1]] shr 16;
Bm.Canvas.Pixels[x,y]:=t;
S:=S-1;
X:=x+1;
If s>0 then
Begin
t:=pal16[kk[2]] shl 24;
t:=t shr 8;
z:=pal16[kk[2]] shl 16;
z:=z shr 24;
t:=t or z shl 8;
t:=t or pal16[kk[2]] shr 16;
Bm.Canvas.Pixels[x,y]:=t;
s:=s-1;
x:=x+1;
end;
until s<=0;
end;
Inc(i);
until Rle;
end;
{изображение с палитрой 8bit и со сжатием}
if (ft.BitPerPixel=8) and (ft.Compress=1) then
begin
{начинаем читать файл}
BM.pixelformat := pf8bit;
{пропускаем описание файла}
for i:=0 to 255 do
blockread(f,Pal256[i],4);
GetMem(Buf, ft.SizeOfBMP);
BlockRead(f, Buf^, ft.SizeOfBMP);
X:=0;
y := Bm.height - 1;
Repeat
If Buf^[i]=0 then
Begin
inc(i);
If Buf^[i]=0 then
begin
y:=y-1;
x:=0;
end;
If Buf^[i]=1 then
begin
RlE:=true;
FreeMem(buf);
Exit;
end;
If Buf^[i]=2 then
begin
x:=x+Buf[i+1];
y:=y-Buf[i+2];
i:=i+2;
end;
If Buf^[i]>2 then
Begin
S:=Buf^[i];
// ss:=s;
repeat
Inc(i);
t:=pal256[Buf^[i]] shl 24;
t:=t shr 8;
z:=pal256[Buf^[i]] shl 16;
z:=z shr 24;
t:=t or z shl 8;
t:=t or pal256[Buf^[i]] shr 16;
Bm.Canvas.Pixels[x,y]:=t;
S:=S-1;
X:=x+1;
until s<=0;
// inc(i,ss mod 2);
end;
end
else
Begin
S:=Buf^[i];
inc(i);
for j:=1 to s do
begin
t:=pal256[Buf^[i]] shl 24;
t:=t shr 8;
z:=pal256[Buf^[i]] shl 16;
z:=z shr 24;
t:=t or z shl 8;
t:=t or pal256[Buf^[i]] shr 16;
Bm.Canvas.Pixels[x,y]:=t;
x:=x+1;
end;
end;
Inc(i);
until Rle;
end;
closefile(f);
end
else showmessage ('Открываемый файл не является файлом BMP');
end;
procedure SaveBMP(Bm:TBitmap; FF:Integer; Var name:string);
Var
f:File;
W,H:Integer;
X: string;
begin
W:=Bm.Width;
H:=Bm.Height;
If FF=1 then Bm.SaveToFile(name);
If FF=2 then
Begin
(* If name=''
AssignFile(f,name);
Rewrite(f);
reset(f,1);
{Запись заголовка файла}
blockwrite(f,'BM',2);
x:=inttostr(1078+H*W*3);
blockwrite(f,X,4);
x:=inttostr(0);
blockwrite(f,x,4);
x:=inttostr(1078);
blockwrite(f,x,4);
x:=inttostr(40);
blockwrite(f,x,4);
x:=inttostr(W);
blockwrite(f,x,4);
x:=inttostr(H);
blockwrite(f,x,4);
x:=inttostr(1);
blockwrite(f,x,2);
x:=inttostr($08);
blockwrite(f,x,2);
x:=inttostr(0);
blockwrite(f,x,4);
x:=inttostr(H*W*3);
blockwrite(f,x,4);
x:=inttostr(0);
blockwrite(f,x,4);
x:=inttostr(0);
blockwrite(f,x,4);
x:=inttostr(0);
blockwrite(f,x,4);
x:=inttostr(0);
blockwrite(f,x,4);
close(f); *)
Bm.PixelFormat:=pf8bit;
Bm.SaveToFile(name);
end;
If FF=3 then
begin
Bm.PixelFormat:=pf4bit;
Bm.SaveToFile(name);
end;
If FF=4 then
begin
Bm.PixelFormat:=pf1bit;
Bm.SaveToFile(name);
end;
end;
end.
|
|
24Bit преобразовать в 256, 16 и 2 цвета 
Загрузка ...
