He implementado el Código de
cHackAll, logrando el Orbital que en un principio de este hilo pedí como ayuda, no fue tan cierto como otros amigos foristas indicaron que fuera muy complicado de realizar esta aplicación y llevaría mucho tiempo, gracias una vez más al amigo cHackAll por su código, la implementación es la siguiente:
Código Delphi
[-]
unit MIMOuse;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
Timer1: TTimer;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
private
MouseX, MouseY:integer;
public
end;
var
Form1: TForm1;
Bitmap: TBitmap;
Orbital: array [0..255] of TPoint;
Step:extended=0;
implementation
{$R *.dfm}
function EllipsePoint(X1,Y1,X2,Y2,Largo: Integer; Step, Angulo: Double): TPoint;
var
Cx,Cy,A,B: Double;
begin
A:= abs(X2-X1)/2;
B:= abs(Y2-Y1)/2;
Cx:= (X1+X2)/2;
Cy:= (Y1+Y2)/2;
Result.X:= Trunc(Cx + A * cos(Step+360/Largo*Angulo));
Result.Y:= Trunc(Cy + B * sin(Step+360/Largo*Angulo));
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Timer1.Interval := 33;
Bitmap := TBitmap.Create;
Bitmap.Width := ClientWidth;
Bitmap.Height := ClientHeight;
Bitmap.Canvas.Brush.Color := Color;
BitMap.Canvas.Font.Size:=12;
BitMap.Canvas.Font.Name:= 'Times New Roman';
Caption:='Cursor Animado - ';
end;
procedure TForm1.FormPaint(Sender: TObject);
var DestDC: Cardinal;
begin
DestDC := GetWindowDC(Handle);
BitBlt(DestDC, ClientOrigin.X - Left, ClientOrigin.Y - Top, Bitmap.Width, Bitmap.Height, Bitmap.Canvas.Handle, 0, 0, SRCCOPY);
ReleaseDC(Handle, DestDC);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
Value,Posi: TPoint;
Index, i, Border: Integer;
Size : array [0..50] of double;
begin
with Bitmap.Canvas do
begin
FillRect(Classes.Rect(0, 0, Bitmap.Width, Bitmap.Height));
for Index:= 0 to ControlCount - 1 do
with TWinControl(Controls[Index]) do
if Visible then
begin
Repaint;
PaintTo(Bitmap.Canvas, Left, Top); Border:= BorderWidth + 3;
BitBlt(Bitmap.Canvas.Handle, Left + Border, Top + Border, Width - Border * 2, Height - Border * 2, Canvas.Handle, Left + Border, Top + Border, SRCCOPY); end;
SetBkMode(Handle, TRANSPARENT);
for i:= 0 to Length(Caption)-1 do
with Orbital[i] do
begin
Posi:= EllipsePoint(10,10,150,70,length(Caption),Step,(Pi*i)/180);
if i > 0 then
Value := Orbital[i - 1]
else
Value := ScreenToClient(Mouse.CursorPos); TextOut(X + MouseX + Posi.X - 80, Y + MouseY + Posi.Y - 40, Caption[length(Caption)-i]); Size[i]:= Posi.Y-25;
if Size[i] < 12 then
Size[i]:=12;
Font.Size:=Trunc(Size[i]/2.6);
Application.ProcessMessages;
end;
end;
FormPaint(nil);
Step:= Step + 0.06;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
MouseX:= x;
MouseY:= y;
end;
end.
Como ya mencioné en el anterior post, tiene problemas con un TImage de fondo. Rogaría a los Foristas del Club si pueden implementar este código por favor y que funcione con una Imagen de fondo para finalizar esta duda que me llevó mucho tiempo, y evitar esos parpadeos.
¿Cómo implementar este código y evitar Parpadeos en el redibujado?