mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-09-25 13:49:16 +02:00
customdrawnws: more structural code
git-svn-id: trunk@33364 -
This commit is contained in:
sekelsenmat
parent
b7d842fe5e
commit
6b2e9132e3
3
.gitattributes
vendored
3
.gitattributes
vendored
@ -5396,6 +5396,9 @@ lcl/interfaces/customdrawn/alllclintfunits.pas svneol=native#text/plain
|
||||
lcl/interfaces/customdrawn/customdrawnint.pas svneol=native#text/plain
|
||||
lcl/interfaces/customdrawn/customdrawnobject.inc svneol=native#text/plain
|
||||
lcl/interfaces/customdrawn/customdrawnobject_win.inc svneol=native#text/plain
|
||||
lcl/interfaces/customdrawn/customdrawnwscontrols.pp svneol=native#text/plain
|
||||
lcl/interfaces/customdrawn/customdrawnwsfactory.pas svneol=native#text/plain
|
||||
lcl/interfaces/customdrawn/customdrawnwsforms.pp svneol=native#text/plain
|
||||
lcl/interfaces/customdrawn/interfaces.pas svneol=native#text/plain
|
||||
lcl/interfaces/customdrawn/wincallback.inc svneol=native#text/plain
|
||||
lcl/interfaces/customdrawn/winproc.pas svneol=native#text/plain
|
||||
|
||||
@ -17,16 +17,16 @@ uses
|
||||
//win32wspairsplitter,
|
||||
{ win32themes,
|
||||
win32wsmenus,
|
||||
win32debug,
|
||||
win32wscontrols,
|
||||
win32wsfactory,
|
||||
win32wsextctrls,
|
||||
win32debug,}
|
||||
customdrawnwscontrols,
|
||||
customdrawnwsfactory,
|
||||
{win32wsextctrls,
|
||||
win32wscomctrls,
|
||||
win32wsgrids,
|
||||
win32wsimglist,}
|
||||
customdrawnint
|
||||
customdrawnint,
|
||||
{win32wsspin,
|
||||
win32wsbuttons,
|
||||
win32wsforms};
|
||||
win32wsbuttons,}
|
||||
customdrawnwsforms;
|
||||
implementation
|
||||
end.
|
||||
|
||||
@ -118,7 +118,7 @@ function WindowProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam;
|
||||
implementation
|
||||
|
||||
uses
|
||||
WsControls, lclintf, menus,
|
||||
WsControls, lclintf,
|
||||
{ Win32WSFactory,
|
||||
Win32WSButtons,
|
||||
Win32WSMenus,
|
||||
|
||||
700
lcl/interfaces/customdrawn/customdrawnwscontrols.pp
Normal file
700
lcl/interfaces/customdrawn/customdrawnwscontrols.pp
Normal file
@ -0,0 +1,700 @@
|
||||
{
|
||||
*****************************************************************************
|
||||
* CustomDrawnWSControls.pp *
|
||||
* --------------- *
|
||||
* *
|
||||
* *
|
||||
*****************************************************************************
|
||||
|
||||
*****************************************************************************
|
||||
* *
|
||||
* This file is part of the Lazarus Component Library (LCL) *
|
||||
* *
|
||||
* See the file COPYING.modifiedLGPL.txt, included in this distribution, *
|
||||
* for details about the copyright. *
|
||||
* *
|
||||
* This program is distributed in the hope that it will be useful, *
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
|
||||
* *
|
||||
*****************************************************************************
|
||||
}
|
||||
unit CustomDrawnWSControls;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
// LCL
|
||||
SysUtils, Classes, Types, Controls, LCLType, LCLProc, Forms, Graphics,
|
||||
// Widgetset
|
||||
InterfaceBase, WSProc, WSControls, WSLCLClasses;
|
||||
|
||||
type
|
||||
|
||||
{ TCDWSDragImageList }
|
||||
|
||||
TCDWSDragImageList = class(TWSDragImageList)
|
||||
published
|
||||
{ class function BeginDrag(const ADragImageList: TDragImageList; Window: HWND; AIndex, X, Y: Integer): Boolean; override;
|
||||
class function DragMove(const ADragImageList: TDragImageList; X, Y: Integer): Boolean; override;
|
||||
class procedure EndDrag(const ADragImageList: TDragImageList); override;
|
||||
class function HideDragImage(const ADragImageList: TDragImageList;
|
||||
ALockedWindow: HWND; DoUnLock: Boolean): Boolean; override;
|
||||
class function ShowDragImage(const ADragImageList: TDragImageList;
|
||||
ALockedWindow: HWND; X, Y: Integer; DoLock: Boolean): Boolean; override;}
|
||||
end;
|
||||
|
||||
{ TCDWSControl }
|
||||
|
||||
TCDWSControl = class(TWSControl)
|
||||
published
|
||||
end;
|
||||
|
||||
{ TCDWSWinControl }
|
||||
|
||||
TCDWSWinControl = class(TWSWinControl)
|
||||
published
|
||||
{ class function CanFocus(const AWinControl: TWinControl): Boolean; override;
|
||||
class function CreateHandle(const AWinControl: TWinControl;
|
||||
const AParams: TCreateParams): TLCLIntfHandle; override;
|
||||
class procedure DestroyHandle(const AWinControl: TWinControl); override;
|
||||
class procedure Invalidate(const AWinControl: TWinControl); override;
|
||||
class procedure AddControl(const AControl: TControl); override;
|
||||
class function GetClientBounds(const AWincontrol: TWinControl; var ARect: TRect): Boolean; override;
|
||||
class function GetClientRect(const AWincontrol: TWinControl; var ARect: TRect): Boolean; override;
|
||||
class function GetDesignInteractive(const AWinControl: TWinControl; AClientPos: TPoint): Boolean; override;
|
||||
|
||||
class procedure SetBiDiMode(const AWinControl: TWinControl; UseRightToLeftAlign, UseRightToLeftReading, UseRightToLeftScrollBar : Boolean); override;
|
||||
class procedure SetBounds(const AWinControl: TWinControl; const ALeft, ATop, AWidth, AHeight: Integer); override;
|
||||
class procedure SetBorderStyle(const AWinControl: TWinControl; const ABorderStyle: TBorderStyle); override;
|
||||
class procedure SetPos(const AWinControl: TWinControl; const ALeft, ATop: Integer); override;
|
||||
class procedure SetSize(const AWinControl: TWinControl; const AWidth, AHeight: Integer); override;
|
||||
class procedure ShowHide(const AWinControl: TWinControl); override; //TODO: rename to SetVisible(control, visible)
|
||||
class procedure SetColor(const AWinControl: TWinControl); override;
|
||||
class procedure SetCursor(const AWinControl: TWinControl; const ACursor: HCURSOR); override;
|
||||
class procedure SetFont(const AWinControl: TWinControl; const AFont: TFont); override;
|
||||
class procedure SetShape(const AWinControl: TWinControl; const AShape: HBITMAP); override;
|
||||
|
||||
class procedure GetPreferredSize(const AWinControl: TWinControl;
|
||||
var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); override;
|
||||
|
||||
class function GetText(const AWinControl: TWinControl; var AText: String): Boolean; override;
|
||||
class procedure SetText(const AWinControl: TWinControl; const AText: string); override;
|
||||
|
||||
class procedure SetChildZPosition(const AWinControl, AChild: TWinControl;
|
||||
const AOldPos, ANewPos: Integer;
|
||||
const AChildren: TFPList); override;
|
||||
|
||||
class procedure ConstraintsChange(const AWinControl: TWinControl); override;
|
||||
class procedure PaintTo(const AWinControl: TWinControl; ADC: HDC; X, Y: Integer); override;}
|
||||
end;
|
||||
|
||||
{ TCDWSGraphicControl }
|
||||
|
||||
TCDWSGraphicControl = class(TWSGraphicControl)
|
||||
published
|
||||
end;
|
||||
|
||||
{ TCDWSCustomControl }
|
||||
|
||||
TCDWSCustomControl = class(TWSCustomControl)
|
||||
published
|
||||
// class function CreateHandle(const AWinControl: TWinControl;
|
||||
// const AParams: TCreateParams): TLCLIntfHandle; override;
|
||||
end;
|
||||
|
||||
{ TCDWSImageList }
|
||||
|
||||
TCDWSImageList = class(TWSImageList)
|
||||
published
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
(*{------------------------------------------------------------------------------
|
||||
Method: TCDWSCustomControl.CreateHandle
|
||||
Params: None
|
||||
Returns: Nothing
|
||||
------------------------------------------------------------------------------}
|
||||
class function TCDWSCustomControl.CreateHandle(const AWinControl: TWinControl;
|
||||
const AParams: TCreateParams): TLCLIntfHandle;
|
||||
var
|
||||
CDCustomControl: TCDCustomControl;
|
||||
begin
|
||||
{$ifdef VerboseCD}
|
||||
WriteLn('> TCDWSCustomControl.CreateHandle for ',dbgsname(AWinControl));
|
||||
{$endif}
|
||||
|
||||
CDCustomControl := TCDCustomControl.Create(AWinControl, AParams);
|
||||
CDCustomControl.setFrameShape(TBorderStyleToCDFrameShapeMap[TCustomControl(AWinControl).BorderStyle]);
|
||||
CDCustomControl.viewportNeeded;
|
||||
CDCustomControl.AttachEvents;
|
||||
Result := TLCLIntfHandle(CDCustomControl);
|
||||
|
||||
{$ifdef VerboseCD}
|
||||
WriteLn('< TCDWSCustomControl.CreateHandle for ',dbgsname(AWinControl),' Result: ', dbgHex(Result));
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Function: TCDWSWinControl.CanFocus
|
||||
Params: TWinControl
|
||||
Returns: Boolean
|
||||
------------------------------------------------------------------------------}
|
||||
class function TCDWSWinControl.CanFocus(const AWinControl: TWinControl): Boolean;
|
||||
var
|
||||
Widget: TCDWidget;
|
||||
begin
|
||||
if AWinControl.HandleAllocated then
|
||||
begin
|
||||
Widget := TCDWidget(AWinControl.Handle);
|
||||
Result := (Widget.getFocusPolicy <> CDNoFocus);
|
||||
end else
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCDWSWinControl.CreateHandle
|
||||
Params: None
|
||||
Returns: Nothing
|
||||
------------------------------------------------------------------------------}
|
||||
class function TCDWSWinControl.CreateHandle(const AWinControl: TWinControl;
|
||||
const AParams: TCreateParams): TLCLIntfHandle;
|
||||
var
|
||||
CDWidget: TCDWidget;
|
||||
begin
|
||||
|
||||
{$ifdef VerboseCD}
|
||||
WriteLn('> TCDWSWinControl.CreateHandle for ',dbgsname(AWinControl));
|
||||
{$endif}
|
||||
CDWidget := TCDWidget.Create(AWinControl, AParams);
|
||||
|
||||
CDWidget.AttachEvents;
|
||||
|
||||
// Finalization
|
||||
|
||||
Result := TLCLIntfHandle(CDWidget);
|
||||
|
||||
{$ifdef VerboseCD}
|
||||
WriteLn('< TCDWSWinControl.CreateHandle for ',dbgsname(AWinControl),' Result: ', dbgHex(Result));
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCDWSWinControl.DestroyHandle
|
||||
Params: None
|
||||
Returns: Nothing
|
||||
------------------------------------------------------------------------------}
|
||||
class procedure TCDWSWinControl.DestroyHandle(const AWinControl: TWinControl);
|
||||
begin
|
||||
TCDWidget(AWinControl.Handle).Release;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCDWSWinControl.Invalidate
|
||||
Params: None
|
||||
Returns: Nothing
|
||||
------------------------------------------------------------------------------}
|
||||
class procedure TCDWSWinControl.Invalidate(const AWinControl: TWinControl);
|
||||
begin
|
||||
if not WSCheckHandleAllocated(AWinControl, 'Invalidate') then
|
||||
Exit;
|
||||
|
||||
TCDWidget(AWinControl.Handle).Update;
|
||||
end;
|
||||
|
||||
class procedure TCDWSWinControl.AddControl(const AControl: TControl);
|
||||
var
|
||||
Child: TCDWidget;
|
||||
Parent: TCDWidget;
|
||||
begin
|
||||
if (AControl is TWinControl) and (TWinControl(AControl).HandleAllocated) then
|
||||
begin
|
||||
Child := TCDWidget(TWinControl(AControl).Handle);
|
||||
Parent := TCDWidget(AControl.Parent.Handle);
|
||||
if Child.getParent <> Parent.GetContainerWidget then
|
||||
begin
|
||||
Child.BeginUpdate;
|
||||
Child.setParent(Parent.GetContainerWidget);
|
||||
Child.EndUpdate;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TCDWSWinControl.GetClientBounds(const AWincontrol: TWinControl;
|
||||
var ARect: TRect): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
if not WSCheckHandleAllocated(AWinControl, 'GetClientBounds') then
|
||||
Exit;
|
||||
|
||||
ARect := TCDWidget(AWinControl.Handle).getClientBounds;
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
class function TCDWSWinControl.GetClientRect(const AWincontrol: TWinControl;
|
||||
var ARect: TRect): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
if not WSCheckHandleAllocated(AWinControl, 'GetClientRect') then
|
||||
Exit;
|
||||
|
||||
ARect := TCDWidget(AWinControl.Handle).getClientBounds;
|
||||
OffsetRect(ARect, -ARect.Left, -ARect.Top);
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
class function TCDWSWinControl.GetDesignInteractive(
|
||||
const AWinControl: TWinControl; AClientPos: TPoint): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
if not WSCheckHandleAllocated(AWinControl, 'GetDesignInteractive') then
|
||||
Exit;
|
||||
end;
|
||||
|
||||
class procedure TCDWSWinControl.SetBiDiMode(const AWinControl : TWinControl;
|
||||
UseRightToLeftAlign, UseRightToLeftReading, UseRightToLeftScrollBar : Boolean
|
||||
);
|
||||
begin
|
||||
if not WSCheckHandleAllocated(AWinControl, 'SetBiDiMode') then
|
||||
Exit;
|
||||
|
||||
TCDWidget(AWinControl.Handle).setLayoutDirection(TLayoutDirectionMap[UseRightToLeftAlign]);
|
||||
end;
|
||||
|
||||
class procedure TCDWSWinControl.GetPreferredSize(const AWinControl: TWinControl;
|
||||
var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean);
|
||||
begin
|
||||
if AWinControl.HandleAllocated then
|
||||
TCDWidget(AWinControl.Handle).PreferredSize(PreferredWidth,
|
||||
PreferredHeight, WithThemeSpace);
|
||||
end;
|
||||
|
||||
class function TCDWSWinControl.GetText(const AWinControl: TWinControl;
|
||||
var AText: String): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
if not WSCheckHandleAllocated(AWincontrol, 'GetText') then
|
||||
Exit;
|
||||
|
||||
Result := not TCDWidget(AWinControl.Handle).getTextStatic;
|
||||
if Result then
|
||||
AText := UTF16ToUTF8(TCDWidget(AWinControl.Handle).getText);
|
||||
end;
|
||||
|
||||
class procedure TCDWSWinControl.SetText(const AWinControl: TWinControl;
|
||||
const AText: string);
|
||||
begin
|
||||
if not WSCheckHandleAllocated(AWincontrol, 'SetText') then
|
||||
Exit;
|
||||
TCDWidget(AWinControl.Handle).BeginUpdate;
|
||||
TCDWidget(AWinControl.Handle).setText(GetUtf8String(AText));
|
||||
TCDWidget(AWinControl.Handle).EndUpdate;
|
||||
end;
|
||||
|
||||
class procedure TCDWSWinControl.SetChildZPosition(const AWinControl,
|
||||
AChild: TWinControl; const AOldPos, ANewPos: Integer; const AChildren: TFPList);
|
||||
var
|
||||
n: Integer;
|
||||
Child: TWinControl;
|
||||
Reorder: TFPList;
|
||||
begin
|
||||
if not WSCheckHandleAllocated(AWincontrol, 'SetChildZPosition') then
|
||||
Exit;
|
||||
if not WSCheckHandleAllocated(AChild, 'SetChildZPosition (child)') then
|
||||
Exit;
|
||||
|
||||
if (ANewPos <= 0) or (ANewPos >= AChildren.Count - 1) then
|
||||
begin
|
||||
// simple
|
||||
if ANewPos <= 0 then // bottom
|
||||
TCDWidget(AChild.Handle).lowerWidget
|
||||
else
|
||||
TCDWidget(AChild.Handle).raiseWidget;
|
||||
end else
|
||||
begin
|
||||
if (ANewPos >= 0) and (ANewPos < AChildren.Count -1) then
|
||||
begin
|
||||
Reorder := TFPList.Create;
|
||||
for n := AChildren.Count - 1 downto 0 do
|
||||
Reorder.Add(AChildren[n]);
|
||||
Child := TWinControl(Reorder[ANewPos + 1]);
|
||||
if Child.HandleAllocated then
|
||||
TCDWidget(AChild.Handle).stackUnder(TCDWidget(Child.Handle).Widget)
|
||||
else
|
||||
TCDWidget(AChild.Handle).lowerWidget;
|
||||
Reorder.Free;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
class procedure TCDWSWinControl.ConstraintsChange(const AWinControl: TWinControl);
|
||||
const
|
||||
CDMaxContraint = $FFFFFF;
|
||||
var
|
||||
Widget: TCDWidget;
|
||||
MaxW, MaxH: Integer;
|
||||
begin
|
||||
if not WSCheckHandleAllocated(AWincontrol, 'ConstraintsChange') then
|
||||
Exit;
|
||||
|
||||
Widget := TCDWidget(AWinControl.Handle);
|
||||
with AWinControl do
|
||||
begin
|
||||
Widget.setMinimumSize(Constraints.MinWidth, Constraints.MinHeight);
|
||||
if Constraints.MaxWidth = 0 then
|
||||
MaxW := CDMaxContraint
|
||||
else
|
||||
MaxW := Constraints.MaxWidth;
|
||||
if Constraints.MaxHeight = 0 then
|
||||
MaxH := CDMaxContraint
|
||||
else
|
||||
MaxH := Constraints.MaxHeight;
|
||||
Widget.setMaximumSize(MaxW, MaxH);
|
||||
end;
|
||||
end;
|
||||
|
||||
class procedure TCDWSWinControl.PaintTo(const AWinControl: TWinControl;
|
||||
ADC: HDC; X, Y: Integer);
|
||||
var
|
||||
Context: TCDDeviceContext absolute ADC;
|
||||
Widget: TCDWidget;
|
||||
Pixmap: TCDPixmap;
|
||||
DCSize: TSize;
|
||||
APoint: TCDPoint;
|
||||
ARect, GRect: TRect;
|
||||
begin
|
||||
if not WSCheckHandleAllocated(AWincontrol, 'PaintTo') or (ADC = 0) then
|
||||
Exit;
|
||||
|
||||
Widget := TCDWidget(AWinControl.Handle);
|
||||
ARect := Widget.getFrameGeometry;
|
||||
GRect := Widget.getGeometry;
|
||||
with DCSize, ARect do
|
||||
begin
|
||||
cx := Right - Left;
|
||||
cy := Bottom - Top;
|
||||
end;
|
||||
Pixmap := TCDPixmap.Create(@DCSize);
|
||||
OffsetRect(GRect, -ARect.Left, -ARect.Top);
|
||||
Pixmap.grabWidget(Widget.Widget, 0, 0);
|
||||
APoint := CDPoint(X + GRect.Left, Y + GRect.Top);
|
||||
ARect := Rect(0, 0, Pixmap.getWidth, Pixmap.getHeight);
|
||||
Context.drawPixmap(@APoint, Pixmap.Handle, @ARect);
|
||||
Pixmap.Free;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCDWSWinControl.SetBounds
|
||||
Params: AWinControl - the calling object
|
||||
ALeft, ATop - Position
|
||||
AWidth, AHeight - Size
|
||||
Returns: Nothing
|
||||
|
||||
Sets the position and size of a widget
|
||||
------------------------------------------------------------------------------}
|
||||
class procedure TCDWSWinControl.SetBounds(const AWinControl: TWinControl;
|
||||
const ALeft, ATop, AWidth, AHeight: Integer);
|
||||
var
|
||||
R: TRect;
|
||||
Box: TCDWidget;
|
||||
begin
|
||||
if not WSCheckHandleAllocated(AWincontrol, 'SetBounds') then
|
||||
Exit;
|
||||
R := Rect(ALeft, ATop, AWidth, AHeight);
|
||||
|
||||
Box := nil;
|
||||
if Assigned(AWinControl.Parent) and
|
||||
AWinControl.Parent.HandleAllocated then
|
||||
Box := TCDWidget(AWinControl.Parent.Handle);
|
||||
|
||||
if Assigned(Box) and
|
||||
(Box.ChildOfComplexWidget = ccwScrollingWinControl) then
|
||||
begin
|
||||
R := Rect(ALeft - TCDCustomControl(Box).horizontalScrollBar.getValue,
|
||||
ATop - TCDCustomControl(Box).verticalScrollBar.getValue, AWidth, AHeight);
|
||||
end;
|
||||
|
||||
TCDWidget(AWinControl.Handle).BeginUpdate;
|
||||
with R do
|
||||
begin
|
||||
TCDWidget(AWinControl.Handle).move(Left, Top);
|
||||
TCDWidget(AWinControl.Handle).resize(Right, Bottom);
|
||||
end;
|
||||
TCDWidget(AWinControl.Handle).EndUpdate;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCDWSWinControl.SetPos
|
||||
Params: AWinControl - the calling object
|
||||
ALeft, ATop - Position
|
||||
Returns: Nothing
|
||||
|
||||
Sets the position of a widget
|
||||
------------------------------------------------------------------------------}
|
||||
class procedure TCDWSWinControl.SetPos(const AWinControl: TWinControl;
|
||||
const ALeft, ATop: Integer);
|
||||
begin
|
||||
if not WSCheckHandleAllocated(AWincontrol, 'SetPos') then
|
||||
Exit;
|
||||
|
||||
TCDWidget(AWinControl.Handle).BeginUpdate;
|
||||
TCDWidget(AWinControl.Handle).move(ALeft, ATop);
|
||||
TCDWidget(AWinControl.Handle).EndUpdate;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCDWSWinControl.SetSize
|
||||
Params: AWinControl - the calling object
|
||||
AWidth, AHeight - Size
|
||||
Returns: Nothing
|
||||
|
||||
Sets the size of a widget
|
||||
------------------------------------------------------------------------------}
|
||||
class procedure TCDWSWinControl.SetSize(const AWinControl: TWinControl;
|
||||
const AWidth, AHeight: Integer);
|
||||
begin
|
||||
if not WSCheckHandleAllocated(AWincontrol, 'SetSize') then
|
||||
Exit;
|
||||
TCDWidget(AWinControl.Handle).BeginUpdate;
|
||||
TCDWidget(AWinControl.Handle).resize(AWidth, AHeight);
|
||||
TCDWidget(AWinControl.Handle).EndUpdate;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCDWSWinControl.ShowHide
|
||||
Params: AWinControl - the calling object
|
||||
|
||||
Returns: Nothing
|
||||
|
||||
Shows or hides a widget.
|
||||
------------------------------------------------------------------------------}
|
||||
class procedure TCDWSWinControl.ShowHide(const AWinControl: TWinControl);
|
||||
var
|
||||
Widget: TCDWidget;
|
||||
begin
|
||||
if not WSCheckHandleAllocated(AWincontrol, 'ShowHide') then
|
||||
Exit;
|
||||
|
||||
Widget := TCDWidget(AWinControl.Handle);
|
||||
|
||||
Widget.BeginUpdate;
|
||||
Widget.setVisible(AWinControl.HandleObjectShouldBeVisible);
|
||||
Widget.EndUpdate;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCDWSWinControl.SetColor
|
||||
Params: AWinControl - the calling object
|
||||
Returns: Nothing
|
||||
|
||||
Sets the color of the widget.
|
||||
------------------------------------------------------------------------------}
|
||||
class procedure TCDWSWinControl.SetColor(const AWinControl: TWinControl);
|
||||
var
|
||||
QColor: TQColor;
|
||||
ColorRef: TColorRef;
|
||||
CDWidget: TCDWidget;
|
||||
begin
|
||||
if not WSCheckHandleAllocated(AWinControl, 'SetColor') then
|
||||
Exit;
|
||||
|
||||
CDWidget := TCDWidget(AWinControl.Handle);
|
||||
CDWidget.BeginUpdate;
|
||||
CDWidget.WidgetState := CDWidget.WidgetState + [CDwsColorUpdating];
|
||||
try
|
||||
// Get the color numeric value (system colors are mapped to numeric colors depending on the widget style)
|
||||
if AWinControl.Color = clDefault then
|
||||
CDWidget.SetDefaultColor(dctBrush)
|
||||
else
|
||||
begin
|
||||
ColorRef := ColorToRGB(AWinControl.Color);
|
||||
|
||||
// Fill QColor
|
||||
QColor_fromRgb(@QColor,Red(ColorRef),Green(ColorRef),Blue(ColorRef));
|
||||
|
||||
// Set color of the widget to QColor
|
||||
CDWidget.SetColor(@QColor);
|
||||
end;
|
||||
finally
|
||||
CDWidget.WidgetState := CDWidget.WidgetState - [CDwsColorUpdating];
|
||||
CDWidget.EndUpdate;
|
||||
end;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCDWSWinControl.SetCursor
|
||||
Params: AWinControl - the calling object
|
||||
Returns: Nothing
|
||||
|
||||
Sets the cursor of the widget.
|
||||
------------------------------------------------------------------------------}
|
||||
class procedure TCDWSWinControl.SetCursor(const AWinControl: TWinControl; const ACursor: HCURSOR);
|
||||
begin
|
||||
if not WSCheckHandleAllocated(AWinControl, 'SetCursor') then
|
||||
Exit;
|
||||
if ACursor <> 0 then
|
||||
TCDWidget(AWinControl.Handle).SetCursor(TCDCursor(ACursor).Handle)
|
||||
else
|
||||
TCDWidget(AWinControl.Handle).SetCursor(nil);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCDWSWinControl.SetFont
|
||||
Params: AWinControl - the calling object, AFont - object font
|
||||
Returns: Nothing
|
||||
|
||||
Sets the font of the widget.
|
||||
------------------------------------------------------------------------------}
|
||||
class procedure TCDWSWinControl.SetFont(const AWinControl: TWinControl; const AFont: TFont);
|
||||
var
|
||||
CDWidget: TCDWidget;
|
||||
QColor: TQColor;
|
||||
ColorRef: TColorRef;
|
||||
begin
|
||||
if not WSCheckHandleAllocated(AWinControl, 'SetFont') then
|
||||
Exit;
|
||||
|
||||
CDWidget := TCDWidget(AWinControl.Handle);
|
||||
CDWidget.BeginUpdate;
|
||||
CDWidget.WidgetState := CDWidget.WidgetState + [CDwsFontUpdating];
|
||||
try
|
||||
CDWidget.SetLCLFont(TCDFont(AFont.Reference.Handle));
|
||||
CDWidget.setFont(TCDFont(AFont.Reference.Handle).FHandle);
|
||||
|
||||
// tscrollbar, ttrackbar etc.
|
||||
if not CDWidget.CanChangeFontColor then
|
||||
begin
|
||||
with CDWidget do
|
||||
begin
|
||||
Palette.ForceColor := True;
|
||||
setDefaultColor(dctFont);
|
||||
Palette.ForceColor := False;
|
||||
end;
|
||||
exit;
|
||||
end;
|
||||
|
||||
if AFont.Color = clDefault then
|
||||
CDWidget.SetDefaultColor(dctFont)
|
||||
else
|
||||
begin
|
||||
ColorRef := ColorToRGB(AFont.Color);
|
||||
QColor_fromRgb(@QColor,Red(ColorRef),Green(ColorRef),Blue(ColorRef));
|
||||
CDWidget.SetTextColor(@QColor);
|
||||
end;
|
||||
finally
|
||||
CDWidget.WidgetState := CDWidget.WidgetState - [CDwsFontUpdating];
|
||||
CDWidget.EndUpdate;
|
||||
end;
|
||||
end;
|
||||
|
||||
class procedure TCDWSWinControl.SetShape(const AWinControl: TWinControl;
|
||||
const AShape: HBITMAP);
|
||||
var
|
||||
Widget: TCDWidget;
|
||||
Shape: TCDImage;
|
||||
AMask: QBitmapH;
|
||||
begin
|
||||
if not WSCheckHandleAllocated(AWinControl, 'SetShape') then
|
||||
Exit;
|
||||
Widget := TCDWidget(AWinControl.Handle);
|
||||
|
||||
if AShape <> 0 then
|
||||
begin
|
||||
Shape := TCDImage(AShape);
|
||||
// invert white/black
|
||||
Shape.invertPixels;
|
||||
AMask := Shape.AsBitmap;
|
||||
Widget.setMask(AMask);
|
||||
QBitmap_destroy(AMask);
|
||||
// invert back
|
||||
Shape.invertPixels;
|
||||
end
|
||||
else
|
||||
Widget.clearMask;
|
||||
end;
|
||||
|
||||
class procedure TCDWSWinControl.SetBorderStyle(const AWinControl: TWinControl;
|
||||
const ABorderStyle: TBorderStyle);
|
||||
var
|
||||
Widget: TCDWidget;
|
||||
CDEdit: ICDEdit;
|
||||
begin
|
||||
if not WSCheckHandleAllocated(AWinControl, 'SetBorderStyle') then
|
||||
Exit;
|
||||
|
||||
Widget := TCDWidget(AWinControl.Handle);
|
||||
CDEdit := nil;
|
||||
if Widget is TCDFrame then
|
||||
TCDFrame(Widget).setFrameShape(TBorderStyleToCDFrameShapeMap[ABorderStyle])
|
||||
else
|
||||
if Supports(Widget, ICDEdit, CDEdit) then
|
||||
CDEdit.setBorder(ABorderStyle = bsSingle);
|
||||
end;
|
||||
|
||||
{ TCDWSDragImageList }
|
||||
|
||||
class function TCDWSDragImageList.BeginDrag(
|
||||
const ADragImageList: TDragImageList; Window: HWND; AIndex, X, Y: Integer): Boolean;
|
||||
var
|
||||
ABitmap: TBitmap;
|
||||
begin
|
||||
ABitmap := TBitmap.Create;
|
||||
ADragImageList.GetBitmap(AIndex, ABitmap);
|
||||
|
||||
if (ABitmap.Handle = 0) or (ABitmap.Width = 0) or (ABitmap.Height = 0) then
|
||||
begin
|
||||
Result := False;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
Result := TCDWidgetset(Widgetset).DragImageList_BeginDrag(
|
||||
TCDImage(ABitmap.Handle).FHandle, ADragImageList.DragHotSpot);
|
||||
if Result then
|
||||
TCDWidgetset(Widgetset).DragImageList_DragMove(X, Y);
|
||||
ABitmap.Free;
|
||||
end;
|
||||
|
||||
class function TCDWSDragImageList.DragMove(
|
||||
const ADragImageList: TDragImageList; X, Y: Integer): Boolean;
|
||||
begin
|
||||
Result := TCDWidgetset(Widgetset).DragImageList_DragMove(X, Y);
|
||||
end;
|
||||
|
||||
class procedure TCDWSDragImageList.EndDrag(const ADragImageList: TDragImageList);
|
||||
begin
|
||||
TCDWidgetset(Widgetset).DragImageList_EndDrag;
|
||||
end;
|
||||
|
||||
class function TCDWSDragImageList.HideDragImage(
|
||||
const ADragImageList: TDragImageList; ALockedWindow: HWND; DoUnLock: Boolean
|
||||
): Boolean;
|
||||
begin
|
||||
Result := True;
|
||||
if DoUnlock then
|
||||
begin
|
||||
TCDWidgetset(Widgetset).DragImageLock := False;
|
||||
Result := TCDWidgetset(Widgetset).DragImageList_SetVisible(False);
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TCDWSDragImageList.ShowDragImage(
|
||||
const ADragImageList: TDragImageList; ALockedWindow: HWND; X, Y: Integer;
|
||||
DoLock: Boolean): Boolean;
|
||||
begin
|
||||
Result := TCDWidgetset(Widgetset).DragImageLock;
|
||||
if not DoLock then
|
||||
begin
|
||||
if not Result then
|
||||
Result := TCDWidgetset(Widgetset).DragImageList_SetVisible(True);
|
||||
end else
|
||||
begin
|
||||
TCDWidgetset(Widgetset).DragImageLock := True;
|
||||
Result := TCDWidgetset(Widgetset).DragImageList_DragMove(X, Y) and
|
||||
TCDWidgetset(Widgetset).DragImageList_SetVisible(True);
|
||||
end;
|
||||
end;*)
|
||||
|
||||
end.
|
||||
545
lcl/interfaces/customdrawn/customdrawnwsfactory.pas
Normal file
545
lcl/interfaces/customdrawn/customdrawnwsfactory.pas
Normal file
@ -0,0 +1,545 @@
|
||||
unit CustomDrawnWSFactory;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
uses
|
||||
Classes, Controls, ComCtrls, ImgList, Calendar, StdCtrls, Arrow, Spin,
|
||||
Dialogs, ExtCtrls, Buttons, CheckLst, Forms, Menus, Grids,
|
||||
WSLCLClasses;
|
||||
|
||||
// imglist
|
||||
function RegisterCustomImageList: Boolean;
|
||||
// controls
|
||||
function RegisterDragImageList: Boolean;
|
||||
function RegisterControl: Boolean;
|
||||
function RegisterWinControl: Boolean;
|
||||
function RegisterGraphicControl: Boolean;
|
||||
function RegisterCustomControl: Boolean;
|
||||
// comctrls
|
||||
function RegisterStatusBar: Boolean;
|
||||
function RegisterTabSheet: Boolean;
|
||||
function RegisterPageControl: Boolean;
|
||||
function RegisterCustomListView: Boolean;
|
||||
function RegisterCustomProgressBar: Boolean;
|
||||
function RegisterCustomUpDown: Boolean;
|
||||
function RegisterCustomToolButton: Boolean;
|
||||
function RegisterToolBar: Boolean;
|
||||
function RegisterCustomTrackBar: Boolean;
|
||||
function RegisterCustomTreeView: Boolean;
|
||||
// calendar
|
||||
function RegisterCustomCalendar: Boolean;
|
||||
// dialogs
|
||||
function RegisterCommonDialog: Boolean;
|
||||
function RegisterFileDialog: Boolean;
|
||||
function RegisterOpenDialog: Boolean;
|
||||
function RegisterSaveDialog: Boolean;
|
||||
function RegisterSelectDirectoryDialog: Boolean;
|
||||
function RegisterColorDialog: Boolean;
|
||||
function RegisterColorButton: Boolean;
|
||||
function RegisterFontDialog: Boolean;
|
||||
// StdCtrls
|
||||
function RegisterCustomScrollBar: Boolean;
|
||||
function RegisterCustomGroupBox: Boolean;
|
||||
function RegisterCustomComboBox: Boolean;
|
||||
function RegisterCustomListBox: Boolean;
|
||||
function RegisterCustomEdit: Boolean;
|
||||
function RegisterCustomMemo: Boolean;
|
||||
function RegisterButtonControl: Boolean;
|
||||
function RegisterCustomButton: Boolean;
|
||||
function RegisterCustomCheckBox: Boolean;
|
||||
function RegisterToggleBox: Boolean;
|
||||
function RegisterRadioButton: Boolean;
|
||||
function RegisterCustomStaticText: Boolean;
|
||||
function RegisterCustomLabel: Boolean;
|
||||
// extctrls
|
||||
function RegisterCustomPage: Boolean;
|
||||
function RegisterCustomNotebook: Boolean;
|
||||
function RegisterShape: Boolean;
|
||||
function RegisterCustomSplitter: Boolean;
|
||||
function RegisterPaintBox: Boolean;
|
||||
function RegisterCustomImage: Boolean;
|
||||
function RegisterBevel: Boolean;
|
||||
function RegisterCustomRadioGroup: Boolean;
|
||||
function RegisterCustomCheckGroup: Boolean;
|
||||
function RegisterCustomLabeledEdit: Boolean;
|
||||
function RegisterCustomPanel: Boolean;
|
||||
function RegisterCustomTrayIcon: Boolean;
|
||||
//ExtDlgs
|
||||
function RegisterPreviewFileControl: Boolean;
|
||||
function RegisterPreviewFileDialog: Boolean;
|
||||
function RegisterOpenPictureDialog: Boolean;
|
||||
function RegisterSavePictureDialog: Boolean;
|
||||
function RegisterCalculatorDialog: Boolean;
|
||||
function RegisterCalculatorForm: Boolean;
|
||||
function RegisterCalendarDialog: Boolean;
|
||||
// Buttons
|
||||
function RegisterCustomBitBtn: Boolean;
|
||||
function RegisterCustomSpeedButton: Boolean;
|
||||
// Arrow
|
||||
function RegisterArrow: Boolean;
|
||||
// CheckLst
|
||||
function RegisterCustomCheckListBox: Boolean;
|
||||
// Forms
|
||||
function RegisterScrollingWinControl: Boolean;
|
||||
function RegisterScrollBox: Boolean;
|
||||
function RegisterCustomFrame: Boolean;
|
||||
function RegisterCustomForm: Boolean;
|
||||
function RegisterHintWindow: Boolean;
|
||||
function RegisterCustomGrid: Boolean;
|
||||
function RegisterMenuItem: Boolean;
|
||||
function RegisterMenu: Boolean;
|
||||
function RegisterMainMenu: Boolean;
|
||||
function RegisterPopupMenu: Boolean;
|
||||
function RegisterPairSplitterSide: Boolean;
|
||||
function RegisterCustomPairSplitter: Boolean;
|
||||
function RegisterCustomFloatSpinEdit: Boolean;
|
||||
function RegisterCustomRubberBand: Boolean;
|
||||
|
||||
implementation
|
||||
uses
|
||||
{ WinCEWSArrow,
|
||||
WinCEWSButtons,
|
||||
WinCEWSCalendar,
|
||||
WinCEWSCheckLst,
|
||||
WinCEWSComCtrls,}
|
||||
CustomDrawnWSControls,
|
||||
{ WinCEWSDialogs,
|
||||
WinCEWSExtCtrls,}
|
||||
CustomDrawnWSForms{,
|
||||
WinCEWSImgList,
|
||||
WinCEWSMenus,
|
||||
WinCEWSSpin,
|
||||
WinCEWSStdCtrls,
|
||||
WinCEWSGrids};
|
||||
|
||||
// imglist
|
||||
function RegisterCustomImageList: Boolean; alias : 'WSRegisterCustomImageList';
|
||||
begin
|
||||
// RegisterWSComponent(TCustomImageList, TWinCEWSCustomImageList);
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
// controls
|
||||
function RegisterDragImageList: Boolean; alias : 'WSRegisterDragImageList';
|
||||
begin
|
||||
// RegisterWSComponent(TDragImageList, TWinCEWSDragImageList);
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterControl: Boolean; alias : 'WSRegisterControl';
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterWinControl: Boolean; alias : 'WSRegisterWinControl';
|
||||
begin
|
||||
RegisterWSComponent(TWinControl, TCDWSWinControl);
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
function RegisterGraphicControl: Boolean; alias : 'WSRegisterGraphicControl';
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterCustomControl: Boolean; alias : 'WSRegisterCustomControl';
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
// comctrls
|
||||
function RegisterStatusBar: Boolean; alias : 'WSRegisterStatusBar';
|
||||
begin
|
||||
// RegisterWSComponent(TStatusBar, TWinCEWSStatusBar);
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterTabSheet: Boolean; alias : 'WSRegisterTabSheet';
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterPageControl: Boolean; alias : 'WSRegisterPageControl';
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterCustomListView: Boolean; alias : 'WSRegisterCustomListView';
|
||||
begin
|
||||
// RegisterWSComponent(TCustomListView, TWinCEWSCustomListView);
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterCustomProgressBar: Boolean; alias : 'WSRegisterCustomProgressBar';
|
||||
begin
|
||||
// RegisterWSComponent(TCustomProgressBar, TWinCEWSProgressBar);
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterCustomUpDown: Boolean; alias : 'WSRegisterCustomUpDown';
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterCustomToolButton: Boolean; alias : 'WSRegisterCustomToolButton';
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterToolBar: Boolean; alias : 'WSRegisterToolBar';
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterCustomTrackBar: Boolean; alias : 'WSRegisterCustomTrackBar';
|
||||
begin
|
||||
// RegisterWSComponent(TCustomTrackBar, TWinCEWSTrackBar);
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterCustomTreeView: Boolean; alias : 'WSRegisterCustomTreeView';
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
// calendar
|
||||
function RegisterCustomCalendar: Boolean; alias : 'WSRegisterCustomCalendar';
|
||||
begin
|
||||
// RegisterWSComponent(TCustomCalendar, TWinCEWSCustomCalendar);
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
// dialogs
|
||||
function RegisterCommonDialog: Boolean; alias : 'WSRegisterCommonDialog';
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterFileDialog: Boolean; alias : 'WSRegisterFileDialog';
|
||||
begin
|
||||
// RegisterWSComponent(TFileDialog, TWinCEWSFileDialog);
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterOpenDialog: Boolean; alias : 'WSRegisterOpenDialog';
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterSaveDialog: Boolean; alias : 'WSRegisterSaveDialog';
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterSelectDirectoryDialog: Boolean; alias : 'WSRegisterSelectDirectoryDialog';
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterColorDialog: Boolean; alias : 'WSRegisterColorDialog';
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterColorButton: Boolean; alias : 'WSRegisterColorButton';
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterFontDialog: Boolean; alias : 'WSRegisterFontDialog';
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
// StdCtrls
|
||||
function RegisterCustomScrollBar: Boolean; alias : 'WSRegisterCustomScrollBar';
|
||||
begin
|
||||
// RegisterWSComponent(TCustomScrollBar, TWinCEWSScrollBar);
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterCustomGroupBox: Boolean; alias : 'WSRegisterCustomGroupBox';
|
||||
begin
|
||||
// RegisterWSComponent(TCustomGroupBox, TWinCEWSCustomGroupBox);
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterCustomComboBox: Boolean; alias : 'WSRegisterCustomComboBox';
|
||||
begin
|
||||
// RegisterWSComponent(TCustomComboBox, TWinCEWSCustomComboBox);
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterCustomListBox: Boolean; alias : 'WSRegisterCustomListBox';
|
||||
begin
|
||||
// RegisterWSComponent(TCustomListBox, TWinCEWSCustomListBox);
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterCustomEdit: Boolean; alias : 'WSRegisterCustomEdit';
|
||||
begin
|
||||
// RegisterWSComponent(TCustomEdit, TWinCEWSCustomEdit);
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterCustomMemo: Boolean; alias : 'WSRegisterCustomMemo';
|
||||
begin
|
||||
// RegisterWSComponent(TCustomMemo, TWinCEWSCustomMemo);
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterButtonControl: Boolean; alias : 'WSRegisterButtonControl';
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterCustomButton: Boolean; alias : 'WSRegisterCustomButton';
|
||||
begin
|
||||
// RegisterWSComponent(TCustomButton, TWinCEWSButton);
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterCustomCheckBox: Boolean; alias : 'WSRegisterCustomCheckBox';
|
||||
begin
|
||||
// RegisterWSComponent(TCustomCheckBox, TWinCEWSCustomCheckBox);
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterToggleBox: Boolean; alias : 'WSRegisterToggleBox';
|
||||
begin
|
||||
// RegisterWSComponent(TToggleBox, TWinCEWSToggleBox);
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterRadioButton: Boolean; alias : 'WSRegisterRadioButton';
|
||||
begin
|
||||
// RegisterWSComponent(TRadioButton, TWinCEWSRadioButton);
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterCustomStaticText: Boolean; alias : 'WSRegisterCustomStaticText';
|
||||
begin
|
||||
// RegisterWSComponent(TCustomStaticText, TWinCEWSCustomStaticText);
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterCustomLabel: Boolean; alias : 'WSRegisterCustomLabel';
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
// extctrls
|
||||
function RegisterCustomPage: Boolean; alias : 'WSRegisterCustomPage';
|
||||
begin
|
||||
// RegisterWSComponent(TCustomPage, TWinCEWSCustomPage);
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterCustomNotebook: Boolean; alias : 'WSRegisterCustomNotebook';
|
||||
begin
|
||||
// RegisterWSComponent(TCustomTabControl, TWinCEWSCustomNotebook);
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterShape: Boolean; alias : 'WSRegisterShape';
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterCustomSplitter: Boolean; alias : 'WSRegisterCustomSplitter';
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterPaintBox: Boolean; alias : 'WSRegisterPaintBox';
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterCustomImage: Boolean; alias : 'WSRegisterCustomImage';
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterBevel: Boolean; alias : 'WSRegisterBevel';
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterCustomRadioGroup: Boolean; alias : 'WSRegisterCustomRadioGroup';
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterCustomCheckGroup: Boolean; alias : 'WSRegisterCustomCheckGroup';
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterCustomLabeledEdit: Boolean; alias : 'WSRegisterCustomLabeledEdit';
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterCustomPanel: Boolean; alias : 'WSRegisterCustomPanel';
|
||||
begin
|
||||
// RegisterWSComponent(TCustomPanel, TWinCEWSCustomPanel);
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterCustomTrayIcon: Boolean; alias : 'WSRegisterCustomTrayIcon';
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
//ExtDlgs
|
||||
function RegisterPreviewFileControl: Boolean; alias : 'WSRegisterPreviewFileControl';
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterPreviewFileDialog: Boolean; alias : 'WSRegisterPreviewFileDialog';
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterOpenPictureDialog: Boolean; alias : 'WSRegisterOpenPictureDialog';
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterSavePictureDialog: Boolean; alias : 'WSRegisterSavePictureDialog';
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterCalculatorDialog: Boolean; alias : 'WSRegisterCalculatorDialog';
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterCalculatorForm: Boolean; alias : 'WSRegisterCalculatorForm';
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
(*function RegisterCalendarDialogForm: Boolean; alias : 'WSRegisterCalendarDialogForm';
|
||||
begin
|
||||
// RegisterWSComponent(TCalendarDialogForm, TWinCEWSCalendarDialogForm);
|
||||
Result := False;
|
||||
end;*)
|
||||
|
||||
function RegisterCalendarDialog: Boolean; alias : 'WSRegisterCalendarDialog';
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
// Buttons
|
||||
function RegisterCustomBitBtn: Boolean; alias : 'WSRegisterCustomBitBtn';
|
||||
begin
|
||||
// RegisterWSComponent(TCustomBitBtn, TWinCEWSBitBtn);
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterCustomSpeedButton: Boolean; alias : 'WSRegisterCustomSpeedButton';
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
// Arrow
|
||||
function RegisterArrow: Boolean; alias : 'WSRegisterArrow';
|
||||
begin
|
||||
// RegisterWSComponent(TArrow, TWinCEWSArrow);
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
// CheckLst
|
||||
function RegisterCustomCheckListBox: Boolean; alias : 'WSRegisterCustomCheckListBox';
|
||||
begin
|
||||
// RegisterWSComponent(TCustomCheckListBox, TWinCEWSCustomCheckListBox);
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
// Forms
|
||||
function RegisterScrollingWinControl: Boolean; alias : 'WSRegisterScrollingWinControl';
|
||||
begin
|
||||
// RegisterWSComponent(TScrollingWinControl, TWinCEWSScrollingWinControl);
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterScrollBox: Boolean; alias : 'WSRegisterScrollBox';
|
||||
begin
|
||||
// RegisterWSComponent(TScrollBox, TWinCEWSScrollBox);
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterCustomFrame: Boolean; alias : 'WSRegisterCustomFrame';
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterCustomForm: Boolean; alias : 'WSRegisterCustomForm';
|
||||
begin
|
||||
// RegisterWSComponent(TCustomForm, TWinCEWSCustomForm);
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterHintWindow: Boolean; alias : 'WSRegisterHintWindow';
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
// Grids
|
||||
function RegisterCustomGrid: Boolean; alias : 'WSRegisterCustomGrid';
|
||||
begin
|
||||
// RegisterWSComponent(TCustomGrid, TWinCEWSCustomGrid);
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
// Menus
|
||||
function RegisterMenuItem: Boolean; alias : 'WSRegisterMenuItem';
|
||||
begin
|
||||
// RegisterWSComponent(TMenuItem, TWinCEWSMenuItem);
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterMenu: Boolean; alias : 'WSRegisterMenu';
|
||||
begin
|
||||
// RegisterWSComponent(TMenu, TWinCEWSMenu);
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterMainMenu: Boolean; alias : 'WSRegisterMainMenu';
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterPopupMenu: Boolean; alias : 'WSRegisterPopupMenu';
|
||||
begin
|
||||
// RegisterWSComponent(TPopupMenu, TWinCEWSPopupMenu);
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterPairSplitterSide: Boolean; alias : 'WSRegisterPairSplitterSide';
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterCustomPairSplitter: Boolean; alias : 'WSRegisterCustomPairSplitter';
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterCustomFloatSpinEdit: Boolean; alias : 'WSRegisterCustomFloatSpinEdit';
|
||||
begin
|
||||
// RegisterWSComponent(TCustomFloatSpinEdit, TWinCEWSCustomFloatSpinEdit);
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function RegisterCustomRubberBand: Boolean; alias : 'WSRegisterCustomRubberBand';
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
end.
|
||||
644
lcl/interfaces/customdrawn/customdrawnwsforms.pp
Normal file
644
lcl/interfaces/customdrawn/customdrawnwsforms.pp
Normal file
@ -0,0 +1,644 @@
|
||||
{
|
||||
*****************************************************************************
|
||||
* QtWSForms.pp *
|
||||
* ------------ *
|
||||
* *
|
||||
* *
|
||||
*****************************************************************************
|
||||
|
||||
*****************************************************************************
|
||||
* *
|
||||
* This file is part of the Lazarus Component Library (LCL) *
|
||||
* *
|
||||
* See the file COPYING.modifiedLGPL.txt, included in this distribution, *
|
||||
* for details about the copyright. *
|
||||
* *
|
||||
* This program is distributed in the hope that it will be useful, *
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
|
||||
* *
|
||||
*****************************************************************************
|
||||
}
|
||||
unit CustomDrawnWSForms;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
//{$I qtdefines.inc}
|
||||
|
||||
uses
|
||||
// LCL
|
||||
SysUtils, Classes, Controls, LCLType, Forms,
|
||||
// Widgetset
|
||||
InterfaceBase, WSForms, WSProc, WSLCLClasses;
|
||||
|
||||
type
|
||||
|
||||
{ TCDWSScrollingWinControl }
|
||||
|
||||
TCDWSScrollingWinControl = class(TWSScrollingWinControl)
|
||||
published
|
||||
end;
|
||||
|
||||
{ TCDWSScrollBox }
|
||||
|
||||
TCDWSScrollBox = class(TWSScrollBox)
|
||||
published
|
||||
// class procedure ScrollBy(const AWinControl: TScrollingWinControl;
|
||||
// const DeltaX, DeltaY: integer); override;
|
||||
end;
|
||||
|
||||
{ TCDWSCustomFrame }
|
||||
|
||||
TCDWSCustomFrame = class(TWSCustomFrame)
|
||||
published
|
||||
// class procedure ScrollBy(const AWinControl: TScrollingWinControl;
|
||||
// const DeltaX, DeltaY: integer); override;
|
||||
end;
|
||||
|
||||
{ TCDWSFrame }
|
||||
|
||||
TCDWSFrame = class(TWSFrame)
|
||||
published
|
||||
end;
|
||||
|
||||
{ TCDWSCustomForm }
|
||||
|
||||
TCDWSCustomForm = class(TWSCustomForm)
|
||||
private
|
||||
{ class function GetCDBorderStyle(const AFormBorderStyle: TFormBorderStyle): CDWindowFlags;
|
||||
class function GetCDBorderIcons(const AFormBorderStyle: TFormBorderStyle; ABorderIcons: TBorderIcons): CDWindowFlags;
|
||||
class function GetCDFormStyle(const AFormStyle: TFormStyle): CDWindowFlags;
|
||||
class procedure UpdateWindowFlags(const AWidget: TCDMainWindow;
|
||||
ABorderStyle: TFormBorderStyle; ABorderIcons: TBorderIcons; AFormStyle: TFormStyle);
|
||||
published
|
||||
class function CanFocus(const AWinControl: TWinControl): Boolean; override;
|
||||
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
|
||||
|
||||
class procedure CloseModal(const ACustomForm: TCustomForm); override;
|
||||
class procedure DestroyHandle(const AWinControl: TWinControl); override;
|
||||
class procedure SetAllowDropFiles(const AForm: TCustomForm; AValue: Boolean); override;
|
||||
class procedure SetFormBorderStyle(const AForm: TCustomForm; const AFormBorderStyle: TFormBorderStyle); override;
|
||||
class procedure SetFormStyle(const AForm: TCustomform; const AFormStyle, AOldFormStyle: TFormStyle); override;
|
||||
class procedure SetIcon(const AForm: TCustomForm; const Small, Big: HICON); override;
|
||||
class procedure SetPopupParent(const ACustomForm: TCustomForm;
|
||||
const APopupMode: TPopupMode; const APopupParent: TCustomForm); override;
|
||||
class procedure SetShowInTaskbar(const AForm: TCustomForm; const AValue: TShowInTaskbar); override;
|
||||
class procedure ShowHide(const AWinControl: TWinControl); override; //TODO: rename to SetVisible(control, visible)
|
||||
class procedure ShowModal(const ACustomForm: TCustomForm); override;
|
||||
class procedure SetBorderIcons(const AForm: TCustomForm; const ABorderIcons: TBorderIcons); override;
|
||||
class procedure SetAlphaBlend(const ACustomForm: TCustomForm;
|
||||
const AlphaBlend: Boolean; const Alpha: Byte); override;}
|
||||
end;
|
||||
|
||||
{ TCDWSForm }
|
||||
|
||||
TCDWSForm = class(TWSForm)
|
||||
published
|
||||
end;
|
||||
|
||||
{ TCDWSHintWindow }
|
||||
|
||||
TCDWSHintWindow = class(TWSHintWindow)
|
||||
published
|
||||
// class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
|
||||
end;
|
||||
|
||||
{ TCDWSScreen }
|
||||
|
||||
TCDWSScreen = class(TWSScreen)
|
||||
published
|
||||
end;
|
||||
|
||||
{ TCDWSApplicationProperties }
|
||||
|
||||
TCDWSApplicationProperties = class(TWSApplicationProperties)
|
||||
published
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
(*uses CDint, CDWSControls, LCLIntf;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCDWSCustomForm.CreateHandle
|
||||
Params: None
|
||||
Returns: Nothing
|
||||
|
||||
Creates a CD Form and initializes it according to it's properties
|
||||
------------------------------------------------------------------------------}
|
||||
class function TCDWSCustomForm.CreateHandle(const AWinControl: TWinControl;
|
||||
const AParams: TCreateParams): TLCLIntfHandle;
|
||||
var
|
||||
CDMainWindow: TCDMainWindow;
|
||||
Str: WideString;
|
||||
PopupParent: QWidgetH;
|
||||
AForm: TCustomForm;
|
||||
begin
|
||||
{$ifdef VerboseCD}
|
||||
WriteLn('[TCDWSCustomForm.CreateHandle] Height: ', IntToStr(AWinControl.Height),
|
||||
' Width: ', IntToStr(AWinControl.Width));
|
||||
{$endif}
|
||||
|
||||
// Creates the window
|
||||
{$IFDEF HASX11}
|
||||
if (CDVersionMajor = 4) and (CDVersionMinor >= 6) then
|
||||
QCoreApplication_setAttribute(CDAA_ImmediateWidgetCreation, True);
|
||||
{$ENDIF}
|
||||
if csDesigning in AWinControl.ComponentState then
|
||||
CDMainWindow := TCDDesignWidget.Create(AWinControl, AParams)
|
||||
else
|
||||
CDMainWindow := TCDMainWindow.Create(AWinControl, AParams);
|
||||
|
||||
AForm := TCustomForm(AWinControl);
|
||||
|
||||
CDMainWindow.CDFormBorderStyle := Ord(AForm.BorderStyle);
|
||||
CDMainWindow.CDFormStyle := Ord(AForm.FormStyle);
|
||||
|
||||
Str := GetUtf8String(AWinControl.Caption);
|
||||
|
||||
CDMainWindow.SetWindowTitle(@Str);
|
||||
|
||||
if not (csDesigning in AForm.ComponentState) then
|
||||
begin
|
||||
UpdateWindowFlags(CDMainWindow, AForm.BorderStyle,
|
||||
AForm.BorderIcons, AForm.FormStyle);
|
||||
end;
|
||||
|
||||
if not (AForm.FormStyle in [fsMDIChild]) and
|
||||
(Application <> nil) and
|
||||
(Application.MainForm <> nil) and
|
||||
(Application.MainForm.HandleAllocated) and
|
||||
(Application.MainForm <> AForm) then
|
||||
begin
|
||||
if (AForm.ShowInTaskBar in [stDefault, stNever])
|
||||
{$ifdef HASX11}
|
||||
{CDTool have not minimize button !}
|
||||
and not (AForm.BorderStyle in [bsSizeToolWin, bsToolWindow])
|
||||
{$endif} then
|
||||
CDMainWindow.setShowInTaskBar(False);
|
||||
if Assigned(AForm.PopupParent) then
|
||||
PopupParent := TCDWidget(AForm.PopupParent.Handle).Widget
|
||||
else
|
||||
PopupParent := nil;
|
||||
CDMainWindow.setPopupParent(AForm.PopupMode, PopupParent);
|
||||
end;
|
||||
|
||||
{$IFDEF HASX11}
|
||||
if (CDVersionMajor = 4) and (CDVersionMinor >= 6) then
|
||||
QCoreApplication_setAttribute(CDAA_ImmediateWidgetCreation, False);
|
||||
{$ENDIF}
|
||||
|
||||
// Sets Various Events
|
||||
CDMainWindow.AttachEvents;
|
||||
CDMainWindow.MenuBar.AttachEvents;
|
||||
|
||||
if (AForm.FormStyle in [fsMDIChild]) and
|
||||
(Application.MainForm.FormStyle = fsMdiForm) and
|
||||
not (csDesigning in AWinControl.ComponentState) then
|
||||
begin
|
||||
QMdiArea_addSubWindow(TCDMainWindow(Application.MainForm.Handle).MDIAreaHandle, CDMainWindow.Widget, CDWindow);
|
||||
QWidget_setFocusProxy(CDMainWindow.Widget, CDMainWindow.getContainerWidget);
|
||||
end;
|
||||
|
||||
|
||||
// Return the handle
|
||||
Result := TLCLIntfHandle(CDMainWindow);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCDWSCustomForm.CloseModal
|
||||
Params:
|
||||
Returns: Nothing
|
||||
------------------------------------------------------------------------------}
|
||||
class procedure TCDWSCustomForm.CloseModal(const ACustomForm: TCustomForm);
|
||||
begin
|
||||
inherited CloseModal(ACustomForm);
|
||||
end;
|
||||
|
||||
class procedure TCDWSCustomForm.DestroyHandle(const AWinControl: TWinControl);
|
||||
var
|
||||
w: TCDWidget;
|
||||
begin
|
||||
w := TCDWidget(AWinControl.Handle);
|
||||
{forms which have another widget as parent
|
||||
eg.form inside tabpage or mdichilds
|
||||
can segfault without hiding before release.
|
||||
So we save our day here.}
|
||||
if w.getVisible and (w.getParent <> nil) then
|
||||
w.Hide;
|
||||
w.Release;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCDWSCustomForm.SetAllowDropFiles
|
||||
Params:
|
||||
Returns: Nothing
|
||||
------------------------------------------------------------------------------}
|
||||
class procedure TCDWSCustomForm.SetAllowDropFiles(const AForm: TCustomForm;
|
||||
AValue: Boolean);
|
||||
begin
|
||||
if AForm.HandleAllocated then
|
||||
TCDMainWindow(AForm.Handle).setAcceptDropFiles(AValue);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCDWSCustomForm.SetFormBorderStyle
|
||||
Params:
|
||||
Returns: Nothing
|
||||
------------------------------------------------------------------------------}
|
||||
class procedure TCDWSCustomForm.SetFormBorderStyle(const AForm: TCustomForm;
|
||||
const AFormBorderStyle: TFormBorderStyle);
|
||||
var
|
||||
CDWin: TCDMainWindow;
|
||||
begin
|
||||
CDWin := TCDMainWindow(AForm.Handle);
|
||||
if (AForm.Parent <> nil) and (CDWin.CDFormBorderStyle <> Ord(AFormBorderStyle)) then
|
||||
RecreateWnd(AForm)
|
||||
else
|
||||
begin
|
||||
CDWin.CDFormBorderStyle := Ord(AFormBorderStyle);
|
||||
UpdateWindowFlags(CDWin, AFormBorderStyle,
|
||||
AForm.BorderIcons, AForm.FormStyle);
|
||||
end;
|
||||
end;
|
||||
|
||||
class procedure TCDWSCustomForm.SetFormStyle(const AForm: TCustomform;
|
||||
const AFormStyle, AOldFormStyle: TFormStyle);
|
||||
var
|
||||
CDWin: TCDMainWindow;
|
||||
begin
|
||||
CDWin := TCDMainWindow(AForm.Handle);
|
||||
if (AForm.Parent <> nil) and (CDWin.CDFormStyle <> Ord(AFormStyle)) then
|
||||
RecreateWnd(AForm)
|
||||
else
|
||||
begin
|
||||
CDWin.CDFormStyle := Ord(AFormStyle);
|
||||
UpdateWindowFlags(CDWin, AForm.BorderStyle, AForm.BorderIcons, AFormStyle);
|
||||
end;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCDWSCustomForm.SetIcon
|
||||
Params:
|
||||
Returns: Nothing
|
||||
------------------------------------------------------------------------------}
|
||||
class procedure TCDWSCustomForm.SetIcon(const AForm: TCustomForm; const Small, Big: HICON);
|
||||
var
|
||||
Icon: TCDIcon;
|
||||
begin
|
||||
Icon := TCDIcon(Big);
|
||||
if Icon <> nil then
|
||||
TCDWidget(AForm.Handle).setWindowIcon(Icon.Handle)
|
||||
else
|
||||
TCDWidget(AForm.Handle).setWindowIcon(nil);
|
||||
end;
|
||||
|
||||
class procedure TCDWSCustomForm.SetPopupParent(const ACustomForm: TCustomForm;
|
||||
const APopupMode: TPopupMode; const APopupParent: TCustomForm);
|
||||
var
|
||||
PopupParent: QWidgetH;
|
||||
begin
|
||||
if Assigned(APopupParent) then
|
||||
PopupParent := TCDWidget(APopupParent.Handle).Widget
|
||||
else
|
||||
PopupParent := nil;
|
||||
TCDMainWindow(ACustomForm.Handle).setPopupParent(APopupMode, PopupParent);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCDWSCustomForm.SetShowInTaskbar
|
||||
Params:
|
||||
Returns: Nothing
|
||||
------------------------------------------------------------------------------}
|
||||
class procedure TCDWSCustomForm.SetShowInTaskbar(const AForm: TCustomForm; const AValue: TShowInTaskbar);
|
||||
var
|
||||
Enable: Boolean;
|
||||
begin
|
||||
if (AForm.Parent<>nil) or not (AForm.HandleAllocated) then exit;
|
||||
|
||||
Enable := AValue <> stNever;
|
||||
if (AValue = stDefault) and
|
||||
{$IFDEF HASX11}
|
||||
TCDMainWindow(AForm.Handle).ShowOnTaskBar and
|
||||
{$ENDIF}
|
||||
(Application<>nil) and
|
||||
(Application.MainForm <> nil) and
|
||||
(Application.MainForm <> AForm) then
|
||||
Enable := false;
|
||||
{$IFDEF HASX11}
|
||||
if AForm.FormStyle <> fsMDIChild then
|
||||
SetSkipX11Taskbar(TCDMainWindow(AForm.Handle).Widget, not Enable);
|
||||
{$ENDIF}
|
||||
TCDMainWindow(AForm.Handle).setShowInTaskBar(Enable);
|
||||
end;
|
||||
|
||||
class procedure TCDWSCustomForm.ShowHide(const AWinControl: TWinControl);
|
||||
const
|
||||
LCLToCDWindowState: array[TWindowState] of CDWindowState = (
|
||||
{ wsNormal } CDWindowNoState,
|
||||
{ wsMinimized } CDWindowMinimized,
|
||||
{ wsMaximized } CDWindowMaximized,
|
||||
{ wsFullScreen} CDWindowFullScreen
|
||||
);
|
||||
var
|
||||
Widget: TCDMainWindow;
|
||||
R: TRect;
|
||||
ActiveWin: HWND;
|
||||
W: QWidgetH;
|
||||
Flags: Cardinal;
|
||||
begin
|
||||
if not WSCheckHandleAllocated(AWinControl, 'ShowHide') then
|
||||
Exit;
|
||||
|
||||
Widget := TCDMainWindow(AWinControl.Handle);
|
||||
|
||||
if AWinControl.HandleObjectShouldBeVisible then
|
||||
begin
|
||||
if fsModal in TForm(AWinControl).FormState then
|
||||
begin
|
||||
{$ifdef MSWINDOWS}
|
||||
// CD doesn't modal windows as CDTool.see issue #18709
|
||||
if (TForm(AWinControl).BorderStyle in [bsToolWindow, bsSizeToolWin]) then
|
||||
QWidget_setWindowFlags(Widget.Widget, CDDialog);
|
||||
{$endif}
|
||||
|
||||
{$ifdef HASX11}
|
||||
W := nil;
|
||||
ActiveWin := GetActiveWindow;
|
||||
if ActiveWin <> 0 then
|
||||
begin
|
||||
if Assigned(TCDWidget(ActiveWin).LCLObject) then
|
||||
begin
|
||||
if (TCDWidget(ActiveWin).LCLObject is TCustomForm) then
|
||||
begin
|
||||
with TCustomForm(TCDWidget(ActiveWin).LCLObject) do
|
||||
begin
|
||||
if Visible and (FormStyle <> fsSplash) then
|
||||
W := TCDWidget(Handle).Widget;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
QWidget_setParent(Widget.Widget, W);
|
||||
QWidget_setWindowFlags(Widget.Widget, CDDialog);
|
||||
{$endif}
|
||||
{$ifdef darwin}
|
||||
QWidget_setWindowFlags(Widget.Widget, CDDialog or CDWindowSystemMenuHint or CDCustomizeWindowHint
|
||||
or CDWindowTitleHint or CDWindowCloseButtonHint);
|
||||
{$endif}
|
||||
Widget.setWindowModality(CDApplicationModal);
|
||||
end;
|
||||
|
||||
if TForm(AWinControl).FormStyle = fsMDIChild then
|
||||
begin
|
||||
{MDI windows have to be resized , since titlebar is included into widget geometry !}
|
||||
if not (csDesigning in AWinControl.ComponentState)
|
||||
and not Widget.isMaximized then
|
||||
begin
|
||||
QWidget_contentsRect(Widget.Widget, @R);
|
||||
R.Right := TForm(AWinControl).Width + R.Left;
|
||||
R.Bottom := TForm(AWinControl).Height + R.Top;
|
||||
R.Left := Widget.MdiChildCount * 10;
|
||||
R.Top := Widget.MdiChildCount * 10;
|
||||
Widget.move(R.Left, R.Top);
|
||||
Widget.resize(R.Right, R.Bottom);
|
||||
end;
|
||||
end;
|
||||
|
||||
if TForm(AWinControl).FormStyle <> fsMDIChild then
|
||||
begin
|
||||
if (csDesigning in AWinControl.ComponentState) and
|
||||
(TCustomForm(AWinControl).WindowState = wsMaximized) then
|
||||
Widget.setWindowState(LCLToCDWindowState[wsNormal])
|
||||
else
|
||||
Widget.setWindowState(LCLToCDWindowState[TCustomForm(AWinControl).WindowState]);
|
||||
end;
|
||||
end;
|
||||
|
||||
Widget.BeginUpdate;
|
||||
if not (csDesigning in AWinControl.ComponentState) then
|
||||
begin
|
||||
if AWinControl.HandleObjectShouldBeVisible
|
||||
and (TCustomForm(AWinControl).FormStyle in fsAllStayOnTop) then
|
||||
begin
|
||||
Flags := Widget.windowFlags;
|
||||
if (Flags and CDWindowStaysOnTopHint = 0) then
|
||||
begin
|
||||
Flags := Flags or CDWindowStaysOnTopHint;
|
||||
Widget.setWindowFlags(Flags);
|
||||
end;
|
||||
end else
|
||||
begin
|
||||
if (TCustomForm(AWinControl).FormStyle in fsAllStayOnTop)
|
||||
and not (csDestroying in AWinControl.ComponentState) then
|
||||
begin
|
||||
Flags := Widget.windowFlags;
|
||||
Flags := Flags and not CDWindowStaysOnTopHint;
|
||||
Widget.setWindowFlags(Flags);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
Widget.setVisible(AWinControl.HandleObjectShouldBeVisible);
|
||||
Widget.EndUpdate;
|
||||
|
||||
{$IFDEF HASX11}
|
||||
if AWinControl.HandleObjectShouldBeVisible and
|
||||
(fsModal in TForm(AWinControl).FormState) and
|
||||
(CDWidgetSet.WindowManagerName = 'metacity') then
|
||||
X11Raise(QWidget_winID(Widget.Widget));
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF HASX11}
|
||||
if (CDVersionMajor = 4) and (CDVersionMinor >= 6)
|
||||
and (TForm(AWinControl).FormStyle <> fsMDIChild) then
|
||||
QApplication_syncX();
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCDWSCustomForm.ShowModal
|
||||
Params:
|
||||
Returns: Nothing
|
||||
------------------------------------------------------------------------------}
|
||||
class procedure TCDWSCustomForm.ShowModal(const ACustomForm: TCustomForm);
|
||||
begin
|
||||
{
|
||||
Setting modal flags is done in TCDWSCustomControl.ShowHide
|
||||
Since that flags has effect only when Widget is not visible
|
||||
|
||||
We can of course hide widget, set flags here and then show it, but we do not
|
||||
want window flickering :)
|
||||
}
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCDWSCustomForm.SetBorderIcons
|
||||
Params:
|
||||
Returns: Nothing
|
||||
------------------------------------------------------------------------------}
|
||||
class procedure TCDWSCustomForm.SetBorderIcons(const AForm: TCustomForm;
|
||||
const ABorderIcons: TBorderIcons);
|
||||
begin
|
||||
UpdateWindowFlags(TCDMainWindow(AForm.Handle), AForm.BorderStyle, ABorderIcons, AForm.FormStyle);
|
||||
end;
|
||||
|
||||
class procedure TCDWSCustomForm.SetAlphaBlend(const ACustomForm: TCustomForm;
|
||||
const AlphaBlend: Boolean; const Alpha: Byte);
|
||||
begin
|
||||
if AlphaBlend then
|
||||
TCDMainWindow(ACustomForm.Handle).setWindowOpacity(Alpha / 255)
|
||||
else
|
||||
TCDMainWindow(ACustomForm.Handle).setWindowOpacity(1);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCDWSCustomForm.GetCDWindowBorderStyle
|
||||
Params: None
|
||||
Returns: Nothing
|
||||
|
||||
------------------------------------------------------------------------------}
|
||||
class function TCDWSCustomForm.GetCDBorderStyle(const AFormBorderStyle: TFormBorderStyle): CDWindowFlags;
|
||||
begin
|
||||
case AFormBorderStyle of
|
||||
bsNone:
|
||||
Result := CDWindow or CDFramelessWindowHint;
|
||||
bsSingle:
|
||||
Result := CDWindow or CDMSWindowsFixedSizeDialogHint;
|
||||
bsSizeable:
|
||||
Result := CDWindow;
|
||||
bsDialog:
|
||||
Result := CDDialog or CDMSWindowsFixedSizeDialogHint;
|
||||
bsToolWindow:
|
||||
Result := CDTool or CDMSWindowsFixedSizeDialogHint;
|
||||
bsSizeToolWin:
|
||||
// CD on most platforms (except windows) doesn't have sizeToolWin, it's regular CDWindow
|
||||
Result := {$ifdef windows}CDTool{$else}CDWindow{$endif};
|
||||
else
|
||||
Result := CDWidget;
|
||||
end;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCDWSCustomForm.SetCDBorderIcons
|
||||
Params: None
|
||||
Returns: Nothing
|
||||
|
||||
Same comment as SetCDWindowBorderStyle above
|
||||
------------------------------------------------------------------------------}
|
||||
class function TCDWSCustomForm.GetCDBorderIcons(const AFormBorderStyle: TFormBorderStyle; ABorderIcons: TBorderIcons): CDWindowFlags;
|
||||
begin
|
||||
Result := 0;
|
||||
|
||||
case AFormBorderStyle of
|
||||
bsNone: Exit;
|
||||
bsDialog: ABorderIcons := ABorderIcons - [biMaximize, biMinimize];
|
||||
bsToolWindow, bsSizeToolWin: ABorderIcons := ABorderIcons - [biMaximize, biMinimize, biHelp];
|
||||
end;
|
||||
|
||||
if (biSystemMenu in ABorderIcons) then
|
||||
Result := Result or CDWindowSystemMenuHint;
|
||||
|
||||
if (biMinimize in ABorderIcons) then
|
||||
Result := Result or CDWindowMinimizeButtonHint;
|
||||
|
||||
if (biMaximize in ABorderIcons) then
|
||||
Result := Result or CDWindowMaximizeButtonHint;
|
||||
|
||||
if (biHelp in ABorderIcons) then
|
||||
Result := Result or CDWindowContextHelpButtonHint;
|
||||
end;
|
||||
|
||||
class function TCDWSCustomForm.GetCDFormStyle(const AFormStyle: TFormStyle): CDWindowFlags;
|
||||
begin
|
||||
if AFormStyle in fsAllStayOnTop then
|
||||
Result := CDWindowStaysOnTopHint
|
||||
else
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
class procedure TCDWSCustomForm.UpdateWindowFlags(const AWidget: TCDMainWindow;
|
||||
ABorderStyle: TFormBorderStyle; ABorderIcons: TBorderIcons; AFormStyle: TFormStyle);
|
||||
var
|
||||
Flags: CDWindowFlags;
|
||||
AVisible: Boolean;
|
||||
begin
|
||||
AWidget.BeginUpdate;
|
||||
AVisible := AWidget.getVisible;
|
||||
Flags := GetCDBorderStyle(ABorderStyle) or GetCDFormStyle(AFormStyle) or GetCDBorderIcons(ABorderStyle, ABorderIcons);
|
||||
if (Flags and CDFramelessWindowHint) = 0 then
|
||||
Flags := Flags or CDWindowTitleHint or CDCustomizeWindowHint
|
||||
or CDWindowCloseButtonHint;
|
||||
|
||||
if not (csDesigning in AWidget.LCLObject.ComponentState) then
|
||||
begin
|
||||
AWidget.setWindowFlags(Flags);
|
||||
if ABorderStyle in [bsDialog, bsNone, bsSingle] then
|
||||
AWidget.Resize(AWidget.LCLObject.Width, AWidget.LCLObject.Height)
|
||||
else
|
||||
begin
|
||||
// Reset constraints.
|
||||
AWidget.setMinimumSize(CDMinimumWidgetSize, CDMinimumWidgetSize);
|
||||
AWidget.setMaximumSize(CDMaximumWidgetSize, CDMaximumWidgetSize);
|
||||
end;
|
||||
end;
|
||||
|
||||
AWidget.setVisible(AVisible);
|
||||
AWidget.EndUpdate;
|
||||
end;
|
||||
|
||||
class function TCDWSCustomForm.CanFocus(const AWinControl: TWinControl
|
||||
): Boolean;
|
||||
var
|
||||
Widget: TCDWidget;
|
||||
begin
|
||||
if AWinControl.HandleAllocated then
|
||||
begin
|
||||
Widget := TCDWidget(AWinControl.Handle);
|
||||
Result := Widget.getVisible and Widget.getEnabled;
|
||||
end else
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
{ TCDWSHintWindow }
|
||||
|
||||
class function TCDWSHintWindow.CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle;
|
||||
var
|
||||
CDMainWindow: TCDMainWindow;
|
||||
begin
|
||||
CDMainWindow := TCDHintWindow.Create(AWinControl, AParams);
|
||||
// Sets Various Events
|
||||
CDMainWindow.AttachEvents;
|
||||
Result := TLCLIntfHandle(CDMainWindow);
|
||||
end;
|
||||
|
||||
{ TCDWSScrollBox }
|
||||
|
||||
class procedure TCDWSScrollBox.ScrollBy(
|
||||
const AWinControl: TScrollingWinControl; const DeltaX, DeltaY: integer);
|
||||
var
|
||||
Widget: TCDCustomControl;
|
||||
begin
|
||||
if not WSCheckHandleAllocated(AWinControl, 'ScrollBy') then
|
||||
Exit;
|
||||
Widget := TCDCustomControl(AWinControl.Handle);
|
||||
Widget.viewport.scroll(DeltaX, DeltaY);
|
||||
end;
|
||||
|
||||
{ TCDWSCustomFrame }
|
||||
|
||||
class procedure TCDWSCustomFrame.ScrollBy(
|
||||
const AWinControl: TScrollingWinControl; const DeltaX, DeltaY: integer);
|
||||
var
|
||||
Widget: TCDCustomControl;
|
||||
begin
|
||||
if not WSCheckHandleAllocated(AWinControl, 'ScrollBy') then
|
||||
Exit;
|
||||
Widget := TCDCustomControl(AWinControl.Handle);
|
||||
Widget.viewport.scroll(DeltaX, DeltaY);
|
||||
end;*)
|
||||
|
||||
end.
|
||||
@ -1092,13 +1092,12 @@ end;
|
||||
function GetControlText(AHandle: HWND): string;
|
||||
var
|
||||
TextLen: dword;
|
||||
tmpWideStr : PWideChar;
|
||||
tmpWideStr: WideString;
|
||||
begin
|
||||
TextLen := GetWindowTextLength(AHandle);
|
||||
tmpWideStr := PWideChar(SysAllocStringLen(nil,TextLen + 1));
|
||||
GetWindowTextW(AHandle, tmpWideStr, TextLen + 1);
|
||||
Result := UTF8Encode(widestring(tmpWideStr));
|
||||
SysFreeString(tmpWideStr);
|
||||
SetLength(tmpWideStr, TextLen+1);
|
||||
GetWindowTextW(AHandle, PWideChar(tmpWideStr), TextLen + 1);
|
||||
Result := UTF8Encode(tmpWideStr);
|
||||
end;
|
||||
|
||||
procedure WideStrCopy(Dest, Src: PWideChar);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user