Solved

Need Help on Imaging Problem...

Posted on 1997-07-18
12
262 Views
Last Modified: 2010-04-06
I have a CCD camera sending data to my PC. I managed to aquire the data and put it into an array. The image is grayscale, thus the array is of type byte.

I need to display the image on the screen close to real time. This is my source code:

var imageBuffer: array[0..249,0..249] of byte;
    arrayPtr: Pointer;
begin
     arrayPtr:= addr(imageBuffer);
     Image.Picture.Bitmap.Width := 250;
     Image.Picture.Bitmap.Height := 250;
     MakePalette; // My grayscale palette

     { Fill up imageBuffer }
     SetBitmapBits(Image.Picture.Bitmap.Handle, sizeof(imageBuffer),ArrayPtr);
     Image.Refresh;

My problem is that the image is only half filled!! I read the help files and found that the SetBitmapBits takes in an array of words, not bytes. how do i solve this problem?

I have gone through all the previously asked questions and I have found 2 answers which partially help my problem.

This first one is entitled "Bitmap Palette" asked by tier and answered by javiertb (Question #294 date: 05/08). I have a very similar code to tier. How did tier manage to use the arary of bytes?

The second mail is entitled "Displaying bitmaps from memory" asked by Thales and answered by Sperling (Question #387 Date: 04/23). Should I incorporate this method to my solution?

I need some guidance. I am not sure how much this question is worth, but if you feel that it is too low, i'll be happy to increase it. :)

Kind regards
keith
0
Comment
Question by:keithcsl
  • 7
  • 4
12 Comments
 
LVL 1

Author Comment

by:keithcsl
ID: 1339233
Edited text of question
0
 

Expert Comment

by:magic_wizard
ID: 1339234
This may be a stupid answer, so I let it go only as a comment.
Isn't it possible to actually convert those bytes to word's on
the fly?
If that works, well...
Good luck anyway.
(Maybe I just didn't understand your problem fully)

Morten Brendefur.
brendefu@online.no
0
 
LVL 3

Expert Comment

by:mirek071497
ID: 1339235
Image can contain planes.
0
Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

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 1

Author Comment

by:keithcsl
ID: 1339236
i have tried using an array of type word. first of all, this change managed to fill the image. but when i tried filling the buffer with values 0 to 255, i did not get the gradient fill i expected. i got 8 strips of gradient fill instead of 1 single strip (top to bottom). i would expect this because 0 - 255 is $0000 - $00FF. i don't know how to map the byte to a word.

the second problem is my palette. i still cannot produce a grayscale image.

i would be most grateful if magic_wizard or mirek or anyone would like to see my source code.
0
 
LVL 1

Author Comment

by:keithcsl
ID: 1339237
This is my source code (i managed to reach this far with the help of my russian friend, anatoly):

var
  Form1: TForm1;
   hPal: HPalette;
implementation

{$R *.DFM}

procedure TForm1.MakePalette;
var
  LogicalPalette: PLogPalette;
  ColorIndex : LongInt;
begin
GetMem(LogicalPalette, (SizeOf(TLogPalette) + SizeOf(TPaletteEntry)*256));
GetSystemPaletteEntries(Canvas.Handle, 0, 256, LogicalPalette^.palPalEntry[0]);
with LogicalPalette^ do
  begin
  palVersion := $300;
  palNumEntries := 256;
  {$R-}
  for ColorIndex := 10 to 245 do
    with palPalEntry[ColorIndex] do
      begin
      peRed := 255 - (ColorIndex-10);
      peGreen := 255 - (ColorIndex-10);
      peBlue := 255 - (ColorIndex-10);
      peFlags := PC_NOCOLLAPSE;
      end;
  end;
  {$R+}
DeleteObject(hPal); // Prevent Memory leakage by deleting old palette
hPal := CreatePalette(LogicalPalette^);
FreeMem(LogicalPalette, (SizeOf(TLogPalette) + SizeOf(TPaletteEntry)*256));
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  ImageBuffer : array[0..254,0..254] of word;
  I,J,N : Integer;
  ArrayPtr : Pointer;
begin
  Image.Picture.Bitmap.Width := High(ImageBuffer)-1;
  Image.Picture.Bitmap.Height := High(ImageBuffer[1])-1;
  ArrayPtr := @imageBuffer;
  MakePalette;
  SelectPalette(Image.Canvas.Handle,hPal,FALSE);
  RealizePalette(Image.Canvas.Handle);
  Image.Picture.Bitmap.Palette := hPal;

  for n:= 1 to 25 do begin
            for i:= Low(ImageBuffer) to High(ImageBuffer) do begin
                  for j:= Low(ImageBuffer[1]) to High(ImageBuffer[1]) do begin
                        ImageBuffer[i,j]:= j;
                  end;
        end;

  SetBitmapBits(Image.Picture.Bitmap.Handle,SizeOf(imageBuffer),ArrayPtr);
  Image.Refresh;
  end;
end;

0
 
LVL 3

Expert Comment

by:mirek071497
ID: 1339238
Sorry.  You cant do this in this way.
Tell me what you'r program need show and i write code for you.
0
 
LVL 1

Author Comment

by:keithcsl
ID: 1339239
This is the specifications of my program:

poll the printer port for video data. i get the video 1 frame at a time and display the image on the screen. 1 frame is 250x250.  this means my array is 62500 bytes long. the code is like this:

  for i := 0 to rowSize do
    for j := 0 to colSize do
      imageBuffer[i,j] := GetDataFromPort(PortAddress); // puts a byte into the array

then, all i need to do is to display this grayscale image on the screen.

if you need more information, please ask. lastly, i would like to thank you, mirek, in advance for helping me out.
0
 
LVL 1

Author Comment

by:keithcsl
ID: 1339240
This is the specifications of my program:

poll the printer port for video data. i get the video 1 frame at a time and display the image on the screen. 1 frame is 250x250.  this means my array is 62500 bytes long. the code is like this:

  for i := 0 to rowSize do
    for j := 0 to colSize do
      imageBuffer[i,j] := GetDataFromPort(PortAddress); // puts a byte into the array

then, all i need to do is to display this grayscale image on the screen.

if you need more information, please ask. lastly, i would like to thank you, mirek, in advance for helping me out.
0
 
LVL 3

Accepted Solution

by:
mirek071497 earned 100 total points
ID: 1339241
Her is example of this problem.

unit1;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, ExtCtrls;

const
  XSize = 4*63; { must be devided by 4 !!!}
  YSize = 250;

type
  TForm2 = class(TForm)
    Button2: TButton;
    PaintBox2: TPaintBox;
    Label2: TLabel;
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    ByteBits : array[0..YSize-1,0..XSize-1] of byte;
    ByteInfo : PBitmapInfo;
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.DFM}

var
  MyPal       : HPalette;
  MyLPal      : PLogPalette;

procedure TForm2.FormCreate(Sender: TObject);
var
  i,j  : longint;
begin

  for j:=0 to YSize-1 do
    for i:=0 to XSize-1 do
     ByteBits[j,i]:=i;   { here is filling byte array }

  GetMem(MyLPal, (SizeOf(TLogPalette) + SizeOf(TPaletteEntry)*256));
  MyLPal^.PalVersion := $0300;
  MyLPal^.palNumEntries:=256;
  for i:=0 to 255 do
  begin
    MyLPal^.palPalEntry[i].peRed   := i;
    MyLPal^.palPalEntry[i].peGreen := i;
    MyLPal^.palPalEntry[i].peBlue  := i;
    MyLPal^.palPalEntry[i].peFlags := 0;
  end;
  MyPal := CreatePalette(MyLPal^);
  FreeMem(MyLPal, (SizeOf(TLogPalette) + SizeOf(TPaletteEntry)*256));

  GetMem( ByteInfo, SizeOf(TBitmapInfoHeader) + 256*SizeOf(TRGBQuad) );
  ByteInfo^.BmiHeader.biSize := SizeOf(TBitmapInfoHeader);
  ByteInfo^.BmiHeader.biWidth := XSize;
  ByteInfo^.BmiHeader.biHeight := YSize;
  ByteInfo^.BmiHeader.biPlanes := 1;
  ByteInfo^.BmiHeader.biBitCount := 8; { 256 color }
  ByteInfo^.BmiHeader.biCompression := BI_RGB;
  ByteInfo^.BmiHeader.biSizeImage := 0;
  ByteInfo^.BmiHeader.biXPelsPerMeter:= 1000;
  ByteInfo^.BmiHeader.biYPelsPerMeter:= 1000;
  ByteInfo^.BmiHeader.biClrUsed:= 0;
  ByteInfo^.BmiHeader.biClrImportant:= 0;
  for i:=0 to 255 do
  begin
    ByteInfo^.BmiColors[i].rgbRed := i;
    ByteInfo^.BmiColors[i].rgbGreen := i;
    ByteInfo^.BmiColors[i].rgbBlue := i;
    ByteInfo^.BmiColors[i].rgbReserved := 0;
  end;
end;

procedure TForm2.FormDestroy(Sender: TObject);
begin
  DeleteObject(MyPal);
  FreeMem( ByteInfo, SizeOf(TBitmapInfoHeader) + 256*SizeOf(TRGBQuad) );
end;

procedure TForm2.Button2Click(Sender: TObject);
var
  Bmp     : HBitmap;
  NewDC   : HDC;
  T1      : TDateTime;
begin
  T1:=Now;
  PaintBox2.Repaint;
  NewDC := CreateCompatibleDC( PaintBox2.Canvas.Handle );
  DeleteObject(SelectPalette( NewDC,MyPal,false));
  RealizePalette( NewDC );
  Bmp := CreateCompatibleBitmap( PaintBox2.Canvas.Handle, XSize, YSize );
  SetDIBits( NewDC, Bmp, 0, YSize, @ByteBits, ByteInfo^, DIB_RGB_Colors );
  SelectObject( NewDC, Bmp );
  BitBlt( PaintBox2.Canvas.Handle, 0, 0, XSize, YSize, NewDC, 0, 0, SrcCopy );
  DeleteObject( Bmp );
  DeleteDC( NewDC );
  Label2.Caption := 'Time=' + FormatFloat('#.000',(Now-t1)*100000);   { time is 0 add loop for testing }
end;

end.


You don't need use Palette if You work on display than have more then 256 colors (for example HighColor)
0
 
LVL 1

Author Comment

by:keithcsl
ID: 1339242
Fantastic Results!!!

Thank you so much for your help, mirek. The code is excellent! I think this question is worth more than 100 points. Well, I have only 82 points left on me and I think you deserve it all.

Very Statisfied,
keith
0
 
LVL 1

Author Comment

by:keithcsl
ID: 1339243
Hei, how come the points did not get through to you? I will enquire on this...
0
 
LVL 3

Expert Comment

by:mirek071497
ID: 1339244
I don't need more point's
0

Featured Post

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.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
Delphi XE10, MySQL Query 4 167
tvirtualstringtree freeze when load too manny images 10 73
How to build JSON File in Delphi 6 3 46
MS Access from Delphi 31 61
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…
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 …
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…

828 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