Solved

Colors - getting as bits.

Posted on 2002-03-14
15
253 Views
Last Modified: 2010-04-04
How do I show the binaer value of a single pixel in a tbitmap, and let the user change the bits?
0
Comment
Question by:hutelihut
  • 5
  • 4
  • 3
  • +2
15 Comments
 
LVL 2

Expert Comment

by:PeterLarsen
ID: 6864491
Something like this :
var
  GetColor : TColor;
begin
  GetColor := Image1.Canvas.Pixels[5,10];
0
 
LVL 4

Expert Comment

by:nestorua
ID: 6864962
HI,
Use TBitmap.Canvas.Pixels array (as already said PeterLarsen)
and TBitmap.Scanline for getting access for each line of pixels.
Sincerely,
Nestorua.
0
 

Author Comment

by:hutelihut
ID: 6867455
PeterLarsen:

How do I show GetColor as a binear value - like 00100011 somewhere on screen.
0
 
LVL 6

Expert Comment

by:edey
ID: 6870717
mm, there's no buitin function (that I know of) to convert an int to a "binary string", but it's trivial to implement. An example:

procedure TForm1.Button1Click(Sender: TObject);
var
   int,ix : integer;
   str : string;
begin
     setLength(str,32);
     int := strToInt(edit1.text);
     for ix := 1 to 32 do
         if (int and (1 shl (ix-1))) > 0 then
            str[33-ix] := '1'
         else
             str[33-ix] := '0';
     caption := str;
end;

GL
Mike
0
 
LVL 2

Expert Comment

by:PeterLarsen
ID: 6874239
I agree with edey, something like that - except that i probably would choose to run the conversion in two loops - or maybe not.
I have some assembler code i'm using when necessary to other processors, maybe i should transfer that code into delphi. With that its possible to convert from and to commonly used number systems like 2, 8, 10 and 16.
0
 

Author Comment

by:hutelihut
ID: 6884974
edey:

I think the variabel called BITS could be usefull:

like:

var
  v:byte;
  b:bits absolute v;

...then you can change each bit of v - b[5]:=true.


One of the problems is that bitmaps has diffenrent count of bits per pixel...
0
 
LVL 6

Expert Comment

by:edey
ID: 6886692
After some thought I think my example was far to hard to read, plus this one compiles a little cleaner:

procedure TForm1.Button1Click(Sender: TObject);
var
  int,ix,mask : integer;
  str : string;
begin
    setLength(str,32);
    int := strToInt(edit1.text);
    for ix := 31 downto 0 do
    begin
         mask := 1 shl ix;
         byte(str[ix]) := (48+integer((int and mask)=mask));
    end;
    caption := str;
end

You could use TBits, but it's, umm a bit of overkill. It's great when you have to test against a bit set larger then a word, but the algo to extract bits for a singe word is pretty clear.
0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 4

Expert Comment

by:delphi3
ID: 6887700
0
 

Author Comment

by:hutelihut
ID: 6887995
Converting a integer to bits is not the big deal.

My main problem is to get the bits from 1 pixel in a BITMAP, and how to change them...

It differs from every bitmap whenever there is 1,2,4,8,16,24, or 32 bits per pixel. How do I show and change the bits one at the time?
0
 
LVL 4

Expert Comment

by:delphi3
ID: 6888535
hutelihut,
I am out of ideas on how to help you and since I do not work at the level of making this form of an adjustment,  I would point you in another direction that may answer your Q, especially the efg's Delphi Reference Library html listed below:

This was written by Steve Williams:  stevewilliams@kromestudios.com
Quote:
The number of colours, or colour depth, is usually specified in the header
of the image file.  How are you loading the images?  For BMP images loaded
into a TBitmap, you can look at the PixelFormat property to find the pixel
format.  JPG images are always true-colour (24-bit).  GIF images can be up
to 8-bit (256 colour), but finding out the actual bit depth of a GIF image
will depend on what object you have used to load the GIF image and how it
exposes that information.

efg's Delphi Reference Library is a fantastic resource for this kind of
info.
http://homepages.borland.com/efg2lab/Library/Delphi/index.html

Delphi3
0
 
LVL 6

Expert Comment

by:edey
ID: 6889670
just out of curiosity, why do you want this? changing bits in bitmaps with some bitcounts can mean doing _completely_ different things. for example, 24/32 bit bmp's keep actual rgb color information. So does 16 bit, but the number of bits per color can vary depending on video driver. 8 bit keeps index's to a palette, so changin one bit can result in a completely different color, or exactly the same, depends on what the (arbitrary) palette looks like.

So I'm wondering, why, exactly do you want bit level access to a bmp? Could this be something better done by converting the bmp to 32 bit, editing, then resampling back to what ever bitcount the source was?

GL
Mike
0
 
LVL 4

Accepted Solution

by:
delphi3 earned 100 total points
ID: 6890997
hutelihut,
I have put together a 4k zip  small utility that uses a ColorDialog, displays the binary, user edits the binary, it decodes the binary back into into a color at the pixel selected, and the user saves the changes. The zip  has the .pas, .dpr, and .dfm.  If you want you can email me at bherbst65@hotmail.com and I will forward it to you. Still, like some of the previous respondents I  am confused  as to why you need it in this binary format?

Delphi3
0
 

Author Comment

by:hutelihut
ID: 6892411
delphi3:

Seems interresting... Please send it to me at

gyldemanden(a)yahoo.dk

( sorry - unable to make the 'a'-thing in this explorer... - don't think I am stupid ;-)   )
0
 
LVL 4

Expert Comment

by:delphi3
ID: 6912821
hutelihut,
As  is the custom at EE not to leave an email address that is noted elsewhere, I show the solution that you accepted as a working model for others who view this Q.

Delphi3

unit ClrAndShrUnit1;

{From the D4 help
SHR      Logical shift right. Both expressions must be absolute immediate values,
 and the result is an absolute immediate value.
shl      bitwise shift left      integer      integer      X shl 2
shr      bitwise shift right      integer      integer      Y shl I
The following rules apply to bitwise operators.

The result of a not operation is of the same type as the operand.
 If the operands of an and, or, or xor operation are both integers,
        the result is of the predefined integer type with the smallest
        range that includes all possible values of both types.

 The operations x shl y and x shr y shift the value of x
        to the left or right by y bits, which is equivalent to
        multiplying or dividing x by 2^y; the result is of the same type as x.
        For example, if N stores the value 01101 (decimal 13),
        then N shl 1 returns 11010 (decimal 26).

Delphi3  
01.29.2000

Revisions:
 made this into a read as a pixel reader, and set this to a binary number
 translator.
 
Delphi3  
03.23.2002}


interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    ColorDialog1: TColorDialog;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    Edit6: TEdit;
    Edit7: TEdit;
    Edit8: TEdit;
    Edit9: TEdit;
    Edit10: TEdit;
    Edit11: TEdit;
    Edit12: TEdit;
    Image1: TImage;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);

  private
    function IntToBinStr(Num, Width: integer; Fill, Sep: char): string;
    function BinStrToInt(BS: string): integer;
    procedure ProcessData(Sender: TObject);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

function TForm1.IntToBinStr(Num, Width: integer; Fill, Sep: char): string;
{Width is minimum width}
{Fill is the char used to left-fill to make up the width if less}
{for no separators call with #0 no quotes) for Sep}
var
  LenResult, i: integer;
const
  {look-up array for bit values}
  B: array[0..1] of char = ('0', '1');
begin
  Result := '';
  {make string from bit values}
  while Num > 0 do begin
    Result := B[Num and $00000001] + Result;
    Num := Num shr 1;
  end;
  {set length to specified if less}
  while Length(Result) < Width do
    Result := Fill + Result;
  LenResult := Length(Result);
  {insert separators every 4 characters}
  if Sep >= ' ' then
    for i := 0 to LenResult - 1 do
      if (i > 0) and ((i mod 4) = 0) then
        Result := Copy(Result, 1, LenResult - i)
          + Sep
          + Copy(Result, LenResult - i + 1, LenResult + i);
end;

function TForm1.BinStrToInt(BS: string): integer;
var
  i: integer;
begin
  Result := 0;
  for i := 1 to length(BS) do begin
    Result := Result shl 1;
    if BS[i] > '0' then
      inc(Result);
  end;
end;

procedure TForm1.ProcessData(Sender: TObject);
var
  HexNum: string;
  Temp2, A, B, C: Integer;
begin
  if (ColorDialog1.Execute) then
  begin
    Hexnum := IntToHex(ColorDialog1.Color, 6); // a string
    Edit2.Text := '$' + HexNum;

    Temp2 := ColorDialog1.Color;
    A := temp2 and 255; //Color RED
    Edit5.Text := IntToStr(A);
    Edit8.Text := '$' + HexNum[5] + HexNum[6]; //Add string parts in HexNumber

    B := (Temp2 shr 8) and 255; //shift right for Color GREEN
    Edit6.Text := IntToStr(B);
    Edit9.Text := '$' + HexNum[3] + HexNum[4]; //Add string parts in HexNumber

    C := Temp2 shr 16; // shift right for  Color BLUE
    Edit7.Text := IntToStr(C);
    Edit10.Text := '$' + HexNum[1] + HexNum[2]; //Add string parts in HexNumber

  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  BitMap1: TBitMap;
begin
  BitMap1 := TBitMap.Create;
  if OpenDialog1.Execute then
  try
    BitMap1.LoadFromFile(OpenDialog1.FileName);
    Image1.Width := Bitmap1.Width;
    Image1.Height := Bitmap1.Height;
    Form1.Image1.picture.graphic := Bitmap1;
    show();

  finally
    BitMap1.Free;
  end;

end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Edit1.Text := IntToStr(BinStrToInt(Edit3.Text));
  ColorDialog1.Color := StrToInt(Edit1.Text);
  ProcessData(Self);
  Image1.Canvas.Pixels[StrToInt(Edit11.Text), StrToInt(Edit12.Text)] := ColorDialog1.Color;

end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);

begin
  Edit11.Text := IntToStr(X);
  Edit12.Text := IntToStr(Y);
  Edit1.Text := IntToStr(Image1.Canvas.Pixels[X, Y]);
  ColorDialog1.Color := StrToInt(Edit1.Text);
  ProcessData(Self);

  Edit3.text := IntToBinStr(StrToInt(Edit2.Text), 0, #0, #0)
end;


procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  Edit4.Text := IntToStr(X) + ', ' + IntToStr(Y);
  Edit11.Text := IntToStr(X);
  Edit12.Text := IntToStr(Y);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  if SaveDialog1.Execute then
    Image1.Picture.Graphic.SaveToFile(SaveDialog1.FileName + '.bmp');
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  Application.Terminate;
end;
end.

Form viewed as text:


object Form1: TForm1
  Left = 352
  Top = 132
  Width = 563
  Height = 493
  Caption = 'Binary Pixel Color Changer'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -14
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 120
  TextHeight = 16
  object Label1: TLabel
    Left = 23
    Top = 10
    Width = 166
    Height = 16
    Caption = 'Color Number As a Decimal'
  end
  object Label3: TLabel
    Left = 28
    Top = 86
    Width = 26
    Height = 16
    Caption = 'Red'
  end
  object Label4: TLabel
    Left = 115
    Top = 86
    Width = 37
    Height = 16
    Caption = 'Green'
  end
  object Label5: TLabel
    Left = 201
    Top = 86
    Width = 27
    Height = 16
    Caption = 'Blue'
  end
  object Label6: TLabel
    Left = 28
    Top = 66
    Width = 140
    Height = 16
    Caption = 'RGB Decimal Numbers'
  end
  object Label7: TLabel
    Left = 23
    Top = 231
    Width = 114
    Height = 16
    Caption = 'RGB Hex Numbers'
  end
  object Label8: TLabel
    Left = 23
    Top = 251
    Width = 26
    Height = 16
    Caption = 'Red'
  end
  object Label9: TLabel
    Left = 120
    Top = 251
    Width = 37
    Height = 16
    Caption = 'Green'
  end
  object Label10: TLabel
    Left = 209
    Top = 251
    Width = 27
    Height = 16
    Caption = 'Blue'
  end
  object Label2: TLabel
    Left = 23
    Top = 161
    Width = 140
    Height = 16
    Caption = 'Color Number As a Hex'
  end
  object Label11: TLabel
    Left = 24
    Top = 320
    Width = 238
    Height = 16
    Caption = 'View and Edit Color Number As a Binary'
  end
  object Image1: TImage
    Left = 320
    Top = 96
    Width = 17
    Height = 17
    Picture.Data = {
      07544269746D617026040000424D260400000000000036000000280000001200
      0000120000000100180000000000F00300000000000000000000000000000000
      0000009C00009C00009C00009C00009C00009C00009B00009C00009D00009D00
      009D00009D00009D00009D00009D00009C00009C00009C000000009C00009C00
      009C00009C00009C00009B00009D00009A000099000099000099000099000099
      00009900009800009C00009C00009C000000009C00009C00009C00009C00009C
      00009B0000A500005B8A0058B00059AB0059AB0059AB0059AB0059AA0055B900
      7C3D009F00009C000000009C00009C00009C00009C00009C00009B0000A50000
      627F005FA100609C00609C00609C00609C00609B005CAA008037009F00009C00
      0000009E0000A90000A90000A90000A90000A90000B300006B7C0067AE0068A9
      0068A90067A8005F9C00609B005CAA008037009F00009C000000049804FF00FF
      F209F2F209F2F209F2F209F2F40BFFE10448F40400F50206FE0000F20000006F
      AE006199005BAA008037009F00009C000000009B00FF00FFFF00FFFF00FFFF00
      FFFF00FFFF00FFEB003DFF0000F20E08BA5553B242382547BF204EA3005DAC00
      7F38009F00009C000000009B00FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFE1
      0056FB0016BB3D5200FFFF06EDEBAD03E76C2EB7006196008033009F00009C00
      0000009B00FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFF700FDF800FFE420D8
      FFA48CF5848B00FF0000CB00009500009C00009C00009C000000009B00FF00FF
      FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFEB23DDFFAD92F9899600FF
      0000CD00009A00009E00009B00009C000000009B00FF00FFFF00FFFF00FFFF00
      FFFF00FFFF00FFFF00FFFF00FFE723D8FFAE95F48A9A00FF0000CA0000950000
      9B00009C00009C000000029802FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF
      00FFFF00FFF319E2FFA29EFE80A100FF0000CA00009500009C00009C00009C00
      0000009C004778473B803B3B803B3B803B3B803B3B803B3B803B3D7A3E368334
      3EE7223BD82500FF0000CA00009500009C00009C00009C000000009C0000A100
      00A00000A00000A00000A00000A00000A000009D00009F0000FF0000FF0000FF
      0000CA00009500009C00009C00009C000000009C00009C00009C00009C00009C
      00009C00009C00009C00009800009B0000FF0000FF0000FF0000CA0000950000
      9C00009C00009C000000009C00009C00009C00009C00009C00009C00009C0000
      9C00009800009C0000FF0000FF0000FF0000CC00009500009C00009C00009C00
      0000009C00009C00009C00009C00009C00009C00009C00009C00009A00009A00
      00E80000DF0000E30000B900009800009C00009C00009C000000009C00009C00
      009C00009C00009C00009C00009C00009C00009C00009B000090000090000090
      00009700009C00009C00009C00009C000000}
    OnMouseDown = Image1MouseDown
    OnMouseMove = Image1MouseMove
  end
  object Label12: TLabel
    Left = 328
    Top = 288
    Width = 34
    Height = 16
    Caption = '(X , Y)'
  end
  object Label13: TLabel
    Left = 296
    Top = 48
    Width = 191
    Height = 16
    Caption = 'Use Mouse To Get the  Location'
  end
  object Label14: TLabel
    Left = 296
    Top = 72
    Width = 199
    Height = 16
    Caption = 'Of Pixel On Image, Then Left Click'
  end
  object Button2: TButton
    Left = 139
    Top = 401
    Width = 94
    Height = 25
    Caption = 'Convert Binary'
    TabOrder = 4
    OnClick = Button2Click
  end
  object Edit1: TEdit
    Left = 23
    Top = 31
    Width = 178
    Height = 24
    TabOrder = 1
  end
  object Button1: TButton
    Left = 19
    Top = 402
    Width = 94
    Height = 24
    Caption = 'GetBMP'
    TabOrder = 0
    OnClick = Button1Click
  end
  object Edit2: TEdit
    Left = 23
    Top = 190
    Width = 199
    Height = 24
    TabOrder = 5
  end
  object Edit3: TEdit
    Left = 24
    Top = 352
    Width = 257
    Height = 24
    TabOrder = 6
  end
  object Button3: TButton
    Tag = 2
    Left = 256
    Top = 400
    Width = 94
    Height = 25
    Caption = 'Save'
    TabOrder = 2
    OnClick = Button3Click
  end
  object Button4: TButton
    Tag = 3
    Left = 368
    Top = 400
    Width = 94
    Height = 25
    Caption = 'Close'
    TabOrder = 3
    OnClick = Button4Click
  end
  object Edit5: TEdit
    Left = 24
    Top = 112
    Width = 74
    Height = 24
    TabOrder = 7
  end
  object Edit6: TEdit
    Left = 112
    Top = 112
    Width = 74
    Height = 24
    TabOrder = 8
  end
  object Edit7: TEdit
    Left = 200
    Top = 112
    Width = 74
    Height = 24
    TabOrder = 9
  end
  object Edit8: TEdit
    Left = 24
    Top = 280
    Width = 74
    Height = 24
    TabOrder = 10
  end
  object Edit9: TEdit
    Left = 112
    Top = 280
    Width = 74
    Height = 24
    TabOrder = 11
  end
  object Edit10: TEdit
    Left = 200
    Top = 280
    Width = 74
    Height = 24
    TabOrder = 12
  end
  object Edit11: TEdit
    Left = 368
    Top = 320
    Width = 57
    Height = 24
    TabOrder = 13
    Visible = False
  end
  object Edit12: TEdit
    Left = 432
    Top = 320
    Width = 57
    Height = 24
    TabOrder = 14
    Visible = False
  end
  object Edit4: TEdit
    Left = 368
    Top = 280
    Width = 65
    Height = 24
    TabOrder = 15
  end
  object ColorDialog1: TColorDialog
    Ctl3D = True
    Left = 224
    Top = 8
  end
  object OpenDialog1: TOpenDialog
    Filter = 'Bitmap|*.bmp'
    Left = 224
    Top = 48
  end
  object SaveDialog1: TSaveDialog
    Filter = 'Bitmap|*.bmp'
    Left = 264
    Top = 32
  end
end


0
 

Author Comment

by:hutelihut
ID: 6915082
ahh... OK
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

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…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
In this tutorial you'll learn about bandwidth monitoring with flows and packet sniffing with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're interested in additional methods for monitoring bandwidt…
You have products, that come in variants and want to set different prices for them? Watch this micro tutorial that describes how to configure prices for Magento super attributes. Assigning simple products to configurable: We assigned simple products…

757 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

19 Experts available now in Live!

Get 1:1 Help Now