- Posts: 51
- Thank you received: 0
- Forum
- CodeTyphon Studio
- CodeTyphon Studio Components and Libraries
- Graphics Development
- How to draw on Cursor
×
Components and Libraries for Graphics Development, discussions, problems and suggestions.
Question How to draw on Cursor
- Roman
- Topic Author
- Offline
- Junior Member
-
Less
More
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: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 (...)?
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;
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
PilotLogic Architect and Core Programmer
Replied by Sternas Stefanos on topic How to draw on Cursor
Sir
TCursorImage has Canvas
so this must work
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
-
Less
More
- Posts: 51
- Thank you received: 0
4 years 3 months ago #11508
by Roman

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):
Replied by Roman on topic How to draw on Cursor
Must, but do not workSternas Stefanos wrote: so this must 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.
- Sternas Stefanos
-
- Offline
- Moderator
-
- Ex Pilot, M.Sc, Ph.D
4 years 3 months ago #11509
by Sternas Stefanos
PilotLogic Architect and Core Programmer
Replied by Sternas Stefanos on topic How to draw on Cursor
so the TCursorImage.Canvas work OK
Try
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.