⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 setwindowregionu.pas

📁 DelphiWin32核心API参考光盘内容.是学习书籍中的源码,便于学习.
💻 PAS
字号:
unit SetWindowRegionU;

interface

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

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
  end;

var
  Form1: TForm1;
  OriginX, OriginY: Integer;    // holds the center coordinates of the window

implementation

uses Math;

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var
  NewShape: HRGN;    // holds the region
begin
  {create a circular region}
  NewShape := CreateEllipticRgn(GetSystemMetrics(SM_CXBORDER)+3,
                                GetSystemMetrics(SM_CYCAPTION)+3,
                                GetSystemMetrics(SM_CXBORDER)+103,
                                GetSystemMetrics(SM_CYCAPTION)+103);

  {determine the center of the circle. this is used when drawing the numbers
   of the clock}
  OriginX := (GetSystemMetrics(SM_CXBORDER)+90) div 2;
  OriginY := ((GetSystemMetrics(SM_CXBORDER)+90) div 2)-3;

  {set the window region to the circular region. this will create
   a round window}
  SetWindowRgn(Handle, NewShape, TRUE);
end;

procedure TForm1.FormPaint(Sender: TObject);
var
  iCount: Integer;                      // a general loop control variable
  Hour, Minute, Second, MilSec: Word;   // used to decode the time
begin
  {set the background mode to transparent for drawing text}
  SetBkMode(Canvas.Handle, TRANSPARENT);

  {draw a highlighted bevel}
  Canvas.Pen.Color := clWhite;
  Canvas.Pen.Width := 2;
  Arc(Canvas.Handle, 1, 1, 98, 98, 98, 1, 1, 98);

  {draw a shadowed bevel}
  Canvas.Pen.Color := clBtnShadow;
  Arc(Canvas.Handle, 1, 1, 98, 98, 1, 98, 98, 1);

  {for every hour of the day...}
  for iCount := 1 to 12 do
  begin
    {...draw an hour measurement in a circular form around the window}
    Canvas.TextOut(Trunc(Sin(((360/12)*iCount)*(PI/180))*40)+OriginX,
                   Trunc(-Cos(-((360/12)*iCount)*(PI/180))*40)+OriginY,
                   IntToStr(iCount));
  end;

  {retrieve the current time in a useable format}
  DecodeTime(Now, Hour, Minute, Second, MilSec);

  {translate military hours to civilian hours}
  if Hour>12 then Hour := Hour-12;

  {draw the hour hand}
  Canvas.Pen.Color := clBlack;
  Canvas.MoveTo(50, 50);
  Canvas.LineTo(Trunc(Sin(((360/12)*Hour)*(PI/180))*30)+50,
                Trunc(-Cos(-((360/12)*Hour)*(PI/180))*30)+50);

  {draw the minutes hand}
  Canvas.MoveTo(50, 50);
  Canvas.LineTo(Trunc(Sin(((360/60)*Minute)*(PI/180))*40)+50,
                Trunc(-Cos(-((360/60)*Minute)*(PI/180))*40)+50);

  {draw the seconds hand}
  Canvas.Pen.Color := clRed;
  Canvas.MoveTo(50, 50);
  Canvas.LineTo(Trunc(Sin(((360/60)*Second)*(PI/180))*40)+50,
                Trunc(-Cos(-((360/60)*Second)*(PI/180))*40)+50);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  {repaint the form once per second}
  Repaint;
end;

procedure TForm1.WMNCHitTest(var Msg: TWMNCHitTest);
begin
  {this allows the user to drag the window by clicking anywhere on the form}
  inherited;
  Msg.Result := HTCAPTION;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -