Solved

Colors - getting as bits.

Posted on 2002-03-14
15
256 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
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

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 I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
This tutorial demonstrates a quick way of adding group price to multiple Magento products.
With Secure Portal Encryption, the recipient is sent a link to their email address directing them to the email laundry delivery page. From there, the recipient will be required to enter a user name and password to enter the page. Once the recipient …

929 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

11 Experts available now in Live!

Get 1:1 Help Now