Ver Mensaje Individual
  #20  
Antiguo 09-11-2008
Deiv Deiv is offline
Miembro
 
Registrado: jul 2005
Ubicación: La Paz - Bolivia
Posts: 364
Reputación: 19
Deiv Va por buen camino
Exclamation ¿Cómo quitar el parpadeo?

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?
Responder Con Cita