paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-05-30 00:22:56 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: Screen.BeginTempCursor & EndTempCursor

Browse Source 
git-svn-id: trunk@62664 -
This commit is contained in:
ondrej 2020-02-23 06:04:38 +00:00
parent aaf4d4d12f
commit 74fb203f39
36 changed files with 235 additions and 184 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
components/chmhelp/democontrol/helpconnectionunit1.pas
View File

@ -51,13 +51,13 @@ var
begin begin
OpenDialog1.InitialDir:=GetCurrentDirUTF8; OpenDialog1.InitialDir:=GetCurrentDirUTF8;
if not OpenDialog1.Execute then exit; if not OpenDialog1.Execute then exit;
Screen.Cursor := crHourGlass; Screen.BeginWaitCursor;
try try
if Help.ServerRunning = false then if Help.ServerRunning = false then
Help.StartHelpServer(IPCFile, GetLHelpFilename); Help.StartHelpServer(IPCFile, GetLHelpFilename);
Res := Help.OpenFile(OpenDialog1.FileName); Res := Help.OpenFile(OpenDialog1.FileName);
finally finally
Screen.Cursor := crDefault; Screen.EndWaitCursor;
end; end;
Label1.Caption := ResponseToString(Res); Label1.Caption := ResponseToString(Res);
end; end;

8
components/lazutils/examples/LookupStringList/main.pas
View File

@ -63,7 +63,7 @@ begin
UpdateTime(0); UpdateTime(0);
Memo.Clear; Memo.Clear;
Application.ProcessMessages; Application.ProcessMessages;
Screen.Cursor := crHourGlass; Screen.BeginWaitCursor;
try try
InList.Clear; InList.Clear;
for i := 0 to SpinEdit1.Value - 1 do for i := 0 to SpinEdit1.Value - 1 do
@ -75,7 +75,7 @@ begin
end; end;
Memo.Lines.Assign(inList); Memo.Lines.Assign(inList);
finally finally
Screen.Cursor := crDefault; Screen.EndWaitCursor;
end; end;
end; end;
@ -84,7 +84,7 @@ var
DSL :TLookupStringList; DSL :TLookupStringList;
T :TDateTime; T :TDateTime;
begin begin
Screen.Cursor := crHourGlass; Screen.BeginWaitCursor;
try try
T := Now; T := Now;
DSL := TLookupStringList.Create; DSL := TLookupStringList.Create;
@ -97,7 +97,7 @@ begin
end; end;
UpdateTime(Now - T); UpdateTime(Now - T);
finally finally
Screen.Cursor := crDefault; Screen.EndWaitCursor;
end; end;
end; end;

4
components/onlinepackagemanager/opkman_mainfrm.pas
View File

@ -1030,11 +1030,11 @@ var
begin begin
if MessageDlgEx(rsMainFrm_rsRepositoryCleanup0, mtInformation, [mbYes, mbNo], Self) = mrYes then if MessageDlgEx(rsMainFrm_rsRepositoryCleanup0, mtInformation, [mbYes, mbNo], Self) = mrYes then
begin begin
Screen.Cursor := crHourGlass; Screen.BeginWaitCursor;
try try
Cnt := SerializablePackages.Cleanup; Cnt := SerializablePackages.Cleanup;
finally finally
Screen.Cursor := crDefault; Screen.EndWaitCursor;
end; end;
MessageDlgEx(Format(rsMainFrm_rsRepositoryCleanup1, [IntToStr(Cnt)]), MessageDlgEx(Format(rsMainFrm_rsRepositoryCleanup1, [IntToStr(Cnt)]),
mtInformation, [mbOk], Self); mtInformation, [mbOk], Self);

6
components/pochecker/graphstat.pp
View File

@ -398,15 +398,13 @@ var
Bmp: TBitmap; Bmp: TBitmap;
AStat: TStat; AStat: TStat;
Index: Integer; Index: Integer;
Cur: TCursor;
begin begin
if Assigned(FImgList) then FImgList.Free; if Assigned(FImgList) then FImgList.Free;
FImgList := TImageList.CreateSize(BmpWH, BmpWH); FImgList := TImageList.CreateSize(BmpWH, BmpWH);
ListView.Clear; ListView.Clear;
ListView.LargeImages := FImgList; ListView.LargeImages := FImgList;
ListView.BeginUpdate; ListView.BeginUpdate;
Cur := Screen.Cursor; Screen.BeginWaitCursor;
Screen.Cursor := crHourGlass;
try try
StatusLabel.Visible := True; StatusLabel.Visible := True;
for Index := 0 to FPoFamilyStats.Count - 1 do for Index := 0 to FPoFamilyStats.Count - 1 do
@ -429,7 +427,7 @@ begin
end; end;
finally finally
ListView.EndUpdate; ListView.EndUpdate;
Screen.Cursor := Cur; Screen.EndWaitCursor;
StatusLabel.Visible := False; StatusLabel.Visible := False;
end; end;
end; end;

6
components/pochecker/pocheckermain.pp
View File

@ -322,10 +322,8 @@ var
SL, ML, OL, CurFiles, MissingFiles: TStringList; SL, ML, OL, CurFiles, MissingFiles: TStringList;
i: Integer; i: Integer;
S, Mn: String; S, Mn: String;
Cur: TCursor;
begin begin
Cur := Screen.Cursor; Screen.BeginWaitCursor;
Screen.Cursor := crHourGlass;
StatusBar.SimpleText := sScanningInProgress; StatusBar.SimpleText := sScanningInProgress;
try try
ML := FindAllFiles(ADir, '*.pot', True); ML := FindAllFiles(ADir, '*.pot', True);
@ -376,7 +374,7 @@ begin
MissingFiles.Free; MissingFiles.Free;
SL.Free; SL.Free;
StatusBar.SimpleText := ''; StatusBar.SimpleText := '';
Screen.Cursor := Cur; Screen.EndWaitCursor;
end; end;
end; end;

4
components/todolist/todolist.pas
View File

@ -276,7 +276,7 @@ begin
if fUpdating then Exit; if fUpdating then Exit;
LazarusIDE.SaveSourceEditorChangesToCodeCache(nil); LazarusIDE.SaveSourceEditorChangesToCodeCache(nil);
Screen.Cursor:=crHourGlass; Screen.BeginWaitCursor;
lvTodo.BeginUpdate; lvTodo.BeginUpdate;
Units:=nil; Units:=nil;
try try
@ -324,7 +324,7 @@ begin
Units.Free; Units.Free;
CodeToolBoss.DeactivateWriteLock; CodeToolBoss.DeactivateWriteLock;
lvTodo.EndUpdate; lvTodo.EndUpdate;
Screen.Cursor:=crDefault; Screen.EndWaitCursor;
fUpdating:=False; fUpdating:=False;
end; end;
end; end;

4
converter/chgencodingdlg.pas
View File

@ -366,7 +366,7 @@ var
HasFiles: Boolean; HasFiles: Boolean;
IsDone: Boolean; IsDone: Boolean;
begin begin
Screen.Cursor:=crHourGlass; Screen.BeginWaitCursor;
try try
HasFiles:=GetFiles; HasFiles:=GetFiles;
PreviewListView.Items.Clear; PreviewListView.Items.Clear;
@ -396,7 +396,7 @@ begin
Format(lisNumberOfFilesToConvert, [IntToStr(PreviewListView.Items.Count)]); Format(lisNumberOfFilesToConvert, [IntToStr(PreviewListView.Items.Count)]);
ApplyButton.Enabled:=True; ApplyButton.Enabled:=True;
finally finally
Screen.Cursor:=crDefault; Screen.EndWaitCursor;
end; end;
end; end;

8
converter/convertdelphi.pas
View File

@ -1104,7 +1104,7 @@ begin
DebugLn(''); DebugLn('');
DebugLn('TConvertDelphiProjPack.ConvertAllFormFiles: '+lisConvDelphiRepairingFormFiles); DebugLn('TConvertDelphiProjPack.ConvertAllFormFiles: '+lisConvDelphiRepairingFormFiles);
end; end;
Screen.Cursor:=crHourGlass; Screen.BeginWaitCursor;
try try
for i:=0 to ConverterList.Count-1 do begin for i:=0 to ConverterList.Count-1 do begin
Converter:=TDelphiUnit(ConverterList[i]); // Converter created in cycle1. Converter:=TDelphiUnit(ConverterList[i]); // Converter created in cycle1.
@ -1117,7 +1117,7 @@ begin
if Result<>mrOK then exit; if Result<>mrOK then exit;
end; end;
finally finally
Screen.Cursor:=crDefault; Screen.EndWaitCursor;
end; end;
Result:=mrOK; Result:=mrOK;
end; end;
@ -1601,7 +1601,7 @@ var
p: LongInt; p: LongInt;
ui: TUnitInfo; ui: TUnitInfo;
begin begin
Screen.Cursor:=crHourGlass; Screen.BeginWaitCursor;
FoundUnits:=nil; FoundUnits:=nil;
MisUnits:=nil; MisUnits:=nil;
NormalUnits:=nil; NormalUnits:=nil;
@ -1649,7 +1649,7 @@ begin
FoundUnits.Free; FoundUnits.Free;
MisUnits.Free; MisUnits.Free;
NormalUnits.Free; NormalUnits.Free;
Screen.Cursor:=crDefault; Screen.EndWaitCursor;
end; end;
Result:=mrOK; Result:=mrOK;
end; end;

10
converter/missingpropertiesdlg.pas
View File

@ -565,7 +565,6 @@ end;
function TLFMFixer.ShowConvertLFMWizard: TModalResult; function TLFMFixer.ShowConvertLFMWizard: TModalResult;
var var
FixLFMDialog: TFixLFMDialog; FixLFMDialog: TFixLFMDialog;
PrevCursor: TCursor;
begin begin
Result:=mrCancel; Result:=mrCancel;
FixLFMDialog:=TFixLFMDialog.Create(nil, self); FixLFMDialog:=TFixLFMDialog.Create(nil, self);
@ -579,14 +578,7 @@ begin
and ((fSettings.TypeReplaceMode=raAutomatic) or not fHasMissingObjectTypes) then and ((fSettings.TypeReplaceMode=raAutomatic) or not fHasMissingObjectTypes) then
Result:=ReplaceAndRemoveAll // Can return mrRetry. Result:=ReplaceAndRemoveAll // Can return mrRetry.
else begin else begin
// Cursor is earlier set to HourGlass. Show normal cursor while in dialog. Result:=FixLFMDialog.ShowModal;
PrevCursor:=Screen.Cursor;
Screen.Cursor:=crDefault;
try
Result:=FixLFMDialog.ShowModal;
finally
Screen.Cursor:=PrevCursor;
end;
end; end;
finally finally
FixLFMDialog.Free; FixLFMDialog.Free;

9
docs/xml/lcl/forms.xml
View File

@ -9973,6 +9973,15 @@
</descr> </descr>
<seealso/> <seealso/>
</element> </element>
<element name="TScreen.BeginTempCursor">
<short>Override the Cursor property with a temporary value. Use EndTempCursor to release it.</short>
</element>
<element name="TScreen.EndTempCursor">
<short>Release the temporary cursor set with BeginTempCursor.</short>
</element>
<element name="TScreen.RealCursor">
<short>Get the Cursor property with taking temporary cursors into account.</short>
</element>
</module> </module>
<!-- Forms --> <!-- Forms -->
</package> </package>

4
examples/database/sqldbtutorial3/mainform.pas
View File

@ -135,7 +135,7 @@ var
begin begin
result:=false; result:=false;
Conn:=TSQLConnector.Create(nil); Conn:=TSQLConnector.Create(nil);
Screen.Cursor:=crHourglass; Screen.BeginWaitCursor;
try try
// ...actual connector type is determined by this property. // ...actual connector type is determined by this property.
// Make sure the ChosenConfig.DBType string matches // Make sure the ChosenConfig.DBType string matches
@ -154,7 +154,7 @@ begin
end; end;
Conn.Close; Conn.Close;
finally finally
Screen.Cursor:=crDefault; Screen.EndWaitCursor;
Conn.Free; Conn.Free;
end; end;
end; end;

4
examples/database/tsqlscript/mainform.pas
View File

@ -231,7 +231,7 @@ var
begin begin
result:=false; result:=false;
Conn:=TSQLConnector.Create(nil); Conn:=TSQLConnector.Create(nil);
Screen.Cursor:=crHourglass; Screen.BeginWaitCursor;
try try
// ...actual connector type is determined by this property. // ...actual connector type is determined by this property.
// Make sure the ChosenConfig.DBType string matches // Make sure the ChosenConfig.DBType string matches
@ -250,7 +250,7 @@ begin
end; end;
Conn.Close; Conn.Close;
finally finally
Screen.Cursor:=crDefault; Screen.EndWaitCursor;
Conn.Free; Conn.Free;
end; end;
end; end;

12
examples/imgviewer/frmmain.pas
View File

@ -212,7 +212,7 @@ var
begin begin
if SelectDirectory(SSelectImageDir, '/', Dir, true) then if SelectDirectory(SSelectImageDir, '/', Dir, true) then
begin 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 try
LBFiles.Items.BeginUpdate; //Indicate to the listbox that we're doing a lengthy operation LBFiles.Items.BeginUpdate; //Indicate to the listbox that we're doing a lengthy operation
WasSorted:=LBFiles.Sorted; WasSorted:=LBFiles.Sorted;
@ -221,7 +221,7 @@ begin
LBFiles.Sorted:=WasSorted; LBFiles.Sorted:=WasSorted;
finally finally
LBFiles.Items.EndUpdate; LBFiles.Items.EndUpdate;
Screen.Cursor := crDefault; Screen.EndWaitCursor;
end; end;
end; end;
end; end;
@ -270,7 +270,7 @@ var
begin begin
if SelectDirectory(SSelectImageDirRec, '/', Dir, true) then if SelectDirectory(SSelectImageDirRec, '/', Dir, true) then
begin 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 try
LBFiles.Items.BeginUpdate; //Indicate to the listbox that we're doing a lengthy operation LBFiles.Items.BeginUpdate; //Indicate to the listbox that we're doing a lengthy operation
WasSorted:=LBFiles.Sorted; WasSorted:=LBFiles.Sorted;
@ -279,7 +279,7 @@ begin
LBFiles.Sorted:=WasSorted; LBFiles.Sorted:=WasSorted;
finally finally
LBFiles.Items.EndUpdate; LBFiles.Items.EndUpdate;
Screen.Cursor := crDefault; Screen.EndWaitCursor;
end; end;
end; end;
end; end;
@ -461,14 +461,14 @@ begin
else else
begin begin
S := ParamStrUTF8(I); S := ParamStrUTF8(I);
Screen.Cursor := crHourglass; //Show user he may have to wait Screen.BeginWaitCursor; //Show user he may have to wait
try try
if DirectoryExistsUTF8(S) then if DirectoryExistsUTF8(S) then
AddDir(ExpandFileNameUTF8(S), FRecursive) AddDir(ExpandFileNameUTF8(S), FRecursive)
else if FileExistsUTF8(S) then else if FileExistsUTF8(S) then
AddFile(ExpandFileNameUTF8(S), LBFiles.Items.Count = 0); AddFile(ExpandFileNameUTF8(S), LBFiles.Items.Count = 0);
finally finally
Screen.Cursor := crDefault; Screen.EndWaitCursor;
end; end;
end; end;
end; end;

4
ide/allcompileroptions.pas
View File

@ -163,7 +163,7 @@ var
begin begin
IdleConnected := False; IdleConnected := False;
if FOptionsThread=nil then exit; if FOptionsThread=nil then exit;
Screen.Cursor := crHourGlass; Screen.BeginWaitCursor;
try try
FOptionsThread.EndParsing; // Make sure the options are read. FOptionsThread.EndParsing; // Make sure the options are read.
if FOptionsReader.ErrorMsg <> '' then if FOptionsReader.ErrorMsg <> '' then
@ -176,7 +176,7 @@ begin
FormatTimeWithMs(Now-StartTime)])); FormatTimeWithMs(Now-StartTime)]));
end; end;
finally finally
Screen.Cursor := crDefault; Screen.EndWaitCursor;
end; end;
FRenderedOnce := True; FRenderedOnce := True;
end; end;

4
ide/checkcompileropts.pas
View File

@ -886,7 +886,7 @@ begin
Target_PPUs:=nil; Target_PPUs:=nil;
FPC_PPUs:=nil; FPC_PPUs:=nil;
IDEMessagesWindow.Clear; IDEMessagesWindow.Clear;
Screen.Cursor:=crHourGlass; Screen.BeginWaitCursor;
try try
// make sure there is no invalid cache due to bugs // make sure there is no invalid cache due to bugs
InvalidateFileStateCache(); InvalidateFileStateCache();
@ -986,7 +986,7 @@ begin
AddMsg(lisCCOTestsSuccess,'',-1); AddMsg(lisCCOTestsSuccess,'',-1);
finally finally
Screen.Cursor:=crDefault; Screen.EndWaitCursor;
CompilerFiles.Free; CompilerFiles.Free;
CompileTool.Free; CompileTool.Free;
FTest:=cotNone; FTest:=cotNone;

4
ide/componentlist.pas
View File

@ -394,7 +394,7 @@ var
CurIcon: TImageIndex; CurIcon: TImageIndex;
begin begin
if [csDestroying,csLoading]*ComponentState<>[] then exit; if [csDestroying,csLoading]*ComponentState<>[] then exit;
Screen.Cursor := crHourGlass; Screen.BeginWaitCursor;
ListTree.BeginUpdate; ListTree.BeginUpdate;
PalletteTree.BeginUpdate; PalletteTree.BeginUpdate;
InheritanceTree.Items.BeginUpdate; InheritanceTree.Items.BeginUpdate;
@ -446,7 +446,7 @@ begin
InheritanceTree.Items.EndUpdate; InheritanceTree.Items.EndUpdate;
PalletteTree.EndUpdate; PalletteTree.EndUpdate;
ListTree.EndUpdate; ListTree.EndUpdate;
Screen.Cursor := crDefault; Screen.EndWaitCursor;
end; end;
end; end;

4
ide/definesgui.pas
View File

@ -159,7 +159,7 @@ var
i, ListInd: Integer; i, ListInd: Integer;
begin begin
IdleConnected := False; IdleConnected := False;
Screen.Cursor := crHourGlass; Screen.BeginWaitCursor;
try try
FOptionsThread.EndParsing; // Make sure the options are read. FOptionsThread.EndParsing; // Make sure the options are read.
// Parse and separate defines from other options. // Parse and separate defines from other options.
@ -177,7 +177,7 @@ begin
DefinesCheckList.Checked[ListInd] := True; DefinesCheckList.Checked[ListInd] := True;
end; end;
finally finally
Screen.Cursor := crDefault; Screen.EndWaitCursor;
end; end;
end; end;

4
ide/examplemanager.pas
View File

@ -208,7 +208,7 @@ var
i, j: Integer; i, j: Integer;
LastDir: String; LastDir: String;
begin begin
Screen.Cursor:=crHourGlass; Screen.BeginWaitCursor;
Searcher:=TListFileSearcher.Create(Self); Searcher:=TListFileSearcher.Create(Self);
IncludedDirs:=TStringList.Create; IncludedDirs:=TStringList.Create;
AllDirs:=Nil; AllDirs:=Nil;
@ -246,7 +246,7 @@ begin
AllDirs.Free; AllDirs.Free;
IncludedDirs.Free; IncludedDirs.Free;
Searcher.Free; Searcher.Free;
Screen.Cursor:=crDefault; Screen.EndWaitCursor;
end; end;
end; end;

4
ide/sourceeditor.pp
View File

@ -9848,7 +9848,7 @@ begin
FUpdateFlags := []; FUpdateFlags := [];
// Debugger cause ProcessMessages, which could lead to entering methods in unexpected order // Debugger cause ProcessMessages, which could lead to entering methods in unexpected order
DebugBoss.LockCommandProcessing; DebugBoss.LockCommandProcessing;
Screen.Cursor := crHourGlass; Screen.BeginWaitCursor;
end; end;
inc(FUpdateLock); inc(FUpdateLock);
end; end;
@ -9858,7 +9858,7 @@ begin
dec(FUpdateLock); dec(FUpdateLock);
if FUpdateLock = 0 then begin if FUpdateLock = 0 then begin
try try
Screen.Cursor := crDefault; Screen.EndWaitCursor;
if (ufShowWindowOnTop in FUpdateFlags) then if (ufShowWindowOnTop in FUpdateFlags) then
ShowActiveWindowOnTop(ufShowWindowOnTopFocus in FUpdateFlags); ShowActiveWindowOnTop(ufShowWindowOnTopFocus in FUpdateFlags);
if (ufMgrActiveEditorChanged in FUpdateFlags) then if (ufMgrActiveEditorChanged in FUpdateFlags) then

4
ide/useunitdlg.pas
View File

@ -393,7 +393,7 @@ var
SrcEdit: TSourceEditor; SrcEdit: TSourceEditor;
begin begin
if not (Assigned(FMainUsedUnits) and Assigned(FImplUsedUnits)) then Exit; if not (Assigned(FMainUsedUnits) and Assigned(FImplUsedUnits)) then Exit;
Screen.Cursor:=crHourGlass; Screen.BeginWaitCursor;
try try
FOtherUnits := TStringList.Create; FOtherUnits := TStringList.Create;
FOtherUnits.Sorted := True; FOtherUnits.Sorted := True;
@ -413,7 +413,7 @@ begin
end; end;
end; end;
finally finally
Screen.Cursor:=crDefault; Screen.EndWaitCursor;
end; end;
end; end;

1
lcl/controls.pp
View File

@ -356,7 +356,6 @@ type
private private
FDragging: Boolean; FDragging: Boolean;
FDragHotspot: TPoint; FDragHotspot: TPoint;
FOldCursor: TCursor;
FLastDragPos: TPoint; FLastDragPos: TPoint;
FLockedWindow: HWND;// window where drag started and locked via DragLock, invalid=NoLockedWindow=High(PtrInt) FLockedWindow: HWND;// window where drag started and locked via DragLock, invalid=NoLockedWindow=High(PtrInt)

8
lcl/forms.pp
View File

@ -1039,6 +1039,7 @@ type
FActiveCustomForm: TCustomForm; FActiveCustomForm: TCustomForm;
FActiveForm: TForm; FActiveForm: TForm;
FCursor: TCursor; FCursor: TCursor;
FTempCursors: array of TCursor;
FCursorMap: TMap; FCursorMap: TMap;
FCustomForms: TFPList; FCustomForms: TFPList;
FCustomFormsZOrdered: TFPList; FCustomFormsZOrdered: TFPList;
@ -1081,6 +1082,7 @@ type
function GetMonitor(Index: Integer): TMonitor; function GetMonitor(Index: Integer): TMonitor;
function GetMonitorCount: Integer; function GetMonitorCount: Integer;
function GetPrimaryMonitor: TMonitor; function GetPrimaryMonitor: TMonitor;
function GetRealCursor: TCursor;
function GetWidth : Integer; function GetWidth : Integer;
procedure AddForm(AForm: TCustomForm); procedure AddForm(AForm: TCustomForm);
procedure RemoveForm(AForm: TCustomForm); procedure RemoveForm(AForm: TCustomForm);
@ -1158,11 +1160,17 @@ type
MonitorDefault: TMonitorDefaultTo = mdNearest): TMonitor; MonitorDefault: TMonitorDefaultTo = mdNearest): TMonitor;
function MonitorFromWindow(const Handle: THandle; function MonitorFromWindow(const Handle: THandle;
MonitorDefault: TMonitorDefaultTo = mdNearest): TMonitor; MonitorDefault: TMonitorDefaultTo = mdNearest): TMonitor;
procedure BeginTempCursor(const aCursor: TCursor);
procedure EndTempCursor(const aCursor: TCursor);
procedure BeginWaitCursor;
procedure EndWaitCursor;
public public
property ActiveControl: TWinControl read FActiveControl; property ActiveControl: TWinControl read FActiveControl;
property ActiveCustomForm: TCustomForm read FActiveCustomForm; property ActiveCustomForm: TCustomForm read FActiveCustomForm;
property ActiveForm: TForm read FActiveForm; property ActiveForm: TForm read FActiveForm;
property Cursor: TCursor read FCursor write SetCursor; property Cursor: TCursor read FCursor write SetCursor;
property RealCursor: TCursor read GetRealCursor;
property Cursors[Index: Integer]: HCURSOR read GetCursors write SetCursors; property Cursors[Index: Integer]: HCURSOR read GetCursors write SetCursors;
property CustomFormCount: Integer read GetCustomFormCount; property CustomFormCount: Integer read GetCustomFormCount;
property CustomForms[Index: Integer]: TCustomForm read GetCustomForms; property CustomForms[Index: Integer]: TCustomForm read GetCustomForms;

2
lcl/include/control.inc
View File

@ -2927,7 +2927,7 @@ procedure TControl.UpdateMouseCursor(X, Y: integer);
begin begin
//DebugLn(['TControl.UpdateMouseCursor ',DbgSName(Self)]); //DebugLn(['TControl.UpdateMouseCursor ',DbgSName(Self)]);
if csDesigning in ComponentState then Exit; if csDesigning in ComponentState then Exit;
if Screen.Cursor <> crDefault then Exit; if Screen.RealCursor <> crDefault then Exit;
SetTempCursor(Cursor); SetTempCursor(Cursor);
end; end;

6
lcl/include/customform.inc
View File

@ -2914,7 +2914,6 @@ var
DisabledList: TList; DisabledList: TList;
SavedFocusState: TFocusState; SavedFocusState: TFocusState;
ActiveWindow: HWnd; ActiveWindow: HWnd;
SavedCursor: TCursor;
begin begin
if Self = nil then if Self = nil then
raise EInvalidOperation.Create('TCustomForm.ShowModal Self = nil'); 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 RecreateWnd(Self); // need to refresh handle for pmNone because ParentWindow changes if (fsModal in FFormState) - see GetRealPopupParent
ActiveWindow := GetActiveWindow; ActiveWindow := GetActiveWindow;
SavedFocusState := SaveFocusState; SavedFocusState := SaveFocusState;
SavedCursor := Screen.Cursor;
Screen.FSaveFocusedList.Insert(0, Screen.FFocusedForm); Screen.FSaveFocusedList.Insert(0, Screen.FFocusedForm);
Screen.FFocusedForm := Self; Screen.FFocusedForm := Self;
Screen.MoveFormToFocusFront(Self); Screen.MoveFormToFocusFront(Self);
Screen.Cursor := crDefault; Screen.BeginTempCursor(crDefault);
ModalResult := 0; ModalResult := 0;
try try
@ -3001,7 +2999,7 @@ begin
end; end;
finally finally
RestoreFocusState(SavedFocusState); RestoreFocusState(SavedFocusState);
Screen.Cursor := SavedCursor; Screen.EndTempCursor(crDefault);
if LCLIntf.IsWindow(ActiveWindow) then if LCLIntf.IsWindow(ActiveWindow) then
SetActiveWindow(ActiveWindow); SetActiveWindow(ActiveWindow);
Exclude(FFormState, fsModal); Exclude(FFormState, fsModal);

13
lcl/include/dragimagelist.inc
View File

@ -25,9 +25,12 @@ const
procedure TDragImageList.SetDragCursor(const AValue: TCursor); procedure TDragImageList.SetDragCursor(const AValue: TCursor);
begin begin
if FDragCursor = AValue then exit; if FDragCursor = AValue then exit;
FDragCursor := AValue;
if Dragging then if Dragging then
WidgetSet.SetCursor(Screen.Cursors[DragCursor]); begin
Screen.BeginTempCursor(AValue);
Screen.EndTempCursor(DragCursor);
end;
FDragCursor := AValue;
end; end;
procedure TDragImageList.SetDragHotspot(const aDragHotspot: TPoint); procedure TDragImageList.SetDragHotspot(const aDragHotspot: TPoint);
@ -184,7 +187,6 @@ begin
inherited Create(TheOwner); inherited Create(TheOwner);
FLastDragPos := Point(0, 0); FLastDragPos := Point(0, 0);
FOldCursor := crNone;
FLockedWindow := NoLockedWindow; FLockedWindow := NoLockedWindow;
end; end;
@ -197,8 +199,7 @@ begin
if Result then if Result then
begin begin
DragLock(Window, X, Y); DragLock(Window, X, Y);
FOldCursor := Screen.Cursor; Screen.BeginTempCursor(ImageList.DragCursor);
WidgetSet.SetCursor(Screen.Cursors[ImageList.DragCursor])
end; end;
end; end;
@ -250,7 +251,7 @@ begin
DragUnlock; DragUnlock;
TWSDragImageListResolutionClass(WidgetSetClass).EndDrag(Self); TWSDragImageListResolutionClass(WidgetSetClass).EndDrag(Self);
FDragging := False; FDragging := False;
WidgetSet.SetCursor(Screen.Cursors[FOldCursor]) Screen.EndTempCursor(ImageList.DragCursor);
end; end;
function TDragImageListResolution.GetHotSpot: TPoint; function TDragImageListResolution.GetHotSpot: TPoint;

2
lcl/include/dragmanager.inc
View File

@ -220,7 +220,7 @@ begin
if FDragImageList <> nil then if FDragImageList <> nil then
FDragImageList.EndDrag; FDragImageList.EndDrag;
WidgetSet.SetCursor(Screen.Cursors[Screen.Cursor]); WidgetSet.SetCursor(Screen.Cursors[Screen.RealCursor]);
if (ADragObjectCopy.DragTarget <> nil) and (ADragObjectCopy.DragTarget is TControl) then if (ADragObjectCopy.DragTarget <> nil) and (ADragObjectCopy.DragTarget is TControl) then
TargetPos := ADragObjectCopy.DragTargetPos //controls can override the position TargetPos := ADragObjectCopy.DragTargetPos //controls can override the position
else else

4
lcl/include/promptdialog.inc
View File

@ -942,16 +942,12 @@ function DefaultQuestionDialog(const aCaption, aMsg: string; DlgType: LongInt;
} }
var var
QuestionDialog: TQuestionDlg; QuestionDialog: TQuestionDlg;
last_cur: TCursor;
begin begin
QuestionDialog := TQuestionDlg.CreateQuestionDlg(aCaption, aMsg, DlgType, Buttons, HelpCtx); QuestionDialog := TQuestionDlg.CreateQuestionDlg(aCaption, aMsg, DlgType, Buttons, HelpCtx);
last_cur := Screen.Cursor;
Screen.Cursor := crDefault;
try try
Result := QuestionDialog.ShowModal; Result := QuestionDialog.ShowModal;
finally finally
QuestionDialog.Free; QuestionDialog.Free;
Screen.Cursor := last_cur;
end; end;
end; end;

54
lcl/include/screen.inc
View File

@ -295,6 +295,22 @@ begin
AddHandler(snRemoveForm,TMethod(OnRemoveForm),AsFirst); AddHandler(snRemoveForm,TMethod(OnRemoveForm),AsFirst);
end; 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); procedure TScreen.RemoveHandlerRemoveForm(OnRemoveForm: TScreenFormEvent);
begin begin
RemoveHandler(snRemoveForm,TMethod(OnRemoveForm)); RemoveHandler(snRemoveForm,TMethod(OnRemoveForm));
@ -409,6 +425,30 @@ begin
FreeAndNil(AFormList); FreeAndNil(AFormList);
end; 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; function TScreen.UpdatedMonitor(AHandle: HMONITOR; ADefault: TMonitorDefaultTo;
AErrorMsg: string): TMonitor; AErrorMsg: string): TMonitor;
var var
@ -807,6 +847,14 @@ begin
Result := nil; Result := nil;
end; end;
function TScreen.GetRealCursor: TCursor;
begin
if Length(FTempCursors)>0 then
Result := FTempCursors[High(FTempCursors)]
else
Result := Cursor;
end;
function TScreen.GetSystemFont: TFont; function TScreen.GetSystemFont: TFont;
begin begin
if (FSystemFont = nil) then if (FSystemFont = nil) then
@ -909,11 +957,15 @@ end;
procedure TScreen.SetCursor(const AValue: TCursor); procedure TScreen.SetCursor(const AValue: TCursor);
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
procedure TScreen.SetCursor(const AValue: TCursor); procedure TScreen.SetCursor(const AValue: TCursor);
var
OldCursor: TCursor;
begin begin
if AValue <> Cursor then if AValue <> Cursor then
begin begin
OldCursor := RealCursor;
FCursor := AValue; FCursor := AValue;
WidgetSet.SetCursor(Cursors[FCursor]); if OldCursor<>RealCursor then
WidgetSet.SetCursor(Cursors[RealCursor]);
end; end;
end; end;

4
lcl/interfaces/carbon/carbonprivatecommon.inc
View File

@ -341,7 +341,7 @@ begin
Widget := GetCarbonWidget(Control); Widget := GetCarbonWidget(Control);
if Widget = nil then Exit; if Widget = nil then Exit;
if Screen.Cursor = crDefault then // we can change cursor if Screen.RealCursor = crDefault then // we can change cursor
begin begin
ACursorWasSet := False; ACursorWasSet := False;
@ -502,7 +502,7 @@ begin
DeliverMessage(AWidget.LCLObject, Msg); DeliverMessage(AWidget.LCLObject, Msg);
} }
ACursor := Screen.Cursor; ACursor := Screen.RealCursor;
if ACursor = crDefault then if ACursor = crDefault then
begin begin
ACursor := AWidget.LCLObject.Cursor; ACursor := AWidget.LCLObject.Cursor;

2
lcl/interfaces/carbon/carbonwscontrols.pp
View File

@ -327,7 +327,7 @@ begin
TCarbonWidget(AWinControl.Handle).SetCursor(ACursor); TCarbonWidget(AWinControl.Handle).SetCursor(ACursor);
if (Screen.Cursor <> crDefault) then Exit; if (Screen.RealCursor <> crDefault) then Exit;
TopWindow := TCarbonWidget(AWinControl.Handle).GetTopParentWindow; TopWindow := TCarbonWidget(AWinControl.Handle).GetTopParentWindow;
TopView := HIViewGetRoot(TopWindow); TopView := HIViewGetRoot(TopWindow);

2
lcl/interfaces/cocoa/cocoawscommon.pas
View File

@ -1470,7 +1470,7 @@ begin
if not Assigned(Target) then Exit; if not Assigned(Target) then Exit;
if not (csDesigning in Target.ComponentState) then if not (csDesigning in Target.ComponentState) then
begin begin
ACursor := Screen.Cursor; ACursor := Screen.RealCursor;
if ACursor = crDefault then if ACursor = crDefault then
begin begin
// traverse visible child controls // traverse visible child controls

2
lcl/interfaces/customdrawn/wincallback.inc
View File

@ -267,7 +267,7 @@ Var
Dec(P.X, BoundsOffset.Left); Dec(P.X, BoundsOffset.Left);
Dec(P.Y, BoundsOffset.Top); Dec(P.Y, BoundsOffset.Top);
end; end;
ACursor := Screen.Cursor; ACursor := Screen.RealCursor;
if ACursor = crDefault then if ACursor = crDefault then
begin begin
// statictext controls do not get WM_SETCURSOR messages... // statictext controls do not get WM_SETCURSOR messages...

2
lcl/interfaces/win32/win32callback.inc
View File

@ -851,7 +851,7 @@ begin
begin begin
if not (csDesigning in lWinControl.ComponentState) and (LOWORD(LParam) = HTCLIENT) then if not (csDesigning in lWinControl.ComponentState) and (LOWORD(LParam) = HTCLIENT) then
begin begin
ACursor := Screen.Cursor; ACursor := Screen.RealCursor;
if ACursor = crDefault then if ACursor = crDefault then
begin begin
Windows.GetCursorPos(Windows.POINT(P)); Windows.GetCursorPos(Windows.POINT(P));

2
lcl/interfaces/win32/win32wscontrols.pp
View File

@ -502,7 +502,7 @@ begin
Exit; Exit;
end; end;
if Screen.Cursor <> crDefault then exit; if Screen.RealCursor <> crDefault then exit;
Windows.GetCursorPos(CursorPos); Windows.GetCursorPos(CursorPos);

2
lcl/interfaces/wince/wincecallback.inc
View File

@ -711,7 +711,7 @@ Var
Dec(P.X, BoundsOffset.Left); Dec(P.X, BoundsOffset.Left);
Dec(P.Y, BoundsOffset.Top); Dec(P.Y, BoundsOffset.Top);
end; end;
ACursor := Screen.Cursor; ACursor := Screen.RealCursor;
if ACursor = crDefault then if ACursor = crDefault then
begin begin
// statictext controls do not get WM_SETCURSOR messages... // statictext controls do not get WM_SETCURSOR messages...

202
tools/apiwizz/apiwizard.pp
View File

@ -782,82 +782,59 @@ var
Item: TListItem; Item: TListItem;
WS: TApiWidgetset; WS: TApiWidgetset;
begin begin
Screen.Cursor := crHourGlass;
lvExisting.BeginUpdate; lvExisting.BeginUpdate;
Clear; Screen.BeginWaitCursor;
Lines := TStringList.Create; Lines := TStringList.Create;
Scan(txtLazarus.text + '/lcl/include/winapih.inc', 'ps', Lines); try
for n := 0 to Lines.Count - 1 do Clear;
begin
Line := TApiLine.Create;
Line.Declaration := Lines[n];
Line.WinApi := True;
S := GetName(Lines[n]);
FLineInfo.AddObject(S, Line);
end;
Scan(txtLazarus.text + '/lcl/include/winapih.inc', 'pi', Lines); Scan(txtLazarus.text + '/lcl/include/winapih.inc', 'ps', Lines);
for n := 0 to Lines.Count - 1 do for n := 0 to Lines.Count - 1 do
begin begin
S := GetName(Lines[n]); Line := TApiLine.Create;
if FLineInfo.IndexOf(s) >= 0 then Continue; //overloaded Line.Declaration := Lines[n];
Line.WinApi := True;
S := GetName(Lines[n]);
FLineInfo.AddObject(S, Line);
end;
Line := TApiLine.Create; Scan(txtLazarus.text + '/lcl/include/winapih.inc', 'pi', Lines);
Line.Independent := True; for n := 0 to Lines.Count - 1 do
Line.WinApi := True; begin
Line.Declaration := Lines[n]; S := GetName(Lines[n]);
FLineInfo.AddObject(S, Line); if FLineInfo.IndexOf(s) >= 0 then Continue; //overloaded
end;
Scan(txtLazarus.text + '/lcl/include/lclintfh.inc', 'ps', Lines); Line := TApiLine.Create;
for n := 0 to Lines.Count - 1 do Line.Independent := True;
begin Line.WinApi := True;
Line := TApiLine.Create; Line.Declaration := Lines[n];
Line.Declaration := Lines[n]; FLineInfo.AddObject(S, Line);
S := GetName(Lines[n]); end;
FLineInfo.AddObject(S, Line);
end;
Scan(txtLazarus.text + '/lcl/include/lclintfh.inc', 'pi', Lines); Scan(txtLazarus.text + '/lcl/include/lclintfh.inc', 'ps', Lines);
for n := 0 to Lines.Count - 1 do for n := 0 to Lines.Count - 1 do
begin begin
S := GetName(Lines[n]); Line := TApiLine.Create;
if FLineInfo.IndexOf(s) >= 0 then Continue; //overloaded Line.Declaration := Lines[n];
S := GetName(Lines[n]);
FLineInfo.AddObject(S, Line);
end;
Line := TApiLine.Create; Scan(txtLazarus.text + '/lcl/include/lclintfh.inc', 'pi', Lines);
Line.Independent := True; for n := 0 to Lines.Count - 1 do
Line.Declaration := Lines[n]; begin
FLineInfo.AddObject(S, Line); S := GetName(Lines[n]);
end; 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); // implementations
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]); Scan(txtLazarus.text + '/lcl/include/intfbasewinapi.inc', 'ps', Lines);
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);
for n := 0 to Lines.Count - 1 do for n := 0 to Lines.Count - 1 do
begin begin
S := GetName(Lines[n]); S := GetName(Lines[n]);
@ -865,10 +842,10 @@ begin
if idx = -1 then Continue; if idx = -1 then Continue;
Line := TApiLine(FLineInfo.Objects[idx]); Line := TApiLine(FLineInfo.Objects[idx]);
Include(Line.Widgetsets, WS); Line.Base := True;
end; 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 for n := 0 to Lines.Count - 1 do
begin begin
S := GetName(Lines[n]); S := GetName(Lines[n]);
@ -876,51 +853,74 @@ begin
if idx = -1 then Continue; if idx = -1 then Continue;
Line := TApiLine(FLineInfo.Objects[idx]); Line := TApiLine(FLineInfo.Objects[idx]);
Include(Line.Widgetsets, WS); Line.Base := True;
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; end;
for WS := Low(WS) to High(Ws) do for WS := Low(WS) to High(Ws) do
begin 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') then Item.SubItems.Add('X')
else begin else begin
if Line.Independent if Line.Independent
then Item.SubItems.Add('-') then Item.SubItems.Add('-')
else Item.SubItems.Add(''); else Item.SubItems.Add('');
end; 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; end;
finally
Lines.Free;
Screen.EndWaitCursor;
lvExisting.EndUpdate;
end; end;
lvExisting.EndUpdate;
Lines.Free;
Screen.Cursor := crDefault;
end; end;
procedure TApiWizForm.FormDestroy(Sender: TObject); procedure TApiWizForm.FormDestroy(Sender: TObject);