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

細かいマトリックス表を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.

☆FormのOnMouseWheelDown(Up)

CAD Viewerを作っていて、FormのOnMouseWheelDown(Up)で問題が発生しました。 CADではコードがややこしいので、下記のような簡単なもので考えてみることにします。 問題点としては、PaintBoxに描画したものをマウスホイールにより拡大縮小する 仕様なのですが、この動作によりListBoxがスクロールしてしまうことです。

問題のあるコード

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    PaintBox1: TPaintBox;
    procedure PaintBox1Paint(Sender: TObject);
    procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure FormCreate(Sender: TObject);
  private
    P: Integer;
    procedure DrawData;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  I: Integer;
begin
  P := 0;
  Form1.OnResize := PaintBox1Paint;
  for I := 0 to 99  do
    ListBox1.Items.Add(IntToStr(I));
end;

procedure TForm1.DrawData;
var
  Rect: TRect;
begin
  // Clear
  Rect.Top := PaintBox1.Top;
  Rect.Left := PaintBox1.Left;
  Rect.Bottom := PaintBox1.Height;
  Rect.Right := PaintBox1.Width;
  // Rectangle
  PaintBox1.Canvas.FillRect(Rect);
  Rect.Top := (PaintBox1.Top + P);
  Rect.Left := PaintBox1.Left + P;
  Rect.Bottom := PaintBox1.Height - P;
  Rect.Right := PaintBox1.Width - P;
  PaintBox1.Canvas.Rectangle(Rect);
end;

procedure TForm1.FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  Dec(P,5);
  DrawData;
end;

procedure TForm1.FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  Inc(P,5);
  DrawData;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  DrawData;
end;

end.

対策後のコード
MouseWheelDown(Up)をそれぞれ下記のようにしました。

procedure TForm1.FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
var
  Pt: TPoint;
begin
  GetCursorPos(Pt);
  Pt := ScreenToClient(Pt);
  if ((Pt.X > 0) and (Pt.X < PaintBox1.Width)) and
     ((Pt.Y > 0) and (Pt.Y < PaintBox1.Height)) then
  begin
    Handled := True;
    Dec(P,5);
    DrawData;
  end;
end;

procedure TForm1.FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
var
  Pt: TPoint;
begin
  GetCursorPos(Pt);
  Pt := ScreenToClient(Pt);
  if ((Pt.X > 0) and (Pt.X < PaintBox1.Width)) and
     ((Pt.Y > 0) and (Pt.Y < PaintBox1.Height)) then
  begin
    Handled := True;
    Inc(P,5);
    DrawData;
  end;
end;

これによりPaintBox1上にマウスがある場合のみPaintBox1にマウスホイールが働きます。 ListBox1をスクロールするには、ListBox1上にマウスを移動させます。

☆リターンキーで移動させる。

なんだっけ？なんだっけ？となかなか思い出せず、過去のプログラムを 調べて、ようやく見つけた出した SelectNext！超、超、超いまさらですが、書いておきますね。

Form1のKeyPreviewをTrueにする必要があります。

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
  //リターンキーで移動させる
  if Key = #13 then
  begin
    SelectNext(ActiveControl, True, True);
    Key := #0;
  end;
end;

☆多数のEditのテキストを削除する。

TFormは、TComponentから派生されていますので、 ComponentsプロパティやComponentCountプロパティを使えば、 フォーム上のコンポーネントの単純な処理が可能になります。
ここでは、Editのテキストを空白にする処理を行ってみました。

procedure TForm1.Button1Click(Sender: TObject);
var
  I: Integer;
begin
  // Editの初期化
  for I := 0 to Self.ComponentCount - 1 do
    if Self.Components[I] is TEdit then
      (Self.Components[I] as TEdit).Text := '';
end;

☆入力間違いを知らせる一つの方法

Yahoo!ウィジェットか何かで、ID、パスワードが違うとフォームが細かく左右に動く・・・まるで「いやいや」（関西人としては、「ちゃうちゃう」かな）してるようなものを見たことがあるので、Delphiで試してみました。

フォームにボタンを貼り付けて、試してみて下さい。

procedure TForm1.Button1Click(Sender: TObject);
const
  Wait = 50;
var
  I, J: Integer;
begin
  J := -30;
  for I := 0 to 3 do
  begin
    case I of
      0: Left := Left - 15;
      1..3: begin
              J := J * (-1);
              Left := Left + J;
            end;
    end;
    Sleep(Wait);
    Application.ProcessMessages;
  end;
  Left := Left-15;
end;