Welcome, Guest
Username: Password: Remember me
Components and Libraries for Graphics Development, discussions, problems and suggestions.
  • Page:
  • 1

TOPIC:

How to draw on Cursor 6 years 7 months ago #11506

  • Roman
  • Roman's Avatar Topic Author
  • Offline
  • Junior Member
  • Junior Member
  • Posts: 94
  • Thank you received: 0
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 (...)?

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

Last edit: by Roman.

How to draw on Cursor 6 years 7 months ago #11507

  • Sternas Stefanos
  • Sternas Stefanos's Avatar
  • Offline
  • Moderator
  • Moderator
  • Ex Pilot, M.Sc, Ph.D
  • Posts: 4528
  • Thank you received: 1111
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

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

Last edit: by Sternas Stefanos.

How to draw on Cursor 6 years 7 months ago #11508

  • Roman
  • Roman's Avatar Topic Author
  • Offline
  • Junior Member
  • Junior Member
  • Posts: 94
  • Thank you received: 0

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;
Attachments:

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

How to draw on Cursor 6 years 7 months ago #11509

  • Sternas Stefanos
  • Sternas Stefanos's Avatar
  • Offline
  • Moderator
  • Moderator
  • Ex Pilot, M.Sc, Ph.D
  • Posts: 4528
  • Thank you received: 1111
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.

  • Page:
  • 1