⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 spagecontrol.pas

📁 Alpha Controls 界面控件包
💻 PAS
📖 第 1 页 / 共 4 页
字号:
var
  r : TRect;
begin
  Result := Rect(0, 0, Width, Height);
  if Tabs.Count > 0 then begin
    AdjustClientRect(r);
    case TabPosition of
      tpTop : Result.Bottom := R.Top - TopOffset;
      tpBottom : Result.Top := R.Bottom + BottomOffset;
      tpLeft : Result.Right := R.Left - LeftOffset;
      tpRight : Result.Left := R.Right + RightOffset;
    end;
  end;
end;

procedure TsPageControl.UpdateActivePage;
var
  DC, SavedDC : hdc;
  PS : TPaintStruct;
begin
  Curitem := -1;
  if FCommonData.Skinned then begin
    inherited;
    if FCommonData.Updating then Exit;
    if StoredVisiblePageCount <> VisibleTabsCount then begin // v4.32
      Perform(WM_PAINT, 0, 0);
      if Assigned(ActivePage) then ActivePage.Repaint
    end
    else begin
      FCommonData.BGChanged := False; // v4.31
      if ActivePage <> nil then begin // Active tab repainting
        BeginPaint(Handle, PS);
        DC := GetDC(Handle);
        SavedDC := SaveDC(DC);
        RepaintTabs(DC, ActivePage.PageIndex); // v4.32
        try DrawSkinTab(ActivePage.PageIndex, 2, DC)
        finally
          RestoreDC(DC, SavedDC);
          ReleaseDC(Handle, DC);
          EndPaint(Handle, PS);
        end;
        ActivePage.Repaint;
      end else FCommonData.Invalidate; // v4.43
    end;
    TabsChanging := False;
  end
  else inherited;
end;

procedure TsPageControl.UpdateUpDown;
var
  i, j : integer;
begin
  if UpDown = nil then Exit;
  UpDown.Left := Width - UpDown.Width;
  // v4.43
  if TabPosition = tpTop then UpDown.Top := 0 else UpDown.Top := Height - UpDown.Height;
  j := 0;
  for i := 0 to PageCount - 1 do begin
    if Pages[i].TabVisible and (TabRect(i).Left > 0) then Break else inc(j);
  end;
  UpDown.Max := GetInvisibleItemCount;
  UpDown.Position := j;
end;

function TsPageControl.VisibleTabsCount: integer;
var
  i : integer;
begin
  Result := 0;
  for i := 0 to PageCount - 1 do if Pages[i].TabVisible then inc(Result);
end;

procedure TsPageControl.WMPaint(var Message: TWMPaint);
var
  DC, SavedDC, SavedDC2, TabDC : hdc;
  PS : TPaintStruct;
  ci : TCacheInfo;
  R : TRect;
  i : integer;
begin
  if not FCommonData.Skinned or (csDestroying in Parent.ComponentState) or (csLoading in ComponentState) then begin inherited; Exit end;
  SavedDC := 0;
  TabDC := 0;

  BeginPaint(Handle, PS);
  try
  FCommonData.Updating := FCommonData.Updating;
  if not FCommonData.Updating and not TabsChanging then begin
    if Message.Unused = 1 then DC := Message.DC else begin
      DC := GetDC(Handle);
      SavedDC := SaveDC(DC);
    end;
    try begin
        // If transparent and form resizing processed
        FCommonData.BGChanged := FCommonData.BGChanged or FCommonData.HalfVisible or GetBoolMsg(Parent, AC_GETHALFVISIBLE);
        FCommonData.HalfVisible := not (PtInRect(Parent.ClientRect, Point(Left, Top)) and
                                 PtInRect(Parent.ClientRect, Point(Left + Width, Top + Height)));
        if FCommonData.SkinSection = s_PageControl then case TabPosition of
          tpTop :    ChangedSkinSection := s_PageControl;
          tpLeft :   ChangedSkinSection := s_PageControl + 'LEFT';
          tpRight :  ChangedSkinSection := s_PageControl + 'RIGHT';
          tpBottom : ChangedSkinSection := s_PageControl + 'BOTTOM';
        end
        else ChangedSkinSection := FCommonData.SkinSection;
        FCommonData.SkinIndex := FCommonData.SkinManager.GetSkinIndex(ChangedSkinSection);

        CI := GetParentCache(FCommonData);

        FCommonData.InitCacheBmp;
        if FCommonData.BGChanged then begin
          if Tabs.Count > 0 then DrawSkinTabs(CI);
          R := PageRect;
          CtrlParentColor := ColorToRGB(TsHackedControl(Parent).Color);
          PaintItem(FCommonData.SkinIndex, ChangedSkinSection, CI, False, 0, R, Point(Left + R.Left, Top + r.Top), FCommonData.FCacheBmp, FCommonData.SkinManager);
          CtrlParentColor := clFuchsia;
          FCommonData.BGChanged := False;
        end;
        if (Tabs.Count > 0) and (ActivePage <> nil) then begin
          R := SkinTabRect(ActivePage.TabIndex, True);
          TabDC := SaveDC(DC);
          ExcludeClipRect(DC, R.Left, R.Top, R.Right, R.Bottom); // ???
        end;
        SavedDC2 := 0;
        if FShowCloseBtns then begin
          SavedDC2 := SaveDC(DC);
          for i := 0 to PageCount - 1 do if Pages[i].TabVisible and TsTabSheet(Pages[i]).UseCloseBtn and (Pages[i] <> ActivePage) then begin
            R := SkinTabRect(Pages[i].TabIndex, False);
            ExcludeClipRect(DC, R.Right - BtnWidth - BtnOffs, R.Top + BtnOffs, R.Right - BtnOffs, R.Top + BtnHeight + BtnOffs);
          end;
        end;
        CopyWinControlCache(Self, FCommonData,  Rect(0, 0, 0, 0), Rect(0, 0, Width, Height), DC, True); //v4.43
        if FShowCloseBtns then RestoreDC(DC, SavedDC2);
        PaintButtons(DC);
        sVCLUtils.PaintControls(DC, Self, True, Point(0, 0)); // Painting of the skinned TGraphControls
        if (Tabs.Count > 0) and (ActivePage <> nil) then begin
          RestoreDC(DC, TabDC);
          if Message.Unused <> 1 then begin
            RestoreDC(DC, SavedDC);
            SavedDC := SaveDC(DC);
          end;
          DrawSkinTab(ActivePage.PageIndex, 2, DC);
          if Message.Unused = 1 then begin
            SavedDC := SaveDC(TWMPaint(Message).DC);
            MoveWindowOrg(TWMPaint(Message).DC, ActivePage.Left, ActivePage.Top);
          end;
          ActivePage.Perform(WM_PAINT, longint(Message.DC), Message.Unused); // v4.51
          if Message.Unused = 1 then begin
            RestoreDC(TWMPaint(Message).DC, SavedDC);
          end;
        end;
      end;
    finally
      if Message.Unused = 0 then begin
        RestoreDC(DC, SavedDC);
        ReleaseDC(Handle, DC);
      end;
    end;
  end
  finally
    EndPaint(Handle, PS);
  end;
  StoredVisiblePageCount := VisibleTabsCount;
end;

procedure TsPageControl.WndProc(var Message: TMessage);
var
  DC, SavedDC : hdc;
  R : TRect;
  p : TPoint;
  NewItem, i : integer;
  b : boolean;
  Act : TacCloseAction;
  SavedDC2 : hdc;
begin
{$IFDEF LOGGED}
  AddToLog(Message);
{$ENDIF}
  if (Message.Msg = cardinal(SM_ALPHACMD)) and Assigned(FCommonData) then case Message.WParamHi of
    AC_CTRLHANDLED : begin Message.LParam := 1 end; // AlphaSkins supported
    AC_GETAPPLICATION : begin Message.Result := longint(Application); Exit end;
    AC_REMOVESKIN : begin
      if Message.LParam = LongInt(SkinData.SkinManager) then begin
        CommonWndProc(Message, FCommonData);
        CheckUpDown;
        ArrangeButtons;
        RedrawWindow(Handle, nil, 0, RDW_ERASE + RDW_INVALIDATE + RDW_UPDATENOW + RDW_FRAME);
        if (UpDown <> nil) and UpDown.Visible then SendMessage(UpDown.Handle, WM_PRINT, Message.WParam, Message.LParam);
      end;
      AlphaBroadcast(Self, Message)
    end;
    AC_REFRESH : begin
      if (Message.LParam = LongInt(SkinData.SkinManager)) then begin
        CommonWndProc(Message, FCommonData);
        if Showing then begin
          RedrawWindow(Handle, nil, 0, RDW_ERASE + RDW_INVALIDATE + RDW_UPDATENOW + RDW_FRAME);
          Perform(WM_PAINT, 0, 0);
        end;
        if ActivePage <> nil then AddToAdapter(ActivePage);
        CheckUpDown;
        ArrangeButtons;
        if (UpDown <> nil) then UpdateUpDownRgn(True);
      end;
      AlphaBroadcast(Self, Message);
      Exit;
    end;
    AC_SETNEWSKIN : begin
      AlphaBroadcast(Self, Message);
      if (Message.LParam = LongInt(SkinData.SkinManager)) then begin
        CommonWndProc(Message, FCommonData);
      end;
      UpdateBtnData;
      Exit;
    end;
    AC_PREPARING : begin
      Message.LParam := integer(SkinData.Updating or TabsChanging or SkinData.BGChanged); // To optimize here !!!
      Exit;
    end;
    AC_ENDPARENTUPDATE : if FCommonData.Updating then begin // To optimize here !!! v4.35
      FCommonData.Updating := False;
      Perform(WM_PAINT, 0, 0);
      Perform(WM_NCPAINT, 0, 0);
    end;
    AC_GETCACHE : if FCommonData.Skinned then begin
      GlobalCacheInfo.X := 0;
      GlobalCacheInfo.Y := 0;
      if SkinData.Skinned
        then GlobalCacheInfo.Bmp := FCommonData.FCacheBmp
        else GlobalCacheInfo.Bmp := nil;
      GlobalCacheInfo.Ready := GlobalCacheInfo.Bmp <> nil;
    end;
    AC_PREPARECACHE : ;
  end
  else if FCommonData.Skinned(True) then case Message.Msg of
    WM_KILLFOCUS, WM_SETFOCUS : if not (csDesigning in ComponentState) then begin
      b := FCommonData.BGChanged;
      inherited;
      FCommonData.BGChanged := b;
      Exit;
    end else exit;
    WM_MOUSELEAVE, CM_MOUSELEAVE : if not (csDesigning in ComponentState) and (HotTrack or FShowCloseBtns) and (CurItem <> -1) and (CurItem <> ActivePage.TabIndex) then begin
      if HotTrack then RepaintTab(CurItem, 0);
      if FShowCloseBtns and TsTabSheet(Pages[CurItem]).UseCloseBtn then PaintButtonEx(CurItem, 0, 0);
      acBtnPressed := False;
      CurItem := -1;
      Exit;
    end;
    WM_MOUSEMOVE : if not (csDesigning in ComponentState) then begin
      b := (HotTrack or (Style <> tsTabs));
      if b or FShowCloseBtns then begin
        p.x := TCMHitTest(Message).XPos; p.y := TCMHitTest(Message).YPos;
        if PtInRect(TabsRect, p) then begin
          Application.ProcessMessages;
          NewItem := GetTabUnderMouse(p);
          if (NewItem <> CurItem) then begin // if changed
            if (CurItem <> -1) and (HotTrack or FShowCloseBtns) then begin
              if b then RepaintTab(CurItem, 0);
              PaintButtonEx(CurItem, 0, 0);
            end;
            inherited;
            CurItem := NewItem;
            if (CurItem <> -1) and (HotTrack or FShowCloseBtns) then begin
              if (CurItem <> ActivePage.TabIndex) then begin
                if b then RepaintTab(CurItem, 1);
              end
              else begin
                CurItem := -1;
                acBtnPressed := False;
                if FShowCloseBtns and PtInRect(BtnRect(ActivePage.TabIndex), p) then begin
                  PaintButtonEx(ActivePage.TabIndex, 1, 2);
                  Exit;
                end;
              end;
            end;
            if FShowCloseBtns and (CurItem <> -1) and PtInRect(BtnRect(CurItem), p) then begin
              PaintButtonEx(CurItem, 1, 1);
              Exit;
            end;
          end
          else begin
            if FShowCloseBtns and (CurItem <> -1) then begin
              PaintButtonEx(CurItem, integer(PtInRect(BtnRect(CurItem), p)), 1);
              Exit;
            end;
          end;
        end
        else if (CurItem <> -1) then begin
          if b then RepaintTab(CurItem, 0);
          PaintButtonEx(CurItem, 0, 0);
          CurItem := -1;
          acBtnPressed := False;
        end;
      end;
    end;
    WM_LBUTTONUP, WM_LBUTTONDOWN : if not (csDesigning in ComponentState) and FShowCloseBtns then begin
      p.x := TCMHitTest(Message).XPos; p.y := TCMHitTest(Message).YPos;
      if PtInRect(TabsRect, p) then begin
        for i := 0 to PageCount - 1 do begin
          R := SkinTabRect(i, Pages[i] = ActivePage);
          if PtInRect(R, p) then begin
            if TsTabSheet(Pages[i]).UseCloseBtn then begin
              if PtInRect(Rect(R.Right - BtnWidth - BtnOffs, R.Top + BtnOffs, R.Right - BtnOffs, R.Top + BtnHeight + BtnOffs), p) then begin
                PaintButtonEx(i, 1 + integer(WM_LBUTTONDOWN = Message.Msg), 1 + integer(ActivePage = Pages[i]));
                if (WM_LBUTTONUP = Message.Msg) then begin
                  if not acBtnPressed then Exit;
                  b := True;
                  Act := acaFree;
                  if Assigned(OnCloseBtnClick) then OnCloseBtnClick(Self, i, b, Act);
                  if b then begin
                    if Pages[i] <> nil then begin
                      Perform(WM_SETREDRAW, 0, 0);
                      if Act = acaFree then Pages[i].Free else Pages[i].TabVisible := False;
                      Perform(WM_SETREDRAW, 1, 0);
                      FCommonData.BGChanged := True;
                      RedrawWindow(Handle, nil, 0, RDW_ERASE or RDW_INVALIDATE or RDW_UPDATENOW);
                    end;
                  end;
                  acBtnPressed := False;
                end else acBtnPressed := True;
                Exit;
              end;
            end;
          end;
        end;
      end;
    end;
  end;
  if Assigned(FCommonData) and FCommonData.Skinned then begin
    CommonWndProc(Message, FCommonData);
    case Message.Msg of
      WM_PRINT : begin
        CheckUpDown;
        ArrangeButtons;
        SkinData.Updating := False;
        SendMessage(Handle, WM_PAINT, longint(TWMPaint(Message).DC), 1);
        Exit;
      end;
      WM_NCPAINT : if ActivePage <> nil then begin
        FCommonData.Updating := FCommonData.Updating;
        if FCommonData.Updating then Exit;
        DC := GetDC(Handle);
        SavedDC := SaveDC(DC);
        try
          R := TabsRect;
          ExcludeClipRect(DC, R.Left, R.Top, R.Right, R.Bottom);
          R := ActivePage.BoundsRect;
          ExcludeClipRect(DC, R.Left, R.Top, R.Right, R.Bottom);
          if (Tabs.Count > 0) and (ActivePage <> nil) then begin
            R := SkinTabRect(ActivePage.TabIndex, True);
            ExcludeClipRect(DC, R.Left, R.Top, R.Right, R.Bottom); // ???
          end;
          CopyWinControlCache(Self, FCommonData,  Rect(0, 0, 0, 0), Rect(0, 0, Width, Height), DC, True);
        finally
          RestoreDC(DC, SavedDC);
          ReleaseDC(Handle, DC);
        end;
      end;
      TCM_SETCURSEL : SkinData.BGChanged := True;
      WM_ERASEBKGND : begin Exit end;
      WM_STYLECHANGED, WM_STYLECHANGING, WM_HSCROLL : begin FCommonData.BGChanged := True; Repaint end;
      TCM_SETITEMSIZE : TabsChanging := True;
    end;
  end;
  inherited;
  if Assigned(FCommonData) and FCommonData.Skinned then begin
    case Message.Msg of
      WM_PARENTNOTIFY : if (Message.WParam and $FFFF = WM_CREATE) or (Message.WParam and $FFFF = WM_DESTROY) then begin
        if Message.WParamLo = WM_CREATE then AddToAdapter(Self);
      end;
      CM_CONTROLLISTCHANGE : begin
        CheckUpDown;
        ArrangeButtons;
      end;
      WM_SIZE : if not (csLoading in ComponentState) then begin
        CheckUpDown;
        ArrangeButtons;
      end;
      TCM_DELETEITEM : if not SkinData.Updating then begin
        SkinData.BGChanged := True;
      end;
      WM_LBUTTONDOWN : if (Style <> tsTabs) and (CurItem <> -1) then begin
        RepaintTab(CurItem, 1);
      end;
      WM_WINDOWPOSCHANGING : if TabsChanging then begin
        if not FCommonData.Updating then begin
          DC := GetDC(Handle);
          SavedDC := SaveDC(DC);
          try
            R := TabsRect; // Instant restoring of BG
            BitBlt(DC, R.Left, R.Top, WidthOf(R), HeightOf(R), FCommonData.FCacheBmp.Canvas.Handle, R.Left, R.Top, SRCCOPY);
            // Preparing of new tabs
            if Tabs.Count > 0 then DrawSkinTabs(GetParentCache(FCommonData));

            R := TabsRect;
            SavedDC2 := 0;
            if FShowCloseBtns then begin
              SavedDC2 := SaveDC(DC);
              for i := 0 to PageCount - 1 do if Pages[i].TabVisible and TsTabSheet(Pages[i]).UseCloseBtn and (Pages[i] <> ActivePage) then begin
                R := SkinTabRect(Pages[i].TabIndex, False);
                ExcludeClipRect(DC, R.Right - BtnWidth - BtnOffs, R.Top + BtnOffs, R.Right - BtnOffs, R.Top + BtnHeight + BtnOffs);
              end;
            end;
            CopyWinControlCache(Self, FCommonData,  Rect(R.Left, R.Top, R.Left, R.Top), R, DC, False);
            if FShowCloseBtns then RestoreDC(DC, SavedDC2);

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -