PDA

Ver la Versión Completa : Mouse con Texto Orbital


Deiv
16-12-2006, 15:08:20
Hola,
En Febrero de este año pregunté en el foro Incluir Cursor Animado especial (http://www.clubdelphi.com/foros/showthread.php?t=30119&highlight=animado), en ese entonces mis conocimientos de autodidacta y novato en Delphi no estaban muy compenetrados (y aún me considero novato, modestia aparte) hasta que empecé a practicar hace un par de semanas atrás la Construcción de Páginas Web, y en ese trayecto buscando ejemplos de JavaScript, encuentro el código de "Texto Orbital (http://www.mundojavascript.com/efectos/)" en MundoJavaScript.com aquel que había consultado en el Foro exponiendo un ejemplo de la página "Massy (http://utenti.lycos.it/wwwmassyrossi/)". He abierto un nuevo hilo por 2 razones: No quería que se pierda en "Varios" y quise darle un mejor título al Post.
Los consejos de los amigos:
En realidad no se trata de un cursor animado, sino que el efecto que puedes ver alrededor del cursor lo lleva a cabo cierto código JavaScript, el cual, por cierto, no funciona en FireFox (y no pude verlo sino en Internet Explorer).
No sé si partiendo de ese JavaScript podrías hacer algo similar en Delphi. O bastaría con que pusieras un cursor animado, tal cual. Si vas por lo primero, obtén el código fuente JavaScript de la página Web que mencionas y que se relaciona con el efecto que dices. Ponte a elo y trataremos de ayudarte.
o de:
Lo más aproximado que se me ocurre es que sustituyas todos los cursores estandard, por los correspondientes con el giro:
Mi opinión: Mucho trabajo, y poco beneficio. Además, como tú bien comentas en ese supuesto, se perdería la secuencia de giro al cambiar de cursor.
Me dejaron con una información que a la larga debía averiguar.
Bueno, HOY después de analizar el ejemplo de JavaScript "Texto Orbital" y relacionando con la función de Seoane EllipsePoint, he llegado a intentar realizar ese mismo efecto y acomodarlo en Delphi como Cursor animado especial con el siguiente código:
(Colocar la propiedad Cursor del Button1 a crHandPoint)


type
TForm1 = class(TForm)
Button1: TButton;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Button1Click(Sender: TObject);
private
Texto:string;
MouseX, MouseY:integer;
Letra: array[0..50] of TStaticText;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
currStep:extended=0;

implementation

{$R *.dfm}

function EllipsePoint(X1,Y1,X2,Y2,Largo: Integer; currStep, 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(currStep+360/Largo*Angulo));
Result.Y:= Trunc(Cy + B * sin(currStep+360/Largo*Angulo));
end;

procedure TForm1.FormCreate(Sender: TObject);
var
n, Espacio:integer;
begin
Texto:='Cursor Animado-';
Espacio:=0;
for n:=0 to length(Texto) do
begin
Letra[n]:= TStaticText.Create(Self);
with Letra[n] do
begin
Parent:= Self;
Top:= 10;
Left:= Espacio;
Caption:= Texto[n];
autosize:=true;
Font.Color:= clBlue;
Font.Name:='Arial';
Font.Size:=10;
Alignment:=taCenter;
end;
Espacio:=Espacio+Letra[n].Width;
end;
Timer1.Enabled:=true;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
i:integer;
P: TPoint;
begin
for i:= 0 to length(Texto) do
begin
P:= EllipsePoint(10,10,150,70,length(Texto),currStep,(Pi*i)/180);
Letra[length(Texto)-i].Left:= MouseX + P.X - 80;
Letra[length(Texto)-i].Top := MouseY + P.Y - 40;
Application.ProcessMessages;
end;
currStep:=currStep+0.03;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
MouseX:= x;
MouseY:= y;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
timer1.Enabled:=false;
end;

end.
Bueno, este ejemplo todavía está en etapa de construcción, falta por ejemplo que el fondo del texto orbital la fuente y el tamaño del texto sea más pequeño y hay muchas cosas más por corregir imagino, en la cual estaré atento a vuestra experiencia.
Mis preguntas:
1.- Respondiendo a dec: He intentado adaptar dicho código JavaScript en un TPaintBox incluido en un TPanel, pero todo el área del TPanel se sobrepone a los objetos en el Form al movimiento del mouse, mala idea. Luego intenté realizar en un TLabel, pero este se situa detras de los objetos al movimiento del mouse, segunda mala idea, por ello decidí (a lo que mas se aproximaba) en un TStaticText. Pero aún así este componente me mueve cuadros pequeños por cada letra y es notorio cuando se posiciona sobre otro objeto. Y más aún si el texto contiene un string bastante largo es más notorio todo ello en el movimiento orbital.
¿Conocen de algún otro componente parecido al TStaticText que se sobreponga al los objetos pero en forma Transparente? la propiedad transparente aquí no me funciona.

2.- Respondiendo a Neftali: Ahora ya no hay problema con el cursor al posicionarse sobre un objeto que tenga la propiedad por ejemplo en mi caso Button1.Cursor:=crHandPoint; el Texto no pierde la secuencia de giro, pero..... pierde el "Centro" de giro, es decir, mientras el cursor está posicionado en el objeto el Texto pierde la posición del FORM, y tratándose de objetos más grandes es más notorio este desfase.
¿Existe alguna forma de solucionar esa ubicación, al posicionarse en un objeto? La finalidad es que el Mouse esté siempre en el centro del texto orbital mientras esté dentro del Form.

3.- Si observaron la variable currStep va a ir incrementando su valor constantemente (siempre), ¿Qué podrá pasar si por así decirlo dejo trabajando el programa todo 1 dia o 1 semana, dicho valor no excederá el tipo de rango que tiene? ¿Cómo solucionar esta parte?

Ahora si espero vuestra ayuda por favor, y disculpen lo extensivo del post.
Deiv

Deiv
18-12-2006, 23:59:34
Hola,
Bueno he mejorado el código, ahora tiene pinta de una verdadera órbita, ahora si se puede llamar "Mouse con Texto Orbital" pueden verlo en el nuevo ZIP que adjunto.
Al parecer ese desfase del centro que existe al ubicarse sobre otro objeto se puede solucionar con el evento OnMouseMove para cada objeto, capturando así sus coordenadas "X" y "Y".

- ¿De que manera buscar un común denominador de tal forma que esa posición "X" y "Y" obtenga un cálculo común para todos?

- Pensaba sobre una de mis otras preguntas que la variable currStep iba creciendo constantemente, tal vez solucionar con un IF que si llegase cerca a su límite, volver a reiniciarlo?

- He leido sobre el componente StaticText, y a este no se le puede hacer nunca transparente ya que es un componente que desciende de TWinControl y todos los TWinControls son ventanas verdaderas. ¿Existe otro componente que se sobreponga encima de los objetos mostrando un texto pero de forma transparente? o ¿de que otra forma encarar esta mi aplicación?

Deiv
06-01-2007, 16:16:53
Hola Amigos,
De tanto indagar e investigar, me recomendaron el uso del componente OSD (https://secure.element5.com/shareit/product.html?productid=160933&sessionid=522782294&random=8ce01d525c0d7856db27e8a9af4396c7) (On Screen Display) es lo que Buscaba (http://www.torry.net/authorsmore.php?id=2897), si Ustedes adaptan el código a los ejemplos que les envié con este componente, tendrán un excelente cursor animado. Lástima que el Componente sea de pago, pero en fin, como dec dijo en programción todo se puede pero a veces cuesta tiempo y otras cosas.
Un saludo
Deiv

Deiv
26-10-2008, 14:53:00
Hola,
Abro el hilo nuevamente ya que encontré algo parecido a lo que en aquel entonces (años..... de duda... que se quedó...) intentaba realizar; si bien les comenté del último componente OSD. De casualidad encontre un programa (http://urlcash.net/go/1/18977/5/http://www.mediachance.com/realdraw/) llamado RealDraw en esta página (http://urlcash.net/go/1/18977/5/http://www.mediachance.com/realdraw/) que si lo descargan como versión de prueba, instalan un momento tan solo para confirmar lo que digo, en su ABOUT pueden ver este giro de letras al movimiento del mouse.

¿Alguien puede explicar por favor de que artificios y componentes se valieron para realizar ese texto que se mueve alrededor del mouse en movimiento, en el ABOUT de ese Programa?

.

cHackAll
27-10-2008, 00:19:41
...¿Alguien puede explicar por favor de que artificios y componentes se valieron para realizar ese texto que se mueve alrededor del mouse en movimiento, en el ABOUT de ese Programa?

Hola Deiv; serías tan amable de adjuntar un snapshot?

Deiv
30-10-2008, 00:03:33
Hola,
Gracias por responder, no se como colocar un SnapShot, y por alguna razón el Foro ya no me permite subir archivos ZIP (dentro la Imagen) ya que aparentemente me excedí del Límite, pero cuando reviso mis preferencias no es así, de repente algo no estoy entendiendo....
De todas maneras envié el ejemplo en esta página (http://utenti.lycos.it/wwwmassyrossi/) donde se ve el efecto del Texto alrededor del mouse, es lo mismo que se ve en el ABOUT de este Programa (http://www.mediachance.com/realdraw/) RealDraw, solo que ya no está con código de JScript, he ahí el interés del mismo de saber cómo lo hicieron?
¿Alguna Idea?

cHackAll
30-10-2008, 00:20:15
Por alguna razon no puedo ingresar al enlace que dejaste.

Deiv
30-10-2008, 00:36:30
Perdón al editar se me fue la mano, este es enlace de RealDraw:
http://www.mediachance.com/realdraw/
El ejemplo de massy corre bien en IE, lo dudo en otros navegadores, creo que no va con Firefox.

cHackAll
30-10-2008, 00:58:34
Bueno, creo que es mi error el no haber sido mas especifico... me referia al otro link que por cierto ya funcionó, pero no se donde esta la captura de pantalla.

El detalle amigo Deiv es ahorrarme la descarga de 10 Mb. viendo el asunto concretamente.

Saludos

cHackAll
30-10-2008, 19:58:45
Al parecer no solo no he leido el título del hilo, sino que no he visto tus comentarios :D en fin; a jugar se dijo:

unit Unit1;

interface

uses Windows, Types, Classes, Graphics, Controls, Forms, ExtCtrls;

type
TForm1 = class(TForm)
Timer: TTimer;
procedure FormCreate(Sender: TObject);
procedure TimerTimer(Sender: TObject);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure FormPaint(Sender: TObject);
end;

var Form1: TForm1;

implementation

{$r *.dfm}

var Bitmap: TBitmap;

procedure TForm1.FormCreate(Sender: TObject);
begin
Timer.Interval := 32;
Bitmap := TBitmap.Create;
Bitmap.Width := ClientWidth;
Bitmap.Height := ClientHeight;
end;

procedure TForm1.TimerTimer(Sender: TObject);
begin
Tag := (Tag - 2) mod 360;
FormMouseMove(nil, [], 0, 0);
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
const
Text: string = 'cHackAll ';
Radio: Integer = 128;
var
Point: TPoint;
Index, Value, Color: Integer;
begin
with Bitmap.Canvas do
begin
FillRect(Rect(0, 0, Bitmap.Width, Bitmap.Height));
Point := ScreenToClient(Mouse.CursorPos);
for Index := 1 to Length(Text) do
begin
Value := Round(Radio * Sin(((2 * Pi) * (Index / Length(Text))) + ((Tag / 180) * Pi)));
if Value > 0 then
Color := $D0
else
Color := Value + 128;
Font.Size := 32 - Value;
SetBkMode(Handle, TRANSPARENT);
SetTextColor(Handle, RGB(Color, Color, Color));
Windows.TextOut(Handle, Point.X + Round(Radio * Cos(((2 * Pi) * (Index / Length(Text))) + ((Tag / 180) * Pi))),
Point.Y + Value, @Text[Index], 1);
end;
end;
FormPaint(nil);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
BitBlt(Canvas.Handle, 0, 0, Bitmap.Width, Bitmap.Height, Bitmap.Canvas.Handle, 0, 0, SRCCOPY);
end;

end.

Saludos

Deiv
31-10-2008, 23:52:46
Acabo de leer el post y bueno, no tengo delphi a mano en este momento, y lo probaré en casa para ver tu código cHackAll, de todas maneras en este momento paralelamente subo un Video de el About aquí (http://rapidshare.com/files/159468796/RealDraw3.wmv.html) de este Programa, para que se entienda de que es lo que quiero obtener (Ojo que el link a partir de la fecha solo funcionará por 90 días) pesa apenas 1 MB.
Si observan este video, se han de fijar que si el mouse no se encuentra dentro de la ventana del form, las letras giran o se mueven por doquier y en desorden; y si ubicas el puntero del mouse en algún lugar de la ventana, entonces notarán que el texto: primero, se ubica alrededor como centro en el puntero del mouse, girando; y si se lo deja sin mover el mouse (estático) al final el texto gira alrededor en forma circular.

Con el código y ejemplo que puse lo que intente es realizar algo parecido pero de forma orbital y no encontraba el componente adecuado, pero este ABOUT es el que más se acerca a lo que en ese entonces intenté realizar, probaré el código del último post y veremos si es eso lo que realmente deseo. Gracias.
Saludos

cHackAll
01-11-2008, 22:14:08
unit _Main; // by cHackAll

interface

uses Windows, Classes, Graphics, Controls, Forms, ExtCtrls;

type
TMain = class(TForm)
Timer: TTimer;
procedure FormCreate(Sender: TObject);
procedure TimerTimer(Sender: TObject);
procedure FormPaint(Sender: TObject);
end;

var Main: TMain;

implementation

{$r *.dfm}

var
Step: Double;
Bitmap: TBitmap;
Snake: array [0..255] of TPoint; // must be zero when "Text" is changed!

procedure TMain.FormCreate(Sender: TObject);
begin
Timer.Interval := 33;
Bitmap := TBitmap.Create;
Bitmap.Width := ClientWidth;
Bitmap.Height := ClientHeight;
end;

procedure TMain.TimerTimer(Sender: TObject);
var
Size: Double;
Value: TPoint;
Index: Integer;
begin
Size := 360 / Length(Caption);
with Bitmap.Canvas do
begin
FillRect(Rect(0, 0, Bitmap.Width, Bitmap.Height));
for Index := 1 to Length(Caption) do
with Snake[Index] do
begin
if Index > 1 then
Value := Snake[Index - 1]
else
Value := ScreenToClient(Mouse.CursorPos);
Inc(X, Round((Value.X - X) * 0.6));
Inc(Y, Round((Value.Y - Y) * 0.6));
Pixels[X, Y] := clRed; // It shows a "snake tail" effect
TextOut(X + Round(66 * Cos(Step + Index * Size * (Pi / 180))),
Y + Round(66 * Sin(Step + Index * Size * (Pi / 180))),
Caption[Index]); // It shows your effect, use one or both
end;
end;
FormPaint(nil);
Step := Step - 0.06;
end;

procedure TMain.FormPaint(Sender: TObject);
begin
BitBlt(Canvas.Handle, 0, 0, Bitmap.Width, Bitmap.Height, Bitmap.Canvas.Handle, 0, 0, SRCCOPY);
end;

end.

Deiv
01-11-2008, 23:34:25
Gracias por responder nuevamente cHackAll, ayer había probado tu código, y pude observar la muy buena experiencia en programación de tu parte, ya que cuando pensé que no se podía resolver este, lo hiciste en un corto tiempo. Probé digo tu código y estaba a punto de preguntarte: ¿De que manera puedo darle fuente más pequeña a la que en tu ejemplo (un poco grande) se podía ver y así acercarse a mi primer código?

Pero ahora que veo tu archivo ZIP, realmente está fabuloso es casi aproximado a lo que yo intentaba programar hace tiempo; y aunque veo tu código puesto en el foro, me preguntaba si es el mismo del archivo Project.exe (de orbital.zip), ya que no veo por ningún lado el texto que gira que imagino lo colocaste directamente en las propiedades de algun componente. Me queda analizar tu código para aprender del mismo, y agradecerte por darte la molestia y el tiempo en escribir código.... me recuerdas a Seoane que no se limitaba en ayudar con código a muchos foristas (uno de ellos Yo)... ¿Será que tu seas el sucesor? :D
Sin desmerecer claro está a dec, lepe, Nefatli y roman que también me apoyaron con códigos, y en si a muchos del Foro.

Viendo así superficialmente el Project.exe, me nace 2 preguntas, ya que como no tengo conexión a Internet en Casa, escribo desde un Cyber, y cuando llegue a casa probaré el último código.
Dos preguntas por favor:

1.- El objetivo final mio era precisamente mostrar esa ventana en un About, la pregunta es, como veo tu aplicación funcionando en un fondo BLANCO, ¿Se puede colocar detrás también una imagen de fondo imagino verdad? y/o ¿Puede funcionar dentro de un TRichEdit tambien?

2.- Como dije tendré que estudiar mucho tu código (como Novato) y adaptar al orbital del primer Post de este Hilo y a tu anterior código, para que se vea como el de esa página (http://utenti.lycos.it/wwwmassyrossi/)en IE que mencioné. ¿Si coloco en la ventana un botón, funcionaría normal? pregunto esto porque en mi primer post no funcionaba, pues se ve interesante cuando pasas el mouse por un botón y te cambia el puntero.

No se si sería mucho pedirte que subieras en un archivo adjunto o enviarme via email el Source de tu último código.
Gracias
Saludos

cHackAll
02-11-2008, 02:41:14
...¿De que manera puedo darle fuente más pequeña a la que en tu ejemplo (un poco grande) se podía ver y así acercarse a mi primer código?...

Modifica el valor asignado a Bitmap.Canvas.Font.Size a tu antojo.

......aunque veo tu código puesto en el foro, me preguntaba si es el mismo del archivo Project.exe (de orbital.zip)...

Si es el mismo, seria frustrante para los miembros del Club que les muestre la envoltura sin darles el caramelo ;)

...ya que no veo por ningún lado el texto que gira que imagino lo colocaste directamente en las propiedades de algun componente...

Claro, no olvidemos que "Caption" es la propiedad que contiene el texto mostrado en la barra de título del formulario.

...me recuerdas a Seoane que no se limitaba en ayudar con código a muchos foristas (uno de ellos Yo)... ¿Será que tu seas el sucesor? :D...

Pues alumno, sucesor o similar no se si "seré", pero es gratificante poder ayudar a la comunidad :)

...ya que como no tengo conexión a Internet en Casa, escribo desde un Cyber...

Pues ya somos dos.

...¿Se puede colocar detrás también una imagen de fondo imagino verdad?...

Es posible usar una imagen de fondo, para ello debes "dibujar" la imagen sobre el Bitmap despues de llamar a "FillRect"

...¿Puede funcionar dentro de un TRichEdit tambien?...

Si, para evitarte complicaciones talvez deberias realizar el buffer doble sobre un TPaintBox :rolleyes:

...¿Si coloco en la ventana un botón, funcionaría normal?...

Si

...No se si sería mucho pedirte que subieras en un archivo adjunto o enviarme via email el Source de tu último código...

No es ninguna molestia, pero lo veo innecesario pues como ya he comentado el código siempre estuvo aqui (http://www.clubdelphi.com/foros/showpost.php?p=323725).

Con respecto a enviartelo por email, me parece que va en contra de la filosofía de los foros de internet; sin embargo en alguna ocación talvez podríamos charlar de éstos códigos en alguna reunion (http://www.clubdelphi.com/foros/showthread.php?t=55826) ;)

Saludos

Deiv
02-11-2008, 16:42:59
:D Vaya, vaya, a la hora que me entero "paisano k'ochala de la llajta" y "1/2 Luna". :D :D :D

seria frustrante para los miembros del Club que les muestre la envoltura sin darles el caramelo ;) :D :D

Gracias por tus explicaciones, la verdad como mencione (http://www.clubdelphi.com/foros/showpost.php?p=124865&postcount=9) en una ocasión, no soy programador de profesión, sino Químico, y la verdad programo por hobby, o de vez en cuando o si hay tiempo (no tengo constancia) y a veces se me presentan dudas como este para poder salir de las mismas.

Ya revisé tu código y evidentemente es el mismo, se presentan nuevas dudas:
...¿Puede funcionar dentro de un TRichEdit tambien?...Si, para evitarte complicaciones talvez deberias realizar el buffer doble sobre un TPaintBox :rolleyes:
¿Es solo colocar el doble buffer?. Adicioné a tu código un TEdit, Un TMemo y un TRichEdit, el movimiento de letras sigue funcionando bien, pero al pasar el mouse por estos componentes, el movimiento de las letras se los ve tal como si estuvieran detrás de estos objetos, es decir se posiciona por detrás. No sé que solución colocar ante ello.

No supe de aquella reunión, estando acá no me enteré, a la hora que leo el hilo de aquella invitación, me hubiera gustado estar presente en ese entonces, pues en nuestro País habemos pocos que programamos en Delphi, la mayoría se dedica a Base de Datos con FoxPro, C++, PHP, y otros, como Novato en alguna ocasión busqué Institutos donde aprender Delphi, pero como ya dije más dan importancia a otros Lenguajes. De todas maneras me gustaría saber la dirección de algún email o teléfono a través de un MP para poder contactarme de los detalles de dirección en LP-Bolivia, please.
Saludos

cHackAll
02-11-2008, 23:46:27
Te aclaro que soy paceño... y actualmente vivo en La Paz.
Con respecto a la informacion personal que publicas de tu persona, me parece que ya la conocia :)
Concuerdo contigo al decir que en nuestro medio hay pocos desarrolladores que utilicen como lenguaje principal el Delphi; en dicho contexto yo tampoco soy "programador de profesión"
Por lo dicho, es casi imposible encontrar enseñanza de buen nivel en dicho lenguaje, por ello los primeros dos enlaces de mi firma :rolleyes:
La proxima vez que nos reunamos, serás notificado ;)En fin, sin animos de perder el objetivo del hilo te aclaro que cuando me refiero a "realizar el buffer doble sobre" un TPaintBox me refiero a:

procedure TMe.PaintBoxPaint(Sender: TObject);
begin
BitBlt(PaintBox.Canvas.Handle, 0, 0, Bitmap.Width, Bitmap.Height, Bitmap.Canvas.Handle, 0, 0, SRCCOPY);
end;

Saludos

Deiv
03-11-2008, 15:08:06
Hola,
Je, debí haber dicho entonces paisano "chukuta". Gracias por el MSN.
Bueno adjunto nuevamente una dirección donde subí algunos archivos para que se entienda mejor:
http://rapidshare.com/files/160250824/MouseOrbital2.rar.html (Link por 3 meses)

Revisando tu código e intentando adaptar a lo que Yo requiero, estoy ya con problemas, pero el mayor problema que tengo, el MAYOR es que, no puedo ubicar este efecto sobre un form que contenga objetos y se mueva por encima de ellos :eek:.

Ahora que recuerdo esa fue la razón por la que no pude trabajar con labels u otros componentes, y el TStaticText, era el que mejor se acercaba para sobreponerse ante ellos, por esa razón hablé del OSD component, pero lástima que era de pago.

Si deseara realizar un about por ejemplo, no siempre ha de estar "vacía", o blanca "verdad"?, por ello necesitaba adaptar este efecto sobre un form normal con objetos.
Quiza tb invitar a otros foristas para que se adhieran a una virtual solución plis.
¿Alguna Idea? :confused:

cHackAll
03-11-2008, 16:30:31
...el mayor problema que tengo, el MAYOR es que, no puedo ubicar este efecto sobre un form que contenga objetos y se mueva por encima de ellos :eek:...

...¿Alguna Idea? :confused:

unit Unit1; // by cHackAll

interface

uses Windows, Messages, Classes, Graphics, Controls, Forms, ExtCtrls;

type
TForm1 = class(TForm) // class and file name changed to facilitate the tests
Timer: TTimer;
procedure FormCreate(Sender: TObject);
procedure TimerTimer(Sender: TObject);
procedure FormPaint(Sender: TObject);
end;

var Form1: TForm1;

implementation

{$r *.dfm}

var
Step: Double;
Bitmap: TBitmap;
Snake: array [0..255] of TPoint;

procedure TForm1.FormCreate(Sender: TObject);
begin
Bitmap := TBitmap.Create;
Bitmap.Width := ClientWidth;
Bitmap.Height := ClientHeight;
Bitmap.Canvas.Brush.Color := Color;
end;

procedure TForm1.TimerTimer(Sender: TObject);
var
Size: Double;
Value: TPoint;
Index, Border: Integer;
begin
Size := 360 / Length(Caption);
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); // Draw the border
Border := BorderWidth + 3;
BitBlt(Bitmap.Canvas.Handle, Left + Border, Top + Border, Width - Border * 2, Height - Border * 2, Canvas.Handle, Left + Border, Top + Border, SRCCOPY); // and the content
end;
SetBkMode(Handle, TRANSPARENT);
for Index := 1 to Length(Caption) do
with Snake[Index] do
begin
if Index > 1 then
Value := Snake[Index - 1]
else
Value := ScreenToClient(Mouse.CursorPos);
Inc(X, Round((Value.X - X) * 0.6));
Inc(Y, Round((Value.Y - Y) * 0.6));
TextOut(X + Round(66 * Cos(Step + Index * Size * (Pi / 180))),
Y + Round(66 * Sin(Step + Index * Size * (Pi / 180))),
Caption[Index]);
end;
end;
FormPaint(nil);
Step := Step - 0.06;
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;

end.

Deiv
04-11-2008, 16:11:30
Todo Ok, pero si colocogo un TImage con cualquier Propiedad ALIGN, me sale error justo en es esta línea: Border := BorderWidth + 3;
ERROR:
raised exception EAccess Violation

PaintTo(Bitmap.Canvas, Left, Top); // Draw the border
=> Border := BorderWidth + 3;
BitBlt(Bitmap.Canvas.Handle, Left + Border, Top + Border, Width - Border * 2, Height - Border * 2, Canvas.Handle, Left + Border, Top + Border, SRCCOPY); // and the content

Imagino que es por el repintado, quise solucionar colocando un TPanel como fondo del Form y que este a su vez contenga al TImage, de trabajar, trabaja, pero tiene un problema con el repintado, es decir se nota mucho PARPADEO en el efecto "snake"

Este problema me parece que es de Delphi por el comentario de otros foristas, que en este hilo (http://www.clubdelphi.com/foros/showthread.php?p=172974#post172974) hablaban en "Evitar el refresco de un TImage como fondo de un form".

¿Es Así? :(

Deiv
09-11-2008, 14:22:28
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:

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
{ Private declarations }
MouseX, MouseY:integer;
public
{ Public declarations }
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); // Draw the border
Border:= BorderWidth + 3;
BitBlt(Bitmap.Canvas.Handle, Left + Border, Top + Border, Width - Border * 2, Height - Border * 2, Canvas.Handle, Left + Border, Top + Border, SRCCOPY); // and the content
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); //CON EL Cursor
TextOut(X + MouseX + Posi.X - 80, Y + MouseY + Posi.Y - 40, Caption[length(Caption)-i]); // Elipse
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?

cHackAll
10-11-2008, 19:27:24
unit Unit1;

interface

uses Windows, Types, Classes, Graphics, Controls, Forms, ExtCtrls, StdCtrls, jpeg;

type
TForm1 = class(TForm)
Timer: TTimer;
Image: TImage;
Button: TButton;
procedure FormCreate(Sender: TObject);
procedure TimerTimer(Sender: TObject);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure FormPaint(Sender: TObject);
procedure ButtonClick(Sender: TObject);
end;

var Form1: TForm1;

implementation

{$r *.dfm}

var Bitmap: TBitmap;

procedure TForm1.FormCreate(Sender: TObject);
begin
Bitmap := TBitmap.Create;
Bitmap.Width := ClientWidth;
Bitmap.Height := ClientHeight;
Bitmap.Canvas.Brush.Color := Color;
Bitmap.Canvas.Font := Font;

Image.Visible := False; // design time!
BorderStyle := bsNone; // design time!
Timer.Interval := 20; // design time!
end;

procedure TForm1.TimerTimer(Sender: TObject);
begin
Tag := (Tag + 2) mod 360;
FormMouseMove(nil, [], 0, 0);
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
const Text: string = 'ésto NO es un cursor animado! - ';
var
Rect: TRect;
Angle: Real;
Point: TPoint;
Index, Value: Integer;
begin
with Bitmap.Canvas do
begin
Rect := Classes.Rect(0, 0, Bitmap.Width, Bitmap.Height);
{FillRect(Rect);} Draw(0, 0, Image.Picture.Graphic); // Draw the background (images)...
DrawEdge(Handle, Rect, BDR_RAISED, BF_RECT); // and the border (like Panel)

for Index := 0 to ControlCount - 1 do // don't works fine with manifest
with TWinControl(Controls[Index]) do
if Visible then
begin
Repaint;
PaintTo(Bitmap.Canvas, Left, Top); // Draw the border of each control
Value := BorderWidth + 3;
BitBlt(Bitmap.Canvas.Handle, Left + Value, Top + Value, Width - Value * 2, Height - Value * 2, Canvas.Handle, Left + Value, Top + Value, SRCCOPY); // and its content
end;

SetBkMode(Handle, TRANSPARENT);
Point := ScreenToClient(Mouse.CursorPos);
for Index := 1 to Length(Text) do
begin
Angle := (2 * Pi) * (Index / Length(Text)) + ((Tag / 180) * Pi);
Value := Round(33 * Sin(Angle));
Font.Size := (Value + 55) div 5;
Windows.TextOut(Handle, Point.X + Round(77 * Cos(Angle)),
Point.Y + Value, @Text[Length(Text) - Index + 1], 1);
end;
end;

FormPaint(nil);
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.ButtonClick(Sender: TObject);
begin
Close;
end;

end.

Deiv
15-11-2008, 14:15:48
Me perdí más de una semana, acabo de entrar al foro y pude observar que cHackAll una vez más se dio la molestia de implementar el código del texto orbital girando alrededor del mouse. Y evidentemente el código ya funciona sin problemas sobre una Imagen de Fondo.
Solo que me parece que como programadores habría que tomar las previsiones del tamaño de la ventana a mostrar en mi Aplicación (si bien le entendí así a chackall en la implementación de su ejemplo). Pues de casualidad cargué un Imagen-x que este ocupaba tan solo la mitad del ancho de mi Form, y el redibujado funciona bien en el Área de la Imagen, pero no así cuando el cursor se ubica fuera del área de la imagen (la otra mitad). Por ello decía que estas previsiones deberíamos de tomarlas antes de cargar una imagen (tamaño del Form = tamaño de la Imagen, verdad?). Además algo que también pude observar es que el código no permitirá redimensionar (maximizar) la Ventana.

cHackAll, y si en esta parte del código cambiamos por:

procedure TForm1.FormPaint(Sender: TObject);
var DestDC: Cardinal;
begin
Bitmap.Width := ClientWidth; //AUMENTAMOS ESTA LÍNEA
Bitmap.Height := ClientHeight; //Y AUMENTAMOS ESTA OTRA LÍNEA
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.FormCreate(Sender: TObject);
begin
Timer1.Interval := 33;
Timer1.Enabled:=True;
Bitmap := TBitmap.Create;
Bitmap.Width := ClientWidth;
Bitmap.Height := ClientHeight;
Bitmap.LoadFromFile('NombreDeMiArchivo.ВМР'); //MI AUMENTO
//Bitmap.Canvas.Brush.Color := Color; ........TU CÓDIGO
Caption:= 'The New custom Cursor ';
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var Size: Double;
Value: TPoint;
Index, Border: Integer;
begin
Size := 360 / Length(Caption);
with Bitmap.Canvas do
begin
//FillRect(Classes.Rect(0, 0, Bitmap.Width, Bitmap.Height)); ........TU CÓDIGO
Bitmap.LoadFromFile('NombreDeMiArchivo.ВМР'); //MI AUMENTO
...

Notarás que el parpadeo desapareció en un 90% y el TForm se puede redimensionar a cualquier tamaño, ¿Que opinas?

cHackAll
15-11-2008, 16:20:57
..¿Que opinas?

ta weno!!!