2017-06-05 20 views
3

Delphi XE2でDevExpress QuantumGrid(MasterView)の古代の前駆体を使用していて、特定のセルを効果的にハイパーリンクとして機能させたいそれらの上にあるときにcrDefaultをcrHandPointに設定し、クリック時にアクションをトリガーします)。他のカーソル設定コードに影響を与えずに特定のコンポーネント上でマウスカーソルを変更

グリッドコンポーネントの設定は、個々のセルが独自のコンポーネントではなく、マウスカーソルの座標からセルを見つけてそこからカーソルを設定する必要があります。

これを達成するためにグリッドオブジェクトにいくつかのイベントを設定する必要があると思いますが、これらのイベントが長時間実行されているときにカーソルを砂時計に設定するコードとどのように作用するか少し不快です現在はIDisposibleを使って処理され、終了時にカーソルが元の状態に戻されます)、開始する前にこれを行うより良い方法があるかどうかを再確認したいのですが、マウスカーソルを間違った状態。

私はオーバーライドする必要があると思う:

  • omMouseMove - XY座標を取得し、手にカーソルを設定/
  • れるonmousedown矢印 - 存在する場合(XY座標と「アクティブ」のハイパーリンクを取得おそらく矢印に戻りますか?ハイパーリンクは通常新しいウィンドウを開き、呼び出されたコードはカーソルを砂時計に変更することがあります)
  • onMouseLeave - カーソルを矢印にリセットします(このイベントは実際には公開されていません。) 手動でメッセージを処理する)

この種の機能はTButtonではデフォルトとして提供されていますが、VCLでは一見したところでどのように達成されたのか分かりませんでしたし、基礎をなすWindowsコントロールの機能かもしれません。

+1

ハンドル[ 'WM_SETCURSOR'](https://msdn.microsoft.com/en-us/library/windows/desktop/ms648382.aspxは) –

+0

は多分これは役立ちます:https://でスタックオーバーフロー。com/questions/19257237/reset-cursor-in-wm-setcursorハンドラが正しく –

+0

またはhttps://stackoverflow.com/q/19570880/8041231 – Victoria

答えて

0

SO周りのブラウズ中に私が実際に解決策を見つけました。

私は、ポインタがにカーソルを変更するのMouseMoveをオーバーライドすることによって、それら(つまり、ボタンの動作)

の上にあるときのコンポーネントは通常、彼らは正しいマウスカーソルの種類を設定する方法である、独自のCursorプロパティを持っていることを忘れていcrHandPointハイパーリンクのセル上にあり、ハイパーリンクを越えていない場合に元のカーソルプロパティを保存すると、正常に動作するように見えます(長時間実行されるコードで設定されたscreen.cursorとは別です)。コードが正常に動作することを確認するためにコードを完成させる必要があるので、私が期待どおりに動作することを確認するまで、未回答のまま残しておきます。

編集:コードを追加。私は、インターセプタクラスを使用することに決めました。グリッドをサブクラス化してコントロールを登録する必要はありません。私は、1つのアプリケーションで1つまたは2つの場所でしか使用しないで、他のマシンをセットアップする必要はありません。

TdxMasterView = class(dxMasterView.TdxMasterView) 
private 
    FDefaultCursor: TCursor; 
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; 
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; 
public 
    constructor Create(AOwner: TComponent); override; 
end; 

constructor TdxMasterView.Create(AOwner: TComponent); 
begin 
    inherited create(AOwner); 
    FDefaultCursor := self.Cursor; 
end; 

procedure TdxMasterView.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 
var 
    lvHitTestCode: TdxMasterViewHitTestCode; 
    lvNode : TdxMasterViewNode; 
    lvColumn: TdxMasterViewColumn; 
    lvRowIndex, lvColIndex: integer; 
begin 
    inherited; 
    lvHitTestCode := self.GetHitTestInfo(Point(X,Y), 
              lvNode, 
              lvColumn, 
              lvRowIndex, 
              lvColIndex); 
    if (lvHitTestCode = htContent) and (lvColumn is TMasterViewClickableColumn) then 
    begin 
    TMasterViewClickableColumn(lvColumn).onClickContentCell(lvNode); 
    end; 
end; 

procedure TdxMasterView.MouseMove(Shift: TShiftState; X, Y: Integer); 
var 
    lvHitTestCode: TdxMasterViewHitTestCode; 
    lvNode : TdxMasterViewNode; 
    lvColumn: TdxMasterViewColumn; 
    lvRowIndex, lvColIndex: integer; 
begin 
    inherited; 
    lvHitTestCode := self.GetHitTestInfo(Point(X,Y), 
              lvNode, 
              lvColumn, 
              lvRowIndex, 
              lvColIndex); 
    if (lvHitTestCode = htContent) and (lvColumn is TMasterViewClickableColumn) then 
    begin 
    self.cursor := TMasterViewClickableColumn(lvColumn).cursorOnMouseOver; 
    end 
    else 
    begin 
    self.cursor := self.FDefaultCursor; 
    end; 
end; 
+0

グリッド自体が 'WM_SETCURSOR'メッセージを処理していると思いますメッセージハンドラの 'HitTest'パラメータが' HTCLIENT'のときにヒットテストをテストします。もしそうなら、私はその方法に従い、ちょうどヒットテストメソッドを拡張し、疑似コード 'if(Msg.HitTest = HTCLIENT)と(GetHitTest()= htLinkHover)で次にChangeToMyCursorを継承しました。 – Victoria

+0

@Victoria TControlの祖先から発信される 'Cursor'プロパティは、WM_SETCURSORウィンドウメッセージの周りのラッパーにすぎません。変更された場合、プロパティにはWM_SETCURSORへの呼び出しを処理するセッターがあります。私はちょうど古いカーソルを保持するために特別なFOriginalCursorプロパティを作成し、VCLに必要な呼び出しを処理させます。私はいくつかのコードをポップするために私の答えを編集するが、私はそれがより簡単な解決策だと思う。 –

+0

グリッド元のコードを変更していると思いました。もしそうなら、あなたは私が書いたものに従うかもしれません。私の答えで述べたように、 'WM_SETCURSOR'メッセージハンドラの中で' inherited'を呼び出すことはデフォルトの 'Cursor'に"デフォルト "します。それはラッパーではありません。メッセージングシステムはカーソルを要求し、あなた自身でそれを設定するか、または「継承」を呼び出してVCLにデフォルトジョブを実行させます。 – Victoria

1

これは私が好むシナリオです。カーソルは、WM_SETCURSORメッセージハンドラから設定され、バックエンドの作業はフラグによって通知されます。リンクのクリックは、MouseDownメソッドオーバーライドから処理されます。カーソルは、このコントロール(マウスカーソルがコントロールをホバーしているとき)に対してのみ変更されることに注意してください。擬似コードで:

type 
    THitCode = 
    (
    hcHeader, 
    hcGridCell, 
    hcHyperLink { ← this is the extension } 
); 

    THitInfo = record 
    HitRow: Integer; 
    HitCol: Integer; 
    HitCode: THitCode; 
    end; 

    TMadeUpGrid = class(TGridAncestor) 
    private 
    FWorking: Boolean; 
    procedure DoStartWork; 
    procedure DoFinishWork; 
    procedure UpdateCursor; 
    procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR; 
    protected 
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; 
    public 
    function GetHitTest(X, Y: Integer): THitInfo; override; 
    end; 

implementation 

procedure TMadeUpGrid.DoStartWork; 
begin 
    FWorking := True; 
    UpdateCursor; 
end; 

procedure TMadeUpGrid.DoFinishWork; 
begin 
    FWorking := False; 
    UpdateCursor; 
end; 

procedure TMadeUpGrid.UpdateCursor; 
begin 
    Perform(CM_CURSORCHANGED, 0, 0); { ← triggers WM_SETCURSOR handler if needed } 
end; 

procedure TMadeUpGrid.WMSetCursor(var Msg: TWMSetCursor); 
var 
    P: TPoint; 
    HitInfo: THitInfo; 
begin 
    { the mouse is inside the control client rect, inherited call here should 
    "default" to the Cursor property cursor type } 
    if Msg.HitTest = HTCLIENT then 
    begin 
    GetCursorPos(P); 
    P := ScreenToClient(P); 
    HitInfo := GetHitTest(P.X, P.Y); 
    { if the mouse is hovering a hyperlink or the grid backend is working } 
    if FWorking or (HitInfo.HitCode = hcHyperLink) then 
    begin 
     { here you can setup the "temporary" cursor for the hyperlink, or 
     for the working grid backend } 
     if not FWorking then 
     SetCursor(Screen.Cursors[crHandPoint]) 
     else 
     SetCursor(Screen.Cursors[crHourGlass]); 
     { tell the messaging system that this message has been handled } 
     Msg.Result := 1; 
    end 
    else 
     inherited; 
    end 
    else 
    inherited; 
end; 

procedure TMadeUpGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 
var 
    HitInfo: THitInfo; 
begin 
    if Button = mbLeft then 
    begin 
    HitInfo := GetHitTest(X, Y); 
    { the left mouse button was pressed when hovering the hyperlink, so set 
     the working flag, trigger the WM_SETCURSOR handler "manually" and do the 
     navigation; when you finish the work, call DoFinishWork (from the main 
     thread context) } 
    if HitInfo.HitCode = hcHyperLink then 
    begin 
     DoStartWork; 
     DoSomeNavigation(HitInfo.HitRow, HitInfo.HitCol); 
    end; 
    end; 
end; 

function TMadeUpGrid.GetHitTest(X, Y: Integer): THitInfo; 
begin 
    { fill the Result structure properly } 
end; 
関連する問題