Solved

Black and white picture making like a Matrix printer...

Posted on 2003-11-02
16
345 Views
Last Modified: 2010-04-03
Hi.

I want to convert a colorfull bitmap to balck and white.
How can I do it ? The Bitmap.PixelFormat:=pf1bit; is not too good.
Beacuse a light picture will hide.
The best solve like a matrix printer : dark = close pixels;
                                                     light = rare pixxels.

How can I do it in Delphi ?
0
Comment
Question by:wwwbetyar
  • 10
  • 6
16 Comments
 
LVL 34

Expert Comment

by:Slick812
ID: 9666974
hello wwwbetyar, can you give some more information about the "Bitmap" that you want to Have as your result of the conversion. . . mostly information about the PixelFormat, or if you have any specs for the conversion. . . You can do a scan line an convert all the color pixels to a shade of grey (a 24-bit pixel format). .  you could also do an 8-Bit conversion or an 4-Bit conversion. . . but a 1-Bit conversion will never look  very good even if you rasterize it to simulate greys
0
 

Author Comment

by:wwwbetyar
ID: 9669343
Hi

The great thing is that I have 2 colors as Black and White, no more.
If I use 1-Bit , the picture is not recognizable. But
If I print a color bitmap to a matrix printer (for ex. Epson) I get a picture
where darknes pixels are dense and the light pixels are rare, so this picture
is recognizable.
So I want to do this with the picture, whithout print. And I have no any idea how
I can do this.
I show you with a picture as soon as posible...
0
 

Author Comment

by:wwwbetyar
ID: 9669687
0
Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
LVL 34

Expert Comment

by:Slick812
ID: 9674135
I really do not care about how the picture may or may not look on a printer. . . I have used many color to Greyscale conversions. .  and I need to know
 WHAT COLOR FORMAT YOU WANT YOUR RESULT BITMAP IN

your choises are

pf1Bit
pf4Bit
pf8Bit
pf24Bit
pf32Bit

- - - - - - - - - - - -

and the web addy you gave for the picture will not load
0
 

Author Comment

by:wwwbetyar
ID: 9674157
Ah !

I need a dirther algorythm in delphi
0
 

Author Comment

by:wwwbetyar
ID: 9674609
sorry Slick812

"pf1Bit" but I saw : the bitmap format does not care.
the web addy my gave.... sorry be patient. and you will see the different.
http://www.extra.hu/wwwbetyar/pic/  ->500Kb

I searched a lot and I found that i need : a dirther converter algorithm, and the picture will good for me.

Can you help me ?
0
 

Author Comment

by:wwwbetyar
ID: 9674610
sorry Slick812

"pf1Bit" but I saw : the bitmap format does not care.
the web addy my gave.... sorry be patient. and you will see the different.
http://www.extra.hu/wwwbetyar/pic/  ->500Kb

I searched a lot and I found that i need : a dirther converter algorithm, and the picture will good for me.

Can you help me ?
0
 

Author Comment

by:wwwbetyar
ID: 9674636
sorry dither
0
 
LVL 34

Accepted Solution

by:
Slick812 earned 140 total points
ID: 9675927
OK,  but since you requested a dithering I will assume that a 1-Bit bitmap is what you need. The following code is for a button click, it has my own very simplistic dithering, It creates a 4-Bit greyscale Copy of the original 24-bit color bitmap, And then it does scanlines for the 4-Bit and One-Bit bitmap, to map a dithering pattern into the 1-Bit bitmap, which is done by averaging a 4x4 block of pixels in the greyscale and does a simulated grey scale replacement into the 1-Bit bitmap. This technique is sometimes called "Ordered Dither". There are dithering techniques that are better like the Floyd-Steinberg or Burkes or Stucki Error Diffusion methods, but these are way more complicated.



procedure TForm1.sbut_AverPixelClick(Sender: TObject);
const
aryDotMap: Array[0..15] of Word =
    ($0000,$0400,$0401,$0501,
     $0505,$0525,$A425,$A5A5,
     $A7A5,$E5B5,$F5B6,$F5F5,
     $F5FD,$F7FD,$F7FF,$FFFF);
var
Bmp1, Bmp2: TBitmap;
MyPal: TMaxLogPalette;
i, hPal, X, Y, Mod1: Integer;
aryP4Bit: Array[0..3] of PByteArray;
aryP1Bit: Array[0..3] of PByteArray;
PalNum, PalNum2: Integer;
aryPalNum: Array[0..15] of Integer;
begin
Bmp1 := TBitmap.Create;
Bmp1.LoadFromFile('E:\dither test.bmp');
{the bitmap above is a 24 Bit pixel format}

Bmp2 := TBitmap.Create;
{Bmp2 will be a 4-Bit 16 grey color bitmap, to get the
true color of Bmp1 converted to 16 basic shades of grey}
MyPal.palVersion := $300;
MyPal.palNumEntries := 16;
for i := 0 to 15 do
  TColor(MyPal.palPalEntry[i]) := (i shl 4) or (i shl 12) or (i shl 20);
hPal := CreatePalette(PLogPalette(@MyPal)^);
{you need to create the greyscale palette}
Bmp2.Width := Bmp1.Width;
Bmp2.Height := Bmp1.Height;
Bmp2.PixelFormat := pf4bit;
Bmp2.Palette :=  hPal;
{set Bmp2 palette to greyscale}

Bmp2.Canvas.Draw(0,0, Bmp1);
{copy the full color Bmp1 to the greyScale Bmp2}
Canvas.Draw(6,290, Bmp2);
{this draws the GreyScale Bmp2 on the form}
FreeAndNil(Bmp1);

Bmp1 := TBitmap.Create;
{free the old Bmp1 and create a new pf1Bit Bmp1}
Bmp1.Width := Bmp2.Width;
Bmp1.Height := Bmp2.Height;
Bmp1.PixelFormat := pf1bit;

{the next code does a scanline on the 4-Bit grayScale bitmap and the
One-Bit bitmap, it averages a 4 pixel square in the Bmp2 and then maps
out that 4 pixel area in the Bmp1 with a Dithered black and white color
from the aryDotMap of word values, these word values will map into a
one-Bit as a 4x4 pixel shade of grey}
Mod1 := 3;
for Y := 0 to ((Bmp2.Height - 1) shr 2) do
  begin
{you need to adjust the Height by Mod1 because you divide the height by 4}
  if Y = (Bmp2.Height - 1) shr 2 then
  Mod1 := ((Bmp2.Height - 1) mod 4) - 1;
  if Mod1 = -1 then Mod1 := 3;
  for i := 0 to Mod1 do
    begin
{you need to get an array of 4 Scanlines to do a 4x4 pixel area}
    aryP4Bit[i] := Bmp2.ScanLine[(Y shl 2)+i];
    aryP1Bit[i] := Bmp1.ScanLine[(Y shl 2)+i];
    end;
  for X := 0 to (Bmp2.Width - 1) shr 3 do
    begin
    for i := 0 to Mod1 do
      begin
      aryPalNum[i shl 2] :=  aryP4Bit[i][X shl 2] shr 4;
      aryPalNum[(i shl 2)+1] := aryP4Bit[i][X shl 2] and not $F0;
      aryPalNum[(i shl 2)+2] :=  aryP4Bit[i][(X shl 2)+1] shr 4;
      aryPalNum[(i shl 2)+3] := aryP4Bit[i][(X shl 2)+1] and not $F0;
      end;
{You get the palette values for the 16 pixels in the 4x4 area of Bmp2}
    PalNum := 0;
      for i := 0 to ((Mod1+1) shl 2)-1 do
       PalNum := PalNum+aryPalNum[i];
    PalNum := PalNum div ((Mod1+1)*4);
    {get the averave value of the 16 pixels into PalNum}

{I am doing Eight pixels at a time, because the Byte values in the Bmp1
scanline Pointers have 8 pixels (8-Bit) in them, so I need to do a second
Averageing into PalNum2}
    for i := 0 to Mod1 do
      begin
      aryPalNum[i shl 2] :=  aryP4Bit[i][(X shl 2)+2] shr 4;
      aryPalNum[(i shl 2)+1] := aryP4Bit[i][(X shl 2)+2] and not $F0;
      aryPalNum[(i shl 2)+2] :=  aryP4Bit[i][(X shl 2)+3] shr 4;
      aryPalNum[(i shl 2)+3] := aryP4Bit[i][(X shl 2)+3] and not $F0;
      end;
    PalNum2 := 0;
      for i := 0 to ((Mod1+1) shl 2)-1  do
       PalNum2 := PalNum2+aryPalNum[i];
    PalNum2 := PalNum2 div ((Mod1+1)*4);

{the following sets a 8x4 pixel area of the Bmp1}
    aryP1Bit[0][X] := ((aryDotMap[PalNum] and not $0FFF) shr 8) or
               ((aryDotMap[PalNum2] and not $0FFF) shr 12);
    if Mod1 > 0 then
    aryP1Bit[1][X] := ((aryDotMap[PalNum] and not $F0FF) shr 4) or
               ((aryDotMap[PalNum2] and not $F0FF) shr 8);
    if Mod1 > 1 then
    aryP1Bit[2][X] := (aryDotMap[PalNum] and not $FF0F) or
               ((aryDotMap[PalNum2] and not $FF0F) shr 4);
    if Mod1 > 2 then
    aryP1Bit[3][X] := ((aryDotMap[PalNum] and not $FFF0) shl 4) or
               (aryDotMap[PalNum2] and not $FFF0);
    end;
  end;

Canvas.Draw(6,100, Bmp1);

FreeAndNil(Bmp2);
FreeAndNil(Bmp1);
end;

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

as you can see, even this simplistic method requires some code work,
ask question if you need more information
0
 
LVL 34

Expert Comment

by:Slick812
ID: 9675937
I'm guessing this might be worth more than 125 points  :-)
0
 

Author Comment

by:wwwbetyar
ID: 9676930
Thanx. It works fine...

0
 

Author Comment

by:wwwbetyar
ID: 9677286
And One more problem...

If I have a bitmap that include a picture and some line of text and I use this algorithm,
the text also will be dither. How can I do : The fix black points will be black, and the fix white points will be white , and not an average .
sorry.
:)
0
 
LVL 34

Expert Comment

by:Slick812
ID: 9683756
??????
The whole process of the dithering is not so easy, especially for a 1-Bit. . . but I have no solution for this, or even a guess as to how to attemp it, without a very sofisicated search if the grey pixels. .  However you may be able to do a Sub search of each 4x4 pixel block and isolate the 4 2x2 blocks that make this up, and use some method of offseting the pixels to the 2x2 blocks that have more or less average values, (I think the Burkes error difussion does something like this) but it would take me weeks or mouths to try and do this, and I just do not want to do it, ,  or have the time, . . . But  searching out what is text would also be very difficult (at least for me). Maybe you can try some things for that. . . Sorry

There used to be some B&W dither algorithems availible at web sites, but many were from the old Turbo Pascal DOS days when this type of thing had some use
0
 

Author Comment

by:wwwbetyar
ID: 9685106
Thanx all your help !
It's very kind of you ! I will do it myself.
0
 
LVL 34

Expert Comment

by:Slick812
ID: 9696326
after my comment, I remembered something I did before (that had nothing to do with dithering), but was a weighted Black and white shift, anyway, it had some code for scaning a 4bit pal index for black and white pixels. . . so here's some code for a button click, and this is about the same as before, except I have added a Direct Black and white conversion (instesd of averaging) if the pixels are all blank and white, this works for Black and white text on an Image, but if it is antialised text, it is about the same as before



procedure TForm1.but_BmpGreyScanClick(Sender: TObject);
const
aryDotMap: Array[0..15] of Word =
    ($0000,$0400,$0401,$0501,
     $0505,$0525,$A425,$A5A5,
     $A7A5,$E5B5,$F5B6,$F5F5,
     $F5FD,$F7FD,$F7FF,$FFFF);
var
Bmp1, Bmp2: TBitmap;
MyPal: TMaxLogPalette;
i, hPal, X, Y, Mod1: Integer;
aryP4Bit: Array[0..3] of PByteArray;
aryP1Bit: Array[0..3] of PByteArray;
PalNum, PalNum2: Integer;
aryPalNum: Array[0..15] of Integer;
aWord, bWord: Word;
IsBW, IsBW2: Boolean;
Rect1: TRect;
begin
Bmp1 := TBitmap.Create;
Bmp1.LoadFromFile('E:\dither test.bmp');
{the bitmap above is a 24 Bit pixel format}

Bmp2 := TBitmap.Create;
{Bmp2 will be a 4-Bit 16 grey color bitmap, to get the
true color of Bmp1 converted to 16 basic shades of grey}
MyPal.palVersion := $300;
MyPal.palNumEntries := 16;
for i := 0 to 15 do
  TColor(MyPal.palPalEntry[i]) := ((i shl 4)+i) or (((i shl 4)+i) shl 8) or
                                  (((i shl 4)+i) shl 16);
hPal := CreatePalette(PLogPalette(@MyPal)^);
{you need to create the greyscale palette}
Bmp2.Width := Bmp1.Width;
Bmp2.Height := Bmp1.Height;
Bmp2.PixelFormat := pf4bit;
Bmp2.Palette :=  hPal;
{set Bmp2 palette to greyscale}

Bmp2.Canvas.Draw(0,0, Bmp1);
{copy the full color Bmp1 to the greyScale Bmp2}
Canvas.Draw(6,290, Bmp2);

FreeAndNil(Bmp1);

//ShowMessage(IntToStr(((Bmp2.Height) mod 4) - 1));
Bmp1 := TBitmap.Create;
{free the old Bmp1 and create a new pf1Bit Bmp1}
Bmp1.Width := Bmp2.Width;
Bmp1.Height := Bmp2.Height;
Bmp1.PixelFormat := pf1bit;

{the next code does a scanline on the 4-Bit grayScale bitmap and the
One-Bit bitmap, it averages a 4 pixel square in the Bmp2 and then maps
out that 4 pixel area in the Bmp1 with a Dithered black and white color
from the aryDotMap of word values, these word values will map into a
one-Bit as a 4x4 pixel shade of grey}
Mod1 := 3;
for Y := 0 to ((Bmp2.Height - 1) shr 2) do
  begin
{you need to adjust the Height by Mod1 because you divide the height by 4}
  if Y = (Bmp2.Height - 1) shr 2 then
  Mod1 := (Bmp2.Height mod 4) - 1;
  if Mod1 = -1 then Mod1 := 3;

  for i := 0 to Mod1 do
    begin
{you need to get an array of 4 Scanlines to do a 4x4 pixel area}
    aryP4Bit[i] := Bmp2.ScanLine[(Y shl 2)+i];
    aryP1Bit[i] := Bmp1.ScanLine[(Y shl 2)+i];
    end;
  for X := 0 to (Bmp2.Width - 1) shr 3 do
    begin
    for i := 0 to Mod1 do
      begin
      aryPalNum[i shl 2] :=  aryP4Bit[i][X shl 2] shr 4;
      aryPalNum[(i shl 2)+1] := aryP4Bit[i][X shl 2] and not $F0;
      aryPalNum[(i shl 2)+2] :=  aryP4Bit[i][(X shl 2)+1] shr 4;
      aryPalNum[(i shl 2)+3] := aryP4Bit[i][(X shl 2)+1] and not $F0;
      end;
{You get the palette values for the 16 pixels in the 4x4 area of Bmp2}
    IsBW := True;
{next I will test the palette values to see if they are all High and Low,
more or less Black and white}
    for i := 0 to ((Mod1+1) shl 2)-1 do
     if not ((aryPalNum[i]<2) or (aryPalNum[i]>13)) then
     begin
     IsBW := False;
     Break;
     end;
    aWord := 0;
    PalNum := 0;
{if all of the pixels are balck and white, IsBW = True, then I
translate the palette numbers to the bit positions in aWord}
    if IsBW then
      begin
      for i := 15 downto 0 do
      if aryPalNum[15-i] > 13 then
      aWord := aWord or (1 shl i);
      end else
      begin
      for i := 0 to ((Mod1+1) shl 2)-1 do
       PalNum := PalNum+aryPalNum[i];
      PalNum := PalNum div ((Mod1+1)*4);
      end;
    {get the average value of the 16 pixels into PalNum}

{I am doing Eight pixels at a time, because the Byte values in the Bmp1
scanline Pointers have 8 pixels (8-Bit) in them, so I need to do a second
Averageing into PalNum2}
    for i := 0 to Mod1 do
      begin
      aryPalNum[(i shl 2)] :=  aryP4Bit[i][(X shl 2)+2] shr 4;
      aryPalNum[(i shl 2)+1] := aryP4Bit[i][(X shl 2)+2] and not $F0;
      aryPalNum[(i shl 2)+2] :=  aryP4Bit[i][(X shl 2)+3] shr 4;
      aryPalNum[(i shl 2)+3] := aryP4Bit[i][(X shl 2)+3] and not $F0;
      end;
    IsBW2 := True;
    for i := 0 to ((Mod1+1) shl 2)-1 do
     if not ((aryPalNum[i]<2) or (aryPalNum[i]>13)) then
     begin
     IsBW2 := False;
     Break;
     end;
    bWord := 0;
    PalNum2 := 0;
    if IsBW2 then
      begin
      for i := 15 downto 0 do
      if aryPalNum[15-i] > 13 then
      bWord := bWord or (1 shl i);
      end else
      begin
      for i := 0 to ((Mod1+1) shl 2)-1  do
       PalNum2 := PalNum2+aryPalNum[i];
      PalNum2 := PalNum2 div ((Mod1+1)*4);
      end;

    if not IsBW then aWord := aryDotMap[PalNum];
    if not IsBW2 then bWord := aryDotMap[PalNum2];
{the following sets a 8x4 pixel area of the Bmp1}
      aryP1Bit[0][X] := ((aWord and not $0FFF) shr 8) or
               ((bWord and not $0FFF) shr 12);
      if Mod1 > 0 then
      aryP1Bit[1][X] := ((aWord and not $F0FF) shr 4) or
               ((bWord and not $F0FF) shr 8);
      if Mod1 > 1 then
      aryP1Bit[2][X] := (aWord and not $FF0F) or
               ((bWord and not $FF0F) shr 4);
      if Mod1 > 2 then
      aryP1Bit[3][X] := ((aWord and not $FFF0) shl 4) or
               (bWord and not $FFF0);
    end;
  end;

Canvas.Draw(6,10, Bmp1);

FreeAndNil(Bmp2);
FreeAndNil(Bmp1);
end;
0
 

Author Comment

by:wwwbetyar
ID: 9700201
Huh

I'm deeply Impressed !
You're the best !
thx.
0

Featured Post

Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
Established in 1997, Technology Architects has become one of the most reputable technology solutions companies in the country. TA have been providing businesses with cost effective state-of-the-art solutions and unparalleled service that is designed…
In a recent question (https://www.experts-exchange.com/questions/29004105/Run-AutoHotkey-script-directly-from-Notepad.html) here at Experts Exchange, a member asked how to run an AutoHotkey script (.AHK) directly from Notepad++ (aka NPP). This video…

820 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question