Programowanie w języku Delphi » Gotowce

CMP

<center>Własny zapis pliku graficznego</center>

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

Piotrekdp 2007-08-26 10:21

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'

Piotr_Gil 2004-04-18 18:06

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

CyberKid 2003-08-13 00:23

a czy nie lepiej zamiast tego

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

zrobić

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

AndRew 2003-06-17 22:53

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

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

psychoszayber 2003-06-05 22:30

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.

brodny 2003-06-02 20:54

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