CMP

psychoszayber

Własny zapis pliku graficznego

Wiem że to jest nie potrzebne bo od czego są Bitmapy, Gify, Jpegi ale głównie dlatego to piszę ponieważ nie mam pomysłów na inne arty, a chce pokazać jak to można zrobić; zresztą to jest biblioteka DLL w moim systemie OS. Ten art jest raczej dla początkujących niż choćby dla średnio-zaawansowanych. Użyję Double-Bufferingu, (Jeśli nie wiesz, co to jest to na końcu wyjaśnię) żeby było szybciej ładować obrazki z pliku.

W kodzie użyje techniki "Block" (jeśli wiesz co to jest, to nie czytaj) czyli
BlockRead i BlockWrite

Składnia:

    BlockWrite(var F:file; const Buf; Count:integer);
    BlockRead(var F:file; var Buf; Count:integer);

Gdzie:

F = Plik
Buf = Dowolna zmienna (nawet Array)
count = ilość zapisywanych znaków w pliku (więcej niż 1 tylko jeżeli buf to array albo string)

Bardzo się nam to przyda przy zapisywaniu R,G,B czyli 3 Byte'ów.

Jeszcze jedno CMP to jest skrót od Color MaP

Na początku trzeba zadeklarować zmienną globalną (Double-Buffering)

var
db:Tbitmap;

Kliknij na Formę, Na zakładkę, onCreate I wpisz:

    Db:=Tbitmap.Create;

Teraz zrobimy procedurkę do zapisu:

Procedure SaveCMP(S:string);
var
X,Y:Integer;
F:File;
RGB:array [1..3] of byte;
W,H:string;
 
// zaczynamy
 
begin
 
//Wiążemy plik ze zmienną
 
Assignfile(F,S);
Rewrite(F,1);
 
//Zapisujemy wysokość i szerokość
 
W:=inttostr(db.width);
H:=inttostr(db.height);
 
blockwrite(F,W,5);
blockwrite(F,H,5);
 
// cała funkcja liczenia
 
For Y:=0 to db.height do
For X:=0 to db.width do
begin
RGB[1]:=getRvalue(db.canvas.pixels[x,y]);
RGB[2]:=getGvalue(db.canvas.pixels[x,y]);
RGB[3]:=getBvalue(db.canvas.pixels[x,y]);
blockwrite(F,RGB,3);
application.processmessages; //żeby było szybciej
end;
 
// Mniej więcej na podobnej
// zasadzie opiera się BMP, ale dokładnie nie wiem
 
end;

Oczywiście to wcale nie pójdzie :( . Tylko żartowałem :)
ale przed użyciem tej procedury obrazek typu TImage musi się znaleźć
w zmiennej db.
Proponuje kodzik (zakładając, że twój TImage nazywa się "Image"):

db.width:=image.picture.width;
db.height:=image.picture.height;
db.canvas.CopyRect(rect(0,0,image.picture.width,image.picture.height),image.canvas,rect(0,0,image.picture.width,image.picture.height));

Teraz procedura odczytująca:

Procedure LoadCMP(S:string);
var
X,Y,I:Integer;
F:File;
col:array [1..3] of byte;
num:array [1..5] of byte;
str:string;
 
// zaczynamy
 
begin
 
//Wiążemy plik ze zmienną
 
Assignfile(F,S);
Reset(F,1);
 
//Odczytujemy wysokość i szerokość
 
blockread(F,num,5);
 
//Zabezpieczenie 1
 
for I:=1 to 5 do
if (num[I]<>ord('0')) and
(num[I]<>ord('1')) and
(num[I]<>ord('2')) and
(num[I]<>ord('3')) and
(num[I]<>ord('4')) and
(num[I]<>ord('5')) and
(num[I]<>ord('6')) and
(num[I]<>ord('7')) and
(num[I]<>ord('8')) and
(num[I]<>ord('9')) then application.ProcessMessages else
str:=str+chr(num[i]);
db.width:=strtoint(str);
 
blockread(F,num,5);
 
//Zabezpieczenie 2
str:='';
for I:=1 to 5 do
if (num[I]<>ord('0')) and
(num[I]<>ord('1')) and
(num[I]<>ord('2')) and
(num[I]<>ord('3')) and
(num[I]<>ord('4')) and
(num[I]<>ord('5')) and
(num[I]<>ord('6')) and
(num[I]<>ord('7')) and
(num[I]<>ord('8')) and
(num[I]<>ord('9')) then application.ProcessMessages else
str:=str+chr(num[i]);
db.height:=strtoint(str);
str:='';
 
// cała funkcja liczenia
 
For Y:=0 to db.height do
For X:=0 to db.width do
begin
blockread(F,col,3);
db.canvas.pixels[x,y]:=rgb(col[1],col[2],col[3]);
application.processmessages; //żeby było szybciej
end;
 
end;

To także od razu nie pójdzie, ale po procedurze napisz:

image.width:=db.width;
image.height:=db.height;
image.canvas.CopyRect(rect(0,0,db.width,db.height),db.canvas,rect(0,0,db.width,db.height));

Więc teraz wytłumaczę Double-Buffering.
To jest nic innego jak tylko odczyt obrazka z pliku
i zapisywanie go w pamięci a jak już się cały załaduje to
Dopiero kopiujemy go z pamięci do TImage.
Jeśli i tak nie rozumiesz to gdzieś w dziale Delphi jest o tym
Artykuł.

Dzięki temu kodowi można zapisać obrazek MAX 99999 x 99999 (wysokość x szerokość) i można uzyskać 256 x 256 x 256 (Red x Green x Blue [Czerwony x Zielony x Niebieski]) kolorów na pixel; Czyli 16777216 kolorów na pixel.

Och aż (ok.) 190 linii.

Bye Bye Psychoszayber.

6 komentarzy

to już lepiej tak Pomijając że to bez celowe i nie potrzebne :):
Format Nieco inny :)
3 Byte'owy - Nagłówek
4 Byte'owy- Szerokość
4 Byte'owy -Wysokość
Kolejno barwy Pixeli w kolejności BGR

procedure SaveColorMap( Bitmap:TBitmap;FileName:String);
const header='GCM';
var
Memory:TMemoryStream;
BWidth,BHeight,W,H:Integer;
PixelWsk:^TRGBTriple;
begin
try
Bitmap.PixelFormat :=pf24Bit;
Memory:=TMemoryStream.Create;
Memory.WriteBuffer(Pchar(header)^,Length(header));  //zapisujemy nagłowek
BWidth:=Bitmap.Width ;        //pobieramy wymiary bitmapki
BHeight:=Bitmap.Height ;
Memory.WriteBuffer(BWidth,Sizeof(BWidth));  //zapisujemy wymiary
Memory.WriteBuffer(BHeight,Sizeof(BHeight));
for H:=0 to BHeight-1 do
  begin
  PixelWsk:=Bitmap.Scanline[H];
  for W:=0 to BWidth -1 do
    begin
    Memory.WriteBuffer(PixelWsk^,Sizeof(PixelWsk^)); //zapisujemy wartość wskaźnika
    inc(PixelWsk); //przesuwamy wskaźnik
    end;
  end;
  Memory.SaveToFile(FileName);
  finally
  Memory.Free;
  end;
end;
 
procedure LoadColorMap( var  Bitmap:TBitmap;FileName:String);
const header='GCM';
var
Memory:TMemoryStream;
W,H:Integer;
PixelWsk:^TRGBTriple;
Head:array[1..Length(header)]of Char;
begin
try
Memory:=TMemoryStream.Create;
Memory.LoadFromFile(FileName);
Memory.ReadBuffer(Head,Length(header));  // odczytujemy nagłowek do porównania
if Head = header then   // jak nagłowek zgadza się to robimy resztę inaczej wywalamy błąd o złym typie pliku
  begin
Bitmap.PixelFormat :=pf24Bit;
Memory.ReadBuffer(W,Sizeof(W));  //czytamy wymiary bitmapy
Memory.ReadBuffer(H,Sizeof(H));
Bitmap.Width :=W;   //no i ustawiamy te wymiary
Bitmap.Height :=H;
 
  for H:=0 to Bitmap.Height-1 do
 begin
  PixelWsk:=Bitmap.ScanLine[H];
  for W:=0 to Bitmap.Width -1 do
  begin
 Memory.ReadBuffer( PixelWsk^,Sizeof( PixelWsk^));  //czytam wartości BGR
   inc(PixelWsk);        //powiększam wskaźnik
 
   end;
  end;
end
   else Messagebox(0,'Graphic Color Map Invalid','Error',0);
  finally
Memory.Free;  //Po skończonej pracy zwalniam Zmienną :)
  end;
end;

A Lepiej Bo:
1.ScanLine jest szybszy
2.Plik Posiada Nagłówek (identyfikacja)
3.Mamy do dyspozycji cały Integer a nie jakieś słowne '9999'

Czemu daliście mu jednyki? Ten art zasługuje na wyższą ocene, chociaż 4. A co do sposobu CyberKida - koleś, przeca to przepuści na elese wszystko oprócz 1 i 9. Tak jest lepiej

a czy nie lepiej zamiast tego

if (num[I]<ord('0')) and<br="and&lt;br" /> (num[I]<ord('1')) and<br="and&lt;br" /> (num[I]<ord('2')) and<br="and&lt;br" /> (num[I]<ord('3')) and<br="and&lt;br" /> (num[I]<ord('4')) and<br="and&lt;br" /> (num[I]<ord('5')) and<br="and&lt;br" /> (num[I]<ord('6')) and<br="and&lt;br" /> (num[I]<ord('7')) and<br="and&lt;br" /> (num[I]<ord('8')) and<br="and&lt;br" /> (num[I]<ord('9')) then="then" else="else" </p="&lt;/p" application.processmessages="application.ProcessMessages">

zrobić

if (num[I]<ord('0')) and
(num[I]>ord('9')) then application.ProcessMessages else
?????????

/cyt/ application.processmessages; // żeby było szybciej /cyt/

wierz mi, nie będzie szybciej.. dlaczego ? pomyśl..

Możę ale nie wiem czy będę miał czas.
Ps. Mam już algorytm na GIFa i AVI ale wątpie czy dałbym radę w Wavie albo mp3.

Fajnie, ale może napiszesz jeszcze, jak stworzyć swojego GIF'a, Flash'a, AVI, WAV'a, MP3 itp. itd??? ;)