AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

TabSheet "freistellen"

Ein Thema von Sugar · begonnen am 6. Jul 2015 · letzter Beitrag vom 7. Jul 2015
 
Sailor

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

AW: TabSheet "freistellen"

  Alt 7. Jul 2015, 10: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
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 16:44 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz