Прямо "на живо" в проект добавить увы не получилось ....
Сделал согласно "Заветам zub-а " не сколько тестовых программ
Вот самая простая ...
- Код: Выделить всё
unit BTun1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
Buttons, StdCtrls;
type
{ TBTForm }
TBTForm = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Image1: TImage;
Image2: TImage;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
OpenDialog1: TOpenDialog;
Panel1: TPanel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject); // Конверсия
procedure Button3Click(Sender: TObject);.// Тест
private
public
const B1:TBitmap=nil;
end;
var
BTForm: TBTForm;
implementation
{$R *.lfm}
{ TBTForm }
// Загрузка (Картинка должна быть 24 бита и бинаризированная (два цвета черный и "не черный") )
procedure TBTForm.Button1Click(Sender: TObject);
Var f:String;
begin
GetDir(0,F);
OpenDialog1.InitialDir:=F;
OpenDialog1.FileName:='*.bmp;*.jpg;*.png';
If OpenDialog1.Execute then begin
image1.Picture.LoadFromFile(OpenDialog1.FileName);
end;
end;
// Конверсия в 1 Бит
procedure TBTForm.Button2Click(Sender: TObject);
Type A=Array[0..1] Of byte;
var X,Y:Integer;
BA,ba2:^A;
begin
if B1= nil then b1:=TBitmap.Create else exit;
B1.PixelFormat:=pf1bit;
b1.SetSize(image1.Picture.Bitmap.Width,image1.Picture.Bitmap.Height);
For Y:=0 To b1.Height-1 do
Begin
b1.BeginUpdate;
ba:=b1.ScanLine[y];Ba2:=image1.Picture.Bitmap.ScanLine[y];
For X:=0 To B1.Width-1 do
begin
If BA2^[x * 3]+BA2^[x * 3+1]+BA2^[x * 3+2]<>0
then Ba^[X div 8 ]:=Ba^[X div 8 ] or (1 shr 7-(x mod 8) );
end;
b1.EndUpdate;
end;
//b1.Canvas.Draw(0,0,image1.Picture.Bitmap);
image2.Picture.Bitmap.
SetSize(B1.Width,b1.Height);
image2.Picture.Bitmap.Canvas.Draw(0,0,b1);
label3.Caption:=' Размер 24 бита°: '+
IntToStr(Image1.Picture.Bitmap.RawImage.DataSize)+' Размер 1 бит‚ : '+
IntToStr(B1.RawImage.DataSize);
end;
// Тест
procedure TBTForm.Button3Click(Sender: TObject);
Type A=Array[0..1] Of byte;
var X,Y:Integer;
BA,ba2:^A;
myTime:TDateTime;
ts:String;
begin
if B1= nil then exit;
myTime:=now;
For Y:=0 To b1.Height-1 do
begin
image1.Picture.Bitmap.BeginUpdate;
Ba2:=image1.Picture.Bitmap.ScanLine[y];
for X:=0 To B1.Width-1 do
begin
BA2^[x * 3] :=Not BA2^[x * 3];
BA2^[x * 3+1]:=Not BA2^[x * 3+1];
BA2^[x * 3+2]:=Not BA2^[x * 3+2];
end;
image1.Picture.Bitmap.endUpdate;
end;
image1.Refresh;
str((now-myTime)*10e4:2:5,ts);
Label1.Caption:='Время 24 Bit: '+ts;
myTime:=now;
For Y:=0 To b1.Height-1 do begin
b1.BeginUpdate;
ba:=b1.ScanLine[y];
For X:=0 To B1.Width-1 do
begin
if x mod 8 =0 then Ba^[X div 8 ]:= not Ba^[X div 8 ] ;
end;
b1.endUpdate;
end;
str((now-myTime)*10e4:2:5,ts);
Label2.Caption:='Время1 Bit: '+ts;
image2.Picture.Bitmap.Canvas.Draw(0,0,b1);
end;
end.
Сразу возникла непонятка обычно нормально работающий с разной битностью Canvas.Draw ( b1.Canvas.Draw(0,0,image1.Picture.Bitmap); ) в 1 бит копировать отказался ...
Ну если гора не идет нам навстречу .... это с ее стороны как минимум не вежливо !
Поэтому конвертирую сам !
- Код: Выделить всё
For Y:=0 To b1.Height-1 do
Begin
b1.BeginUpdate;
ba:=b1.ScanLine[y];Ba2:=image1.Picture.Bitmap.ScanLine[y];
For X:=0 To B1.Width-1 do
begin
If BA2^[x * 3]+BA2^[x * 3+1]+BA2^[x * 3+2]<>0
then Ba^[X div 8 ]:=Ba^[X div 8 ] or (1 shr 7-(x mod 8) );
end;
b1.EndUpdate;
end;
Причем работает даже если убрать b1.BeginUpdate; и b1.EndUpdate; (Интересно почему ? )
На третью кнопку цепляю тест времени исполнения простершей инверсии изображения ...
Вуаля! ускорение примерно в четыре раза (...0.09с против 0.02с)
Почему не в ожидаемые 8 раз не понятно но и это не плохо ...
И так вопросы :
1 Как сделать быстрый доступ к пикселю на запись и чтение ?
(Способ вроде Ba^[X div 8 ]:=Ba^[X div 8 ] or (1 shr 7-(x mod 8 ) ) ; не выглядит особо оптимальным ....)
2 Почему не работает b1.Canvas.Draw(0,0,image1.Picture.Bitmap); но работает image2.Picture.Bitmap.Canvas.Draw(0,0,b1); ?
В 1 бит конвертировать не получается, а вот обратно сколько угодно !
3 С чем быстрее работать с битмапом в 1 бит или 1 байт (8 бит ) ?
