unit1.~pas

一个简单的屏幕时钟代码

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    PopupMenu1: TPopupMenu;
    Exit1: TMenuItem;
    Label1: TLabel;
    Timer1: TTimer;
    Color1: TMenuItem;
    ColorDialog1: TColorDialog;
    FontDialog1: TFontDialog;
    Font1: TMenuItem;
    procedure Exit1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Label1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Label1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Label1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Color1Click(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Font1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    move,move1: boolean;

  end;

var
  Form1: TForm1;
OldX,OldY:integer;
OldX1,OldY1:integer;


implementation

{$R *.dfm}

procedure TForm1.Exit1Click(Sender: TObject);
begin
   Form1.Close;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  DateTime : TDateTime;
  str : string;
begin
  DateTime := Time;  // store the current date and time
  str := TimeToStr(DateTime); // convert the time into a string
  label1.Caption:=str;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  wndhandle: Thandle;
begin
   //使得应用程序不再任务栏显示
   SetWindowLong(Application.Handle,GWL_EXSTYLE, WS_EX_TOOLWINDOW);
   //wndhandle:=FindWindow('shell_traywnd',nil);
   //ShowWindow(WndHandle, SW_SHOW);   //   显示任务栏
   //ShowWindow(WndHandle, SW_HIDE);   //   隐藏任务栏
   move:=false;
   move1:=false;
   form1.Height:=40;
   form1.Width:=80;
//   form1.Top:=0;
//   form1.Left:=0;
   form1.FormStyle:=fsStayOnTop;
 //  form1.AlphaBlend:=true;
 //  form1.AlphaBlendValue:=80;

   Label1.Show;
   Label1.Font.Color:=clred;
end;

procedure TForm1.Label1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   move:=true;
   OldX:=x;
   OldY:=y;

end;

procedure TForm1.Label1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   move:=false;
end;

procedure TForm1.Label1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
if move and ( ssleft in shift ) then
begin
Form1.Left:=Form1.Left+x-Oldx;
Form1.Top:=Form1.Top+y-Oldy;

end;

end;

procedure TForm1.Color1Click(Sender: TObject);
begin
   if ColorDialog1.Execute then
   Label1.Font.Color:=ColorDialog1.Color;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   move1:=true;
   OldX1:=x;
   OldY1:=y;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
if move1 and ( ssleft in shift ) then
begin
Form1.Left:=Form1.Left+x-Oldx1;
Form1.Top:=Form1.Top+y-Oldy1;

end;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   move1:=false;
end;

procedure TForm1.Font1Click(Sender: TObject);
begin
   if FontDialog1.Execute then
   Label1.Font.Name:=FontDialog1.Font.Name;
end;

end.