Solved

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

Posted on 2003-11-02
16
342 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 33

Expert Comment

by:Slick812
Comment Utility
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
Comment Utility
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
Comment Utility
0
 
LVL 33

Expert Comment

by:Slick812
Comment Utility
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
Comment Utility
Ah !

I need a dirther algorythm in delphi
0
 

Author Comment

by:wwwbetyar
Comment Utility
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
Comment Utility
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
Comment Utility
sorry dither
0
Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 33

Accepted Solution

by:
Slick812 earned 140 total points
Comment Utility
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 33

Expert Comment

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

Author Comment

by:wwwbetyar
Comment Utility
Thanx. It works fine...

0
 

Author Comment

by:wwwbetyar
Comment Utility
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 33

Expert Comment

by:Slick812
Comment Utility
??????
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
Comment Utility
Thanx all your help !
It's very kind of you ! I will do it myself.
0
 
LVL 33

Expert Comment

by:Slick812
Comment Utility
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
Comment Utility
Huh

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

Featured Post

Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

Join & Write a Comment

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
Internet Business Fax to Email Made Easy - With eFax Corporate (http://www.enterprise.efax.com), you'll receive a dedicated online fax number, which is used the same way as a typical analog fax number. You'll receive secure faxes in your email, fr…
When you create an app prototype with Adobe XD, you can insert system screens -- sharing or Control Center, for example -- with just a few clicks. This video shows you how. You can take the full course on Experts Exchange at http://bit.ly/XDcourse.

744 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

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now