Kopao sam još dublje, i evo skoro sve funkcije redom kojim se otvaraju, sve dok se pokazivač ne promeni u peščani sat.
Code:
procedure TDBDataSet.CloseCursor;
begin
inherited CloseCursor;
SetDBFlag(dbfOpened, False); <<<<OVA<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
end;
function TQuery.SetDBFlag(Flag: Integer; Value: Boolean): Boolean;
var
NewConnection: Boolean;
begin
if Value then
begin
NewConnection := DBFlags = [];
Result := inherited SetDBFlag(Flag, Value);
if not (csReading in ComponentState) and NewConnection then
FLocal := not Database.IsSQLBased;
end
else begin
if DBFlags - [Flag] = [] then SetPrepared(False); <<<<OVA<<<<<<<<<<<<<<<<<<
Result := inherited SetDBFlag(Flag, Value);
end;
end;
procedure TQuery.SetPrepared(Value: Boolean);
begin
if Handle <> nil then DatabaseError(SDataSetOpen, Self);
if Value <> Prepared then
begin
if Value then
begin
FRowsAffected := -1;
FCheckRowsAffected := True;
if Length(Text) > 1 then PrepareSQL(PChar(Text))
else DatabaseError(SEmptySQLStatement, Self);
end
else
begin
if FCheckRowsAffected then
FRowsAffected := RowsAffected;
FreeStatement;
end;
FPrepared := Value;
end;
end;
procedure TQuery.FreeStatement;
var
Result: DbiResult;
begin
if StmtHandle <> nil then
begin
Result := DbiQFree(FStmtHandle);
if not (csDestroying in ComponentState) then
Check(Result);
end;
end;
function BdeCallBack(CallType: CBType; Data: Longint;
CBInfo: Pointer): CBRType; stdcall;
begin
if (Data <> 0) then
Result := TBDECallback(Data).Invoke(CallType, CBInfo) else
Result := cbrUSEDEF;
end;
function TBDECallback.Invoke(CallType: CBType; CBInfo: Pointer): CBRType;
begin
if CallType = FCBType then
Result := FCallbackEvent(CBInfo) else
Result := cbrUSEDEF;
if Assigned(FOldCBFunc)
then Result := FOldCBFunc(CallType, FOldCBData, CBInfo);
end;
function TSession.ServerCallBack(CBInfo: Pointer): CBRType;
begin
Result := cbrUSEDEF;
if (GetCurrentThreadID <> MainThreadID) then Exit;
if (FCBSCType = cbscSQL) then
begin
if TimerID = 0 then
TimerID := SetTimer(0, 0, SQLDelay, @TimerCallBack);
if Assigned(DBScreen) and (DBScreen.Cursor <> dcrSQLWait) then
DBScreen.Cursor := dcrSQLWait; <<<<OVA<<<<<<<<<<<<<<<<<<<<<<
StartTime := GetTickCount;
end;
end;
procedure TVCLScreenApplication.SetCursor(Cursor: TDBScreenCursor);
begin
case Cursor of
dcrDefault: Forms.Screen.Cursor := crDefault;
dcrHourGlass: Forms.Screen.Cursor := crHourGlass;
dcrSQLWait: Forms.Screen.Cursor := crSQLWait; <<<<OVA<<<<<<<<<<<<<<<<<<<<<
end;
end;
procedure TScreen.SetCursor(Value: TCursor);
var
P: TPoint;
Handle: HWND;
Code: Longint;
begin
if Value <> Cursor then
begin
FCursor := Value;
if Value = crDefault then
begin
{ Reset the cursor to the default by sending a WM_SETCURSOR to the
window under the cursor }
GetCursorPos(P);
Handle := WindowFromPoint(P);
if (Handle <> 0) and
(GetWindowThreadProcessId(Handle, nil) = GetCurrentThreadId) then
begin
Code := SendMessage(Handle, WM_NCHITTEST, 0, LongInt(PointToSmallPoint(P)));
SendMessage(Handle, WM_SETCURSOR, Handle, MakeLong(Code, WM_MOUSEMOVE));
Exit;
end;
end;
Windows.SetCursor(Cursors[Value]); <<<<<<OVA<<<<<<<<<<<<<<<
end;
Inc(FCursorCount); <<<<<<<<<<<OVDE JE VEC PESCANI SAT<<<<<<<<<<<<<<
end;
function TScreen.GetCursors(Index: Integer): HCURSOR;
var
P: PCursorRec;
begin
Result := 0;
if Index <> crNone then
begin
P := FCursorList;
while (P <> nil) and (P^.Index <> Index) do P := P^.Next;
if P = nil then Result := FDefaultCursor else Result := P^.Handle;
end;
end;
function SetCursor; external user32 name 'SetCursor'; <<<<<<<OVO MENJA<<<<<<<<<
E, sada, kako ja da sredim to (po mogućnosti regularno, bez prljavih trikova) da se taj pokazivač ne menja u peščani sat?