Пишу компонент типа Combobox. При первом клике мышью по компоненту выпадающий список появляется не под основным компонентом а в левом углу экрана. При последующих вызовах выпадающего списка все отображается правильно.
Выпадающий список отображаю с помощью
| Код |
SetWindowPos(FPopupList.Handle, HWND_TOP, P.X, Y, 0, 0,
SWP_NOSIZE or SWP_NOACTIVATE or SWP_SHOWWINDOW);
|
При трассировке кода и в первом и в последующих вызовах списка координаты одинаковы.
Помогите разобраться что не так?
Привожу код компонента
| Код |
type
{ TfsListView }
TfsSourceSelect = class;
TfsListView = class (TfsPopupListView)
private
FEdit: TfsSourceSelect;
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer;
Y: Integer); override;
public
constructor Create(AOwner: TComponent); override;
end;
{ TfsSourceSelect }
TfsSourceSelect = class(TCustomControl)
private
FText : String;
FPopupList: TfsListView;
FListVisible : Boolean;
procedure DropDown;
procedure CloseUp(Accept: Boolean);
protected
procedure Paint; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer;
Y: Integer); override;
public
property Text: string read FText;
constructor Create(AOwner: TComponent); override;
end;
implementation
{ TfsSourceSelect }
constructor TfsSourceSelect.Create(AOwner: TComponent);
begin
inherited;
ControlStyle := ControlStyle + [csReplicatable];
Width := 90;
Height := 32;
FText := '';
Color := TColor($8b8b8b);
if NewStyleControls then
ControlStyle := [csOpaque]
else
ControlStyle := [csOpaque, csFramed];
TabStop := True;
FPopupList := TfsListView.Create(Self);
FPopupList.Parent := Self;
FListVisible := False;
end;
procedure TfsSourceSelect.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
begin
inherited;
Invalidate;
if not FListVisible then
DropDown
else
CloseUp(False);
end;
procedure TfsSourceSelect.DropDown;
var
P: TPoint;
Y: Integer;
begin
FPopupList.Color := Color;
FPopupList.Font := Font;
FPopupList.Width := Width;
P := Parent.ClientToScreen(Point(Left, Top));
Y := P.Y + Height;
if Y + FPopupList.Height > Screen.Height then Y := P.Y - FPopupList.Height;
SetWindowPos(FPopupList.Handle, HWND_TOP, P.X, Y, 0, 0,
SWP_NOSIZE or SWP_NOACTIVATE or SWP_SHOWWINDOW);
FPopupList.Left := Left;
FPopupList.Top := Top + Height;
FListVisible:=True;
FPopupList.Repaint;
end;
procedure TfsSourceSelect.CloseUp(Accept: Boolean);
begin
{if Accept and (FPopupList.ItemIndex >= 0) then
FText := FPopupList.Items[FPopupList.ItemIndex];}
SetWindowPos(FPopupList.Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or
SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
FListVisible := False;
Repaint;
end;
procedure TfsSourceSelect.Paint;
var
APoint1 : TPoint;
begin
inherited Paint;
with Canvas do
begin
Color := clFSGray;
Pen.Color := clFSGray;
Brush.Color := clFSRed;
RoundRect(ClientRect.Left, ClientRect.Top,
ClientRect.Right, ClientRect.Bottom, 7, 7);
//Выводим текст
Font.Name := 'Arial';
Font.Style := [fsBold];
Font.Size := 8;
Font.Color := clWhite;
APoint1 := Point((Self.Width - TextWidth(Text)) div 2,
(Self.Height - TextHeight(Text)) div 2);
TextOut(APoint1.X, APoint1.Y, Text);
end;
end;
{ TfsListView }
constructor TfsListView.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FEdit := TfsSourceSelect(AOwner);
Parent := FEdit;
Visible := False;
ControlStyle := ControlStyle + [csNoDesignVisible, csReplicatable];
Color := TColor($8b8b8b);
end;
procedure TfsListView.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
begin
Style :=Style or WS_POPUP; //or WS_VSCROLL or WS_BORDER
ExStyle := WS_EX_TOOLWINDOW;
AddBiDiModeExStyle(ExStyle);
WindowClass.Style :=CS_SAVEBITS;
end;
end;
procedure TfsListView.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
begin
inherited;
//if (ItemIndex >= 0) then FEdit.CloseUp(True);
end;
|
|
)