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

lcl: introduce new widgetset functions for rubberband creation and moving, implement them for win32, qt and gtk2

Browse Source 
git-svn-id: trunk@26446 -
This commit is contained in:
paul 2010-07-03 15:25:36 +00:00
parent ef1accc0b0
commit fe54310b0f
9 changed files with 190 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
lcl/include/intfbaselcl.inc
View File

@ -105,6 +105,11 @@ begin
CombineRGN(Result,SrcRGN,SrcRGN,RGN_COPY);
end;
function TWidgetSet.CreateRubberBand(const ARect: TRect; const ABrush: HBrush): HWND;
begin
Result := 0;
end;
function TWidgetSet.CreateStandardCursor(ACursor: SmallInt): hCursor;
begin
Result := 0;
@ -126,6 +131,11 @@ begin
end;
procedure TWidgetSet.DestroyRubberBand(ARubberBand: HWND);
begin
end;
procedure TWidgetSet.DrawDefaultDockImage(AOldRect, ANewRect: TRect; AOperation: TDockImageOperation);
procedure DefaultDockImage(ARect: TRect);
@ -695,6 +705,11 @@ procedure TWidgetSet.SetEventHandlerFlags(AHandler: PEventHandler; NewFlags: dwo
begin
end;
procedure TWidgetSet.SetRubberBandRect(const ARubberBand: HWND; const ARect: TRect);
begin
end;
function TWidgetSet.StretchMaskBlt(DestDC: HDC;
X, Y, Width, Height: Integer; SrcDC: HDC;
XSrc, YSrc, SrcWidth, SrcHeight: Integer;

15
lcl/include/lclintf.inc
View File

@ -118,11 +118,21 @@ begin
Result := WidgetSet.DCClipRegionValid(DC);
end;
function CreateRubberBand(const ARect: TRect; const ABrush: HBrush = 0): HWND;
begin
Result := WidgetSet.CreateRubberBand(ARect, ABrush);
end;
procedure DeallocateHWnd(Wnd: HWND);
begin
WidgetSet.DeallocateHWnd(Wnd);
end;
procedure DestroyRubberBand(ARubberBand: HWND);
begin
WidgetSet.DestroyRubberBand(ARubberBand);
end;
procedure DrawDefaultDockImage(AOldRect, ANewRect: TRect; AOperation: TDockImageOperation);
begin
WidgetSet.DrawDefaultDockImage(AOldRect, ANewRect, AOperation);
@ -416,6 +426,11 @@ begin
WidgetSet.SetEventHandlerFlags(AHandler, NewFlags);
end;
procedure SetRubberBandRect(const ARubberBand: HWND; const ARect: TRect);
begin
WidgetSet.SetRubberBandRect(ARubberBand, ARect);
end;
function StretchMaskBlt(DestDC: HDC; X, Y, Width, Height: Integer;
SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer;
Mask: HBITMAP; XMask, YMask: Integer; Rop: DWORD): Boolean;

3
lcl/include/lclintfh.inc
View File

@ -56,10 +56,12 @@ function ClipboardRegisterFormat(const AMimeType: string): TClipboardFormat; {$I
function CreateEmptyRegion: hRGN; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function CreatePixmapIndirect(const Data: Pointer; const TransColor: Longint): HBITMAP; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function CreateRegionCopy(SrcRGN: hRGN): hRGN; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function CreateRubberBand(const ARect: TRect; const ABrush: HBrush = 0): HWND; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function CreateStandardCursor(ACursor: SmallInt): hCursor; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function DCClipRegionValid(DC: HDC): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
procedure DeallocateHWnd(Wnd: HWND); {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
procedure DestroyRubberBand(ARubberBand: HWND); {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
procedure DrawDefaultDockImage(AOldRect, ANewRect: TRect; AOperation: TDockImageOperation); {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
procedure DrawGrid(DC: HDC; const R: TRect; DX, DY: Integer); {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
@ -113,6 +115,7 @@ procedure SendCachedLCLMessages; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function SetCaretRespondToFocus(handle: HWND; ShowHideOnFocus: boolean): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function SetComboMinDropDownSize(Handle: HWND; MinItemsWidth, MinItemsHeight, MinItemCount: integer): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
procedure SetEventHandlerFlags(AHandler: PEventHandler; NewFlags: dword); {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
procedure SetRubberBandRect(const ARubberBand: HWND; const ARect: TRect); {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function StretchMaskBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; Mask: HBITMAP; XMask, YMask: Integer; Rop: DWORD): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function TextUTF8Out(DC: HDC; X, Y: Integer; Str: PChar; Count: Longint): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}

63
lcl/interfaces/gtk2/gtk2lclintf.inc
View File

@ -30,6 +30,62 @@
//##apiwiz##sps## // Do not remove
function TGtk2WidgetSet.CreateRubberBand(const ARect: TRect; const ABrush: HBrush): HWND;
const
LineWidth = 2;
var
Widget: PGtkWidget absolute Result;
dx, dy: integer;
Pixmap: PGdkPixmap;
gc: PGdkGC;
AColor: TGdkColor;
begin
dx := ARect.Right - ARect.Left;
dy := ARect.Bottom - ARect.Top;
if dx < 0 then
dx := 0;
if dy < 0 then
dy := 0;
// rubber band is just a window without a title
Result := HWND(gtk_window_new(GTK_WINDOW_POPUP));
gtk_window_set_default_size(PGtkWindow(Result), dx, dy);
gtk_widget_set_uposition(Widget, ARect.Left, ARect.Top);
gtk_widget_set_app_paintable(Widget, True);
gtk_widget_realize(Widget);
gdk_window_set_decorations(Widget^.window, 0);
gdk_window_set_functions(Widget^.window, GDK_FUNC_RESIZE or GDK_FUNC_CLOSE);
gtk_window_set_opacity(PGtkWindow(Result), 0.25);
if ABrush = 0 then
SetWidgetColor(Widget, clNone, clGradientActiveCaption, [GTK_STATE_NORMAL])
else
if PGDIObject(ABrush)^.GDIBrushFill = GDK_SOLID then
SetWidgetColor(Widget, clNone, PGDIObject(ABrush)^.GDIBrushColor.ColorRef, [GTK_STATE_NORMAL])
else
begin
Pixmap := gdk_pixmap_new(Widget^.window, dx, dy, -1);
gc := gdk_gc_new(Pixmap);
AColor := AllocGDKColor(clWhite);
gdk_gc_set_foreground(gc, @AColor);
gdk_gc_set_fill(gc, PGDIObject(ABrush)^.GDIBrushFill);
case PGDIObject(ABrush)^.GDIBrushFill of
GDK_TILED: gdk_gc_set_tile(gc, PGDIObject(ABrush)^.GDIBrushPixMap);
GDK_STIPPLED: gdk_gc_set_stipple(gc, PGDIObject(ABrush)^.GDIBrushPixMap);
end;
gdk_draw_rectangle(Pixmap, gc, -1, 0, 0, dx, dy);
gdk_gc_unref(gc);
gdk_window_set_back_pixmap(Widget^.window, Pixmap, False);
g_object_unref(Pixmap);
end;
gtk_widget_show(Widget);
end;
procedure TGtk2WidgetSet.DestroyRubberBand(ARubberBand: HWND);
begin
gtk_widget_destroy(PGtkWidget(ARubberBand));
end;
procedure TGtk2WidgetSet.DrawDefaultDockImage(AOldRect, ANewRect: TRect;
AOperation: TDockImageOperation);
const
@ -893,6 +949,13 @@ begin
//debugln('TGtk2WidgetSet.SetEventHandlerFlags lEventHandler=',HexStr(Cardinal(lEventHandler),8),' AHandle=',dbgs(lEventHandler^.Handle));
end;
procedure TGtk2WidgetSet.SetRubberBandRect(const ARubberBand: HWND; const ARect: TRect);
begin
with ARect do
gdk_window_move_resize(PGtkWidget(ARubberBand)^.window, Left,
Top, Right - Left, Bottom - Top);
end;
type
PPipeEventInfo = ^TPipeEventInfo;
TPipeEventInfo = record

3
lcl/interfaces/gtk2/gtk2lclintfh.inc
View File

@ -37,6 +37,8 @@ function AddProcessEventHandler(AHandle: THandle;
AEventHandler: TChildExitEvent; AData: PtrInt): PProcessEventHandler; override;
function CreateStandardCursor(ACursor: SmallInt): hCursor; override;
function CreateRubberBand(const ARect: TRect; const ABrush: HBrush = 0): HWND; override;
procedure DestroyRubberBand(ARubberBand: HWND); override;
procedure DrawDefaultDockImage(AOldRect, ANewRect: TRect; AOperation: TDockImageOperation); override;
procedure DrawGrid(DC: HDC; const R: TRect; DX, DY: Integer); override;
@ -65,6 +67,7 @@ procedure RemoveProcessEventHandler(var AHandler: PProcessEventHandler); overrid
function SetComboMinDropDownSize(Handle: HWND; MinItemsWidth, MinItemsHeight, MinItemCount: integer): boolean; override;
procedure SetEventHandlerFlags(AHandler: PEventHandler; NewFlags: dword); override;
procedure SetRubberBandRect(const ARubberBand: HWND; const ARect: TRect); override;
function TextUTF8Out(DC: HDC; X, Y: Integer; Str: PChar; Count: Longint): Boolean; override;
//##apiwiz##eps## // Do not remove, no wizard declaration after this line

18
lcl/interfaces/qt/qtlclintf.inc
View File

@ -193,6 +193,14 @@ begin
Result := HCURSOR(TQtCursor.Create(CursorShape));
end;
function TQtWidgetSet.CreateRubberBand(const ARect: TRect; const ABrush: HBrush): HWND;
begin
// todo: think of ABrush
Result := HWND(QRubberBand_create(QRubberBandRectangle));
QRubberBand_setGeometry(QRubberBandH(Result), @ARect);
QWidget_show(QRubberBandH(Result));
end;
procedure TQtWidgetSet.DrawDefaultDockImage(AOldRect, ANewRect: TRect; AOperation: TDockImageOperation);
begin
if FDockImage = nil then
@ -226,6 +234,11 @@ begin
end;
end;
procedure TQtWidgetSet.DestroyRubberBand(ARubberBand: HWND);
begin
QWidget_destroy(QRubberBandH(ARubberBand));
end;
{------------------------------------------------------------------------------
Function: FontCanUTF8
Params:
@ -788,6 +801,11 @@ begin
QSocketNotifier_setEnabled(wheh^.qsn[QSocketNotifierException], do_error);
end;
procedure TQtWidgetSet.SetRubberBandRect(const ARubberBand: HWND; const ARect: TRect);
begin
QRubberBand_setGeometry(QRubberBandH(ARubberBand), @ARect);
end;
function TQtWidgetSet.TextUTF8Out(DC: HDC; X, Y: Integer; Str: PChar; Count: Longint): Boolean;
begin
Result := False;

5
lcl/interfaces/qt/qtlclintfh.inc
View File

@ -1,4 +1,4 @@
{%MainUnit qtkint.pp}
{%MainUnit qtint.pp}
{ $Id$ }
{******************************************************************************
@ -42,8 +42,10 @@ function AddProcessEventHandler(AHandle: THandle;
function CreateEmptyRegion: hRGN; override;
function CreateStandardCursor(ACursor: SmallInt): HCURSOR; override;
function CreateRubberBand(const ARect: TRect; const ABrush: HBrush = 0): HWND; override;
procedure DrawDefaultDockImage(AOldRect, ANewRect: TRect; AOperation: TDockImageOperation); override;
procedure DrawGrid(DC: HDC; const R: TRect; DX, DY: Integer); override;
procedure DestroyRubberBand(ARubberBand: HWND); override;
function FontCanUTF8(Font: HFont): boolean; override;
function FontIsMonoSpace(Font: HFont): boolean; override;
@ -77,6 +79,7 @@ procedure RemovePipeEventHandler(var AHandler: PPipeEventHandler); override;
procedure RemoveProcessEventHandler(var AHandler: PProcessEventHandler); override;
procedure SetEventHandlerFlags(AHandler: PEventHandler; NewFlags: dword); override;
procedure SetRubberBandRect(const ARubberBand: HWND; const ARect: TRect); override;
function TextUTF8Out(DC: HDC; X, Y: Integer; Str: PChar; Count: Longint): Boolean; override;

73
lcl/interfaces/win32/win32lclintf.inc
View File

@ -182,6 +182,12 @@ begin
AHandler := nil;
end;
procedure TWin32WidgetSet.SetRubberBandRect(const ARubberBand: HWND; const ARect: TRect);
begin
with ARect do
SetWindowPos(ARubberBand, 0, Left, Top, Right - Left, Bottom - Top, SWP_NOZORDER or SWP_NOACTIVATE);
end;
function TWin32WidgetSet.AppHandle: THandle;
begin
Result:= FAppHandle;
@ -210,6 +216,56 @@ begin
end;
end;
function DockWindowProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam;
LParam: Windows.LParam): LResult; stdcall;
begin
if (Msg = WM_ACTIVATE) and (LoWord(WParam) <> WA_INACTIVE) and (LParam <> 0) then
Windows.SendMessage(LParam, WM_NCACTIVATE, 1, 0);
Result := Windows.DefWindowProc(Window, Msg, WParam, LParam);
end;
function TWin32WidgetSet.CreateRubberBand(const ARect: TRect; const ABrush: HBrush = 0): HWND;
var
WindowClass: Windows.WNDCLASS;
WndClassName: String;
begin
WndClassName := 'LazRubberBand' + IntToStr(ABrush);
if not Windows.GetClassInfo(System.HInstance, PChar(WndClassName), WindowClass) then
begin
with WindowClass do
begin
Style := 0;
LPFnWndProc := @DockWindowProc;
CbClsExtra := 0;
CbWndExtra := 0;
hInstance := System.HInstance;
hIcon := Windows.LoadIcon(0, IDI_APPLICATION);
hCursor := Windows.LoadCursor(0, IDC_ARROW);
if ABrush = 0 then
hbrBackground := GetSysColorBrush(COLOR_HIGHLIGHT)
else
hbrBackground := ABrush;
LPSzMenuName := nil;
LPSzClassName := PChar(WndClassName);
end;
Windows.RegisterClass(@WindowClass);
end;
if WindowsVersion >= wv2000 then
begin
Result := CreateWindowEx(WS_EX_LAYERED or WS_EX_TRANSPARENT or WS_EX_TOPMOST or WS_EX_TOOLWINDOW,
PChar(WndClassName), PChar(WndClassName), WS_POPUP or WS_VISIBLE,
ARect.Left, ARect.Top, ARect.Right - ARect.Left, ARect.Bottom - ARect.Top, AppHandle, 0, System.HInstance, nil);
SetLayeredWindowAttributes(Result, 0, $30, LWA_ALPHA);
end
else
Result := CreateWindowEx(WS_EX_TOPMOST or WS_EX_TOOLWINDOW,
PChar(WndClassName), PChar(WndClassName), WS_POPUP or WS_VISIBLE,
ARect.Left, ARect.Top, ARect.Right - ARect.Left, ARect.Bottom - ARect.Top, AppHandle, 0, System.HInstance, nil);
end;
{------------------------------------------------------------------------------
Method: CallbackAllocateHWnd
Params: None
@ -294,12 +350,15 @@ begin
if Assigned(PMethod) then Freemem(PMethod);
end;
function DockWindowProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam;
LParam: Windows.LParam): LResult; stdcall;
procedure TWin32WidgetSet.DestroyRubberBand(ARubberBand: HWND);
var
WndClassName: array[0..255] of Char;
begin
if (Msg = WM_ACTIVATE) and (LoWord(WParam) <> WA_INACTIVE) and (LParam <> 0) then
Windows.SendMessage(LParam, WM_NCACTIVATE, 1, 0);
Result := Windows.DefWindowProc(Window, Msg, WParam, LParam);
GetClassName(ARubberBand, @WndClassName, 255);
// preserve the brush or it will be deleted
SetClassLongPtr(ARubberBand, GCL_HBRBACKGROUND, 0);
DestroyWindow(ARubberBand);
Windows.UnRegisterClass(@WndClassName, System.HINSTANCE);
end;
procedure TWin32WidgetSet.DrawDefaultDockImage(AOldRect, ANewRect: TRect; AOperation: TDockImageOperation);
@ -340,14 +399,14 @@ const
var
WindowClass: WndClass;
begin
if WindowsVersion >= wvXP then
if WindowsVersion >= wv2000 then
begin
case AOperation of
disShow:
begin
with WindowClass do
begin
Style := CS_DBLCLKS;
Style := 0;
LPFnWndProc := @DockWindowProc;
CbClsExtra := 0;
CbWndExtra := 0;

3
lcl/interfaces/win32/win32lclintfh.inc
View File

@ -38,8 +38,10 @@ function AddProcessEventHandler(AHandle: THandle;
function AllocateHWnd(Method: TLCLWndMethod): HWND; override;
function CreateStandardCursor(ACursor: SmallInt): hCursor; override;
function CreateRubberBand(const ARect: TRect; const ABrush: HBrush = 0): HWND; override;
procedure DeallocateHWnd(Wnd: HWND); override;
procedure DestroyRubberBand(ARubberBand: HWND); override;
procedure DrawDefaultDockImage(AOldRect, ANewRect: TRect; AOperation: TDockImageOperation); override;
procedure DrawGrid(DC: HDC; const R: TRect; DX, DY: Integer); override;
@ -67,5 +69,6 @@ procedure RemoveEventHandler(var AHandler: PEventHandler); override;
procedure RemovePipeEventHandler(var AHandler: PPipeEventHandler); override;
procedure RemoveProcessEventHandler(var AHandler: PProcessEventHandler); override;
procedure SetRubberBandRect(const ARubberBand: HWND; const ARect: TRect); override;
//##apiwiz##eps## // Do not remove, no wizard declaration after this line