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

cleanups; wm_hscroll/wm_vscroll fix

Browse Source 
git-svn-id: trunk@4820 -
This commit is contained in:
micha 2003-11-21 20:32:01 +00:00
parent ac613eab14
commit ab6d51cfb8
3 changed files with 215 additions and 167 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -352,35 +352,10 @@ Begin
ScrollCode := Lo(WParam); ScrollCode := Lo(WParam);
Pos := Hi(WParam); Pos := Hi(WParam);
ScrollBar := LParam; ScrollBar := LParam;
If OwnerObject Is TScrollingWinControl Then if ScrollBar <> 0 then
With TScrollingWinControl(OwnerObject).HorzScrollbar do
begin begin
NewPos := Position; // send message to actual scrollbar window
case ScrollCode of OwnerObject := TObject(Windows.GetProp(ScrollBar, 'Lazarus'));
SB_LINEUP:
Dec(NewPos, Increment);
SB_LINEDOWN:
Inc(NewPos, Increment);
SB_PAGEUP:
Dec(NewPos, Page);
SB_PAGEDOWN:
Inc(NewPos, Page);
SB_THUMBPOSITION, SB_THUMBTRACK:
NewPos := Pos;
SB_TOP:
NewPos := 0;
SB_BOTTOM:
NewPos := Range;
end;
Windows.GetClientRect(Window,@R);
if NewPos < 0 then NewPos := 0;
if NewPos > (Range - (Page - 1)) then Begin
NewPos := Range - (Page - 1);
Win32Def.ScrollWindow(Window,Position - NewPos,0,nil,@R);
Position:=NewPos;
Exit;
End;
Win32Def.ScrollWindow(Window,Position - NewPos,0,nil,@R);
end; end;
End; End;
End; End;
@ -653,35 +628,10 @@ Begin
ScrollCode := Lo(WParam); ScrollCode := Lo(WParam);
Pos := Hi(WParam); Pos := Hi(WParam);
ScrollBar := LParam; ScrollBar := LParam;
If OwnerObject Is TScrollingWinControl Then if ScrollBar <> 0 then
With TScrollingWinControl(OwnerObject).VertScrollbar do
begin begin
NewPos := Position; // send message to actual scrollbar window
case ScrollCode of OwnerObject := TObject(Windows.GetProp(ScrollBar, 'Lazarus'));
SB_LINEUP:
Dec(NewPos, Increment);
SB_LINEDOWN:
Inc(NewPos, Increment);
SB_PAGEUP:
Dec(NewPos, Page);
SB_PAGEDOWN:
Inc(NewPos, Page);
SB_THUMBPOSITION, SB_THUMBTRACK:
NewPos := Pos;
SB_TOP:
NewPos := 0;
SB_BOTTOM:
NewPos := Range;
end;
Windows.GetClientRect(Window,@R);
if NewPos < 0 then NewPos := 0;
if NewPos > (Range - (Page - 1)) then Begin
NewPos := Range - (Page - 1);
Win32Def.ScrollWindow(Window,0,Position - NewPos,nil,@R);
Position:=NewPos;
Exit;
End;
Win32Def.ScrollWindow(Window,0,Position - NewPos,nil,@R);
end; end;
End; End;
End; End;
@ -698,6 +648,11 @@ Begin
// SendMessage(Window, WM_SIZE, 0, MakeLParam(R.right-R.left, R.bottom-R.top)); // SendMessage(Window, WM_SIZE, 0, MakeLParam(R.right-R.left, R.bottom-R.top));
// WinProcess:=false; // WinProcess:=false;
End; End;
WM_MEASUREITEM:
Begin
if wParam <> 0 then
CNSendMessage(LM_MEASUREITEM, TObject(Windows.GetProp(Windows.GetDlgItem(Window, WParam), 'WinControl')), Pointer(LParam));
End;
WM_DRAWITEM: WM_DRAWITEM:
Begin Begin
CNSendMessage(LM_DRAWITEM, TObject(GetProp(PDRAWITEMSTRUCT(LParam)^.hwndItem ,'WinControl')), Pointer(LParam)); CNSendMessage(LM_DRAWITEM, TObject(GetProp(PDRAWITEMSTRUCT(LParam)^.hwndItem ,'WinControl')), Pointer(LParam));
@ -888,6 +843,9 @@ end;
{ {
$Log$ $Log$
Revision 1.70 2003/11/21 20:32:01 micha
cleanups; wm_hscroll/wm_vscroll fix
Revision 1.69 2003/11/18 07:20:39 micha Revision 1.69 2003/11/18 07:20:39 micha
added "included by" notice at top of file added "included by" notice at top of file

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

@ -60,6 +60,7 @@ Type
FMenu: HMENU; // Main menu/menu bar FMenu: HMENU; // Main menu/menu bar
FSubMenu: HMENU; // current sub menu FSubMenu: HMENU; // current sub menu
FWin32MenuHeight: Integer; FWin32MenuHeight: Integer;
FNextControlId: Cardinal;
FStockNullBrush: HBRUSH; FStockNullBrush: HBRUSH;
FStockBlackBrush: HBRUSH; FStockBlackBrush: HBRUSH;
@ -186,6 +187,9 @@ End.
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.52 2003/11/21 20:32:01 micha
cleanups; wm_hscroll/wm_vscroll fix
Revision 1.51 2003/11/14 20:23:31 micha Revision 1.51 2003/11/14 20:23:31 micha
fpimage fixes fpimage fixes

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

@ -47,6 +47,7 @@ Begin
Windows.AdjustwindowRect(@R1,WS_OVERLAPPEDWINDOW,true); Windows.AdjustwindowRect(@R1,WS_OVERLAPPEDWINDOW,true);
Windows.AdjustwindowRect(@R2,WS_OVERLAPPEDWINDOW,false); Windows.AdjustwindowRect(@R2,WS_OVERLAPPEDWINDOW,false);
FWin32MenuHeight:= R2.Top - R1.Top; FWin32MenuHeight:= R2.Top - R1.Top;
FNextControlId := 0;
End; End;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -1547,7 +1548,7 @@ Begin
If ofAllowMultiSelect in Options Then If ofAllowMultiSelect in Options Then
SizeStr:=15*MAX_PATH // Tested with 210 selected files SizeStr:=15*MAX_PATH // Tested with 210 selected files
Else Else
SizeStr:=256; SizeStr:=MAX_PATH;
GetMem(FName,SizeStr); GetMem(FName,SizeStr);
StrPCopy(FName,Filename); StrPCopy(FName,Filename);
If Filter <> '' Then Begin If Filter <> '' Then Begin
@ -1833,12 +1834,16 @@ End;
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
Procedure TWin32Object.CreateComponent(Sender: TObject); Procedure TWin32Object.CreateComponent(Sender: TObject);
Var Var
Buddy,Parent, Handle, Window: HWnd; Buddy, Parent, Handle, Window: HWnd;
Caption : String;
CompStyle, Left, Top, Height, Width: Integer; CompStyle, Left, Top, Height, Width: Integer;
Flags,FlagsEx: DWord; AlternateCreateWindow: Boolean;
MenuHandle: HMENU;
Caption : String;
Flags, FlagsEx: DWord;
DoSubClass: Boolean; DoSubClass: Boolean;
StrTemp: PChar; StrCaption: PChar;
WindowTitle: PChar;
pClassName: PChar;
R: TRect; R: TRect;
//TCI: TC_ITEM; //TCI: TC_ITEM;
Const Const
@ -1853,6 +1858,7 @@ Begin
Assert(False, 'Trace:CreateComponent - 1'); Assert(False, 'Trace:CreateComponent - 1');
Flags := WS_CHILD or WS_CLIPSIBLINGS or WS_CLIPCHILDREN; Flags := WS_CHILD or WS_CLIPSIBLINGS or WS_CLIPCHILDREN;
FlagsEx := 0;
Assert(False, 'Trace:Setting flags'); Assert(False, 'Trace:Setting flags');
Window := HWND(Nil); Window := HWND(Nil);
Buddy := HWND(Nil); Buddy := HWND(Nil);
@ -1869,7 +1875,9 @@ Begin
Parent := FAppHandle; Parent := FAppHandle;
DoSubClass := true; DoSubClass := true;
AlternateCreateWindow := false;
CompStyle := csNone; CompStyle := csNone;
WindowTitle := nil;
Assert(False, 'Trace:Setting compstyle'); Assert(False, 'Trace:Setting compstyle');
//Caption := ''; //Caption := '';
Assert(False, 'Trace:Setting caption'); Assert(False, 'Trace:Setting caption');
@ -1912,29 +1920,18 @@ Begin
// until here remove when debug not needed // until here remove when debug not needed
If Caption = '' Then If Caption = '' Then
Caption := 'Blank'; Caption := 'Blank';
StrTemp := StrAlloc(Length(Caption) + 1); StrCaption := StrAlloc(Length(Caption) + 1);
StrPCopy(StrTemp, Caption); StrPCopy(StrCaption, Caption);
Assert(False, 'Trace:CreateComponent - Control Style is ' + CS_To_String(CompStyle)); Assert(False, 'Trace:CreateComponent - Control Style is ' + CS_To_String(CompStyle));
Case CompStyle Of Case CompStyle Of
csAlignment: // controls with a window handle
Begin
Assert(False, 'Trace:TODO: Code csAlignment. If anyone knows how to do this, please do.');
Handle:=TWinControl(Sender).Handle;
GetClientRect(Handle, R);
MoveWindow(Handle, R.Right - Left, R.Bottom - Top, (R.Right - R.Left) - (Left Div 2), (R.Bottom - R.Top) - (Top Div 2), True);
Window := Handle;
End;
csArrow:
Begin
Assert(False, 'Trace:TODO: TWin32Object.CreateComponent - Figure out what a csArrow is and code it');
Assert(False, 'Trace:TWin32Object.CreateComponent - Creating a cursor. This will have to be good enough for now.');
LoadCursor(HInst(Nil), IDC_SizeWE);
End;
csBitBtn: csBitBtn:
Begin Begin
Window := CreateWindow('BUTTON', Nil, Flags or BS_PUSHBUTTON Or BS_OWNERDRAW, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil); pClassName := 'BUTTON';
IntSendMessage3(LM_LOADXPM, Sender, StrTemp); Flags := Flags or BS_PUSHBUTTON or BS_OWNERDRAW;
WindowTitle := nil;
IntSendMessage3(LM_LOADXPM, Sender, StrCaption);
End; End;
csButton: csButton:
Begin Begin
@ -1943,23 +1940,29 @@ Begin
Flags := Flags Or BS_PUSHBUTTON Flags := Flags Or BS_PUSHBUTTON
Else Else
Flags := Flags Or BS_DEFPUSHBUTTON; Flags := Flags Or BS_DEFPUSHBUTTON;
Window := CreateWindow('BUTTON', StrTemp, Flags, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil); pClassName := 'BUTTON';
WindowTitle := StrCaption;
End; End;
csCalendar: csCalendar:
Begin Begin
Window := CreateWindow('SysMonthCal32', StrTemp, WS_CHILD Or WS_VISIBLE, Left, Top, Width, Height, Parent, HMenu(Nil), HInstance, Nil); pClassName := 'SysMonthCal32';
WindowTitle := StrCaption;
Flags := WS_CHILD or WS_VISIBLE;
DoSubClass := False; DoSubClass := False;
End; End;
csCheckbox: csCheckbox:
Begin Begin
Window := CreateWindow('BUTTON', StrTemp, Flags Or BS_AUTOCHECKBOX, Left, Top, Width, Height, Parent, HMenu(Nil), HInstance, Nil); pClassName := 'BUTTON';
WindowTitle := StrCaption;
Flags := Flags Or BS_AUTOCHECKBOX;
End; End;
csComboBox: csComboBox:
Begin Begin
Flags := Flags or ComboBoxStyles[TCustomComboBox(Sender).Style]; Flags := Flags or ComboBoxStyles[TCustomComboBox(Sender).Style];
If TComboBox(Sender).Sorted Then If TComboBox(Sender).Sorted Then
Flags:= Flags or CBS_SORT; Flags:= Flags or CBS_SORT;
Window := CreateWindow('COMBOBOX', Nil, Flags or WS_VSCROLL or CBS_AUTOHSCROLL or CBS_HASSTRINGS, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil); pClassName := 'COMBOBOX';
Flags := Flags or WS_VSCROLL or CBS_AUTOHSCROLL or CBS_HASSTRINGS;
End; End;
csImage: csImage:
Begin Begin
@ -1972,7 +1975,7 @@ Begin
// SetOwner(Window, Sender); // SetOwner(Window, Sender);
// ReleaseDC(Handle, DC); // ReleaseDC(Handle, DC);
End; End;
csListBox: csListBox, csCheckListBox:
Begin Begin
With TCustomListBox(Sender) do With TCustomListBox(Sender) do
Begin Begin
@ -1983,8 +1986,12 @@ Begin
Flags:= Flags or LBS_EXTENDEDSEL Flags:= Flags or LBS_EXTENDEDSEL
else else
Flags:= Flags or LBS_MULTIPLESEL; Flags:= Flags or LBS_MULTIPLESEL;
end; if CompStyle = csCheckListBox then
Window := CreateWindowEx(WS_EX_CLIENTEDGE,'LISTBOX', Nil, Flags or WS_VSCROLL or LBS_NOINTEGRALHEIGHT, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil); Flags := Flags or LBS_OWNERDRAWFIXED;
end;
FlagsEx := WS_EX_CLIENTEDGE;
pClassName := 'LISTBOX';
Flags := Flags or WS_VSCROLL or LBS_NOINTEGRALHEIGHT;
End; End;
csCListBox: csCListBox:
Begin Begin
@ -1998,32 +2005,24 @@ Begin
else else
Flags:= Flags or LBS_MULTIPLESEL; Flags:= Flags or LBS_MULTIPLESEL;
End; End;
Window := CreateWindowEx(WS_EX_CLIENTEDGE,'LISTBOX', Nil, Flags Or LBS_MULTICOLUMN or WS_HSCROLL, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil); FlagsEx := WS_EX_CLIENTEDGE;
SendMessage(Window, LB_SETCOLUMNWIDTH, WPARAM(TCListBox(Sender).Width Div (TCListBox(Sender).ListColumns)), 0); pClassName := 'LISTBOX';
Flags := Flags or LBS_MULTICOLUMN or WS_HSCROLL;
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); FlagsEx := WS_EX_CLIENTEDGE;
pClassName := 'EDIT';
WindowTitle := StrCaption;
Flags := Flags Or ES_AUTOHSCROLL;
End; End;
csFileDialog, csOpenFileDialog, csSaveFileDialog,
csColorDialog, csFontDialog:
Begin
CreateCommonDialog(TCommonDialog(Sender),CompStyle);
End;
csSelectDirectoryDialog:
CreateSelectDirectoryDialog(TSelectDirectoryDialog(Sender));
csFixed: csFixed:
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); pClassName := @ClsName;
WindowTitle := StrCaption;
DoSubClass := false; DoSubClass := false;
End; End;
csFont:
Begin
Assert(False, 'Trace:CreateComponent - Creating a font');
With LPLogFont(@Sender)^ Do
Window := CreateFont(LFHeight, LFWidth, LFEscapement, LFOrientation, LFWeight, LFItalic, LFUnderLine, LFStrikeOut, LFCharSet, LFOutPrecision, LFClipPrecision, LFQuality, LFPitchAndFamily, LFFaceName);
End;
csForm: csForm:
Begin Begin
Assert(False, 'Trace:CreateComponent - Creating a Form Window'); Assert(False, 'Trace:CreateComponent - Creating a Form Window');
@ -2048,38 +2047,42 @@ Begin
If TCustomForm(Sender).FormStyle = fsStayOnTop Then If TCustomForm(Sender).FormStyle = fsStayOnTop Then
FlagsEx:= FlagsEx or WS_EX_TOPMOST; FlagsEx:= FlagsEx or WS_EX_TOPMOST;
try pClassName := @ClsName;
Window := CreateWindowEx(FlagsEx, @ClsName, StrTemp, Flags, LongInt(CW_USEDEFAULT), LongInt(CW_USEDEFAULT), LongInt(CW_USEDEFAULT), LongInt(CW_USEDEFAULT), Parent, HMENU(Nil), HInstance, Nil); WindowTitle := StrCaption;
except Left := LongInt(CW_USEDEFAULT);
writeln('Exception occured creating window'); Top := LongInt(CW_USEDEFAULT);
end; Width := LongInt(CW_USEDEFAULT);
Assert(False, 'Trace:CreateComponent - Form Window Handle Value = $' + IntToHex(Window, 8)); Height := LongInt(CW_USEDEFAULT);
Assert(False, 'Trace:Creating a Form - SetProp');
DoSubClass := false; DoSubClass := false;
If Window = 0 then
Begin
MessageBox(0, 'csForm CreateWindow Failed', nil, mb_Ok);
Exit;
End;
End; End;
csHintWindow: csHintWindow:
Begin Begin
Window := CreateWindow(@ClsName, StrTemp,WS_POPUP or WS_CLIPSIBLINGS or WS_CLIPCHILDREN, LongInt(CW_USEDEFAULT), LongInt(CW_USEDEFAULT), LongInt(CW_USEDEFAULT), LongInt(CW_USEDEFAULT), Parent, HMENU(Nil), HInstance, Nil); pClassName := @ClsName;
WindowTitle := StrCaption;
Flags := WS_POPUP or WS_CLIPSIBLINGS or WS_CLIPCHILDREN;
Left := LongInt(CW_USEDEFAULT);
Top := LongInt(CW_USEDEFAULT);
Width := LongInt(CW_USEDEFAULT);
Height := LongInt(CW_USEDEFAULT);
DoSubClass := false; DoSubClass := false;
End; End;
csFrame, csGroupBox: csFrame, csGroupBox:
Begin Begin
Window := CreateWindow('BUTTON', StrTemp, Flags Or BS_GROUPBOX, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil); pClassName := 'BUTTON';
TWinControl(Sender).InvalidateClientRectCache(true); WindowTitle := StrCaption;
Flags := Flags Or BS_GROUPBOX;
End; End;
csLabel: csLabel:
Begin Begin
Window := CreateWindow('STATIC', StrTemp, Flags Or SS_LEFT, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil); pClassName := 'STATIC';
WindowTitle := StrCaption;
Flags := Flags Or SS_LEFT;
End; End;
csListView: csListView:
Begin Begin
Window := CreateWindow(WC_LISTVIEW, StrTemp, Flags Or LVS_LIST Or LVS_SINGLESEL, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil); pClassName := WC_LISTVIEW;
SetOwner(Window, Sender); WindowTitle := StrCaption;
Flags := Flags Or LVS_LIST Or LVS_SINGLESEL;
End; End;
csMemo: csMemo:
Begin Begin
@ -2097,25 +2100,19 @@ Begin
ssBoth: ssBoth:
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); FlagsEx := WS_EX_CLIENTEDGE;
End; pClassName := 'EDIT';
csMainMenu, csMenuBar: WindowTitle := StrCaption;
Begin
Window := CreateMenu;
FMenu := Window;
Assert(False, Format('Trace:Main menu owner --> %S', [(TComponent(Sender).Owner As TWinControl).ClassName]));
End;
csMenuItem:
Begin
Window := CreateMenu;
End; End;
csNotebook: csNotebook:
Begin Begin
Window := CreateWindow(WC_TABCONTROL, Nil, Flags, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil); pClassName := WC_TABCONTROL;
End; End;
csRadioButton: csRadioButton:
Begin Begin
Window := CreateWindow('BUTTON', StrTemp, Flags Or BS_AUTORADIOBUTTON, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil); pClassName := 'BUTTON';
WindowTitle := StrCaption;
Flags := Flags Or BS_AUTORADIOBUTTON;
End; End;
csScrollBar: csScrollBar:
Begin Begin
@ -2125,38 +2122,37 @@ Begin
sbVertical: sbVertical:
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); pClassName := 'SCROLLBAR';
End; End;
csScrollBox: csScrollBox:
Begin Begin
//Todo: Make control respond to user scroll request //Todo: Make control respond to user scroll request
Window := CreateWindowEx(WS_EX_CLIENTEDGE, @ClsName, Nil, Flags or WS_HSCROLL or WS_VSCROLL, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil); FlagsEx := WS_EX_CLIENTEDGE;
DoSubClass:=False; pClassName := @ClsName;
Flags := Flags or WS_HSCROLL or WS_VSCROLL;
DoSubClass := false;
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, LongInt(CW_USEDEFAULT), LongInt(CW_USEDEFAULT), LongInt(CW_USEDEFAULT), LongInt(CW_USEDEFAULT), HWND(Nil), HMENU(Nil), HInstance, Nil); pClassName := @ClsName;
WindowTitle := StrCaption;
Flags := WS_OVERLAPPEDWINDOW Or WS_HSCROLL Or WS_VSCROLL Or WS_VISIBLE;
Left := LongInt(CW_USEDEFAULT);
Top := LongInt(CW_USEDEFAULT);
Width := LongInt(CW_USEDEFAULT);
Height := LongInt(CW_USEDEFAULT);
DoSubClass := false; DoSubClass := false;
End; End;
csSpinEdit:
Begin
Assert(False, 'Trace:TODO: Create a spin edit control. What is a spin edit contol anyway?');
//this needs to be created in the actual code because it requires a gtkadjustment Win32Control
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 or UDS_ALIGNRIGHT or UDS_NOTHOUSANDS or UDS_ARROWKEYS or UDS_WRAP or UDS_SETBUDDYINT,
0, 0, // pos - ignored for buddy
0, 0, // size - ignored for buddy
Parent, 0, HInstance, Buddy,
Trunc(TSpinEdit(Sender).MaxValue),
Trunc(TSpinEdit(Sender).MinValue),
Trunc(TSpinEdit(Sender).Value));
Assert(False, 'TRACE:Spin edit control not created');
End;
csStatusBar: csStatusBar:
Begin Begin
Assert(False, 'TRACE:CreateComponent - Creating Status Bar'); Assert(False, 'TRACE:CreateComponent - Creating Status Bar');
Window := CreateStatusWindow(Flags, StrTemp, Parent, 0); pClassName := STATUSCLASSNAME;
WindowTitle := StrCaption;
Left := LongInt(CW_USEDEFAULT);
Top := LongInt(CW_USEDEFAULT);
Width := LongInt(CW_USEDEFAULT);
Height := LongInt(CW_USEDEFAULT);
End; End;
csGTKTable: csGTKTable:
Begin Begin
@ -2170,36 +2166,36 @@ Begin
csToggleBox: csToggleBox:
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); pClassName := 'BUTTON';
WindowTitle := StrCaption;
Flags := Flags Or BS_AUTOCHECKBOX Or BS_PUSHLIKE;
End; End;
csToolBar: csToolBar:
Begin Begin
Window := CreateWindow(TOOLBARCLASSNAME, LPSTR(Nil), Flags OR CCS_ADJUSTABLE, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil); pClassName := TOOLBARCLASSNAME;
Flags := Flags OR CCS_ADJUSTABLE;
End; End;
csToolButton: csToolButton:
Begin Begin
Window := CreateWindow(@ToolBtnClsName, LPSTR(nil), 0, Left, Top, Width, Height, Parent, HMENU(nil), HInstance, nil); pClassName := ToolBtnClsName;
Flags := 0;
DoSubClass := false; DoSubClass := false;
End; End;
// TCustomPage - Notebook page // TCustomPage - Notebook page
csPage: csPage:
Begin 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); FlagsEx := WS_EX_CONTROLPARENT;
ShowWindow(Window, SW_HIDE); pClassName := @ClsName;
Flags := Flags and not WS_VISIBLE;
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); pClassName := @ClsName;
DoSubClass := false; DoSubClass := false;
End; End;
csPopupMenu:
Begin
Window := CreatePopupMenu;
FSubMenu := Window;
End;
csProgressBar: csProgressBar:
Begin Begin
with TProgressBar(Sender) do with TProgressBar(Sender) do
@ -2209,15 +2205,89 @@ Begin
if (Orientation = pbVertical) or (Orientation = pbTopDown) then if (Orientation = pbVertical) or (Orientation = pbTopDown) then
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); pClassName := PROGRESS_CLASS;
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); pClassName := TRACKBAR_CLASS;
WindowTitle := StrCaption;
End; End;
else
AlternateCreateWindow := true;
case CompStyle of
// these controls create no window handle using CreateWindowEx
csAlignment:
Begin
Assert(False, 'Trace:TODO: Code csAlignment. If anyone knows how to do this, please do.');
Handle:=TWinControl(Sender).Handle;
GetClientRect(Handle, R);
MoveWindow(Handle, R.Right - Left, R.Bottom - Top, (R.Right - R.Left) - (Left Div 2), (R.Bottom - R.Top) - (Top Div 2), True);
Window := Handle;
End;
csArrow:
Begin
Assert(False, 'Trace:TODO: TWin32Object.CreateComponent - Figure out what a csArrow is and code it');
Assert(False, 'Trace:TWin32Object.CreateComponent - Creating a cursor. This will have to be good enough for now.');
LoadCursor(HInst(Nil), IDC_SizeWE);
End;
csFileDialog, csOpenFileDialog, csSaveFileDialog,
csColorDialog, csFontDialog:
Begin
CreateCommonDialog(TCommonDialog(Sender),CompStyle);
End;
csSelectDirectoryDialog:
CreateSelectDirectoryDialog(TSelectDirectoryDialog(Sender));
csFont:
Begin
Assert(False, 'Trace:CreateComponent - Creating a font');
With LPLogFont(@Sender)^ Do
Window := CreateFont(LFHeight, LFWidth, LFEscapement, LFOrientation, LFWeight, LFItalic, LFUnderLine, LFStrikeOut, LFCharSet, LFOutPrecision, LFClipPrecision, LFQuality, LFPitchAndFamily, LFFaceName);
End;
csMainMenu, csMenuBar:
Begin
Window := CreateMenu;
FMenu := Window;
Assert(False, Format('Trace:Main menu owner --> %S', [(TComponent(Sender).Owner As TWinControl).ClassName]));
End;
csMenuItem:
Begin
Window := CreateMenu;
End;
csSpinEdit:
Begin
//this needs to be created in the actual code because it requires a gtkadjustment Win32Control
Buddy := CreateWindowEx(WS_EX_CLIENTEDGE, 'EDIT', StrCaption, Flags Or ES_AUTOHSCROLL, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil);
Window := CreateUpDownControl(Flags Or WS_Border or UDS_ALIGNRIGHT or UDS_NOTHOUSANDS or UDS_ARROWKEYS or UDS_WRAP or UDS_SETBUDDYINT,
0, 0, // pos - ignored for buddy
0, 0, // size - ignored for buddy
Parent, 0, HInstance, Buddy,
Trunc(TSpinEdit(Sender).MaxValue),
Trunc(TSpinEdit(Sender).MinValue),
Trunc(TSpinEdit(Sender).Value));
End;
csPopupMenu:
Begin
Window := CreatePopupMenu;
FSubMenu := Window;
End;
end;
End; {Case} End; {Case}
if not AlternateCreateWindow then
begin
if (Flags and WS_CHILD) <> 0 then
begin
// menu handle is also for specifying a control id if this is a child
MenuHandle := HMENU(FNextControlId);
Inc(FNextControlId);
end else begin
MenuHandle := HMENU(nil);
end;
Window := CreateWindowEx(FlagsEx, pClassName, WindowTitle, Flags,
Left, Top, Width, Height, Parent, MenuHandle, HInstance, Nil);
end;
if Window <> HWND(nil) then if Window <> HWND(nil) then
Windows.SetProp(Window, 'Lazarus', Integer(Sender)); Windows.SetProp(Window, 'Lazarus', Integer(Sender));
@ -2260,11 +2330,24 @@ Begin
End; End;
Try Try
StrDispose(StrTemp); StrDispose(StrCaption);
Except Except
Assert(False, 'Trace:Warning: Tried to dispose a string that was not allocated'); Assert(False, 'Trace:Warning: Tried to dispose a string that was not allocated');
End; End;
case CompStyle of
csCListBox:
begin
SendMessage(Window, LB_SETCOLUMNWIDTH, WPARAM(TCListBox(Sender).Width Div (TCListBox(Sender).ListColumns)), 0);
end;
csFrame, csGroupBox:
TWinControl(Sender).InvalidateClientRectCache(true);
csListView:
SetOwner(Window, Sender);
csPage:
ShowWindow(Window, SW_HIDE);
end;
Assert(False, 'Trace:Leaving CreateComponent'); Assert(False, 'Trace:Leaving CreateComponent');
End; End;
@ -2813,6 +2896,9 @@ End;
{ {
$Log$ $Log$
Revision 1.132 2003/11/21 20:32:01 micha
cleanups; wm_hscroll/wm_vscroll fix
Revision 1.131 2003/11/21 08:40:54 micha Revision 1.131 2003/11/21 08:40:54 micha
menuitems gone that have images, init bug menuitems gone that have images, init bug