2

フォーム上のコントロールを強調表示するウィンドウを作成します。親フォームが別のウィンドウの後ろにある場合、このウィンドウは他のアプリケーションウィンドウの上に留まらないようにする必要があります（Alt + Tabを試してください）。赤いフレームがモーダルフォームから作成されていない限り、これは正常に機能します。

私が達成したいのは、モーダルダイアログから作成されたときに赤いフレームが他のウィンドウの上部に留まらず、別のアプリケーションに切り替えることです。

コードはDelphi7-XE2で機能するはずなので、PopupParentとPopupModeを省略したいと思います（正直なところ、PopupParentで遊んでみましたが成功しませんでした）。

フレームが閉じていないという事実は問題ではありません。

以下の完全なソースコードを確認してください（新しいVCLアプリケーションを作成し、ユニットテキスト全体を置き換えます。フォームにコンポーネントを配置しないでください）。

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
  private
    procedure HighlightButton(Sender: TObject);
    procedure CreateModalDialog(Sender: TObject);
  protected
    procedure DoCreate; override;
  end;

  TOHighlightForm = class(TForm)
  private
    fxPopupParent: TCustomForm;
    procedure SetFormLook;
    procedure WMMouseActivate(var Message: TWMMouseActivate); message WM_MOUSEACTIVATE;
    procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
  protected
    procedure Paint; override;
    procedure DoCreate; override;
    procedure Resize; override;
    procedure CreateParams(var Params: TCreateParams); override;
  public
    procedure ShowAt(const aPopupParent: TCustomForm; aRect: TRect; const aInflateRect: Integer = 0);
  end;


var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TOHighlightForm }

procedure TOHighlightForm.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);

  if HandleAllocated then
  with Params do begin
    if Assigned(fxPopupParent) then
      WndParent := fxPopupParent.Handle;
  end;
end;

procedure TOHighlightForm.DoCreate;
begin
  inherited;

  Color := clRed;

  FormStyle := fsStayOnTop;
  BorderStyle := bsNone;
  Position := poDesigned;
  DoubleBuffered := True;
end;

procedure TOHighlightForm.Paint;
begin
  with Canvas do begin
    Brush.Color := Self.Color;
    FillRect(Self.ClientRect);
  end;
end;

procedure TOHighlightForm.Resize;
begin
  inherited;

  SetFormLook;
  Repaint;
end;

procedure TOHighlightForm.SetFormLook;
var
  HR1, HR2: HRGN;
  xR: TRect;
begin
  if not HandleAllocated then
    exit;

  xR := Self.ClientRect;

  HR1 := CreateRectRgnIndirect(xR);
  InflateRect(xR, -3, -3);
  HR2 := CreateRectRgnIndirect(xR);

  if CombineRgn(HR1, HR1, HR2, RGN_XOR) <> ERROR then
    SetWindowRgn(Handle, HR1, True);
end;

procedure TOHighlightForm.ShowAt(const aPopupParent: TCustomForm; aRect: TRect;
  const aInflateRect: Integer);
begin
  if fxPopupParent <> aPopupParent then begin
    fxPopupParent := aPopupParent;
    RecreateWnd;
  end;

  if aInflateRect > 0 then
    InflateRect(aRect, aInflateRect, aInflateRect);

  SetBounds(aRect.Left, aRect.Top, aRect.Right-aRect.Left, aRect.Bottom-aRect.Top);

  Resize;

  ShowWindow(Handle, SW_SHOWNOACTIVATE);
  Visible := True;
end;

procedure TOHighlightForm.WMMouseActivate(var Message: TWMMouseActivate);
begin
  Message.Result := MA_NOACTIVATE;
end;

procedure TOHighlightForm.WMNCHitTest(var Message: TWMNCHitTest);
begin
  Message.Result := HTTRANSPARENT;
end;

{ TForm1 }

procedure TForm1.CreateModalDialog(Sender: TObject);
var xModalForm: TForm;
begin
  xModalForm := TForm.CreateNew(Self);
  try
    with TButton.Create(Self) do begin
      Parent := xModalForm;
      Top := 70;
      Left := 10;
      Width := 200;
      OnClick := HighlightButton;
      Caption := 'This does not work (try Alt+Tab)';
    end;

    xModalForm.ShowModal;
  finally
    xModalForm.Free;
  end;
end;

procedure TForm1.DoCreate;
begin
  inherited;

  with TLabel.Create(Self) do begin
    Parent := Self;
    Left := 10;
    Top := 10;
    Caption :=
      'I create a window, that should highlight a control on a form.'#13#10+
      'This window should not stay on top of other application windows when'#13#10+
      'the parent form is behind another window (try Alt+Tab).'#13#10+
      'This works fine unless it is a modal form.';
  end;

  with TButton.Create(Self) do begin
    Parent := Self;
    Top := 70;
    Left := 10;
    Width := 200;
    OnClick := HighlightButton;
    Caption := 'This works fine';
  end;

  with TButton.Create(Self) do begin
    Parent := Self;
    Top := 100;
    Left := 10;
    Width := 200;
    OnClick := CreateModalDialog;
    Caption := 'Open modal window and try there';
  end;
end;

procedure TForm1.HighlightButton(Sender: TObject);
var
  xR: TRect;
  xControl: TControl;
begin
  xControl := TControl(Sender);
  xR.TopLeft := xControl.ClientToScreen(Point(0, 0));
  xR.BottomRight := Point(xR.Left+xControl.Width, xR.Top+xControl.Height);

  with TOHighlightForm.CreateNew(Self) do begin
    ShowAt(Self, xR, 3);
  end;
end;

end.
4

1 に答える 1

5

テストしないでください、もちろん、テストHandleAllocatedされCreateParamsていません...

procedure TOHighlightForm.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);

//  if HandleAllocated then // <------
  with Params do begin
    if Assigned(fxPopupParent) then
      WndParent := fxPopupParent.Handle;
  end;
end;


fsStayOnTopフォームを上に残したくない場合は使用しないでください。

procedure TOHighlightForm.DoCreate;
begin
  inherited;

  Color := clRed;
//  FormStyle := fsStayOnTop; // <-----
  BorderStyle := bsNone;
  Position := poDesigned;
  DoubleBuffered := True;
end;


自己がメインフォームです。フレームを所有するフォーム（モーダルフォーム）を使用します。

procedure TForm1.HighlightButton(Sender: TObject);
var
  xR: TRect;
  xControl: TControl;
begin
  xControl := TControl(Sender);
  xR.TopLeft := xControl.ClientToScreen(Point(0, 0));
  xR.BottomRight := Point(xR.Left+xControl.Width, xR.Top+xControl.Height);

  with TOHighlightForm.CreateNew(Self) do begin  
    ShowAt(GetParentForm(TControl(Sender), False), xR, 3); // <--------
  end;
end;
于 2012-07-18T15:26:30.937 に答える