paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-21 16:59:36 +02:00
Code Issues Packages Projects Releases Wiki Activity

Keith: Fixed persistent label captions and a few less noticable things

Browse Source 
git-svn-id: trunk@671 -
This commit is contained in:
lazarus 2002-02-07 08:35:13 +00:00
parent 83a1947ff0
commit ae9eee5b17
6 changed files with 73 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -142,7 +142,12 @@ Begin
Case Hi(WParam) Of
0:
Begin
LMessage.Msg := LM_CLICKED;
If ((OwnerObject Is TControl) And (Not (OwnerObject Is TButton))) Then
CallEvent(OwnerObject, TControl(OwnerObject).OnClick, Nil, etNotify)
Else If OwnerObject Is TMenuItem Then
LMessage.Msg := LM_ACTIVATE
Else
LMessage.Msg := LM_CLICKED;
End;
BN_KILLFOCUS, EN_KILLFOCUS:
Begin
@ -1485,6 +1490,9 @@ end;}
{
$Log$
Revision 1.10 2002/02/07 08:35:12 lazarus
Keith: Fixed persistent label captions and a few less noticable things
Revision 1.9 2002/02/04 10:54:33 lazarus
Keith:
* Fixes for Win32

5
lcl/interfaces/win32/win32int.pp
View File

@ -249,6 +249,8 @@ Type
Reserved: Pointer;
End;
TEventType = (etNotify, etKey, etKeyPress, etMouseWheeel, etMouseUpDown);
{ Linked list of objects for events }
PLazObject = ^TLazObject;
TLazObject = Record
@ -333,6 +335,9 @@ End.
{ =============================================================================
$Log$
Revision 1.11 2002/02/07 08:35:12 lazarus
Keith: Fixed persistent label captions and a few less noticable things
Revision 1.10 2002/02/03 06:06:25 lazarus
Keith: Fixed Win32 compilation problems

27
lcl/interfaces/win32/win32object.inc
View File

@ -157,9 +157,10 @@ End;
------------------------------------------------------------------------------}
Procedure TWin32Object.SetLabel(Sender: TObject; Data: Pointer);
Var
Handle, Wnd: HWnd;
Handle, HOwner, Wnd: HWnd;
I: Integer;
P: Pointer;
R: TRect;
TbBI: TBBUTTONINFO;
TCI: TC_ITEM;
PLabel: PChar;
@ -172,6 +173,7 @@ Begin
Assert(False, Format('Trace:WARNING: [TWin32Object.SetLabel] %S --> No Decendant of TWinControl', [Sender.ClassName]));
Handle := (Sender As TWinControl).Handle;
HOwner := GetAncestor(Handle, GA_ROOTOWNER);
P := Pointer(Handle);
Wnd := PWin32Control(@Sender)^.Window;
Assert(P = Nil, 'Trace:WARNING: [TWin32Object.SetLabel] --> Got nil pointer');
@ -220,6 +222,14 @@ Begin
End;
Else
SetWindowText(Handle, Data);
If TControl(Sender).FCompStyle = csLabel Then
Begin
GetClientRect(HOwner, R);
InvalidateRect(HOwner, @R, True);
UpdateWindow(HOwner);
End;
Assert(False, Format('Trace:[TWin32Object.SetLabel] %S --> END', [Sender.ClassName]));
End;
End;
@ -1338,7 +1348,7 @@ Var
End;
Begin
Assert(False, 'Trace:TWin32Object.CreateCommonDialog - Start');
Assert(False, Format('Trace:TWin32Object.CreateCommonDialog - class name --> ', [TCommonDialog(Sender).ClassName]));
Assert(False, Format('Trace:TWin32Object.CreateCommonDialog - class name --> ', [Sender.ClassName]));
If Sender Is TColorDialog Then
Begin
CC := LPChooseColor(@Sender)^;
@ -2199,18 +2209,22 @@ end;
Shows or hides a control
------------------------------------------------------------------------------}
Procedure TWin32Object.ShowHide(Sender: TObject);
Var
Handle: HWND;
Begin
Handle := ObjectToHWND(Sender);
If TControl(Sender).Visible Then
Begin
Assert(False, 'Trace: [TWin32Object.ShowHide] Showing the window');
ShowWindow(TWinControl(Sender).Handle, SW_SHOW);
ShowWindow(Handle, SW_SHOW);
If (Sender Is TCustomForm) Then
SetClassLong(TWinControl(Sender).Handle, GCL_HIcon, TCustomForm(Sender).GetIconHandle);
SetClassLong(Handle, GCL_HIcon, TCustomForm(Sender).GetIconHandle);
End
Else
Begin
Assert(False, 'TRACE: [TWin32Object.ShowHide] Hiding the window');
ShowWindow(TWinControl(Sender).Handle, SW_HIDE);
ShowWindow(Handle, SW_HIDE);
End;
End;
@ -3087,6 +3101,9 @@ End;
{
$Log$
Revision 1.16 2002/02/07 08:35:12 lazarus
Keith: Fixed persistent label captions and a few less noticable things
Revision 1.15 2002/02/04 10:54:33 lazarus
Keith:
* Fixes for Win32

27
lcl/interfaces/win32/win32proc.inc
View File

@ -613,7 +613,6 @@ Begin
Result := GetShiftState;
End;
{------------------------------------------------------------------------------
Procedure: GetWin32KeyInfo
Params: Event - Requested info
@ -687,6 +686,29 @@ Begin
Result := Message.Result;
End;
{-----------------------------------------------------------------------------
Procedure: CallEvent
Params: Target - the object for which the event will be called
Event - event to call
Data - misc data
EventType - the type of event
Returns: Nothing
Calls an event
-------------------------------------------------------------------------------}
Procedure CallEvent(Const Target: TObject; Event: TNotifyEvent; Const Data: Pointer; Const EventType: TEventType);
Begin
If Assigned(Target) And Assigned(Event) Then
Begin
Case EventType Of
etNotify:
Begin
Event(Target);
End;
End;
End;
End;
{------------------------------------------------------------------------------
Function: ObjectToHWND
Params: AObject - An LCL Object
@ -899,6 +921,9 @@ End;
{ =============================================================================
$Log$
Revision 1.6 2002/02/07 08:35:12 lazarus
Keith: Fixed persistent label captions and a few less noticable things
Revision 1.5 2002/01/18 09:07:44 lazarus
Keith: Fixed menu creation

11
lcl/interfaces/win32/win32winapi.inc
View File

@ -439,7 +439,7 @@ Const
Begin
Try
Elem := String(PixmapArray^[I]);
Idx := Length(Elem) - 6;
Idx := Length(Elem) - 7;
With ColorMap Do
Begin
Alias := Copy(Elem, 1, AliasLen);
@ -1510,7 +1510,7 @@ End;
------------------------------------------------------------------------------}
Function TWin32Object.SetCaretPos(X, Y: Integer): Boolean;
Begin
Result := SetCaretPosEx(GetFocus, X, Y);
Result := Windows.SetCaretPos(X, Y);
End;
{------------------------------------------------------------------------------
@ -1524,7 +1524,7 @@ End;
------------------------------------------------------------------------------}
Function TWin32Object.SetCaretPosEx(Handle: HWND; X, Y: Integer): Boolean;
Begin
Result := ShowCaret(Handle) And Windows.SetCaretPos(X, Y);
Result := ShowCaret(Handle) And SetCaretPos(X, Y);
End;
{------------------------------------------------------------------------------
@ -1534,7 +1534,7 @@ End;
Returns: true on success
------------------------------------------------------------------------------}
Function TWin32Object.SetCaretRespondToFocus(Handle: HWND; ShowHideOnFocus: boolean): Boolean;
Function TWin32Object.SetCaretRespondToFocus(Handle: HWND; ShowHideOnFocus: Boolean): Boolean;
Begin
If ShowHideOnFocus Then
Result := ShowCaret(Handle)
@ -1850,6 +1850,9 @@ End;
{ =============================================================================
$Log$
Revision 1.7 2002/02/07 08:35:12 lazarus
Keith: Fixed persistent label captions and a few less noticable things
Revision 1.6 2002/02/03 06:06:26 lazarus
Keith: Fixed Win32 compilation problems

4
lcl/interfaces/win32/win32winapih.inc
View File

@ -50,6 +50,7 @@ Function EnableWindow(HWnd: HWND; BEnable: Boolean): Boolean; Override;
Function ExtTextOut(DC: HDC; X, Y: Integer; Options: LongInt; Rect: PRect; Str: PChar; Count: LongInt; Dx: PInteger): Boolean; Override;
Function FillRect(DC: HDC; Const Rect: TRect; Brush: HBRUSH): Boolean; Override;
{ Draws a 3D border in GTK native style. }
Function Frame3D(DC: HDC; Var Rect: TRect; Const FrameWidth: Integer; Const Style: TBevelCut): Boolean; Override;
Function GetActiveWindow: HWND; Override;
@ -132,6 +133,9 @@ Function WindowFromPoint(Point: TPoint): HWND; Override;
{ =============================================================================
$Log$
Revision 1.5 2002/02/07 08:35:13 lazarus
Keith: Fixed persistent label captions and a few less noticable things
Revision 1.4 2002/02/03 06:06:26 lazarus
Keith: Fixed Win32 compilation problems