× Components and Libraries for Graphics Development, discussions, problems and suggestions.

Question How to draw on Cursor

Start
Prev
1
Next
End

Roman
Topic Author
Offline
Junior Member

4 years 3 months ago - 4 years 3 months ago #11506 by Roman

How to draw on Cursor was created by Roman

Hi All!
I need to runtime modify cursor image. Drawing by cursor Canvas do not work correctly: any painting make image transparent.
On the FPC-forum helped me with this code:

procedure TToolFill.UpdateImage;
var
  Cur : TCursorImage;
  Bitmap : PBitmapInfo;
  FillColor : TRGBQuad;

  procedure Square(x, y, w : integer);
  var
     I, J : Integer;
  begin
    // квадратик
    with FillColor do begin
       rgbRed := Red(fColor);
       rgbGreen := Green(fColor);
       rgbBlue := Blue(fColor);
       rgbReserved := $FF;
    end;
    for I := y to y+w do begin
      for J := x to x+w do begin
        Bitmap^.bmiColors[I * Cur.Width + J] := FillColor;
      end;
    end;
  end;

begin
  Cur := TCursorImage.Create;
  Cur.LoadFromResourceID(HINSTANCE, CurId);

  GetMem(Bitmap, SizeOf(TBitmapInfoHeader) + Cur.Width * Cur.Height * SizeOf(TColor));
  with Bitmap^.bmiHeader do begin
    biSize := SizeOf(TBitmapInfoHeader);
    biWidth := Cur.Width;
    biHeight := Cur.Height;
    biPlanes := 1;
    biBitCount := 32;
    biCompression := BI_RGB;
    biSizeImage := biWidth * biHeight * SizeOf(TColor);
  end;

  GetDIBits(Cur.Canvas.Handle, Cur.BitmapHandle, 0, Cur.Height, @(Bitmap^.bmiColors), Bitmap, DIB_RGB_COLORS);

  Square(Cur.Width - 9, Cur.Height - 9, 8);

  SetDIBits(Cur.Canvas.Handle, Cur.BitmapHandle, 0, Cur.Height, @(Bitmap^.bmiColors), Bitmap, DIB_RGB_COLORS);
  FreeMem(Bitmap);
  Screen.Cursors[CurId] := Cur.ReleaseHandle;
  Cur.Free;
  //
  WorkScreen.PB.Cursor := CurId;
end;

But this code not flexible becouse drawind curves, ellipses and angled lines need more work.

My question to the connoisseurs is this: is there any way to do the same thing on the principle of drawing on canvas?
For example, instead of the above procedure Square(..) use something like SomeObj.Canvas.FillRect (...)?

Last edit: 4 years 3 months ago by Roman.

Please Log in or Create an account to join the conversation.

Sternas Stefanos
Offline
Moderator
Ex Pilot, M.Sc, Ph.D

4 years 3 months ago - 4 years 3 months ago #11507 by Sternas Stefanos

Replied by Sternas Stefanos on topic How to draw on Cursor

Sir
TCursorImage has Canvas
so this must work

procedure test;
 var Cur : TCursorImage;
begin
  Cur := TCursorImage.Create;
  Cur.LoadFromResourceID(HINSTANCE, CurId);
  //................................

  cur.Canvas.FillRect(); 
  cur.Canvas.some
  ..
  ..

  //..............................
  Screen.Cursors[CurId] := Cur.ReleaseHandle;
  Cur.Free;
end;

PilotLogic Architect and Core Programmer

Last edit: 4 years 3 months ago by Sternas Stefanos.

Please Log in or Create an account to join the conversation.

Roman
Topic Author
Offline
Junior Member

4 years 3 months ago #11508 by Roman

Replied by Roman on topic How to draw on Cursor

Sternas Stefanos wrote: so this must work

Must, but do not work

If cursor is 32-bit-color image any drawing as Canvas.LineTo or Canvas.FillRect or any other make original image transparent.

The image above is obtained by the following code (red circle is background):

Cur := TCursorImage.Create;
  Cur.LoadFromResourceID(HINSTANCE, CurId);
  with Cur.Canvas do begin
    Brush.Style := bsSolid;
    Brush.Color := clBlue;
    FillRect(10,10,21,21);
  end;
  Screen.Cursors[CurId] := Cur.ReleaseHandle;
  Cur.Free;

ScreenShot1.png

Please Log in or Create an account to join the conversation.

Sternas Stefanos
Offline
Moderator
Ex Pilot, M.Sc, Ph.D

4 years 3 months ago #11509 by Sternas Stefanos

Replied by Sternas Stefanos on topic How to draw on Cursor

so the TCursorImage.Canvas work OK

Try

  Cur.LoadFromResourceID(HINSTANCE, CurId);

  Cur.Transparent:=false or true;
  Cur.TransparentColor:=
  Cur.TransparentMode:=

  with Cur.Canvas do begin

PilotLogic Architect and Core Programmer

Please Log in or Create an account to join the conversation.

Start
Prev
1
Next
End

Question How to draw on Cursor

Attachments: