Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > Gráficos
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #21  
Antiguo 10-11-2008
Avatar de cHackAll
[cHackAll] cHackAll is offline
Baneado?
 
Registrado: oct 2006
Posts: 2.159
Poder: 20
cHackAll Va por buen camino
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.
Archivos Adjuntos
Tipo de Archivo: zip bin.zip (473,3 KB, 30 visitas)
__________________
RTFM > STFW > Foro > Truco > Post > cHackAll > KeBugCheckEx
Responder Con Cita
  #22  
Antiguo 15-11-2008
Deiv Deiv is offline
Miembro
 
Registrado: jul 2005
Ubicación: La Paz - Bolivia
Posts: 364
Poder: 19
Deiv Va por buen camino
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?

Última edición por Deiv fecha: 15-11-2008 a las 14:22:08.
Responder Con Cita
  #23  
Antiguo 15-11-2008
Avatar de cHackAll
[cHackAll] cHackAll is offline
Baneado?
 
Registrado: oct 2006
Posts: 2.159
Poder: 20
cHackAll Va por buen camino
Cita:
Empezado por Deiv Ver Mensaje
..¿Que opinas?
ta weno!!!
__________________
RTFM > STFW > Foro > Truco > Post > cHackAll > KeBugCheckEx
Responder Con Cita
Respuesta



Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

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


La franja horaria es GMT +2. Ahora son las 16:23:58.


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
Copyright 1996-2007 Club Delphi