Ver Mensaje Individual
  #21  
Antiguo 10-11-2008
Avatar de cHackAll
[cHackAll] cHackAll is offline
Baneado?
 
Registrado: oct 2006
Posts: 2.159
Reputación: 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