Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   Gráficos (https://www.clubdelphi.com/foros/forumdisplay.php?f=8)
-   -   Mouse con Texto Orbital (https://www.clubdelphi.com/foros/showthread.php?t=38503)

cHackAll 10-11-2008 19:27:24

1 Archivos Adjunto(s)
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 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:
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 15-11-2008 16:20:57

Cita:

Empezado por Deiv (Mensaje 326315)
..¿Que opinas?

ta weno!!!


La franja horaria es GMT +2. Ahora son las 21:40:39.

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi