qwincursors.pas

East make Tray Icon in delphi

{                   And   Xor          Bitmap    Mask                          }
{ Black              0     0             1         1                           }
{ White              0     1      =>     0         1                           }
{ Transparent        1     0             0         0                           }
{                                                                              }
{ Inverse            1     1             0         0  Transparent              }
{ Inverse            1     1             1         1  Black                    }
{ Inverse            1     1             0         1  White                    }
{                                                                              }
{ Inv > Transparent: => Bitmap := not("AND" or "XOR")                          }
{                    => Mask   := not "AND"                                    }
{                                                                              }
{ Inv > Black:       => Bitmap := not("AND" xor "XOR")                         }
{                    => Mask   := not "AND" or "XOR"                           }
{                                                                              }
{ Inv > White:       => Bitmap := not("AND" or "XOR")                          }
{                    => Mask   := not(("XOR" xor "AND") and "AND")             }
{                                                                              }
{------------------------------------------------------------------------------}

procedure TWinCursor.ConvertDIB(Stream: TStream);
var
  TempCursor: TCustomCursor;
  AndByte, XorByte: Byte;
  I: Integer;
  T: Integer;
begin
  SetLength(TempCursor.Bits, FBytesPerRow * FHeight);
  SetLength(TempCursor.Mask, FBytesPerRow * FHeight);

  Stream.ReadBuffer(TempCursor.Mask[0], FHeight*FBytesPerRow);
  Stream.ReadBuffer(TempCursor.Bits[0], FHeight*FBytesPerRow);

  for I := 0 to FHeight - 1 do
  begin
    for T := 0 to FBytesPerRow - 1 do
    begin
      AndByte := TempCursor.Bits[I*FBytesPerRow+T];
      XorByte := TempCursor.Mask[I*FBytesPerRow+T];

      case FInvMode of
      invBlack:
        begin
          FCustomCursor.Bits[(FHeight-1-I) * FBytesPerRow + T] := not(XorByte xor AndByte);
          FCustomCursor.Mask[(FHeight-1-I) * FBytesPerRow + T] := not AndByte or XorByte;
        end;
      invWhite:
        begin
          FCustomCursor.Bits[(FHeight-1-I) * FBytesPerRow + T] := not(XorByte or AndByte);
          FCustomCursor.Mask[(FHeight-1-I) * FBytesPerRow + T] := not((XorByte xor AndByte) and AndByte);
        end;
      invTransparent:
        begin
          FCustomCursor.Bits[(FHeight-1-I) * FBytesPerRow + T] := not(XorByte or AndByte);
          FCustomCursor.Mask[(FHeight-1-I) * FBytesPerRow + T] := not(AndByte);
        end;
      end;
    end;
  end;
end;

procedure TWinCursor.CreateCursor;
var
  Bitmap: QBitmapH;
  Mask: QBitmapH;
begin
  if Assigned(FHandle) and FOwnsHandle then
    QCursor_destroy(FHandle);

  Bitmap := QBitmap_create(FBytesPerRow*8,FHeight, @FCustomCursor.Bits[0], False);
  Mask   := QBitmap_create(FBytesPerRow*8,FHeight, @FCustomCursor.Mask[0], False);

  if (FWidth mod 8) <> 0 then
  begin
    QPixmap_resize(Bitmap, FWidth, FHeight);
    QPixmap_resize(Mask, FWidth, FHeight);
  end;

  FHandle := QCursor_create(Bitmap, Mask, FHotspot.X, FHotspot.Y);

  QBitmap_Destroy(Bitmap);
  QBitmap_Destroy(Mask);

  Changed(Self);
end;

procedure TWinCursor.OwnHandle;
begin
  FOwnsHandle := True;
end;

function TWinCursor.ReleaseHandle: QCursorH;
begin
  Result := FHandle;
  FHandle := nil;
  Changed(Self);
end;

procedure TWinCursor.HandleNeeded;
begin
  if FHandle = nil then
  begin
    FHandle := QCursor_create;
    OwnHandle;
  end;
end;

function TWinCursor.GetHotSpot: TPoint;
begin
  Result := Point(0, 0);

  if Assigned(FHandle) then
    QCursor_hotSpot(FHandle, @Result);
end;

procedure TWinCursor.SetHotspot(const Value: TPoint);
var
  TempHandle: QCursorH;
begin
  if Assigned(FHandle) then
  begin
    TempHandle := QCursor_create(QCursor_bitmap(FHandle), QCursor_bitmap(FHandle), Value.X, Value.Y);

    if FOwnsHandle then
      QCursor_destroy(FHandle);

    FHandle := TempHandle;
    OwnHandle;
  end;
end;

procedure TWinCursor.FreeCursor;
begin
  if Assigned(FHandle) then
  begin
    QCursor_destroy(FHandle);
    FHandle := nil;

    FWidth := 0;
    FHeight := 0;
    FBytesPerRow := 0;

    SetLength(FCustomCursor.Bits, 0);
    SetLength(FCustomCursor.Mask, 0);
  end;
end;

procedure TWinCursor.Assign(Source: TPersistent);
begin
  if FOwnsHandle then
    FreeCursor;

  if Source is TWinCursor then
  begin
     FHandle := QCursor_create((Source as TWinCursor).Handle);
     OwnHandle;
  end
  else
    inherited Assign(Source);
end;

procedure TWinCursor.LoadFromMimeSource(MimeSource: TMimeSource);
begin
  raise EInvalidGraphicOperation.Create(RsInvalidOperation);
end;

procedure TWinCursor.SaveToMimeSource(MimeSource: TClxMimeSource);
begin
  raise EInvalidGraphicOperation.Create(RsInvalidOperation);
end;

procedure TWinCursor.SaveToStream(Stream: TStream);
begin
  raise EInvalidGraphicOperation.Create(RsInvalidOperation);
end;

function TWinCursor.GetEmpty: Boolean;
begin
  Result := not Assigned(FHandle);
end;

function TWinCursor.GetHeight: Integer;
begin
  Result := FHeight;
end;

function TWinCursor.GetWidth: Integer;
begin
  Result := FWidth;
end;

procedure TWinCursor.SetHeight(Value: Integer);
begin
  raise EInvalidGraphicOperation.Create(RsInvalidOperation);
end;

procedure TWinCursor.SetWidth(Value: Integer);
begin
  raise EInvalidGraphicOperation.Create(RsInvalidOperation);
end;

type
  TCrackBitmap = class(TBitmap);

procedure TWinCursor.Draw(ACanvas: TCanvas; const Rect: TRect);
var
  Bitmap: TCrackBitmap;
  Pixmap: QPixmapH;
begin
  if not Empty then
  begin
    Bitmap := TCrackBitmap.Create;
    try
      Bitmap.Width := FWidth;
      Bitmap.Height := FHeight;
      Pixmap := QPixmap_create(QCursor_bitmap(FHandle));
      QPixmap_setMask(Pixmap,QCursor_mask(FHandle));
      Bitmap.Handle := Pixmap;
      Bitmap.Draw(ACanvas, Rect);
    finally
      Bitmap.Free;
    end;
  end;
end;

//------------------------------------------------------------------------------
// Helper functions
//------------------------------------------------------------------------------

{ LoadCursor Helper function                                                   }
{ ==========================                                                   }
{                                                                              }
{ If you are using this function with D6/CLX please be aware that it might     }
{ collide with the Windows LoadCursor function. In such cases reference it     }
{ directly using QWinCursors.LoadCursor                                        }

function LoadCursor(Instance: Cardinal; CursorName: string): QCursorH;
var
  WinCursor: TWinCursor;
begin
  WinCursor := TWinCursor.Create;
  try
    WinCursor.LoadFromResourceName(Instance, CursorName);
    Result := WinCursor.ReleaseHandle;
  finally
    WinCursor.Free;
  end;
end;

function LoadCursorFromFile(CursorFileName: string): QCursorH;
var
  WinCursor: TWinCursor;
begin
  WinCursor := TWinCursor.Create;
  try
    WinCursor.LoadFromFile(CursorFileName);
    Result := WinCursor.ReleaseHandle;
  finally
    WinCursor.Free;
  end;
end;

end.