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

- rethink DrawDefaultDockImage: add 3 dock image operation: show, hide and move

Browse Source 
- implement qt DrawDefaultDockImage

git-svn-id: trunk@13608 -
This commit is contained in:
paul 2008-01-03 15:39:34 +00:00
parent 1c8516a77f
commit 0f9be635f0
9 changed files with 66 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
lcl/include/dragmanager.inc
View File

@ -60,7 +60,7 @@ type
TDockPerformer = class(TDragDockComon)
private
FDockObject: TDragDockObject;
procedure DefaultDockImage(ADrawRect: TRect; Erase: Boolean);
procedure DefaultDockImage(AOldRect, ANewRect: TRect; AOperation: TDockImageOperation);
protected
function Dragging(AControl: TControl): boolean; override;
procedure DragStarted(APosition: TPoint); override;
@ -304,7 +304,7 @@ begin
FDragImageList := FDockObject.GetDragImages;
if FDragImageList <> nil then
FDragImageList.BeginDrag(0, APosition.X, APosition.Y);
DefaultDockImage(FDockObject.DockRect, False);
DefaultDockImage(FDockObject.EraseDockRect, FDockObject.DockRect, disShow);
FDockObject.EraseDockRect := FDockObject.DockRect;
end;
@ -467,9 +467,7 @@ begin
//Draw the form outlines when the position has changed
if not CompareMem(@DockRect, @EraseDockRect, SizeOf(TRect)) then
begin
if EraseDockRect.Left <> Maxint then
DefaultDockImage(FDockObject.EraseDockRect, True);
DefaultDockImage(FDockObject.DockRect, False);
DefaultDockImage(FDockObject.EraseDockRect, FDockObject.DockRect, disMove);
EraseDockRect := DockRect;
end;
end;
@ -489,7 +487,7 @@ begin
FDockObject := nil;
SetCaptureControl(nil);
DefaultDockImage(ADockObjectCopy.EraseDockRect, True);
DefaultDockImage(ADockObjectCopy.EraseDockRect, ADockObjectCopy.DockRect, disHide);
ADockObjectCopy.Floating := ADockObjectCopy.DragTarget = nil;
Accepted := ADockObjectCopy.DragTarget <> nil;
@ -545,9 +543,9 @@ begin
end;
procedure TDockPerformer.DefaultDockImage(ADrawRect: TRect; Erase: Boolean);
procedure TDockPerformer.DefaultDockImage(AOldRect, ANewRect: TRect; AOperation: TDockImageOperation);
begin
WidgetSet.DrawDefaultDockImage(ADrawRect, Erase);
WidgetSet.DrawDefaultDockImage(AOldRect, ANewRect, AOperation);
end;
{ TDragManagerDefault }

65
lcl/include/intfbaselcl.inc
View File

@ -140,36 +140,45 @@ procedure TWidgetSet.DrawArrow(Arrow: TComponent; Canvas: TPersistent);
begin
end;
procedure TWidgetSet.DrawDefaultDockImage(ARect: TRect; Erase: Boolean);
const
PenSize=4;
var
DC: HDC;
OldPen, NewPen: HPen;
OldRop: Integer;
LogPen: TLogPen;
begin
LogPen.lopnColor := $00FFFFFF;
LogPen.lopnWidth := Point(PenSize, 0);
LogPen.lopnStyle := PS_SOLID;
DC := GetDC(0);
try
NewPen := CreatePenIndirect(LogPen);
OldPen := SelectObject(DC, NewPen);
OldRop := SetROP2(DC, R2_XORPEN);
with ARect do
begin
MoveToEx(DC, Left+PenSize, Top+PenSize, nil);
LineTo(DC, Right-PenSize,Top+PenSize);
LineTo(DC, Right-PenSize, Bottom-PenSize);
LineTo(DC, Left+PenSize,Bottom-PenSize);
LineTo(DC, Left+PenSize, Top+PenSize);
procedure TWidgetSet.DrawDefaultDockImage(AOldRect, ANewRect: TRect; AOperation: TDockImageOperation);
procedure DefaultDockImage(ARect: TRect);
const
PenSize=4;
var
DC: HDC;
OldPen, NewPen: HPen;
OldRop: Integer;
LogPen: TLogPen;
begin
LogPen.lopnColor := $00FFFFFF;
LogPen.lopnWidth := Point(PenSize, 0);
LogPen.lopnStyle := PS_SOLID;
DC := GetDC(0);
try
NewPen := CreatePenIndirect(LogPen);
OldPen := SelectObject(DC, NewPen);
OldRop := SetROP2(DC, R2_XORPEN);
with ARect do
begin
MoveToEx(DC, Left+PenSize, Top+PenSize, nil);
LineTo(DC, Right-PenSize,Top+PenSize);
LineTo(DC, Right-PenSize, Bottom-PenSize);
LineTo(DC, Left+PenSize,Bottom-PenSize);
LineTo(DC, Left+PenSize, Top+PenSize);
end;
finally
SetROP2(DC, OldRop);
DeleteObject(SelectObject(DC, OldPen));
ReleaseDC(0, DC);
end;
finally
SetROP2(DC, OldRop);
DeleteObject(SelectObject(DC, OldPen));
ReleaseDC(0, DC);
end;
begin
if AOperation in [disMove, disHide] then
DefaultDockImage(AOldRect);
if AOperation in [disMove, disShow] then
DefaultDockImage(ANewRect);
end;
function TWidgetSet.ExtUTF8Out(DC: HDC; X, Y: Integer; Options: Longint;

4
lcl/include/lclintf.inc
View File

@ -149,9 +149,9 @@ begin
WidgetSet.DrawArrow(Arrow, Canvas);
end;
procedure DrawDefaultDockImage(ARect: TRect; Erase: Boolean);
procedure DrawDefaultDockImage(AOldRect, ANewRect: TRect; AOperation: TDockImageOperation);
begin
WidgetSet.DrawDefaultDockImage(ARect, Erase);
WidgetSet.DrawDefaultDockImage(AOldRect, ANewRect, AOperation);
end;
function ExtUTF8Out(DC: HDC; X, Y: Integer; Options: Longint; Rect: PRect;

2
lcl/include/lclintfh.inc
View File

@ -66,7 +66,7 @@ function CreateStandardCursor(ACursor: SmallInt): hCursor; {$IFDEF IF_BASE_MEMBE
function DCClipRegionValid(DC: HDC): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
procedure DeallocateHWnd(Wnd: HWND); {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
procedure DrawArrow(Arrow: TComponent; Canvas: TPersistent); {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
procedure DrawDefaultDockImage(ARect: TRect; Erase: Boolean); {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
procedure DrawDefaultDockImage(AOldRect, ANewRect: TRect; AOperation: TDockImageOperation); {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function ExtUTF8Out(DC: HDC; X, Y: Integer; Options: Longint; Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}

1
lcl/interfaces/qt/qtint.pp
View File

@ -60,6 +60,7 @@ type
App: QApplicationH;
SavedDCList: TList;
FOldFocusWidget: QWidgetH;
FDockImage: QRubberBandH;
protected
FStockNullBrush: HBRUSH;
FStockBlackBrush: HBRUSH;

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

@ -114,6 +114,18 @@ begin
end;
end;
procedure TQtWidgetSet.DrawDefaultDockImage(AOldRect, ANewRect: TRect; AOperation: TDockImageOperation);
begin
if FDockImage = nil then
FDockImage := QRubberBand_create(QRubberBandRectangle);
QRubberBand_setGeometry(FDockImage, @ANewRect);
case AOperation of
disShow: QWidget_show(FDockImage);
disHide: QWidget_hide(FDockImage);
end;
end;
{------------------------------------------------------------------------------
Function: FontCanUTF8
@ -129,7 +141,7 @@ begin
Result := False;
{$endif}
{$else}
Result := IsValidGDIObject(Font);
Result := IsValidGDIObject(Font);
{$endif}
end;

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

@ -32,6 +32,7 @@
function CreateStandardCursor(ACursor: SmallInt): hCursor; override;
procedure DrawArrow(Arrow: TComponent; Canvas: TPersistent); override;
procedure DrawDefaultDockImage(AOldRect, ANewRect: TRect; AOperation: TDockImageOperation); override;
function FontCanUTF8(Font: HFont): boolean; override;
function FontIsMonoSpace(Font: HFont): boolean; override;

3
lcl/interfaces/qt/qtobject.inc
View File

@ -29,6 +29,7 @@ begin
InitStockItems;
QtWidgetSet := Self;
FDockImage := nil;
end;
{------------------------------------------------------------------------------
@ -40,6 +41,8 @@ end;
------------------------------------------------------------------------------}
destructor TQtWidgetSet.Destroy;
begin
if FDockImage <> nil then
QRubberBand_destroy(FDockImage);
DestroyGlobalCaret;
Clipboard.Free;
FreeStockItems;

2
lcl/lcltype.pp
View File

@ -67,6 +67,8 @@ type
TCriticalSection = PtrUInt;
PCriticalSection = ^TCriticalSection;
TDockImageOperation = (disShow, disMove, disHide);
{$ifndef WINDOWS}
{$IFDEF CPU64}
// temp solution for 32bit system.Thandle