mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-06 10:18:05 +02:00
- some minor changes and comments for native win32 image list
- native drag image list implementation for win32 git-svn-id: trunk@10933 -
This commit is contained in:
paul
parent
584a1f6a33
commit
1cdfd2446a
@ -278,6 +278,8 @@ type
|
||||
FDragHotspot: TPoint;
|
||||
FOldCursor: TCursor;
|
||||
FImageIndex: Integer;
|
||||
FLastDragPos: TPoint;
|
||||
FLockedWindow: HWND;
|
||||
procedure SetDragCursor(const AValue: TCursor);
|
||||
protected
|
||||
procedure Initialize; override;
|
||||
@ -351,6 +353,7 @@ type
|
||||
|
||||
TDragObject = class(TObject)
|
||||
private
|
||||
FAlwaysShowDragImages: Boolean;
|
||||
FDragTarget: TControl;
|
||||
FDragHandle: HWND;
|
||||
FDragPos: TPoint;
|
||||
@ -377,6 +380,7 @@ type
|
||||
procedure HideDragImage; virtual;
|
||||
function Instance: THandle; virtual;
|
||||
procedure ShowDragImage; virtual;
|
||||
property AlwaysShowDragImages: Boolean read FAlwaysShowDragImages write FAlwaysShowDragImages;
|
||||
property Cancelling: Boolean read FCancelling write FCancelling;
|
||||
property DragHandle: HWND read FDragHandle write FDragHandle;
|
||||
property DragPos: TPoint read FDragPos write FDragPos;
|
||||
|
||||
@ -281,12 +281,17 @@ Begin
|
||||
ADragCursor := DragObject.GetDragCursor(SendDragOver(dmDragMove), Position.X, Position.Y);
|
||||
if DragImages <> nil then
|
||||
begin
|
||||
if (DragObject.DragTarget = nil) or (csDisplayDragImage in DragObject.DragTarget.ControlStyle) then
|
||||
if (DragObject.DragTarget = nil) or (csDisplayDragImage in DragObject.DragTarget.ControlStyle) or
|
||||
(DragObject.AlwaysShowDragImages) then
|
||||
begin
|
||||
DragImages.DragLock(0, Position.X, Position.Y);
|
||||
DragImages.DragCursor := ADragCursor;
|
||||
DragImages.DragMove(Position.X, Position.Y);
|
||||
end else
|
||||
DragImages.EndDrag;
|
||||
begin
|
||||
// we can hide drag image
|
||||
DragImages.DragUnLock;
|
||||
end;
|
||||
end;
|
||||
WidgetSet.SetCursor(Screen.Cursors[ADragCursor]);
|
||||
if DragObject = nil then Exit;
|
||||
|
||||
@ -18,6 +18,10 @@
|
||||
*****************************************************************************
|
||||
}
|
||||
|
||||
const
|
||||
// bad window handle. 0 is reserverd by DesktopWindow
|
||||
NoLockedWindow: HWND = $FFFFFFFF;
|
||||
|
||||
{ TDragImageList }
|
||||
|
||||
{
|
||||
@ -29,7 +33,7 @@ begin
|
||||
if FDragCursor = AValue then exit;
|
||||
FDragCursor := AValue;
|
||||
if Dragging then
|
||||
Screen.Cursor := FDragCursor;
|
||||
WidgetSet.SetCursor(Screen.Cursors[DragCursor]);
|
||||
end;
|
||||
|
||||
{
|
||||
@ -42,8 +46,10 @@ begin
|
||||
FDragging := False;
|
||||
FDragCursor := crNone;
|
||||
FDragHotspot := Point(0, 0);
|
||||
FLastDragPos := Point(0, 0);
|
||||
FOldCursor := crNone;
|
||||
FImageIndex := -1;
|
||||
FLockedWindow := NoLockedWindow;
|
||||
FImageIndex := 0;
|
||||
end;
|
||||
|
||||
{
|
||||
@ -52,26 +58,40 @@ end;
|
||||
}
|
||||
function TDragImageList.BeginDrag(Window: HWND; X, Y: Integer): Boolean;
|
||||
begin
|
||||
{$note implement}
|
||||
Result := TWsDragImageListClass(WidgetSetClass).BeginDrag(Self, Window, X, Y);
|
||||
Result := TWsDragImageListClass(WidgetSetClass).BeginDrag(Self, Window,
|
||||
FImageIndex, FDragHotspot.X, FDragHotspot.Y);
|
||||
FDragging := Result;
|
||||
if Result then
|
||||
begin
|
||||
DragLock(Window, X, Y);
|
||||
FOldCursor := Screen.Cursor;
|
||||
Screen.Cursor := FDragCursor;
|
||||
WidgetSet.SetCursor(Screen.Cursors[DragCursor])
|
||||
end;
|
||||
end;
|
||||
|
||||
{
|
||||
TDragImageList.DragLock
|
||||
Show drag image and locks updates of Window during drag operation
|
||||
}
|
||||
function TDragImageList.DragLock(Window: HWND; XPos, YPos: Integer): Boolean;
|
||||
begin
|
||||
if Dragging then
|
||||
Result := Dragging;
|
||||
if not Result then
|
||||
begin
|
||||
{$note implement}
|
||||
end else
|
||||
Result := False;
|
||||
Result := BeginDrag(Window, XPos, YPos);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if Window <> FLockedWindow then
|
||||
begin
|
||||
if FLockedWindow <> NoLockedWindow then
|
||||
DragUnlock;
|
||||
FLockedWindow := Window;
|
||||
Result := TWsDragImageListClass(WidgetSetClass).ShowDragImage(Self, Window,
|
||||
XPos, YPos, True);
|
||||
if Result then
|
||||
FLastDragPos := Point(XPos, YPos);
|
||||
end;
|
||||
end;
|
||||
|
||||
{
|
||||
@ -80,22 +100,22 @@ end;
|
||||
}
|
||||
function TDragImageList.DragMove(X, Y: Integer): Boolean;
|
||||
begin
|
||||
if not Dragging then
|
||||
BeginDrag(0, X, Y);
|
||||
Result := Dragging;
|
||||
Result := Dragging and TWsDragImageListClass(WidgetSetClass).DragMove(Self, X, Y);
|
||||
if Result then
|
||||
Result := TWsDragImageListClass(WidgetSetClass).DragMove(Self, X, Y);
|
||||
{$note implement}
|
||||
FLastDragPos := Point(X, Y);
|
||||
end;
|
||||
|
||||
{
|
||||
TDragImageList.DragUnlock
|
||||
Hide drag image and stop lock updates of Window during drag operation
|
||||
}
|
||||
procedure TDragImageList.DragUnlock;
|
||||
begin
|
||||
if Dragging then
|
||||
begin
|
||||
{$note implement}
|
||||
TWsDragImageListClass(WidgetSetClass).HideDragImage(Self, FLockedWindow, True);
|
||||
FLockedWindow := NoLockedWindow;
|
||||
FLastDragPos := Point(0, 0);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -104,14 +124,15 @@ end;
|
||||
}
|
||||
function TDragImageList.EndDrag: Boolean;
|
||||
begin
|
||||
if Dragging then
|
||||
begin
|
||||
FDragging := False;
|
||||
FDragCursor := crNone;
|
||||
TWsDragImageListClass(WidgetSetClass).EndDrag(Self);
|
||||
{$note implement}
|
||||
end else
|
||||
Result := False;
|
||||
Result := Dragging;
|
||||
if not Result then
|
||||
Exit;
|
||||
|
||||
DragUnlock;
|
||||
TWsDragImageListClass(WidgetSetClass).EndDrag(Self);
|
||||
FDragging := False;
|
||||
FDragCursor := crNone;
|
||||
WidgetSet.SetCursor(Screen.Cursors[FOldCursor])
|
||||
end;
|
||||
|
||||
{
|
||||
@ -120,20 +141,17 @@ end;
|
||||
}
|
||||
function TDragImageList.GetHotSpot: TPoint;
|
||||
begin
|
||||
Result := inherited GetHotSpot;
|
||||
Result := FDragHotSpot;
|
||||
end;
|
||||
|
||||
{
|
||||
TDragImageList.HideDragImage
|
||||
Hide dragging image
|
||||
Hide dragging image without unlocking of window
|
||||
}
|
||||
procedure TDragImageList.HideDragImage;
|
||||
begin
|
||||
if Dragging then
|
||||
begin
|
||||
TWsDragImageListClass(WidgetSetClass).HideDragImage(Self);
|
||||
{$note implement}
|
||||
end;
|
||||
TWsDragImageListClass(WidgetSetClass).HideDragImage(Self, 0, False);
|
||||
end;
|
||||
|
||||
{
|
||||
@ -141,10 +159,25 @@ end;
|
||||
Set index of dragging image and hotspot
|
||||
}
|
||||
function TDragImageList.SetDragImage(Index, HotSpotX, HotSpotY: Integer): Boolean;
|
||||
var
|
||||
CurLockedWindow: HWND;
|
||||
CurDragPos: TPoint;
|
||||
begin
|
||||
FImageIndex := Index;
|
||||
FDragHotSpot := Point(HotSpotX, HotSpotY);
|
||||
{$note implement}
|
||||
Result := True;
|
||||
if (FImageIndex <> Index) or (FDragHotSpot.X <> HotSpotX) or
|
||||
(FDragHotSpot.Y <> HotSpotY) then
|
||||
begin
|
||||
FImageIndex := Index;
|
||||
FDragHotSpot := Point(HotSpotX, HotSpotY);
|
||||
if Dragging then
|
||||
begin
|
||||
// restart dragging with new params
|
||||
CurLockedWindow := FLockedWindow;
|
||||
CurDragPos := FLastDragPos;
|
||||
EndDrag;
|
||||
BeginDrag(CurLockedWindow, CurDragPos.X, CurDragPos.Y);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{
|
||||
@ -154,10 +187,7 @@ end;
|
||||
procedure TDragImageList.ShowDragImage;
|
||||
begin
|
||||
if Dragging then
|
||||
begin
|
||||
TWsDragImageListClass(WidgetSetClass).ShowDragImage(Self);
|
||||
{$note implement}
|
||||
end;
|
||||
TWsDragImageListClass(WidgetSetClass).ShowDragImage(Self, 0, 0, 0, False);
|
||||
end;
|
||||
|
||||
// included by controls.pp
|
||||
|
||||
@ -28,6 +28,7 @@ begin
|
||||
FDragTargetPos := Source.FDragTargetPos;
|
||||
FMouseDeltaX := Source.FMouseDeltaX;
|
||||
FMouseDeltaY := Source.FMouseDeltaY;
|
||||
FAlwaysShowDragImages := Source.FAlwaysShowDragImages;
|
||||
end;
|
||||
|
||||
function TDragObject.Capture: HWND;
|
||||
|
||||
@ -41,13 +41,20 @@ uses
|
||||
InterfaceBase, LCLIntf, LCLType;
|
||||
|
||||
type
|
||||
|
||||
{ TWin32WSDragImageList }
|
||||
|
||||
TWin32WSDragImageList = class(TWSDragImageList)
|
||||
private
|
||||
protected
|
||||
public
|
||||
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;
|
||||
|
||||
{ TWin32WSControl }
|
||||
@ -466,6 +473,44 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
{ TWin32WSDragImageList }
|
||||
|
||||
class function TWin32WSDragImageList.BeginDrag(
|
||||
const ADragImageList: TDragImageList; Window: HWND; AIndex, X, Y: Integer): Boolean;
|
||||
begin
|
||||
if not WSCheckHandleAllocated(ADragImageList, 'BeginDrag') then
|
||||
Exit;
|
||||
Result := ImageList_BeginDrag(ADragImageList.Handle, AIndex, X, Y);
|
||||
end;
|
||||
|
||||
class function TWin32WSDragImageList.DragMove(const ADragImageList: TDragImageList;
|
||||
X, Y: Integer): Boolean;
|
||||
begin
|
||||
Result := ImageList_DragMove(X, Y);
|
||||
end;
|
||||
|
||||
class procedure TWin32WSDragImageList.EndDrag(const ADragImageList: TDragImageList);
|
||||
begin
|
||||
ImageList_EndDrag;
|
||||
end;
|
||||
|
||||
class function TWin32WSDragImageList.HideDragImage(const ADragImageList: TDragImageList;
|
||||
ALockedWindow: HWND; DoUnLock: Boolean): Boolean;
|
||||
begin
|
||||
if DoUnLock then
|
||||
Result := ImageList_DragLeave(ALockedWindow)
|
||||
else
|
||||
Result := ImageList_DragShowNolock(True);
|
||||
end;
|
||||
|
||||
class function TWin32WSDragImageList.ShowDragImage(const ADragImageList: TDragImageList;
|
||||
ALockedWindow: HWND; X, Y: Integer; DoLock: Boolean): Boolean;
|
||||
begin
|
||||
if DoLock then
|
||||
Result := ImageList_DragEnter(ALockedWindow, X, Y)
|
||||
else
|
||||
Result := ImageList_DragShowNolock(False);
|
||||
end;
|
||||
|
||||
initialization
|
||||
|
||||
@ -475,7 +520,7 @@ initialization
|
||||
// To improve speed, register only classes
|
||||
// which actually implement something
|
||||
////////////////////////////////////////////////////
|
||||
// RegisterWSComponent(TDragImageList, TWin32WSDragImageList);
|
||||
// RegisterWSComponent(TDragImageList, TWin32WSDragImageList); // Uncomment with native image list
|
||||
RegisterWSComponent(TControl, TWin32WSControl);
|
||||
RegisterWSComponent(TWinControl, TWin32WSWinControl);
|
||||
// RegisterWSComponent(TGraphicControl, TWin32WSGraphicControl);
|
||||
|
||||
@ -45,6 +45,9 @@ type
|
||||
TWin32WSCustomImageList = class(TWSCustomImageList)
|
||||
private
|
||||
protected
|
||||
class procedure InternalCreateBitmap(AList: TCustomImageList; AWidth, AHeight: Integer; AData: PRGBAQuad;
|
||||
var hbmImage, hbmMask: HBitmap);
|
||||
class procedure InternalDestroyBitmap(hbmImage, hbmMask: HBitmap);
|
||||
public
|
||||
class procedure Clear(AList: TCustomImageList); override;
|
||||
class function CreateHandle(AList: TCustomImageList; ACount, AGrow, AWidth,
|
||||
@ -72,6 +75,24 @@ const
|
||||
|
||||
{ TWin32WSCustomImageList }
|
||||
|
||||
class procedure TWin32WSCustomImageList.InternalCreateBitmap(AList: TCustomImageList;
|
||||
AWidth, AHeight: Integer; AData: PRGBAQuad; var hbmImage, hbmMask: HBitmap);
|
||||
begin
|
||||
// this will work only with Comctl32.dll version 6 (XP manifest)
|
||||
// in other case we need separate image and mask
|
||||
hbmImage := CreateBitmap(AWidth, AHeight, 1, 32, AData);
|
||||
hbmMask := 0;
|
||||
end;
|
||||
|
||||
class procedure TWin32WSCustomImageList.InternalDestroyBitmap(hbmImage,
|
||||
hbmMask: HBitmap);
|
||||
begin
|
||||
if hbmImage <> 0 then
|
||||
DeleteObject(hbmImage);
|
||||
if hbmMask <> 0 then
|
||||
DeleteObject(hbmMask);
|
||||
end;
|
||||
|
||||
class procedure TWin32WSCustomImageList.Clear(AList: TCustomImageList);
|
||||
begin
|
||||
if not WSCheckHandleAllocated(AList, 'Clear')
|
||||
@ -83,7 +104,7 @@ class function TWin32WSCustomImageList.CreateHandle(AList: TCustomImageList;
|
||||
ACount, AGrow, AWidth, AHeight: Integer; AData: PRGBAQuad): TLCLIntfHandle;
|
||||
var
|
||||
FLags: DWord;
|
||||
hbmImage: HBITMAP;
|
||||
hbmImage, hbmMask: HBITMAP;
|
||||
i: integer;
|
||||
begin
|
||||
if (Win32Platform and VER_PLATFORM_WIN32_NT) <> 0 then
|
||||
@ -97,9 +118,10 @@ begin
|
||||
// this is very slow method :(
|
||||
for i := 0 to ACount - 1 do
|
||||
begin
|
||||
hbmImage := CreateBitmap(AWidth, AHeight, 1, 32, @AData[AWidth * AHeight * i]);
|
||||
ImageList_Add(Result, hbmImage, 0);
|
||||
DeleteObject(hbmImage);
|
||||
InternalCreateBitmap(AList, AWidth, AHeight, @AData[AWidth * AHeight * i],
|
||||
hbmImage, hbmMask);
|
||||
ImageList_Add(Result, hbmImage, hbmMask);
|
||||
InternalDestroyBitmap(hbmMask, hbmImage);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -126,7 +148,7 @@ begin
|
||||
then Exit;
|
||||
|
||||
ImageList_DrawEx(HImageList(AList.Handle), AIndex, ACanvas.Handle, ABounds.Left,
|
||||
ABounds.Top, ABounds.Right, ABounds.Bottom, CLR_DEFAULT, CLR_DEFAULT,
|
||||
ABounds.Top, ABounds.Right, ABounds.Bottom, CLR_NONE, CLR_NONE,
|
||||
DrawingStyleMap[AStyle]);
|
||||
end;
|
||||
|
||||
@ -135,7 +157,7 @@ class procedure TWin32WSCustomImageList.Insert(AList: TCustomImageList;
|
||||
var
|
||||
AImageList: HImageList;
|
||||
ACount: Integer;
|
||||
hbmImage: HBITMAP;
|
||||
hbmImage, hbmMask: HBITMAP;
|
||||
begin
|
||||
if not WSCheckHandleAllocated(AList, 'Insert')
|
||||
then Exit;
|
||||
@ -145,9 +167,9 @@ begin
|
||||
|
||||
if (AIndex <= ACount) and (AIndex >= 0) then
|
||||
begin
|
||||
hbmImage := CreateBitmap(AList.Width, AList.Height, 1, 32, AData);
|
||||
ImageList_Add(AImageList, hbmImage, 0);
|
||||
DeleteObject(hbmImage);
|
||||
InternalCreateBitmap(AList, AList.Width, AList.Height, AData, hbmImage, hbmMask);
|
||||
ImageList_Add(AImageList, hbmImage, hbmMask);
|
||||
InternalDestroyBitmap(hbmImage, hbmMask);
|
||||
if AIndex <> ACount
|
||||
then Move(AList, ACount, AIndex);
|
||||
end;
|
||||
@ -175,21 +197,19 @@ begin
|
||||
for n := ACurIndex downto ANewIndex - 1 do
|
||||
ImageList_Copy(Handle, n - 1, Handle, n, ILCF_SWAP);
|
||||
end;
|
||||
|
||||
|
||||
end;
|
||||
|
||||
class procedure TWin32WSCustomImageList.Replace(AList: TCustomImageList;
|
||||
AIndex: Integer; AData: PRGBAQuad);
|
||||
var
|
||||
hbmImage: HBITMAP;
|
||||
hbmImage, hbmMask: HBITMAP;
|
||||
begin
|
||||
if not WSCheckHandleAllocated(AList, 'Replace')
|
||||
then Exit;
|
||||
|
||||
hbmImage := CreateBitmap(AList.Width, AList.Height, 1, 32, AData);
|
||||
ImageList_Replace(HImageList(AList.Handle), AIndex, hbmImage, 0);
|
||||
DeleteObject(hbmImage);
|
||||
InternalCreateBitmap(AList, AList.Width, AList.Height, AData, hbmImage, hbmMask);
|
||||
ImageList_Replace(HImageList(AList.Handle), AIndex, hbmImage, hbmMask);
|
||||
InternalDestroyBitmap(hbmImage, hbmMask);
|
||||
end;
|
||||
|
||||
initialization
|
||||
|
||||
@ -55,11 +55,13 @@ type
|
||||
{ TWSDragImageList }
|
||||
|
||||
TWSDragImageList = class(TWSCustomImageList)
|
||||
class function BeginDrag(const ADragImageList: TDragImageList; Window: HWND; X, Y: Integer): Boolean; virtual;
|
||||
class function BeginDrag(const ADragImageList: TDragImageList; Window: HWND; AIndex, X, Y: Integer): Boolean; virtual;
|
||||
class function DragMove(const ADragImageList: TDragImageList; X, Y: Integer): Boolean; virtual;
|
||||
class procedure EndDrag(const ADragImageList: TDragImageList); virtual;
|
||||
class procedure HideDragImage(const ADragImageList: TDragImageList); virtual;
|
||||
class procedure ShowDragImage(const ADragImageList: TDragImageList); virtual;
|
||||
class function HideDragImage(const ADragImageList: TDragImageList;
|
||||
ALockedWindow: HWND; DoUnLock: Boolean): Boolean; virtual;
|
||||
class function ShowDragImage(const ADragImageList: TDragImageList;
|
||||
ALockedWindow: HWND; X, Y: Integer; DoLock: Boolean): Boolean; virtual;
|
||||
end;
|
||||
|
||||
TWSDragImageListClass = class of TWSDragImageList;
|
||||
@ -257,7 +259,7 @@ end;
|
||||
{ TWSDragImageList }
|
||||
|
||||
class function TWSDragImageList.BeginDrag(const ADragImageList: TDragImageList;
|
||||
Window: HWND; X, Y: Integer): Boolean;
|
||||
Window: HWND; AIndex, X, Y: Integer): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
@ -272,12 +274,16 @@ class procedure TWSDragImageList.EndDrag(const ADragImageList: TDragImageList);
|
||||
begin
|
||||
end;
|
||||
|
||||
class procedure TWSDragImageList.HideDragImage(const ADragImageList: TDragImageList);
|
||||
class function TWSDragImageList.HideDragImage(const ADragImageList: TDragImageList;
|
||||
ALockedWindow: HWND; DoUnLock: Boolean): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
class procedure TWSDragImageList.ShowDragImage(const ADragImageList: TDragImageList);
|
||||
class function TWSDragImageList.ShowDragImage(const ADragImageList: TDragImageList;
|
||||
ALockedWindow: HWND; X, Y: Integer; DoLock: Boolean): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
initialization
|
||||
|
||||
Loading…
Reference in New Issue
Block a user