Mauscursor ändern [gelöst]
-
- Beiträge: 185
- Registriert: Fr 18. Jan 2013, 09:29
- OS, Lazarus, FPC: Windows 10, Windows XP, Lazarus 1.6
- CPU-Target: Celeron
Mauscursor ändern [gelöst]
Hallo zusammen
man kann ja mit z.B. screen.cursor := crHourGlass; den cursor ändern.
Wo finde ich die anderen Definitionen, die mir zur Verfügung stehen.
Könnte ich einen Mauszeiger auch selbst definieren wenn kein passender dabei ist?
Und wenn ja, wie geht das dann.
Gruß Fritz
man kann ja mit z.B. screen.cursor := crHourGlass; den cursor ändern.
Wo finde ich die anderen Definitionen, die mir zur Verfügung stehen.
Könnte ich einen Mauszeiger auch selbst definieren wenn kein passender dabei ist?
Und wenn ja, wie geht das dann.
Gruß Fritz
Zuletzt geändert von haderlump am Mo 22. Apr 2019, 05:11, insgesamt 1-mal geändert.
- Niesi
- Lazarusforum e. V.
- Beiträge: 334
- Registriert: So 26. Jun 2016, 19:44
- OS, Lazarus, FPC: Linux Mint Cinnamon (Windows wenn notwendig), Lazarus 3.0 FPC 3.3.1
Re: Mauscursor ändern
Guten Morgen,
bei mir funktioniert das ( mehr Info unter http://wiki.freepascal.org/Cursor ):
Beste Grüße
Harald
bei mir funktioniert das ( mehr Info unter http://wiki.freepascal.org/Cursor ):
Code: Alles auswählen
unit main;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Menus;
type
{ TForm1 }
TForm1 = class(TForm)
MainMenu1: TMainMenu;
MenuItem1: TMenuItem;
MenuItem2: TMenuItem;
MenuItem3: TMenuItem;
MenuItem4: TMenuItem;
MenuItem5: TMenuItem;
N1: TMenuItem;
procedure MenuItem2Click(Sender: TObject);
procedure MenuItem4Click(Sender: TObject);
procedure MenuItem5Click(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.MenuItem2Click(Sender: TObject);
begin
Close;
end;
procedure TForm1.MenuItem4Click(Sender: TObject);
begin
Cursor := crDefault;
end;
procedure TForm1.MenuItem5Click(Sender: TObject);
begin
Cursor := crCross;
end;
end.
Beste Grüße
Harald
Wissen ist das einzige Gut, das sich vermehrt, wenn es geteilt wird ...
- Niesi
- Lazarusforum e. V.
- Beiträge: 334
- Registriert: So 26. Jun 2016, 19:44
- OS, Lazarus, FPC: Linux Mint Cinnamon (Windows wenn notwendig), Lazarus 3.0 FPC 3.3.1
Re: Mauscursor ändern
Moin,
was ich fast vergessen hätte: Mausformänderungen beziehen sich immer auf das entsprechende Objekt - wenn Du also z. B. ein Memo auf der Form hast, dann musst Du für das Memo den Cursor extra ändern ....
was ich fast vergessen hätte: Mausformänderungen beziehen sich immer auf das entsprechende Objekt - wenn Du also z. B. ein Memo auf der Form hast, dann musst Du für das Memo den Cursor extra ändern ....
Code: Alles auswählen
unit main;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Menus, StdCtrls;
type
{ TMainForm }
TMainForm = class(TForm)
MainMenu1: TMainMenu;
MainForm: TMenuItem;
MenuItem4: TMenuItem;
MenuItem5: TMenuItem;
MenuItem6: TMenuItem;
MenuItem7: TMenuItem;
MenuItem8: TMenuItem;
MyMemo: TMemo;
MenuItem1: TMenuItem;
MenuItem2: TMenuItem;
MenuItem3: TMenuItem;
N1: TMenuItem;
procedure MenuItem2Click(Sender: TObject);
procedure MenuItem5Click(Sender: TObject);
procedure MenuItem6Click(Sender: TObject);
procedure MenuItem7Click(Sender: TObject);
procedure MenuItem8Click(Sender: TObject);
private
public
end;
var
MainForm: TMainForm;
implementation
{$R *.lfm}
{ TMainForm }
procedure TMainForm.MenuItem2Click(Sender: TObject);
begin
Close;
end;
procedure TMainForm.MenuItem5Click(Sender: TObject);
begin
MyMemo.Cursor := crDefault;
end;
procedure TMainForm.MenuItem6Click(Sender: TObject);
begin
Cursor := crDefault;
end;
procedure TMainForm.MenuItem7Click(Sender: TObject);
begin
Cursor := crCross;
end;
procedure TMainForm.MenuItem8Click(Sender: TObject);
begin
MyMemo.Cursor := crSize;
end;
end.
Wissen ist das einzige Gut, das sich vermehrt, wenn es geteilt wird ...
- fliegermichl
- Lazarusforum e. V.
- Beiträge: 1435
- Registriert: Do 9. Jun 2011, 09:42
- OS, Lazarus, FPC: Lazarus Fixes FPC Stable
- CPU-Target: 32/64Bit
- Wohnort: Echzell
Re: Mauscursor ändern
Zum einen haben die Windowscontrols (Formulare / Groupboxen, Labels usw. alle eine Eigenschaft "Cursor". Wenn man auf das Listensymbol im Objektinspektor klickt, bekommt man alle verfügbaren Standardcursor zur Auswahl.
Man kann auch eigene Cursor erstellen. Das kann man z.B. hier direkt Online machen. https://www.cursor.cc/
Nachdem man den Cursor erstellt und die sog. sensitive Zone festgelegt hat, speichert man den Cursor in einer Datei cursor.cur.
Jetzt muss die in eine Resourcendatei hinein. Dafür kann man z.B. lazres.exe im Tools Verzeichnis deiner Lazarus Installation verwenden.
In deinem Programm muss die cursor.res mit
eingebunden werden. Während der Programminitialisierung muss die Resource dann in den Arbeitsspeicher geladen werden. Dazu kann z.B. im FormCreate folgender Code verwendet werden:
Man kann auch eigene Cursor erstellen. Das kann man z.B. hier direkt Online machen. https://www.cursor.cc/
Nachdem man den Cursor erstellt und die sog. sensitive Zone festgelegt hat, speichert man den Cursor in einer Datei cursor.cur.
Jetzt muss die in eine Resourcendatei hinein. Dafür kann man z.B. lazres.exe im Tools Verzeichnis deiner Lazarus Installation verwenden.
Code: Alles auswählen
c:\lazarus\tools\lazres.exe cursor.res cursor.cur=MYCURSOR
In deinem Programm muss die cursor.res mit
Code: Alles auswählen
{$R cursor.res}
eingebunden werden. Während der Programminitialisierung muss die Resource dann in den Arbeitsspeicher geladen werden. Dazu kann z.B. im FormCreate folgender Code verwendet werden:
Code: Alles auswählen
const crMyCursor = 1234;
procedure TForm1.FormCreate(Sender: TObject);
begin
Screen.Cursors[crMyCursor] := LoadCursor(hInstance, 'MYCURSOR');
Cursor := crMyCursor;
end;
-
- Beiträge: 185
- Registriert: Fr 18. Jan 2013, 09:29
- OS, Lazarus, FPC: Windows 10, Windows XP, Lazarus 1.6
- CPU-Target: Celeron
Re: Mauscursor ändern
Suoeroberaffenturbogeil. Hat auf Anhieb funktioniert.
Fliegermichel: Ich habe entsprechend deiner Anleitung 4 neue Cursors erstellt.
Herzlichen Dank, auch an die anderen Beitragschreiber.
Gruß Fritz
Fliegermichel: Ich habe entsprechend deiner Anleitung 4 neue Cursors erstellt.
Herzlichen Dank, auch an die anderen Beitragschreiber.
Gruß Fritz
- h-elsner
- Lazarusforum e. V.
- Beiträge: 259
- Registriert: Di 24. Jul 2012, 15:42
- OS, Lazarus, FPC: LINUX Mint21.1, Win10, Lazarus 2.2.4, FPC3.2.2
- CPU-Target: X86-64; arm 32bit
- Wohnort: Illertissen
- Kontaktdaten:
Re: Mauscursor ändern [gelöst]
Und die bereits vorhandenen Kursors sind hier gelistet:
http://wiki.freepascal.org/Cursor
http://wiki.freepascal.org/Cursor
- fliegermichl
- Lazarusforum e. V.
- Beiträge: 1435
- Registriert: Do 9. Jun 2011, 09:42
- OS, Lazarus, FPC: Lazarus Fixes FPC Stable
- CPU-Target: 32/64Bit
- Wohnort: Echzell
Re: Mauscursor ändern [gelöst]
Man kann sogar den Mauscursor zur Laufzeit erstellen. Ich habe z.B. für mein CAD Programm einen Mauscursor crFadenkreuz. Der Anwender kann den Bereich in dem ein Punkt gefangen werden soll selbst festlegen. Der Fangbereich wird in einem Konfigurationsrecord der "Anwender" heisst gespeichert. Mit der folgenden Routine erstelle ich dann einen entsprechenden Cursor. (Image1 ist eine PaintBox in der die aktuelle Zeichnung angezeigt wird)
Soweit ich weiss allerdings Windows only
Soweit ich weiss allerdings Windows only
Code: Alles auswählen
procedure TMassen.CreateFangCursor;
var w, h : integer;
a, o : array[0..31] of array[0..3] of Byte;
i : integer;
// Mode = 0 Schwarz
// Mode = 1 Weiss
// Mode = 2 Screen (Transparent)
// Mode = 3 Screen invers
procedure SetPixel(x, y, Mode : integer);
var sv : integer;
begin
sv := x mod 8;
case Mode of
0 : begin
o[y, x div 8] := o[y, x div 8] and not (128 shr sv);
a[y, x div 8] := a[y, x div 8] and not (128 shr sv);
end;
end;
end;
begin
w := GetSystemMetrics(SM_CXCURSOR);
h := GetSystemMetrics(SM_CYCURSOR);
FillChar(a, SizeOf(a), 255);
FillChar(o, SizeOf(o), 0);
for i := 0 to 31 do SetPixel(i, 15, 0); // Waagerechte Linie
for i := 0 to 31 do SetPixel(15, i, 0); // Senkrechte Linie
for i := 15 - Anwender.poFangbereich to 15 + Anwender.poFangBereich do // Obere Kastenlinie
SetPixel(i, 15 - Anwender.poFangBereich, 0);
for i := 16 - Anwender.poFangbereich to 14 + Anwender.poFangbereich do
begin
SetPixel(15 - Anwender.poFangBereich, i, 0);
SetPixel(15 + Anwender.poFangBereich, i, 0);
end;
for i := 15 - Anwender.poFangbereich to 15 + Anwender.poFangBereich do // Obere Kastenlinie
SetPixel(i, 15 + Anwender.poFangBereich, 0);
DestroyCursor(Screen.Cursors[crFadenkreuz]);
Screen.Cursors[crFadenKreuz] := CreateCursor(hInstance, w div 2, h div 2, w, h, @a, @o);
Image1.Cursor := crDefault;
Image1.Cursor := crFadenkreuz;
Image1.Invalidate;
end;