Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
?
Solved

Palettes in Delphi

Posted on 1997-09-05
5
Medium Priority
?
756 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
  • 2
5 Comments
 
LVL 3

Expert Comment

by:mirek071497
ID: 1344041
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
ID: 1344042
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 400 total points
ID: 1344043
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
ID: 1344044
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
ID: 1344045

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

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

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

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…
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 video you will find out how to export Office 365 mailboxes using the built in eDiscovery tool. Bear in mind that although this method might be useful in some cases, using PST files as Office 365 backup is troublesome in a long run (more on t…
How to fix incompatible JVM issue while installing Eclipse While installing Eclipse in windows, got one error like above and unable to proceed with the installation. This video describes how to successfully install Eclipse. How to solve incompa…
Suggested Courses

618 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