Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2004.05.02;
Скачать: [xml.tar.bz2];

Вниз

Принцип работы c TBitMap ...   Найти похожие ветки 

 
Cosinus ©   (2004-04-15 13:59) [0]

Добрый день. Я пишу программу, которая представляет любой файл в качестве графического,т.е. допустим первый байт в файле $ff, тогда первая верт.линия (состоящая из 8 пикселей) будет вся черная, если $7f, то первый пиксель не закрашивается и тд. В итоге 3-ех часовых мучений я родил вот это, но она работает не совсем корректно. В первом столбце идет какой то сбой с координатами и я получаю картинку, где помимо черного явно присутствуют как красный, так и зеленый с синим в чистом виде. Никак не пойму в чем дело. И второй - в принципе, все работает довольно быстро, но хотелось бы попробовать еще увеличить скорость. Можно ли это как то сделать? Заранее благодарен.
Если необходимо, могу куда-нибудь выложить скриншот того, что у меня получается.

type
     TRGB=record
     r,g,b:byte;
     end;
     ARGB=array [0..1] of TRGB;
     PARGB=^ARGB;

var
 Form1: TForm1;
 b:TBitMap;
 
implementation

{$R *.dfm}

procedure Tform1.ShowBlock;
var
 Buffer:PChar;
 i,ColWidth,ColCount,ColHeight:integer;
 bt:byte;
 ColWidthMax,ColCountMax,ColHeightMax:Integer;
 p:PARGB;
 x,y:integer;
begin
   b:=TBitMap.Create;
   b.pixelformat:=pf1bit;
   b.width:=Clientwidth;
   b.height:=ClientHeight;

 GetMem(Buffer,$01);
 ColWidthMax:=64;
 ColHeightMax:=image1.Height div 8;
 ColCountMax:=image1.Width div ColWidthMax;
 For ColCount:=0 to ColCountMax do
   For ColHeight:=0 to ColHeightMax do
     for ColWidth:=1 to ColWidthMax do
     begin
       Mem.ReadBuffer(buffer^,$01);
       Bt:=ord(Buffer[0]);
       for i:=1 to 8 do
       begin
         if odd(bt) then
         begin
         p:=b.scanline[i+ColHeight*8];
         p[ColWidth+ColCount*ColWidthMax].r:=0;
         p[ColWidth+ColCount*ColWidthMax].g:=0;
         p[ColWidth+ColCount*ColWidthMax].b:=0
         end;
         Bt:=bt shr 1
       end
     end;
   FreeMem(Buffer);
   Image1.canvas.draw(0,0,b);
b.Free
end;

procedure TForm1.Open1Click(Sender: TObject);
begin
PatBlt(Image1.Canvas.Handle, 0, 0, image1.ClientWidth, image1.ClientHeight, WHITENESS);
 if OpenDialog1.Execute then
    Mem:= TMemoryStream.Create;
 Mem.LoadFromFile(OpenDialog1.FileName);
 ShowBlock;
 Mem.Free
end;


 
Cosinus ©   (2004-04-15 14:29) [1]

Может вопрос некорректно поставлен? Поправьте меня если это так. Или может он банален и встречается на каждом шагу? Скажите мне об этом.
Еще раз благодарен.


 
Cosinus ©   (2004-04-15 15:12) [2]

Up


 
Amoeba ©   (2004-04-15 15:34) [3]

У тебя b.pixelformat:=pf1bit; т.о. каждый байт в ScanLine кодирует 8 смежных пикселей. Не понятно, зачем при формате 1 бит нужен
type
    TRGB=record
    r,g,b:byte;
    end;
    ARGB=array [0..1] of TRGB;
    PARGB=^ARGB;

и все последующие манипуляции с его использованием. Просто попытка скрестить ужа с ежом.
Вобщем, каша какая-то в голове и в коде...



Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2004.05.02;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.45 MB
Время: 0.047 c
11-1066976000
jab~
2003-10-24 10:13
2004.05.02
KOLGraphic


1-1081943575
Алексей2
2004-04-14 15:52
2004.05.02
Как "превратить" строку в имя переменной?:


9-1068383106
G A M E R
2003-11-09 16:05
2004.05.02
LOD


9-1069678339
Eagle Owl
2003-11-24 15:52
2004.05.02
DirectX Help


1-1082287187
Андрей Сенченко
2004-04-18 15:19
2004.05.02
Поймать ответ ShellExecute в случае ошибки





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский