☆デスクトップに定規を・・・。
細かいマトリックス表をDocuworksで編集していると、行や列がわからなくなるので
わざわざ三角スケールを画面に当てて作業している人がいました。
液晶画面が傷つきそうなので、次のようなものを作ってみました。
(定規と書いていますが、測定するためのものではないです)
次の通り仕組みは簡単です。ポイントとしては、キャプションのないフォームを移動させる 処理かな。
次の通り仕組みは簡単です。ポイントとしては、キャプションのないフォームを移動させる 処理かな。
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Buttons, ExtCtrls, StdCtrls, Menus;
type
TForm1 = class(TForm)
PopupMenu1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
procedure N1Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
procedure WMNCHitTest(var Msg : TWMNchitTest); Message WM_NCHITTEST;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
const
DefaultSize = 25;
procedure TForm1.FormCreate(Sender: TObject);
begin
BorderStyle := bsNone;
AlphaBlend := True;
AlphaBlendValue := 200;
Color := clBlack;
N2Click(Self);
end;
procedure TForm1.N1Click(Sender: TObject);
begin
Close;
end;
// 横
procedure TForm1.N2Click(Sender: TObject);
var
ARect: TRect;
begin
SystemParametersInfo(SPI_GETWORKAREA, 0, @ARect, 0);
Height := DefaultSize;
Width := Screen.Width * 3;
Left := -Screen.Width;
Top := ARect.Bottom-(ARect.Top+DefaultSize);
end;
// 縦
procedure TForm1.N3Click(Sender: TObject);
var
ARect: TRect;
begin
SystemParametersInfo(SPI_GETWORKAREA, 0, @ARect, 0);
Width := DefaultSize;
Height := Screen.Height * 3;
Top := -Screen.Height;
Left := ARect.Right-DefaultSize;
end;
// 隅へ移動
procedure TForm1.N4Click(Sender: TObject);
var
ARect: TRect;
begin
SystemParametersInfo(SPI_GETWORKAREA, 0, @ARect, 0);
Width := DefaultSize;
Height := DefaultSize;
Top := ARect.Bottom-(ARect.Top+DefaultSize);
Left := ARect.Right-DefaultSize;
end;
procedure TForm1.WMNCHitTest(var Msg: TWMNchitTest);
const
Offset = 3;
var
P: TPoint;
begin
P := ScreenToClient(Point(Msg.XPos, Msg.YPos));
if (P.X > Width-Offset) and (P.Y > Height-Offset) then
Msg.Result := HTBOTTOMRIGHT
else if (P.X > Width-Offset) and (P.Y < Offset) then
Msg.Result := HTTOPRIGHT
else if (P.X < Offset) and (P.Y > Height-Offset) then
Msg.Result := HTBOTTOMLEFT
else if (P.X < Offset) and (P.Y < Offset) then
Msg.Result := HTTOPLEFT
else if (P.X < Offset) then
Msg.Result := HTLEFT
else if (P.X > Width-Offset) then
Msg.Result := HTRIGHT
else if (P.Y < Offset) then
Msg.Result := HTTOP
else if (P.Y > Height-Offset) then
Msg.Result := HTBOTTOM
else if (GetAsyncKeyState(VK_LBUTTON) < 0) then
Msg.Result := HTCAPTION
else
Msg.Result := HTCLIENT;
end;
end.
| 固定リンク
