{%MainUnit ../extctrls.pp} { ***************************************************************************** * * * This file is part of the Lazarus Component Library (LCL) * * * * See the file COPYING.modifiedLGPL.txt, included in this distribution, * * for details about the copyright. * * * * This program is distributed in the hope that it will be useful, * * but WITHOUT ANY WARRANTY; without even the implied warranty of * * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. * * * ***************************************************************************** } {------------------------------------------------------------------------------ TCustomPage Constructor ------------------------------------------------------------------------------} constructor TCustomPage.Create(TheOwner: TComponent); begin inherited Create(TheOwner); FImageIndex := -1; FCompStyle := csPage; FTabVisible := True; ControlStyle := ControlStyle + [csAcceptsControls, csDesignFixedBounds, csNoDesignVisible, csNoFocus]; // height and width depends on parent, align to client rect Align := alClient; Caption := ''; Visible := False; end; {------------------------------------------------------------------------------ method TCustomPage SetImageIndex Params: const AValue: integer Result: none Set the image index of the image shown in the tabs. ------------------------------------------------------------------------------} procedure TCustomPage.SetImageIndex(const AValue: TImageIndex); begin if FImageIndex = AValue then Exit; FImageIndex := AValue; if not HandleAllocated or (csLoading in ComponentState) then Exit; TWSCustomPageClass(WidgetSetClass).UpdateProperties(Self); end; function TCustomPage.GetTabVisible: Boolean; begin Result := FTabVisible; end; procedure TCustomPage.SetTabVisible(const AValue: Boolean); begin if AValue = FTabVisible then Exit; FTabVisible := AValue; if csDesigning in ComponentState then Exit; if Parent.HandleAllocated then begin TCustomNotebook(Parent).AddRemovePageHandle(Self); if FTabVisible then begin // check if there was no visible tab if TCustomNotebook(Parent).PageIndex = -1 then TCustomNotebook(Parent).PageIndex:=PageIndex; end else // Check if the page is active and set a new pageindex TCustomNotebook(Parent).PageRemoved(PageIndex); end; end; class procedure TCustomPage.WSRegisterClass; begin inherited WSRegisterClass; RegisterCustomPage; end; {------------------------------------------------------------------------------ TCustomPage WMPaint Params: a TLMPaint message ------------------------------------------------------------------------------} procedure TCustomPage.WMPaint(var Msg: TLMPaint); var Notebook: TCustomNoteBook; begin if (Parent <> nil) and (Parent is TCustomNoteBook) then begin NoteBook := TCustomNoteBook(Parent); if (NoteBook.PageIndex >= 0) and (NoteBook.Page[NoteBook.PageIndex] = Self) then inherited WMPaint(Msg); end else inherited WMPaint(Msg); end; {------------------------------------------------------------------------------ procedure TCustomPage.SetParent(AParent: TWinControl); Set parent wincontrol. ------------------------------------------------------------------------------} procedure TCustomPage.SetParent(AParent: TWinControl); var OldParent: TWinControl; ParentNotebook: TCustomNotebook; i: integer; begin if (AParent=Parent) or (pfInserting in FFlags) then Exit; CheckNewParent(AParent); OldParent := Parent; if (OldParent <> AParent) and (OldParent <> nil) and (OldParent is TCustomNotebook) and (not (pfRemoving in FFlags)) then begin // remove from old pagelist ParentNotebook := TCustomNotebook(OldParent); i := PageIndex; if i >= 0 then ParentNotebook.RemovePage(i); end; inherited SetParent(AParent); if (OldParent <> AParent) and (Parent <> nil) and (Parent is TCustomNotebook) then begin // add to new pagelist ParentNotebook:=TCustomNotebook(Parent); i := ParentNotebook.PageList.IndexOf(Self); if i < 0 then ParentNotebook.InsertPage(Self, ParentNotebook.PageCount); end; end; {------------------------------------------------------------------------------ procedure TCustomPage.CMHitTest(var Message: TLMNCHITTEST); ------------------------------------------------------------------------------} procedure TCustomPage.CMHitTest(var Message: TLMNCHITTEST); begin if (Parent<>nil) and (Parent is TCustomNotebook) and (TCustomNotebook(Parent).ActivePageComponent <> Self) then Message.Result := 0 // no hit else inherited CMHitTest(Message); {DebugLn('TCustomPage.CMHitTest A ',Name,' ',(Parent<>nil),' ', (Parent is TCustomNotebook),' ', (TCustomNotebook(Parent).ActivePageComponent<>Self), ' Message.Result=',Message.Result);} end; {------------------------------------------------------------------------------ function TCustomPage.PageIndex: integer; Returns the index of the page in the notebook. ------------------------------------------------------------------------------} function TCustomPage.GetPageIndex: integer; begin if (Parent<>nil) and (Parent is TCustomNotebook) then Result := TCustomNotebook(Parent).PageList.IndexOf(Self) else Result := -1; end; procedure TCustomPage.SetPageIndex(AValue: Integer); begin if (Parent <> nil) and (Parent is TCustomNotebook) then TCustomNotebook(Parent).MoveTab(Self,AValue); //DebugLn('TCustomPage.SetPageIndex Old=',dbgs(PageIndex),' New=',dbgs(AValue)); end; function TCustomPage.DialogChar(var Message: TLMKey): boolean; begin Result := False; if (not (csDesigning in ComponentState)) and IsAccel(Message.CharCode, Caption) and TabVisible then begin Result := True; if (Parent <> nil) and (Parent is TCustomNotebook) then TCustomNotebook(Parent).PageIndex := PageIndex; end else Result := inherited DialogChar(Message); end; procedure TCustomPage.DoHide; begin if Assigned(FOnHide) then FOnHide(Self); end; procedure TCustomPage.DoShow; begin if Assigned(FOnShow) then FOnShow(Self); end; procedure TCustomPage.DestroyHandle; begin inherited DestroyHandle; Exclude(FFlags,pfAdded); end; procedure TCustomPage.RealSetText(const AValue: TCaption); begin if (Parent <> nil) and Parent.HandleAllocated and (not (csLoading in ComponentState)) then begin WSSetText(AValue); InvalidatePreferredSize; inherited RealSetText(AValue); AdjustSize; end else inherited RealSetText(AValue); end; function TCustomPage.IsControlVisible: Boolean; begin if Parent is TCustomNotebook then Result := (PageIndex = TCustomNotebook(Parent).PageIndex) else Result := inherited IsControlVisible; end; function TCustomPage.HandleObjectShouldBeVisible: boolean; begin if Parent is TCustomNotebook then Result := (PageIndex = TCustomNotebook(Parent).PageIndex) else Result := inherited HandleObjectShouldBeVisible; end; function TCustomPage.VisibleIndex: integer; // returns the visible index, as if TabVisible=true var List: TList; i: Integer; begin if (Parent <> nil) and (Parent is TCustomNotebook) then begin Result := 0; List := TCustomNotebook(Parent).PageList; i := 0; repeat if i = List.Count then exit(-1); if (TObject(List[i]) = Self) then exit; if TCustomPage(List[i]).TabVisible or (csDesigning in ComponentState) then inc(Result); inc(i); until False; end else Result := -1; end; {------------------------------------------------------------------------------ function TCustomPage.CanTab: boolean; ------------------------------------------------------------------------------} function TCustomPage.CanTab: boolean; begin Result := False; end; function TCustomPage.AutoSizeDelayed: boolean; begin Result := (not (pfAdded in FFlags)) or (inherited AutoSizeDelayed); end; // included by extctrls.pp