关闭

Delphi 定制自己的下拉控件, 無焦點彈出新窗口

标签: delphiintegerfunctionborderformsinterface
1665人阅读 评论(1) 收藏 举报
分类:

Delphi 控件中, 沒有找到合適的選擇控件, 能夠提供較多信息, 而不緊緊是下拉列表提供的單個列信息,

下面的代碼中, 實現了一個彈出對話框, 彈出時,沒有改變當前活動窗口,從某种意義上說,算是沒有改變焦點,並且用鼠標鍵盤拖拉控件,均不會讓別的窗口變爲非活動窗口, Delphi6 實現。

// PopupWndBase 是一個基本的框架,本身就是提供一個下拉窗口, 需要從其繼承實現具體的應用

// PopupWndBase.dfm

object KPopupWndBase: TKPopupWndBase
  Left = 228
  Top = 140
  Width = 259
  Height = 186
  Caption = 'KPopupWndBase'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  KeyPreview = True
  OldCreateOrder = False
  OnCreate = FormCreate
  OnKeyDown = FormKeyDown
  PixelsPerInch = 96
  TextHeight = 13
end

// PopupWndBase.pas

unit PopupWndBase;

interface

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

type
  TKPopupWndBase = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    FParentWindow:HWND;
    FEnableAutoClose: boolean;
    FWinCtrlAttached:TWinControl;
    { Private declarations }
    function DoShowModalAt(wnd:TWinControl;xPos, yPos:Integer;
                           defWidth:integer=0; defHeight:Integer=0):Integer; overload;
    procedure SetEnableAutoClose(const Value: boolean);
  public
    { Public declarations }
    // like ShowModal, but can lose focus
    function ShowModalAt(wnd:TWinControl;
                     defWidth:integer=0; defHeight:Integer=0; KeepFocusWhenCanceled:boolean=false):Integer; overload;
    // Message Handler: WM_ACTIVATE
    procedure OnActivate(var Msg:TWMActivate); message WM_ACTIVATE;
    //
    function ShowModal:Integer; override;
    //
    property EnableAutoClose:boolean read FEnableAutoClose write SetEnableAutoClose;
  end;


implementation

{$R *.dfm}
function TKPopupWndBase.DoShowModalAt(wnd:TWinControl;
             xPos, yPos, defWidth, defHeight: Integer):Integer;
var
 PopupRt:TRect;
 scrRt:TRect;
 WndRt:TRect;
begin
  //
  GetWindowRect(wnd.Handle, WndRt);
  scrRt := Screen.WorkAreaRect;
  //
  PopupRt.Left := xPos;
  PopupRt.Top := yPos;
  PopupRt.Right := PopupRt.Left + defWidth;
  PopupRt.Bottom := PopupRt.Top + defHeight;
  //   when lower border bottom out of eyeshot
 if PopupRt.Bottom>scrRt.Bottom then
     if WndRt.Top - ( PopupRt.Bottom - PopupRt.Top)>= scrRt.Top then
       OffsetRect(PopupRt, 0, - PopupRt.Bottom + WndRt.Top)
     else
       OffsetRect(PopupRt, 0, - PopupRt.Bottom + scrRt.Bottom);
  //   when left border bottom out of eyeshot
 if PopupRt.Left<scrRt.Left then
       OffsetRect(PopupRt, scrRt.Left - PopupRt.Left, 0);
  //   when left border bottom out of eyeshot
 if PopupRt.Right>scrRt.Right then
       OffsetRect(PopupRt, scrRt.Right - PopupRt.Right, 0);
  //
  MoveWindow(handle, PopupRt.Left, PopupRt.Top, defWidth, defHeight, false);
  //
  Result := ShowModal;
end;

function TKPopupWndBase.ShowModalAt(wnd: TWinControl;
          defWidth, defHeight: Integer; KeepFocusWhenCanceled:boolean):Integer;
var
  rt:TRect;
begin
  Assert(wnd<>nil, 'invalid control');
  //
  GetWindowRect(wnd.Handle, rt);
  OffsetRect(rt, 0 , rt.Bottom - rt.Top);
  // Set Default value
  if defWidth=0 then defWidth := Max(60, rt.Right - rt.Left);
  if defHeight=0 then defHeight := defWidth*10 div 16;
  defWidth := Min(Screen.WorkAreaWidth, defWidth);
  defHeight := Min(Screen.WorkAreaHeight, defHeight);
  FWinCtrlAttached := wnd;
  //
  Result := DoShowModalAt(wnd, rt.left, rt.top, defWidth, defHeight);
end;

procedure TKPopupWndBase.FormCreate(Sender: TObject);
begin
    // NO Caption
    SetWindowLong(handle,
       GWL_STYLE,
       GetWindowLong(Handle, GWL_STYLE) - WS_CAPTION);
    // Redraw Frame
    SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_NOSIZE OR SWP_NOMOVE or SWP_NOZORDER or SWP_DRAWFRAME);
end;

function TKPopupWndBase.ShowModal: Integer;
begin
  EnableAutoClose := true;
  Show;
  ModalResult := mrNone;
  repeat
    Application.HandleMessage;
   // Application.ProcessMessages;
   // Sleep(20); // give up CPU
  until (GetActiveWindow()<>handle) or (ModalResult<>mrNone);

  if ModalResult = mrNone then
    begin
      ModalResult := mrCancel;
    end;
  Result := ModalResult;
  Close;
end;

procedure TKPopupWndBase.OnActivate(var Msg: TWMActivate);
begin
    if Msg.Active=word(True) then // Activate
      begin
       FParentWindow := msg.ActiveWindow;
       if EnableAutoClose then EnableAutoClose := true;
      end
    else
      begin
        if EnableAutoClose and self.Visible then close; // close when lost focus
      end;
end;


procedure TKPopupWndBase.SetEnableAutoClose(const Value: boolean);
begin
  FEnableAutoClose := Value;
  if (Value) then
    SendMessage(FParentWindow, WM_NCACTIVATE, 1, 0);
end;

procedure TKPopupWndBase.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key=27 then
     Close;
end;

end.

// ========= PopupWndBase完 ============

這個實現沒有什麽特別的, 就是做了一個欺人的小把戲。就是給前一個活動窗口發送了WM_NCACTIVATE消息, 好像仍然是活動窗口,事實上前一個輸入窗口已經失去輸入焦點; 可以OVERRIDE CreateParams, CreateWnd, 在CreateParams裏, 增加WS_CHILD STYLE, 在CreateWnd中, inherited之後, 設置parent window 為0,  但不能簡單實現鍵盤事件的處理。

// 給出一個測試代碼

   KPopupLSA  := TKPopupWndBase.CREATE(Self);
   if KPopupLSA.ShowModalAt(btn1, 400)=mrOK then
      ShowMessage('xxxxxxxx')
   else         
     ShowMessage('canceled');
   FreeAndNil(KPopupLSA);

 // pic

popup no focus window

0
0

查看评论
* 以上用户言论只代表其个人观点,不代表CSDN网站的观点或立场
    个人资料
    • 访问:77694次
    • 积分:1406
    • 等级:
    • 排名:千里之外
    • 原创:59篇
    • 转载:13篇
    • 译文:0篇
    • 评论:13条
    最新评论
    美女與戰爭