spagecontrol.pas

AlphaControls是一个Delphi标准控件的集合

procedure TsTabSheet.Loaded;
begin
  inherited Loaded;
  CommonData.Loaded;
end;

procedure TsTabSheet.WMEraseBkGND(var Message: TWMPaint);
begin
  if not Assigned(PageControl) or PageControl.Skinable // IsValidSkinIndex(FCommonData.SkinIndex) 
    then Message.Result := 1
    else inherited;
end;

procedure TsTabSheet.VisibleChanging;
begin
  if Assigned(PageControl) and PageControl.Skinable then begin
    SetControlChanged(PageControl, True);
    SendMessage(PageControl.Handle, CM_INVALIDATE, 0, 0);
  end;
  inherited;
end;

{ TsPageControl }

constructor TsPageControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle - [csOpaque];
  FPages := TList.Create;
  DrawShadows := True;
  FCommonData.BGChanged := True;
end;

procedure TsPageControl.WMPaint(var Message: TWMPaint);
var
  SaveIndex: Integer;
  DC: HDC;
  PS: TPaintStruct;
  ci : TCacheInfo;
  BorderIndex : integer;
  r : TRect;
  sc : TsGenStyle;
  procedure PaintSheet;
  var
    i : integer;
  begin
    if Assigned(ActivePage) and ActivePage.Visible then begin // Drawing of the active tabsheet
      CI.Bmp := FCommonData.FCacheBmp; CI.X := ActivePage.Left; CI.Y := ActivePage.Top; CI.Ready := True;
      r := PageRect;
      PaintItem(ActivePage.FCommonData.SkinIndex, ActivePage.FCommonData.SkinSection, CI, False, 0, R, Point(ActivePage.Left, ActivePage.Top), FCommonData.FCacheBmp);
      if DrawShadows then
        for i := 0 to ActivePage.ControlCount - 1 do begin
          if (csDestroying in ActivePage.Controls[i].ComponentState) then break;
          sc := GetsStyle(ActivePage.Controls[i]);
          if Assigned(sc) and (sc.SkinIndex > -1) and gd[sc.SkinIndex].ShadowEnabled and ActivePage.Controls[i].Visible then begin
            sc.PaintShadow(FCommonData.FCacheBmp.Canvas, ActivePage.Left, ActivePage.Top);
          end;
        end;
    end;
  end;
begin
  if DrawingLock or
       (csDestroying in ComponentState) or
         (csLoading in ComponentState) or
           (csReading in ComponentState) or
             not (Visible or (csDesigning in ComponentState)) then Exit;
  if Assigned(ActivePage) then ActivePage.BGChanged := FCommonData.BGChanged;
  if FCommonData.Skinned then begin
    Skinable := True;
    UpdateTabRects;

    Message.Result := 1;
    ci := GetParentCache(FCommonData);
    FCommonData.InitCacheBmp;
    case TabPosition of
      tpTop : begin ChangedSkinSection := FCommonData.SkinSection; end;
      tpLeft : begin ChangedSkinSection := FCommonData.SkinSection + 'LEFT'; end;
      tpRight : begin ChangedSkinSection := FCommonData.SkinSection + 'RIGHT'; end;
      tpBottom : begin ChangedSkinSection := FCommonData.SkinSection + 'BOTTOM'; end;
    end;
    FCommonData.SkinIndex := GetSkinIndex(ChangedSkinSection);
    BorderIndex := GetMaskIndex(FCommonData.SkinIndex, ChangedSkinSection, BordersMasK);
    if IsValidImgIndex(BorderIndex) and IsValidSkinIndex(FCommonData.SkinIndex) then begin
      if FCommonData.BGChanged then begin
        if Tabs.Count > 0 then DrawSkinTabs(CI);
        R := PageRect;
        PaintItem(FCommonData.SkinIndex, ChangedSkinSection, CI, False, 0, PageRect, Point(Left + R.Left, Top + R.Top), FCommonData.FCacheBmp);
        if Tabs.Count > 0 then DrawSkinTab(ActiveTabIndex, 1);
        PaintSheet;
        FCommonData.BGChanged := False;
      end;
      DC := Message.DC; if DC = 0 then DC := BeginPaint(Handle, PS);
      SaveIndex := SaveDC(DC);
      try
        FCommonData.CopyFromCache(DC, 0, 0, Width, Height);
      finally
        RestoreDC(DC, SaveIndex);
        if Message.DC = 0 then EndPaint(Handle, PS);
      end;
      if Assigned(ActivePage) then begin
        ActivePage.Repaint;
      end;
    end else inherited;
  end else begin
    Skinable := False;
    inherited;
  end;
end;

procedure TsPageControl.Change;
//var
//  Form: TCustomForm;
begin
  if not (csDestroying in ComponentState) {and not (csReading in ComponentState)} then 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;
end;

function TsPageControl.GetPage(Index: Integer): TsTabSheet;
begin
  Result := FPages[Index];
end;

function TsPageControl.GetPageCount: Integer;
begin
  Result := FPages.Count;
end;

function TsPageControl.GetActivePageIndex: Integer;
begin
  if ActivePage <> nil
    then Result := ActivePage.GetPageIndex
    else Result := -1;
end;

procedure TsPageControl.SetActivePage(Page: TsTabSheet);
begin
//  if (csReading in ComponentState) then Exit;
//  if FUpdating then Exit;
  if (Page <> nil) and (Page.PageControl <> Self) then Exit;
  if Page = nil
    then TabIndex := -1
    else TabIndex := Page.TabIndex;
  ChangeActivePage(Page);
  if csDesigning in ComponentState {in designing page don't repainted automatically} then Repaint;
end;

procedure TsPageControl.SetActivePageIndex(const Value: Integer);
begin
//  if (csReading in ComponentState) then Exit;
  if (Value > -1) and (Value < PageCount) then begin
    ActivePage := Pages[Value];
    Change;
  end
  else ActivePage := nil;
end;

procedure TsPageControl.RemovePage(Page: TsTabSheet);
var
  NextSheet: TsTabSheet;
begin
  NextSheet := nil;
  if not (csDestroying in ComponentState) then begin
    NextSheet := FindNextPage(Page, True, not (csDesigning in ComponentState));
    if NextSheet = Page then NextSheet := nil;
    Page.SetTabShowing(False);
  end;
  Page.FPageControl := nil;
  FPages.Remove(Page);
  if not (csDestroying in ComponentState) then begin
    SetActivePage(NextSheet);
  end;
end; 

procedure TsPageControl.UpdateTab(Page: TsTabSheet);
begin
  Tabs[Page.TabIndex] := Page.Caption;
end;

procedure TsPageControl.DeleteTab(Page: TsTabSheet; Index: Integer);
var
  UpdateIndex: Boolean;
begin
  UpdateIndex := (Page = ActivePage) and not (csDestroying in ComponentState);
  Tabs.Delete(Index);
  if UpdateIndex then begin
    if Index >= Tabs.Count then Index := Tabs.Count - 1;
    TabIndex := Index;
  end;
  UpdateActivePage;
end;

procedure TsPageControl.InsertPage(Page: TsTabSheet);
begin
  FPages.Add(Page);
  Page.FPageControl := Self;
  Page.SendToBack;
  Page.ControlStyle := [csAcceptsControls, csClickEvents, {csOpaque, }csDoubleClicks];
  Page.UpdateTabShowing;
end;

procedure TsPageControl.InsertTab(Page: TsTabSheet);
begin
  Tabs.InsertObject(Page.TabIndex, Page.Caption, Page);
  UpdateActivePage;
end;

procedure TsPageControl.MoveTab(CurIndex, NewIndex: Integer);
begin
  Tabs.Move(CurIndex, NewIndex);
end;

procedure TsPageControl.ChangeActivePage(Page: TsTabSheet);
var
  ParentForm: TCustomForm;
  OldPage : TsTabSheet;
begin
  if FActivePage <> Page then begin
    DrawingLock := True;
    DrawShadows := False;
    OldPage := FActivePage;
    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;

    FActivePage := Page;

    if OldPage <> nil then OldPage.Visible := False;
    if Page <> nil then begin
      if csDesigning in ComponentState then Page.BringToFront;
      Page.Visible := True;
      if (ParentForm <> nil) and (FActivePage <> nil) and (ParentForm.ActiveControl = FActivePage) then begin
        if Page.CanFocus
          then ParentForm.ActiveControl := Page
          else ParentForm.ActiveControl := Self;
      end;
    end;
    if not RestrictDrawing then FCommonData.BGChanged := True;
    if (ParentForm <> nil) and (FActivePage <> nil) and (ParentForm.ActiveControl = FActivePage) then FActivePage.SelectFirst;
    DrawingLock := False;
    DrawShadows := True;
  end;
end;

function TsPageControl.FindNextPage(CurPage: TsTabSheet; GoForward, CheckTabVisible: Boolean): TsTabSheet;
var
  I, StartIndex: Integer;
begin
  if FPages.Count <> 0 then begin
    StartIndex := FPages.IndexOf(CurPage);
    if StartIndex = -1 then begin
      if GoForward then StartIndex := FPages.Count - 1 else StartIndex := 0;
    end;
    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 TsPageControl.UpdateActivePage;
begin
//  if csReading in ComponentState then Exit;
  if OwnCalc then begin
    if TabIndex >= 0
      then SetActivePage(TsTabSheet(Tabs.Objects[TabIndex]))
      else SetActivePage(nil);
  end
  else begin
    if TabIndex >= 0
      then SetActivePage(TsTabSheet(Tabs.Objects[TabIndex]))
      else SetActivePage(nil);
  end;
end;

destructor TsPageControl.Destroy;
var
  I: Integer;
begin
  for I := 0 to FPages.Count - 1 do TsTabSheet(FPages[I]).FPageControl := nil;
  if Assigned(FPages) then FreeAndNil(FPages);
  inherited Destroy;
end;

procedure TsPageControl.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 TsPageControl.CMDialogKey(var Message: TCMDialogKey);
begin
  if (FCommonData.FFocused 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 TsPageControl.CMDockClient(var Message: TCMDockClient);
var
  IsVisible: Boolean;
  DockCtl: TControl;
begin
  Message.Result := 0;
  FNewDockSheet := TsTabSheet.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 TsPageControl.CMDockNotification(var Message: TCMDockNotification);
var
  I: Integer;
  S: string;
  Page: TsTabSheet;
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: Page.TabVisible := Boolean(Message.NotifyRec.MsgWParam);
    end;
  inherited;
end;

procedure TsPageControl.CMUnDockClient(var Message: TCMUnDockClient);
var
  Page: TsTabSheet;
begin
  Message.Result := 0;
  Page := GetPageFromDockClient(Message.Client);
  if Page <> nil then
  begin
    FUndockingPage := Page;
    Message.Client.Align := alNone;
  end;
end;

procedure TsPageControl.WMLButtonDblClk(var Message: TWMLButtonDblClk);
var