« ☆FormのOnMouseWheelDown(Up) | トップページ | ☆HTMLのソースを取得する。 »

☆デスクトップに定規を・・・。

細かいマトリックス表をDocuworksで編集していると、行や列がわからなくなるので わざわざ三角スケールを画面に当てて作業している人がいました。 液晶画面が傷つきそうなので、次のようなものを作ってみました。 (定規と書いていますが、測定するためのものではないです)

Docu

(この画像では、2つ起動させ、それぞれを縦と横に設定して使っています。)

次の通り仕組みは簡単です。ポイントとしては、キャプションのないフォームを移動させる 処理かな。
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.

|

« ☆FormのOnMouseWheelDown(Up) | トップページ | ☆HTMLのソースを取得する。 »