paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-05-28 16:02:49 +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
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;

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

@ -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;

4
components/onlinepackagemanager/opkman_mainfrm.pas
View File

@ -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);

6
components/pochecker/graphstat.pp
View File

@ -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;

6
components/pochecker/pocheckermain.pp
View File

@ -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;

4
components/todolist/todolist.pas
View File

@ -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;

4
converter/chgencodingdlg.pas
View File

@ -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;

8
converter/convertdelphi.pas
View File

@ -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;

10
converter/missingpropertiesdlg.pas
View File

@ -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;

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

@ -9973,6 +9973,15 @@
</descr>
<seealso/>
</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>
<!-- Forms -->
</package>

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

@ -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;

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

@ -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;

12
examples/imgviewer/frmmain.pas
View File

@ -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;

4
ide/allcompileroptions.pas
View File

@ -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;

4
ide/checkcompileropts.pas
View File

@ -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;

4
ide/componentlist.pas
View File

@ -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;

4
ide/definesgui.pas
View File

@ -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;

4
ide/examplemanager.pas
View File

@ -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;

4
ide/sourceeditor.pp
View File

@ -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

4
ide/useunitdlg.pas
View File

@ -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;

1
lcl/controls.pp
View File

@ -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)

8
lcl/forms.pp
View File

@ -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;

2
lcl/include/control.inc
View File

@ -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;

6
lcl/include/customform.inc
View File

@ -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);

13
lcl/include/dragimagelist.inc
View File

@ -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;

2
lcl/include/dragmanager.inc
View File

@ -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

4
lcl/include/promptdialog.inc
View File

@ -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;

54
lcl/include/screen.inc
View File

@ -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;

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

@ -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;

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

@ -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);

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

@ -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

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

@ -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...

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

@ -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));

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

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

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

@ -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...

202
tools/apiwizz/apiwizard.pp
View File

@ -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);