Solved

Palettes in Delphi

Posted on 1997-09-05
5
649 Views
Last Modified: 2010-04-04
Dear Sir,

I have a CCD camera which I controll through delphi3.0

I create a BITMAP:HBitmap and a Palette:Hpalette.

When I display the image I get unwanted colors in my image,
especially in the low range and high range bytes of the image.

How can I get for eksample display the image
with a red color scale, and ONLY a red color scale.

I suspect there are windows systems colors that get
mixed in to my image.


I will send the source code on how I create the palette:

I do hope You can help since I have tried myself
for a long time ( 1 month)

procedure Tpal.makepal(Sender: TObject);
var i,j:integer;
    UsFlag:Byte;
    lSize : LongInt;
    pPal  : PLOGPALETTE;
    hpal  : HPalette;
begin
 if Scrollbar1.position <> Scrollbar2.position then
 begin
  pPal:=nil;
  try
    lSize:= sizeof(TLogPalette) + (Entries-1) * sizeof(TPaletteEntry);
    GetMem(pPal,LSize);
    pPal^.palVersion    := $300;
    pPal^.palNumEntries := Entries;
    UsFlag:=PC_NOCOLLAPSE;
    {$R-}
    for i:= 0 to Entries-1 do
    begin
      j:=round((i-Scrollbar2.position)*((Entries-1)/(Scrollbar1.position-Scrollbar2.position)));
      if i > Scrollbar1.position then j:=Entries-1;
      if i <= Scrollbar2.position then j:=0;
      if RED then
      begin
       pPal^.palPalEntry[i].peRed   := j;
       pPal^.palPalEntry[i].peGreen := 0;
       pPal^.palPalEntry[i].peBlue  := 0;
       pPal^.palPalEntry[i].peFlags := UsFlag;
      end;
      if BLUE then
      begin
       pPal^.palPalEntry[i].peRed   := 0;
       pPal^.palPalEntry[i].peGreen := 0;
       pPal^.palPalEntry[i].peBlue  := j;
       pPal^.palPalEntry[i].peFlags := UsFlag;
      end;
      if GREEN then
      begin
       pPal^.palPalEntry[i].peRed   := 0;
       pPal^.palPalEntry[i].peGreen := j;
       pPal^.palPalEntry[i].peBlue  := 0;
       pPal^.palPalEntry[i].peFlags := UsFlag;
      end;
      if WHITE then
      begin
       pPal^.palPalEntry[i].peRed   := j;
       pPal^.palPalEntry[i].peGreen := j;
       pPal^.palPalEntry[i].peBlue  := j;
       pPal^.palPalEntry[i].peFlags := UsFlag;
      end;
   end;
   {$R+}
   hpal:= CreatePalette(pPal^);
   if hpal <> 0 then ImagePalette:=hpal;
  finally
   FreeMem(pPal, lSize);
  end;
   dopaints(Sender);
  end;
end;


Best regards
Fred Sigernes
0
Comment
Question by:freds090597
  • 3
  • 2
5 Comments
 
LVL 3

Expert Comment

by:mirek071497
Comment Utility
Palette was created in proper way but what do you need more.
Plase submit comment about painting and i think so i can help you. Mayby you use select palette and realize palette ?
In Delphi1 and 2 this ok but in delphi3 you need work with VCL palettes.
0
 

Author Comment

by:freds090597
Comment Utility
Question:  How to create proper palettes in delphi3.0?
           (without unwanted colors displayed in the images?)

Thanks a lot mirek!
Good to know that there is help out there!

I do select the palette and realizes it in the following
way when I paint.

procedure Tpal.DrawBitMaps(PaintDC:HDC;PalBitMap:Hbitmap);
var MemDC:HDC;
    OldBitMap:HbitMap;
    ImageOldPalette:HPalette;
    wreal:word;
begin
    MemDC:=CreateCompatibleDC(PaintDC);
    OldBitMap:=SelectObject(MemDC,PalBitMap);
    ImageOldPalette:= SelectPalette(PaintDC, ImagePalette, FALSE);
    wReal := RealizePalette(PaintDC);
    StretchBlt(PaintDC,pal.image1.left,pal.image1.Top,
               pal.image1.width,pal.image1.Height,
               MemDC,0,0,IPV,IPH,SRCCOPY);
    SelectObject(MemDC,OldBitmap);
    DeleteObject(MemDC);
end;

procedure Tpal.dopaints(Sender: TObject);
var DC:HDC;
begin
 if palbitmap<>0 then
 begin
  DC:=GetDC(pal.Handle);
  DrawBitMaps(DC,palbitMap);
  releaseDC(pal.Handle,DC);
 end;
 Edit1.text:=i2s(ScrollBar1.position);
 Edit2.text:=i2s(ScrollBar2.position);
end;


Let me aslo show you how I create the bitmap itself:

procedure Tpal.dowelcomes(Sender: TObject);
var BITMAP:^Windows.Tbitmap;
    j:longint;
    bitinfs:longint;
begin
   Entries:=256;
   bitinfs:=sizeof(Windows.TBitmap);
   GetMem(BITMAP,bitinfs);
    with BITMAP^ do
    begin
      bmType:=0;
       bmWidth:=256;
       bmHeight:=1;
       bmWidthBytes:=256;
       bmPlanes:=1;
       bmBitsPixel:=8;
   end;
   GetMem(IPS,256);
   for J:=0 to 255 do IPS^[J]:=J;
   BITMAP^.bmBits:=IPS;
   PalBitMap:=CreateBitmapIndirect(BITMAP^);
   FreeMem(IPS,IPV*IPH);
   FreeMem(BITMAP,bitinfs);
 end;

When I paint this image I get unwanted colors at the begining
and at the end of the image.
It is suposed to go from dark/black to red/white.

I hope this make my question more clarified...maybe I should
send the whole source code...If you want ?

Best regards
Fred Sigernes


0
 
LVL 3

Accepted Solution

by:
mirek071497 earned 200 total points
Comment Utility
All is good without one : PC_NOCOLLAPSE
I don't saw this later because you put this in another variable.

Try : UsFlag:=0;

peFlags
  Specifies how the palette entry is to be used. The peFlags member may be set to NULL or one of the following values:

PC_EXPLICIT      Specifies that the low-order word of the logical palette entry designates a hardware palette index. This flag allows the application to show the contents of the display device palette.
PC_NOCOLLAPSE      Specifies that the color be placed in an unused entry in the system palette instead of being matched to an existing color in the system palette. If there are no unused entries in the system palette, the color is matched normally. Once this color is in the system palette, colors in other logical palettes can be matched to this color.
PC_RESERVED      Specifies that the logical palette entry be used for palette animation. This flag prevents other windows from matching colors to the palette entry since the color frequently changes. If an unused system-palette entry is available, the color is placed in that entry. Otherwise, the color is not available for animation.
0
 

Author Comment

by:freds090597
Comment Utility
Dear Sir.

Yes I have tried out that bit UsFlag = 0, but it made things
even worse...I found out that PC_EXPLICIT or PC_NOCOLAPSE still
is the best way to go.


I will add the total sorce code for this unit.
The main thing about this unit is that it changes the palette
as you drag with the mouse.

That way your image will be stretched in intensity
and details in the image might appear.
The main image must select and realize the same
palette.

Anyway, whatever value I put to the UsFlag make no change
to the low and high color values of the displayed image.
I still suspect them to be the colors that windows uses,
and I do not know hoe to get rid of them.

Maybe when you see the whole unit You'll see
the thing which puzzles me.

Maybe I create the BITMAP itself wrong????

Once again
Best regards Fred
PS!


Main Source code:

unit vpal;

interface

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
  Buttons, ExtCtrls;

const
    IPV : word = 256;
    IPH : word =  1;

type
  Ptype=array[0..255] of byte;
  IP=^Ptype;
  Tpal = class(TForm)
    Image1: TImage;
    ScrollBar1: TScrollBar;
    ScrollBar2: TScrollBar;
    ListBox1: TListBox;
    Edit1: TEdit;
    Edit2: TEdit;
    procedure dopaints(Sender: TObject);
    procedure dowelcomes(Sender: TObject);
    procedure makepal(Sender: TObject);
    procedure WhichisSelected(Sender: TObject);
    procedure Initpalette(Sender: TObject);

  private
    { Private declarations }
     procedure DrawBitMaps(PaintDC:HDC;PalBitMap:Hbitmap);
  public
    { Public declarations }
  end;

var
  pal: Tpal;
  IPS: IP;
  PalBitMap:Hbitmap;
  ImagePalette:HPalette;
  Entries:integer;
  RED,GREEN,BLUE,WHITE:BOOLEAN;

implementation

{$R *.DFM}

function GetColorsCount : integer;
var h : hDC;
begin
 Result := 0;
 try
  h      := GetDC( 0 );
  Result :=
          1 shl
           (
             GetDeviceCaps( h, PLANES ) *
             GetDeviceCaps( h, BITSPIXEL )
            );
 finally
 ReleaseDC( 0, h );
end;
end;

function i2s(i:longint):string;
var tmp:string;
begin
  Str(i,tmp);
  i2s:=tmp;
end;

procedure Selectcolores(COLOR:string);
begin
   if Color = 'RED' then
   begin
     RED:=TRUE;
     BLUE:=FALSE;
     GREEN:=FALSE;
     WHITE:=FALSE;
   end;
   if Color = 'BLUE' then
   begin
     RED:=FALSE;
     BLUE:=TRUE;
     GREEN:=FALSE;
     WHITE:=FALSE;
   end;
   if Color = 'GREEN' then
   begin
     RED:=FALSE;
     BLUE:=FALSE;
     GREEN:=TRUE;
     WHITE:=FALSE;
   end;
   if Color = 'WHITE' then
   begin
     RED:=FALSE;
     BLUE:=FALSE;
     GREEN:=FALSE;
     WHITE:=TRUE;
   end;
end;

procedure Tpal.dowelcomes(Sender: TObject);
var BITMAP:^Windows.Tbitmap;
    j:longint;
    bitinfs:longint;
begin
   Entries:=GetColorsCount;
   Selectcolores('WHITE');
   bitinfs:=sizeof(Windows.TBitmap);
   GetMem(BITMAP,bitinfs);
    with BITMAP^ do
    begin
      bmType:=0;
       bmWidth:=IPV;
       bmHeight:=IPH;
       bmWidthBytes:=IPV;
       bmPlanes:=1;
       bmBitsPixel:=8;
   end;
   GetMem(IPS,IPV*IPH);
   for J:=0 to IPV-1 do IPS^[J]:=J;
   BITMAP^.bmBits:=IPS;
   PalBitMap:=CreateBitmapIndirect(BITMAP^);
   FreeMem(IPS,IPV*IPH);
   FreeMem(BITMAP,bitinfs);
   Initpalette(Sender);
end;

procedure Tpal.DrawBitMaps(PaintDC:HDC;PalBitMap:Hbitmap);
var MemDC:HDC;
    OldBitMap:HbitMap;
    ImageOldPalette:HPalette;
    wreal:word;
begin
    MemDC:=CreateCompatibleDC(PaintDC);
    OldBitMap:=SelectObject(MemDC,PalBitMap);
    ImageOldPalette:= SelectPalette(PaintDC, ImagePalette, FALSE);
    wReal := RealizePalette(PaintDC);
    StretchBlt(PaintDC,pal.image1.left,pal.image1.Top,
               pal.image1.width,pal.image1.Height,
               MemDC,0,0,IPV,IPH,SRCCOPY);
    SelectObject(MemDC,OldBitmap);
    DeleteObject(MemDC);
end;

procedure Tpal.dopaints(Sender: TObject);
var DC:HDC;
begin
 if palbitmap<>0 then
 begin
  DC:=GetDC(pal.Handle);
  DrawBitMaps(DC,palbitMap);
  releaseDC(pal.Handle,DC);
 end;
 Edit1.text:=i2s(ScrollBar1.position);
 Edit2.text:=i2s(ScrollBar2.position);
end;

procedure Tpal.makepal(Sender: TObject);
var i,j:integer;
    UsFlag:Byte;
    lSize : LongInt;
    pPal  : PLOGPALETTE;
    hpal  : HPalette;
begin
 if Scrollbar1.position <> Scrollbar2.position then
 begin
  pPal:=nil;
  try
    lSize:= sizeof(TLogPalette) + (Entries-1) * sizeof(TPaletteEntry);
    GetMem(pPal,LSize);
    pPal^.palVersion    := $300;
    pPal^.palNumEntries := Entries;
    UsFlag:=PC_RESERVED;
    {$R-}
    for i:= 0 to Entries-1 do
    begin
      j:=round((i-Scrollbar2.position)*((Entries-1)/(Scrollbar1.position-Scrollbar2.position)));
      if i > Scrollbar1.position then j:=Entries-1;
      if i <= Scrollbar2.position then j:=0;
      if RED then
      begin
       pPal^.palPalEntry[i].peRed   := j;
       pPal^.palPalEntry[i].peGreen := 0;
       pPal^.palPalEntry[i].peBlue  := 0;
       pPal^.palPalEntry[i].peFlags := UsFlag;
      end;
      if BLUE then
      begin
       pPal^.palPalEntry[i].peRed   := 0;
       pPal^.palPalEntry[i].peGreen := 0;
       pPal^.palPalEntry[i].peBlue  := j;
       pPal^.palPalEntry[i].peFlags := UsFlag;
      end;
      if GREEN then
      begin
       pPal^.palPalEntry[i].peRed   := 0;
       pPal^.palPalEntry[i].peGreen := j;
       pPal^.palPalEntry[i].peBlue  := 0;
       pPal^.palPalEntry[i].peFlags := UsFlag;
      end;
      if WHITE then
      begin
       pPal^.palPalEntry[i].peRed   := j;
       pPal^.palPalEntry[i].peGreen := j;
       pPal^.palPalEntry[i].peBlue  := j;
       pPal^.palPalEntry[i].peFlags := UsFlag;
      end;
   end;
   {$R+}
   hpal:= CreatePalette(pPal^);
   if hpal <> 0 then ImagePalette:=hpal;
  finally
   FreeMem(pPal, lSize);
  end;
   dopaints(Sender);
  end;
end;

procedure Tpal.WhichisSelected(Sender: TObject);
begin
  if ListBox1.Selected[0] then SelectColores('WHITE');
  if ListBox1.Selected[1] then SelectColores('RED');
  if ListBox1.Selected[2] then SelectColores('BLUE');
  if ListBox1.Selected[3] then SelectColores('GREEN');
  makepal(Sender);
end;

procedure Tpal.Initpalette(Sender: TObject);
begin
   WhichisSelected(Sender);
   makepal(Sender);
end;

end.

0
 

Author Comment

by:freds090597
Comment Utility

Ups...I guess I need more points !
0

Featured Post

IT, Stop Being Called Into Every Meeting

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!

Join & Write a Comment

Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
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…
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.
This tutorial demonstrates a quick way of adding group price to multiple Magento products.

772 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

12 Experts available now in Live!

Get 1:1 Help Now