paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2026-01-04 21:30:41 +01:00
Code Issues Packages Projects Releases Wiki Activity

customdrawn-windows: Starts rewriting for the new unified handle

Browse Source 
git-svn-id: trunk@33969 -
This commit is contained in:
sekelsenmat 2011-12-05 13:33:33 +00:00
parent eb931b330d
commit 6c068f32f8
10 changed files with 197 additions and 563 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -5475,7 +5475,6 @@ lcl/interfaces/customdrawn/customdrawnwinapih.inc svneol=native#text/pascal
lcl/interfaces/customdrawn/customdrawnwsarrow.pas svneol=native#text/plain
lcl/interfaces/customdrawn/customdrawnwscomctrls.pas svneol=native#text/pascal
lcl/interfaces/customdrawn/customdrawnwscontrols.pp svneol=native#text/plain
lcl/interfaces/customdrawn/customdrawnwscontrols_win.inc svneol=native#text/pascal
lcl/interfaces/customdrawn/customdrawnwsfactory.pas svneol=native#text/pascal
lcl/interfaces/customdrawn/customdrawnwsforms.pp svneol=native#text/plain
lcl/interfaces/customdrawn/customdrawnwsforms_android.inc svneol=native#text/pascal

78
lcl/interfaces/customdrawn/customdrawn_winproc.pas
View File

@ -28,7 +28,9 @@ uses
Windows, CTypes, Classes, SysUtils,
// LCL
LCLType, Interfacebase, LMessages, lclintf, LCLMessageGlue, LCLProc,
Controls, Forms, graphtype, Menus, IntfGraphics, lazcanvas;
Controls, Forms, graphtype, Menus, IntfGraphics, lazcanvas,
//
customdrawnproc;
type
MCHITTESTINFO = record
@ -103,21 +105,16 @@ var
type
TEventType = (etNotify, etKey, etKeyPress, etMouseWheel, etMouseUpDown);
PWindowInfo = ^TWindowInfo;
TWindowInfo = record
TWindowInfo = class(TCDForm)
Overlay: HWND; // overlay, transparent window on top, used by designer
//PopupMenu: TPopupMenu;
DefWndProc: WNDPROC;
ParentPanel: HWND; // if non-zero, is the tabsheet window, for the pagecontrol hack
WinControl: TWinControl;
List: TStrings;
StayOnTopList: TList; // a list of windows that were normalized when showing modal
Children: TFPList;
MaxLength: dword;
MouseX, MouseY: word; // noticing spurious WM_MOUSEMOVE messages
// CD additions
Image: TLazIntfImage;
Canvas: TLazCanvas;
Bitmap: HBITMAP;
BitmapWidth: integer;
BitmapHeight: integer;
@ -184,13 +181,10 @@ function BorderStyleToWinAPIFlags(Style: TFormBorderStyle): DWORD;
function BorderStyleToWinAPIFlagsEx(AForm: TCustomForm; Style: TFormBorderStyle): DWORD;
function GetFileVersion(FileName: string): dword;
function AllocWindowInfo(Window: HWND): PWindowInfo;
function DisposeWindowInfo(Window: HWND): boolean;
procedure RemoveStayOnTopFlags(AppHandle: HWND; ASystemTopAlso: Boolean = False);
procedure RestoreStayOnTopFlags(AppHandle: HWND);
function GetWindowInfo(Window: HWND): PWindowInfo;
procedure AddToChangedMenus(Window: HWnd);
procedure RedrawMenus;
function MeasureText(const AWinControl: TWinControl; Text: string; var Width, Height: integer): boolean;
@ -1218,7 +1212,7 @@ function GetLCLClientBoundsOffset(Handle: HWnd; var Rect: TRect): boolean;
var
OwnerObject: TObject;
begin
OwnerObject := GetWindowInfo(Handle)^.WinControl;
OwnerObject := TWindowInfo(Handle).LCLForm;
Result:=GetLCLClientBoundsOffset(OwnerObject, Rect);
end;
@ -1377,51 +1371,22 @@ begin
end;
end;
function AllocWindowInfo(Window: HWND): PWindowInfo;
var
WindowInfo: PWindowInfo;
begin
New(WindowInfo);
FillChar(WindowInfo^, sizeof(WindowInfo^), 0);
{$ifdef win32}
Windows.SetPropW(Window, PWideChar(DWord(WindowInfoAtom)), DWord(WindowInfo));
{$else}
Windows.SetProp(Window, PWideChar(DWord(WindowInfoAtom)), DWord(WindowInfo));
{$endif}
Result := WindowInfo;
end;
function DisposeWindowInfo(Window: HWND): boolean;
var
WindowInfo: PWindowInfo;
begin
{$ifdef win32}
WindowInfo := PWindowInfo(Windows.GetPropW(Window, PWideChar(DWord(WindowInfoAtom))));
Result := Windows.RemovePropW(Window, PWideChar(DWord(WindowInfoAtom)))<>0;
{$else}
WindowInfo := PWindowInfo(Windows.GetProp(Window, PWideChar(DWord(WindowInfoAtom))));
Result := Windows.RemoveProp(Window, PWideChar(DWord(WindowInfoAtom)))<>0;
{$endif}
if Result then
Dispose(WindowInfo);
end;
function EnumStayOnTopRemove(Handle: HWND; Param: LPARAM): WINBOOL; stdcall;
var
StayOnTopWindowsInfo: PStayOnTopWindowsInfo absolute Param;
lWindowInfo: PWindowInfo;
lWindowInfo: TWindowInfo;
lWinControl: TWinControl;
begin
Result := True;
{ Result := True;
if ((GetWindowLong(Handle, GWL_EXSTYLE) and WS_EX_TOPMOST) <> 0) then
begin
// Don't remove system-wide stay on top, unless desired
if not StayOnTopWindowsInfo^.SystemTopAlso then
begin
lWindowInfo := GetWindowInfo(Handle);
lWindowInfo := TWindowInfo(FindFormWithNativeHandle(Handle));
if Assigned(lWindowInfo) then
begin
lWinControl := lWindowInfo^.WinControl;
lWinControl := lWindowInfo.LCLForm;
if (lWinControl is TCustomForm) and
(TCustomForm(lWinControl).FormStyle = fsSystemStayOnTop) then
Exit;
@ -1429,16 +1394,16 @@ begin
end;
StayOnTopWindowsInfo^.StayOnTopList.Add(Pointer(Handle));
end;
end;}
end;
procedure RemoveStayOnTopFlags(AppHandle: HWND; ASystemTopAlso: Boolean = False);
var
StayOnTopWindowsInfo: PStayOnTopWindowsInfo;
WindowInfo: PWindowInfo;
WindowInfo: TWindowInfo;
I: Integer;
begin
//WriteLn('RemoveStayOnTopFlags ', InRemoveStayOnTopFlags);
{ //WriteLn('RemoveStayOnTopFlags ', InRemoveStayOnTopFlags);
if InRemoveStayOnTopFlags = 0 then
begin
New(StayOnTopWindowsInfo);
@ -1454,15 +1419,15 @@ begin
SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_NOOWNERZORDER or SWP_DRAWFRAME);
Dispose(StayOnTopWindowsInfo);
end;
inc(InRemoveStayOnTopFlags);
inc(InRemoveStayOnTopFlags);}
end;
procedure RestoreStayOnTopFlags(AppHandle: HWND);
var
WindowInfo: PWindowInfo;
WindowInfo: TWindowInfo;
I: integer;
begin
//WriteLn('RestoreStayOnTopFlags ', InRemoveStayOnTopFlags);
{ //WriteLn('RestoreStayOnTopFlags ', InRemoveStayOnTopFlags);
if InRemoveStayOnTopFlags = 1 then
begin
WindowInfo := GetWindowInfo(AppHandle);
@ -1476,18 +1441,7 @@ begin
end;
end;
if InRemoveStayOnTopFlags > 0 then
dec(InRemoveStayOnTopFlags);
end;
function GetWindowInfo(Window: HWND): PWindowInfo;
begin
{$ifdef win32}
Result := PWindowInfo(Windows.GetPropW(Window, PWideChar(DWord(WindowInfoAtom))));
{$else}
Result := PWindowInfo(Windows.GetProp(Window, PWideChar(DWord(WindowInfoAtom))));
{$endif}
if Result = nil then
Result := @DefaultWindowInfo;
dec(InRemoveStayOnTopFlags);}
end;
function WndClassName(Wnd: HWND): String; inline;

2
lcl/interfaces/customdrawn/customdrawnobject_win.inc
View File

@ -57,7 +57,7 @@ begin
0, {Windows.GetSystemMetrics(SM_CXSCREEN) div 2,}
0, {Windows.GetSystemMetrics(SM_CYSCREEN) div 2,}
0, 0, HWND(nil), HMENU(nil), HInstance, nil);
AllocWindowInfo(FAppHandle);
// AllocWindowInfo(FAppHandle);
// remove useless menuitems from sysmenu
SysMenu := Windows.GetSystemMenu(FAppHandle, False);
Windows.DeleteMenu(SysMenu, SC_MAXIMIZE, MF_BYCOMMAND);

30
lcl/interfaces/customdrawn/customdrawnproc.pas
View File

@ -32,6 +32,7 @@ type
public
LCLForm: TCustomForm;
Children: TFPList; // of TCDWinControl;
NativeHandle: HWND;
//
LastMouseDownControl: TWinControl; // Stores the control which should receive the next MouseUp
// painting objects
@ -56,6 +57,8 @@ function GetCDWinControlList(const AForm: TCustomForm): TFPList;
procedure InitNonNativeForms();
function GetCurrentForm(): TCDNonNativeForm;
function AddNewForm(AForm: TCustomForm): TCDNonNativeForm;
procedure AddFormWithCDHandle(AHandle: TCDForm);
function FindFormWithNativeHandle(AHandle: HWND): TCDForm;
procedure ShowForm(ACDForm: TCDNonNativeForm);
procedure HideForm(ACDForm: TCDNonNativeForm);
@ -131,14 +134,37 @@ begin
{$IFDEF VerboseCDForms}
DebugLn('AddNewForm');
{$ENDIF}
InitNonNativeForms();
lFormInfo := TCDNonNativeForm.Create;
lFormInfo.LCLForm := AForm;
lFormInfo.Children := TFPList.Create;
NonNativeForms.Insert(0, lFormInfo);
AddFormWithCDHandle(lFormInfo);
Result := lFormInfo;
end;
procedure AddFormWithCDHandle(AHandle: TCDForm);
begin
InitNonNativeForms();
NonNativeForms.Insert(0, AHandle);
end;
function FindFormWithNativeHandle(AHandle: HWND): TCDForm;
var
lCDForm: TCDForm;
i: Integer;
begin
Result := nil;
InitNonNativeForms();
for i := 0 to NonNativeForms.Count - 1 do
begin
lCDForm := TCDForm(NonNativeForms.Items[i]);
if lCDForm.NativeHandle = AHandle then
begin
Result := lCDForm;
Exit;
end;
end;
end;
procedure ShowForm(ACDForm: TCDNonNativeForm);
var
lCount, lCurIndex: Integer;

7
lcl/interfaces/customdrawn/customdrawnwinapi_win.inc
View File

@ -2219,7 +2219,6 @@ function TCDWidgetSet.GetWindowSize(Handle : hwnd;
var
WP: WINDOWPLACEMENT;
R: TRect;
WindowInfo: PWindowInfo;
Info: tagWINDOWINFO;
procedure ExcludeCaption; inline;
@ -2291,8 +2290,6 @@ begin
Height := Bottom - Top;
end;
WindowInfo := GetWindowInfo(Handle);
// convert top level lcl window coordinaties to win32 coord
Info.dwStyle := DWORD(GetWindowLong(Handle, GWL_STYLE));
Info.dwExStyle := DWORD(GetWindowLong(Handle, GWL_EXSTYLE));
@ -3589,7 +3586,7 @@ end;
function TWin32WidgetSet.SystemParametersInfo(uiAction: DWord; uiParam: DWord; pvParam: Pointer; fWinIni: DWord): LongBool;
begin
Result := Windows.SystemParametersInfo(uiAction, uiParam, pvParam, fWinIni);
end;*)
end;
{------------------------------------------------------------------------------
Method: TextOut
@ -3611,7 +3608,7 @@ begin
Result := Boolean(Windows.TextOutW(DC, X, Y, PWideChar(ws), length(ws)));
end;
(*function TWin32WidgetSet.UpdateWindow(Handle: HWND): Boolean;
function TWin32WidgetSet.UpdateWindow(Handle: HWND): Boolean;
begin
Result:=Windows.UpdateWindow(Handle);
end;

24
lcl/interfaces/customdrawn/customdrawnwscontrols.pp
View File

@ -31,7 +31,6 @@ uses
// LCL
SysUtils, Classes, Types,
//
{$ifdef CD_Windows}Windows, customdrawn_WinProc,{$endif}
Controls, LCLType, LCLProc, Forms, Graphics,
lazcanvas, lazregions,
// Widgetset
@ -137,33 +136,10 @@ type
published
end;
{$ifdef CD_Windows}
type
TCreateWindowExParams = record
Buddy, Parent, Window: HWND;
Left, Top, Height, Width: integer;
WindowInfo, BuddyWindowInfo: PWindowInfo;
MenuHandle: HMENU;
Flags, FlagsEx: dword;
SubClassWndProc: pointer;
WindowTitle, StrCaption: String;
pClassName: PWideChar;
end;
procedure PrepareCreateWindow(const AWinControl: TWinControl;
const CreateParams: TCreateParams; out Params: TCreateWindowExParams);
procedure FinishCreateWindow(const AWinControl: TWinControl; var Params: TCreateWindowExParams;
const AlternateCreateWindow: boolean);
{$endif}
implementation
uses customdrawnwsforms;
{$ifdef CD_Windows}
{$include customdrawnwscontrols_win.inc}
{$endif}
class function TCDWSWinControl.GetText(const AWinControl: TWinControl; var AText: String): Boolean;
begin
AText := '';

349
lcl/interfaces/customdrawn/customdrawnwscontrols_win.inc
View File

@ -1,349 +0,0 @@
{$MainUnit customdrawnwscontrols.pp}
type
TNCCreateParams = record
WinControl: TWinControl;
DefWndProc: WNDPROC;
Handled: Boolean;
end;
PNCCreateParams = ^TNCCreateParams;
procedure PrepareCreateWindow(const AWinControl: TWinControl;
const CreateParams: TCreateParams; out Params: TCreateWindowExParams);
begin
Fillchar(Params,Sizeof(Params),0);
with Params do
begin
Window := HWND(nil);
Buddy := HWND(nil);
WindowTitle := '';
SubClassWndProc := @WindowProc;
Flags := CreateParams.Style;
FlagsEx := CreateParams.ExStyle;
// Never set the parent of a window to AppHandle,
// otherwise wince will really try to make it a child
Parent := CreateParams.WndParent;
StrCaption := CreateParams.Caption;
Left := CreateParams.X;
Top := CreateParams.Y;
Width := CreateParams.Width;
Height := CreateParams.Height;
LCLBoundsToWin32Bounds(AWinControl, Left, Top, Width, Height);
// if AWinControl is TCustomControl then
// if TCustomControl(AWinControl).BorderStyle = bsSingle then
// FlagsEx := FlagsEx or WS_EX_CLIENTEDGE;
// SetStdBiDiModeParams(AWinControl, Params);
{$IFDEF VerboseSizeMsg}
Debugln('PrepareCreateWindow ',AWinControl.Name,':',AWinControl.ClassName,
' ',dbgs(Left),',',dbgs(Top),',',dbgs(Width),',',dbgs(Height));
{$ENDIF}
end;
end;
procedure FinishCreateWindow(const AWinControl: TWinControl; var Params: TCreateWindowExParams;
const AlternateCreateWindow: boolean);
var
lhFont: HFONT;
AErrorCode: Cardinal;
NCCreateParams: TNCCreateParams;
WindowClassW, DummyClassW: WndClassW;
begin
NCCreateParams.DefWndProc := nil;
NCCreateParams.WinControl := AWinControl;
NCCreateParams.Handled := False;
if not AlternateCreateWindow then
begin
with Params do
begin
Window := CreateWindowExW(FlagsEx, PWideChar(WideString(pClassName)),
PWideChar(UTF8ToUTF16(WindowTitle)), Flags,
Left, Top, Width, Height, Parent, 0, HInstance, @NCCreateParams);
if Window = 0 then
begin
AErrorCode := GetLastError;
DebugLn(['Failed to create win32 control, error: ', AErrorCode, ' : ', GetLastErrorText(AErrorCode)]);
raise Exception.Create('Failed to create win32 control, error: ' + IntToStr(AErrorCode) + ' : ' + GetLastErrorText(AErrorCode));
end;
end;
{ after creating a child window the following happens:
1) the previously bottom window is thrown to the top
2) the created window is added at the bottom
undo this by throwing them both to the bottom again }
{ not needed anymore, tab order is handled entirely by LCL now
Windows.SetWindowPos(Windows.GetTopWindow(Parent), HWND_BOTTOM, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);
Windows.SetWindowPos(Window, HWND_BOTTOM, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);
}
end;
with Params do
begin
if Window <> 0 then
begin
WindowInfo := AllocWindowInfo(Window);
WindowInfo^.WinControl := AWinControl;
AWinControl.Handle := Window;
//if Assigned(SubClassWndProc) then
// WindowInfo^.DefWndProc := Windows.WNDPROC(SetWindowLong(
// Window, GWL_WNDPROC, PtrInt(SubClassWndProc)));
// Set control ID to map WinControl. This is required for messages that sent to parent
// to extract control from the passed ID.
// In case of subclassing this ID will be set in WM_NCCREATE message handler
//SetWindowLong(Window, GWL_ID, PtrInt(AWinControl));
{ if AWinControl.Font.IsDefault then
lhFont := CDWidgetSet.DefaultFont
else
lhFont := AWinControl.Font.Reference.Handle;
Windows.SendMessage(Window, WM_SETFONT, WPARAM(lhFont), 0);}
end;
end;
end;
(*class procedure TCDWSWinControl.AddControl(const AControl: TControl);
var
ParentPanelHandle, ParentHandle, ChildHandle: HWND;
begin
{$ifdef OldToolbar}
if (AControl.Parent is TToolbar) then
exit;
{$endif}
with TWinControl(AControl) do
begin
//DebugLn(Format('Trace:[TCDWSWinControl.AddControl] %S --> Calling Add Child: %S', [Parent.ClassName, ClassName]));
ParentHandle := Parent.Handle;
ChildHandle := Handle;
end;
//DebugLn('Trace:AddControl - Parent Window Handle is $' + IntToHex(LongInt(ParentHandle), 8));
//DebugLn('Trace:AddControl - Child Window Handle is $' + IntToHex(LongInt(ChildHandle), 8));
// handle groupbox exception
ParentPanelHandle := GetWindowInfo(ChildHandle)^.ParentPanel;
if ParentPanelHandle <> 0 then
ChildHandle := ParentPanelHandle;
SetParent(ChildHandle, ParentHandle);
end;
class function TCDWSWinControl.GetText(const AWinControl: TWinControl; var AText: String): Boolean;
begin
AText := '';
Result := false;
end;
class procedure TCDWSWinControl.SetBorderStyle(const AWinControl: TWinControl; const ABorderStyle: TBorderStyle);
begin
RecreateWnd(AWinControl);
end;
class procedure TCDWSWinControl.SetChildZPosition(
const AWinControl, AChild: TWinControl; const AOldPos, ANewPos: Integer;
const AChildren: TFPList);
var
AfterWnd: hWnd;
n, StopPos: Integer;
Child: TWinControl;
begin
if not WSCheckHandleAllocated(AWincontrol, 'SetChildZPosition')
then Exit;
if not WSCheckHandleAllocated(AChild, 'SetChildZPosition (child)')
then Exit;
if ANewPos = 0 // bottom
then AfterWnd := HWND_BOTTOM
else if ANewPos >= AChildren.Count - 1
then AfterWnd := HWND_TOP
else begin
// Search for the first child above us with a handle
// the child list is reversed form the windows order.
// So the first window is the top window and is the last child
// if we don't find a allocated handle then we are effectively not moved
AfterWnd := 0;
if AOldPos > ANewPos
then StopPos := AOldPos // The child is moved to the bottom, oldpos is on top of it
else StopPos := AChildren.Count - 1; // the child is moved to the top
for n := ANewPos + 1 to StopPos do
begin
Child := TWinControl(AChildren[n]);
if Child.HandleAllocated
then begin
AfterWnd := Child.Handle;
Break;
end;
end;
if AfterWnd = 0 then Exit; // nothing to do
end;
Windows.SetWindowPos(AChild.Handle, AfterWnd, 0, 0, 0, 0,
SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOOWNERZORDER or
SWP_NOSIZE or SWP_NOSENDCHANGING);
end;
{------------------------------------------------------------------------------
Method: SetBounds
Params: AWinControl - the object which invoked this function
ALeft, ATop, AWidth, AHeight - new dimensions for the control
Pre: AWinControl.HandleAllocated
Returns: Nothing
Resize a window
------------------------------------------------------------------------------}
class procedure TCDWSWinControl.SetBounds(const AWinControl: TWinControl;
const ALeft, ATop, AWidth, AHeight: Integer);
var
IntfLeft, IntfTop, IntfWidth, IntfHeight: integer;
suppressMove: boolean;
Handle: HWND;
WindowPlacement: TWINDOWPLACEMENT;
begin
IntfLeft := ALeft;
IntfTop := ATop;
IntfWidth := AWidth;
IntfHeight := AHeight;
LCLBoundsToWin32Bounds(AWinControl, IntfLeft, IntfTop, IntfWidth, IntfHeight);
{$IFDEF VerboseSizeMsg}
DebugLn('TWin32WSWinControl.ResizeWindow A ', dbgsName(AWinControl),
' LCL=',Format('%d, %d, %d, %d', [ALeft,ATop,AWidth,AHeight]),
' Win32=',Format('%d, %d, %d, %d', [IntfLeft,IntfTop,IntfWidth,IntfHeight])
);
{$ENDIF}
suppressMove := False;
AdaptBounds(AWinControl, IntfLeft, IntfTop, IntfWidth, IntfHeight, suppressMove);
if not suppressMove then
begin
Handle := AWinControl.Handle;
WindowPlacement.length := SizeOf(WindowPlacement);
if IsIconic(Handle) and GetWindowPlacement(Handle, @WindowPlacement) then
begin
WindowPlacement.rcNormalPosition := Bounds(IntfLeft, IntfTop, IntfWidth, IntfHeight);
SetWindowPlacement(Handle, @WindowPlacement);
end
else
Windows.SetWindowPos(Handle, 0, IntfLeft, IntfTop, IntfWidth, IntfHeight, SWP_NOZORDER or SWP_NOACTIVATE);
end;
LCLControlSizeNeedsUpdate(AWinControl, True);
end;
class procedure TCDWSWinControl.SetColor(const AWinControl: TWinControl);
begin
// TODO: to be implemented, had no implementation in LM_SETCOLOR message
end;
class procedure TCDWSWinControl.SetFont(const AWinControl: TWinControl; const AFont: TFont);
begin
Windows.SendMessage(AWinControl.Handle, WM_SETFONT, Windows.WParam(AFont.Reference.Handle), 1);
end;
class procedure TCDWSWinControl.SetText(const AWinControl: TWinControl; const AText: string);
begin
if not WSCheckHandleAllocated(AWincontrol, 'SetText') then Exit;
Windows.SetWindowTextW(AWinControl.Handle, PWideChar(UTF8Decode(AText)));
end;
class procedure TCDWSWinControl.ConstraintsChange(const AWinControl: TWinControl);
begin
// TODO: implement me!
end;
class function TCDWSWinControl.CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): HWND;
var
Params: TCreateWindowExParams;
begin
{$ifdef VerboseWinCE}
DebugLn(' TWinCEWSWinControl.CreateHandle ');
{$endif}
// general initialization of Params
PrepareCreateWindow(AWinControl, AParams, Params);
// customization of Params
with Params do
begin
pClassName := @ClsName;
WindowTitle := StrCaption;
SubClassWndProc := nil;
end;
// create window
FinishCreateWindow(AWinControl, Params, false);
Result := Params.Window;
end;
class procedure TCDWSWinControl.DestroyHandle(const AWinControl: TWinControl);
var
Handle: HWND;
begin
Handle := AWinControl.Handle;
DestroyWindow(Handle);
end;
class procedure TCDWSWinControl.Invalidate(const AWinControl: TWinControl);
begin
// lpRect = nil updates entire client area of window
InvalidateRect(AWinControl.Handle, nil, true);
end;
class procedure TCDWSWinControl.ShowHide(const AWinControl: TWinControl);
const
VisibilityToFlag: array[Boolean] of UINT = (SWP_HIDEWINDOW, SWP_SHOWWINDOW);
begin
Windows.SetWindowPos(AWinControl.Handle, 0, 0, 0, 0, 0,
SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or VisibilityToFlag[AWinControl.HandleObjectShouldBeVisible])
end;*)
(*var
Handle: HWND;
// ParentPanel: HWND;
Flags: dword;
begin
//if (TControl(Sender).FCompStyle = csPage) or (TControl(Sender).FCompStyle = csToolButton) then exit;
Handle := ObjectToHWND(AWinControl);
// ParentPanel := GetWindowInfo(Handle)^.ParentPanel;
// if ParentPanel <> 0 then
// Handle := ParentPanel;
if AWinControl.HandleObjectShouldBeVisible then
begin
//DebugLn('Trace: [TWinCEWidgetSet.ShowHide] Showing the window');
if AWinControl.FCompStyle = csHintWindow then
begin
Windows.SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_SHOWWINDOW or SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_NOOWNERZORDER);
end else begin
Flags := SW_SHOW;
if (AWinControl is TCustomForm) and
(Application.ApplicationType = atDesktop) then
case TCustomForm(AWinControl).WindowState of
wsMaximized: Flags := SW_SHOWMAXIMIZED;
wsMinimized: Flags := SW_SHOWMINIMIZED;
end;
Windows.ShowWindow(Handle, Flags);
{ ShowWindow does not send WM_SHOWWINDOW when creating overlapped maximized window }
{ TODO: multiple WM_SHOWWINDOW when maximizing after initial show? }
if Flags = SW_SHOWMAXIMIZED then
Windows.SendMessage(Handle, WM_SHOWWINDOW, 1, 0);
end;
if (AWinControl is TCustomForm) then
begin
if TCustomForm(AWinControl).BorderStyle <> bsDialog then
begin
SetClassLong(Handle, GCL_HICONSM, LONG(TCustomForm(AWinControl).SmallIconHandle));
SetClassLong(Handle, GCL_HICON, LONG(TCustomForm(AWinControl).BigIconHandle));
end
else
begin
SetClassLong(Handle, GCL_HICONSM, 0);
SetClassLong(Handle, GCL_HICON, 0);
end;
end;
end
else
begin
//DebugLn('TRACE: [TWinCEWidgetSet.ShowHide] Hiding the window');
ShowWindow(Handle, SW_HIDE);
end;
end; *)

4
lcl/interfaces/customdrawn/customdrawnwsforms.pp
View File

@ -84,8 +84,8 @@ type
class function CalcBorderIconsFlagsEx(const AForm: TCustomForm): DWORD;
class procedure CalcFormWindowFlags(const AForm: TCustomForm;
var Flags, FlagsEx: dword);
class procedure CalculateDialogPosition(var Params: TCreateWindowExParams;
Bounds: TRect; lForm: TCustomForm);
//class procedure CalculateDialogPosition(var Params: TCreateWindowExParams;
//Bounds: TRect; lForm: TCustomForm);
class function GetDesigningBorderStyle(const AForm: TCustomForm): TFormBorderStyle;
class function CalcBorderStyleFlags(const AForm: TCustomForm): DWORD;
class function CalcBorderStyleFlagsEx(const AForm: TCustomForm): DWORD;

168
lcl/interfaces/customdrawn/customdrawnwsforms_win.inc
View File

@ -4,26 +4,15 @@ type
TWinControlAccess = class(TWinControl)
end;
TNCCreateParams = record
WinControl: TWinControl;
DefWndProc: WNDPROC;
Handled: Boolean;
end;
PNCCreateParams = ^TNCCreateParams;
{ TCDWSCustomForm }
class procedure TCDWSCustomForm.BackendAddCDWinControlToForm(const AForm: TCustomForm; ACDWinControl: TCDWinControl);
var
WindowInfo: PWindowInfo;
begin
WindowInfo := GetWindowInfo(AForm.Handle);
if WindowInfo^.Children = nil then WindowInfo^.Children := TFPList.Create;
WindowInfo^.Children.Add(ACDWinControl);
end;
class function TCDWSCustomForm.BackendGetCDWinControlList(const AForm: TCustomForm): TFPList;
var
WindowInfo: PWindowInfo;
begin
WindowInfo := GetWindowInfo(AForm.Handle);
if WindowInfo^.Children = nil then WindowInfo^.Children := TFPList.Create;
Result := WindowInfo^.Children;
end;
class function TCDWSCustomForm.CalcBorderIconsFlags(const AForm: TCustomForm): dword;
var
BorderIcons: TBorderIcons;
@ -71,7 +60,7 @@ begin
FlagsEx := FlagsEx or CalcBorderIconsFlagsEx(AForm);
end;
class procedure TCDWSCustomForm.CalculateDialogPosition(var Params: TCreateWindowExParams;
{class procedure TCDWSCustomForm.CalculateDialogPosition(var Params: TCreateWindowExParams;
Bounds: TRect; lForm: TCustomForm);
begin
if lForm.Position in [poDefault, poDefaultPosOnly] then
@ -94,7 +83,7 @@ begin
Params.Width := Bounds.Right - Bounds.Left;
Params.Height := Bounds.Bottom - Bounds.Top;
end;
end;
end;}
class function TCDWSCustomForm.GetDesigningBorderStyle(const AForm: TCustomForm): TFormBorderStyle;
begin
@ -192,72 +181,123 @@ end;
class function TCDWSCustomForm.CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): TLCLIntfHandle;
var
Params: TCreateWindowExParams;
lForm: TCustomForm absolute AWinControl;
Bounds: TRect;
SystemMenu: HMenu;
// Create Params
Parent, Window: HWND;
Left, Top, Height, Width: integer;
WindowInfo, BuddyWindowInfo: TWindowInfo;
MenuHandle: HMENU;
Flags, FlagsEx: dword;
SubClassWndProc: pointer;
WindowTitle: widestring;
pClassName: PWideChar;
//
NCCreateParams: TNCCreateParams;
AErrorCode: DWORD;
begin
{$ifdef VerboseCDForms}
DebugLn(Format(':>[TCDWSCustomForm.CreateHandle] AWincontrol=%x left=%d Top=%d'
+ ' Width=%d Height=%d', [PtrInt(AWincontrol), AWinControl.Top, AWinControl.Left,
AParams.Width, AParams.Height]));
{$endif}
NCCreateParams.DefWndProc := nil;
NCCreateParams.WinControl := AWinControl;
NCCreateParams.Handled := False;
// general initialization of Params
PrepareCreateWindow(AWinControl, AParams, Params);
//Fillchar(Params,Sizeof(Params),0);
Window := HWND(nil);
WindowTitle := UTF8ToUTF16(AParams.Caption);
//SubClassWndProc := @WindowProc;
Flags := AParams.Style;
FlagsEx := AParams.ExStyle;
// Never set the parent of a window to AppHandle,
// otherwise wince will really try to make it a child
Parent := AParams.WndParent;
Left := AParams.X;
Top := AParams.Y;
Width := AParams.Width;
Height := AParams.Height;
LCLBoundsToWin32Bounds(AWinControl, Left, Top, Width, Height);
// if AWinControl is TCustomControl then
// if TCustomControl(AWinControl).BorderStyle = bsSingle then
// FlagsEx := FlagsEx or WS_EX_CLIENTEDGE;
// SetStdBiDiModeParams(AWinControl, Params);
// customization of Params
with Params do
if (Parent = 0) then
begin
if (Parent = 0) then
if not Application.MainFormOnTaskBar then
Parent := CDWidgetSet.AppHandle
else
if (AWinControl <> Application.MainForm) then
begin
if not Application.MainFormOnTaskBar then
Parent := CDWidgetSet.AppHandle
if Assigned(Application.MainForm) and Application.MainForm.HandleAllocated then
Parent := Application.MainFormHandle
else
if (AWinControl <> Application.MainForm) then
begin
if Assigned(Application.MainForm) and Application.MainForm.HandleAllocated then
Parent := Application.MainFormHandle
else
Parent := CDWidgetSet.AppHandle;
end;
Parent := CDWidgetSet.AppHandle;
end;
CalcFormWindowFlags(lForm, Flags, FlagsEx);
pClassName := @ClsName[0];
WindowTitle := StrCaption;
AdjustFormBounds(lForm, Bounds);
if (lForm.Position in [poDefault, poDefaultPosOnly]) and not (csDesigning in lForm.ComponentState) then
begin
Left := CW_USEDEFAULT;
Top := CW_USEDEFAULT;
end
else
begin
Left := Bounds.Left;
Top := Bounds.Top;
end;
if (lForm.Position in [poDefault, poDefaultSizeOnly]) and not (csDesigning in lForm.ComponentState) then
begin
Width := CW_USEDEFAULT;
Height := CW_USEDEFAULT;
end
else
begin
Width := Bounds.Right - Bounds.Left;
Height := Bounds.Bottom - Bounds.Top;
end;
//SubClassWndProc := @CustomFormWndProc;
if not (csDesigning in lForm.ComponentState) and lForm.AlphaBlend then
FlagsEx := FlagsEx or WS_EX_LAYERED;
end;
CalcFormWindowFlags(lForm, Flags, FlagsEx);
pClassName := @ClsName[0];
AdjustFormBounds(lForm, Bounds);
if (lForm.Position in [poDefault, poDefaultPosOnly]) and not (csDesigning in lForm.ComponentState) then
begin
Left := CW_USEDEFAULT;
Top := CW_USEDEFAULT;
end
else
begin
Left := Bounds.Left;
Top := Bounds.Top;
end;
if (lForm.Position in [poDefault, poDefaultSizeOnly]) and not (csDesigning in lForm.ComponentState) then
begin
Width := CW_USEDEFAULT;
Height := CW_USEDEFAULT;
end
else
begin
Width := Bounds.Right - Bounds.Left;
Height := Bounds.Bottom - Bounds.Top;
end;
//SubClassWndProc := @CustomFormWndProc;
if not (csDesigning in lForm.ComponentState) and lForm.AlphaBlend then
FlagsEx := FlagsEx or WS_EX_LAYERED;
//SetStdBiDiModeParams(AWinControl, Params);
// create window
FinishCreateWindow(AWinControl, Params, False);
Result := Params.Window;
Window := CreateWindowExW(FlagsEx, PWideChar(WideString(pClassName)),
PWideChar(WindowTitle), Flags,
Left, Top, Width, Height, Parent, 0, HInstance, @NCCreateParams);
if Window = 0 then
begin
AErrorCode := GetLastError;
DebugLn(['Failed to create win32 control, error: ', AErrorCode, ' : ', GetLastErrorText(AErrorCode)]);
raise Exception.Create('Failed to create win32 control, error: ' + IntToStr(AErrorCode) + ' : ' + GetLastErrorText(AErrorCode));
end;
WindowInfo := TWindowInfo.Create;
WindowInfo.LCLForm := TCustomForm(AWinControl);
WindowInfo.NativeHandle := Window;
//AWinControl.Handle := HWND(WindowInfo);
AddFormWithCDHandle(WindowInfo);
Result := HWND(WindowInfo);
// remove system menu items for bsDialog
if (lForm.BorderStyle = bsDialog) and not (csDesigning in lForm.ComponentState) then
begin
SystemMenu := GetSystemMenu(Result, False);
SystemMenu := GetSystemMenu(Window, False);
DeleteMenu(SystemMenu, SC_RESTORE, MF_BYCOMMAND);
DeleteMenu(SystemMenu, SC_SIZE, MF_BYCOMMAND);
DeleteMenu(SystemMenu, SC_MINIMIZE, MF_BYCOMMAND);
@ -269,7 +309,7 @@ begin
// rectangles and accelerator key indication. According to msdn we need to
// initialize all root windows with this message
if WindowsVersion >= wv2000 then
Windows.SendMessage(Result, WM_CHANGEUISTATE,
Windows.SendMessage(Window, WM_CHANGEUISTATE,
MakeWParam(UIS_INITIALIZE, UISF_HIDEFOCUS or UISF_HIDEACCEL), 0);
{$ifdef VerboseCDForms}

97
lcl/interfaces/customdrawn/wincallback.inc
View File

@ -64,14 +64,14 @@ function CallDefaultWindowProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam;
var
PrevWndProc: Windows.WNDPROC;
setComboWindow: boolean;
WindowInfo: PWindowInfo;
WindowInfo: TWindowInfo;
begin
{$ifdef MSG_DEBUG}
DebugLn('Trace:CallDefaultWindowProc - Start');
{$endif}
WindowInfo := GetWindowInfo(Window);
PrevWndProc := WindowInfo^.DefWndProc;
WindowInfo := TWindowInfo(FindFormWithNativeHandle(Window));
PrevWndProc := WindowInfo.DefWndProc;
if (PrevWndProc = nil) or (PrevWndProc = @WindowProc) // <- prevent recursion
then
@ -151,8 +151,6 @@ function WindowProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam;
LParam: Windows.LParam): LResult; {$ifdef win32}stdcall{$else}cdecl{$endif};
Var
LMessage: TLMessage;
menuItem: TObject;
menuHDC: HDC;
PLMsg: PLMessage;
R: TRect;
P: TPoint;
@ -164,10 +162,8 @@ Var
WindowPlacement: TWINDOWPLACEMENT;
OverlayWindow: HWND;
TargetWindow: HWND;
eraseBkgndCommand: TEraseBkgndCommand;
WindowInfo: PWindowInfo;
WindowInfo: TWindowInfo;
Flags: dword;
ChildWindowInfo: PWindowInfo;
WindowColor: Integer;
LMScroll: TLMScroll; // used by WM_HSCROLL
@ -237,43 +233,43 @@ Var
GetWindowSize(Window, WindowWidth, WindowHeight);
// Start the double buffering by checking if we need to increase the buffer
if (WindowInfo^.BitmapWidth < WindowWidth) or (WindowInfo^.BitmapHeight < WindowHeight) then
if (WindowInfo.BitmapWidth < WindowWidth) or (WindowInfo.BitmapHeight < WindowHeight) then
begin
// first release old objects
if WindowInfo^.BitmapDC <> 0 then
if WindowInfo.BitmapDC <> 0 then
begin
Windows.SelectObject(WindowInfo^.BitmapDC, WindowInfo^.DCBitmapOld);
Windows.DeleteObject(WindowInfo^.BitmapDC);
Windows.SelectObject(WindowInfo.BitmapDC, WindowInfo.DCBitmapOld);
Windows.DeleteObject(WindowInfo.BitmapDC);
end;
if WindowInfo^.Bitmap <> 0 then Windows.DeleteObject(WindowInfo^.Bitmap);
if WindowInfo.Bitmap <> 0 then Windows.DeleteObject(WindowInfo.Bitmap);
// And now create the new ones
DC := Windows.GetDC(0);
WindowInfo^.BitmapDC := Windows.CreateCompatibleDC(0);
WindowInfo^.BitmapWidth := WindowWidth;
WindowInfo^.BitmapHeight := WindowHeight;
WindowInfo^.Bitmap := Windows.CreateCompatibleBitmap(DC, WindowWidth, WindowHeight);
WindowInfo^.DCBitmapOld := Windows.SelectObject(WindowInfo^.BitmapDC, WindowInfo^.Bitmap);
WindowInfo.BitmapDC := Windows.CreateCompatibleDC(0);
WindowInfo.BitmapWidth := WindowWidth;
WindowInfo.BitmapHeight := WindowHeight;
WindowInfo.Bitmap := Windows.CreateCompatibleBitmap(DC, WindowWidth, WindowHeight);
WindowInfo.DCBitmapOld := Windows.SelectObject(WindowInfo.BitmapDC, WindowInfo.Bitmap);
Windows.ReleaseDC(0, DC);
// Reset the image and canvas
WindowInfo^.Canvas.Free;
WindowInfo^.Canvas := nil;
WindowInfo^.Image.Free;
WindowInfo^.Image := nil;
WindowInfo.Canvas.Free;
WindowInfo.Canvas := nil;
WindowInfo.Image.Free;
WindowInfo.Image := nil;
end;
// Prepare the non-native Canvas if necessary
if (WindowInfo^.Image = nil) then
if (WindowInfo.Image = nil) then
begin
WinProc_RawImage_FromBitmap(lRawImage, WindowInfo^.Bitmap, 0);
WindowInfo^.Image := TLazIntfImage.Create(WindowWidth, WindowHeight);
WindowInfo^.Image.SetRawImage(lRawImage);
WinProc_RawImage_FromBitmap(lRawImage, WindowInfo.Bitmap, 0);
WindowInfo.Image := TLazIntfImage.Create(WindowWidth, WindowHeight);
WindowInfo.Image.SetRawImage(lRawImage);
end;
if (WindowInfo^.Canvas = nil) then WindowInfo^.Canvas := TLazCanvas.Create(WindowInfo^.Image);
if (WindowInfo.Canvas = nil) then WindowInfo.Canvas := TLazCanvas.Create(WindowInfo.Image);
{$ifdef VerboseCDMessages}
DebugLn(Format('[SendPaintMessage] WindowInfo^.Canvas=%s', [dbghex(PtrInt(WindowInfo^.Canvas))]));
DebugLn(Format('[SendPaintMessage] WindowInfo^.Canvas=%s', [dbghex(PtrInt(WindowInfo.Canvas))]));
{$endif}
// main processing
@ -293,7 +289,7 @@ Var
GetLCLClientBoundsOffset(lWinControl, ORect);
PaintMsg.Msg := LM_PAINT;
PaintMsg.PaintStruct := @PS;
PaintMsg.DC := HDC(WindowInfo^.Canvas);
PaintMsg.DC := HDC(WindowInfo.Canvas);
// send through message to allow message override, moreover use SendMessage
// to allow subclass window proc override this message too
@ -316,15 +312,15 @@ Var
{$endif}
// Now draw all child controls
RenderChildWinControls(WindowInfo^.Image, WindowInfo^.Canvas,
TCDWSCustomForm.BackendGetCDWinControlList(TCustomForm(lWinControl)));
RenderChildWinControls(WindowInfo.Image, WindowInfo.Canvas,
GetCDWinControlList(TCustomForm(lWinControl)));
// Now convert the rawimage to a HBITMAP and draw it to the screen
WindowInfo^.Image.GetRawImage(lRawImage);
WindowInfo.Image.GetRawImage(lRawImage);
WinProc_RawImage_CreateBitmaps(lRawImage, lBitmap, lMask, True);
Windows.SelectObject(WindowInfo^.BitmapDC, lBitmap);
Windows.BitBlt(DC, 0, 0, WindowWidth, WindowHeight, WindowInfo^.BitmapDC, 0, 0, SRCCOPY);
Windows.SelectObject(WindowInfo^.BitmapDC, WindowInfo^.Bitmap);
Windows.SelectObject(WindowInfo.BitmapDC, lBitmap);
Windows.BitBlt(DC, 0, 0, WindowWidth, WindowHeight, WindowInfo.BitmapDC, 0, 0, SRCCOPY);
Windows.SelectObject(WindowInfo.BitmapDC, WindowInfo.Bitmap);
Windows.DeleteObject(lBitmap);
if ControlDC = 0 then
@ -480,7 +476,7 @@ Var
begin
Result := false;
UTF8Char := UTF8Encode(widestring(WideChar(AChar)));
lWinControl := WindowInfo^.WinControl;
lWinControl := WindowInfo.LCLForm;
if Assigned(lWinControl) then
begin
Result:= lWinControl.IntfUTF8KeyPress(UTF8Char, 1, False);
@ -500,9 +496,9 @@ begin
NotifyUserInput := False;
//DebugLn('Trace:WindowProc - Getting Object with Callback Procedure');
WindowInfo := GetWindowInfo(Window);
WindowInfo := TWindowInfo(FindFormWithNativeHandle(Window));
lWinControl := WindowInfo^.WinControl;
lWinControl := WindowInfo.LCLForm;
{$ifdef VerboseCDMessages}
DebugLn('WindowProc lWinControl: ',DbgSName(lWinControl),' MSG=',WM_To_String(Msg));
@ -663,9 +659,6 @@ begin
end;
WM_DESTROY:
begin
//DebugLn('Trace:WindowProc - Got WM_DESTROY');
if WindowInfo^.Overlay<>HWND(nil) then
Windows.DestroyWindow(WindowInfo^.Overlay);
LMessage.Msg := LM_DESTROY;
end;
WM_DESTROYCLIPBOARD:
@ -692,7 +685,7 @@ begin
WM_ENTERIDLE: Application.Idle(False);
WM_ERASEBKGND:
begin
eraseBkgndCommand := TEraseBkgndCommand(EraseBkgndStack and EraseBkgndStackMask);
{eraseBkgndCommand := TEraseBkgndCommand(EraseBkgndStack and EraseBkgndStackMask);
if eraseBkgndCommand = ecDoubleBufferNoRemove then
begin
end
@ -713,7 +706,7 @@ begin
begin
SendPaintMessage(HDC(WParam));
LMessage.Result := 1;
end;
end;}
WinProcess := False;
end;
@ -916,17 +909,18 @@ begin
YPos := SmallInt(Hi(LParam));
Keys := WParam;
// check if this is a spurious WM_MOUSEMOVE message, pos not actually changed
if (XPos = WindowInfo^.MouseX) and (YPos = WindowInfo^.MouseY) then
if (XPos = WindowInfo.MouseX) and (YPos = WindowInfo.MouseY) then
begin
// do not fire message after all (position not changed)
Msg := LM_NULL;
NotifyUserInput := false;
end else
if WindowInfo <> @DefaultWindowInfo then
if (WindowInfo.MouseX <> DefaultWindowInfo.MouseX) or
(WindowInfo.MouseY <> DefaultWindowInfo.MouseY) then
begin
// position changed, update window info
WindowInfo^.MouseX := XPos;
WindowInfo^.MouseY := YPos;
WindowInfo.MouseX := XPos;
WindowInfo.MouseY := YPos;
end;
end;
end;
@ -1368,7 +1362,7 @@ begin
begin
lEventReceiver := FindControlWhichReceivedEvent(
TCustomForm(lWinControl),
TCDWSCustomForm.BackendGetCDWinControlList(TCustomForm(lWinControl)),
GetCDWinControlList(TCustomForm(lWinControl)),
lEventX, lEventY);
DeliverMessage(lEventReceiver, PLMsg^);
end;
@ -1408,11 +1402,8 @@ begin
end;
WM_NCDESTROY:
begin
//roozbeh : test this....
// free our own data associated with window
if DisposeWindowInfo(Window) then
WindowInfo := nil;
//EnumProps(Window, @PropEnumProc);
WindowInfo.Free;
WindowInfo := nil;
end;
end;
end;