C
ccc123456
Unregistered / Unconfirmed
GUEST, unregistred user!
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
type
TLUTTable = array[0..255, 0..3] of Integer; //按照R,G,B的顺序来存储
PTLutTable = ^TLUTTable;
const
PseudoKind = 13;
PseudoList: array[0..PseudoKind - 1] of string[16] =
('正常', '负片', 'Metal', 'GrayRain', 'HotIron', 'BlackBody', 'NIH',
'GE_Color', 'Flow', 'Cardiac', 'Spectrum', 'FiveRamp', 'Fusion16');
{以下是颜色查找表}
Hotiron_LUT: TLUTTable = //Hotiron.lut
(
(255, 255, 255, 255), (254, 255, 252, 252), (253, 255, 250, 248), (252, 255, 248, 244),
(251, 255, 246, 240), (250, 255, 244, 236), (249, 255, 242, 232), (248, 255, 240, 228),
(247, 255, 238, 224), (246, 255, 236, 220), (245, 255, 234, 216), (244, 255, 232, 212),
(243, 255, 230, 208), (242, 255, 228, 204), (241, 255, 226, 200), (240, 255, 224, 196),
(239, 255, 222, 192), (238, 255, 220, 188), (237, 255, 218, 184), (236, 255, 216, 180),
(235, 255, 214, 176), (234, 255, 212, 172), (233, 255, 210, 168), (232, 255, 208, 164),
(231, 255, 206, 160), (230, 255, 204, 156), (229, 255, 202, 152), (228, 255, 200, 148),
(227, 255, 198, 144), (226, 255, 196, 140), (225, 255, 194, 136), (224, 255, 192, 132),
(223, 255, 190, 128), (222, 255, 188, 124), (221, 255, 186, 120), (220, 255, 184, 116),
(219, 255, 182, 112), (218, 255, 180, 108), (217, 255, 178, 104), (216, 255, 176, 100),
(215, 255, 174, 96), (214, 255, 172, 92), (213, 255, 170, 88), (212, 255, 168, 84),
(211, 255, 166, 80), (210, 255, 164, 76), (209, 255, 162, 72), (208, 255, 160, 68),
(207, 255, 158, 64), (206, 255, 156, 60), (205, 255, 154, 56), (204, 255, 152, 52),
(203, 255, 150, 48), (202, 255, 148, 44), (201, 255, 146, 40), (200, 255, 144, 36),
(199, 255, 142, 32), (198, 255, 140, 28), (197, 255, 138, 24), (196, 255, 136, 20),
(195, 255, 134, 16), (194, 255, 132, 12), (193, 255, 130, 8), (192, 255, 128, 4),
(191, 255, 126, 0), (190, 255, 124, 0), (189, 255, 122, 0), (188, 255, 120, 0),
(187, 255, 118, 0), (186, 255, 116, 0), (185, 255, 114, 0), (184, 255, 112, 0),
(183, 255, 110, 0), (182, 255, 108, 0), (181, 255, 106, 0), (180, 255, 104, 0),
(179, 255, 102, 0), (178, 255, 100, 0), (177, 255, 98, 0), (176, 255, 96, 0),
(175, 255, 94, 0), (174, 255, 92, 0), (173, 255, 90, 0), (172, 255, 88, 0),
(171, 255, 86, 0), (170, 255, 84, 0), (169, 255, 82, 0), (168, 255, 80, 0),
(167, 255, 78, 0), (166, 255, 76, 0), (165, 255, 74, 0), (164, 255, 72, 0),
(163, 255, 70, 0), (162, 255, 68, 0), (161, 255, 66, 0), (160, 255, 64, 0),
(159, 255, 62, 0), (158, 255, 60, 0), (157, 255, 58, 0), (156, 255, 56, 0),
(155, 255, 54, 0), (154, 255, 52, 0), (153, 255, 50, 0), (152, 255, 48, 0),
(151, 255, 46, 0), (150, 255, 44, 0), (149, 255, 42, 0), (148, 255, 40, 0),
(147, 255, 38, 0), (146, 255, 36, 0), (145, 255, 34, 0), (144, 255, 32, 0),
(143, 255, 30, 0), (142, 255, 28, 0), (141, 255, 26, 0), (140, 255, 24, 0),
(139, 255, 22, 0), (138, 255, 20, 0), (137, 255, 18, 0), (136, 255, 16, 0),
(135, 255, 14, 0), (134, 255, 12, 0), (133, 255, 10, 0), (132, 255, 8, 0),
(131, 255, 6, 0), (130, 255, 4, 0), (129, 255, 2, 0), (128, 255, 0, 0),
(127, 254, 0, 0), (126, 252, 0, 0), (125, 250, 0, 0), (124, 248, 0, 0),
(123, 246, 0, 0), (122, 244, 0, 0), (121, 242, 0, 0), (120, 240, 0, 0),
(119, 238, 0, 0), (118, 236, 0, 0), (117, 234, 0, 0), (116, 232, 0, 0),
(115, 230, 0, 0), (114, 228, 0, 0), (113, 226, 0, 0), (112, 224, 0, 0),
(111, 222, 0, 0), (110, 220, 0, 0), (109, 218, 0, 0), (108, 216, 0, 0),
(107, 214, 0, 0), (106, 212, 0, 0), (105, 210, 0, 0), (104, 208, 0, 0),
(103, 206, 0, 0), (102, 204, 0, 0), (101, 202, 0, 0), (100, 200, 0, 0),
(99, 198, 0, 0), (98, 196, 0, 0), (97, 194, 0, 0), (96, 192, 0, 0),
(95, 190, 0, 0), (94, 188, 0, 0), (93, 186, 0, 0), (92, 184, 0, 0),
(91, 182, 0, 0), (90, 180, 0, 0), (89, 178, 0, 0), (88, 176, 0, 0),
(87, 174, 0, 0), (86, 172, 0, 0), (85, 170, 0, 0), (84, 168, 0, 0),
(83, 166, 0, 0), (82, 164, 0, 0), (81, 162, 0, 0), (80, 160, 0, 0),
(79, 158, 0, 0), (78, 156, 0, 0), (77, 154, 0, 0), (76, 152, 0, 0),
(75, 150, 0, 0), (74, 148, 0, 0), (73, 146, 0, 0), (72, 144, 0, 0),
(71, 142, 0, 0), (70, 140, 0, 0), (69, 138, 0, 0), (68, 136, 0, 0),
(67, 134, 0, 0), (66, 132, 0, 0), (65, 130, 0, 0), (64, 128, 0, 0),
(63, 126, 0, 0), (62, 124, 0, 0), (61, 122, 0, 0), (60, 120, 0, 0),
(59, 118, 0, 0), (58, 116, 0, 0), (57, 114, 0, 0), (56, 112, 0, 0),
(55, 110, 0, 0), (54, 108, 0, 0), (53, 106, 0, 0), (52, 104, 0, 0),
(51, 102, 0, 0), (50, 100, 0, 0), (49, 98, 0, 0), (48, 96, 0, 0),
(47, 94, 0, 0), (46, 92, 0, 0), (45, 90, 0, 0), (44, 88, 0, 0),
(43, 86, 0, 0), (42, 84, 0, 0), (41, 82, 0, 0), (40, 80, 0, 0),
(39, 78, 0, 0), (38, 76, 0, 0), (37, 74, 0, 0), (36, 72, 0, 0),
(35, 70, 0, 0), (34, 68, 0, 0), (33, 66, 0, 0), (32, 64, 0, 0),
(31, 62, 0, 0), (30, 60, 0, 0), (29, 58, 0, 0), (28, 56, 0, 0),
(27, 54, 0, 0), (26, 52, 0, 0), (25, 50, 0, 0), (24, 48, 0, 0),
(23, 46, 0, 0), (22, 44, 0, 0), (21, 42, 0, 0), (20, 40, 0, 0),
(19, 38, 0, 0), (18, 36, 0, 0), (17, 34, 0, 0), (16, 32, 0, 0),
(15, 30, 0, 0), (14, 28, 0, 0), (13, 26, 0, 0), (12, 24, 0, 0),
(11, 22, 0, 0), (10, 20, 0, 0), (9, 18, 0, 0), (8, 16, 0, 0),
(7, 14, 0, 0), (6, 12, 0, 0), (5, 10, 0, 0), (4, 8, 0, 0),
(3, 6, 0, 0), (2, 4, 0, 0), (1, 2, 0, 0), (0, 0, 0, 0)
);
var
Form1: TForm1;
implementation
{$R *.DFM}
Function CreateIdentityPalette(handle:Hwnd; nColors: Integer): HPALETTE;
type
QA = Array[0..255] of TRGBQUAD;
var
SelLUT: TLUTTable;
Palette: PLOGPALETTE;
PalSize: Word;
ScreenDC: HDC;
I: Integer;
nStaticColors: Integer;
nUsableColors: Integer;
begin
SelLUT := HotIron_LUT;
PalSize := SizeOf(TLOGPALETTE) + SizeOf(TPALETTEENTRY) * 256;
GetMem(Palette, PalSize);
try
with Palette^ do
begin
palVersion := $0300;
palNumEntries := 256;
ScreenDC := GetDC(handle);
try
if (GetSystemPaletteUse(ScreenDC) = SYSPAL_NOSTATIC)
then
begin
{$R-}
for i := 0 to (nColors - 1) do
with palPalEntry do
begin
peRed := SelLUT[i,1];
peGreen := SelLUT[i,2];
peBlue := SelLUT[i,3];
peFlags := PC_NOCOLLAPSE;
end;
for i := nColors to 255 do
palPalEntry.peFlags := PC_NOCOLLAPSE;
I := 255;
with palPalEntry do
begin
peRed := 255;
peGreen := 255;
peBlue := 255;
peFlags := 0;
end;
with palPalEntry[0] do
begin
peRed := 0;
peGreen := 0;
peBlue := 0;
peFlags := 0;
end;
{$R+}
end
else
begin
nStaticColors := GetDeviceCaps(ScreenDC, NUMRESERVED);
GetSystemPaletteEntries(ScreenDC, 0, 256, palPalEntry);
{$R-}
nStaticColors := nStaticColors shr 1;
for i:= 0 to (nStaticColors - 1) do
palPalEntry.peFlags := 0;
nUsableColors := nColors - nStaticColors;
for I := nStaticColors to (nUsableColors - 1) do
with palPalEntrydo
begin
peRed := SelLUT[i,1];
peGreen := SelLUT[i,2];
peBlue := SelLUT[i,3];
peFlags := PC_NOCOLLAPSE;
end;
for i := nUsableColors to (255 - nStaticColors) do
palPalEntry.peFlags := PC_NOCOLLAPSE;
for i := (256 - nStaticColors) to 255 do
palPalEntry.peFlags := 0;
end;
finally
ReleaseDC(handle, ScreenDC);
end;
end;
Result := CreatePalette(Palette^);
finally
FreeMem(Palette, PalSize);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
SelPallete:HPALETTE;
begin
SelPallete:=CreateIdentityPalette(image1.Picture.Bitmap.Handle,256);
SelectPalette(image1.Picture.Bitmap.Handle,SelPallete,false);
RealizePalette(image1.Picture.Bitmap.Handle );
end;
end.
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
type
TLUTTable = array[0..255, 0..3] of Integer; //按照R,G,B的顺序来存储
PTLutTable = ^TLUTTable;
const
PseudoKind = 13;
PseudoList: array[0..PseudoKind - 1] of string[16] =
('正常', '负片', 'Metal', 'GrayRain', 'HotIron', 'BlackBody', 'NIH',
'GE_Color', 'Flow', 'Cardiac', 'Spectrum', 'FiveRamp', 'Fusion16');
{以下是颜色查找表}
Hotiron_LUT: TLUTTable = //Hotiron.lut
(
(255, 255, 255, 255), (254, 255, 252, 252), (253, 255, 250, 248), (252, 255, 248, 244),
(251, 255, 246, 240), (250, 255, 244, 236), (249, 255, 242, 232), (248, 255, 240, 228),
(247, 255, 238, 224), (246, 255, 236, 220), (245, 255, 234, 216), (244, 255, 232, 212),
(243, 255, 230, 208), (242, 255, 228, 204), (241, 255, 226, 200), (240, 255, 224, 196),
(239, 255, 222, 192), (238, 255, 220, 188), (237, 255, 218, 184), (236, 255, 216, 180),
(235, 255, 214, 176), (234, 255, 212, 172), (233, 255, 210, 168), (232, 255, 208, 164),
(231, 255, 206, 160), (230, 255, 204, 156), (229, 255, 202, 152), (228, 255, 200, 148),
(227, 255, 198, 144), (226, 255, 196, 140), (225, 255, 194, 136), (224, 255, 192, 132),
(223, 255, 190, 128), (222, 255, 188, 124), (221, 255, 186, 120), (220, 255, 184, 116),
(219, 255, 182, 112), (218, 255, 180, 108), (217, 255, 178, 104), (216, 255, 176, 100),
(215, 255, 174, 96), (214, 255, 172, 92), (213, 255, 170, 88), (212, 255, 168, 84),
(211, 255, 166, 80), (210, 255, 164, 76), (209, 255, 162, 72), (208, 255, 160, 68),
(207, 255, 158, 64), (206, 255, 156, 60), (205, 255, 154, 56), (204, 255, 152, 52),
(203, 255, 150, 48), (202, 255, 148, 44), (201, 255, 146, 40), (200, 255, 144, 36),
(199, 255, 142, 32), (198, 255, 140, 28), (197, 255, 138, 24), (196, 255, 136, 20),
(195, 255, 134, 16), (194, 255, 132, 12), (193, 255, 130, 8), (192, 255, 128, 4),
(191, 255, 126, 0), (190, 255, 124, 0), (189, 255, 122, 0), (188, 255, 120, 0),
(187, 255, 118, 0), (186, 255, 116, 0), (185, 255, 114, 0), (184, 255, 112, 0),
(183, 255, 110, 0), (182, 255, 108, 0), (181, 255, 106, 0), (180, 255, 104, 0),
(179, 255, 102, 0), (178, 255, 100, 0), (177, 255, 98, 0), (176, 255, 96, 0),
(175, 255, 94, 0), (174, 255, 92, 0), (173, 255, 90, 0), (172, 255, 88, 0),
(171, 255, 86, 0), (170, 255, 84, 0), (169, 255, 82, 0), (168, 255, 80, 0),
(167, 255, 78, 0), (166, 255, 76, 0), (165, 255, 74, 0), (164, 255, 72, 0),
(163, 255, 70, 0), (162, 255, 68, 0), (161, 255, 66, 0), (160, 255, 64, 0),
(159, 255, 62, 0), (158, 255, 60, 0), (157, 255, 58, 0), (156, 255, 56, 0),
(155, 255, 54, 0), (154, 255, 52, 0), (153, 255, 50, 0), (152, 255, 48, 0),
(151, 255, 46, 0), (150, 255, 44, 0), (149, 255, 42, 0), (148, 255, 40, 0),
(147, 255, 38, 0), (146, 255, 36, 0), (145, 255, 34, 0), (144, 255, 32, 0),
(143, 255, 30, 0), (142, 255, 28, 0), (141, 255, 26, 0), (140, 255, 24, 0),
(139, 255, 22, 0), (138, 255, 20, 0), (137, 255, 18, 0), (136, 255, 16, 0),
(135, 255, 14, 0), (134, 255, 12, 0), (133, 255, 10, 0), (132, 255, 8, 0),
(131, 255, 6, 0), (130, 255, 4, 0), (129, 255, 2, 0), (128, 255, 0, 0),
(127, 254, 0, 0), (126, 252, 0, 0), (125, 250, 0, 0), (124, 248, 0, 0),
(123, 246, 0, 0), (122, 244, 0, 0), (121, 242, 0, 0), (120, 240, 0, 0),
(119, 238, 0, 0), (118, 236, 0, 0), (117, 234, 0, 0), (116, 232, 0, 0),
(115, 230, 0, 0), (114, 228, 0, 0), (113, 226, 0, 0), (112, 224, 0, 0),
(111, 222, 0, 0), (110, 220, 0, 0), (109, 218, 0, 0), (108, 216, 0, 0),
(107, 214, 0, 0), (106, 212, 0, 0), (105, 210, 0, 0), (104, 208, 0, 0),
(103, 206, 0, 0), (102, 204, 0, 0), (101, 202, 0, 0), (100, 200, 0, 0),
(99, 198, 0, 0), (98, 196, 0, 0), (97, 194, 0, 0), (96, 192, 0, 0),
(95, 190, 0, 0), (94, 188, 0, 0), (93, 186, 0, 0), (92, 184, 0, 0),
(91, 182, 0, 0), (90, 180, 0, 0), (89, 178, 0, 0), (88, 176, 0, 0),
(87, 174, 0, 0), (86, 172, 0, 0), (85, 170, 0, 0), (84, 168, 0, 0),
(83, 166, 0, 0), (82, 164, 0, 0), (81, 162, 0, 0), (80, 160, 0, 0),
(79, 158, 0, 0), (78, 156, 0, 0), (77, 154, 0, 0), (76, 152, 0, 0),
(75, 150, 0, 0), (74, 148, 0, 0), (73, 146, 0, 0), (72, 144, 0, 0),
(71, 142, 0, 0), (70, 140, 0, 0), (69, 138, 0, 0), (68, 136, 0, 0),
(67, 134, 0, 0), (66, 132, 0, 0), (65, 130, 0, 0), (64, 128, 0, 0),
(63, 126, 0, 0), (62, 124, 0, 0), (61, 122, 0, 0), (60, 120, 0, 0),
(59, 118, 0, 0), (58, 116, 0, 0), (57, 114, 0, 0), (56, 112, 0, 0),
(55, 110, 0, 0), (54, 108, 0, 0), (53, 106, 0, 0), (52, 104, 0, 0),
(51, 102, 0, 0), (50, 100, 0, 0), (49, 98, 0, 0), (48, 96, 0, 0),
(47, 94, 0, 0), (46, 92, 0, 0), (45, 90, 0, 0), (44, 88, 0, 0),
(43, 86, 0, 0), (42, 84, 0, 0), (41, 82, 0, 0), (40, 80, 0, 0),
(39, 78, 0, 0), (38, 76, 0, 0), (37, 74, 0, 0), (36, 72, 0, 0),
(35, 70, 0, 0), (34, 68, 0, 0), (33, 66, 0, 0), (32, 64, 0, 0),
(31, 62, 0, 0), (30, 60, 0, 0), (29, 58, 0, 0), (28, 56, 0, 0),
(27, 54, 0, 0), (26, 52, 0, 0), (25, 50, 0, 0), (24, 48, 0, 0),
(23, 46, 0, 0), (22, 44, 0, 0), (21, 42, 0, 0), (20, 40, 0, 0),
(19, 38, 0, 0), (18, 36, 0, 0), (17, 34, 0, 0), (16, 32, 0, 0),
(15, 30, 0, 0), (14, 28, 0, 0), (13, 26, 0, 0), (12, 24, 0, 0),
(11, 22, 0, 0), (10, 20, 0, 0), (9, 18, 0, 0), (8, 16, 0, 0),
(7, 14, 0, 0), (6, 12, 0, 0), (5, 10, 0, 0), (4, 8, 0, 0),
(3, 6, 0, 0), (2, 4, 0, 0), (1, 2, 0, 0), (0, 0, 0, 0)
);
var
Form1: TForm1;
implementation
{$R *.DFM}
Function CreateIdentityPalette(handle:Hwnd; nColors: Integer): HPALETTE;
type
QA = Array[0..255] of TRGBQUAD;
var
SelLUT: TLUTTable;
Palette: PLOGPALETTE;
PalSize: Word;
ScreenDC: HDC;
I: Integer;
nStaticColors: Integer;
nUsableColors: Integer;
begin
SelLUT := HotIron_LUT;
PalSize := SizeOf(TLOGPALETTE) + SizeOf(TPALETTEENTRY) * 256;
GetMem(Palette, PalSize);
try
with Palette^ do
begin
palVersion := $0300;
palNumEntries := 256;
ScreenDC := GetDC(handle);
try
if (GetSystemPaletteUse(ScreenDC) = SYSPAL_NOSTATIC)
then
begin
{$R-}
for i := 0 to (nColors - 1) do
with palPalEntry do
begin
peRed := SelLUT[i,1];
peGreen := SelLUT[i,2];
peBlue := SelLUT[i,3];
peFlags := PC_NOCOLLAPSE;
end;
for i := nColors to 255 do
palPalEntry.peFlags := PC_NOCOLLAPSE;
I := 255;
with palPalEntry do
begin
peRed := 255;
peGreen := 255;
peBlue := 255;
peFlags := 0;
end;
with palPalEntry[0] do
begin
peRed := 0;
peGreen := 0;
peBlue := 0;
peFlags := 0;
end;
{$R+}
end
else
begin
nStaticColors := GetDeviceCaps(ScreenDC, NUMRESERVED);
GetSystemPaletteEntries(ScreenDC, 0, 256, palPalEntry);
{$R-}
nStaticColors := nStaticColors shr 1;
for i:= 0 to (nStaticColors - 1) do
palPalEntry.peFlags := 0;
nUsableColors := nColors - nStaticColors;
for I := nStaticColors to (nUsableColors - 1) do
with palPalEntrydo
begin
peRed := SelLUT[i,1];
peGreen := SelLUT[i,2];
peBlue := SelLUT[i,3];
peFlags := PC_NOCOLLAPSE;
end;
for i := nUsableColors to (255 - nStaticColors) do
palPalEntry.peFlags := PC_NOCOLLAPSE;
for i := (256 - nStaticColors) to 255 do
palPalEntry.peFlags := 0;
end;
finally
ReleaseDC(handle, ScreenDC);
end;
end;
Result := CreatePalette(Palette^);
finally
FreeMem(Palette, PalSize);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
SelPallete:HPALETTE;
begin
SelPallete:=CreateIdentityPalette(image1.Picture.Bitmap.Handle,256);
SelectPalette(image1.Picture.Bitmap.Handle,SelPallete,false);
RealizePalette(image1.Picture.Bitmap.Handle );
end;
end.