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

improved setprop from Micha

Browse Source 
git-svn-id: trunk@4537 -
This commit is contained in:
mattias 2003-08-27 15:15:42 +00:00
parent a9d2994382
commit 495577e5b8
2 changed files with 18 additions and 75 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -267,7 +267,10 @@ Procedure TWin32Object.SetLabel(Sender: TObject; Data: Pointer);
end; end;
SetMenuItemInfo((Sender as TMenuItem).Parent.Handle, SetMenuItemInfo((Sender as TMenuItem).Parent.Handle,
(Sender as TMenuItem).Command, false, @MenuInfo); (Sender as TMenuItem).Command, false, @MenuInfo);
DrawMenuBar(((Sender as TMenuItem).Owner as TWinControl).Handle); // owner could be a popupmenu too
if (TMenuItem(Sender).Owner is TWinControl) and
TWinControl(TMenuItem(Sender).Owner).HandleAllocated then
DrawMenuBar(TWinControl(TMenuItem(Sender).Owner).Handle);
End; End;
Var Var
@ -621,8 +624,9 @@ activate_time : the time at which the activation event occurred.
} }
LM_POPUPSHOW: LM_POPUPSHOW:
Begin Begin
SetProp(((Sender as TPopupMenu).Owner as TWinControl).Handle, 'PopupMenu', Pointer((Sender as TPopupMenu).Handle)); SetProp(FParentWindow, 'PopupMenu', Pointer(TPopupMenu(Sender).Handle));
TrackPopupMenuEx((Sender as TPopupMenu).Handle, TPM_LEFTALIGN or TPM_LEFTBUTTON or TPM_RIGHTBUTTON, TPoint(Data^).x, TPoint(Data^).y, ((Sender as TPopupMenu).Owner as TWinControl).Handle, Nil); TrackPopupMenuEx(TPopupMenu(Sender).Handle, TPM_LEFTALIGN or TPM_LEFTBUTTON or TPM_RIGHTBUTTON,
TPoint(Data^).x, TPoint(Data^).y, FParentWindow, Nil);
End; End;
LM_SETFILTER: LM_SETFILTER:
Begin Begin
@ -1051,7 +1055,6 @@ Begin
SetProp(Window, 'MsgList', Pointer(List)); SetProp(Window, 'MsgList', Pointer(List));
{$ENDIF} {$ENDIF}
//SetProp(Window, 'MsgColl', List);
Assert(False, 'Trace:TWin32Object.SetCallback - Exit'); Assert(False, 'Trace:TWin32Object.SetCallback - Exit');
End; End;
@ -1793,7 +1796,6 @@ End;
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
Procedure TWin32Object.CreateComponent(Sender: TObject); Procedure TWin32Object.CreateComponent(Sender: TObject);
Var Var
//AccelIndex: Byte;
AProcess: TProcess; AProcess: TProcess;
Buddy, Handle, Window: HWnd; Buddy, Handle, Window: HWnd;
Caption : String; Caption : String;
@ -1862,7 +1864,7 @@ Begin
CompStyle := TMenuItem(Sender).FCompStyle; CompStyle := TMenuItem(Sender).FCompStyle;
Assert(False, Format('Trace:[TWin32Object.CreateComponent] - CompStyle set to %S', [CS_To_String(CompStyle)])); Assert(False, Format('Trace:[TWin32Object.CreateComponent] - CompStyle set to %S', [CS_To_String(CompStyle)]));
End End
Else If (Sender Is TMenu) Or (Sender Is TPopupMenu) Then Else If (Sender Is TMenu) { Or (Sender Is TPopupMenu) } Then
CompStyle := TMenu(Sender).FCompStyle CompStyle := TMenu(Sender).FCompStyle
Else If (Sender Is TCommonDialog) Then Else If (Sender Is TCommonDialog) Then
CompStyle := TCommonDialog(Sender).FCompStyle; CompStyle := TCommonDialog(Sender).FCompStyle;
@ -1899,7 +1901,6 @@ Begin
Begin Begin
Window := CreateWindow('BUTTON', Nil, Flags or BS_PUSHBUTTON Or BS_BITMAP, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil); Window := CreateWindow('BUTTON', Nil, Flags or BS_PUSHBUTTON Or BS_BITMAP, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil);
IntSendMessage3(LM_LOADXPM, Sender, StrTemp); IntSendMessage3(LM_LOADXPM, Sender, StrTemp);
SetProp(Window, 'Lazarus', Sender);
End; End;
csButton: csButton:
Begin Begin
@ -1909,8 +1910,6 @@ Begin
Else Else
Flags := Flags Or BS_DEFPUSHBUTTON; Flags := Flags Or BS_DEFPUSHBUTTON;
Window := CreateWindow('BUTTON', StrTemp, Flags, Left, Top, Width, Height - 8, Parent, HMENU(Nil), HInstance, Nil); Window := CreateWindow('BUTTON', StrTemp, Flags, Left, Top, Width, Height - 8, Parent, HMENU(Nil), HInstance, Nil);
If Window <> HWND(Nil) Then
SetProp(Window, 'Lazarus', Sender);
End; End;
csCalendar: csCalendar:
Begin Begin
@ -1925,24 +1924,14 @@ Begin
AProcess.Free; AProcess.Free;
AProcess := Nil; AProcess := Nil;
End; End;
{
csCanvas:
Begin
Assert(False, 'Trace:TODO: Code TWin32Object.CreateComponent: style csCanvas');
Window := CreateWindow(ClsName, StrTemp, WS_DLGFRAME Or WS_POPUP Or WS_VISIBLE, Left, Top, Width, Height, HWND(Nil), HMENU(Nil), HInstance, Nil);
SetProp(Window, 'Lazarus', Sender);
End;
}
csCheckbox: csCheckbox:
Begin Begin
Window := CreateWindow('BUTTON', StrTemp, Flags Or BS_AUTOCHECKBOX, Left, Top, Width, Height, Parent, HMenu(Nil), HInstance, Nil); Window := CreateWindow('BUTTON', StrTemp, Flags Or BS_AUTOCHECKBOX, Left, Top, Width, Height, Parent, HMenu(Nil), HInstance, Nil);
SetProp(Window, 'Lazarus', Sender);
End; End;
csComboBox: csComboBox:
Begin Begin
Flags := Flags or ComboBoxStyles[TCustomComboBox(Sender).Style]; Flags := Flags or ComboBoxStyles[TCustomComboBox(Sender).Style];
Window := CreateWindow('COMBOBOX', Nil, Flags or WS_VSCROLL or CBS_AUTOHSCROLL or CBS_HASSTRINGS, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil); Window := CreateWindow('COMBOBOX', Nil, Flags or WS_VSCROLL or CBS_AUTOHSCROLL or CBS_HASSTRINGS, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil);
SetProp(Window, 'Lazarus', Sender);
End; End;
csImage: csImage:
Begin Begin
@ -1955,18 +1944,15 @@ Begin
csListBox: csListBox:
Begin Begin
Window := CreateWindow('LISTBOX', Nil, Flags or WS_VSCROLL, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil); Window := CreateWindow('LISTBOX', Nil, Flags or WS_VSCROLL, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil);
SetProp(Window, 'Lazarus', Sender);
End; End;
csCListBox: csCListBox:
Begin Begin
Window := CreateWindow('LISTBOX', Nil, Flags Or LBS_MULTICOLUMN or WS_HSCROLL, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil); Window := CreateWindow('LISTBOX', Nil, Flags Or LBS_MULTICOLUMN or WS_HSCROLL, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil);
SendMessage(Window, LB_SETCOLUMNWIDTH, WPARAM((Sender As TCListBox).Width Div ((Sender As TCListBox).ListColumns)), 0); SendMessage(Window, LB_SETCOLUMNWIDTH, WPARAM((Sender As TCListBox).Width Div ((Sender As TCListBox).ListColumns)), 0);
SetProp(Window, 'Lazarus', Sender);
End; End;
csEdit: csEdit:
Begin Begin
Window := CreateWindowEx(WS_EX_CLIENTEDGE, 'EDIT', StrTemp, Flags Or ES_AUTOHSCROLL, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil); Window := CreateWindowEx(WS_EX_CLIENTEDGE, 'EDIT', StrTemp, Flags Or ES_AUTOHSCROLL, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil);
SetProp(Window, 'Lazarus', Sender);
End; End;
csFileDialog, csOpenFileDialog, csSaveFileDialog, csFileDialog, csOpenFileDialog, csSaveFileDialog,
csColorDialog, csFontDialog: csColorDialog, csFontDialog:
@ -1979,7 +1965,6 @@ Begin
Begin Begin
Assert(False, 'Trace:TODO: Figure out what component style csFixed is and code the component. No component created.'); Assert(False, 'Trace:TODO: Figure out what component style csFixed is and code the component. No component created.');
Window := CreateWindow(ClsName, StrTemp, Flags, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil); Window := CreateWindow(ClsName, StrTemp, Flags, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil);
SetProp(Window, 'Lazarus', Sender);
DoSubClass := false; DoSubClass := false;
End; End;
csFont: csFont:
@ -1987,7 +1972,6 @@ Begin
Assert(False, 'Trace:CreateComponent - Creating a font'); Assert(False, 'Trace:CreateComponent - Creating a font');
With LPLogFont(@Sender)^ Do With LPLogFont(@Sender)^ Do
Window := CreateFont(LFHeight, LFWidth, LFEscapement, LFOrientation, LFWeight, LFItalic, LFUnderLine, LFStrikeOut, LFCharSet, LFOutPrecision, LFClipPrecision, LFQuality, LFPitchAndFamily, LFFaceName); Window := CreateFont(LFHeight, LFWidth, LFEscapement, LFOrientation, LFWeight, LFItalic, LFUnderLine, LFStrikeOut, LFCharSet, LFOutPrecision, LFClipPrecision, LFQuality, LFPitchAndFamily, LFFaceName);
SetProp(Window, 'Lazarus', Sender);
End; End;
csForm: csForm:
Begin Begin
@ -2021,7 +2005,6 @@ Begin
Assert(False, 'Trace:CreateComponent - Form Window Handle Value = $' + IntToHex(Window, 8)); Assert(False, 'Trace:CreateComponent - Form Window Handle Value = $' + IntToHex(Window, 8));
Assert(False, 'Trace:Creating a Form - SetProp'); Assert(False, 'Trace:Creating a Form - SetProp');
DoSubClass := false; DoSubClass := false;
SetProp(Window, 'Lazarus', Sender);
If Window = 0 then If Window = 0 then
Begin Begin
MessageBox(0, 'csForm CreateWindow Failed', nil, mb_Ok); MessageBox(0, 'csForm CreateWindow Failed', nil, mb_Ok);
@ -2031,7 +2014,6 @@ Begin
csHintWindow: csHintWindow:
Begin Begin
Window := CreateWindow(ClsName, StrTemp,WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, Parent, HMENU(Nil), HInstance, Nil); Window := CreateWindow(ClsName, StrTemp,WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, Parent, HMENU(Nil), HInstance, Nil);
SetProp(Window, 'Lazarus', Sender);
DoSubClass := false; DoSubClass := false;
End; End;
csMainForm: csMainForm:
@ -2044,8 +2026,6 @@ Begin
StrDispose(PStr); StrDispose(PStr);
DoSubClass := false; DoSubClass := false;
Assert(False, 'Trace:CreateComponent - MainForm Window Handle Value = $' + IntToHex(Window, 8)); Assert(False, 'Trace:CreateComponent - MainForm Window Handle Value = $' + IntToHex(Window, 8));
Assert(False, 'Trace:Creating a Form - MainForm SetProp');
SetProp(Window, 'Lazarus', Sender);
If Window = 0 Then If Window = 0 Then
Begin Begin
MessageBox(0, 'csMainForm CreateWindow Failed', nil, mb_Ok); MessageBox(0, 'csMainForm CreateWindow Failed', nil, mb_Ok);
@ -2055,7 +2035,6 @@ Begin
csFrame, csGroupBox: csFrame, csGroupBox:
Begin Begin
Window := CreateWindow('BUTTON', StrTemp, Flags Or BS_GROUPBOX, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil); Window := CreateWindow('BUTTON', StrTemp, Flags Or BS_GROUPBOX, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil);
SetProp(Window, 'Lazarus', Sender);
TWinControl(Sender).InvalidateClientRectCache; TWinControl(Sender).InvalidateClientRectCache;
End; End;
{csHintWindow: {csHintWindow:
@ -2068,7 +2047,6 @@ Begin
csLabel: csLabel:
Begin Begin
Window := CreateWindow('STATIC', StrTemp, Flags Or SS_LEFT, Left, Top, Width, Height, FParentWindow, HMENU(Nil), HInstance, Nil); Window := CreateWindow('STATIC', StrTemp, Flags Or SS_LEFT, Left, Top, Width, Height, FParentWindow, HMENU(Nil), HInstance, Nil);
SetProp(Window, 'Lazarus', Sender);
End; End;
csListView: csListView:
Begin Begin
@ -2090,7 +2068,6 @@ Begin
Flags := Flags Or WS_HSCROLL Or WS_VSCROLL; Flags := Flags Or WS_HSCROLL Or WS_VSCROLL;
End; End;
Window := CreateWindowEx(WS_EX_CLIENTEDGE, 'EDIT', StrTemp, Flags, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil); Window := CreateWindowEx(WS_EX_CLIENTEDGE, 'EDIT', StrTemp, Flags, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil);
SetProp(Window, 'Lazarus', Sender);
End; End;
csMainMenu, csMenuBar: csMainMenu, csMenuBar:
Begin Begin
@ -2098,26 +2075,18 @@ Begin
FMenu := Window; FMenu := Window;
Assert(False, Format('Trace:Main menu owner --> %S', [((Sender As TComponent).Owner As TWinControl).ClassName])); Assert(False, Format('Trace:Main menu owner --> %S', [((Sender As TComponent).Owner As TWinControl).ClassName]));
Windows.SetMenu(((Sender As TComponent).Owner As TWinControl).Handle, Window); Windows.SetMenu(((Sender As TComponent).Owner As TWinControl).Handle, Window);
{Self.SetProp(Window, 'Lazarus', Sender);}
End; End;
csMenuItem: csMenuItem:
Begin Begin
Window := CreateMenu; Window := CreateMenu;
{SetProp(Window, 'MenuCaption', StrTemp);
AccelIndex := Pos('&', Caption);
If AccelIndex <> 0 Then
SetAccelKey(Window, Nil);}
{SetProp(Window, 'Lazarus', Sender);}
End; End;
csNotebook: csNotebook:
Begin Begin
Window := CreateWindow(WC_TABCONTROL, Nil, Flags, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil); Window := CreateWindow(WC_TABCONTROL, Nil, Flags, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil);
SetProp(Window, 'Lazarus', Sender);
End; End;
csRadioButton: csRadioButton:
Begin Begin
Window := CreateWindow('BUTTON', StrTemp, Flags Or BS_AUTORADIOBUTTON, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil); Window := CreateWindow('BUTTON', StrTemp, Flags Or BS_AUTORADIOBUTTON, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil);
SetProp(Window, 'Lazarus', Sender);
End; End;
csScrollBar: csScrollBar:
Begin Begin
@ -2128,13 +2097,11 @@ Begin
Flags := Flags Or SBS_VERT; Flags := Flags Or SBS_VERT;
End; End;
Window := CreateWindow('SCROLLBAR', Nil, Flags, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil); Window := CreateWindow('SCROLLBAR', Nil, Flags, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil);
SetProp(Window, 'Lazarus', Sender);
End; End;
csScrolledWindow: csScrolledWindow:
Begin Begin
Assert(False, 'TRACE: CreateComponent - creating a scrolled window'); Assert(False, 'TRACE: CreateComponent - creating a scrolled window');
Window := CreateWindow(ClsName, strTemp, WS_OVERLAPPEDWINDOW Or WS_HSCROLL Or WS_VSCROLL Or WS_Visible, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, HWND(Nil), HMENU(Nil), HInstance, Nil); Window := CreateWindow(ClsName, strTemp, WS_OVERLAPPEDWINDOW Or WS_HSCROLL Or WS_VSCROLL Or WS_Visible, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, HWND(Nil), HMENU(Nil), HInstance, Nil);
SetProp(Window, 'Lazarus', Sender);
DoSubClass := false; DoSubClass := false;
End; End;
csSpinEdit: csSpinEdit:
@ -2144,7 +2111,6 @@ Begin
Inc(FControlIndex); Inc(FControlIndex);
Buddy := CreateWindowEx(WS_EX_CLIENTEDGE, 'EDIT', StrTemp, Flags Or ES_AUTOHSCROLL, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil); Buddy := CreateWindowEx(WS_EX_CLIENTEDGE, 'EDIT', StrTemp, Flags Or ES_AUTOHSCROLL, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil);
Window := CreateUpDownControl(Flags Or WS_Border, Left + Width + 10, Top, 10, Height, Parent, FControlIndex, HInstance, Buddy, 0, 100, Trunc((Sender As TSpinEdit).Value)); Window := CreateUpDownControl(Flags Or WS_Border, Left + Width + 10, Top, 10, Height, Parent, FControlIndex, HInstance, Buddy, 0, 100, Trunc((Sender As TSpinEdit).Value));
SetProp(Window, 'Lazarus', Sender);
Assert(False, 'TRACE:Spin edit control not created'); Assert(False, 'TRACE:Spin edit control not created');
End; End;
csStatusBar: csStatusBar:
@ -2152,7 +2118,6 @@ Begin
Assert(False, 'TRACE:CreateComponent - Creating Status Bar'); Assert(False, 'TRACE:CreateComponent - Creating Status Bar');
Inc(FControlIndex); Inc(FControlIndex);
Window := CreateStatusWindow(Flags, StrTemp, Parent, FControlIndex); Window := CreateStatusWindow(Flags, StrTemp, Parent, FControlIndex);
SetProp(Window, 'Lazarus', Sender);
End; End;
csGTKTable: csGTKTable:
Begin Begin
@ -2167,17 +2132,14 @@ Begin
Begin Begin
Assert(False, 'TRACE: CreateComponent - Creating toggle box'); Assert(False, 'TRACE: CreateComponent - Creating toggle box');
Window := CreateWindow('BUTTON', StrTemp, Flags Or BS_AUTOCHECKBOX Or BS_PUSHLIKE, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil); Window := CreateWindow('BUTTON', StrTemp, Flags Or BS_AUTOCHECKBOX Or BS_PUSHLIKE, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil);
SetProp(Window, 'Lazarus', Sender);
End; End;
csToolBar: csToolBar:
Begin Begin
Window := CreateWindow(TOOLBARCLASSNAME, LPSTR(Nil), Flags OR CCS_ADJUSTABLE, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil); Window := CreateWindow(TOOLBARCLASSNAME, LPSTR(Nil), Flags OR CCS_ADJUSTABLE, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil);
SetProp(Window, 'Lazarus', Sender);
End; End;
csToolButton: csToolButton:
Begin Begin
Window := CreateWindow(@ToolBtnClsName, LPSTR(nil), 0, Left, Top, Width, Height, Parent, HMENU(nil), HInstance, nil); Window := CreateWindow(@ToolBtnClsName, LPSTR(nil), 0, Left, Top, Width, Height, Parent, HMENU(nil), HInstance, nil);
SetProp(Window, 'Lazarus', Sender);
DoSubClass := false; DoSubClass := false;
End; End;
// TPage - Notebook page // TPage - Notebook page
@ -2186,21 +2148,18 @@ Begin
Assert(False, 'Trace:Create a csPage component.'); Assert(False, 'Trace:Create a csPage component.');
Window := CreateWindowEx(WS_EX_CONTROLPARENT, @ClsName, Nil, Flags and not WS_VISIBLE, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil); Window := CreateWindowEx(WS_EX_CONTROLPARENT, @ClsName, Nil, Flags and not WS_VISIBLE, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil);
ShowWindow(Window, SW_HIDE); ShowWindow(Window, SW_HIDE);
SetProp(Window, 'Lazarus', Sender);
DoSubClass := false; DoSubClass := false;
End; End;
csPanel: csPanel:
Begin Begin
Assert(False, 'Trace:Create a csPanel component.'); Assert(False, 'Trace:Create a csPanel component.');
Window := CreateWindowEx(0, @ClsName, Nil, Flags, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil); Window := CreateWindowEx(0, @ClsName, Nil, Flags, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil);
SetProp(Window, 'Lazarus', Sender);
DoSubClass := false; DoSubClass := false;
End; End;
csPopupMenu: csPopupMenu:
Begin Begin
Window := CreatePopupMenu; Window := CreatePopupMenu;
FSubMenu := Window; FSubMenu := Window;
SetProp(Window, 'Lazarus', Sender);
End; End;
csProgressBar: csProgressBar:
Begin Begin
@ -2212,22 +2171,22 @@ Begin
Flags := Flags or PBS_VERTICAL; Flags := Flags or PBS_VERTICAL;
end; end;
Window := CreateWindow(PROGRESS_CLASS, nil, Flags, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil); Window := CreateWindow(PROGRESS_CLASS, nil, Flags, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil);
SetProp(Window, 'Lazarus', Sender);
End; End;
csTrackBar: csTrackBar:
Begin Begin
Assert(False, 'TRACE:CreateComponent - Creating a Track Bar (if we''re lucky)'); Assert(False, 'TRACE:CreateComponent - Creating a Track Bar (if we''re lucky)');
Window := CreateWindow(TRACKBAR_CLASS, StrTemp, Flags, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil); Window := CreateWindow(TRACKBAR_CLASS, StrTemp, Flags, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil);
SetProp(Window, 'Lazarus', Sender);
End; End;
End; {Case} End; {Case}
if Window <> HWND(nil) then
Windows.SetProp(Window, 'Lazarus', Integer(Sender));
If (Sender Is TWinControl) Or (CompStyle = csImage) Then If (Sender Is TWinControl) Or (CompStyle = csImage) Then
Begin Begin
TWinControl(Sender).Handle := Window; TWinControl(Sender).Handle := Window;
If Window <> HWND(Nil) Then If Window <> HWND(Nil) Then
begin begin
SetProp(Window, 'Sender', @Sender);
if DoSubClass then if DoSubClass then
SetProp(Window, 'DefWndProc', Pointer(SetWindowLong(Window, GWL_WNDPROC, LongInt(@WindowProc)))); SetProp(Window, 'DefWndProc', Pointer(SetWindowLong(Window, GWL_WNDPROC, LongInt(@WindowProc))));
SendMessage(Window, WM_SETFONT, GetStockObject(DEFAULT_GUI_FONT), 0); SendMessage(Window, WM_SETFONT, GetStockObject(DEFAULT_GUI_FONT), 0);
@ -2259,14 +2218,6 @@ Begin
End; End;
End; End;
SetLCLObject(Window, Sender);
If Window = HWnd(Nil) Then
Begin
SetProp(Window, 'Style', Pointer(GetWindowLong(Window, GWL_Style)));
SetProp(Window, 'ExStyle', Pointer(GetWindowLong(Window, GWL_ExStyle)));
End;
Try Try
StrDispose(StrTemp); StrDispose(StrTemp);
Except Except
@ -2287,7 +2238,6 @@ End;
procedure TWin32Object.AssignSelf(Window: HWnd; Data: Pointer); procedure TWin32Object.AssignSelf(Window: HWnd; Data: Pointer);
begin begin
Assert(False, 'Trace:[TWin32Object.AssignSelf] Trying to code it. It''s probably wrong.'); Assert(False, 'Trace:[TWin32Object.AssignSelf] Trying to code it. It''s probably wrong.');
SetProp(Window, 'Self', Data);
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -2878,6 +2828,9 @@ End;
{ {
$Log$ $Log$
Revision 1.99 2003/08/27 15:15:42 mattias
improved setprop from Micha
Revision 1.98 2003/08/27 09:33:26 mattias Revision 1.98 2003/08/27 09:33:26 mattias
implements SET_LABEL from Micha implements SET_LABEL from Micha

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

@ -588,9 +588,8 @@ begin
end; end;
end; end;
// Set the properties in the same order as in CreateComponent // Set the properties in the same order as in CreateComponent
SetProp(NewHandle,'Lazarus',ListControl); Windows.SetProp(NewHandle, 'Lazarus', Integer(ListControl));
TWinControl(ListControl).Handle:=NewHandle; TWinControl(ListControl).Handle:=NewHandle;
SetProp(NewHandle,'Sender',@ListControl);
Windows.SetProp(NewHandle, 'DefWndProc',SetWindowLong (NewHandle, GWL_WNDPROC, Main_WndProc)); Windows.SetProp(NewHandle, 'DefWndProc',SetWindowLong (NewHandle, GWL_WNDPROC, Main_WndProc));
SendMessage(NewHandle, WM_SETFONT, GetStockObject(DEFAULT_GUI_FONT), 0); SendMessage(NewHandle, WM_SETFONT, GetStockObject(DEFAULT_GUI_FONT), 0);
@ -613,18 +612,6 @@ end;
Widget member Functions Widget member Functions
************************************************************************) ************************************************************************)
// ----------------------------------------------------------------------
// Some need the LCLobject which created this control.
//
// MWE: IMO this shouldn't be needed
// ----------------------------------------------------------------------
Procedure SetLCLObject(Const Control: HWND; Const AnObject: TObject);
Begin
Assert(False, 'TRACE:Using function SetLCLObject which isn''t implemented yet');
If (Control <> HWND(Nil)) Then
SetProp(Control, 'Class', Pointer(AnObject));
End;
{------------------------------------------------------------------------------- {-------------------------------------------------------------------------------
function LCLBoundsNeedsUpdate(Sender: TObject; function LCLBoundsNeedsUpdate(Sender: TObject;
SendSizeMsgOnDiff: boolean): boolean; SendSizeMsgOnDiff: boolean): boolean;
@ -787,6 +774,9 @@ End;
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.23 2003/08/27 15:15:42 mattias
improved setprop from Micha
Revision 1.22 2003/08/26 08:12:33 mattias Revision 1.22 2003/08/26 08:12:33 mattias
applied listbox/combobox patch from Karl applied listbox/combobox patch from Karl