You've already forked lazarus-ccr
jvcllaz: Add JvGIF unit (read and write GIF images).
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8070 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
@ -519,8 +519,9 @@ procedure GetIconSize(Icon: HICON; var W, H: Integer);
|
||||
function CreateRealSizeIcon(Icon: TIcon): HICON;
|
||||
procedure DrawRealSizeIcon(Canvas: TCanvas; Icon: TIcon; X, Y: Integer);
|
||||
{end JvIconClipboardUtils }
|
||||
|
||||
*)
|
||||
function CreateScreenCompatibleDC: HDC;
|
||||
(*
|
||||
{$ENDIF !CLR}
|
||||
|
||||
{ begin JvRLE }
|
||||
@ -4903,14 +4904,14 @@ begin
|
||||
DestroyIcon(Ico);
|
||||
end;
|
||||
end;
|
||||
|
||||
*)
|
||||
function CreateScreenCompatibleDC: HDC;
|
||||
const
|
||||
HDC_DESKTOP = HDC(0);
|
||||
begin
|
||||
Result := CreateCompatibleDC(HDC_DESKTOP);
|
||||
end;
|
||||
|
||||
(*
|
||||
|
||||
{$ENDIF !CLR}
|
||||
|
||||
|
||||
@ -38,7 +38,7 @@ uses
|
||||
Windows, // before Types!
|
||||
{$ENDIF}
|
||||
Classes, Graphics, Controls, ImgList,
|
||||
LCLType, LCLProc, LCLVersion, LMessages, Types,
|
||||
LCLType, LCLProc, LCLVersion, LMessages, Types, Forms,
|
||||
JvTypes;
|
||||
|
||||
(******************** NOT CONVERTED
|
||||
@ -128,6 +128,7 @@ function ChangeBitmapColor(Bitmap: TBitmap; Color, NewColor: TColor): TBitmap;
|
||||
procedure ImageListDrawDisabled(Images: TCustomImageList; Canvas: TCanvas;
|
||||
X, Y, Index: Integer; HighLightColor, GrayColor: TColor;
|
||||
DrawHighlight: Boolean);
|
||||
|
||||
(******************** NOT CONVERTED
|
||||
|
||||
{$IFNDEF CLR}
|
||||
@ -183,6 +184,7 @@ function PointInPolyRgn(const P: TPoint; const Points: array of TPoint): Boolean
|
||||
******************** NOT CONVERTED *)
|
||||
|
||||
function PaletteColor(Color: TColor): Longint;
|
||||
function GetNearestColor(hdc: THandle; AColor: TColor): TColor;
|
||||
|
||||
(******************** NOT CONVERTED
|
||||
procedure PaintInverseRect(const RectOrg, RectEnd: TPoint);
|
||||
@ -238,7 +240,9 @@ procedure StretchBltTransparent(DstDC: HDC; DstX, DstY, DstW, DstH: Integer;
|
||||
(******************** NOT CONVERTED
|
||||
procedure DrawTransparentBitmap(DC: HDC; Bitmap: HBITMAP;
|
||||
DstX, DstY: Integer; TransparentColor: TColorRef);
|
||||
*)
|
||||
function PaletteEntries(Palette: HPALETTE): Integer;
|
||||
(******************** NOT CONVERTED
|
||||
procedure ShadeRect(DC: HDC; const Rect: TRect);
|
||||
|
||||
function ScreenWorkArea: TRect;
|
||||
@ -468,17 +472,19 @@ procedure InternalSaveMDIChildren(MainForm: TForm; const AppStorage: TJvCustomAp
|
||||
procedure InternalRestoreMDIChildren(MainForm: TForm; const AppStorage: TJvCustomAppStorage; const StorePath: string);
|
||||
|
||||
{ end JvAppUtils }
|
||||
************)
|
||||
|
||||
{ begin JvGraph }
|
||||
type
|
||||
TMappingMethod = (mmHistogram, mmQuantize, mmTrunc784, mmTrunc666,
|
||||
mmTripel, mmGrayscale);
|
||||
|
||||
function GetBitmapPixelFormat(Bitmap: TBitmap): TPixelFormat;
|
||||
|
||||
(*
|
||||
function GetPaletteBitmapFormat(Bitmap: TBitmap): TPixelFormat;
|
||||
{$IFNDEF CLR}
|
||||
procedure SetBitmapPixelFormat(Bitmap: TBitmap; PixelFormat: TPixelFormat;
|
||||
Method: TMappingMethod);
|
||||
*)
|
||||
function BitmapToMemoryStream(Bitmap: TBitmap; PixelFormat: TPixelFormat;
|
||||
Method: TMappingMethod): TMemoryStream;
|
||||
procedure GrayscaleBitmap(Bitmap: TBitmap);
|
||||
@ -486,14 +492,14 @@ procedure GrayscaleBitmap(Bitmap: TBitmap);
|
||||
function BitmapToMemory(Bitmap: TBitmap; Colors: Integer): TStream;
|
||||
procedure SaveBitmapToFile(const FileName: string; Bitmap: TBitmap;
|
||||
Colors: Integer);
|
||||
{$ENDIF !CLR}
|
||||
(*
|
||||
|
||||
function ScreenPixelFormat: TPixelFormat;
|
||||
function ScreenColorCount: Integer;
|
||||
|
||||
*)
|
||||
var
|
||||
DefaultMappingMethod: TMappingMethod = mmHistogram;
|
||||
|
||||
(******************
|
||||
function GetWorkareaRect(Monitor: TMonitor): TRect;
|
||||
function FindMonitor(Handle: HMONITOR): TMonitor;
|
||||
|
||||
@ -864,11 +870,12 @@ function Scale96ToForm(ASize: Integer): Integer;
|
||||
implementation
|
||||
|
||||
uses
|
||||
sysutils, LCLIntf, GraphType, Math, Forms,
|
||||
sysutils, LCLIntf, GraphType, Math,
|
||||
{$IFDEF MSWINDOWS}
|
||||
CommCtrl,
|
||||
{$ENDIF}
|
||||
JvConsts, JvJCLUtils;
|
||||
JvConsts, JvJCLUtils,
|
||||
JvResources;
|
||||
(********************
|
||||
SysConst,
|
||||
Consts,
|
||||
@ -889,7 +896,12 @@ const
|
||||
RC_TileWallpaper = 'TileWallpaper';
|
||||
RC_RunCpl = 'rundll32.exe shell32,Control_RunDLL ';
|
||||
{$ENDIF MSWINDOWS}
|
||||
*)
|
||||
|
||||
const
|
||||
SInvalidBitmap = 'Invalid bitmap';
|
||||
|
||||
(*
|
||||
function GetAppHandle: THandle;
|
||||
begin
|
||||
Result := Application.Handle;
|
||||
@ -2284,6 +2296,16 @@ begin
|
||||
Result := ColorToRGB(Color) or PaletteMask;
|
||||
end;
|
||||
|
||||
// Added for LCL. Note: NOT CORRECT ON NON-WINDOWS }
|
||||
function GetNearestColor(hdc: THandle; AColor: TColor): TColor;
|
||||
begin
|
||||
{$IFDEF MSWINDOWS}
|
||||
Result := Windows.GetNearestColor(hdc, AColor);
|
||||
{$ELSE}
|
||||
Result := AColor;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
|
||||
(******************** NOT CONVERTED
|
||||
function CreateRotatedFont(Font: TFont; Angle: Integer): HFONT;
|
||||
@ -2332,17 +2354,13 @@ begin
|
||||
end;
|
||||
Result := CreateFontIndirect(LogFont);
|
||||
end;
|
||||
|
||||
*)
|
||||
function PaletteEntries(Palette: HPALETTE): Integer;
|
||||
begin
|
||||
{$IFDEF CLR}
|
||||
GetObject(Palette, 4, Result);
|
||||
{$ELSE}
|
||||
GetObject(Palette, SizeOf(Integer), @Result);
|
||||
{$ENDIF CLR}
|
||||
end;
|
||||
|
||||
|
||||
(******************
|
||||
procedure Delay(MSecs: Int64);
|
||||
var
|
||||
FirstTickCount, Now: Int64;
|
||||
@ -4453,9 +4471,10 @@ begin
|
||||
SwitchToWindow(Application.Handle, False);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
{ end JvAppUtils }
|
||||
*)
|
||||
|
||||
|
||||
{ begin JvGraph }
|
||||
// (rom) moved here to make JvMaxMin obsolete
|
||||
|
||||
@ -4471,11 +4490,7 @@ end;
|
||||
|
||||
procedure InvalidBitmap;
|
||||
begin
|
||||
{$IFDEF CLR}
|
||||
raise EInvalidGraphic.Create(SInvalidBitmap);
|
||||
{$ELSE}
|
||||
raise EInvalidGraphic.CreateRes(@SInvalidBitmap);
|
||||
{$ENDIF CLR}
|
||||
end;
|
||||
|
||||
function WidthBytes(I: Longint): Longint;
|
||||
@ -4498,6 +4513,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
(*****************
|
||||
|
||||
function ScreenPixelFormat: TPixelFormat;
|
||||
var
|
||||
@ -4556,6 +4572,9 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
{$IFNDEF CLR}
|
||||
*)
|
||||
|
||||
{ Quantizing }
|
||||
{ Quantizing procedures based on free C source code written by
|
||||
Joe C. Oliphant, CompuServe 71742, 1451, joe_oliphant att csufresno dott edu }
|
||||
@ -4566,34 +4585,6 @@ const
|
||||
type
|
||||
TTriple = array [0..2] of Byte;
|
||||
|
||||
{$IFDEF CLR}
|
||||
TQColor = class;
|
||||
PQColor = TQColor;
|
||||
TQColor = class
|
||||
RGB: TTriple;
|
||||
NewColorIndex: Byte;
|
||||
Count: Longint;
|
||||
PNext: PQColor;
|
||||
end;
|
||||
|
||||
PQColorArray = array of TQColor;
|
||||
TQColorArray = array [0..MAX_COLORS - 1] of TQColor;
|
||||
|
||||
PQColorList = array of PQColor;
|
||||
TQColorList = array [0..MaxListSize - 1] of PQColor;
|
||||
|
||||
TNewColor = record
|
||||
RGBMin: TTriple;
|
||||
RGBWidth: TTriple;
|
||||
NumEntries: Longint;
|
||||
Count: Longint;
|
||||
QuantizedColors: PQColor;
|
||||
end;
|
||||
PNewColor = TNewColor;
|
||||
|
||||
PNewColorArray = array of TNewColor;
|
||||
TNewColorArray = array [Byte] of TNewColor;
|
||||
{$ELSE}
|
||||
PQColor = ^TQColor;
|
||||
TQColor = record
|
||||
RGB: TTriple;
|
||||
@ -4606,7 +4597,7 @@ type
|
||||
TQColorArray = array [0..MAX_COLORS - 1] of TQColor;
|
||||
|
||||
PQColorList = ^TQColorList;
|
||||
TQColorList = array [0..MaxListSize - 1] of PQColor;
|
||||
TQColorList = array [0..{$IFDEF RTL230_UP}MaxInt div 16{$ELSE}MaxListSize{$ENDIF RTL230_UP} - 1] of PQColor;
|
||||
|
||||
PNewColor = ^TNewColor;
|
||||
TNewColor = record
|
||||
@ -4619,9 +4610,8 @@ type
|
||||
|
||||
PNewColorArray = ^TNewColorArray;
|
||||
TNewColorArray = array [Byte] of TNewColor;
|
||||
{$ENDIF CLR}
|
||||
|
||||
procedure PInsert(ColorList: PQColorList; {$IFDEF CLR}Offset: Integer;{$ENDIF}
|
||||
procedure PInsert(ColorList: PQColorList;
|
||||
Number: Integer; SortRGBAxis: Integer);
|
||||
var
|
||||
Q1, Q2: PQColor;
|
||||
@ -4630,22 +4620,22 @@ var
|
||||
begin
|
||||
for I := 1 to Number - 1 do
|
||||
begin
|
||||
Temp := ColorList[{$IFDEF CLR}Offset +{$ENDIF}I];
|
||||
Temp := ColorList[I];
|
||||
J := I - 1;
|
||||
while J >= 0 do
|
||||
begin
|
||||
Q1 := Temp;
|
||||
Q2 := ColorList[{$IFDEF CLR}Offset +{$ENDIF}J];
|
||||
Q2 := ColorList[J];
|
||||
if Q1.RGB[SortRGBAxis] - Q2.RGB[SortRGBAxis] > 0 then
|
||||
Break;
|
||||
ColorList[{$IFDEF CLR}Offset +{$ENDIF}J + 1] := ColorList[{$IFDEF CLR}Offset +{$ENDIF}J];
|
||||
ColorList[J + 1] := ColorList[J];
|
||||
Dec(J);
|
||||
end;
|
||||
ColorList[{$IFDEF CLR}Offset +{$ENDIF}J + 1] := Temp;
|
||||
ColorList[J + 1] := Temp;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure PSort(ColorList: PQColorList; {$IFDEF CLR}Offset: Integer;{$ENDIF}
|
||||
procedure PSort(ColorList: PQColorList;
|
||||
Number: Integer; SortRGBAxis: Integer);
|
||||
var
|
||||
Q1, Q2: PQColor;
|
||||
@ -4654,61 +4644,46 @@ var
|
||||
begin
|
||||
if Number < 8 then
|
||||
begin
|
||||
PInsert(ColorList, {$IFDEF CLR}Offset, {$ENDIF} Number, SortRGBAxis);
|
||||
PInsert(ColorList, Number, SortRGBAxis);
|
||||
Exit;
|
||||
end;
|
||||
Part := ColorList[{$IFDEF CLR}Offset +{$ENDIF} Number div 2];
|
||||
Part := ColorList[Number div 2];
|
||||
I := -1;
|
||||
J := Number;
|
||||
repeat
|
||||
repeat
|
||||
Inc(I);
|
||||
Q1 := ColorList[{$IFDEF CLR}Offset +{$ENDIF} I];
|
||||
Q1 := ColorList[I];
|
||||
Q2 := Part;
|
||||
N := Q1.RGB[SortRGBAxis] - Q2.RGB[SortRGBAxis];
|
||||
until N >= 0;
|
||||
repeat
|
||||
Dec(J);
|
||||
Q1 := ColorList[{$IFDEF CLR}Offset +{$ENDIF} J];
|
||||
Q1 := ColorList[J];
|
||||
Q2 := Part;
|
||||
N := Q1.RGB[SortRGBAxis] - Q2.RGB[SortRGBAxis];
|
||||
until N <= 0;
|
||||
if I >= J then
|
||||
Break;
|
||||
Temp := ColorList[{$IFDEF CLR}Offset +{$ENDIF} I];
|
||||
ColorList[{$IFDEF CLR}Offset +{$ENDIF} I] := ColorList[{$IFDEF CLR}Offset +{$ENDIF} J];
|
||||
ColorList[{$IFDEF CLR}Offset +{$ENDIF} J] := Temp;
|
||||
Temp := ColorList[I];
|
||||
ColorList[I] := ColorList[J];
|
||||
ColorList[J] := Temp;
|
||||
until False;
|
||||
Nr := Number - I;
|
||||
if I < Number div 2 then
|
||||
begin
|
||||
{$IFDEF CLR}
|
||||
PSort(ColorList, Offset, I, SortRGBAxis);
|
||||
PSort(ColorList, Offset + I, Nr, SortRGBAxis);
|
||||
{$ELSE}
|
||||
PSort(ColorList, I, SortRGBAxis);
|
||||
PSort(PQColorList(@ColorList[I]), Nr, SortRGBAxis);
|
||||
{$ENDIF CLR}
|
||||
end
|
||||
else
|
||||
begin
|
||||
{$IFDEF CLR}
|
||||
PSort(ColorList, Offset + I, Nr, SortRGBAxis);
|
||||
PSort(ColorList, Offset, I, SortRGBAxis);
|
||||
{$ELSE}
|
||||
PSort(PQColorList(@ColorList[I]), Nr, SortRGBAxis);
|
||||
PSort(ColorList, I, SortRGBAxis);
|
||||
{$ENDIF CLR}
|
||||
end;
|
||||
end;
|
||||
|
||||
{$IFDEF CLR}
|
||||
function DivideMap(var NewColorSubdiv: PNewColorArray; ColorMapSize: Integer;
|
||||
var NewColormapSize: Integer; var LPSTR: PQColorArray; Offset: Integer): Integer;
|
||||
{$ELSE}
|
||||
function DivideMap(NewColorSubdiv: PNewColorArray; ColorMapSize: Integer;
|
||||
var NewColormapSize: Integer; LPSTR: Pointer): Integer;
|
||||
{$ENDIF CLR}
|
||||
var
|
||||
I, J: Integer;
|
||||
MaxSize, Index: Integer;
|
||||
@ -4747,16 +4722,16 @@ begin
|
||||
while (J < NewColorSubdiv[Index].NumEntries) and
|
||||
(QuantizedColor <> nil) do
|
||||
begin
|
||||
SortArray[{$IFDEF CLR}Offset +{$ENDIF} J] := QuantizedColor;
|
||||
SortArray[J] := QuantizedColor;
|
||||
Inc(J);
|
||||
QuantizedColor := QuantizedColor.PNext;
|
||||
end;
|
||||
PSort(SortArray, {$IFDEF CLR}Offset,{$ENDIF} NewColorSubdiv[Index].NumEntries, SortRGBAxis);
|
||||
PSort(SortArray, NewColorSubdiv[Index].NumEntries, SortRGBAxis);
|
||||
for J := 0 to NewColorSubdiv[Index].NumEntries - 2 do
|
||||
SortArray[{$IFDEF CLR}Offset +{$ENDIF} J].PNext := SortArray[{$IFDEF CLR}Offset +{$ENDIF} J + 1];
|
||||
SortArray[{$IFDEF CLR}Offset +{$ENDIF} NewColorSubdiv[Index].NumEntries - 1].PNext := nil;
|
||||
NewColorSubdiv[Index].QuantizedColors := SortArray[{$IFDEF CLR}Offset +{$ENDIF} 0];
|
||||
QuantizedColor := SortArray[{$IFDEF CLR}Offset +{$ENDIF} 0];
|
||||
SortArray[J].PNext := SortArray[J + 1];
|
||||
SortArray[NewColorSubdiv[Index].NumEntries - 1].PNext := nil;
|
||||
NewColorSubdiv[Index].QuantizedColors := SortArray[0];
|
||||
QuantizedColor := SortArray[0];
|
||||
Sum := NewColorSubdiv[Index].Count div 2 - QuantizedColor.Count;
|
||||
NumEntries := 1;
|
||||
Count := QuantizedColor.Count;
|
||||
@ -4795,14 +4770,13 @@ begin
|
||||
Result := 1;
|
||||
end;
|
||||
|
||||
{$IFNDEF CLR}
|
||||
function Quantize(const Bmp: TBitmapInfoHeader; gptr, Data8: Pointer;
|
||||
var ColorCount: Integer; var OutputColormap: TRGBPalette): Integer;
|
||||
type
|
||||
PWord = ^Word;
|
||||
var
|
||||
P: PByteArray;
|
||||
LineBuffer, Data: Pointer;
|
||||
LineBuffer, Data: PAnsiChar;
|
||||
LineWidth: Longint;
|
||||
TmpLineWidth, NewLineWidth: Longint;
|
||||
I, J: Longint;
|
||||
@ -4810,7 +4784,7 @@ var
|
||||
NewColormapSize, NumOfEntries: Integer;
|
||||
Mems: Longint;
|
||||
cRed, cGreen, cBlue: Longint;
|
||||
LPSTR, Temp, Tmp: Pointer;
|
||||
LPSTR, Temp, Tmp: PAnsiChar;
|
||||
NewColorSubdiv: PNewColorArray;
|
||||
ColorArrayEntries: PQColorArray;
|
||||
QuantizedColor: PQColor;
|
||||
@ -4819,17 +4793,15 @@ begin
|
||||
Mems := (Longint(SizeOf(TQColor)) * (MAX_COLORS)) +
|
||||
(Longint(SizeOf(TNewColor)) * 256) + LineWidth +
|
||||
(Longint(SizeOf(PQColor)) * (MAX_COLORS));
|
||||
LPSTR := AllocMemo(Mems);
|
||||
LPSTR := AllocMem(Mems);
|
||||
try
|
||||
Temp := AllocMemo(Longint(Bmp.biWidth) * Longint(Bmp.biHeight) *
|
||||
SizeOf(Word));
|
||||
Temp := AllocMem(Longint(Bmp.biWidth) * Longint(Bmp.biHeight) * SizeOf(Word));
|
||||
try
|
||||
ColorArrayEntries := PQColorArray(LPSTR);
|
||||
NewColorSubdiv := PNewColorArray(HugeOffset(LPSTR,
|
||||
Longint(SizeOf(TQColor)) * (MAX_COLORS)));
|
||||
LineBuffer := HugeOffset(LPSTR, (Longint(SizeOf(TQColor)) * (MAX_COLORS))
|
||||
NewColorSubdiv := PNewColorArray(LPSTR + Longint(SizeOf(TQColor)) * (MAX_COLORS));
|
||||
LineBuffer := LPSTR + (Longint(SizeOf(TQColor)) * (MAX_COLORS))
|
||||
+
|
||||
(Longint(SizeOf(TNewColor)) * 256));
|
||||
(Longint(SizeOf(TNewColor)) * 256);
|
||||
for I := 0 to MAX_COLORS - 1 do
|
||||
begin
|
||||
ColorArrayEntries^[I].RGB[0] := I shr 8;
|
||||
@ -4840,17 +4812,16 @@ begin
|
||||
Tmp := Temp;
|
||||
for I := 0 to Bmp.biHeight - 1 do
|
||||
begin
|
||||
HMemCpy(LineBuffer, HugeOffset(gptr, (Bmp.biHeight - 1 - I) *
|
||||
LineWidth), LineWidth);
|
||||
P := LineBuffer;
|
||||
Move(Pointer(PAnsiChar(gptr) + (Bmp.biHeight - 1 - I) * LineWidth)^, LineBuffer^, LineWidth);
|
||||
P := PByteArray(LineBuffer);
|
||||
for J := 0 to Bmp.biWidth - 1 do
|
||||
begin
|
||||
Index := (Longint(P^[2] and $F0) shl 4) +
|
||||
Longint(P^[1] and $F0) + (Longint(P^[0] and $F0) shr 4);
|
||||
Inc(ColorArrayEntries^[Index].Count);
|
||||
P := HugeOffset(P, 3);
|
||||
Inc(PByte(P), 3);
|
||||
PWord(Tmp)^ := Index;
|
||||
Tmp := HugeOffset(Tmp, 2);
|
||||
Inc(Tmp, 2);
|
||||
end;
|
||||
end;
|
||||
for I := 0 to 255 do
|
||||
@ -4890,8 +4861,7 @@ begin
|
||||
NewColorSubdiv^[0].Count := Longint(Bmp.biWidth) * Longint(Bmp.biHeight);
|
||||
NewColormapSize := 1;
|
||||
DivideMap(NewColorSubdiv, ColorCount, NewColormapSize,
|
||||
HugeOffset(LPSTR, Longint(SizeOf(TQColor)) * (MAX_COLORS) +
|
||||
Longint(SizeOf(TNewColor)) * 256 + LineWidth));
|
||||
LPSTR + Longint(SizeOf(TQColor)) * (MAX_COLORS) + Longint(SizeOf(TNewColor)) * 256 + LineWidth);
|
||||
if NewColormapSize < ColorCount then
|
||||
begin
|
||||
for I := NewColormapSize to ColorCount - 1 do
|
||||
@ -4930,31 +4900,32 @@ begin
|
||||
FillChar(Data8^, NewLineWidth * Bmp.biHeight, #0);
|
||||
for I := 0 to Bmp.biHeight - 1 do
|
||||
begin
|
||||
LineBuffer := HugeOffset(Temp, (Bmp.biHeight - 1 - I) * TmpLineWidth);
|
||||
Data := HugeOffset(Data8, I * NewLineWidth);
|
||||
LineBuffer := Temp + (Bmp.biHeight - 1 - I) * TmpLineWidth;
|
||||
Data := PAnsiChar(Data8) + I * NewLineWidth;
|
||||
for J := 0 to Bmp.biWidth - 1 do
|
||||
begin
|
||||
PByte(Data)^ := ColorArrayEntries^[PWord(LineBuffer)^].NewColorIndex;
|
||||
LineBuffer := HugeOffset(LineBuffer, 2);
|
||||
Data := HugeOffset(Data, 1);
|
||||
Inc(LineBuffer, 2);
|
||||
Inc(Data);
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
FreeMemo(Temp);
|
||||
FreeMem(Temp);
|
||||
end;
|
||||
finally
|
||||
FreeMemo(LPSTR);
|
||||
FreeMem(LPSTR);
|
||||
end;
|
||||
ColorCount := NewColormapSize;
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
{
|
||||
|
||||
{ ------------------------------------------------------------------------------
|
||||
Procedures to truncate to lower bits-per-pixel, grayscale, tripel and
|
||||
histogram conversion based on freeware C source code of GBM package by
|
||||
Andy Key (nyangau att interalpha dott co dott uk). The home page of GBM
|
||||
author is at http://www.interalpha.net/customer/nyangau/.
|
||||
}
|
||||
-------------------------------------------------------------------------------}
|
||||
|
||||
{ Truncate to lower bits per pixel }
|
||||
|
||||
@ -5033,8 +5004,7 @@ begin
|
||||
SrcScanline := (Header.biWidth * 3 + 3) and not 3;
|
||||
DstScanline := ((Header.biWidth * DstBitsPerPixel + 31) div 32) * 4;
|
||||
for Y := 0 to Header.biHeight - 1 do
|
||||
TruncLineProc(HugeOffset(Src, Y * SrcScanline),
|
||||
HugeOffset(Dest, Y * DstScanline), Header.biWidth);
|
||||
TruncLineProc(PAnsiChar(Src) + Y * SrcScanline, PAnsiChar(Dest) + Y * DstScanline, Header.biWidth);
|
||||
end;
|
||||
|
||||
{ return 6Rx6Gx6B palette
|
||||
@ -5071,13 +5041,13 @@ begin
|
||||
for X := 0 to CX - 1 do
|
||||
begin
|
||||
B := TruncIndex06[Byte(Src^)];
|
||||
Src := HugeOffset(Src, 1);
|
||||
Inc(PByte(Src));
|
||||
G := TruncIndex06[Byte(Src^)];
|
||||
Src := HugeOffset(Src, 1);
|
||||
Inc(PByte(Src));
|
||||
R := TruncIndex06[Byte(Src^)];
|
||||
Src := HugeOffset(Src, 1);
|
||||
Inc(PByte(Src), 1);
|
||||
PByte(Dest)^ := 6 * (6 * R + G) + B;
|
||||
Dest := HugeOffset(Dest, 1);
|
||||
Inc(PByte(Dest));
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -5124,13 +5094,13 @@ begin
|
||||
for X := 0 to CX - 1 do
|
||||
begin
|
||||
B := TruncIndex04[Byte(Src^)];
|
||||
Src := HugeOffset(Src, 1);
|
||||
Inc(PByte(Src));
|
||||
G := TruncIndex08[Byte(Src^)];
|
||||
Src := HugeOffset(Src, 1);
|
||||
Inc(PByte(Src));
|
||||
R := TruncIndex07[Byte(Src^)];
|
||||
Src := HugeOffset(Src, 1);
|
||||
Inc(PByte(Src));
|
||||
PByte(Dest)^ := 4 * (8 * R + G) + B;
|
||||
Dest := HugeOffset(Dest, 1);
|
||||
Inc(PByte(Dest));
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -5169,19 +5139,20 @@ begin
|
||||
for X := 0 to Header.biWidth - 1 do
|
||||
begin
|
||||
B := Src^;
|
||||
Src := HugeOffset(Src, 1);
|
||||
Inc(Src);
|
||||
G := Src^;
|
||||
Src := HugeOffset(Src, 1);
|
||||
Inc(Src);
|
||||
R := Src^;
|
||||
Src := HugeOffset(Src, 1);
|
||||
Inc(Src);
|
||||
Dest^ := Byte(Longint(Word(R) * 77 + Word(G) * 150 + Word(B) * 29) shr 8);
|
||||
Dest := HugeOffset(Dest, 1);
|
||||
Inc(Dest);
|
||||
end;
|
||||
Data24 := HugeOffset(Data24, SrcScanline);
|
||||
Data8 := HugeOffset(Data8, DstScanline);
|
||||
Data24 := PAnsiChar(Data24) + SrcScanline;
|
||||
Data8 := PAnsiChar(Data8) + DstScanline;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ Tripel conversion }
|
||||
|
||||
procedure TripelPal(var Colors: TRGBPalette);
|
||||
@ -5213,23 +5184,24 @@ begin
|
||||
for X := 0 to Header.biWidth - 1 do
|
||||
begin
|
||||
B := Src^;
|
||||
Src := HugeOffset(Src, 1);
|
||||
Inc(Src);
|
||||
G := Src^;
|
||||
Src := HugeOffset(Src, 1);
|
||||
Inc(Src);
|
||||
R := Src^;
|
||||
Src := HugeOffset(Src, 1);
|
||||
Inc(Src);
|
||||
case ((X + Y) mod 3) of
|
||||
0: Dest^ := Byte(R shr 2);
|
||||
1: Dest^ := Byte($40 + (G shr 2));
|
||||
2: Dest^ := Byte($80 + (B shr 2));
|
||||
end;
|
||||
Dest := HugeOffset(Dest, 1);
|
||||
Inc(Dest);
|
||||
end;
|
||||
Data24 := HugeOffset(Data24, SrcScanline);
|
||||
Data8 := HugeOffset(Data8, DstScanline);
|
||||
Data24 := PAnsiChar(Data24) + SrcScanline;
|
||||
Data8 := PAnsiChar(Data8) + DstScanline;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ Histogram/Frequency-of-use method of color reduction }
|
||||
|
||||
const
|
||||
@ -5312,11 +5284,11 @@ begin
|
||||
for X := 0 to Header.biWidth - 1 do
|
||||
begin
|
||||
B := Byte(Data24^) and BM;
|
||||
Data24 := HugeOffset(Data24, 1);
|
||||
Inc(PByte(Data24));
|
||||
G := Byte(Data24^) and Gm;
|
||||
Data24 := HugeOffset(Data24, 1);
|
||||
Inc(PByte(Data24));
|
||||
R := Byte(Data24^) and Rm;
|
||||
Data24 := HugeOffset(Data24, 1);
|
||||
Inc(PByte(Data24));
|
||||
HashColor := Hash(R, G, B);
|
||||
repeat
|
||||
Index := Hist.HashTable[HashColor];
|
||||
@ -5350,7 +5322,7 @@ begin
|
||||
Inc(Hist.Freqs[Index].Frequency);
|
||||
end;
|
||||
end;
|
||||
Data24 := HugeOffset(Data24, Step24);
|
||||
Inc(PByte(Data24), Step24);
|
||||
end;
|
||||
Hist.ColCount := ColCount;
|
||||
Result := True;
|
||||
@ -5440,11 +5412,11 @@ begin
|
||||
for X := 0 to Header.biWidth - 1 do
|
||||
begin
|
||||
B := Byte(Data24^) and BM;
|
||||
Data24 := HugeOffset(Data24, 1);
|
||||
Inc(PByte(Data24));
|
||||
G := Byte(Data24^) and Gm;
|
||||
Data24 := HugeOffset(Data24, 1);
|
||||
Inc(PByte(Data24));
|
||||
R := Byte(Data24^) and Rm;
|
||||
Data24 := HugeOffset(Data24, 1);
|
||||
Inc(PByte(Data24));
|
||||
HashColor := Hash(R, G, B);
|
||||
repeat
|
||||
Index := Hist.HashTable[HashColor];
|
||||
@ -5456,10 +5428,10 @@ begin
|
||||
HashColor := 0;
|
||||
until False;
|
||||
PByte(Data8)^ := Hist.Freqs[Index].Nearest;
|
||||
Data8 := HugeOffset(Data8, 1);
|
||||
Inc(PByte(Data8));
|
||||
end;
|
||||
Data24 := HugeOffset(Data24, Step24);
|
||||
Data8 := HugeOffset(Data8, Step8);
|
||||
Inc(PByte(Data24), Step24);
|
||||
Inc(PByte(Data8), Step8);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -5495,6 +5467,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
(*
|
||||
{ expand to 24 bits-per-pixel }
|
||||
|
||||
(-*
|
||||
@ -5612,7 +5585,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
************)
|
||||
|
||||
function GetBitmapPixelFormat(Bitmap: TBitmap): TPixelFormat;
|
||||
begin
|
||||
@ -5627,9 +5600,6 @@ begin
|
||||
Result := Result div 8;
|
||||
end;
|
||||
|
||||
{$IFNDEF CLR}
|
||||
|
||||
|
||||
procedure InitializeBitmapInfoHeader(Bitmap: HBITMAP; var BI: TBitmapInfoHeader;
|
||||
PixelFormat: TPixelFormat);
|
||||
var
|
||||
@ -5743,7 +5713,7 @@ begin
|
||||
InvalidBitmap;
|
||||
InternalGetDIBSizes(Src, HeaderSize, ImageSize, PixelFormat);
|
||||
Length := SizeOf(TBitmapFileHeader) + HeaderSize + ImageSize;
|
||||
Result := AllocMemo(Length);
|
||||
Result := AllocMem(Length);
|
||||
try
|
||||
FillChar(Result^, Length, 0);
|
||||
FileHeader := Result;
|
||||
@ -5757,7 +5727,7 @@ begin
|
||||
Bits := Pointer(Longint(BI) + HeaderSize);
|
||||
InternalGetDIB(Src, Pal, BI^, Bits^, PixelFormat);
|
||||
except
|
||||
FreeMemo(Result);
|
||||
FreeMem(Result);
|
||||
raise;
|
||||
end;
|
||||
end;
|
||||
@ -5808,7 +5778,7 @@ begin
|
||||
raise;
|
||||
end;
|
||||
finally
|
||||
FreeMemo(P);
|
||||
FreeMem(P);
|
||||
end;
|
||||
end;
|
||||
pf8bit:
|
||||
@ -5816,20 +5786,20 @@ begin
|
||||
{ pf8bit - expand to 24bit first }
|
||||
InitData := DIBFromBit(Bitmap.Handle, Bitmap.Palette, pf24bit, Len);
|
||||
try
|
||||
BI := PBitmapInfoHeader(Longint(InitData) + SizeOf(TBitmapFileHeader));
|
||||
BI := PBitmapInfoHeader(PtrInt(InitData) + SizeOf(TBitmapFileHeader));
|
||||
if BI^.biBitCount <> 24 then
|
||||
raise EJVCLException.CreateRes(@RsEBitCountNotImplemented);
|
||||
Bits := Pointer(Longint(BI) + SizeOf(TBitmapInfoHeader));
|
||||
Bits := Pointer(PtrInt(BI) + SizeOf(TBitmapInfoHeader));
|
||||
InternalGetDIBSizes(Bitmap.Handle, NewHeaderSize, ImageSize, PixelFormat);
|
||||
Length := SizeOf(TBitmapFileHeader) + NewHeaderSize;
|
||||
P := AllocMemo(Length);
|
||||
P := AllocMem(Length);
|
||||
try
|
||||
FillChar(P^, Length, #0);
|
||||
NewBI := PBitmapInfoHeader(Longint(P) + SizeOf(TBitmapFileHeader));
|
||||
NewBI := PBitmapInfoHeader(PtrInt(P) + SizeOf(TBitmapFileHeader));
|
||||
if NewHeaderSize <= SizeOf(TBitmapInfoHeader) then
|
||||
NewPalette := nil
|
||||
else
|
||||
NewPalette := PRGBPalette(Longint(NewBI) + SizeOf(TBitmapInfoHeader));
|
||||
NewPalette := PRGBPalette(PtrInt(NewBI) + SizeOf(TBitmapInfoHeader));
|
||||
FileHeader := PBitmapFileHeader(P);
|
||||
InitializeBitmapInfoHeader(Bitmap.Handle, NewBI^, PixelFormat);
|
||||
if Assigned(NewPalette) then
|
||||
@ -5884,10 +5854,10 @@ begin
|
||||
raise;
|
||||
end;
|
||||
finally
|
||||
FreeMemo(P);
|
||||
FreeMem(P);
|
||||
end;
|
||||
finally
|
||||
FreeMemo(InitData);
|
||||
FreeMem(InitData);
|
||||
end;
|
||||
end
|
||||
else
|
||||
@ -5947,9 +5917,6 @@ begin
|
||||
SetBitmapPixelFormat(Bitmap, pf8bit, mmGrayscale);
|
||||
end;
|
||||
|
||||
|
||||
{$ENDIF CLR}
|
||||
|
||||
function ZoomImage(ImageW, ImageH, MaxW, MaxH: Integer; Stretch: Boolean):
|
||||
TPoint;
|
||||
var
|
||||
@ -6000,6 +5967,8 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
(***************
|
||||
|
||||
//=== { TJvGradientOptions } =================================================
|
||||
|
||||
constructor TJvGradientOptions.Create;
|
||||
|
||||
Reference in New Issue
Block a user