VPF::Свой компонент типа Combobox - Форум программистов

FShadow

Дата 5.11.2009, 17:45 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 34
Регистрация: 8.12.2006
Где: Беларусь, г. Минс к

Репутация: -1
Всего: -1

Пишу компонент типа 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;

hawkins

Дата 5.11.2009, 18:02 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 148
Регистрация: 8.9.2003

Репутация: нет
Всего: нет

а если этот код убрать :
FPopupList.Left := Left;
FPopupList.Top := Top + Height;

ты же позицию процедурой SetWindowPos задаешь, вроде как, хотя этот код тоже првильный если тебе под родителем надо список показать

FShadow

Дата 5.11.2009, 18:38 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 34
Регистрация: 8.12.2006
Где: Беларусь, г. Минс к

Репутация: -1
Всего: -1

hawkins, да я его поставил чтоб продублировать SetWindowPos. Ничего не помогло.

Akella

Дата 5.11.2009, 19:01 (ссылка)

(нет голосов)

Загрузка ...

Творец

Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

Репутация: 36
Всего: 329

Цитата(FShadow @ 5.11.2009, 17:45

)

в левом углу экрана.

Цитата(FShadow @ 5.11.2009, 17:45

)

P.X, Y

значит эти координаты равны нулю

FShadow

Дата 5.11.2009, 19:47 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 34
Регистрация: 8.12.2006
Где: Беларусь, г. Минс к

Репутация: -1
Всего: -1

Akella,

Цитата

значит эти координаты равны нулю

Ранее я писал

Цитата

При трассировке кода и в первом и в последующих вызовах списка координаты одинаковы.

Это значит что координаты всегда указывались правильные и при первом вызове и при последующих. Только при первом вызове список отображался в левом углу хотя координаты P.X, Y были отличными от тех где выводился список

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »