#include TPageControl::TPageControl(TComponent *AOwner) : TCustomTabControl(AOwner) { } TPageControl::~TPageControl() { } /* { TPageControl } constructor TPageControl.Create(AOwner: TComponent); begin inherited Create(AOwner); ControlStyle := [csDoubleClicks, csOpaque]; FPages := TList.Create; end; destructor TPageControl.Destroy; var I: Integer; begin for I := 0 to FPages.Count - 1 do TTabSheet(FPages[I]).FPageControl := nil; FPages.Free; inherited Destroy; end; function TPageControl.CanShowTab(TabIndex: Integer): Boolean; begin Result := TTabSheet(FPages[TabIndex]).Enabled; end; procedure TPageControl.Change; var Form: TCustomForm; begin UpdateActivePage; if csDesigning in ComponentState then begin Form := GetParentForm(Self); if (Form <> nil) and (Form.Designer <> nil) then Form.Designer.Modified; end; inherited Change; end; procedure TPageControl.ChangeActivePage(Page: TTabSheet); var ParentForm: TCustomForm; begin if FActivePage <> Page then begin ParentForm := GetParentForm(Self); if (ParentForm <> nil) and (FActivePage <> nil) and FActivePage.ContainsControl(ParentForm.ActiveControl) then begin ParentForm.ActiveControl := FActivePage; if ParentForm.ActiveControl <> FActivePage then begin TabIndex := FActivePage.TabIndex; Exit; end; end; if Page <> nil then begin Page.BringToFront; Page.Visible := True; if (ParentForm <> nil) and (FActivePage <> nil) and (ParentForm.ActiveControl = FActivePage) then if Page.CanFocus then ParentForm.ActiveControl := Page else ParentForm.ActiveControl := Self; end; if FActivePage <> nil then FActivePage.Visible := False; FActivePage := Page; if (ParentForm <> nil) and (FActivePage <> nil) and (ParentForm.ActiveControl = FActivePage) then FActivePage.SelectFirst; end; end; procedure TPageControl.DeleteTab(Page: TTabSheet; Index: Integer); var UpdateIndex: Boolean; begin UpdateIndex := Page = ActivePage; Tabs.Delete(Index); if UpdateIndex then begin if Index >= Tabs.Count then Index := Tabs.Count - 1; TabIndex := Index; end; UpdateActivePage; end; procedure TPageControl.DoAddDockClient(Client: TControl; const ARect: TRect); begin if FNewDockSheet <> nil then Client.Parent := FNewDockSheet; end; procedure TPageControl.DockOver(Source: TDragDockObject; X, Y: Integer; State: TDragState; var Accept: Boolean); var R: TRect; begin GetWindowRect(Handle, R); Source.DockRect := R; DoDockOver(Source, X, Y, State, Accept); end; procedure TPageControl.DoRemoveDockClient(Client: TControl); begin if (FUndockingPage <> nil) and not (csDestroying in ComponentState) then begin SelectNextPage(True); FUndockingPage.Free; FUndockingPage := nil; end; end; function TPageControl.FindNextPage(CurPage: TTabSheet; GoForward, CheckTabVisible: Boolean): TTabSheet; var I, StartIndex: Integer; begin if FPages.Count <> 0 then begin StartIndex := FPages.IndexOf(CurPage); if StartIndex = -1 then if GoForward then StartIndex := FPages.Count - 1 else StartIndex := 0; I := StartIndex; repeat if GoForward then begin Inc(I); if I = FPages.Count then I := 0; end else begin if I = 0 then I := FPages.Count; Dec(I); end; Result := FPages[I]; if not CheckTabVisible or Result.TabVisible then Exit; until I = StartIndex; end; Result := nil; end; procedure TPageControl.GetChildren(Proc: TGetChildProc; Root: TComponent); var I: Integer; begin for I := 0 to FPages.Count - 1 do Proc(TComponent(FPages[I])); end; function TPageControl.GetImageIndex(TabIndex: Integer): Integer; begin if Assigned(FOnGetImageIndex) then Result := inherited GetImageIndex(TabIndex) else Result := GetPage(TabIndex).ImageIndex; end; function TPageControl.GetPageFromDockClient(Client: TControl): TTabSheet; var I: Integer; begin Result := nil; for I := 0 to PageCount - 1 do begin if (Client.Parent = Pages[I]) and (Client.HostDockSite = Self) then begin Result := Pages[I]; Exit; end; end; end; function TPageControl.GetPage(Index: Integer): TTabSheet; begin Result := FPages[Index]; end; function TPageControl.GetPageCount: Integer; begin Result := FPages.Count; end; procedure TPageControl.GetSiteInfo(Client: TControl; var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean); begin CanDock := GetPageFromDockClient(Client) = nil; inherited GetSiteInfo(Client, InfluenceRect, MousePos, CanDock); end; procedure TPageControl.InsertPage(Page: TTabSheet); begin FPages.Add(Page); Page.FPageControl := Self; Page.UpdateTabShowing; end; procedure TPageControl.InsertTab(Page: TTabSheet); begin Tabs.InsertObject(Page.TabIndex, Page.Caption, Page); UpdateActivePage; end; procedure TPageControl.MoveTab(CurIndex, NewIndex: Integer); begin Tabs.Move(CurIndex, NewIndex); end; procedure TPageControl.RemovePage(Page: TTabSheet); var NextSheet: TTabSheet; begin NextSheet := FindNextPage(Page, True, not (csDesigning in ComponentState)); if NextSheet = Page then NextSheet := nil; Page.SetTabShowing(False); Page.FPageControl := nil; FPages.Remove(Page); SetActivePage(NextSheet); end; procedure TPageControl.SelectNextPage(GoForward: Boolean); var Page: TTabSheet; begin Page := FindNextPage(ActivePage, GoForward, True); if (Page <> nil) and (Page <> ActivePage) and CanChange then begin TabIndex := Page.TabIndex; Change; end; end; procedure TPageControl.SetActivePage(Page: TTabSheet); begin if (Page <> nil) and (Page.PageControl <> Self) then Exit; ChangeActivePage(Page); if Page = nil then TabIndex := -1 else if Page = FActivePage then TabIndex := Page.TabIndex; end; procedure TPageControl.SetChildOrder(Child: TComponent; Order: Integer); begin TTabSheet(Child).PageIndex := Order; end; procedure TPageControl.ShowControl(AControl: TControl); begin if (AControl is TTabSheet) and (TTabSheet(AControl).PageControl = Self) then SetActivePage(TTabSheet(AControl)); inherited ShowControl(AControl); end; procedure TPageControl.UpdateTab(Page: TTabSheet); begin Tabs[Page.TabIndex] := Page.Caption; end; procedure TPageControl.UpdateActivePage; begin if TabIndex >= 0 then SetActivePage(TTabSheet(Tabs.Objects[TabIndex])) else SetActivePage(nil); end; procedure TPageControl.CMDesignHitTest(var Message: TCMDesignHitTest); var HitIndex: Integer; HitTestInfo: TTCHitTestInfo; begin HitTestInfo.pt := SmallPointToPoint(Message.Pos); HitIndex := SendMessage(Handle, TCM_HITTEST, 0, Longint(@HitTestInfo)); if (HitIndex >= 0) and (HitIndex <> TabIndex) then Message.Result := 1; end; procedure TPageControl.CMDialogKey(var Message: TCMDialogKey); begin if (Focused or Windows.IsChild(Handle, Windows.GetFocus)) and (Message.CharCode = VK_TAB) and (GetKeyState(VK_CONTROL) < 0) then begin SelectNextPage(GetKeyState(VK_SHIFT) >= 0); Message.Result := 1; end else inherited; end; procedure TPageControl.CMDockClient(var Message: TCMDockClient); var IsVisible: Boolean; DockCtl: TControl; begin Message.Result := 0; FNewDockSheet := TTabSheet.Create(Self); try try DockCtl := Message.DockSource.Control; if DockCtl is TCustomForm then FNewDockSheet.Caption := TCustomForm(DockCtl).Caption; FNewDockSheet.PageControl := Self; DockCtl.Dock(Self, Message.DockSource.DockRect); except FNewDockSheet.Free; raise; end; IsVisible := DockCtl.Visible; FNewDockSheet.TabVisible := IsVisible; if IsVisible then ActivePage := FNewDockSheet; DockCtl.Align := alClient; finally FNewDockSheet := nil; end; end; procedure TPageControl.CMDockNotification(var Message: TCMDockNotification); var I: Integer; S: string; Page: TTabSheet; begin Page := GetPageFromDockClient(Message.Client); if Page <> nil then case Message.NotifyRec.ClientMsg of WM_SETTEXT: begin S := PChar(Message.NotifyRec.MsgLParam); { Search for first CR/LF and end string there } for I := 1 to Length(S) do if S[I] in [#13, #10] then begin SetLength(S, I - 1); Break; end; Page.Caption := S; end; CM_VISIBLECHANGED: with Page do begin Visible := Boolean(Message.NotifyRec.MsgWParam); TabVisible := Boolean(Message.NotifyRec.MsgWParam);; end; end; inherited; end; procedure TPageControl.CMUnDockClient(var Message: TCMUnDockClient); var Page: TTabSheet; begin Message.Result := 0; Page := GetPageFromDockClient(Message.Client); if Page <> nil then begin FUndockingPage := Page; Message.Client.Align := alNone; end; end; function TPageControl.GetDockClientFromMousePos(MousePos: TPoint): TControl; var HitIndex: Integer; HitTestInfo: TTCHitTestInfo; Page: TTabSheet; begin Result := nil; if DockSite then begin HitTestInfo.pt := MousePos; HitIndex := SendMessage(Handle, TCM_HITTEST, 0, Longint(@HitTestInfo)); if HitIndex >= 0 then begin Page := Pages[HitIndex]; if not Page.TabVisible then Page := FindNextPage(Page, True, True); if (Page <> nil) and (Page.ControlCount > 0) then begin Result := Page.Controls[0]; if Result.HostDockSite <> Self then Result := nil; end; end; end; end; procedure TPageControl.WMLButtonDown(var Message: TWMLButtonDown); var DockCtl: TControl; begin inherited; DockCtl := GetDockClientFromMousePos(SmallPointToPoint(Message.Pos)); if DockCtl <> nil then DockCtl.BeginDrag(False); end; procedure TPageControl.WMLButtonDblClk(var Message: TWMLButtonDblClk); var DockCtl: TControl; begin inherited; DockCtl := GetDockClientFromMousePos(SmallPointToPoint(Message.Pos)); if DockCtl <> nil then DockCtl.ManualDock(nil, nil, alNone); end; */