Zmiana kursora jak wcisniety lewy przycisk myszy

0

Chciałbym dla jednego okna (albo całej aplikacji) zmienić sposób rysowania kursora myszki

Jak lewy przycisk myszy jest wciśnięty to np. crHourGlass
Jak lewy przycisk NIE jest wciśnięty to nie rysuje kursora myszy

I taki eksperyment z użyciem TIMERA

procedure TForm13.Timer1Timer(Sender: TObject);
begin
  if GetAsyncKeyState(VK_LBUTTON) = -32768 then   // -32768 =  0xFFFFFFFFFFFF8000
  begin
    Cursor := crHourGlass;
  end
  else
  begin
    Cursor := crNone
  end;
end;

crHourGlass sie pokazuje tylko na chwile jak puszczam kursor myszki a nie jest rysowany caly czas jak wciskam LPM

Dlaczego taka dziwna potrzeba:

  • interfejs uzytkownika jest dotykowy (ale nie multitouch tylko emulacja myszy)
  • kursor myszy zasłania to co jest na ekranie , ale jest potrzebny jak dotykamy ekranu i chcemy cos zmienić w aplikacji
1

OnMouseDown i OnMouseUp.

0

Na moje oko to nie działa prawidłowo bo zawsze jest kursor ustawiony w OnMouseUp

procedure TForm15.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Cursor := crHourGlass;
end;

procedure TForm15.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Cursor := crNone;
end;
0

Nie ustawiaj crNone, bo on oznacza brak kursora. Ustawiaj albo crDefault, albo jawnie crArrow.

0

ja mam trochę niestandardowe(dziwne) potrzeby i niestandardowa platformę sprzętową,
komputer wbudowany w urządzenie z ekranem dotykowym.
Ekran jest dotykowy ale w starej technologii wiec ma tylko jeden punkt i z punktu widzenia OS to myszka
, chciałbym aby kursor myszy zachowywał się podobnie jak kursor na panelu dotykowym i był rysowany tylko wtedy gdy użytkownik dotyka ekranu palcem.

Użytkownik naciska palec na ekranie kursor się pokazuje
Użytkownik odrywa palec od ekranu kursor się ukrywa

3

Jak urządzenie działa pod Windows to może spróbuj:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs;

type
  TForm1 = class(TForm)
  protected
     procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
     procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.WMLButtonDown(var Message: TWMLButtonDown);
begin
  Cursor:= crHandPoint; //albo crHourGlass
  inherited;
end;

procedure TForm1.WMLButtonUp(var Message: TWMLButtonUp);
begin
  Cursor:= crDefault; //albo crNone
  inherited;
end;


end.
0

DZIAŁA ! Dziękuje bardzo !

A to teraz pytanie z wrodzonej ciekawosci ?

Dlaczego to samo nie działa w onMouseDown onMouseUp ? To chyba ten sam "message" tylko troche opakowany przez VCL

procedure TControl.WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
DoMouseDown -> MouseDown -> FOnMouseDown -> TForm15.FormMouseDown

4

Nie wiem trzeba by analizować kod VCL, bo widać tam coś mieszają skoro bezpośrednie wywołanie zmiany kursora w WinApi zadziała:

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  cursorHandle: HCURSOR;
begin
  cursorHandle:= Winapi.Windows.LoadCursor(0, IDC_HAND);
  Winapi.Windows.SetCursor(cursorHandle);
end;

Co ciekawe działa też

procedure TForm2.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Screen.Cursor:= crHandPoint;
end;

procedure TForm2.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Screen.Cursor:= crDefault;
end;

a dla okna (nie obiektu Screen nie chce).

0

Finalne rozwiązanie globalnie dla całej aplikacji

procedure TForm13.AppMessage(var Msg: TMsg; var Handled: Boolean);
var msgStr: String;
begin
  if (Msg.message = WM_LBUTTONUP) then
  begin
    Screen.Cursor:= crHourGlass;
  end
  else if (Msg.message = WM_LBUTTONDOWN) then
  begin
    Screen.Cursor:= crHandPoint;
  end;
end;


procedure TForm13.FormCreate(Sender: TObject);
begin
  Application.OnMessage := AppMessage;
end;
0

Z tego co pamiętam, w LCL był ten sam problem z dynamiczną zmianą kursora okna (może nadal jest — nie sprawdzałem) i jedynym rozwiązaniem aby faktycznie zadziałało, była zmiana nie Form.Cursor, a właśnie Screen.Cursor. I teraz ciekawe czy dlatego, że LCL jest zgodny z VCL, czy może takie zachowanie definiuje system.

1 użytkowników online, w tym zalogowanych: 0, gości: 1