You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
1319 lines
49 KiB
Plaintext
1319 lines
49 KiB
Plaintext
unit VirtualTrees.Utils;
|
|
|
|
// The contents of this file are subject to the Mozilla Public License
|
|
// Version 1.1 (the "License"); you may not use this file except in compliance
|
|
// with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/
|
|
//
|
|
// Alternatively, you may redistribute this library, use and/or modify it under the terms of the
|
|
// GNU Lesser General Public License as published by the Free Software Foundation;
|
|
// either version 2.1 of the License, or (at your option) any later version.
|
|
// You may obtain a copy of the LGPL at http://www.gnu.org/copyleft/.
|
|
//
|
|
// Software distributed under the License is distributed on an "AS IS" basis,
|
|
// WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the
|
|
// specific language governing rights and limitations under the License.
|
|
//
|
|
// The original code is VirtualTrees.pas, released September 30, 2000.
|
|
//
|
|
// The initial developer of the original code is digital publishing AG (Munich, Germany, www.digitalpublishing.de),
|
|
// written by Mike Lischke (public@soft-gems.net, www.soft-gems.net).
|
|
//
|
|
// Portions created by digital publishing AG are Copyright
|
|
// (C) 1999-2001 digital publishing AG. All Rights Reserved.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
interface
|
|
|
|
{$WARN UNSAFE_TYPE OFF}
|
|
{$WARN UNSAFE_CAST OFF}
|
|
{$WARN UNSAFE_CODE OFF}
|
|
|
|
uses
|
|
Winapi.Windows,
|
|
System.Types,
|
|
Vcl.Graphics,
|
|
Vcl.ImgList;
|
|
|
|
|
|
type
|
|
// Describes the mode how to blend pixels.
|
|
TBlendMode = (
|
|
bmConstantAlpha, // apply given constant alpha
|
|
bmPerPixelAlpha, // use alpha value of the source pixel
|
|
bmMasterAlpha, // use alpha value of source pixel and multiply it with the constant alpha value
|
|
bmConstantAlphaAndColor // blend the destination color with the given constant color und the constant alpha value
|
|
);
|
|
|
|
procedure AlphaBlend(Source, Destination: HDC; R: TRect; Target: TPoint; Mode: TBlendMode; ConstantAlpha, Bias: Integer);
|
|
function GetRGBColor(Value: TColor): DWORD;
|
|
procedure PrtStretchDrawDIB(Canvas: TCanvas; DestRect: TRect; ABitmap: TBitmap);
|
|
function HasMMX: Boolean;
|
|
|
|
procedure SetBrushOrigin(Canvas: TCanvas; X, Y: Integer);
|
|
|
|
|
|
procedure SetCanvasOrigin(Canvas: TCanvas; X, Y: Integer);
|
|
|
|
// Clip a given canvas to ClipRect while transforming the given rect to device coordinates.
|
|
procedure ClipCanvas(Canvas: TCanvas; ClipRect: TRect; VisibleRegion: HRGN = 0);
|
|
|
|
procedure DrawImage(ImageList: TCustomImageList; Index: Integer; Canvas: TCanvas; X, Y: Integer; Style: Cardinal; Enabled: Boolean);
|
|
|
|
|
|
// Adjusts the given string S so that it fits into the given width. EllipsisWidth gives the width of
|
|
// the three points to be added to the shorted string. If this value is 0 then it will be determined implicitely.
|
|
// For higher speed (and multiple entries to be shorted) specify this value explicitely.
|
|
// Note: It is assumed that the string really needs shortage. Check this in advance.
|
|
function ShortenString(DC: HDC; const S: string; Width: Integer; EllipsisWidth: Integer = 0): string;
|
|
|
|
// Wrap the given string S so that it fits into a space of given width.
|
|
// RTL determines if right-to-left reading is active.
|
|
function WrapString(DC: HDC; const S: string; const Bounds: TRect; RTL: Boolean; DrawFormat: Cardinal): string;
|
|
|
|
// Calculates bounds of a drawing rectangle for the given string
|
|
procedure GetStringDrawRect(DC: HDC; const S: string; var Bounds: TRect; DrawFormat: Cardinal);
|
|
|
|
// Converts the incoming rectangle so that left and top are always less than or equal to right and bottom.
|
|
function OrderRect(const R: TRect): TRect;
|
|
|
|
// Fills the given rectangles with values which can be used while dragging around an image
|
|
// (used in DragMove of the drag manager and DragTo of the header columns).
|
|
procedure FillDragRectangles(DragWidth, DragHeight, DeltaX, DeltaY: Integer; var RClip, RScroll, RSamp1, RSamp2, RDraw1, RDraw2: TRect);
|
|
|
|
procedure SetCurrentThreadName(const Name: Ansistring); // By Rapid D
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
Winapi.CommCtrl,
|
|
System.SysUtils,
|
|
System.StrUtils,
|
|
System.Math;
|
|
|
|
const
|
|
WideLF = Char(#10);
|
|
|
|
|
|
function OrderRect(const R: TRect): TRect;
|
|
|
|
begin
|
|
if R.Left < R.Right then
|
|
begin
|
|
Result.Left := R.Left;
|
|
Result.Right := R.Right;
|
|
end
|
|
else
|
|
begin
|
|
Result.Left := R.Right;
|
|
Result.Right := R.Left;
|
|
end;
|
|
if R.Top < R.Bottom then
|
|
begin
|
|
Result.Top := R.Top;
|
|
Result.Bottom := R.Bottom;
|
|
end
|
|
else
|
|
begin
|
|
Result.Top := R.Bottom;
|
|
Result.Bottom := R.Top;
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
|
|
procedure SetBrushOrigin(Canvas: TCanvas; X, Y: Integer);
|
|
|
|
// Set the brush origin of a given canvas.
|
|
|
|
var
|
|
P: TPoint;
|
|
|
|
begin
|
|
P := Point(X, Y);
|
|
LPtoDP(Canvas.Handle, P, 1);
|
|
SetBrushOrgEx(Canvas.Handle, P.X, P.Y, nil);
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure SetCanvasOrigin(Canvas: TCanvas; X, Y: Integer);
|
|
|
|
// Set the coordinate space origin of a given canvas.
|
|
|
|
var
|
|
P: TPoint;
|
|
|
|
begin
|
|
// Reset origin as otherwise we would accumulate the origin shifts when calling LPtoDP.
|
|
SetWindowOrgEx(Canvas.Handle, 0, 0, nil);
|
|
|
|
// The shifting is expected in physical points, so we have to transform them accordingly.
|
|
P := Point(X, Y);
|
|
LPtoDP(Canvas.Handle, P, 1);
|
|
|
|
// Do the shift.
|
|
SetWindowOrgEx(Canvas.Handle, P.X, P.Y, nil);
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure ClipCanvas(Canvas: TCanvas; ClipRect: TRect; VisibleRegion: HRGN = 0);
|
|
|
|
var
|
|
ClipRegion: HRGN;
|
|
|
|
begin
|
|
// Regions expect their coordinates in device coordinates, hence we have to transform the region rectangle.
|
|
LPtoDP(Canvas.Handle, ClipRect, 2);
|
|
ClipRegion := CreateRectRgnIndirect(ClipRect);
|
|
if VisibleRegion <> 0 then
|
|
CombineRgn(ClipRegion, ClipRegion, VisibleRegion, RGN_AND);
|
|
SelectClipRgn(Canvas.Handle, ClipRegion);
|
|
DeleteObject(ClipRegion);
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
|
|
procedure GetStringDrawRect(DC: HDC; const S: string; var Bounds: TRect; DrawFormat: Cardinal);
|
|
|
|
begin
|
|
Bounds.Right := Bounds.Left + 1;
|
|
Bounds.Bottom := Bounds.Top + 1;
|
|
|
|
Winapi.Windows.DrawTextW(DC, PWideChar(S), Length(S), Bounds, DrawFormat or DT_CALCRECT);
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
|
|
function ShortenString(DC: HDC; const S: string; Width: Integer; EllipsisWidth: Integer = 0): string;
|
|
|
|
var
|
|
Size: TSize;
|
|
Len: Integer;
|
|
L, H, N, W: Integer;
|
|
|
|
begin
|
|
Len := Length(S);
|
|
if (Len = 0) or (Width <= 0) then
|
|
Result := ''
|
|
else
|
|
begin
|
|
// Determine width of triple point using the current DC settings (if not already done).
|
|
if EllipsisWidth = 0 then
|
|
begin
|
|
GetTextExtentPoint32W(DC, '...', 3, Size);
|
|
EllipsisWidth := Size.cx;
|
|
end;
|
|
|
|
if Width <= EllipsisWidth then
|
|
Result := ''
|
|
else
|
|
begin
|
|
// Do a binary search for the optimal string length which fits into the given width.
|
|
L := 0;
|
|
H := Len - 1;
|
|
while L < H do
|
|
begin
|
|
N := (L + H + 1) shr 1;
|
|
GetTextExtentPoint32W(DC, PWideChar(S), N, Size);
|
|
W := Size.cx + EllipsisWidth;
|
|
if W <= Width then
|
|
L := N
|
|
else
|
|
H := N - 1;
|
|
end;
|
|
Result := Copy(S, 1, L) + '...';
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function WrapString(DC: HDC; const S: string; const Bounds: TRect; RTL: Boolean; DrawFormat: Cardinal): string;
|
|
|
|
var
|
|
Width,
|
|
Len,
|
|
WordCounter,
|
|
WordsInLine,
|
|
I, W: Integer;
|
|
Buffer,
|
|
Line: string;
|
|
Words: array of string;
|
|
R: TRect;
|
|
|
|
begin
|
|
Result := '';
|
|
// Leading and trailing are ignored.
|
|
Buffer := Trim(S);
|
|
Len := Length(Buffer);
|
|
if Len < 1 then
|
|
Exit;
|
|
|
|
Width := Bounds.Right - Bounds.Left;
|
|
R := Rect(0, 0, 0, 0);
|
|
|
|
// Count the words in the string.
|
|
WordCounter := 1;
|
|
for I := 1 to Len do
|
|
if Buffer[I] = ' ' then
|
|
Inc(WordCounter);
|
|
SetLength(Words, WordCounter);
|
|
|
|
if RTL then
|
|
begin
|
|
// At first we split the string into words with the last word being the
|
|
// first element in Words.
|
|
W := 0;
|
|
for I := 1 to Len do
|
|
if Buffer[I] = ' ' then
|
|
Inc(W)
|
|
else
|
|
Words[W] := Words[W] + Buffer[I];
|
|
|
|
// Compose Result.
|
|
while WordCounter > 0 do
|
|
begin
|
|
WordsInLine := 0;
|
|
Line := '';
|
|
|
|
while WordCounter > 0 do
|
|
begin
|
|
GetStringDrawRect(DC, Line + IfThen(WordsInLine > 0, ' ', '') + Words[WordCounter - 1], R, DrawFormat);
|
|
if R.Right > Width then
|
|
begin
|
|
// If at least one word fits into this line then continue with the next line.
|
|
if WordsInLine > 0 then
|
|
Break;
|
|
|
|
Buffer := Words[WordCounter - 1];
|
|
if Len > 1 then
|
|
begin
|
|
for Len := Length(Buffer) - 1 downto 2 do
|
|
begin
|
|
GetStringDrawRect(DC, RightStr(Buffer, Len), R, DrawFormat);
|
|
if R.Right <= Width then
|
|
Break;
|
|
end;
|
|
end
|
|
else
|
|
Len := Length(Buffer);
|
|
|
|
Line := Line + RightStr(Buffer, Max(Len, 1));
|
|
Words[WordCounter - 1] := LeftStr(Buffer, Length(Buffer) - Max(Len, 1));
|
|
if Words[WordCounter - 1] = '' then
|
|
Dec(WordCounter);
|
|
Break;
|
|
end
|
|
else
|
|
begin
|
|
Dec(WordCounter);
|
|
Line := Words[WordCounter] + IfThen(WordsInLine > 0, ' ', '') + Line;
|
|
Inc(WordsInLine);
|
|
end;
|
|
end;
|
|
|
|
Result := Result + Line + WideLF;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
// At first we split the string into words with the last word being the
|
|
// first element in Words.
|
|
W := WordCounter - 1;
|
|
for I := 1 to Len do
|
|
if Buffer[I] = ' ' then
|
|
Dec(W)
|
|
else
|
|
Words[W] := Words[W] + Buffer[I];
|
|
|
|
// Compose Result.
|
|
while WordCounter > 0 do
|
|
begin
|
|
WordsInLine := 0;
|
|
Line := '';
|
|
|
|
while WordCounter > 0 do
|
|
begin
|
|
GetStringDrawRect(DC, Line + IfThen(WordsInLine > 0, ' ', '') + Words[WordCounter - 1], R, DrawFormat);
|
|
if R.Right > Width then
|
|
begin
|
|
// If at least one word fits into this line then continue with the next line.
|
|
if WordsInLine > 0 then
|
|
Break;
|
|
|
|
Buffer := Words[WordCounter - 1];
|
|
if Len > 1 then
|
|
begin
|
|
for Len := Length(Buffer) - 1 downto 2 do
|
|
begin
|
|
GetStringDrawRect(DC, LeftStr(Buffer, Len), R, DrawFormat);
|
|
if R.Right <= Width then
|
|
Break;
|
|
end;
|
|
end
|
|
else
|
|
Len := Length(Buffer);
|
|
|
|
Line := Line + LeftStr(Buffer, Max(Len, 1));
|
|
Words[WordCounter - 1] := RightStr(Buffer, Length(Buffer) - Max(Len, 1));
|
|
if Words[WordCounter - 1] = '' then
|
|
Dec(WordCounter);
|
|
Break;
|
|
end
|
|
else
|
|
begin
|
|
Dec(WordCounter);
|
|
Line := Line + IfThen(WordsInLine > 0, ' ', '') + Words[WordCounter];
|
|
Inc(WordsInLine);
|
|
end;
|
|
end;
|
|
|
|
Result := Result + Line + WideLF;
|
|
end;
|
|
end;
|
|
|
|
Len := Length(Result);
|
|
if Result[Len] = WideLF then
|
|
SetLength(Result, Len - 1);
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
|
|
function CalculateScanline(Bits: Pointer; Width, Height, Row: Integer): Pointer;
|
|
|
|
// Helper function to calculate the start address for the given row.
|
|
|
|
begin
|
|
if Height > 0 then // bottom-up DIB
|
|
Row := Height - Row - 1;
|
|
// Return DWORD aligned address of the requested scanline.
|
|
Result := PAnsiChar(Bits) + Row * ((Width * 32 + 31) and not 31) div 8;
|
|
end;
|
|
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function GetBitmapBitsFromDeviceContext(DC: HDC; var Width, Height: Integer): Pointer;
|
|
|
|
// Helper function used to retrieve the bitmap selected into the given device context. If there is a bitmap then
|
|
// the function will return a pointer to its bits otherwise nil is returned.
|
|
// Additionally the dimensions of the bitmap are returned.
|
|
|
|
var
|
|
Bitmap: HBITMAP;
|
|
DIB: TDIBSection;
|
|
|
|
begin
|
|
Result := nil;
|
|
Width := 0;
|
|
Height := 0;
|
|
|
|
Bitmap := GetCurrentObject(DC, OBJ_BITMAP);
|
|
if Bitmap <> 0 then
|
|
begin
|
|
if GetObject(Bitmap, SizeOf(DIB), @DIB) = SizeOf(DIB) then
|
|
begin
|
|
Assert(DIB.dsBm.bmPlanes * DIB.dsBm.bmBitsPixel = 32, 'Alpha blending error: bitmap must use 32 bpp.');
|
|
Result := DIB.dsBm.bmBits;
|
|
Width := DIB.dsBmih.biWidth;
|
|
Height := DIB.dsBmih.biHeight;
|
|
end;
|
|
end;
|
|
Assert(Result <> nil, 'Alpha blending DC error: no bitmap available.');
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure AlphaBlendLineConstant(Source, Destination: Pointer; Count: Integer; ConstantAlpha, Bias: Integer);
|
|
|
|
// Blends a line of Count pixels from Source to Destination using a constant alpha value.
|
|
// The layout of a pixel must be BGRA where A is ignored (but is calculated as the other components).
|
|
// ConstantAlpha must be in the range 0..255 where 0 means totally transparent (destination pixel only)
|
|
// and 255 totally opaque (source pixel only).
|
|
// Bias is an additional value which gets added to every component and must be in the range -128..127
|
|
//
|
|
{$ifdef CPUX64}
|
|
// RCX contains Source
|
|
// RDX contains Destination
|
|
// R8D contains Count
|
|
// R9D contains ConstantAlpha
|
|
// Bias is on the stack
|
|
|
|
asm
|
|
//.NOFRAME
|
|
|
|
// Load XMM3 with the constant alpha value (replicate it for every component).
|
|
// Expand it to word size.
|
|
MOVD XMM3, R9D // ConstantAlpha
|
|
PUNPCKLWD XMM3, XMM3
|
|
PUNPCKLDQ XMM3, XMM3
|
|
|
|
// Load XMM5 with the bias value.
|
|
MOVD XMM5, [Bias]
|
|
PUNPCKLWD XMM5, XMM5
|
|
PUNPCKLDQ XMM5, XMM5
|
|
|
|
// Load XMM4 with 128 to allow for saturated biasing.
|
|
MOV R10D, 128
|
|
MOVD XMM4, R10D
|
|
PUNPCKLWD XMM4, XMM4
|
|
PUNPCKLDQ XMM4, XMM4
|
|
|
|
@1: // The pixel loop calculates an entire pixel in one run.
|
|
// Note: The pixel byte values are expanded into the higher bytes of a word due
|
|
// to the way unpacking works. We compensate for this with an extra shift.
|
|
MOVD XMM1, DWORD PTR [RCX] // data is unaligned
|
|
MOVD XMM2, DWORD PTR [RDX] // data is unaligned
|
|
PXOR XMM0, XMM0 // clear source pixel register for unpacking
|
|
PUNPCKLBW XMM0, XMM1{[RCX]} // unpack source pixel byte values into words
|
|
PSRLW XMM0, 8 // move higher bytes to lower bytes
|
|
PXOR XMM1, XMM1 // clear target pixel register for unpacking
|
|
PUNPCKLBW XMM1, XMM2{[RDX]} // unpack target pixel byte values into words
|
|
MOVQ XMM2, XMM1 // make a copy of the shifted values, we need them again
|
|
PSRLW XMM1, 8 // move higher bytes to lower bytes
|
|
|
|
// calculation is: target = (alpha * (source - target) + 256 * target) / 256
|
|
PSUBW XMM0, XMM1 // source - target
|
|
PMULLW XMM0, XMM3 // alpha * (source - target)
|
|
PADDW XMM0, XMM2 // add target (in shifted form)
|
|
PSRLW XMM0, 8 // divide by 256
|
|
|
|
// Bias is accounted for by conversion of range 0..255 to -128..127,
|
|
// doing a saturated add and convert back to 0..255.
|
|
PSUBW XMM0, XMM4
|
|
PADDSW XMM0, XMM5
|
|
PADDW XMM0, XMM4
|
|
PACKUSWB XMM0, XMM0 // convert words to bytes with saturation
|
|
MOVD DWORD PTR [RDX], XMM0 // store the result
|
|
@3:
|
|
ADD RCX, 4
|
|
ADD RDX, 4
|
|
DEC R8D
|
|
JNZ @1
|
|
end;
|
|
{$else}
|
|
// EAX contains Source
|
|
// EDX contains Destination
|
|
// ECX contains Count
|
|
// ConstantAlpha and Bias are on the stack
|
|
|
|
asm
|
|
PUSH ESI // save used registers
|
|
PUSH EDI
|
|
|
|
MOV ESI, EAX // ESI becomes the actual source pointer
|
|
MOV EDI, EDX // EDI becomes the actual target pointer
|
|
|
|
// Load MM6 with the constant alpha value (replicate it for every component).
|
|
// Expand it to word size.
|
|
MOV EAX, [ConstantAlpha]
|
|
DB $0F, $6E, $F0 /// MOVD MM6, EAX
|
|
DB $0F, $61, $F6 /// PUNPCKLWD MM6, MM6
|
|
DB $0F, $62, $F6 /// PUNPCKLDQ MM6, MM6
|
|
|
|
// Load MM5 with the bias value.
|
|
MOV EAX, [Bias]
|
|
DB $0F, $6E, $E8 /// MOVD MM5, EAX
|
|
DB $0F, $61, $ED /// PUNPCKLWD MM5, MM5
|
|
DB $0F, $62, $ED /// PUNPCKLDQ MM5, MM5
|
|
|
|
// Load MM4 with 128 to allow for saturated biasing.
|
|
MOV EAX, 128
|
|
DB $0F, $6E, $E0 /// MOVD MM4, EAX
|
|
DB $0F, $61, $E4 /// PUNPCKLWD MM4, MM4
|
|
DB $0F, $62, $E4 /// PUNPCKLDQ MM4, MM4
|
|
|
|
@1: // The pixel loop calculates an entire pixel in one run.
|
|
// Note: The pixel byte values are expanded into the higher bytes of a word due
|
|
// to the way unpacking works. We compensate for this with an extra shift.
|
|
DB $0F, $EF, $C0 /// PXOR MM0, MM0, clear source pixel register for unpacking
|
|
DB $0F, $60, $06 /// PUNPCKLBW MM0, [ESI], unpack source pixel byte values into words
|
|
DB $0F, $71, $D0, $08 /// PSRLW MM0, 8, move higher bytes to lower bytes
|
|
DB $0F, $EF, $C9 /// PXOR MM1, MM1, clear target pixel register for unpacking
|
|
DB $0F, $60, $0F /// PUNPCKLBW MM1, [EDI], unpack target pixel byte values into words
|
|
DB $0F, $6F, $D1 /// MOVQ MM2, MM1, make a copy of the shifted values, we need them again
|
|
DB $0F, $71, $D1, $08 /// PSRLW MM1, 8, move higher bytes to lower bytes
|
|
|
|
// calculation is: target = (alpha * (source - target) + 256 * target) / 256
|
|
DB $0F, $F9, $C1 /// PSUBW MM0, MM1, source - target
|
|
DB $0F, $D5, $C6 /// PMULLW MM0, MM6, alpha * (source - target)
|
|
DB $0F, $FD, $C2 /// PADDW MM0, MM2, add target (in shifted form)
|
|
DB $0F, $71, $D0, $08 /// PSRLW MM0, 8, divide by 256
|
|
|
|
// Bias is accounted for by conversion of range 0..255 to -128..127,
|
|
// doing a saturated add and convert back to 0..255.
|
|
DB $0F, $F9, $C4 /// PSUBW MM0, MM4
|
|
DB $0F, $ED, $C5 /// PADDSW MM0, MM5
|
|
DB $0F, $FD, $C4 /// PADDW MM0, MM4
|
|
DB $0F, $67, $C0 /// PACKUSWB MM0, MM0, convert words to bytes with saturation
|
|
DB $0F, $7E, $07 /// MOVD [EDI], MM0, store the result
|
|
@3:
|
|
ADD ESI, 4
|
|
ADD EDI, 4
|
|
DEC ECX
|
|
JNZ @1
|
|
POP EDI
|
|
POP ESI
|
|
end;
|
|
{$endif CPUX64}
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure AlphaBlendLinePerPixel(Source, Destination: Pointer; Count, Bias: Integer);
|
|
|
|
// Blends a line of Count pixels from Source to Destination using the alpha value of the source pixels.
|
|
// The layout of a pixel must be BGRA.
|
|
// Bias is an additional value which gets added to every component and must be in the range -128..127
|
|
//
|
|
{$ifdef CPUX64}
|
|
// RCX contains Source
|
|
// RDX contains Destination
|
|
// R8D contains Count
|
|
// R9D contains Bias
|
|
|
|
asm
|
|
//.NOFRAME
|
|
|
|
// Load XMM5 with the bias value.
|
|
MOVD XMM5, R9D // Bias
|
|
PUNPCKLWD XMM5, XMM5
|
|
PUNPCKLDQ XMM5, XMM5
|
|
|
|
// Load XMM4 with 128 to allow for saturated biasing.
|
|
MOV R10D, 128
|
|
MOVD XMM4, R10D
|
|
PUNPCKLWD XMM4, XMM4
|
|
PUNPCKLDQ XMM4, XMM4
|
|
|
|
@1: // The pixel loop calculates an entire pixel in one run.
|
|
// Note: The pixel byte values are expanded into the higher bytes of a word due
|
|
// to the way unpacking works. We compensate for this with an extra shift.
|
|
MOVD XMM1, DWORD PTR [RCX] // data is unaligned
|
|
MOVD XMM2, DWORD PTR [RDX] // data is unaligned
|
|
PXOR XMM0, XMM0 // clear source pixel register for unpacking
|
|
PUNPCKLBW XMM0, XMM1{[RCX]} // unpack source pixel byte values into words
|
|
PSRLW XMM0, 8 // move higher bytes to lower bytes
|
|
PXOR XMM1, XMM1 // clear target pixel register for unpacking
|
|
PUNPCKLBW XMM1, XMM2{[RDX]} // unpack target pixel byte values into words
|
|
MOVQ XMM2, XMM1 // make a copy of the shifted values, we need them again
|
|
PSRLW XMM1, 8 // move higher bytes to lower bytes
|
|
|
|
// Load XMM3 with the source alpha value (replicate it for every component).
|
|
// Expand it to word size.
|
|
MOVQ XMM3, XMM0
|
|
PUNPCKHWD XMM3, XMM3
|
|
PUNPCKHDQ XMM3, XMM3
|
|
|
|
// calculation is: target = (alpha * (source - target) + 256 * target) / 256
|
|
PSUBW XMM0, XMM1 // source - target
|
|
PMULLW XMM0, XMM3 // alpha * (source - target)
|
|
PADDW XMM0, XMM2 // add target (in shifted form)
|
|
PSRLW XMM0, 8 // divide by 256
|
|
|
|
// Bias is accounted for by conversion of range 0..255 to -128..127,
|
|
// doing a saturated add and convert back to 0..255.
|
|
PSUBW XMM0, XMM4
|
|
PADDSW XMM0, XMM5
|
|
PADDW XMM0, XMM4
|
|
PACKUSWB XMM0, XMM0 // convert words to bytes with saturation
|
|
MOVD DWORD PTR [RDX], XMM0 // store the result
|
|
@3:
|
|
ADD RCX, 4
|
|
ADD RDX, 4
|
|
DEC R8D
|
|
JNZ @1
|
|
end;
|
|
{$else}
|
|
// EAX contains Source
|
|
// EDX contains Destination
|
|
// ECX contains Count
|
|
// Bias is on the stack
|
|
|
|
asm
|
|
PUSH ESI // save used registers
|
|
PUSH EDI
|
|
|
|
MOV ESI, EAX // ESI becomes the actual source pointer
|
|
MOV EDI, EDX // EDI becomes the actual target pointer
|
|
|
|
// Load MM5 with the bias value.
|
|
MOV EAX, [Bias]
|
|
DB $0F, $6E, $E8 /// MOVD MM5, EAX
|
|
DB $0F, $61, $ED /// PUNPCKLWD MM5, MM5
|
|
DB $0F, $62, $ED /// PUNPCKLDQ MM5, MM5
|
|
|
|
// Load MM4 with 128 to allow for saturated biasing.
|
|
MOV EAX, 128
|
|
DB $0F, $6E, $E0 /// MOVD MM4, EAX
|
|
DB $0F, $61, $E4 /// PUNPCKLWD MM4, MM4
|
|
DB $0F, $62, $E4 /// PUNPCKLDQ MM4, MM4
|
|
|
|
@1: // The pixel loop calculates an entire pixel in one run.
|
|
// Note: The pixel byte values are expanded into the higher bytes of a word due
|
|
// to the way unpacking works. We compensate for this with an extra shift.
|
|
DB $0F, $EF, $C0 /// PXOR MM0, MM0, clear source pixel register for unpacking
|
|
DB $0F, $60, $06 /// PUNPCKLBW MM0, [ESI], unpack source pixel byte values into words
|
|
DB $0F, $71, $D0, $08 /// PSRLW MM0, 8, move higher bytes to lower bytes
|
|
DB $0F, $EF, $C9 /// PXOR MM1, MM1, clear target pixel register for unpacking
|
|
DB $0F, $60, $0F /// PUNPCKLBW MM1, [EDI], unpack target pixel byte values into words
|
|
DB $0F, $6F, $D1 /// MOVQ MM2, MM1, make a copy of the shifted values, we need them again
|
|
DB $0F, $71, $D1, $08 /// PSRLW MM1, 8, move higher bytes to lower bytes
|
|
|
|
// Load MM6 with the source alpha value (replicate it for every component).
|
|
// Expand it to word size.
|
|
DB $0F, $6F, $F0 /// MOVQ MM6, MM0
|
|
DB $0F, $69, $F6 /// PUNPCKHWD MM6, MM6
|
|
DB $0F, $6A, $F6 /// PUNPCKHDQ MM6, MM6
|
|
|
|
// calculation is: target = (alpha * (source - target) + 256 * target) / 256
|
|
DB $0F, $F9, $C1 /// PSUBW MM0, MM1, source - target
|
|
DB $0F, $D5, $C6 /// PMULLW MM0, MM6, alpha * (source - target)
|
|
DB $0F, $FD, $C2 /// PADDW MM0, MM2, add target (in shifted form)
|
|
DB $0F, $71, $D0, $08 /// PSRLW MM0, 8, divide by 256
|
|
|
|
// Bias is accounted for by conversion of range 0..255 to -128..127,
|
|
// doing a saturated add and convert back to 0..255.
|
|
DB $0F, $F9, $C4 /// PSUBW MM0, MM4
|
|
DB $0F, $ED, $C5 /// PADDSW MM0, MM5
|
|
DB $0F, $FD, $C4 /// PADDW MM0, MM4
|
|
DB $0F, $67, $C0 /// PACKUSWB MM0, MM0, convert words to bytes with saturation
|
|
DB $0F, $7E, $07 /// MOVD [EDI], MM0, store the result
|
|
@3:
|
|
ADD ESI, 4
|
|
ADD EDI, 4
|
|
DEC ECX
|
|
JNZ @1
|
|
POP EDI
|
|
POP ESI
|
|
end;
|
|
{$endif CPUX64}
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure EMMS;
|
|
|
|
// Reset MMX state to use the FPU for other tasks again.
|
|
|
|
{$ifdef CPUX64}
|
|
inline;
|
|
begin
|
|
end;
|
|
{$else}
|
|
asm
|
|
DB $0F, $77 /// EMMS
|
|
end;
|
|
{$endif CPUX64}
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure AlphaBlendLineMaster(Source, Destination: Pointer; Count: Integer; ConstantAlpha, Bias: Integer);
|
|
|
|
// Blends a line of Count pixels from Source to Destination using the source pixel and a constant alpha value.
|
|
// The layout of a pixel must be BGRA.
|
|
// ConstantAlpha must be in the range 0..255.
|
|
// Bias is an additional value which gets added to every component and must be in the range -128..127
|
|
//
|
|
{$ifdef CPUX64}
|
|
// RCX contains Source
|
|
// RDX contains Destination
|
|
// R8D contains Count
|
|
// R9D contains ConstantAlpha
|
|
// Bias is on the stack
|
|
|
|
asm
|
|
.SAVENV XMM6
|
|
|
|
// Load XMM3 with the constant alpha value (replicate it for every component).
|
|
// Expand it to word size.
|
|
MOVD XMM3, R9D // ConstantAlpha
|
|
PUNPCKLWD XMM3, XMM3
|
|
PUNPCKLDQ XMM3, XMM3
|
|
|
|
// Load XMM5 with the bias value.
|
|
MOV R10D, [Bias]
|
|
MOVD XMM5, R10D
|
|
PUNPCKLWD XMM5, XMM5
|
|
PUNPCKLDQ XMM5, XMM5
|
|
|
|
// Load XMM4 with 128 to allow for saturated biasing.
|
|
MOV R10D, 128
|
|
MOVD XMM4, R10D
|
|
PUNPCKLWD XMM4, XMM4
|
|
PUNPCKLDQ XMM4, XMM4
|
|
|
|
@1: // The pixel loop calculates an entire pixel in one run.
|
|
// Note: The pixel byte values are expanded into the higher bytes of a word due
|
|
// to the way unpacking works. We compensate for this with an extra shift.
|
|
MOVD XMM1, DWORD PTR [RCX] // data is unaligned
|
|
MOVD XMM2, DWORD PTR [RDX] // data is unaligned
|
|
PXOR XMM0, XMM0 // clear source pixel register for unpacking
|
|
PUNPCKLBW XMM0, XMM1{[RCX]} // unpack source pixel byte values into words
|
|
PSRLW XMM0, 8 // move higher bytes to lower bytes
|
|
PXOR XMM1, XMM1 // clear target pixel register for unpacking
|
|
PUNPCKLBW XMM1, XMM2{[RCX]} // unpack target pixel byte values into words
|
|
MOVQ XMM2, XMM1 // make a copy of the shifted values, we need them again
|
|
PSRLW XMM1, 8 // move higher bytes to lower bytes
|
|
|
|
// Load XMM6 with the source alpha value (replicate it for every component).
|
|
// Expand it to word size.
|
|
MOVQ XMM6, XMM0
|
|
PUNPCKHWD XMM6, XMM6
|
|
PUNPCKHDQ XMM6, XMM6
|
|
PMULLW XMM6, XMM3 // source alpha * master alpha
|
|
PSRLW XMM6, 8 // divide by 256
|
|
|
|
// calculation is: target = (alpha * master alpha * (source - target) + 256 * target) / 256
|
|
PSUBW XMM0, XMM1 // source - target
|
|
PMULLW XMM0, XMM6 // alpha * (source - target)
|
|
PADDW XMM0, XMM2 // add target (in shifted form)
|
|
PSRLW XMM0, 8 // divide by 256
|
|
|
|
// Bias is accounted for by conversion of range 0..255 to -128..127,
|
|
// doing a saturated add and convert back to 0..255.
|
|
PSUBW XMM0, XMM4
|
|
PADDSW XMM0, XMM5
|
|
PADDW XMM0, XMM4
|
|
PACKUSWB XMM0, XMM0 // convert words to bytes with saturation
|
|
MOVD DWORD PTR [RDX], XMM0 // store the result
|
|
@3:
|
|
ADD RCX, 4
|
|
ADD RDX, 4
|
|
DEC R8D
|
|
JNZ @1
|
|
end;
|
|
{$else}
|
|
// EAX contains Source
|
|
// EDX contains Destination
|
|
// ECX contains Count
|
|
// ConstantAlpha and Bias are on the stack
|
|
|
|
asm
|
|
PUSH ESI // save used registers
|
|
PUSH EDI
|
|
|
|
MOV ESI, EAX // ESI becomes the actual source pointer
|
|
MOV EDI, EDX // EDI becomes the actual target pointer
|
|
|
|
// Load MM6 with the constant alpha value (replicate it for every component).
|
|
// Expand it to word size.
|
|
MOV EAX, [ConstantAlpha]
|
|
DB $0F, $6E, $F0 /// MOVD MM6, EAX
|
|
DB $0F, $61, $F6 /// PUNPCKLWD MM6, MM6
|
|
DB $0F, $62, $F6 /// PUNPCKLDQ MM6, MM6
|
|
|
|
// Load MM5 with the bias value.
|
|
MOV EAX, [Bias]
|
|
DB $0F, $6E, $E8 /// MOVD MM5, EAX
|
|
DB $0F, $61, $ED /// PUNPCKLWD MM5, MM5
|
|
DB $0F, $62, $ED /// PUNPCKLDQ MM5, MM5
|
|
|
|
// Load MM4 with 128 to allow for saturated biasing.
|
|
MOV EAX, 128
|
|
DB $0F, $6E, $E0 /// MOVD MM4, EAX
|
|
DB $0F, $61, $E4 /// PUNPCKLWD MM4, MM4
|
|
DB $0F, $62, $E4 /// PUNPCKLDQ MM4, MM4
|
|
|
|
@1: // The pixel loop calculates an entire pixel in one run.
|
|
// Note: The pixel byte values are expanded into the higher bytes of a word due
|
|
// to the way unpacking works. We compensate for this with an extra shift.
|
|
DB $0F, $EF, $C0 /// PXOR MM0, MM0, clear source pixel register for unpacking
|
|
DB $0F, $60, $06 /// PUNPCKLBW MM0, [ESI], unpack source pixel byte values into words
|
|
DB $0F, $71, $D0, $08 /// PSRLW MM0, 8, move higher bytes to lower bytes
|
|
DB $0F, $EF, $C9 /// PXOR MM1, MM1, clear target pixel register for unpacking
|
|
DB $0F, $60, $0F /// PUNPCKLBW MM1, [EDI], unpack target pixel byte values into words
|
|
DB $0F, $6F, $D1 /// MOVQ MM2, MM1, make a copy of the shifted values, we need them again
|
|
DB $0F, $71, $D1, $08 /// PSRLW MM1, 8, move higher bytes to lower bytes
|
|
|
|
// Load MM7 with the source alpha value (replicate it for every component).
|
|
// Expand it to word size.
|
|
DB $0F, $6F, $F8 /// MOVQ MM7, MM0
|
|
DB $0F, $69, $FF /// PUNPCKHWD MM7, MM7
|
|
DB $0F, $6A, $FF /// PUNPCKHDQ MM7, MM7
|
|
DB $0F, $D5, $FE /// PMULLW MM7, MM6, source alpha * master alpha
|
|
DB $0F, $71, $D7, $08 /// PSRLW MM7, 8, divide by 256
|
|
|
|
// calculation is: target = (alpha * master alpha * (source - target) + 256 * target) / 256
|
|
DB $0F, $F9, $C1 /// PSUBW MM0, MM1, source - target
|
|
DB $0F, $D5, $C7 /// PMULLW MM0, MM7, alpha * (source - target)
|
|
DB $0F, $FD, $C2 /// PADDW MM0, MM2, add target (in shifted form)
|
|
DB $0F, $71, $D0, $08 /// PSRLW MM0, 8, divide by 256
|
|
|
|
// Bias is accounted for by conversion of range 0..255 to -128..127,
|
|
// doing a saturated add and convert back to 0..255.
|
|
DB $0F, $F9, $C4 /// PSUBW MM0, MM4
|
|
DB $0F, $ED, $C5 /// PADDSW MM0, MM5
|
|
DB $0F, $FD, $C4 /// PADDW MM0, MM4
|
|
DB $0F, $67, $C0 /// PACKUSWB MM0, MM0, convert words to bytes with saturation
|
|
DB $0F, $7E, $07 /// MOVD [EDI], MM0, store the result
|
|
@3:
|
|
ADD ESI, 4
|
|
ADD EDI, 4
|
|
DEC ECX
|
|
JNZ @1
|
|
POP EDI
|
|
POP ESI
|
|
end;
|
|
{$endif CPUX64}
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure AlphaBlendLineMasterAndColor(Destination: Pointer; Count: Integer; ConstantAlpha, Color: Integer);
|
|
|
|
// Blends a line of Count pixels in Destination against the given color using a constant alpha value.
|
|
// The layout of a pixel must be BGRA and Color must be rrggbb00 (as stored by a COLORREF).
|
|
// ConstantAlpha must be in the range 0..255.
|
|
//
|
|
{$ifdef CPUX64}
|
|
// RCX contains Destination
|
|
// EDX contains Count
|
|
// R8D contains ConstantAlpha
|
|
// R9D contains Color
|
|
|
|
asm
|
|
//.NOFRAME
|
|
|
|
// The used formula is: target = (alpha * color + (256 - alpha) * target) / 256.
|
|
// alpha * color (factor 1) and 256 - alpha (factor 2) are constant values which can be calculated in advance.
|
|
// The remaining calculation is therefore: target = (F1 + F2 * target) / 256
|
|
|
|
// Load XMM3 with the constant alpha value (replicate it for every component).
|
|
// Expand it to word size. (Every calculation here works on word sized operands.)
|
|
MOVD XMM3, R8D // ConstantAlpha
|
|
PUNPCKLWD XMM3, XMM3
|
|
PUNPCKLDQ XMM3, XMM3
|
|
|
|
// Calculate factor 2.
|
|
MOV R10D, $100
|
|
MOVD XMM2, R10D
|
|
PUNPCKLWD XMM2, XMM2
|
|
PUNPCKLDQ XMM2, XMM2
|
|
PSUBW XMM2, XMM3 // XMM2 contains now: 255 - alpha = F2
|
|
|
|
// Now calculate factor 1. Alpha is still in XMM3, but the r and b components of Color must be swapped.
|
|
BSWAP R9D // Color
|
|
ROR R9D, 8
|
|
MOVD XMM1, R9D // Load the color and convert to word sized values.
|
|
PXOR XMM4, XMM4
|
|
PUNPCKLBW XMM1, XMM4
|
|
PMULLW XMM1, XMM3 // XMM1 contains now: color * alpha = F1
|
|
|
|
@1: // The pixel loop calculates an entire pixel in one run.
|
|
MOVD XMM0, DWORD PTR [RCX]
|
|
PUNPCKLBW XMM0, XMM4
|
|
|
|
PMULLW XMM0, XMM2 // calculate F1 + F2 * target
|
|
PADDW XMM0, XMM1
|
|
PSRLW XMM0, 8 // divide by 256
|
|
|
|
PACKUSWB XMM0, XMM0 // convert words to bytes with saturation
|
|
MOVD DWORD PTR [RCX], XMM0 // store the result
|
|
|
|
ADD RCX, 4
|
|
DEC EDX
|
|
JNZ @1
|
|
end;
|
|
{$else}
|
|
// EAX contains Destination
|
|
// EDX contains Count
|
|
// ECX contains ConstantAlpha
|
|
// Color is passed on the stack
|
|
|
|
asm
|
|
// The used formula is: target = (alpha * color + (256 - alpha) * target) / 256.
|
|
// alpha * color (factor 1) and 256 - alpha (factor 2) are constant values which can be calculated in advance.
|
|
// The remaining calculation is therefore: target = (F1 + F2 * target) / 256
|
|
|
|
// Load MM3 with the constant alpha value (replicate it for every component).
|
|
// Expand it to word size. (Every calculation here works on word sized operands.)
|
|
DB $0F, $6E, $D9 /// MOVD MM3, ECX
|
|
DB $0F, $61, $DB /// PUNPCKLWD MM3, MM3
|
|
DB $0F, $62, $DB /// PUNPCKLDQ MM3, MM3
|
|
|
|
// Calculate factor 2.
|
|
MOV ECX, $100
|
|
DB $0F, $6E, $D1 /// MOVD MM2, ECX
|
|
DB $0F, $61, $D2 /// PUNPCKLWD MM2, MM2
|
|
DB $0F, $62, $D2 /// PUNPCKLDQ MM2, MM2
|
|
DB $0F, $F9, $D3 /// PSUBW MM2, MM3 // MM2 contains now: 255 - alpha = F2
|
|
|
|
// Now calculate factor 1. Alpha is still in MM3, but the r and b components of Color must be swapped.
|
|
MOV ECX, [Color]
|
|
BSWAP ECX
|
|
ROR ECX, 8
|
|
DB $0F, $6E, $C9 /// MOVD MM1, ECX // Load the color and convert to word sized values.
|
|
DB $0F, $EF, $E4 /// PXOR MM4, MM4
|
|
DB $0F, $60, $CC /// PUNPCKLBW MM1, MM4
|
|
DB $0F, $D5, $CB /// PMULLW MM1, MM3 // MM1 contains now: color * alpha = F1
|
|
|
|
@1: // The pixel loop calculates an entire pixel in one run.
|
|
DB $0F, $6E, $00 /// MOVD MM0, [EAX]
|
|
DB $0F, $60, $C4 /// PUNPCKLBW MM0, MM4
|
|
|
|
DB $0F, $D5, $C2 /// PMULLW MM0, MM2 // calculate F1 + F2 * target
|
|
DB $0F, $FD, $C1 /// PADDW MM0, MM1
|
|
DB $0F, $71, $D0, $08 /// PSRLW MM0, 8 // divide by 256
|
|
|
|
DB $0F, $67, $C0 /// PACKUSWB MM0, MM0 // convert words to bytes with saturation
|
|
DB $0F, $7E, $00 /// MOVD [EAX], MM0 // store the result
|
|
|
|
ADD EAX, 4
|
|
DEC EDX
|
|
JNZ @1
|
|
end;
|
|
{$endif CPUX64}
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure AlphaBlend(Source, Destination: HDC; R: TRect; Target: TPoint; Mode: TBlendMode; ConstantAlpha, Bias: Integer);
|
|
|
|
// Optimized alpha blend procedure using MMX instructions to perform as quick as possible.
|
|
// For this procedure to work properly it is important that both source and target bitmap use the 32 bit color format.
|
|
// R describes the source rectangle to work on.
|
|
// Target is the place (upper left corner) in the target bitmap where to blend to. Note that source width + X offset
|
|
// must be less or equal to the target width. Similar for the height.
|
|
// If Mode is bmConstantAlpha then the blend operation uses the given ConstantAlpha value for all pixels.
|
|
// If Mode is bmPerPixelAlpha then each pixel is blended using its individual alpha value (the alpha value of the source).
|
|
// If Mode is bmMasterAlpha then each pixel is blended using its individual alpha value multiplied by ConstantAlpha.
|
|
// If Mode is bmConstantAlphaAndColor then each destination pixel is blended using ConstantAlpha but also a constant
|
|
// color which will be obtained from Bias. In this case no offset value is added, otherwise Bias is used as offset.
|
|
// Blending of a color into target only (bmConstantAlphaAndColor) ignores Source (the DC) and Target (the position).
|
|
// CAUTION: This procedure does not check whether MMX instructions are actually available! Call it only if MMX is really
|
|
// usable.
|
|
|
|
var
|
|
Y: Integer;
|
|
SourceRun,
|
|
TargetRun: PByte;
|
|
|
|
SourceBits,
|
|
DestBits: Pointer;
|
|
SourceWidth,
|
|
SourceHeight,
|
|
DestWidth,
|
|
DestHeight: Integer;
|
|
|
|
begin
|
|
if not IsRectEmpty(R) then
|
|
begin
|
|
// Note: it is tempting to optimize the special cases for constant alpha 0 and 255 by just ignoring soure
|
|
// (alpha = 0) or simply do a blit (alpha = 255). But this does not take the bias into account.
|
|
case Mode of
|
|
bmConstantAlpha:
|
|
begin
|
|
// Get a pointer to the bitmap bits for the source and target device contexts.
|
|
// Note: this supposes that both contexts do actually have bitmaps assigned!
|
|
SourceBits := GetBitmapBitsFromDeviceContext(Source, SourceWidth, SourceHeight);
|
|
DestBits := GetBitmapBitsFromDeviceContext(Destination, DestWidth, DestHeight);
|
|
if Assigned(SourceBits) and Assigned(DestBits) then
|
|
begin
|
|
for Y := 0 to R.Bottom - R.Top - 1 do
|
|
begin
|
|
SourceRun := CalculateScanline(SourceBits, SourceWidth, SourceHeight, Y + R.Top);
|
|
Inc(SourceRun, 4 * R.Left);
|
|
TargetRun := CalculateScanline(DestBits, DestWidth, DestHeight, Y + Target.Y);
|
|
Inc(TargetRun, 4 * Target.X);
|
|
AlphaBlendLineConstant(SourceRun, TargetRun, R.Right - R.Left, ConstantAlpha, Bias);
|
|
end;
|
|
end;
|
|
EMMS;
|
|
end;
|
|
bmPerPixelAlpha:
|
|
begin
|
|
SourceBits := GetBitmapBitsFromDeviceContext(Source, SourceWidth, SourceHeight);
|
|
DestBits := GetBitmapBitsFromDeviceContext(Destination, DestWidth, DestHeight);
|
|
if Assigned(SourceBits) and Assigned(DestBits) then
|
|
begin
|
|
for Y := 0 to R.Bottom - R.Top - 1 do
|
|
begin
|
|
SourceRun := CalculateScanline(SourceBits, SourceWidth, SourceHeight, Y + R.Top);
|
|
Inc(SourceRun, 4 * R.Left);
|
|
TargetRun := CalculateScanline(DestBits, DestWidth, DestHeight, Y + Target.Y);
|
|
Inc(TargetRun, 4 * Target.X);
|
|
AlphaBlendLinePerPixel(SourceRun, TargetRun, R.Right - R.Left, Bias);
|
|
end;
|
|
end;
|
|
EMMS;
|
|
end;
|
|
bmMasterAlpha:
|
|
begin
|
|
SourceBits := GetBitmapBitsFromDeviceContext(Source, SourceWidth, SourceHeight);
|
|
DestBits := GetBitmapBitsFromDeviceContext(Destination, DestWidth, DestHeight);
|
|
if Assigned(SourceBits) and Assigned(DestBits) then
|
|
begin
|
|
for Y := 0 to R.Bottom - R.Top - 1 do
|
|
begin
|
|
SourceRun := CalculateScanline(SourceBits, SourceWidth, SourceHeight, Y + R.Top);
|
|
Inc(SourceRun, 4 * Target.X);
|
|
TargetRun := CalculateScanline(DestBits, DestWidth, DestHeight, Y + Target.Y);
|
|
AlphaBlendLineMaster(SourceRun, TargetRun, R.Right - R.Left, ConstantAlpha, Bias);
|
|
end;
|
|
end;
|
|
EMMS;
|
|
end;
|
|
bmConstantAlphaAndColor:
|
|
begin
|
|
// Source is ignored since there is a constant color value.
|
|
DestBits := GetBitmapBitsFromDeviceContext(Destination, DestWidth, DestHeight);
|
|
if Assigned(DestBits) then
|
|
begin
|
|
for Y := 0 to R.Bottom - R.Top - 1 do
|
|
begin
|
|
TargetRun := CalculateScanline(DestBits, DestWidth, DestHeight, Y + R.Top);
|
|
Inc(TargetRun, 4 * R.Left);
|
|
AlphaBlendLineMasterAndColor(TargetRun, R.Right - R.Left, ConstantAlpha, Bias);
|
|
end;
|
|
end;
|
|
EMMS;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function GetRGBColor(Value: TColor): DWORD;
|
|
|
|
// Little helper to convert a Delphi color to an image list color.
|
|
|
|
begin
|
|
Result := ColorToRGB(Value);
|
|
case Result of
|
|
clNone:
|
|
Result := CLR_NONE;
|
|
clDefault:
|
|
Result := CLR_DEFAULT;
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure PrtStretchDrawDIB(Canvas: TCanvas; DestRect: TRect; ABitmap: TBitmap);
|
|
|
|
// Stretch draw on to the new canvas.
|
|
|
|
var
|
|
Header,
|
|
Bits: Pointer;
|
|
HeaderSize,
|
|
BitsSize: Cardinal;
|
|
|
|
begin
|
|
GetDIBSizes(ABitmap.Handle, HeaderSize, BitsSize);
|
|
|
|
GetMem(Header, HeaderSize);
|
|
GetMem(Bits, BitsSize);
|
|
try
|
|
GetDIB(ABitmap.Handle, ABitmap.Palette, Header^, Bits^);
|
|
StretchDIBits(Canvas.Handle, DestRect.Left, DestRect.Top, DestRect.Right - DestRect.Left, DestRect.Bottom -
|
|
DestRect.Top, 0, 0, ABitmap.Width, ABitmap.Height, Bits, TBitmapInfo(Header^), DIB_RGB_COLORS, SRCCOPY);
|
|
finally
|
|
FreeMem(Header);
|
|
FreeMem(Bits);
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function HasMMX: Boolean;
|
|
|
|
// Helper method to determine whether the current processor supports MMX.
|
|
|
|
{$ifdef CPUX64}
|
|
begin
|
|
// We use SSE2 in the "MMX-functions"
|
|
Result := True;
|
|
end;
|
|
{$else}
|
|
asm
|
|
PUSH EBX
|
|
XOR EAX, EAX // Result := False
|
|
PUSHFD // determine if the processor supports the CPUID command
|
|
POP EDX
|
|
MOV ECX, EDX
|
|
XOR EDX, $200000
|
|
PUSH EDX
|
|
POPFD
|
|
PUSHFD
|
|
POP EDX
|
|
XOR ECX, EDX
|
|
JZ @1 // no CPUID support so we can't even get to the feature information
|
|
PUSH EDX
|
|
POPFD
|
|
|
|
MOV EAX, 1
|
|
DW $A20F // CPUID, EAX contains now version info and EDX feature information
|
|
MOV EBX, EAX // free EAX to get the result value
|
|
XOR EAX, EAX // Result := False
|
|
CMP EBX, $50
|
|
JB @1 // if processor family is < 5 then it is not a Pentium class processor
|
|
TEST EDX, $800000
|
|
JZ @1 // if the MMX bit is not set then we don't have MMX
|
|
INC EAX // Result := True
|
|
@1:
|
|
POP EBX
|
|
end;
|
|
{$endif CPUX64}
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
|
|
procedure FillDragRectangles(DragWidth, DragHeight, DeltaX, DeltaY: Integer; var RClip, RScroll, RSamp1, RSamp2, RDraw1, RDraw2: TRect);
|
|
|
|
begin
|
|
// ScrollDC limits
|
|
RClip := Rect(0, 0, DragWidth, DragHeight);
|
|
if DeltaX > 0 then
|
|
begin
|
|
// move to the left
|
|
if DeltaY = 0 then
|
|
begin
|
|
// move only to the left
|
|
// background movement
|
|
RScroll := Rect(0, 0, DragWidth - DeltaX, DragHeight);
|
|
RSamp1 := Rect(0, 0, DeltaX, DragHeight);
|
|
RDraw1 := Rect(DragWidth - DeltaX, 0, DeltaX, DragHeight);
|
|
end
|
|
else
|
|
if DeltaY < 0 then
|
|
begin
|
|
// move to bottom left
|
|
RScroll := Rect(0, -DeltaY, DragWidth - DeltaX, DragHeight);
|
|
RSamp1 := Rect(0, 0, DeltaX, DragHeight);
|
|
RSamp2 := Rect(DeltaX, DragHeight + DeltaY, DragWidth - DeltaX, -DeltaY);
|
|
RDraw1 := Rect(0, 0, DragWidth - DeltaX, -DeltaY);
|
|
RDraw2 := Rect(DragWidth - DeltaX, 0, DeltaX, DragHeight);
|
|
end
|
|
else
|
|
begin
|
|
// move to upper left
|
|
RScroll := Rect(0, 0, DragWidth - DeltaX, DragHeight - DeltaY);
|
|
RSamp1 := Rect(0, 0, DeltaX, DragHeight);
|
|
RSamp2 := Rect(DeltaX, 0, DragWidth - DeltaX, DeltaY);
|
|
RDraw1 := Rect(0, DragHeight - DeltaY, DragWidth - DeltaX, DeltaY);
|
|
RDraw2 := Rect(DragWidth - DeltaX, 0, DeltaX, DragHeight);
|
|
end;
|
|
end
|
|
else
|
|
if DeltaX = 0 then
|
|
begin
|
|
// vertical movement only
|
|
if DeltaY < 0 then
|
|
begin
|
|
// move downwards
|
|
RScroll := Rect(0, -DeltaY, DragWidth, DragHeight);
|
|
RSamp2 := Rect(0, DragHeight + DeltaY, DragWidth, -DeltaY);
|
|
RDraw2 := Rect(0, 0, DragWidth, -DeltaY);
|
|
end
|
|
else
|
|
begin
|
|
// move upwards
|
|
RScroll := Rect(0, 0, DragWidth, DragHeight - DeltaY);
|
|
RSamp2 := Rect(0, 0, DragWidth, DeltaY);
|
|
RDraw2 := Rect(0, DragHeight - DeltaY, DragWidth, DeltaY);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
// move to the right
|
|
if DeltaY > 0 then
|
|
begin
|
|
// move up right
|
|
RScroll := Rect(-DeltaX, 0, DragWidth, DragHeight);
|
|
RSamp1 := Rect(0, 0, DragWidth + DeltaX, DeltaY);
|
|
RSamp2 := Rect(DragWidth + DeltaX, 0, -DeltaX, DragHeight);
|
|
RDraw1 := Rect(0, 0, -DeltaX, DragHeight);
|
|
RDraw2 := Rect(-DeltaX, DragHeight - DeltaY, DragWidth + DeltaX, DeltaY);
|
|
end
|
|
else
|
|
if DeltaY = 0 then
|
|
begin
|
|
// to the right only
|
|
RScroll := Rect(-DeltaX, 0, DragWidth, DragHeight);
|
|
RSamp1 := Rect(DragWidth + DeltaX, 0, -DeltaX, DragHeight);
|
|
RDraw1 := Rect(0, 0, -DeltaX, DragHeight);
|
|
end
|
|
else
|
|
begin
|
|
// move down right
|
|
RScroll := Rect(-DeltaX, -DeltaY, DragWidth, DragHeight);
|
|
RSamp1 := Rect(0, DragHeight + DeltaY, DragWidth + DeltaX, -DeltaY);
|
|
RSamp2 := Rect(DragWidth + DeltaX, 0, -DeltaX, DragHeight);
|
|
RDraw1 := Rect(0, 0, -DeltaX, DragHeight);
|
|
RDraw2 := Rect(-DeltaX, 0, DragWidth + DeltaX, -DeltaY);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
type
|
|
TCustomImageListCast = class(TCustomImageList);
|
|
|
|
procedure DrawImage(ImageList: TCustomImageList; Index: Integer; Canvas: TCanvas; X, Y: Integer; Style: Cardinal; Enabled: Boolean);
|
|
|
|
procedure DrawDisabledImage(ImageList: TCustomImageList; Canvas: TCanvas; X, Y, Index: Integer);
|
|
var
|
|
Params: TImageListDrawParams;
|
|
begin
|
|
FillChar(Params, SizeOf(Params), 0);
|
|
Params.cbSize := SizeOf(Params);
|
|
Params.himl := ImageList.Handle;
|
|
Params.i := Index;
|
|
Params.hdcDst := Canvas.Handle;
|
|
Params.x := X;
|
|
Params.y := Y;
|
|
Params.fState := ILS_SATURATE;
|
|
ImageList_DrawIndirect(@Params);
|
|
end;
|
|
|
|
begin
|
|
if Enabled then
|
|
TCustomImageListCast(ImageList).DoDraw(Index, Canvas, X, Y, Style, Enabled)
|
|
else
|
|
DrawDisabledImage(ImageList, Canvas, X, Y, Index);
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
|
|
{
|
|
function IfThen(AValue: Boolean; const ATrue: Integer; const AFalse: Integer = 0): Integer;
|
|
begin
|
|
if AValue then
|
|
Result := ATrue
|
|
else
|
|
Result := AFalse;
|
|
end;
|
|
}
|
|
procedure SetCurrentThreadName(const Name: Ansistring); // By Rapid D
|
|
type
|
|
TThreadNameInfo =
|
|
record
|
|
RecType: LongWord;
|
|
Name: PAnsiChar;
|
|
ThreadID: LongWord;
|
|
Flags: LongWord;
|
|
end;
|
|
var
|
|
info:TThreadNameInfo;
|
|
begin
|
|
// This code is extremely strange, but it's the documented way of doing it!
|
|
info.RecType:=$1000;
|
|
info.Name:=PAnsiChar(Name);
|
|
info.ThreadID:=$FFFFFFFF;
|
|
info.Flags:=0;
|
|
try
|
|
RaiseException($406D1388, 0,
|
|
SizeOf(info) div SizeOf(LongWord), PUINT_PTR(@info));
|
|
// SizeOf(info) div SizeOf(LongWord), PDWORD(@info));
|
|
except
|
|
end;
|
|
end;
|
|
|
|
end.
|