Thema: Delphi TabSheet "freistellen"

Einzelnen Beitrag anzeigen

Sailor

Registriert seit: 20. Jul 2008
Ort: Balaton
112 Beiträge
 
Delphi 2010 Professional
 
#5

AW: TabSheet "freistellen"

  Alt 7. Jul 2015, 11:07
Du mußt dem TabSheet ein neues Fensterhandle unterjubeln. Geht grob etwa so:

Delphi-Quellcode:
UNIT Floating;

 INTERFACE

  USES Windows,
       Messages,
       SysUtils,Variants,
       Classes,Graphics,Controls,ComCtrls,Forms,Dialogs;

  TYPE
   TFloatingForm = CLASS(TForm)
                    PROCEDURE FormCloseQuery(sender:TObject; VAR can_close:Boolean);
                    PROCEDURE FormClose(sender:TObject; VAR action:TCloseAction);

                    PRIVATE
                       FNoFloatParent: TWinControl;

                        FOnBeforeDock: TNotifyEvent;
                         FOnAfterDock: TNotifyEvent;
                       FOnBeforeFloat: TNotifyEvent;
                        FOnAfterFloat: TNotifyEvent;

                    PUBLIC
                     CONSTRUCTOR Create(an_owner:TComponent; CONST tab_sheet:TWinControl); REINTRODUCE;
                     PROCEDURE CreateParams(VAR params:TCreateParams); OVERRIDE;

                     PROCEDURE Float(x:Integer; y:Integer; wdt:Integer; hgt:Integer);

                     PROPERTY OnBeforeDock:TNotifyEvent
                              READ FOnBeforeDock
                              WRITE FOnBeforeDock;
                     PROPERTY OnAfterDock:TNotifyEvent
                              READ FOnAfterDock
                              WRITE FOnAfterDock;
                     PROPERTY OnBeforeFloat:TNotifyEvent
                              READ FOnBeforeFloat
                              WRITE FOnBeforeFloat;
                     PROPERTY OnAfterFloat:TNotifyEvent
                              READ FOnAfterFloat
                              WRITE FOnAfterFloat;
                   END;

 IMPLEMENTATION

{$R *.dfm}

  CONSTRUCTOR TFloatingForm.Create(an_owner:TComponent; CONST tab_sheet:TWinControl);
   BEGIN
    INHERITED Create(an_owner);
    FNoFloatParent := tab_sheet
   END; {OF CONSTRUCTOR TFloatingForm.Create}

  PROCEDURE TFloatingForm.CreateParams(VAR params:TCreateParams);
   BEGIN
    INHERITED CreateParams(params);
// Desktop button
    params.ExStyle := params.ExStyle OR ws_Ex_AppWindow
   END; {OF PROCEDURE TFloatingForm.CreateParams}

  PROCEDURE TFloatingForm.Float(x:Integer; y:Integer; wdt:Integer; hgt:Integer);
   VAR
    ind: Integer;

   BEGIN
    IF Visible = True
     THEN Exit; //Already floating

    IF Assigned(FOnBeforeFloat)
     THEN FOnBeforeFloat(Self);

    FOR ind:=FNoFloatParent.ControlCount-1 DOWNTO 0
     DO FNoFloatParent.Controls[ind].Parent := Self; // That' s the trick
    Left := x;
    Width := wdt;
    Top := y;
    Height := hgt;

    IF Assigned(FOnAfterFloat)
     THEN FOnAfterFloat(Self);

    Visible := True;
    SetCursorPos(Left+30,Top+10);
    Mouse_Event(MouseEventF_Absolute OR MouseEventF_LeftDown,Left+30,Top+10,0,0)
   END; {OF PROCEDURE TFloatingForm.Float}

  PROCEDURE TFloatingForm.FormCloseQuery(sender:TObject; VAR can_close:Boolean);
   VAR
    ind: Integer;

   BEGIN
    can_close := True;

    IF Assigned(FOnBeforeDock)
     THEN FOnBeforeDock(Self);

    FOR ind:=ControlCount-1 DOWNTO 0
     DO Controls[ind].Parent := FNoFloatParent; // Reset to old parent window

    IF Assigned(FOnAfterDock)
     THEN FOnAfterDock(Self)
   END; {OF PROCEDURE TFloatingForm.FormCloseQuery}

  PROCEDURE TFloatingForm.FormClose(sender:TObject; VAR action:TCloseAction);
   BEGIN
    action := caFree
   END; {OF PROCEDURE TFloatingForm.FormClose}

 END
 .


Aufruf:

 PROCEDURE TShellForm.PageControlMouseMove(sender:TObject; shift:TShiftState; x:Integer; y:Integer);
   CONST
    CMinMove = 3;

   VAR
    tab: Integer;
      p: TPoint;

   BEGIN
    WITH PageControl
     DO BEGIN
         tab := IndexOfTabAt(x,y);
         IF tab <> Undefined
          THEN BEGIN
                IF (FMouseDown = True)
                  AND
                   (
                     (Abs(FMouseX-x) > CMinMove)
                    OR
                     (Abs(FMouseY-y) > CMinMove)
                   )
                 THEN BEGIN
                       IF VisibleTabs > 1
                        THEN BEGIN
                              p := ClientToScreen(Point(x,GetSystemMetrics(sm_CyCaption)+TabHeight DIV 2));
                              FFloatingForm := TFloatingForm.Create(Self,PageControl.Pages[tab]);
                              WITH FFloatingForm
                               DO BEGIN
                                   OnBeforeDock := FloatingBeforeDock;
                                   OnBeforeFloat := FloatingBeforeFloat;
                                   OnAfterDock := FloatingAfterDock;
                                   OnAfterFloat := FloatingAfterFloat
                                  END;
                              FFloatingForm.Float(p.X,p.Y,Width,Height)
                             END;
                       FMouseDown := False
                      END
               END
        END
   END; {OF PROCEDURE TShellForm.PageControlMouseMove}
  Mit Zitat antworten Zitat