diff --git a/components/chmhelp/democontrol/helpconnectionunit1.pas b/components/chmhelp/democontrol/helpconnectionunit1.pas
index f99a8ec3fa..c8dad9409b 100644
--- a/components/chmhelp/democontrol/helpconnectionunit1.pas
+++ b/components/chmhelp/democontrol/helpconnectionunit1.pas
@@ -51,13 +51,13 @@ var
begin
OpenDialog1.InitialDir:=GetCurrentDirUTF8;
if not OpenDialog1.Execute then exit;
- Screen.Cursor := crHourGlass;
+ Screen.BeginWaitCursor;
try
if Help.ServerRunning = false then
Help.StartHelpServer(IPCFile, GetLHelpFilename);
Res := Help.OpenFile(OpenDialog1.FileName);
finally
- Screen.Cursor := crDefault;
+ Screen.EndWaitCursor;
end;
Label1.Caption := ResponseToString(Res);
end;
diff --git a/components/lazutils/examples/LookupStringList/main.pas b/components/lazutils/examples/LookupStringList/main.pas
index fd92346c3c..33e1066f8c 100644
--- a/components/lazutils/examples/LookupStringList/main.pas
+++ b/components/lazutils/examples/LookupStringList/main.pas
@@ -63,7 +63,7 @@ begin
UpdateTime(0);
Memo.Clear;
Application.ProcessMessages;
- Screen.Cursor := crHourGlass;
+ Screen.BeginWaitCursor;
try
InList.Clear;
for i := 0 to SpinEdit1.Value - 1 do
@@ -75,7 +75,7 @@ begin
end;
Memo.Lines.Assign(inList);
finally
- Screen.Cursor := crDefault;
+ Screen.EndWaitCursor;
end;
end;
@@ -84,7 +84,7 @@ var
DSL :TLookupStringList;
T :TDateTime;
begin
- Screen.Cursor := crHourGlass;
+ Screen.BeginWaitCursor;
try
T := Now;
DSL := TLookupStringList.Create;
@@ -97,7 +97,7 @@ begin
end;
UpdateTime(Now - T);
finally
- Screen.Cursor := crDefault;
+ Screen.EndWaitCursor;
end;
end;
diff --git a/components/onlinepackagemanager/opkman_mainfrm.pas b/components/onlinepackagemanager/opkman_mainfrm.pas
index 9bdd8c3f4d..a7f0294053 100644
--- a/components/onlinepackagemanager/opkman_mainfrm.pas
+++ b/components/onlinepackagemanager/opkman_mainfrm.pas
@@ -1030,11 +1030,11 @@ var
begin
if MessageDlgEx(rsMainFrm_rsRepositoryCleanup0, mtInformation, [mbYes, mbNo], Self) = mrYes then
begin
- Screen.Cursor := crHourGlass;
+ Screen.BeginWaitCursor;
try
Cnt := SerializablePackages.Cleanup;
finally
- Screen.Cursor := crDefault;
+ Screen.EndWaitCursor;
end;
MessageDlgEx(Format(rsMainFrm_rsRepositoryCleanup1, [IntToStr(Cnt)]),
mtInformation, [mbOk], Self);
diff --git a/components/pochecker/graphstat.pp b/components/pochecker/graphstat.pp
index bd09655c43..ce0e464b03 100644
--- a/components/pochecker/graphstat.pp
+++ b/components/pochecker/graphstat.pp
@@ -398,15 +398,13 @@ var
Bmp: TBitmap;
AStat: TStat;
Index: Integer;
- Cur: TCursor;
begin
if Assigned(FImgList) then FImgList.Free;
FImgList := TImageList.CreateSize(BmpWH, BmpWH);
ListView.Clear;
ListView.LargeImages := FImgList;
ListView.BeginUpdate;
- Cur := Screen.Cursor;
- Screen.Cursor := crHourGlass;
+ Screen.BeginWaitCursor;
try
StatusLabel.Visible := True;
for Index := 0 to FPoFamilyStats.Count - 1 do
@@ -429,7 +427,7 @@ begin
end;
finally
ListView.EndUpdate;
- Screen.Cursor := Cur;
+ Screen.EndWaitCursor;
StatusLabel.Visible := False;
end;
end;
diff --git a/components/pochecker/pocheckermain.pp b/components/pochecker/pocheckermain.pp
index 7589addef7..f8d2cb5fad 100644
--- a/components/pochecker/pocheckermain.pp
+++ b/components/pochecker/pocheckermain.pp
@@ -322,10 +322,8 @@ var
SL, ML, OL, CurFiles, MissingFiles: TStringList;
i: Integer;
S, Mn: String;
- Cur: TCursor;
begin
- Cur := Screen.Cursor;
- Screen.Cursor := crHourGlass;
+ Screen.BeginWaitCursor;
StatusBar.SimpleText := sScanningInProgress;
try
ML := FindAllFiles(ADir, '*.pot', True);
@@ -376,7 +374,7 @@ begin
MissingFiles.Free;
SL.Free;
StatusBar.SimpleText := '';
- Screen.Cursor := Cur;
+ Screen.EndWaitCursor;
end;
end;
diff --git a/components/todolist/todolist.pas b/components/todolist/todolist.pas
index 1090030013..73694f0f7f 100644
--- a/components/todolist/todolist.pas
+++ b/components/todolist/todolist.pas
@@ -276,7 +276,7 @@ begin
if fUpdating then Exit;
LazarusIDE.SaveSourceEditorChangesToCodeCache(nil);
- Screen.Cursor:=crHourGlass;
+ Screen.BeginWaitCursor;
lvTodo.BeginUpdate;
Units:=nil;
try
@@ -324,7 +324,7 @@ begin
Units.Free;
CodeToolBoss.DeactivateWriteLock;
lvTodo.EndUpdate;
- Screen.Cursor:=crDefault;
+ Screen.EndWaitCursor;
fUpdating:=False;
end;
end;
diff --git a/converter/chgencodingdlg.pas b/converter/chgencodingdlg.pas
index fa1730d349..276b9a0a52 100644
--- a/converter/chgencodingdlg.pas
+++ b/converter/chgencodingdlg.pas
@@ -366,7 +366,7 @@ var
HasFiles: Boolean;
IsDone: Boolean;
begin
- Screen.Cursor:=crHourGlass;
+ Screen.BeginWaitCursor;
try
HasFiles:=GetFiles;
PreviewListView.Items.Clear;
@@ -396,7 +396,7 @@ begin
Format(lisNumberOfFilesToConvert, [IntToStr(PreviewListView.Items.Count)]);
ApplyButton.Enabled:=True;
finally
- Screen.Cursor:=crDefault;
+ Screen.EndWaitCursor;
end;
end;
diff --git a/converter/convertdelphi.pas b/converter/convertdelphi.pas
index ab57ad3af2..35049c612e 100644
--- a/converter/convertdelphi.pas
+++ b/converter/convertdelphi.pas
@@ -1104,7 +1104,7 @@ begin
DebugLn('');
DebugLn('TConvertDelphiProjPack.ConvertAllFormFiles: '+lisConvDelphiRepairingFormFiles);
end;
- Screen.Cursor:=crHourGlass;
+ Screen.BeginWaitCursor;
try
for i:=0 to ConverterList.Count-1 do begin
Converter:=TDelphiUnit(ConverterList[i]); // Converter created in cycle1.
@@ -1117,7 +1117,7 @@ begin
if Result<>mrOK then exit;
end;
finally
- Screen.Cursor:=crDefault;
+ Screen.EndWaitCursor;
end;
Result:=mrOK;
end;
@@ -1601,7 +1601,7 @@ var
p: LongInt;
ui: TUnitInfo;
begin
- Screen.Cursor:=crHourGlass;
+ Screen.BeginWaitCursor;
FoundUnits:=nil;
MisUnits:=nil;
NormalUnits:=nil;
@@ -1649,7 +1649,7 @@ begin
FoundUnits.Free;
MisUnits.Free;
NormalUnits.Free;
- Screen.Cursor:=crDefault;
+ Screen.EndWaitCursor;
end;
Result:=mrOK;
end;
diff --git a/converter/missingpropertiesdlg.pas b/converter/missingpropertiesdlg.pas
index ee9097e8c6..86e085a551 100644
--- a/converter/missingpropertiesdlg.pas
+++ b/converter/missingpropertiesdlg.pas
@@ -565,7 +565,6 @@ end;
function TLFMFixer.ShowConvertLFMWizard: TModalResult;
var
FixLFMDialog: TFixLFMDialog;
- PrevCursor: TCursor;
begin
Result:=mrCancel;
FixLFMDialog:=TFixLFMDialog.Create(nil, self);
@@ -579,14 +578,7 @@ begin
and ((fSettings.TypeReplaceMode=raAutomatic) or not fHasMissingObjectTypes) then
Result:=ReplaceAndRemoveAll // Can return mrRetry.
else begin
- // Cursor is earlier set to HourGlass. Show normal cursor while in dialog.
- PrevCursor:=Screen.Cursor;
- Screen.Cursor:=crDefault;
- try
- Result:=FixLFMDialog.ShowModal;
- finally
- Screen.Cursor:=PrevCursor;
- end;
+ Result:=FixLFMDialog.ShowModal;
end;
finally
FixLFMDialog.Free;
diff --git a/docs/xml/lcl/forms.xml b/docs/xml/lcl/forms.xml
index cdbafefca5..f95946d0b4 100644
--- a/docs/xml/lcl/forms.xml
+++ b/docs/xml/lcl/forms.xml
@@ -9973,6 +9973,15 @@
+
+ Override the Cursor property with a temporary value. Use EndTempCursor to release it.
+
+
+ Release the temporary cursor set with BeginTempCursor.
+
+
+ Get the Cursor property with taking temporary cursors into account.
+
diff --git a/examples/database/sqldbtutorial3/mainform.pas b/examples/database/sqldbtutorial3/mainform.pas
index 36218647ed..942b117572 100644
--- a/examples/database/sqldbtutorial3/mainform.pas
+++ b/examples/database/sqldbtutorial3/mainform.pas
@@ -135,7 +135,7 @@ var
begin
result:=false;
Conn:=TSQLConnector.Create(nil);
- Screen.Cursor:=crHourglass;
+ Screen.BeginWaitCursor;
try
// ...actual connector type is determined by this property.
// Make sure the ChosenConfig.DBType string matches
@@ -154,7 +154,7 @@ begin
end;
Conn.Close;
finally
- Screen.Cursor:=crDefault;
+ Screen.EndWaitCursor;
Conn.Free;
end;
end;
diff --git a/examples/database/tsqlscript/mainform.pas b/examples/database/tsqlscript/mainform.pas
index ab6e65a149..bde1166459 100644
--- a/examples/database/tsqlscript/mainform.pas
+++ b/examples/database/tsqlscript/mainform.pas
@@ -231,7 +231,7 @@ var
begin
result:=false;
Conn:=TSQLConnector.Create(nil);
- Screen.Cursor:=crHourglass;
+ Screen.BeginWaitCursor;
try
// ...actual connector type is determined by this property.
// Make sure the ChosenConfig.DBType string matches
@@ -250,7 +250,7 @@ begin
end;
Conn.Close;
finally
- Screen.Cursor:=crDefault;
+ Screen.EndWaitCursor;
Conn.Free;
end;
end;
diff --git a/examples/imgviewer/frmmain.pas b/examples/imgviewer/frmmain.pas
index 73150034e2..a9a793d560 100644
--- a/examples/imgviewer/frmmain.pas
+++ b/examples/imgviewer/frmmain.pas
@@ -212,7 +212,7 @@ var
begin
if SelectDirectory(SSelectImageDir, '/', Dir, true) then
begin
- Screen.Cursor := crHourglass; //Show user he may have to wait for big directories
+ Screen.BeginWaitCursor; //Show user he may have to wait for big directories
try
LBFiles.Items.BeginUpdate; //Indicate to the listbox that we're doing a lengthy operation
WasSorted:=LBFiles.Sorted;
@@ -221,7 +221,7 @@ begin
LBFiles.Sorted:=WasSorted;
finally
LBFiles.Items.EndUpdate;
- Screen.Cursor := crDefault;
+ Screen.EndWaitCursor;
end;
end;
end;
@@ -270,7 +270,7 @@ var
begin
if SelectDirectory(SSelectImageDirRec, '/', Dir, true) then
begin
- Screen.Cursor := crHourglass; //Show user he may have to wait for big directories
+ Screen.BeginWaitCursor; //Show user he may have to wait for big directories
try
LBFiles.Items.BeginUpdate; //Indicate to the listbox that we're doing a lengthy operation
WasSorted:=LBFiles.Sorted;
@@ -279,7 +279,7 @@ begin
LBFiles.Sorted:=WasSorted;
finally
LBFiles.Items.EndUpdate;
- Screen.Cursor := crDefault;
+ Screen.EndWaitCursor;
end;
end;
end;
@@ -461,14 +461,14 @@ begin
else
begin
S := ParamStrUTF8(I);
- Screen.Cursor := crHourglass; //Show user he may have to wait
+ Screen.BeginWaitCursor; //Show user he may have to wait
try
if DirectoryExistsUTF8(S) then
AddDir(ExpandFileNameUTF8(S), FRecursive)
else if FileExistsUTF8(S) then
AddFile(ExpandFileNameUTF8(S), LBFiles.Items.Count = 0);
finally
- Screen.Cursor := crDefault;
+ Screen.EndWaitCursor;
end;
end;
end;
diff --git a/ide/allcompileroptions.pas b/ide/allcompileroptions.pas
index 94480fd631..d0cd0b1480 100644
--- a/ide/allcompileroptions.pas
+++ b/ide/allcompileroptions.pas
@@ -163,7 +163,7 @@ var
begin
IdleConnected := False;
if FOptionsThread=nil then exit;
- Screen.Cursor := crHourGlass;
+ Screen.BeginWaitCursor;
try
FOptionsThread.EndParsing; // Make sure the options are read.
if FOptionsReader.ErrorMsg <> '' then
@@ -176,7 +176,7 @@ begin
FormatTimeWithMs(Now-StartTime)]));
end;
finally
- Screen.Cursor := crDefault;
+ Screen.EndWaitCursor;
end;
FRenderedOnce := True;
end;
diff --git a/ide/checkcompileropts.pas b/ide/checkcompileropts.pas
index a62e7fc18c..7e7eb8d236 100644
--- a/ide/checkcompileropts.pas
+++ b/ide/checkcompileropts.pas
@@ -886,7 +886,7 @@ begin
Target_PPUs:=nil;
FPC_PPUs:=nil;
IDEMessagesWindow.Clear;
- Screen.Cursor:=crHourGlass;
+ Screen.BeginWaitCursor;
try
// make sure there is no invalid cache due to bugs
InvalidateFileStateCache();
@@ -986,7 +986,7 @@ begin
AddMsg(lisCCOTestsSuccess,'',-1);
finally
- Screen.Cursor:=crDefault;
+ Screen.EndWaitCursor;
CompilerFiles.Free;
CompileTool.Free;
FTest:=cotNone;
diff --git a/ide/componentlist.pas b/ide/componentlist.pas
index 8cf25564de..4f70fc5ce4 100644
--- a/ide/componentlist.pas
+++ b/ide/componentlist.pas
@@ -394,7 +394,7 @@ var
CurIcon: TImageIndex;
begin
if [csDestroying,csLoading]*ComponentState<>[] then exit;
- Screen.Cursor := crHourGlass;
+ Screen.BeginWaitCursor;
ListTree.BeginUpdate;
PalletteTree.BeginUpdate;
InheritanceTree.Items.BeginUpdate;
@@ -446,7 +446,7 @@ begin
InheritanceTree.Items.EndUpdate;
PalletteTree.EndUpdate;
ListTree.EndUpdate;
- Screen.Cursor := crDefault;
+ Screen.EndWaitCursor;
end;
end;
diff --git a/ide/definesgui.pas b/ide/definesgui.pas
index c152ab1b6a..04521da7b8 100644
--- a/ide/definesgui.pas
+++ b/ide/definesgui.pas
@@ -159,7 +159,7 @@ var
i, ListInd: Integer;
begin
IdleConnected := False;
- Screen.Cursor := crHourGlass;
+ Screen.BeginWaitCursor;
try
FOptionsThread.EndParsing; // Make sure the options are read.
// Parse and separate defines from other options.
@@ -177,7 +177,7 @@ begin
DefinesCheckList.Checked[ListInd] := True;
end;
finally
- Screen.Cursor := crDefault;
+ Screen.EndWaitCursor;
end;
end;
diff --git a/ide/examplemanager.pas b/ide/examplemanager.pas
index da4ca77ebf..d8b2a21b0e 100644
--- a/ide/examplemanager.pas
+++ b/ide/examplemanager.pas
@@ -208,7 +208,7 @@ var
i, j: Integer;
LastDir: String;
begin
- Screen.Cursor:=crHourGlass;
+ Screen.BeginWaitCursor;
Searcher:=TListFileSearcher.Create(Self);
IncludedDirs:=TStringList.Create;
AllDirs:=Nil;
@@ -246,7 +246,7 @@ begin
AllDirs.Free;
IncludedDirs.Free;
Searcher.Free;
- Screen.Cursor:=crDefault;
+ Screen.EndWaitCursor;
end;
end;
diff --git a/ide/sourceeditor.pp b/ide/sourceeditor.pp
index df0c79f009..e7ec8d4513 100644
--- a/ide/sourceeditor.pp
+++ b/ide/sourceeditor.pp
@@ -9848,7 +9848,7 @@ begin
FUpdateFlags := [];
// Debugger cause ProcessMessages, which could lead to entering methods in unexpected order
DebugBoss.LockCommandProcessing;
- Screen.Cursor := crHourGlass;
+ Screen.BeginWaitCursor;
end;
inc(FUpdateLock);
end;
@@ -9858,7 +9858,7 @@ begin
dec(FUpdateLock);
if FUpdateLock = 0 then begin
try
- Screen.Cursor := crDefault;
+ Screen.EndWaitCursor;
if (ufShowWindowOnTop in FUpdateFlags) then
ShowActiveWindowOnTop(ufShowWindowOnTopFocus in FUpdateFlags);
if (ufMgrActiveEditorChanged in FUpdateFlags) then
diff --git a/ide/useunitdlg.pas b/ide/useunitdlg.pas
index 17342316ff..2498a1cba4 100644
--- a/ide/useunitdlg.pas
+++ b/ide/useunitdlg.pas
@@ -393,7 +393,7 @@ var
SrcEdit: TSourceEditor;
begin
if not (Assigned(FMainUsedUnits) and Assigned(FImplUsedUnits)) then Exit;
- Screen.Cursor:=crHourGlass;
+ Screen.BeginWaitCursor;
try
FOtherUnits := TStringList.Create;
FOtherUnits.Sorted := True;
@@ -413,7 +413,7 @@ begin
end;
end;
finally
- Screen.Cursor:=crDefault;
+ Screen.EndWaitCursor;
end;
end;
diff --git a/lcl/controls.pp b/lcl/controls.pp
index 52207d7dd1..21f41139b7 100644
--- a/lcl/controls.pp
+++ b/lcl/controls.pp
@@ -356,7 +356,6 @@ type
private
FDragging: Boolean;
FDragHotspot: TPoint;
- FOldCursor: TCursor;
FLastDragPos: TPoint;
FLockedWindow: HWND;// window where drag started and locked via DragLock, invalid=NoLockedWindow=High(PtrInt)
diff --git a/lcl/forms.pp b/lcl/forms.pp
index 5d92a666f1..fe069b9a07 100644
--- a/lcl/forms.pp
+++ b/lcl/forms.pp
@@ -1039,6 +1039,7 @@ type
FActiveCustomForm: TCustomForm;
FActiveForm: TForm;
FCursor: TCursor;
+ FTempCursors: array of TCursor;
FCursorMap: TMap;
FCustomForms: TFPList;
FCustomFormsZOrdered: TFPList;
@@ -1081,6 +1082,7 @@ type
function GetMonitor(Index: Integer): TMonitor;
function GetMonitorCount: Integer;
function GetPrimaryMonitor: TMonitor;
+ function GetRealCursor: TCursor;
function GetWidth : Integer;
procedure AddForm(AForm: TCustomForm);
procedure RemoveForm(AForm: TCustomForm);
@@ -1158,11 +1160,17 @@ type
MonitorDefault: TMonitorDefaultTo = mdNearest): TMonitor;
function MonitorFromWindow(const Handle: THandle;
MonitorDefault: TMonitorDefaultTo = mdNearest): TMonitor;
+
+ procedure BeginTempCursor(const aCursor: TCursor);
+ procedure EndTempCursor(const aCursor: TCursor);
+ procedure BeginWaitCursor;
+ procedure EndWaitCursor;
public
property ActiveControl: TWinControl read FActiveControl;
property ActiveCustomForm: TCustomForm read FActiveCustomForm;
property ActiveForm: TForm read FActiveForm;
property Cursor: TCursor read FCursor write SetCursor;
+ property RealCursor: TCursor read GetRealCursor;
property Cursors[Index: Integer]: HCURSOR read GetCursors write SetCursors;
property CustomFormCount: Integer read GetCustomFormCount;
property CustomForms[Index: Integer]: TCustomForm read GetCustomForms;
diff --git a/lcl/include/control.inc b/lcl/include/control.inc
index a1af6164a5..89f24730f5 100644
--- a/lcl/include/control.inc
+++ b/lcl/include/control.inc
@@ -2927,7 +2927,7 @@ procedure TControl.UpdateMouseCursor(X, Y: integer);
begin
//DebugLn(['TControl.UpdateMouseCursor ',DbgSName(Self)]);
if csDesigning in ComponentState then Exit;
- if Screen.Cursor <> crDefault then Exit;
+ if Screen.RealCursor <> crDefault then Exit;
SetTempCursor(Cursor);
end;
diff --git a/lcl/include/customform.inc b/lcl/include/customform.inc
index 394d6fbed0..d7ad7954b7 100644
--- a/lcl/include/customform.inc
+++ b/lcl/include/customform.inc
@@ -2914,7 +2914,6 @@ var
DisabledList: TList;
SavedFocusState: TFocusState;
ActiveWindow: HWnd;
- SavedCursor: TCursor;
begin
if Self = nil then
raise EInvalidOperation.Create('TCustomForm.ShowModal Self = nil');
@@ -2939,11 +2938,10 @@ begin
RecreateWnd(Self); // need to refresh handle for pmNone because ParentWindow changes if (fsModal in FFormState) - see GetRealPopupParent
ActiveWindow := GetActiveWindow;
SavedFocusState := SaveFocusState;
- SavedCursor := Screen.Cursor;
Screen.FSaveFocusedList.Insert(0, Screen.FFocusedForm);
Screen.FFocusedForm := Self;
Screen.MoveFormToFocusFront(Self);
- Screen.Cursor := crDefault;
+ Screen.BeginTempCursor(crDefault);
ModalResult := 0;
try
@@ -3001,7 +2999,7 @@ begin
end;
finally
RestoreFocusState(SavedFocusState);
- Screen.Cursor := SavedCursor;
+ Screen.EndTempCursor(crDefault);
if LCLIntf.IsWindow(ActiveWindow) then
SetActiveWindow(ActiveWindow);
Exclude(FFormState, fsModal);
diff --git a/lcl/include/dragimagelist.inc b/lcl/include/dragimagelist.inc
index eb0cbbc621..528bd2bf42 100644
--- a/lcl/include/dragimagelist.inc
+++ b/lcl/include/dragimagelist.inc
@@ -25,9 +25,12 @@ const
procedure TDragImageList.SetDragCursor(const AValue: TCursor);
begin
if FDragCursor = AValue then exit;
- FDragCursor := AValue;
if Dragging then
- WidgetSet.SetCursor(Screen.Cursors[DragCursor]);
+ begin
+ Screen.BeginTempCursor(AValue);
+ Screen.EndTempCursor(DragCursor);
+ end;
+ FDragCursor := AValue;
end;
procedure TDragImageList.SetDragHotspot(const aDragHotspot: TPoint);
@@ -184,7 +187,6 @@ begin
inherited Create(TheOwner);
FLastDragPos := Point(0, 0);
- FOldCursor := crNone;
FLockedWindow := NoLockedWindow;
end;
@@ -197,8 +199,7 @@ begin
if Result then
begin
DragLock(Window, X, Y);
- FOldCursor := Screen.Cursor;
- WidgetSet.SetCursor(Screen.Cursors[ImageList.DragCursor])
+ Screen.BeginTempCursor(ImageList.DragCursor);
end;
end;
@@ -250,7 +251,7 @@ begin
DragUnlock;
TWSDragImageListResolutionClass(WidgetSetClass).EndDrag(Self);
FDragging := False;
- WidgetSet.SetCursor(Screen.Cursors[FOldCursor])
+ Screen.EndTempCursor(ImageList.DragCursor);
end;
function TDragImageListResolution.GetHotSpot: TPoint;
diff --git a/lcl/include/dragmanager.inc b/lcl/include/dragmanager.inc
index f02523592e..764aeb4f3d 100644
--- a/lcl/include/dragmanager.inc
+++ b/lcl/include/dragmanager.inc
@@ -220,7 +220,7 @@ begin
if FDragImageList <> nil then
FDragImageList.EndDrag;
- WidgetSet.SetCursor(Screen.Cursors[Screen.Cursor]);
+ WidgetSet.SetCursor(Screen.Cursors[Screen.RealCursor]);
if (ADragObjectCopy.DragTarget <> nil) and (ADragObjectCopy.DragTarget is TControl) then
TargetPos := ADragObjectCopy.DragTargetPos //controls can override the position
else
diff --git a/lcl/include/promptdialog.inc b/lcl/include/promptdialog.inc
index 4b0cd38eae..7b80e93e58 100644
--- a/lcl/include/promptdialog.inc
+++ b/lcl/include/promptdialog.inc
@@ -942,16 +942,12 @@ function DefaultQuestionDialog(const aCaption, aMsg: string; DlgType: LongInt;
}
var
QuestionDialog: TQuestionDlg;
- last_cur: TCursor;
begin
QuestionDialog := TQuestionDlg.CreateQuestionDlg(aCaption, aMsg, DlgType, Buttons, HelpCtx);
- last_cur := Screen.Cursor;
- Screen.Cursor := crDefault;
try
Result := QuestionDialog.ShowModal;
finally
QuestionDialog.Free;
- Screen.Cursor := last_cur;
end;
end;
diff --git a/lcl/include/screen.inc b/lcl/include/screen.inc
index c6e89c4dca..115a1acb02 100644
--- a/lcl/include/screen.inc
+++ b/lcl/include/screen.inc
@@ -295,6 +295,22 @@ begin
AddHandler(snRemoveForm,TMethod(OnRemoveForm),AsFirst);
end;
+procedure TScreen.BeginTempCursor(const aCursor: TCursor);
+var
+ OldCursor: TCursor;
+begin
+ OldCursor := RealCursor;
+ SetLength(FTempCursors, Length(FTempCursors)+1);
+ FTempCursors[High(FTempCursors)] := aCursor;
+ if OldCursor<>RealCursor then
+ WidgetSet.SetCursor(Cursors[RealCursor]);
+end;
+
+procedure TScreen.BeginWaitCursor;
+begin
+ BeginTempCursor(crHourGlass);
+end;
+
procedure TScreen.RemoveHandlerRemoveForm(OnRemoveForm: TScreenFormEvent);
begin
RemoveHandler(snRemoveForm,TMethod(OnRemoveForm));
@@ -409,6 +425,30 @@ begin
FreeAndNil(AFormList);
end;
+procedure TScreen.EndTempCursor(const aCursor: TCursor);
+var
+ I: Integer;
+ OldCursor: TCursor;
+begin
+ OldCursor := RealCursor;
+ for I := High(FTempCursors) downto Low(FTempCursors) do
+ begin
+ if FTempCursors[I]=aCursor then
+ begin
+ Delete(FTempCursors, I, 1);
+ if OldCursor<>RealCursor then
+ WidgetSet.SetCursor(Cursors[RealCursor]);
+ Exit;
+ end;
+ end;
+ raise Exception.CreateFmt('Unbalanced BeginTempCursor/EndTempCursor calls for cursor %d', [aCursor]);
+end;
+
+procedure TScreen.EndWaitCursor;
+begin
+ EndTempCursor(crHourGlass);
+end;
+
function TScreen.UpdatedMonitor(AHandle: HMONITOR; ADefault: TMonitorDefaultTo;
AErrorMsg: string): TMonitor;
var
@@ -807,6 +847,14 @@ begin
Result := nil;
end;
+function TScreen.GetRealCursor: TCursor;
+begin
+ if Length(FTempCursors)>0 then
+ Result := FTempCursors[High(FTempCursors)]
+ else
+ Result := Cursor;
+end;
+
function TScreen.GetSystemFont: TFont;
begin
if (FSystemFont = nil) then
@@ -909,11 +957,15 @@ end;
procedure TScreen.SetCursor(const AValue: TCursor);
------------------------------------------------------------------------------}
procedure TScreen.SetCursor(const AValue: TCursor);
+var
+ OldCursor: TCursor;
begin
if AValue <> Cursor then
begin
+ OldCursor := RealCursor;
FCursor := AValue;
- WidgetSet.SetCursor(Cursors[FCursor]);
+ if OldCursor<>RealCursor then
+ WidgetSet.SetCursor(Cursors[RealCursor]);
end;
end;
diff --git a/lcl/interfaces/carbon/carbonprivatecommon.inc b/lcl/interfaces/carbon/carbonprivatecommon.inc
index 34ea5c40bd..f0fcd99fe9 100644
--- a/lcl/interfaces/carbon/carbonprivatecommon.inc
+++ b/lcl/interfaces/carbon/carbonprivatecommon.inc
@@ -341,7 +341,7 @@ begin
Widget := GetCarbonWidget(Control);
if Widget = nil then Exit;
- if Screen.Cursor = crDefault then // we can change cursor
+ if Screen.RealCursor = crDefault then // we can change cursor
begin
ACursorWasSet := False;
@@ -502,7 +502,7 @@ begin
DeliverMessage(AWidget.LCLObject, Msg);
}
- ACursor := Screen.Cursor;
+ ACursor := Screen.RealCursor;
if ACursor = crDefault then
begin
ACursor := AWidget.LCLObject.Cursor;
diff --git a/lcl/interfaces/carbon/carbonwscontrols.pp b/lcl/interfaces/carbon/carbonwscontrols.pp
index d032bd1394..d8ea174d0b 100644
--- a/lcl/interfaces/carbon/carbonwscontrols.pp
+++ b/lcl/interfaces/carbon/carbonwscontrols.pp
@@ -327,7 +327,7 @@ begin
TCarbonWidget(AWinControl.Handle).SetCursor(ACursor);
- if (Screen.Cursor <> crDefault) then Exit;
+ if (Screen.RealCursor <> crDefault) then Exit;
TopWindow := TCarbonWidget(AWinControl.Handle).GetTopParentWindow;
TopView := HIViewGetRoot(TopWindow);
diff --git a/lcl/interfaces/cocoa/cocoawscommon.pas b/lcl/interfaces/cocoa/cocoawscommon.pas
index 9d369ff901..2d989748da 100644
--- a/lcl/interfaces/cocoa/cocoawscommon.pas
+++ b/lcl/interfaces/cocoa/cocoawscommon.pas
@@ -1470,7 +1470,7 @@ begin
if not Assigned(Target) then Exit;
if not (csDesigning in Target.ComponentState) then
begin
- ACursor := Screen.Cursor;
+ ACursor := Screen.RealCursor;
if ACursor = crDefault then
begin
// traverse visible child controls
diff --git a/lcl/interfaces/customdrawn/wincallback.inc b/lcl/interfaces/customdrawn/wincallback.inc
index 25bd6f6901..0f7c0542e2 100644
--- a/lcl/interfaces/customdrawn/wincallback.inc
+++ b/lcl/interfaces/customdrawn/wincallback.inc
@@ -267,7 +267,7 @@ Var
Dec(P.X, BoundsOffset.Left);
Dec(P.Y, BoundsOffset.Top);
end;
- ACursor := Screen.Cursor;
+ ACursor := Screen.RealCursor;
if ACursor = crDefault then
begin
// statictext controls do not get WM_SETCURSOR messages...
diff --git a/lcl/interfaces/win32/win32callback.inc b/lcl/interfaces/win32/win32callback.inc
index 4440540085..1066443e08 100644
--- a/lcl/interfaces/win32/win32callback.inc
+++ b/lcl/interfaces/win32/win32callback.inc
@@ -851,7 +851,7 @@ begin
begin
if not (csDesigning in lWinControl.ComponentState) and (LOWORD(LParam) = HTCLIENT) then
begin
- ACursor := Screen.Cursor;
+ ACursor := Screen.RealCursor;
if ACursor = crDefault then
begin
Windows.GetCursorPos(Windows.POINT(P));
diff --git a/lcl/interfaces/win32/win32wscontrols.pp b/lcl/interfaces/win32/win32wscontrols.pp
index 40f10a7828..7bd42cde12 100644
--- a/lcl/interfaces/win32/win32wscontrols.pp
+++ b/lcl/interfaces/win32/win32wscontrols.pp
@@ -502,7 +502,7 @@ begin
Exit;
end;
- if Screen.Cursor <> crDefault then exit;
+ if Screen.RealCursor <> crDefault then exit;
Windows.GetCursorPos(CursorPos);
diff --git a/lcl/interfaces/wince/wincecallback.inc b/lcl/interfaces/wince/wincecallback.inc
index 002545dcbe..e646b3b4c2 100644
--- a/lcl/interfaces/wince/wincecallback.inc
+++ b/lcl/interfaces/wince/wincecallback.inc
@@ -711,7 +711,7 @@ Var
Dec(P.X, BoundsOffset.Left);
Dec(P.Y, BoundsOffset.Top);
end;
- ACursor := Screen.Cursor;
+ ACursor := Screen.RealCursor;
if ACursor = crDefault then
begin
// statictext controls do not get WM_SETCURSOR messages...
diff --git a/tools/apiwizz/apiwizard.pp b/tools/apiwizz/apiwizard.pp
index c66c7a91b1..baecef6817 100644
--- a/tools/apiwizz/apiwizard.pp
+++ b/tools/apiwizz/apiwizard.pp
@@ -782,82 +782,59 @@ var
Item: TListItem;
WS: TApiWidgetset;
begin
- Screen.Cursor := crHourGlass;
lvExisting.BeginUpdate;
- Clear;
-
+ Screen.BeginWaitCursor;
Lines := TStringList.Create;
- Scan(txtLazarus.text + '/lcl/include/winapih.inc', 'ps', Lines);
- for n := 0 to Lines.Count - 1 do
- begin
- Line := TApiLine.Create;
- Line.Declaration := Lines[n];
- Line.WinApi := True;
- S := GetName(Lines[n]);
- FLineInfo.AddObject(S, Line);
- end;
+ try
+ Clear;
- Scan(txtLazarus.text + '/lcl/include/winapih.inc', 'pi', Lines);
- for n := 0 to Lines.Count - 1 do
- begin
- S := GetName(Lines[n]);
- if FLineInfo.IndexOf(s) >= 0 then Continue; //overloaded
+ Scan(txtLazarus.text + '/lcl/include/winapih.inc', 'ps', Lines);
+ for n := 0 to Lines.Count - 1 do
+ begin
+ Line := TApiLine.Create;
+ Line.Declaration := Lines[n];
+ Line.WinApi := True;
+ S := GetName(Lines[n]);
+ FLineInfo.AddObject(S, Line);
+ end;
- Line := TApiLine.Create;
- Line.Independent := True;
- Line.WinApi := True;
- Line.Declaration := Lines[n];
- FLineInfo.AddObject(S, Line);
- end;
+ Scan(txtLazarus.text + '/lcl/include/winapih.inc', 'pi', Lines);
+ for n := 0 to Lines.Count - 1 do
+ begin
+ S := GetName(Lines[n]);
+ if FLineInfo.IndexOf(s) >= 0 then Continue; //overloaded
- Scan(txtLazarus.text + '/lcl/include/lclintfh.inc', 'ps', Lines);
- for n := 0 to Lines.Count - 1 do
- begin
- Line := TApiLine.Create;
- Line.Declaration := Lines[n];
- S := GetName(Lines[n]);
- FLineInfo.AddObject(S, Line);
- end;
+ Line := TApiLine.Create;
+ Line.Independent := True;
+ Line.WinApi := True;
+ Line.Declaration := Lines[n];
+ FLineInfo.AddObject(S, Line);
+ end;
- Scan(txtLazarus.text + '/lcl/include/lclintfh.inc', 'pi', Lines);
- for n := 0 to Lines.Count - 1 do
- begin
- S := GetName(Lines[n]);
- if FLineInfo.IndexOf(s) >= 0 then Continue; //overloaded
+ Scan(txtLazarus.text + '/lcl/include/lclintfh.inc', 'ps', Lines);
+ for n := 0 to Lines.Count - 1 do
+ begin
+ Line := TApiLine.Create;
+ Line.Declaration := Lines[n];
+ S := GetName(Lines[n]);
+ FLineInfo.AddObject(S, Line);
+ end;
- Line := TApiLine.Create;
- Line.Independent := True;
- Line.Declaration := Lines[n];
- FLineInfo.AddObject(S, Line);
- end;
+ Scan(txtLazarus.text + '/lcl/include/lclintfh.inc', 'pi', Lines);
+ for n := 0 to Lines.Count - 1 do
+ begin
+ S := GetName(Lines[n]);
+ if FLineInfo.IndexOf(s) >= 0 then Continue; //overloaded
- // implementations
+ Line := TApiLine.Create;
+ Line.Independent := True;
+ Line.Declaration := Lines[n];
+ FLineInfo.AddObject(S, Line);
+ end;
- Scan(txtLazarus.text + '/lcl/include/intfbasewinapi.inc', 'ps', Lines);
- for n := 0 to Lines.Count - 1 do
- begin
- S := GetName(Lines[n]);
- idx := FLineInfo.IndexOf(S);
- if idx = -1 then Continue;
+ // implementations
- Line := TApiLine(FLineInfo.Objects[idx]);
- Line.Base := True;
- end;
-
- Scan(txtLazarus.text + '/lcl/include/intfbaselcl.inc', 'ps', Lines);
- for n := 0 to Lines.Count - 1 do
- begin
- S := GetName(Lines[n]);
- idx := FLineInfo.IndexOf(S);
- if idx = -1 then Continue;
-
- Line := TApiLine(FLineInfo.Objects[idx]);
- Line.Base := True;
- end;
-
- for WS := Low(WS) to High(Ws) do
- begin
- Scan(txtLazarus.text + '/lcl/interfaces/' + WS_NAME[WS] + '/' + WS_NAME[WS] + 'winapih.inc', 'ps', Lines);
+ Scan(txtLazarus.text + '/lcl/include/intfbasewinapi.inc', 'ps', Lines);
for n := 0 to Lines.Count - 1 do
begin
S := GetName(Lines[n]);
@@ -865,10 +842,10 @@ begin
if idx = -1 then Continue;
Line := TApiLine(FLineInfo.Objects[idx]);
- Include(Line.Widgetsets, WS);
+ Line.Base := True;
end;
- Scan(txtLazarus.text + '/lcl/interfaces/' + WS_NAME[WS] + '/' + WS_NAME[WS] + 'lclintfh.inc', 'ps', Lines);
+ Scan(txtLazarus.text + '/lcl/include/intfbaselcl.inc', 'ps', Lines);
for n := 0 to Lines.Count - 1 do
begin
S := GetName(Lines[n]);
@@ -876,51 +853,74 @@ begin
if idx = -1 then Continue;
Line := TApiLine(FLineInfo.Objects[idx]);
- Include(Line.Widgetsets, WS);
- end;
- end;
-
-
- for n := 0 to FLineInfo.Count - 1 do
- begin
- Item := lvExisting.Items.Add;
- Item.Caption := FLineInfo[n];
- Line := TApiLine(FLineInfo.Objects[n]);
- Item.Data := Line;
-
- if Line.WinApi
- then Item.SubItems.Add('Win')
- else Item.SubItems.Add('LCL');
-
- if Line.Independent
- then Item.SubItems.Add('X')
- else Item.SubItems.Add('');
-
- if Line.Base
- then Item.SubItems.Add('X')
- else begin
- if Line.Independent
- then Item.SubItems.Add('-')
- else Item.SubItems.Add('');
+ Line.Base := True;
end;
for WS := Low(WS) to High(Ws) do
begin
- if WS in Line.Widgetsets
+ Scan(txtLazarus.text + '/lcl/interfaces/' + WS_NAME[WS] + '/' + WS_NAME[WS] + 'winapih.inc', 'ps', Lines);
+ for n := 0 to Lines.Count - 1 do
+ begin
+ S := GetName(Lines[n]);
+ idx := FLineInfo.IndexOf(S);
+ if idx = -1 then Continue;
+
+ Line := TApiLine(FLineInfo.Objects[idx]);
+ Include(Line.Widgetsets, WS);
+ end;
+
+ Scan(txtLazarus.text + '/lcl/interfaces/' + WS_NAME[WS] + '/' + WS_NAME[WS] + 'lclintfh.inc', 'ps', Lines);
+ for n := 0 to Lines.Count - 1 do
+ begin
+ S := GetName(Lines[n]);
+ idx := FLineInfo.IndexOf(S);
+ if idx = -1 then Continue;
+
+ Line := TApiLine(FLineInfo.Objects[idx]);
+ Include(Line.Widgetsets, WS);
+ end;
+ end;
+
+
+ for n := 0 to FLineInfo.Count - 1 do
+ begin
+ Item := lvExisting.Items.Add;
+ Item.Caption := FLineInfo[n];
+ Line := TApiLine(FLineInfo.Objects[n]);
+ Item.Data := Line;
+
+ if Line.WinApi
+ then Item.SubItems.Add('Win')
+ else Item.SubItems.Add('LCL');
+
+ if Line.Independent
+ then Item.SubItems.Add('X')
+ else Item.SubItems.Add('');
+
+ if Line.Base
then Item.SubItems.Add('X')
else begin
if Line.Independent
then Item.SubItems.Add('-')
else Item.SubItems.Add('');
end;
+
+ for WS := Low(WS) to High(Ws) do
+ begin
+ if WS in Line.Widgetsets
+ then Item.SubItems.Add('X')
+ else begin
+ if Line.Independent
+ then Item.SubItems.Add('-')
+ else Item.SubItems.Add('');
+ end;
+ end;
end;
+ finally
+ Lines.Free;
+ Screen.EndWaitCursor;
+ lvExisting.EndUpdate;
end;
-
- lvExisting.EndUpdate;
-
- Lines.Free;
-
- Screen.Cursor := crDefault;
end;
procedure TApiWizForm.FormDestroy(Sender: TObject);