mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-16 07:09:38 +02:00
added included by to unitinfo and a few win32 functions
git-svn-id: trunk@3737 -
This commit is contained in:
mattias
parent
056920e6eb
commit
6167af23a2
lcl
22
lcl/forms.pp
22
lcl/forms.pp
@ -433,15 +433,30 @@ type
|
||||
|
||||
{ TScreen }
|
||||
|
||||
PCursorRec = ^TCursorRec;
|
||||
TCursorRec = record
|
||||
Next: PCursorRec;
|
||||
Index: Integer;
|
||||
Handle: HCURSOR;
|
||||
end;
|
||||
|
||||
TScreen = class(TComponent)
|
||||
private
|
||||
FCursor: TCursor;
|
||||
FCursorCount: integer;
|
||||
FCursorList: PCursorRec;
|
||||
FDefaultCursor: HCURSOR;
|
||||
FFocusedForm: TCustomForm;
|
||||
FFonts : TStrings;
|
||||
FFormList: TList;
|
||||
FHintFont : TFont;
|
||||
FPixelsPerInch : integer;
|
||||
FSaveFocusedList: TList;
|
||||
FFonts : TStrings;
|
||||
|
||||
procedure CreateCursors;
|
||||
procedure DeleteCursor(Index: Integer);
|
||||
procedure DestroyCursors;
|
||||
function GetCursors(Index: Integer): HCURSOR;
|
||||
function GetFonts : TStrings;
|
||||
function GetFormCount: Integer;
|
||||
function GetForms(IIndex: Integer): TForm;
|
||||
@ -449,9 +464,14 @@ type
|
||||
function GetWidth : Integer;
|
||||
procedure AddForm(FForm: TCustomForm);
|
||||
procedure RemoveForm(FForm: TCustomForm);
|
||||
procedure SetCursor(const AValue: TCursor);
|
||||
procedure SetCursors(Index: Integer; const AValue: HCURSOR);
|
||||
public
|
||||
constructor Create(AOwner : TComponent); override;
|
||||
destructor Destroy; Override;
|
||||
public
|
||||
property Cursor: TCursor read FCursor write SetCursor;
|
||||
property Cursors[Index: Integer]: HCURSOR read GetCursors write SetCursors;
|
||||
property FormCount: Integer read GetFormCount;
|
||||
property Forms[Index: Integer]: TForm read GetForms;
|
||||
property Fonts : TStrings read GetFonts;
|
||||
|
||||
@ -54,19 +54,87 @@ begin
|
||||
FreeThenNil(FFonts);
|
||||
inherited Destroy;
|
||||
end;
|
||||
{
|
||||
|
||||
FUNCTIONS
|
||||
|
||||
|
||||
|
||||
}
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
function TScreen.GetFonts : TStrings;
|
||||
------------------------------------------------------------------------------}
|
||||
function TScreen.GetFonts : TStrings;
|
||||
begin
|
||||
Result := FFonts;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
procedure TScreen.CreateCursors;
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TScreen.CreateCursors;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
procedure TScreen.DeleteCursor(Index: Integer);
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TScreen.DeleteCursor(Index: Integer);
|
||||
var
|
||||
P, Q: PCursorRec;
|
||||
begin
|
||||
P := FCursorList;
|
||||
Q := nil;
|
||||
while (P <> nil) and (P^.Index <> Index) do begin
|
||||
Q := P;
|
||||
P := P^.Next;
|
||||
end;
|
||||
if P <> nil then begin
|
||||
writeln('ToDo: TScreen.DeleteCursor');
|
||||
//DestroyCursor(P^.Handle);
|
||||
if Q = nil then
|
||||
FCursorList := P^.Next
|
||||
else
|
||||
Q^.Next := P^.Next;
|
||||
Dispose(P);
|
||||
end;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
procedure TScreen.DestroyCursors;
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TScreen.DestroyCursors;
|
||||
var
|
||||
P, Next: PCursorRec;
|
||||
//Hdl: THandle;
|
||||
begin
|
||||
P := FCursorList;
|
||||
while P <> nil do begin
|
||||
writeln('ToDo: TScreen.DeleteCursor');
|
||||
//DestroyCursor(P^.Handle);
|
||||
Next := P^.Next;
|
||||
Dispose(P);
|
||||
P := Next;
|
||||
end;
|
||||
{Hdl := LoadCursor(0, IDC_ARROW);
|
||||
if Hdl <> FDefaultCursor then
|
||||
DestroyCursor(FDefaultCursor);}
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
function TScreen.GetCursors(Index: Integer): HCURSOR;
|
||||
------------------------------------------------------------------------------}
|
||||
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: TScreen.AddForm
|
||||
Params: FForm: The form to be added
|
||||
@ -144,6 +212,51 @@ begin
|
||||
FFormList.Remove(FForm);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
procedure TScreen.SetCursor(const AValue: TCursor);
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TScreen.SetCursor(const AValue: TCursor);
|
||||
//var
|
||||
//MousePos: TPoint;
|
||||
//Handle: HWND;
|
||||
//Code: Longint;
|
||||
begin
|
||||
if AValue <> Cursor then begin
|
||||
FCursor := AValue;
|
||||
{if AValue = crDefault then begin
|
||||
// Reset the cursor to the default by sending a WM_SETCURSOR to the
|
||||
// window under the cursor
|
||||
GetCursorPos(MousePos);
|
||||
Handle := WindowFromPoint(MousePos);
|
||||
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;}
|
||||
LCLLinux.SetCursor(Cursors[FCursor]);
|
||||
end;
|
||||
Inc(FCursorCount);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
procedure TScreen.SetCursors(Index: Integer; const AValue: HCURSOR);
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TScreen.SetCursors(Index: Integer; const AValue: HCURSOR);
|
||||
begin
|
||||
{if Index = crDefault then
|
||||
if Handle = 0 then
|
||||
FDefaultCursor := LoadCursor(0, IDC_ARROW)
|
||||
else
|
||||
FDefaultCursor := Handle
|
||||
else if Index <> crNone then
|
||||
begin
|
||||
DeleteCursor(Index);
|
||||
if Handle <> 0 then InsertCursor(Index, Handle);
|
||||
end;}
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Function: TScreen.MyFunction
|
||||
|
||||
@ -2037,12 +2037,9 @@ End;
|
||||
Sets the window origin of the device context by using the specified coordinates.
|
||||
------------------------------------------------------------------------------}
|
||||
Function TWin32Object.SetWindowOrgEx(DC: HDC; NewX, NewY: Integer;
|
||||
Var OldPoint: TPoint): Boolean;
|
||||
OldPoint: PPoint): Boolean;
|
||||
Begin
|
||||
//writeln('[TWin32Object.SetWindowOrgEx] ', NewX, ' ', NewY);
|
||||
// ToDo: move origin
|
||||
|
||||
Result := Windows.SetWindowOrgEx(DC, NewX, NewY, @OldPoint);
|
||||
Result := Windows.SetWindowOrgEx(DC, NewX, NewY, OldPoint);
|
||||
End;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -2269,6 +2266,9 @@ end;
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.26 2002/12/26 11:00:15 mattias
|
||||
added included by to unitinfo and a few win32 functions
|
||||
|
||||
Revision 1.25 2002/12/25 13:30:37 mattias
|
||||
added more windows funcs and fixed jump to compiler error end of file
|
||||
|
||||
|
||||
@ -149,7 +149,7 @@ Function SetSysColors(CElements: Integer; Const LPAElements; Const LPARgbValues)
|
||||
Function SetTextCharacterExtra(_HDC: HDC; NCharExtra: Integer): Integer; Override;
|
||||
Function SetTextColor(DC: HDC; Color: TColorRef): TColorRef; Override;
|
||||
Function SetWindowLong(Handle: HWND; Idx: Integer; NewLong: LongInt): LongInt; Override;
|
||||
Function SetWindowOrgEx(DC: HDC; NewX, NewY: Integer; Var OldPoint: TPoint): Boolean; Override;
|
||||
Function SetWindowOrgEx(DC: HDC; NewX, NewY: Integer; OldPoint: PPoint): Boolean; Override;
|
||||
Function SetWindowPos(HWnd: HWND; HWndInsertAfter: HWND; X, Y, CX, CY: Integer; UFlags: UINT): Boolean; Override;
|
||||
Function ShowCaret(HWnd: HWND): Boolean; Override;
|
||||
Function ShowScrollBar(Handle: HWND; WBar: Integer; BShow: Boolean): Boolean; Override;
|
||||
@ -170,6 +170,9 @@ Procedure DeleteCriticalSection(var CritSection: TCriticalSection); Override;
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.18 2002/12/26 11:00:15 mattias
|
||||
added included by to unitinfo and a few win32 functions
|
||||
|
||||
Revision 1.17 2002/12/25 13:30:37 mattias
|
||||
added more windows funcs and fixed jump to compiler error end of file
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user