Yeni bir forum kurmak | ©phpBB | Bedava yardımlaşma forumu | Suistimalı göstermek | Bir bloga sahip olmak
ForumAlem

ForumAlem
 
AnasayfaAnasayfa  SSSSSS  AramaArama  Üye ListesiÜye Listesi  Kullanıcı GruplarıKullanıcı Grupları  Kayıt OlKayıt Ol  Giriş yapGiriş yap  

Paylaş | 
 

 Pascal BMP Dosyalarının Gösterilmesi

Önceki başlık Sonraki başlık Aşağa gitmek 
YazarMesaj
ToPrAk
Admin
Admin
avatar

Mesaj Sayısı : 457
Kayıt tarihi : 05/08/08
Yaş : 28
Nerden : KONYA

MesajKonu: Pascal BMP Dosyalarının Gösterilmesi   Cuma Ağus. 08, 2008 6:05 pm

BMP Dosyalarının Pascal İle Gösterilmesi
Programınızda BMP dosya kullanmayı düşünüyorsanız çok faydalı bir döküman.BMP dosyalarının, Pascal ile gösterilmesi dört kısımda yapılabilir :
1. Dosyanın açılması ve başlığın okunması
2. Renk tablosunun okunması ve Set edilmesi.
3. Resim verilerinin okunup grafik ekrana yollanması.
4. Dosyanın kapatılması.

Giriş: Herhangi bir hata olduğunda hata kodunun saklanacağı değer BMPError olarak adlandırılmıştır. Hata mesaj numaraları isimlendirilirken ismin önüne "bm" eklenmiştir.

Const {Hata mesaj numaraları}
bmHataYok = 0;
bmDosyaAcma = 1;
bmDosyaOkuma = 2;
bmDosyaOS2 = 3;
bmLongGenislik = 4;
bmLongYukseklik = 5;
bm16Renk = 6;
bmMilyonRenk = 7;
bmCompressFile = 8;
bmRenkPaleti = 9;
bmGrafik = 10;
bmDosyaSonu = 11;
bmNotBMP = 12;

Const {Hata mesajları}
bmMesaj : Array[0..12] of String[60] =(
'bmp dosyası başarıyla okundu.',
'bmp dosyası yerinde yok...',
'bmp dosyası okunamıyor...',
'bmp dosyası OS2 formatında kaydedilmiş...',
'Resmin genişliği 1024"then büyük ',
'Resmin yüksekliği 768"then büyük ',
'bmp dosyası 16 renk renk kullanıyor...',
'bmp dosyası 256 renkten daha çok renk kullanıyor...',
'bmp dosyası sıkıştırılarak kaydedilmiş...',
'bmp dosyasından Renk Paleti okunamıyor...',
'Bgi256 çalışmıyor...',
'Dosya Sonu!',
'Dosya bmp dosya olarak kaydedilmemiş.');

Var
BMPError : byte; {Hata kodu değişkeni}

1. Dosyanın açılması ve başlığın okunması :

BMP dosyadan farklı büyüklükteki bilgiler okunacağı için, dosya tanımlaması olarak, tipi belirtilmemiş(file) dosya tanımlaması yapılması doğru olur. Ayrıca dosyayı açarken her okumada 1 byte okuyacak şekilde ayarlanması gerekmektedir.

Var
BMPDosya : File; {BMP dosya değişkeni}

Assign(BMPDosya, DosyaIsmi); {Dosya tanımlaması}
{$I-} {Giriş - Çıkış hata sinyalini kapat}
Reset(BMPDosya, 1);{Dosyayı okuma modunda, her defasında 1 byte okuyacak şekilde aç }
If ioResult <> 0 then {Hata varsa dosya yerinde yoktur.}
begin
BMPError := bmDosyaAcma;
exit;
end;
{$I+} {Giriş - Çıkış hata sinyalini aç}

Dosya açildiktan sonra BMP header bilgilerinin alinmasi gereklidir. Onun için Type bölümünde bir Header tanimlanir ve header degiskenine esitlenir. Header söyle olamalidir.

Type {BMP header yapısı}
Theader = record
İz : array[1..2] of char; {BM}
FileSize : Longint; {Dosya uzunlığu}
Reserved : Longint; {0}
OfsetData : Longint; {Görüntü verisinin dosya içinden nereden başladığı}
InfoSize : Longint; {Başlığın bu kısımdan itibaren uzunluğu}{40 Windows bmp}
Width : Longint; {Görüntünün genişliği}
Height : Longint; {Görüntünün yüksekliği}
Planes : Word; {1 olmak zorunda}
NBits : word; {piksel başına bit sayısı}
CompType : longint; {sıkıştırma tipi}
CompSize : Longint; {Sıkıstırılmış görüntünün uzunluğu}
RowCoz : Longint; {Satır çözünürlüğü}
ColonCoz : Longint; {Sütün çözünürlüğü}
RenkCount : Longint; {kullanılan renk sayısı}
OnemliRenkCount : Longint; {Önemli renklerin sayısı}
End;

Var
Header : Theader;

Daha sonra Header dosyadan okunur. Ve gerekli kontroller yapılır.

Var
Okunan : Word; {Dosyadan Okunan byte sayısı}

{$I-} {Giriş - Çıkış hata sinyalini kapat}
BlockRead(BMPDosya, Header, SizeOf(Header), Okunan); {Başlık kısmını oku}
if (ioResult<>0) or (Okunan < SizeOf(Header)) then
begin
BMPError := bmDosyaOkuma;
exit;
end;

{$I+} {Giriş - Çıkış hata sinyalini aç}
if Header.iz <> 'BM' then {BMP mi?}
begin
BMPError := bmNotBMP;
Exit;
end;

if Header.InfoSize <> 40 then {Windows_BMP mi?}
begin
BMPError := bmDosyaOS2;
Exit;
end;


2. Renk tablosunun okunması ve Set edilmesi.

Renk tablosunun okunması için önce dosyanın kullandığı renk sayısı bulunmalıdır. Bu bilgi başlık kısmındaki Nbits değişkenine aktarılmaktadır.

var
ColorCount : word; {Kullanılan Renk sayısı}

Case Header.nBits of
4 : ColorCount := 16;
8 : ColorCount := 256;
end;


Dosyadaki renk paletinin yerleşimi farklı olduğu için iki farklı renk paleti hazırlanmalıdır. Bunlar VGA DAC için renk paleti ve BMP dosyasının renk paleti. VGA DAC için Renk paleti şöyle olmalıdır;

Type
TRgb = Record {Renk Tanımlaması}
Red, Green, Blue : byte;
end;
TRgb256 = array[0..255] of TRgb; {256 renkli grafikler için Renk Paleti}


BMP dosyası için Renk paleti ise;

Type {BMP dosyadaki renk sistemi yapısı}
TrenkDizisi = Record {Renk Tanımlaması}
Mavi, Yesil, Kirmizi : byte;
Reserved : byte;
end;
TrenkPaleti = array[0..255] of TRenkDizisi; {256 renkli grafikler için Renk Paleti}

var
RenkPaleti : TRenkPaleti;


Daha sonra renk sayısına göre dosyadan renkler okunmalıdır.

{$I-} {Giriş - Çıkış hata sinyalini kapat}
BlockRead(BMPDosya, RenkPaleti, ColorCount * 4, Okunan);
{$I+} {Giriş - Çıkış hata sinyalini aç}


Okunan renk tablosunun VGA DAC' a aktarılması gerekmektedir. Aktarırken bazı dikkat edilmesi gereken hususlar vardır. Bunlar renklerin ters sırada olduğu dikkate alınıp doğru eşleme yapılması. Fazladan bir byte fazla kaydedilmiş olması ve DAC' a yazarken değerlerin dörde bölünerek yazılması.

var
Count : byte; {Sayaç}

for count := 0 to ColorCount -1 do
begin
Rgb256[Count].Red := RenkPaleti[Count].Kirmizi shr 2;
Rgb256[Count].Green := RenkPaleti[Count].Yesil shr 2;
Rgb256[Count].Blue := RenkPaleti[Count].Mavi shr 2;
end;


Elde edilen tabloyu DAC' a aktarmak için aşağıdaki procedure' ün kullanılması işlemlere hız kazandırır.


procedure SetVGA256(var tp : TRgb256; segment, ofset, RC : word); assembler;
asm mov ax, 1012h;
mov bx, 0;
mov cx, Rc;
mov es, Segment;
mov dx, Ofset;
int 10h;
end;


Verilecek olan komut ise;
SetVga256(Rgb256, Seg(Rgb256), Ofs(Rgb256), ColorCount - 1);

3. Resim verilerinin okunup grafik ekrana yollanması:
Bmp dosyalarda her satır dördün katı olacak şekilde kaydedilmiştir. Fazlalık olan byte'lar önemsizdir. Bundan dolayı dosyadan bir satır okurken başlık kısmında verilen Width {Görüntünün genişliği} bilgisi kadar değil de Width bilgisinden büyük dörde bölünebilen ilk sayı kadar okumak gereklidir. Ya da Width kadar okuyup önemsiz byte'ları atlamak gerekmektedir. Genişliği dörde tamamlayacak bir fonksiyon aşağıda verilmiştir.

{Verilen sayıdan büyük 4'e bölünen sayıyı bulur}
function DordeTamamla(a : word) : word;
var
b : byte;

begin
b := 4 - (a mod 4);
if b <> 4 then DordeTamamla := a + b else DordeTamamla := a;
end;


Geriye kalan ters sırada kaydedilmiş olan görüntü verilerini okuyup grafik ekrana yazılmasıdır. Bu basit mantıkla da yapılabilir ancak işlemlere biraz hız kazandırmak amacıyla dosyadan bir defada okuyabileceğimiz en çok veriyi hafızaya alıp bu hafızadan grafik ekrana yazılması daha doğru olacaktır. Aşağıdaki fonksiyon bunu gerçekleştirmek için hazırlanmıştır. Fonksiyonun görevi dosyadaki sonraki bir byte'lık veriyi bulmaktır. Ancak bu işlemi yaparken dosyadan maksimum bilgiyi bir tampona atıp, buradan veriyi vermektedir. Tampon boşalınca tekrar tamponu doldurmaktadır.

const {Dosyadan Okunacak maxsimum byte sayısı}
MaxCodes = 4095;

Type {Resim datalarının saklanacağı değişken}
TData = array[1..MaxCodes] of byte;

Var
Sonraki, ToplamData : Longint;
Data : TData;

function NextCode : byte; {sonraki datayı bulur}

procedure BlokOku; {Dosyadan diziye veri okuma}
begin
{$I-} {Giriş - Çıkış hata sinyalini kapat}
BlockRead(BMPDosya, Data, sizeof(Data), Okunan); {Blok genişliği}
if (ioResult <> 0) or (Okunan = 0) then BMPError := bmDosyaSonu; {kadar oku}
{$I+}
Sonraki := 1; {sonraki datayı hazırla}
ToplamData := Okunan;
end;

begin
if ToplamData <= 0 then {toplam data sıfırsa dosyadan oku}
begin
BlokOku; {Dosyadan diziye veri oku}
if BMPError = bmDosyaSonu then exit;
end;

NextCode := Data[Sonraki]; {Sonraki datayı bul}
Dec(ToplamData);
İnc(Sonraki);
end;


Grafik ekranın açmak için Bgi256 kullanılabilir. Bunun için Bgi256.bgi dosyasının olması gerekmektedir.


procedure Bgi256(Gm : integer);
var
GraphDriver, GraphMode, ErrorCode : integer;

begin
GraphDriver := InstallUserDriver('bgi256', nil);
GraphMode := Gm;
InitGraph(GraphDriver, GraphMode, ");
ErrorCode := GraphResult;
if ErrorCode <> grOk then
begin
BMPError := bmGrafik;
Bgi := False;
Exit;
end
else
Bgi := True;
end;


16 ve 256 renkli dosyaları açmak aşağıdaki prosedürden yararlanılir.


procedure ViewBMP(Xmin, Ymin : word);
var
MaxLine : Word;
Reserved : byte;
XCount : Word;
Line : array[0..1023] of byte;
Tmp : byte;

Procedure LineView;
var
i : word;
begin
for i := 0 to Header.Width - 1 do Putpixel(Xmin + i , Ymin + MaxLine - 1, Line[i]); {Ekrana Çiz}
Xcount := 0; {Satir Sayacı = 0}
Dec(MaxLine); {Y'yi bir azalt}
if MaxLine < 0 then BMPError := bmDosyaSonu; {Y=0 ise çık}
for i := 1 to Reserved do NextCode; {Boşa olan dataları atla}
end;

begin
if BMPError <> bmHataYok then exit; {Hata varsa çık}
Reserved := DordeTamamla(Header.Width) - Header.Width;
MaxLine := Header.Height; {Görüntü yüksekliği}
Seek(BMPDosya, Header.OfsetData); {Görüntünün başına gel}
Xcount := 0; {Satir Sayacı = 0}
ToplamData := -1; {NextCode'da Blok Okuması için}
Repeat
Case ColorCount of
256 : begin
Line[XCount] := NextCode; {Datayı Satıra al}
inc(XCount); {Bir arttır}
end;
16 : begin
tmp := NextCode; {Datayı Satıra al}
Line[XCount] := tmp shr 4;
inc(XCount); {Bir arttır}
Line[XCount] := tmp and $0F;
inc(XCount); {Bir arttır}
end;
end;
if XCount >= Header.Width then LineView; {Satir sonu}
until BMPError = bmDosyaSonu; {Dosya sonuna gelince çık}
if BMPError = bmDosyaSonu then BMPError := bmHataYok; {Eğer dosya sonuysa normal}
end;


4. Dosyanın kapatılması:


if not ((BMPError = bmDosyaAcma) or (BMPError = bmDosyaOkuma)) then Close(BMPDosya); {Dosya Açılmışsa kapat}
end.
Sayfa başına dön Aşağa gitmek
Kullanıcı profilini gör
 
Pascal BMP Dosyalarının Gösterilmesi
Önceki başlık Sonraki başlık Sayfa başına dön 
1 sayfadaki 1 sayfası

Bu forumun müsaadesi var:Bu forumdaki mesajlara cevap veremezsiniz
ForumAlem :: Programlama Dilleri :: PascaL-
Buraya geçin: