Mouse con Texto Orbital

Deiv · #1 03-11-2008

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/16025082...ital2.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

.

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?

[cHackAll] · #2 03-11-2008

Cita:

Empezado por Deiv

...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

...

...¿Alguna Idea?

Código Delphi [-]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 · #3 04-11-2008

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

Código Delphi [-] 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 hablaban en "Evitar el refresco de un TImage como fondo de un form".

¿Es Así?

Deiv · #4 09-11-2008

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
    { 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] · #5 10-11-2008

Código Delphi [-]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 · #6 15-11-2008

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:

Código Delphi [-]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;

Código Delphi [-]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] · #7 15-11-2008

Cita:

Empezado por Deiv

..¿Que opinas?

ta weno!!!

Temas Similares
Tema	Autor	Foro	Respuestas	Último mensaje
Posicion del mouse	Luciano M.	OOP	8	11-01-2006 19:05:16
Problema con el mouse y la alineacion del texto en un Tcombobox	Carlos Arevalo	Varios	3	23-09-2005 17:00:36
problemas con mouse	ahkimpech	Linux	1	29-07-2005 01:10:03
mouse	AngelMarvin	Windows	2	20-07-2004 07:16:35
inhabilitar mouse	Barriccel	API de Windows	2	04-12-2003 15:07:35