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

customdrawnws: Updates the win32 backend after the last reworks, but it isn't showing the form anymore

Browse Source 
git-svn-id: trunk@33745 -
This commit is contained in:
sekelsenmat 2011-11-24 07:30:30 +00:00
parent a4e581205b
commit bd3a4c7440
12 changed files with 93 additions and 64 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -112,7 +112,7 @@ type
WinControl: TWinControl;
List: TStrings;
StayOnTopList: TList; // a list of windows that were normalized when showing modal
{needParentPaint: boolean; // has a tabpage as parent, and is winxp themed}
Children: TFPList;
MaxLength: dword;
MouseX, MouseY: word; // noticing spurious WM_MOUSEMOVE messages
// CD additions

2
lcl/interfaces/customdrawn/customdrawnint.pas
View File

@ -31,7 +31,7 @@ uses
// RTL
Types, Classes, SysUtils, Math,
fpimage, fpcanvas, fpimgcanv, ctypes,
{$ifdef CD_Windows}Windows, WinProc,{$endif}
{$ifdef CD_Windows}Windows, customdrawn_WinProc,{$endif}
{$ifdef CD_Cocoa}MacOSAll, CocoaAll,{$endif}
{$ifdef CD_X11}X, XLib, XUtil, customdrawn_x11proc,{unitxft, Xft font support}{$endif}
// Widgetset

19
lcl/interfaces/customdrawn/customdrawnwinapi.inc
View File

@ -2492,7 +2492,7 @@ function TQtWidgetSet.GetCaretRespondToFocus(handle: HWND; var ShowHideOnFocus:
begin
ShowHideOnFocus := QtCaret.GetQtCaretRespondToFocus;
Result := True;
end;
end;*)
{------------------------------------------------------------------------------
Function: GetClientBounds
@ -2504,15 +2504,14 @@ end;
the inner area of a control, where the child controls are visible. The
coordinates are relative to the control's left and top.
------------------------------------------------------------------------------}
function TQtWidgetSet.GetClientBounds(handle : HWND; var ARect : TRect) : Boolean;
function TCDWidgetSet.GetClientBounds(handle : HWND; var ARect : TRect) : Boolean;
begin
{$ifdef VerboseQtWinAPI}
{$ifdef VerboseWinAPI}
WriteLn('[WinAPI GetClientBounds]');
{$endif}
if Handle = 0 then
Exit(False);
ARect := TQtWidget(handle).getClientBounds;
Result := True;
// ToDO check if the window is native or not and process accordingly
// For now just assume it is native
Result := BackendGetClientBounds(Handle, ARect);
end;
{------------------------------------------------------------------------------
@ -2525,9 +2524,9 @@ end;
the inner area of a control, where the child controls are visible. The
coordinates are relative to the control's left and top.
------------------------------------------------------------------------------}
function TQtWidgetSet.GetClientRect(handle : HWND; var ARect : TRect) : Boolean;
function TCDWidgetSet.GetClientRect(handle : HWND; var ARect : TRect) : Boolean;
begin
{$ifdef VerboseQtWinAPI}
{$ifdef VerboseWinAPI}
WriteLn('[WinAPI GetClientRect]');
{$endif}
@ -2537,7 +2536,7 @@ begin
Result := True;
end;
{------------------------------------------------------------------------------
(*{------------------------------------------------------------------------------
Function: GetClipBox
Params: dc, lprect
Returns: Integer

6
lcl/interfaces/customdrawn/customdrawnwinapi_cocoa.inc
View File

@ -445,9 +445,9 @@ begin
if Handle<>0
then Result:=NSObject(Handle).lclIsVisible
else Result:=False;
end;
end;*)
function TCocoaWidgetSet.GetClientBounds(handle : HWND; var ARect : TRect) : Boolean;
function TCDWidgetSet.BackendGetClientBounds(handle : HWND; var ARect : TRect) : Boolean;
begin
if Handle<>0 then begin
Result:=True;
@ -456,7 +456,7 @@ begin
Result:=False;
end;
function TCocoaWidgetSet.GetClientRect(handle : HWND; var ARect : TRect) : Boolean;
(*function TCocoaWidgetSet.GetClientRect(handle : HWND; var ARect : TRect) : Boolean;
var
dx, dy: Integer;
begin

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

@ -1566,7 +1566,7 @@ end;
function TWin32WidgetSet.GetCharABCWidths(DC: HDC; P2, P3: UINT; Const ABCStructs): Boolean;
begin
Result := Boolean(Windows.GetCharABCWidths(DC, P2, P3, ABCStructs));
end;
end;*)
{------------------------------------------------------------------------------
Method: GetClientBounds
@ -1576,35 +1576,20 @@ end;
Retrieves the coordinates of a window's client area.
------------------------------------------------------------------------------}
function TWin32WidgetSet.GetClientBounds(Handle: HWND; var Rect: TRect): Boolean;
function TCDWidgetSet.BackendGetClientBounds(Handle: HWND; var ARect: TRect): Boolean;
var
ARect: TRect;
LRect: TRect;
begin
Result := Boolean(Windows.GetClientRect(Handle, @Rect));
Result := Boolean(Windows.GetClientRect(Handle, @ARect));
if not Result then exit;
if not GetLCLClientBoundsOffset(Handle, ARect) then exit;
Inc(Rect.Left, ARect.Left);
Inc(Rect.Top, ARect.Top);
Inc(Rect.Right, ARect.Right);
Inc(Rect.Bottom, ARect.Bottom);
if not GetLCLClientBoundsOffset(Handle, LRect) then exit;
Inc(ARect.Left, LRect.Left);
Inc(ARect.Top, LRect.Top);
Inc(ARect.Right, LRect.Right);
Inc(ARect.Bottom, LRect.Bottom);
end;
{------------------------------------------------------------------------------
Method: GetClientRect
Params: Handle - handle of window
Rect - record for client coordinates
Returns: If the function succeeds
Retrieves the dimension of a window's client area.
Left and Top are always 0,0
------------------------------------------------------------------------------}
function TWin32WidgetSet.GetClientRect(Handle: HWND; var Rect: TRect): Boolean;
begin
Result := GetClientBounds(Handle, Rect);
OffsetRect(Rect, -Rect.Left, -Rect.Top);
end;
{------------------------------------------------------------------------------
(*{------------------------------------------------------------------------------
Function: GetClipBox
Params: dc, lprect
Returns: Integer

13
lcl/interfaces/customdrawn/customdrawnwinapi_x11.inc
View File

@ -2484,7 +2484,7 @@ function TQtWidgetSet.GetCaretRespondToFocus(handle: HWND; var ShowHideOnFocus:
begin
ShowHideOnFocus := QtCaret.GetQtCaretRespondToFocus;
Result := True;
end;
end;*)
{------------------------------------------------------------------------------
Function: GetClientBounds
@ -2496,18 +2496,15 @@ end;
the inner area of a control, where the child controls are visible. The
coordinates are relative to the control's left and top.
------------------------------------------------------------------------------}
function TQtWidgetSet.GetClientBounds(handle : HWND; var ARect : TRect) : Boolean;
function TCDWidgetSet.BackendGetClientBounds(handle : HWND; var ARect : TRect) : Boolean;
begin
{$ifdef VerboseQtWinAPI}
WriteLn('[WinAPI GetClientBounds]');
{$endif}
if Handle = 0 then
(* if Handle = 0 then
Exit(False);
ARect := TQtWidget(handle).getClientBounds;
ARect := TQtWidget(handle).getClientBounds;*)
Result := True;
end;
{------------------------------------------------------------------------------
(*{------------------------------------------------------------------------------
Function: GetClientRect
Params: handle:
Result:

5
lcl/interfaces/customdrawn/customdrawnwinapih.inc
View File

@ -97,10 +97,11 @@ function GetBitmapBits(Bitmap: HBITMAP; Count: Longint; Bits: Pointer): Longint
function GetBkColor(DC: HDC): TColorRef; override;
function GetCapture: HWND; override;
function GetCaretPos(var lpPoint: TPoint): Boolean; override;
function GetCaretRespondToFocus(handle: HWND; var ShowHideOnFocus: boolean): Boolean; override;
function GetCaretRespondToFocus(handle: HWND; var ShowHideOnFocus: boolean): Boolean; override;*)
function GetClientBounds(handle : HWND; var ARect : TRect) : Boolean; override;
function BackendGetClientBounds(handle : HWND; var ARect : TRect) : Boolean;
function GetClientRect(handle : HWND; var ARect : TRect) : Boolean; override;
function GetClipBox(DC : hDC; lpRect : PRect) : Longint; override;
(*function GetClipBox(DC : hDC; lpRect : PRect) : Longint; override;
function GetClipRGN(DC: hDC; RGN: hRGN): Longint; override;
function GetCmdLineParamDescForInterface: string; override;
function GetCurrentObject(DC: HDC; uObjectType: UINT): HGDIOBJ; override;

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

@ -31,7 +31,7 @@ uses
// LCL
SysUtils, Classes, Types,
//
{$ifdef CD_Windows}Windows, WinProc,{$endif}
{$ifdef CD_Windows}Windows, customdrawn_WinProc,{$endif}
Controls, LCLType, LCLProc, Forms, Graphics,
lazcanvas, lazregions,
// Widgetset
@ -162,6 +162,7 @@ uses customdrawnwsforms;
{$ifdef CD_Windows}
{$include customdrawnwscontrols_win.inc}
{$include customdrawnwscontrols.inc}
{$endif}
{$ifdef CD_Cocoa}
{$include customdrawnwscontrols.inc}

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

@ -106,7 +106,7 @@ begin
end;
end;
class procedure TCDWSWinControl.AddControl(const AControl: TControl);
(*class procedure TCDWSWinControl.AddControl(const AControl: TControl);
var
ParentPanelHandle, ParentHandle, ChildHandle: HWND;
begin
@ -295,7 +295,7 @@ const
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;
end;*)
(*var
Handle: HWND;
// ParentPanel: HWND;

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

@ -32,14 +32,14 @@ interface
uses
// RTL
SysUtils, Classes, types, ctypes,
{$ifdef CD_Windows}Windows, WinProc,{$endif}
{$ifdef CD_Windows}Windows, customdrawn_WinProc,{$endif}
{$ifdef CD_Cocoa}MacOSAll, CocoaAll, CocoaPrivate, CocoaUtils,{$endif}
{$ifdef CD_X11}XShm, X, XLib, XUtil, XAtom, customdrawn_x11proc,{unitxft, Xft font support}{$endif}
// LazUtils
lazutf8sysutils,
// LCL
Controls, LCLType, Forms, LCLProc, GraphType, IntfGraphics, lazcanvas,
lazregions,
lazregions, LCLIntf,
// Widgetset
InterfaceBase, WSForms, WSProc, WSLCLClasses, LCLMessageGlue,
customdrawnwscontrols, customdrawnint, customdrawnproc;

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

@ -7,15 +7,21 @@ type
{ 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
{ lwin := TCocoaWindow(AForm.Handle);
if lwin.Children = nil then lwin.Children := TFPList.Create;
Result := lwin.Children;}
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;
@ -331,6 +337,10 @@ begin
{$endif}
end; *)
class procedure TCDWSCustomForm.DestroyHandle(const AWinControl: TWinControl);
begin
end;
class procedure TCDWSCustomForm.SetBorderIcons(const AForm: TCustomForm;
const ABorderIcons: TBorderIcons);
begin
@ -368,7 +378,7 @@ begin
// if position is default it will be changed to designed. We do not want this.
if wcfInitializing in TWinControlAccess(AWinControl).FWinControlFlags then
begin
if GetWindowRect(AForm.Handle, CurRect) then
if Windows.GetWindowRect(AForm.Handle, CurRect) then
begin
if AForm.Position in [poDefault, poDefaultPosOnly] then
begin
@ -444,8 +454,8 @@ class procedure TCDWSCustomForm.SetIcon(const AForm: TCustomForm; const Small, B
begin
if not WSCheckHandleAllocated(AForm, 'SetIcon') then
Exit;
SendMessage(AForm.Handle, WM_SETICON, ICON_SMALL, LPARAM(Small));
SendMessage(AForm.Handle, WM_SETICON, ICON_BIG, LPARAM(Big));
Windows.SendMessage(AForm.Handle, WM_SETICON, ICON_SMALL, LPARAM(Small));
Windows.SendMessage(AForm.Handle, WM_SETICON, ICON_BIG, LPARAM(Big));
end;
class procedure TCDWSCustomForm.SetShowInTaskbar(const AForm: TCustomForm;
@ -461,8 +471,8 @@ end;
class procedure TCDWSCustomForm.ShowModal(const ACustomForm: TCustomForm);
begin
ShowWindow(ACustomForm.Handle, SW_SHOW);
BringWindowToTop(ACustomForm.Handle);
Windows.ShowWindow(ACustomForm.Handle, SW_SHOW);
Windows.BringWindowToTop(ACustomForm.Handle);
end;
class procedure TCDWSCustomForm.ShowHide(const AWinControl: TWinControl);
@ -470,3 +480,35 @@ begin
TCDWSWinControl.ShowHide(AWinControl);
end;
class function TCDWSCustomForm.GetText(const AWinControl: TWinControl; var AText: String): Boolean;
begin
AText := '';
end;
class function TCDWSCustomForm.GetTextLen(const AWinControl: TWinControl; var ALength: Integer): Boolean;
var
S: String;
begin
Result := GetText(AWinControl, S);
if Result
then ALength := Length(S);
end;
class procedure TCDWSCustomForm.SetText(const AWinControl: TWinControl; const AText: String);
begin
if not WSCheckHandleAllocated(AWincontrol, 'SetText') then Exit;
Windows.SetWindowTextW(AWinControl.Handle, PWideChar(UTF8Decode(AText)));
end;
class function TCDWSCustomForm.GetClientBounds(const AWincontrol: TWinControl; var ARect: TRect): Boolean;
begin
Result := LCLIntf.GetClientBounds(AWincontrol.Handle, ARect);
end;
class function TCDWSCustomForm.GetClientRect(const AWincontrol: TWinControl; var ARect: TRect): Boolean;
begin
Result := LCLIntf.GetClientRect(AWincontrol.Handle, ARect);
end;

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

@ -313,6 +313,10 @@ Var
{$endif}
end;
// Now draw all child controls
RenderChildWinControls(WindowInfo^.Image, WindowInfo^.Canvas,
TCDWSCustomForm.BackendGetCDWinControlList(TCustomForm(lWinControl)));
// Now convert the rawimage to a HBITMAP and draw it to the screen
WindowInfo^.Image.GetRawImage(lRawImage);
WinProc_RawImage_CreateBitmaps(lRawImage, lBitmap, lMask, True);