高手请进->>>子窗体的边界能否越过父窗体的边界?(就是子窗体并未框在父窗体里面)

[laughcsdn]

此处的子窗体和父窗体关系是child.parent=father

我看到cxGrid里的BlobEdit类型,在编辑时弹出一个编辑框,但是这个编辑框的边界可以超越父窗体的(右边或下边),如果这个编辑框是个独立的Form,应该原来的窗体会失去焦点,但是在编辑时,原来的窗体并未失去焦点.证明了这个编辑框可能是原来的窗体的子控件或子孙控件.
我本来想用spy++跟踪证实一下那个弹出的编辑框是不是一个子窗体,但由于那个编辑框是点击后才动态生成,切换到spy++就已经销毁了,winsight32也追踪不到(可能是winsight32在2000上运行不太正常).

有没有高手试过在delphi程序中让form/panel/frame的子窗体的边界越过它的父窗体呢?
例如FormPopup.parent=Panel1,但是FormPopup并未框在Panel1里面,就像正常窗口一样显示在Panel上面.

[SydPink]

他们不是MDI中的那种关系。是两个独立的窗口，不过那个漂着的“子窗口”是工具窗口风格的，至于处理输入焦点，可以用 SetCapture()函数，指定将输入焦点设置成这个小窗口。就是 Combobox的下拉列表筐窗子的那种风格。你应该明白了。试着自己从TCustomForm派生一个窗子,重载它的 CreateParams()方法，指定窗体风格，处理合适的消息就OK。

[aiirii]

http://borland.mblogger.cn/aiirii/posts/3163.aspx

如何让控件的显示能超过主窗口範圍?

[SydPink]

这个是以前写的一个颜色选择器，在256色下有问题，不过说明你的问题是足够了。你看吧。
unit UHQJCombobox;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms;
const
BtnWidth = 12;
bsize = 13;

ColorTable : array[0..39] of integer = (
$009CCFFF, $840400, $FF0400, $FF04FF, $FF96C6,
$943400, $FF6500, $FF9600, $FFC700, $FFC794,
$313400, $848600, $94C700, $FFFF00, $FFFF94,
$003400, $008600, $319663, $00FF00, $C6FFC6,
$C6FFC6, $008684, $31CFCE, $00FFFF, $CEFFFF,
$000484, $0004FF, $3165FF, $00C7FF, $94C7FF,
$313494, $636594, $840484, $943463, $C696FF,
$313431, $848684, $949694, $C6C7C6, $FFFFFF );
type

TCBListForm = class(TForm)
private
CurrentPos: TPoint;
FSelColor: TColor;
InCustomBtn: Boolean;
FOnClose: TNotifyEvent;
procedure InvdCrntPos;
procedure DrawTitle;
// procedure DrawCustomBtn;
procedure DrawColorTable;
procedure HilightPos(x, y: integer);
procedure CalculatePos(x,y,cbHeight: integer);
function GetSelColor: TColor;
procedure WMMOUSEACTIVATE(var Message: TWMMOUSEACTIVATE);message WM_MOUSEACTIVATE;
procedure WMLBUTTONDOWN(var Message: TMessage);message WM_LBUTTONDOWN;
procedure WMMOUSEMOVE(var Message: TMessage);message WM_MOUSEMOVE;
procedure WMACTIVATEAPP(var Message: TMessage);MESSAGE WM_ACTIVATEAPP;
procedure WMKEYEVENT1(var Message: TMessage); message WM_USER + 47360;
procedure WMKEYEVENT2(var Message: TMessage); message WM_USER + 47364;
procedure WMLBUTTONUP(var Message: TMessage);message WM_LBUTTONUP;
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure Click; override;
procedure Paint; override;
procedure MouseMove( Shift: TShiftState; X, Y: Integer); override;
public
Constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0); override;
Procedure DoClose(Var Action: TCloseAction); override;
procedure PopUp(x,y, cbHeight: integer);
property OnDestroy;
property SelColor: TColor read FSelColor;
property OnWndClose: TNotifyEvent read FOnClose write FOnClose;
end;

THQJColorBox = class(TCustomControl)
private
FFrameColor, FBtnColor: TColor;
FMouseIn: Boolean;
FDropDown: Boolean;
FMouseDown: Boolean;
ListWnd: TCBListForm;
FSelColor: TColor;
FHIColor: TColor;
FOnSelColor: TNotifyEvent;
procedure SetHIColor(val: TColor);
procedure SetFrameColor(val: TColor);
procedure SetBtnColor(val: TColor);
procedure DrawFrame;
procedure Draw3DFrame(const c1, c2: TColor; rc: TRect);
procedure DrawFace;
procedure DrawBtn;
procedure DoBtnClick;
procedure ListWndClose(Sender: TObject);
procedure CMMOUSEENTER(var Message: TMessage);message CM_MOUSEENTER;
procedure CMMOUSELEAVE(var Message: TMessage);message CM_MOUSELEAVE;
protected
procedure Paint; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
public
constructor Create(AOwner: TComponent); override;
published
property Font;
property Color;
property FrameColor: TColor read FFrameColor write SetFrameColor;
property BtnColor: TColor read FBtnColor write SetBtnColor;
property SelColor: TColor read FSelColor;
property HiColor: TColor read FHiColor write SetHIColor;
property Visible;
property Enabled;
property Align;
property OnClick;
property OnSelColor: TNotifyEvent read FOnSelColor write FOnSelColor;
end;

procedure Register;
function GetColorDepth: integer ;
implementation

procedure Register;
begin
RegisterComponents('HQJVCL', [THQJColorBox]);
end;
function GetColorDepth: integer;
var
dc: HDC;
begin
dc := GetDC(0);
Result := GetDeviceCaps(dc, BITSPIXEL);
ReleaseDC(0, dc);
end;

[SydPink]

{ TCBListForm }

procedure TCBListForm.CalculatePos(x, y, cbHeight: integer);
begin
Left := x - Width div 2;
Top := y;
if Left < 0 then Left := 0;
if Top + Height > Screen.Height then Top := y - cbHeight - Height - 4;
if left + Width > Screen.Width then Left := Screen.Width - Width;
end;

procedure TCBListForm.Click;
begin
inherited;
ShowWindow(Handle, SW_HIDE);
ReleaseCapture;
if Assigned(FOnClose) then FOnClose(Self);

end;

constructor TCBListForm.CreateNew(AOwner: TComponent; Dummy: Integer);
begin
inherited;
Color := $FFFFFF;
Width := 157;
Height := 120;
FSelColor := $009CCFFF;
CurrentPos := Point(-1, -1);
InCustomBtn := false;
end;

procedure TCBListForm.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.Style := WS_POPUP OR WS_BORDER OR WS_CLIPSIBLINGS OR
WS_OVERLAPPED OR $00008043;
end;
procedure TCBListForm.DoClose(var Action: TCloseAction);
begin
Action := caHide;
ReleaseCapture;
if Assigned(FOnClose) then FOnClose(Self);
inherited;
end;
procedure TCBListForm.DrawColorTable;
var
i, j, num, l, t: integer;
begin
num := 0;
with Canvas do
begin
Pen.Color := clGray;
for i := 0 to 7 do
for j := 0 to 4 do
begin
Brush.Color := ColorTable[num];
l := i * (bSize + 4)+ 10;
t := j * (bSize + 4) + 30;
Rectangle(l + 2, t + 2, l + bSize + 2, t + bsize + 2 );
inc(num);
end;
end;
end;
{
procedure TCBListForm.DrawCustomBtn;
begin
with Canvas do
begin
Font.Name := 'Area Black';
Font.Size := 10;
if InCustomBtn then begin
Pen.Color := clGray;
if GetColorDepth > 8 then
Brush.Color := RGB(220, 220, 255)
else Brush.Color := clGray;
Font.Color := clBlue;
end else begin
Brush.Color := Color;
Pen.Color := Brush.Color;
Font.Color := clBlack;
end;
Rectangle(12, Height - 25, Width - 12, Height - 6);
TextOut(20, Height - 22, 'More...');
end;
end; }

procedure TCBListForm.DrawTitle;
var
i: integer;
begin
with Canvas do
begin
if GetColorDepth > 8 then
begin
for i := 1 to 7 do
begin
Pen.Color := RGB(255 - i* 30, 255 - i * 30, 255);
MoveTo(0, i);
LineTo(Width - 1, i);
end;
end else begin
Brush.Color := clGray;
FillRect(Rect(0,0,Width, 7));
end;
Brush.Color := FSelColor;
Pen.Color := clGray;
Rectangle(24, 10, Width - 24, 26);
end;
end;

function TCBListForm.GetSelColor: TColor;
begin
Result := Canvas.Pixels[50, 20];
end;

procedure TCBListForm.HilightPos(x, y: integer);
var
col, row: integer;
rc: TRect;
begin
col := Round((x - 18) / (bSize + 4));
row := Round((y - 38) / (bSize + 4));
if (col <= 7)and (Row <= 4) and (col >= 0) and (row >=0)then
begin
if (col = CurrentPos.x )and (row = CurrentPos.Y) then exit;
with Canvas do begin
Brush.Style := bsClear;
Pen.Color := clBlack;
rc.left := col * (bSize + 4) + 10;
rc.Top := row * (bSize + 4) + 30;
rc.RIght := rc.Left + bSize + 4;
rc.Bottom := rc.Top + bSize + 4;
Rectangle(rc);
Brush.Color := Pixels[rc.Left + 6, rc.Top + 6];
Pen.Color := clGray;
Rectangle(24, 10, Width - 24, 26);
if CurrentPos.X <> -1 then
InvdCrntPos
end;
CurrentPos := Point(col, row);
end
else if CurrentPos.X <> -1 then begin
InvdCrntPos;
CurrentPos := Point(-1, -1);
Canvas.Brush.Color := FSelColor;
Canvas.Pen.Color := Color;
Canvas.Rectangle(24, 10, Width - 24, 26);
end;
end;

procedure TCBListForm.InvdCrntPos;
var
rc: TRect;
begin
with Canvas do begin
rc.left := CurrentPos.X * (bSize + 4) + 10;
rc.Top := CurrentPos.Y * (bSize + 4) + 30;
rc.RIght := rc.Left + bSize + 4;
rc.Bottom := rc.Top + bSize + 4;
Pen.Color := Color;
Brush.Style := bsClear;
Rectangle(rc);
end;
end;

procedure TCBListForm.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
inherited;
if PtInRect(ClientRect, Point(x, y)) then
begin
HilightPos(x, y);
if (not InCustomBtn) and (Y > Height - 25) then begin
InCustomBtn := true;
// DrawCustomBtn;
end;
if (Y < Height - 25)and(InCustomBtn) then begin
InCustomBtn := false;
// DrawCustomBtn;
end;
end else begin
if InCustomBtn then begin
InCustomBtn := false;
// DrawCustomBtn;
end;
end;
end;

procedure TCBListForm.Paint;
begin
CurrentPos := Point(-1, -1);
DrawTitle;
DrawColorTable;
// DrawCustomBtn;
end;

procedure TCBListForm.PopUp(x, y, cbHeight: integer);
begin
CalculatePos(x,y, cbHeight);
SetWindowPos(Handle, HWND_TOPMOST, Left, Top, Width, Height, SWP_NOACTIVATE);
ShowWindow(Handle, SW_SHOWNOACTIVATE);
end;

procedure TCBListForm.WMACTIVATEAPP(var Message: TMessage);
begin
inherited;
ReleaseCapture;
ShowWindow(Handle, SW_HIDE);
if Assigned(FOnClose) then FOnClose(Self);
end;

procedure TCBListForm.WMKEYEVENT1(var Message: TMessage);
begin
inherited;
ShowWIndow(Handle, SW_HIDE);
ReleaseCapture;
if Assigned(FOnClose) then FOnClose(Self);
end;

[laughcsdn]

楼上的高手能否把代码贴完啊。

[SydPink]

不好意思，，没注意，一次发不完，CUT的时候没注意。我贴完它。。。

[SydPink]

procedure TCBListForm.WMKEYEVENT2(var Message: TMessage);
begin
inherited;
ShowWIndow(Handle, SW_HIDE);
ReleaseCapture;
if Assigned(FOnClose) then FOnClose(Self);
end;

procedure TCBListForm.WMLBUTTONDOWN(var Message: TMessage);
var
p: TPoint;
begin
inherited;
p := Point(LOWORD(Message.lParam), HIWORD(Message.lParam));
if (CurrentPos.X <> -1)and (PtInRect(ClientRect,p )) then
FSelColor := GetSelColor;
ShowWIndow(Handle, SW_HIDE);
ReleaseCapture;
if Assigned(FOnClose) then FOnClose(Self);

end;

procedure TCBListForm.WMLBUTTONUP(var Message: TMessage);
begin
inherited;
SetCapture(Handle);
end;

procedure TCBListForm.WMMOUSEACTIVATE(var Message: TWMMOUSEACTIVATE);
begin
Message.Result := MA_NOACTIVATE;
end;

procedure TCBListForm.WMMOUSEMOVE(var Message: TMessage);
begin
inherited;
if GetCapture <> Handle then
SetCapture(Handle);
end;




{ THQJColorBox }

constructor THQJColorBox.Create(AOwner: TComponent);
begin
inherited;
TabStop := true;
ListWnd := TCBListForm.CreateNew(Application);

ListWnd.OnWndClose := ListWndClose;
SetBounds(0, 0, 42, 20);
FMouseIn := false;
FMouseDown := false;
FDropDown := false;
FFrameColor := clBlack;
Color := RGB(200, 255, 200);
FBtnColor := clSkyBlue;
FSelColor := $009CCFFF;
ListWnd.FSelColor := FSelColor;
FHIColor := RGB(0,0, 120);
end;

procedure THQJColorBox.DrawBtn;
var
l, t: integer;
begin
with Canvas do
begin
if (FMouseIn) and (not FDropDown) then begin
if GetColorDepth > 8 then
Brush.Color := FBtnColor
else Brush.Color := clWhite;
Pen.Color := FHIColor;
end else begin
Brush.Color := Color;
Pen.Color := FFrameColor;
end;
FillRect(Rect(Width - BtnWidth, 1, Width - 1, Height - 1));
l := Width - BtnWidth div 2 - 5;
t := Height div 2 - 4;
if FDropDown then begin
inc(t);
end;
MoveTo(l + 1, t + 1);
LineTo(l + 4, t + 4);
LineTo(l + 8, t);
MoveTo(l + 1, t + 5);
LineTo(l + 4, t + 8);
LineTo(l + 8, t + 4);

end;
end;

procedure THQJColorBox.DrawFace;
begin
with Canvas do
begin
Brush.Color := FSelColor;
Pen.Color := clGray;
Rectangle(3, 3, Width - BtnWidth - 3, Height - 3);
if FMouseDown then Draw3DFrame(clBlack, clWhite,
Rect(3, 3, Width - BtnWidth - 3, Height - 3));
end;
end;

[SydPink]

procedure THQJColorBox.DrawFrame;
begin
with Canvas do
begin
if Enabled then begin
if FMouseIn then begin
Pen.Color := FHIColor;
Draw3DFrame(FHIColor, FHIColor, ClientRect);
end
else begin
Pen.Color := FFrameColor;
Draw3DFrame(FFrameColor, FFrameColor, ClientRect);
end;
end else begin
Pen.Color := clGray;
Draw3DFrame(clGray, clGray, ClientRect);
end;
MoveTo(Width - BtnWidth - 1, 0);
LineTo(Width - BtnWidth - 1, Height);
end;
end;

procedure THQJColorBox.Draw3DFrame(const c1, c2: TColor; rc: TRect);
begin
with Canvas do
begin
Pen.Color := c1;
MoveTo(rc.Left,rc.Bottom - 1);
LineTo(rc.Left,rc.Top);
LineTo(rc.Right - 1, rc.Top);
Pen.Color := c2;
LineTo(rc.Right - 1, rc.Bottom - 1);
LineTo(rc.Left, rc.Bottom - 1);
end;
end;

procedure THQJColorBox.Paint;
begin
DrawFace;
DrawBtn;
DrawFrame;
end;

procedure THQJColorBox.SetBtnColor(val: TColor);
begin
FBtnColor := val;
DrawBtn;
end;

procedure THQJColorBox.SetFrameColor(val: TColor);
begin
FFrameColor := val;
DrawFrame;
end;

procedure THQJColorBox.CMMOUSEENTER(var Message: TMessage);
begin
FMouseIn := true;
DrawFrame;
DrawBtn;
DrawFace;
end;

procedure THQJColorBox.CMMOUSELEAVE(var Message: TMessage);
begin
FMouseIn := false;
DrawFrame;
DrawBtn;
Drawface;
end;

procedure THQJColorBox.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited;
if (X > Width - BtnWidth) and (not FDropDown) then
begin
FDropDown := true;
FMouseIn := false;
DrawFrame;
DrawBtn;
DoBtnClick;
end else begin
FMouseDown := true;
DrawFace;
end;
end;

procedure THQJColorBox.DoBtnClick;
var
rc: TRect;
begin
GetWindowRect(Handle, rc);
rc.Left := rc.Left + Width;
rc.Top := rc.Top + Height + 2;
// Windows.ClientToScreen(TWinControl(Owner).handle, p);
ListWnd.PopUp(rc.left, rc.Top, Height);
SetCapture(ListWnd.Handle);
SetFocus;
end;

procedure THQJColorBox.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
begin
inherited;
FMouseDown := false;
DrawBtn;
DrawFace;
end;

procedure THQJColorBox.ListWndClose(Sender: TObject);
begin
if FSelColor <> ListWnd.SelColor then
begin
FSelColor := ListWnd.SelColor;
if Assigned(FOnSelColor) then FOnSelColor(Self);
end;
FDropDown := false;
FMouseIn := false;
DrawBtn;
DrawFace;
DrawFrame;
end;
procedure THQJColorBox.SetHIColor(val: TColor);
begin
FHIColor := val;
end;

end.