_graphutils.pas

East make Tray Icon in delphi

        JZ        @3              // complete transparency, proceed to next point
        CMP       EAX, $FF000000
        JNC       @2              // opaque pixel, copy without blending

  // blend
        db $0F, $EF, $DB           // PXOR      MM3, MM3
        db $0F, $6E, $C0           // MOVD      MM0, EAX
        db $0F, $6E, $17           // MOVD      MM2, [EDI]
        db $0F, $60, $C3           // PUNPCKLBW MM0, MM3
        MOV       EAX, bias_ptr
        db $0F, $60, $D3           // PUNPCKLBW MM2, MM3
        db $0F, $6F, $C8           // MOVQ      MM1, MM0
        db $0F, $69, $C9           // PUNPCKHWD MM1, MM1
        db $0F, $F9, $C2           // PSUBW     MM0, MM2
        db $0F, $6A, $C9           // PUNPCKHDQ MM1, MM1
        db $0F, $71, $F2, $08      // PSLLW     MM2, 8
        db $0F, $D5, $C1           // PMULLW    MM0, MM1
        db $0F, $FD, $10           // PADDW     MM2, [EAX]
        db $0F, $FD, $D0           // PADDW     MM2, MM0
        db $0F, $71, $D2, $08      // PSRLW     MM2, 8
        db $0F, $67, $D3           // PACKUSWB  MM2, MM3
        db $0F, $7E, $D0           // MOVD      EAX, MM2

@2:     MOV       [EDI], EAX

@3:     ADD       ESI, 4
        ADD       EDI, 4

  // loop end
        DEC       ECX
        JNZ       @1

        POP       EDI
        POP       ESI

@4:     RET
end;

procedure M_BlendLineEx(Src, Dst: PColor32; Count: Integer; M: TColor32); assembler;
asm
  // EAX <- Src
  // EDX <- Dst
  // ECX <- Count

  // test the counter for zero or negativity
        TEST      ECX, ECX
        JS        @4

        PUSH      ESI
        PUSH      EDI
        PUSH      EBX

        MOV       ESI, EAX        // ESI <- Src
        MOV       EDI, EDX        // EDI <- Dst
        MOV       EDX, M          // EDX <- Master Alpha

  // loop start
@1:     MOV       EAX, [ESI]
        TEST      EAX, $FF000000
        JZ        @3              // complete transparency, proceed to next point
        MOV       EBX, EAX
        SHR       EBX, 24
        IMUL      EBX, EDX
        SHR       EBX, 8
        JZ        @3              // complete transparency, proceed to next point

  // blend
        db $0F, $EF, $C0           // PXOR      MM0, MM0
        db $0F, $6E, $C8           // MOVD      MM1, EAX
        SHL       EBX, 3
        db $0F, $6E, $17           // MOVD      MM2, [EDI]
        db $0F, $60, $C8           // PUNPCKLBW MM1, MM0
        db $0F, $60, $D0           // PUNPCKLBW MM2, MM0
        ADD       EBX, alpha_ptr
        db $0F, $F9, $CA           // PSUBW     MM1, MM2
        db $0F, $D5, $0B           // PMULLW    MM1, [EBX]
        db $0F, $71, $F2, $08      // PSLLW     MM2, 8
        MOV       EBX, bias_ptr
        db $0F, $FD, $13           // PADDW     MM2, [EBX]
        db $0F, $FD, $CA           // PADDW     MM1, MM2
        db $0F, $71, $D1, $08      // PSRLW     MM1, 8
        db $0F, $67, $C8           // PACKUSWB  MM1, MM0
        db $0F, $7E, $C8           // MOVD      EAX, MM1

@2:     MOV       [EDI], EAX

@3:     ADD       ESI, 4
        ADD       EDI, 4

  // loop end
        DEC       ECX
        JNZ       @1

        POP       EBX
        POP       EDI
        POP       ESI
@4:
end;

{ MMX Detection and linking }

procedure SetupFunctions;
var
  CpuInfo: TCpuInfo;
begin
  //WIMDC
  CpuInfo := CPUID;
  MMX_ACTIVE := (CpuInfo.Features and MMX_FLAG) = MMX_FLAG;
  if MMX_ACTIVE then
  begin
    // link MMX functions
    CombineReg := M_CombineReg;
    CombineMem := M_CombineMem;
    BlendReg := M_BlendReg;
    BlendMem := M_BlendMem;
    BlendRegEx := M_BlendRegEx;
    BlendMemEx := M_BlendMemEx;
    BlendLine := M_BlendLine;
    BlendLineEx := M_BlendLineEx;
  end
  else
  begin
    // link non-MMX functions
    CombineReg := _CombineReg;
    CombineMem := _CombineMem;
    BlendReg := _BlendReg;
    BlendMem := _BlendMem;
    BlendRegEx := _BlendRegEx;
    BlendMemEx := _BlendMemEx;
    BlendLine := _BlendLine;
    BlendLineEx := _BlendLineEx;
  end;
end;

//=== Dialog functions =======================================================

{$IFDEF MSWINDOWS}
function DialogUnitsToPixelsX(const DialogUnits: Word): Word;
begin
  Result := (DialogUnits * LoWord(GetDialogBaseUnits)) div 4;
end;

function DialogUnitsToPixelsY(const DialogUnits: Word): Word;
begin
  Result := (DialogUnits * HiWord(GetDialogBaseUnits)) div 8;
end;

function PixelsToDialogUnitsX(const PixelUnits: Word): Word;
begin
  Result := PixelUnits * 4 div LoWord(GetDialogBaseUnits);
end;

function PixelsToDialogUnitsY(const PixelUnits: Word): Word;
begin
  Result := PixelUnits * 8 div HiWord(GetDialogBaseUnits);
end;
{$ENDIF MSWINDOWS}

//=== Points =================================================================

function NullPoint: TPoint;
begin
  Result.X := 0;
  Result.Y := 0;
end;

function PointAssign(const X, Y: Integer): TPoint;
begin
  Result.X := X;
  Result.Y := Y;
end;

procedure PointCopy(var Dest: TPoint; const Source: TPoint);
begin
  Dest.X := Source.X;
  Dest.Y := Source.Y;
end;

function PointEqual(const P1, P2: TPoint): Boolean;
begin
  Result := (P1.X = P2.X) and (P1.Y = P2.Y);
end;

function PointIsNull(const P: TPoint): Boolean;
begin
  Result := (P.X = 0) and (P.Y = 0);
end;

procedure PointMove(var P: TPoint; const DeltaX, DeltaY: Integer);
begin
  P.X := P.X + DeltaX;
  P.Y := P.Y + DeltaY;
end;

//=== Rectangles =============================================================

function NullRect: TRect;
begin
  with Result do
  begin
    Top := 0;
    Left := 0;
    Bottom := 0;
    Right := 0;
  end;
end;

function RectAssign(const Left, Top, Right, Bottom: Integer): TRect;
begin
  Result.Left := Left;
  Result.Top := Top;
  Result.Right := Right;
  Result.Bottom := Bottom;
end;

function RectAssignPoints(const TopLeft, BottomRight: TPoint): TRect;
begin
  Result.TopLeft := TopLeft;
  Result.BottomRight := BottomRight;
end;

function RectBounds(const Left, Top, Width, Height: Integer): TRect;
begin
  Result := RectAssign(Left, Top, Left + Width, Top + Height);
end;

function RectCenter(const R: TRect): TPoint;
begin
  Result.X := R.Left + (RectWidth(R) div 2);
  Result.Y := R.Top + (RectHeight(R) div 2);
end;

procedure RectCopy(var Dest: TRect; const Source: TRect);
begin
  Dest := Source;
end;

procedure RectFitToScreen(var R: TRect);
var
  X, Y: Integer;
  Delta: Integer;
begin
  {$IFDEF MSWINDOWS}
  X := GetSystemMetrics(SM_CXSCREEN);
  Y := GetSystemMetrics(SM_CYSCREEN);
  {$ELSE ~MSWINDOWS}
  {$IFDEF VisualCLX}
  { TODO : Find a Qt-independent solution }
  X := QWidget_width(QApplication_desktop);
  Y := QWidget_height(QApplication_desktop);
  {$ENDIF VisualCLX}
  {$ENDIF ~MSWINDOWS}
  with R do
  begin
    if Right > X then
    begin
      Delta := Right - Left;
      Right := X;
      Left := Right - Delta;
    end;
    if Left < 0 then
    begin
      Delta := Right - Left;
      Left := 0;
      Right := Left + Delta;
    end;
    if Bottom > Y then
    begin
      Delta := Bottom - Top;
      Bottom := Y;
      Top := Bottom - Delta;
    end;
    if Top < 0 then
    begin
      Delta := Bottom - Top;
      Top := 0;
      Bottom := Top + Delta;
    end;
  end;
end;

procedure RectGrow(var R: TRect; const Delta: Integer);
begin
  with R do
  begin
    Dec(Left, Delta);
    Dec(Top, Delta);
    Inc(Right, Delta);
    Inc(Bottom, Delta);
  end;
end;

procedure RectGrowX(var R: TRect; const Delta: Integer);
begin
  with R do
  begin
    Dec(Left, Delta);
    Inc(Right, Delta);
  end;
end;

procedure RectGrowY(var R: TRect; const Delta: Integer);
begin
  with R do
  begin
    Dec(Top, Delta);
    Inc(Bottom, Delta);
  end;
end;

function RectEqual(const R1, R2: TRect): Boolean;
begin
  Result := (R1.Left = R2.Left) and (R1.Top = R2.Top) and
    (R1.Right = R2.Right) and (R1.Bottom = R2.Bottom);
end;

function RectHeight(const R: TRect): Integer;
begin
  Result := Abs(R.Bottom - R.Top);
end;

function RectIncludesPoint(const R: TRect; const Pt: TPoint): Boolean;
begin
  Result := (Pt.X > R.Left) and (Pt.X < R.Right) and
    (Pt.Y > R.Top) and (Pt.Y < R.Bottom);
end;

function RectIncludesRect(const R1, R2: TRect): Boolean;
begin
  Result := (R1.Left >= R2.Left) and (R1.Top >= R2.Top) and
    (R1.Right <= R2.Right) and (R1.Bottom <= R2.Bottom);
end;

function RectIntersection(const R1, R2: TRect): TRect;
begin
  with Result do
  begin
    Left := JclLogic.Max(R1.Left, R2.Left);
    Top := JclLogic.Max(R1.Top, R2.Top);
    Right := JclLogic.Min(R1.Right, R2.Right);
    Bottom := JclLogic.Min(R1.Bottom, R2.Bottom);
  end;
  if not RectIsValid(Result) then
    Result := NullRect;
end;

function RectIntersectRect(const R1, R2: TRect): Boolean;
begin
  Result := not RectIsNull(RectIntersection(R1, R2));
end;

function RectIsEmpty(const R: TRect): Boolean;
begin
  Result := (R.Right = R.Left) and (R.Bottom = R.Top);
end;

function RectIsNull(const R: TRect): Boolean;
begin
  with R do
    Result := (Left = 0) and (Right = 0) and (Top = 0) and (Bottom = 0);
end;

function RectIsSquare(const R: TRect): Boolean;
begin
  Result := (RectHeight(R) = RectWidth(R));
end;

function RectIsValid(const R: TRect): Boolean;
begin
  with R do
    Result := (Left <= Right) and (Top <= Bottom);
end;

procedure RectMove(var R: TRect; const DeltaX, DeltaY: Integer);
begin
  with R do
  begin
    Inc(Left, DeltaX);
    Inc(Right, DeltaX);
    Inc(Top, DeltaY);
    Inc(Bottom, DeltaY);
  end;
end;

procedure RectMoveTo(var R: TRect; const X, Y: Integer);
begin
  with R do
  begin
    Right := (Right - Left) + X;
    Bottom := (Bottom - Top) + Y;
    Left := X;
    Top := Y;
  end;
end;

procedure RectNormalize(var R: TRect);
var
  Temp: Integer;
begin
  if R.Left > R.Right then
  begin
    Temp := R.Left;
    R.Left := R.Right;
    R.Right := Temp;
  end;
  if R.Top > R.Bottom then
  begin
    Temp := R.Top;
    R.Top := R.Bottom;
    R.Bottom := Temp;
  end;
end;

function RectsAreValid(R: array of TRect): Boolean;
var
  I: Integer;
begin
  if Length(R) = 0 then
  begin
    Result := False;
    Exit;
  end;
  for I := Low(R) to High(R) do
  begin
    with R[I] do
      Result := (Left <= Right) and (Top <= Bottom);
    if not Result then
      Exit;
  end;
  Result := True;
end;

function RectUnion(const R1, R2: TRect): TRect;
begin
  with Result do
  begin
    Left := JclLogic.Min(R1.Left, R2.Left);
    Top := JclLogic.Min(R1.Top, R2.Top);
    Right := JclLogic.Max(R1.Right, R2.Right);
    Bottom := JclLogic.Max(R1.Bottom, R2.Bottom);
  end;
  if not RectIsValid(Result) then