开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Delphi控件源码 > 查看源码
UnitfrmMessage.pas
资源名称：DarkMoon.rar　[点击查看]
上传用户：hndmjx
上传日期：2014-09-16
资源大小：3369k
文件大小：2k
源码类别：

Delphi控件源码

开发平台：

Delphi

UnitfrmMessage.pas：源码内容
  1. unit UnitfrmMessage;
  3. interface
  5. uses
  6.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7.   Dialogs, StdCtrls, ExtCtrls;
  9. type
  10.   TfrmMessage = class(TForm)
  11.     GroupBox1: TGroupBox;
  12.     Label1: TLabel;
  13.     Shape1: TShape;
  14.     Shape2: TShape;
  15.     Shape3: TShape;
  16.     Shape4: TShape;
  17.     Label2: TLabel;
  18.     Label3: TLabel;
  19.     lblComputername: TLabel;
  20.     lblComputerIP: TLabel;
  21.     lblTitle: TLabel;
  22.     TimerMoveForm: TTimer;
  23.     Memo1: TMemo;
  24.     procedure Label1Click(Sender: TObject);
  25.     procedure TimerMoveFormTimer(Sender: TObject);
  26.     procedure Shape2MouseDown(Sender: TObject; Button: TMouseButton;
  27.       Shift: TShiftState; X, Y: Integer);
  28.     procedure Shape2MouseUp(Sender: TObject; Button: TMouseButton;
  29.       Shift: TShiftState; X, Y: Integer);
  30.     procedure Label1MouseLeave(Sender: TObject);
  31.     procedure Label1MouseMove(Sender: TObject; Shift: TShiftState; X,
  32.       Y: Integer);
  33.   private
  34.     { Private declarations }
  35.   public
  36.     { Public declarations }
  37.   end;
  39. var
  40.   frmMessage: TfrmMessage;
  41.   Punto : TPoint;
  42. implementation
  44. {$R *.dfm}
  46. procedure TfrmMessage.Label1Click(Sender: TObject);
  47. begin
  48. close;
  50. end;
  52. procedure TfrmMessage.TimerMoveFormTimer(Sender: TObject);
  53. var
  54. aux :   TPoint;
  55. begin
  56. //intento imitar los movimientos del mouse
  57.  GetCursorPos( aux );//tomo la pos actual del mouse
  58.  if Aux.x < Punto.x//la comparo el eje de las X con la otra pos que habia tomado recien
  59.   then frmMessage.Left := frmMessage.Left - ( Punto.x - Aux.x )
  60.   else frmMessage.Left := frmMessage.Left + ( Aux.x - Punto.x);
  61.  if Aux.y < Punto.y//lo mismo con el eje Y
  62.   then frmMessage.Top := frmMessage.Top - ( Punto.y - Aux.y )
  63.   else frmMessage.Top :=frmMessage.Top + ( Aux.y - Punto.y );
  64.  Punto := Aux;// y por ultimo actualizo la pos actual
  65. end;
  67. procedure TfrmMessage.Shape2MouseDown(Sender: TObject;
  68.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  69. begin
  70.  TimerMoveForm.Enabled := True;
  71.  GetCursorPos( Punto );
  72. end;
  74. procedure TfrmMessage.Shape2MouseUp(Sender: TObject; Button: TMouseButton;
  75.   Shift: TShiftState; X, Y: Integer);
  76. begin
  77.   TimerMoveForm.Enabled := False;
  78. end;
  80. procedure TfrmMessage.Label1MouseLeave(Sender: TObject);
  81. begin
  82.  label1.Font.Color:=clwhite;
  83. end;
  85. procedure TfrmMessage.Label1MouseMove(Sender: TObject; Shift: TShiftState;
  86.   X, Y: Integer);
  87. begin
  88. label1.Font.Color:=  $000080FF;
  89. end;
  91. end.