2

ツリービューをポップアップするカスタムコンボボックスコントロールを作成しようとしています。すべてがうまく見えます。しかし、そのコントロールにランタイムサイズ変更機能を追加しようとすると、ポップアップウィンドウ（Treeview）が移動するだけで、サイズは変更されません。

任意の提案をいただければ幸いです。

ポップアップウィンドウのスニペット：

作成時：

ControlStyle := ControlStyle + [csNoDesignVisible, csReplicatable, csDoubleClicks];

パラメータの作成について：

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; {this would prevent ondoubleclick event}
  end;

マウス移動時：

var
  ARect, RR: TRect;
  DragStyle: TDragStyle;
  Procedure SetDragStyle(ds:TDragStyle; c:TCursor);
  begin
    FDragStyle:=ds;
    Cursor:=c;
  end;
begin
  inherited;
  FMouseMoveSelected := GetNodeAt(x, y);
  if FDragged then begin
    case FDragStyle of
       dsSizeLeft :begin
                      SetWindowPos(Handle, HWND_TOP, Left+(x-FDragPos.X), Top, Width, Height,
                        SWP_NOACTIVATE or SWP_SHOWWINDOW);
                      //Left:=Left+(x-FDragPos.X); {alternate code that doesn't work either}
                   end;
    end;
    FDragPos:=Point(x,y);
  end else begin
    SetDragStyle(dsMove,crDefault);
    ARect := GetClientRect;
    RR:=ARect;
    InflateRect(RR,-2,-2);
    if (x>=0) and (x<=Width) and (y>=0) and (y<=Height) and (not PtInRect(RR,Point(x,y))) then begin
      if (x<=RR.Left) then begin
        //if (y<=RR.Top) then SetDragStyle(dsSizeTopLeft,crSizeNWSE)else
        if (y>=RR.Bottom) then SetDragStyle(dsSizeBottomLeft,crSizeNESW)
        else SetDragStyle(dsSizeLeft,crSizeWE); 
      end else if (x>=RR.Right) then begin
        //if (y<=RR.Top) then SetDragStyle(dsSizeTopRight,crSizeNESW) else
        if (y>=RR.Bottom) then SetDragStyle(dsSizeBottomRight,crSizeNWSE)
        else SetDragStyle(dsSizeRight,crSizeWE);
      end else begin
        //if (y<=RR.Top) then SetDragStyle(dsSizeTop,crSizeNS) else
        if (y>=RR.Bottom) then SetDragStyle(dsSizeBottom,crSizeNS)
        else SetDragStyle(dsMove,crDefault);
      end;
    end;
  end;
end;
end;

マウスダウン時：

begin
  inherited;
  if FDragStyle<>dsMove then begin
    FDragPos:=point(x,y);
    FDragged:=true;
  end;
end;

マウスアップ時：

begin
  inherited;
  FDragged:=false;
end;
4

1 に答える 1

4

通話では、クライアントの座標と画面の座標を混在させていSetWindowPosます。これは、フロートするはずのないウィンドウをフローティングしていて、VCLがそれを認識していないためです。そのを参照するLeftと、VCLはその親（おそらくフォーム）を基準にした座標を返します。また、ドラッグ中にドラッグを開始したときに保存したポイント（FDragPos）は変更しないでください。

procedure TPanel.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  ARect, RR: TRect;
  DragStyle: TDragStyle;

  Procedure SetDragStyle(ds:TDragStyle; c:TCursor);
  begin
    FDragStyle:=ds;
    Cursor:=c;
  end;

  var
    DragOffset: Integer;
begin
  inherited;
  FMouseMoveSelected := GetNodeAt(x, y);
  if FDragged then begin
    case FDragStyle of
       dsSizeLeft:
         begin
            DragOffset := X - FDragPos.X;
            winapi.windows.GetWindowRect(Handle, ARect);
            SetWindowPos(Handle, HWND_TOP,
                                  ARect.Left + DragOffset,
                                  ARect.Top,
                                  ARect.Right - ARect.Left - DragOffset,
                                  ARect.Bottom - ARect.Top,
                                  SWP_NOACTIVATE or SWP_SHOWWINDOW);
            //Left:=Left+(x-FDragPos.X); {alternate code that doesn't work either}
         end;
    end;
//    FDragPos:=Point(x,y);  // do not change drag origin while you're dragging
  end else begin
    ..
于 2012-05-05T20:43:53.363 に答える