spagecontrol.pas

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

  DockCtl: TControl;
begin
  inherited;
  DockCtl := GetDockClientFromMousePos(SmallPointToPoint(Message.Pos));
  if DockCtl <> nil then DockCtl.ManualDock(nil, nil, alNone);
end;

procedure TsPageControl.WMLButtonDown(var Message: TWMLButtonDown);
var
  DockCtl: TControl;
  i : integer;
  m : TWMLButtonDown;
begin
  m := Message;
  if OwnCalc then begin
    if Assigned(OnMouseDown) then OnMouseDown(Self, mbLeft, [], m.XPos, m.YPos);
    i := IndexOfSkinTab(m.XPos, m.YPos);
    if (i > -1) and CanChange and (TabIndex <> i) then begin
      DrawShadows := False;
      TabIndex := i;
      SetActivePageIndex(i);
      DrawShadows := True;
    end;
    if not (csDesigning in ComponentState) and not Focused then SetFocus;
  end
  else inherited;
  DockCtl := GetDockClientFromMousePos(SmallPointToPoint(Message.Pos));
  if (DockCtl <> nil) and (Style = tsTabs) then DockCtl.BeginDrag(False);
end;

procedure TsPageControl.SelectNextPage(GoForward: Boolean);
var
  Page: TsTabSheet;
begin
  Page := FindNextPage(ActivePage, GoForward, True);
  if (Page <> nil) and (Page <> ActivePage) and CanChange then begin
    TabIndex := Page.TabIndex;
    Change;
  end;
end;

function TsPageControl.GetPageFromDockClient(Client: TControl): TsTabSheet;
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 TsPageControl.GetDockClientFromMousePos(MousePos: TPoint): TControl;
var
  i, HitIndex: Integer;
  HitTestInfo: TTCHitTestInfo;
  Page: TsTabSheet;
begin
  Result := nil;
  if DockSite then
  begin
    HitTestInfo.pt := MousePos;
    HitIndex := SendMessage(Handle, TCM_HITTEST, 0, Longint(@HitTestInfo));
    if HitIndex >= 0 then begin
      Page := nil;
      for i := 0 to HitIndex do 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;

function TsPageControl.CanShowTab(TabIndex: Integer): Boolean;
begin
  Result := TsTabSheet(FPages[ActualIndex(TabIndex)]).Enabled; //!!!
end;

procedure TsPageControl.DoAddDockClient(Client: TControl; const ARect: TRect);
begin
  if FNewDockSheet <> nil then Client.Parent := FNewDockSheet;
end;

procedure TsPageControl.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 TsPageControl.DoRemoveDockClient(Client: TControl);
begin
  if (FUndockingPage <> nil) and not (csDestroying in ComponentState) then begin
    SelectNextPage(True);
    FUndockingPage.Free;
    FUndockingPage := nil;
  end;
end;

procedure TsPageControl.GetChildren(Proc: TGetChildProc; Root: TComponent);
var
  I: Integer;
begin
  for I := 0 to FPages.Count - 1 do Proc(TComponent(FPages[I]));
end;

function TsPageControl.GetImageIndex(TabIndex: Integer): Integer;
var
  I, Visible, NotVisible: Integer;
begin
  Result := -1;
  if csDestroying in ComponentState then Exit;
  if Assigned(OnGetImageIndex) then begin
    Result := inherited GetImageIndex(TabIndex)
  end
  else begin
   { For a PageControl, TabIndex refers to visible tabs only. The control
   doesn't store }
    Visible := 0;
    NotVisible := 0;
    for I := 0 to FPages.Count - 1 do begin
      if not GetPage(I).TabVisible then Inc(NotVisible) else Inc(Visible);
      if Visible = TabIndex + 1 then Break;
    end;
    Result := GetPage(TabIndex + NotVisible).ImageIndex;
  end;
end;

procedure TsPageControl.GetSiteInfo(Client: TControl; var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean);
begin
  CanDock := GetPageFromDockClient(Client) = nil;
  inherited GetSiteInfo(Client, InfluenceRect, MousePos, CanDock);
end;

procedure TsPageControl.Loaded;
begin
  inherited Loaded;
  UpdateTabHighlights;
  if ActivePage <> nil then SetActivePage(ActivePage);
end;

procedure TsPageControl.SetChildOrder(Child: TComponent; Order: Integer);
begin
  TTabSheet(Child).PageIndex := Order;
end;

procedure TsPageControl.ShowControl(AControl: TControl);
begin
  if (AControl is TsTabSheet) and (TsTabSheet(AControl).PageControl = Self) then SetActivePage(TsTabSheet(AControl));
  inherited ShowControl(AControl);
end;

procedure TsPageControl.UpdateTabHighlights;
var
  I: Integer;
begin
  for I := 0 to PageCount - 1 do Pages[I].SetHighlighted(Pages[I].FHighlighted);
end;

procedure TsPageControl.DrawSkinTab(Index, State: integer);
var
  rText, aRect{, rParent} : TRect;
  ActiveTabBorder, InActiveTabBorder : integer;
  VertFont : TLogFont;
  pFont : PLogFontA;
  i, h, w : integer;
  SkinIndex : integer;
  SkinSection : string;
  procedure MakeVertFont(Orient : integer);
  begin
    pFont := @VertFont;
    GetObject(FCommonData.FCacheBmp.Canvas.Handle, SizeOf(TLogFont), pFont);
    VertFont.lfEscapement := Orient;
    VertFont.lfHeight := Font.Height;
    VertFont.lfStrikeOut := integer(fsStrikeOut in Font.Style);
    VertFont.lfItalic := integer(fsItalic in Font.Style);
    VertFont.lfUnderline := integer(fsUnderline	in Font.Style);
    VertFont.lfWeight := 1 + integer(fsBold in Font.Style);
    VertFont.lfCharSet := Font.Charset;

    VertFont.lfWidth := 0;
    VertFont.lfOrientation := VertFont.lfEscapement;
    VertFont.lfPitchAndFamily := Default_Pitch;
    VertFont.lfQuality := Default_Quality;
    VertFont.lfFaceName := '';

    FCommonData.FCacheBmp.Canvas.Font.Handle := CreateFontIndirect(VertFont);
    FCommonData.FCacheBmp.Canvas.Font.Color := Font.Color;
  end;
  procedure KillVertFont;
  begin
    FCommonData.FCacheBmp.Canvas.Font.Assign(Font);
  end;
begin
  if Index = - 1 then Exit;
  aRect := SkinTabRect(Index);
  rText := aRect;

  case TabPosition of
    tpTop    : SkinSection := Pages[TabsArray[Index].Index].FCommonData.SkinSection;
    tpLeft   : SkinSection := Pages[TabsArray[Index].Index].FCommonData.SkinSection + 'LEFT';
    tpRight  : begin
      SkinSection := Pages[TabsArray[Index].Index].FCommonData.SkinSection + 'RIGHT';
    end;
    tpBottom : SkinSection := Pages[TabsArray[Index].Index].FCommonData.SkinSection + 'BOTTOM';
  end;
  SkinIndex := GetSkinIndex(SkinSection);

  ActiveTabBorder := GetMaskIndex(SkinIndex, SkinSection, ActiveTab);
  InActiveTabBorder := GetMaskIndex(SkinIndex, SkinSection, InActiveTab);

  if State = 1 then begin
    if IsValidImgIndex(ActiveTabBorder) then begin
      if (aRect.Left < 0) then Exit;
      if aRect.Right > Width then aRect.Right := Width - 1;
      if IsValidImgIndex(ActiveTabBorder) then DrawMaskRect(FCommonData.FCacheBmp, ma[ActiveTabBorder].Bmp, 0, aRect, ma[ActiveTabBorder].TransparentColor, True, EmptyCI);
    end;
  end
  else begin
    if IsValidImgIndex(InactiveTabBorder) then begin
      DrawMaskRect(FCommonData.FCacheBmp, ma[InactiveTabBorder].Bmp, 0, aRect, ma[InactiveTabBorder].TransparentColor, True, EmptyCI);
    end;
  end;

  if not OwnerDraw then begin
    case TabPosition of
      tpTop, tpBottom : begin
        FCommonData.FCacheBmp.Canvas.Font.Assign(Font);
        if (Images <> nil) and (TabsArray[Index].ImageIndex <= Images.Count - 1) then begin
          Images.Draw(FCommonData.FCacheBmp.Canvas,
                rText.Left + (WidthOf(rText) - (FCommonData.FCacheBmp.Canvas.TextWidth(TabsArray[Index].Caption) + Images.Width + 8)) div 2,
                rText.Top + (HeightOf(rText) - Images.Height) div 2,
                TabsArray[Index].ImageIndex,
                True);
          inc(rText.Left, WidthOf(GlyphRect));
          WriteTextEx(FCommonData.FCacheBmp.Canvas, PChar(TabsArray[Index].Caption),
                      Enabled, rText, DT_CENTER or ta_CENTER, FCommonData.SkinIndex, State <> 0);
        end
        else WriteTextEx(FCommonData.FCacheBmp.Canvas, PChar(TabsArray[Index].Caption), True, rText, DT_CENTER or ta_CENTER, FCommonData.SkinIndex, State <> 0);
        if FCommonData.FFocused and (Index = ActiveTabIndex) then begin
          InflateRect(rText, 1, 0);
          FocusRect(FCommonData.FCacheBmp.Canvas, rText);
        end;
      end;
      tpLeft : begin

        FCommonData.FCacheBmp.Canvas.Brush.Style := bsClear;
        MakeVertFont(900);

        h := FCommonData.FCacheBmp.Canvas.TextWidth(TabsArray[Index].Caption);
        w := FCommonData.FCacheBmp.Canvas.TextHeight(TabsArray[Index].Caption);

        if not Enabled then FCommonData.FCacheBmp.Canvas.Font.Color := clGray;
        if (Images <> nil) and (TabsArray[Index].ImageIndex > -1) and (TabsArray[Index].ImageIndex <= Images.Count - 1) then begin
          if Index = ActiveTabIndex then OffsetRect(rText, 2, 0);
          i := rText.Bottom - (HeightOf(rText) - (Images.Height + 4 + h)) div 2 - Images.Height;
          Images.Draw(FCommonData.FCacheBmp.Canvas,
                rText.Left + (WidthOf(rText) - Images.Width) div 2,
                i,
                TabsArray[Index].ImageIndex,
                Enabled);

          FCommonData.FCacheBmp.Canvas.Brush.Style := bsClear;
          FCommonData.FCacheBmp.Canvas.TextRect(rText,
                              rText.Left + (WidthOf(rText) - w) div 2,
                              i - 4,
                              PChar(TabsArray[Index].Caption));
          InflateRect(rText, (w - WidthOf(rText)) div 2, (h - HeightOf(rText)) div 2 + 2);
          OffsetRect(rText, 0, - (4 + Images.Height) div 2);
        end
        else begin
          FCommonData.FCacheBmp.Canvas.Brush.Style := bsClear;
          FCommonData.FCacheBmp.Canvas.TextRect(rText,
                              rText.Left + (WidthOf(rText) - w) div 2,
                              rText.Bottom - (HeightOf(rText) - h) div 2,
                              PChar(TabsArray[Index].Caption));
          InflateRect(rText, (w - WidthOf(rText)) div 2, (h - HeightOf(rText)) div 2);
        end;
        KillVertFont;
        if FCommonData.FFocused and (Index = ActiveTabIndex) then begin
          FocusRect(FCommonData.FCacheBmp.Canvas, rText);
        end;
      end;
      tpRight : begin
        FCommonData.FCacheBmp.Canvas.Brush.Style := bsClear;
        MakeVertFont(-900);

        OffsetRect(rText, -2, -1);

        h := FCommonData.FCacheBmp.Canvas.TextWidth(TabsArray[Index].Caption);
        w := FCommonData.FCacheBmp.Canvas.TextHeight(TabsArray[Index].Caption);
        if not Enabled then FCommonData.FCacheBmp.Canvas.Font.Color := clGray;
        if (Images <> nil) and (TabsArray[Index].ImageIndex > -1) and (TabsArray[Index].ImageIndex <= Images.Count - 1) then begin
          if Index = ActiveTabIndex then OffsetRect(rText, 2, 0);
          i := rText.Top + (HeightOf(rText) - (Images.Height + 4 + h)) div 2;//  Images.Height;
          Images.Draw(FCommonData.FCacheBmp.Canvas,
                rText.Left + (WidthOf(rText) - Images.Width) div 2,
                i,
                TabsArray[Index].ImageIndex,
                Enabled);

          FCommonData.FCacheBmp.Canvas.Brush.Style := bsClear;
          FCommonData.FCacheBmp.Canvas.TextRect(rText,
                              rText.Left + (WidthOf(rText) - w) div 2 + FCommonData.FCacheBmp.Canvas.TextHeight(TabsArray[Index].Caption),
                              i + 4 + Images.Height,
                              PChar(TabsArray[Index].Caption));
          InflateRect(rText, (w - WidthOf(rText)) div 2, (h - HeightOf(rText)) div 2 + 2);
          OffsetRect(rText, 0, + (4 + Images.Height) div 2);
        end
        else begin
          FCommonData.FCacheBmp.Canvas.Brush.Style := bsClear;
          FCommonData.FCacheBmp.Canvas.TextRect(rText,
                              rText.Left + (WidthOf(rText) - w) div 2 + FCommonData.FCacheBmp.Canvas.TextHeight(TabsArray[Index].Caption),
                              rText.Top + (HeightOf(rText) - h) div 2,
                              PChar(TabsArray[Index].Caption));
          InflateRect(rText, (w - WidthOf(rText)) div 2, (h - HeightOf(rText)) div 2 + 2);
        end;
        KillVertFont;
        if FCommonData.FFocused and (Index = ActiveTabIndex) then begin
          FocusRect(FCommonData.FCacheBmp.Canvas, rText);
        end;
      end;
    end;
  end
  else begin
    if Assigned(OnDrawTab) then OnDrawTab(Self, Index, aRect, Index = ActiveTabIndex);
  end;
end;

{
procedure TsPageControl.GlobalUpdate;
begin
  UpdateActivePage;
end;
}
procedure TsPageControl.WndProc(var Message: TMessage);
//var
//  i : integer;
begin
  case Message.Msg of
    SM_GETCACHE : begin
      Message.Result := 1;
      GlobalCacheInfo.X := PageRect.Left;
      GlobalCacheInfo.Y := PageRect.Top;
      if Skinable
        then GlobalCacheInfo.Bmp := FCommonData.FCacheBmp
        else GlobalCacheInfo.Bmp := nil;
      GlobalCacheInfo.Ready := GlobalCacheInfo.Bmp <> nil;
    end;
  end;
  if (Message.Result <> 1) and Assigned(FCommonData) then FCommonData.WndProc(Message);
  case Message.Msg of
    SM_REMOVESKIN : begin
      Skinable := False;
      FCommonData.BGChanged := True;
      Repaint;
      if Assigned(ActivePage) then ActivePage.Repaint;
    end;
    SM_REFRESH : begin
      FSavedTabIndex := TabIndex;

//      SetActivePage(ActivePage);
    end;
  end;
  if Message.Result <> 1 then inherited;
end;

procedure TsPageControl.AfterConstruction;
begin
  inherited;
end;

{procedure TsPageControl.SetTabIndex(Value: Integer);
begin
  FSavedTabIndex := Value * integer(ActualIndex(Value) <> -1);
  if OwnCalc then begin
    RebuildTabs;
    if not (csReadingState in ControlState) then begin
      FCommonData.BGChanged := True;
    end;
  end else SendMessage(Handle, TCM_SETCURSEL, Value, 0);
end;
}
end.