skintabs.pas

一套及时通讯的原码

                  SkinRect.Left + RTPoint.X - XO, SkinRect.Top + TOff));
  end;

  w := RBPoint.X - LBPoint.X;
  XCnt := (NewRBPoint.X - NewLBPoint.X) div w;
  for X := 0 to XCnt do
  begin
    if NewLBPoint.X + X * w + w > NewRBPoint.X
    then XO := NewLBPoint.X + X * w + w - NewRBPoint.X else XO := 0;
    Cnvs.CopyRect(Rect(R.Left + NewLBPoint.X + X * w, R.Bottom - BOff,
                  R.Left + NewLBPoint.X + X * w + w - XO, R.Bottom),
             Picture.Canvas,
             Rect(SkinRect.Left + LBPoint.X, SkinRect.Bottom - BOff,
                  SkinRect.Left + RBPoint.X - XO, SkinRect.Bottom));
  end;

  w := LOff;
  h := LBPoint.Y - LTPoint.Y;
  YCnt := (NewLBPoint.Y - NewLTPoint.Y) div h;
  for Y := 0 to YCnt do
  begin
    if NewLTPoint.Y + Y * h + h > NewLBPoint.Y
    then YO := NewLTPoint.Y + Y * h + h - NewLBPoint.Y else YO := 0;
    Cnvs.CopyRect(Rect(R.Left, R.Top + NewLTPoint.Y + Y * h,
                       R.Left + w, R.Top + NewLTPoint.Y + Y * h + h - YO),
                  Picture.Canvas,
                  Rect(SkinRect.Left, SkinRect.Top + LTPoint.Y,
                       SkinRect.Left + w, SkinRect.Top + LBPoint.Y - YO));
  end;
  w := ROff;
  h := RBPoint.Y - RTPoint.Y;
  YCnt := (NewRBPoint.Y - NewRTPoint.Y) div h;
  for Y := 0 to YCnt do
  begin
    if NewRTPoint.Y + Y * h + h > NewRBPoint.Y
    then YO := NewRTPoint.Y + Y * h + h - NewRBPoint.Y else YO := 0;
    Cnvs.CopyRect(Rect(R.Right - w, R.Top + NewRTPoint.Y + Y * h,
                       R.Right, R.Top + NewRTPoint.Y + Y * h + h - YO),
                  Picture.Canvas,
                  Rect(SkinRect.Right - w, SkinRect.Top + RTPoint.Y,
                       SkinRect.Right, SkinRect.Top + RBPoint.Y - YO));
  end;
    // draw corners
  Cnvs.CopyRect(Rect(R.Left, R.Top, R.Left + LTPoint.X, R.Top + LTPoint.Y),
                Picture.Canvas,
                Rect(SkinRect.Left, SkinRect.Top,
                     SkinRect.Left + NewLTPoint.X, SkinRect.Top + NewLTPoint.Y));
  Cnvs.CopyRect(Rect(R.Left + NewRTPoint.X, R.Top,
                     R.Right, R.Top + NewRTPoint.Y),
                Picture.Canvas,
                Rect(SkinRect.Left + RTPoint.X, SkinRect.Top,
                     SkinRect.Right, SkinRect.Top + RTPoint.Y));
  Cnvs.CopyRect(Rect(R.Left, R.Top + NewLBPoint.Y,
                     R.Left + NewLBPoint.X, R.Bottom),
                Picture.Canvas,
                Rect(SkinRect.Left, SkinRect.Top + LBPoint.Y,
                     SkinRect.Left + LBPoint.X, SkinRect.Bottom));
  Cnvs.CopyRect(Rect(R.Left + NewRBPoint.X, R.Top + NewRBPoint.Y,
                     R.Right, R.Bottom),
                Picture.Canvas,
                Rect(SkinRect.Left + RBPoint.X, SkinRect.Top + RBPoint.Y,
                     SkinRect.Right, SkinRect.Bottom));
end;

procedure TspSkinPageControl.Loaded;
begin
  inherited Loaded;
  if FIndex = -1
  then
    begin
      if TabHeight <= 0
      then
        SetItemSize(TabWidth, FDefaultItemHeight)
      else
        SetItemSize(TabWidth, TabHeight);
      Change;
      ReAlign;
    end;
end;

procedure TspSkinPageControl.WMEraseBkGnd(var Msg: TWMEraseBkGnd);
begin
  if Self.PageCount = 0
  then
    inherited
  else
    Msg.Result := 1;
end;

procedure TspSkinPageControl.WndProc(var Message:TMessage);
var
  TOff, LOff, Roff, BOff: Integer;
begin
  if Message.Msg = TCM_ADJUSTRECT
  then
    begin
      inherited WndProc(Message);
      if FIndex <> -1
      then
        begin
          TOff := ClRect.Top;
          LOff := ClRect.Left;
          ROff := RectWidth(SkinRect) - ClRect.Right;
          BOff := RectHeight(SkinRect) - ClRect.Bottom;
        end;
      case TabPosition of
        tpLeft:
           if FIndex <> -1
           then
             begin
               PRect(Message.LParam)^.Left := PRect(Message.LParam)^.Left + LOff - 4;
               PRect(Message.LParam)^.Right := ClientWidth - ROff;
               PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 6 + TOff;
               PRect(Message.LParam)^.Bottom := ClientHeight - BOff;
             end
           else
             begin
               PRect(Message.LParam)^.Left := PRect(Message.LParam)^.Left - 3;
               PRect(Message.LParam)^.Right := ClientWidth - 1;
               PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 5;
               PRect(Message.LParam)^.Bottom := ClientHeight - 1;
             end;
        tpRight:
           if FIndex <> -1
           then
             begin
               PRect(Message.LParam)^.Left := LOff;
               PRect(Message.LParam)^.Right := PRect(Message.LParam)^.Right - ROff + 4;
               PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 6 + TOff;
               PRect(Message.LParam)^.Bottom := ClientHeight - BOff;
             end
           else
             begin
               PRect(Message.LParam)^.Left := PRect(Message.LParam)^.Left - 3;
               PRect(Message.LParam)^.Right := PRect(Message.LParam)^.Right + 3;
               PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 5;
               PRect(Message.LParam)^.Bottom := ClientHeight - 1;
             end;
        tpTop:
           if FIndex <> -1
           then
             begin
               PRect(Message.LParam)^.Left := LOff;
               PRect(Message.LParam)^.Right := ClientWidth - ROff;
               PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 6 + TOff;
               PRect(Message.LParam)^.Bottom := ClientHeight - BOff;
             end
           else
             begin
               PRect(Message.LParam)^.Left := 1;
               PRect(Message.LParam)^.Right := ClientWidth - 1;
               PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 5;
               PRect(Message.LParam)^.Bottom := ClientHeight - 1;
             end;
        tpBottom:
          if FIndex <> -1
          then
            begin
              PRect(Message.LParam)^.Left := LOff;
              PRect(Message.LParam)^.Right := ClientWidth - ROff;
              PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 6 + TOff;
              PRect(Message.LParam)^.Bottom := PRect(Message.LParam)^.Bottom + 4 - BOff;
            end
          else
            begin
              PRect(Message.LParam)^.Left := 1;
              PRect(Message.LParam)^.Right := ClientWidth - 1;
              PRect(Message.LParam)^.Top := 1;
              PRect(Message.LParam)^.Bottom := PRect(Message.LParam)^.Bottom + 3;
            end;

      end;
    end
  else
    if Message.Msg = TCM_GETITEMRECT
    then
      begin
        inherited WndProc(Message);
        if Style = tsTabs
        then
          case TabPosition of
            tpLeft:
                begin
                  PRect(Message.LParam)^.Left := PRect(Message.LParam)^.Left - 2;
                  PRect(Message.LParam)^.Right := PRect(Message.LParam)^.Right - 2;
                end;
            tpRight:
                begin
                  PRect(Message.LParam)^.Left := PRect(Message.LParam)^.Left + 2;
                  PRect(Message.LParam)^.Right := PRect(Message.LParam)^.Right + 2;
                end;

            tpTop:
                begin
                  if not MultiLine
                  then
                    begin
                      PRect(Message.LParam)^.Left := PRect(Message.LParam)^.Left - 2;
                      PRect(Message.LParam)^.Right := PRect(Message.LParam)^.Right - 2;
                    end;
                  PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 2;
                  PRect(Message.LParam)^.Bottom := PRect(Message.LParam)^.Bottom - 2;
                end;
            tpBottom:
                begin
                  if not MultiLine
                  then
                    begin
                      PRect(Message.LParam)^.Left := PRect(Message.LParam)^.Left - 2;
                      PRect(Message.LParam)^.Right := PRect(Message.LParam)^.Right - 2;
                    end;
                  PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top + 2;
                  PRect(Message.LParam)^.Bottom := PRect(Message.LParam)^.Bottom + 2;
                end;
          end;
      end
  else
  inherited WndProc(Message);
  if (Message.Msg = WM_SIZE) and (not MultiLine) and
     not (csDesigning in ComponentState)
  then
    begin
      CheckScroll;
    end;
end;

function TspSkinPageControl.GetItemRect(index: integer): TRect;
var
  R: TRect;
begin
  SendMessage(Handle, TCM_GETITEMRECT, index, Integer(@R));
  Result := R;
end;

procedure TspSkinPageControl.SetItemSize;
begin
  SendMessage(Handle, TCM_SETITEMSIZE, 0, MakeLParam(AWidth, AHeight));
end;

procedure TspSkinPageControl.PaintWindow(DC: HDC);
var
  SaveIndex: Integer;
  B: TBitMap;
begin
  if (Width <= 0) or (Height <=0) then Exit;
  GetSkinData;
  SaveIndex := SaveDC(DC);
  try
    Canvas.Handle := DC;
    B := TBitMap.Create;
    B.Width := Width;
    B.Height := Height;
    if FIndex = -1
    then
      PaintDefaultWindow(B.Canvas)
    else
      PaintSkinWindow(B.Canvas);
    DrawTabs(B.Canvas);
    Canvas.Draw(0, 0, B);
    B.Free;
    Canvas.Handle := 0;
  finally
    RestoreDC(DC, SaveIndex);
  end;
end;

procedure TspSkinPageControl.TestActive(X, Y: Integer);
var
  i, j, k: Integer;
  R: TRect;
begin
  FOldActiveTab := FActiveTab;
  FOldActiveTabIndex := FActiveTabIndex;
  k := -1;
  j := -1;
  for i := 0 to PageCount - 1 do
  if Pages[i].TabVisible then
  begin
    Inc(k);
    R := GetItemRect(k);
    if PtInRect(R, Point(X, Y))
    then
      begin
        j := k;
        Break;
      end;
  end;

  FActiveTab := i;
  FActiveTabIndex := j;

  if (FOldActiveTabIndex <> FActiveTabIndex)
  then
    begin
      if (FOldActiveTabIndex <> - 1) and (FOldActiveTabIndex <> TabIndex) and
         (FOldActiveTabIndex < PageCount)
      then
        begin
          R := GetItemRect(FOldActiveTabIndex);
          DrawTab(FOldActiveTab, R, False, False, Canvas);
        end;
      if (FActiveTabIndex <> -1) and (FActiveTabIndex <> TabIndex) and
         (FActiveTabIndex < PageCount)
      then
        begin
          R := GetItemRect(FActiveTabIndex);
          DrawTab(FActiveTab, R, False, True, Canvas );
        end;
    end;
end;

procedure TspSkinPageControl.DrawTabs;
var
  i, j: integer;
  R: TRect;
begin
  j := -1;
  for i := 0 to PageCount-1 do
  if Pages[i].TabVisible then
  begin
    inc(j);
    R := GetItemRect(j);
    DrawTab(i, R, (j = TabIndex), j = FActiveTabIndex, Cnvs);
  end;
end;

procedure TspSkinPageControl.DrawTab;
var
  R: TRect;
  S: String;
  TB, BufferTB: TBitMap;
  DrawGlyph: Boolean;
  W, H: Integer;
begin
  DrawGlyph := (Images <> nil) and (TI < Images.Count);
  S := Pages[TI].Caption;
  TB := TBitMap.Create;
  if (TabPosition = tpTop) or (TabPosition = tpBottom)
  then
    begin
      W := RectWidth(Rct);
      H := RectHeight(Rct);
    end
  else
    begin
      H := RectWidth(Rct);
      W := RectHeight(Rct);
    end;
  R := Rect(0, 0, W, H);  
  if FIndex <> -1
  then
    begin
      if TabHeight <= 0
      then
        begin
          if MouseIn and not Active and not IsNullRect(MouseInTabRect)
          then
            CreateHSkinImage(TabLeftOffset, TabRightOffset,
             TB, Picture, MouseInTabRect, W, H)
          else
            if Active and Focused
          then
           CreateHSkinImage(TabLeftOffset, TabRightOffset,
            TB, Picture, FocusTabRect, W, H)
          else
          if Active
          then
            CreateHSkinImage(TabLeftOffset, TabRightOffset,
              TB, Picture, ActiveTabRect, W, H)
          else
            CreateHSkinImage(TabLeftOffset, TabRightOffset,
             TB, Picture, TabRect, W, H);
       end
     else
       begin
         BufferTB := TBitMap.Create;
         BufferTB.Width := W;
         BufferTB.Height := RectHeight(TabRect);
         if MouseIn and not Active and not IsNullRect(MouseInTabRect)
          then
            CreateHSkinImage(TabLeftOffset, TabRightOffset,
             BufferTB, Picture, MouseInTabRect, W, H)
          else
            if Active and Focused
          then
           CreateHSkinImage(TabLeftOffset, TabRightOffset,
            BufferTB, Picture, FocusTabRect, W, H)
          else
          if Active
          then
            CreateHSkinImage(TabLeftOffset, TabRightOffset,
              BufferTB, Picture, ActiveTabRect, W, H)
          else
            CreateHSkinImage(TabLeftOffset, TabRightOffset,
             BufferTB, Picture, TabRect, W, H);
         TB.Width := W;
         TB.Height := H;
         TB.Canvas.StretchDraw(R, BufferTB);
         BufferTB.Free;
       end;
      with TB.Canvas do
      begin
        Brush.Style := bsClear;
        if FUseSkinFont
        then
          begin
            Font.Name := FontName;
            Font.Style := FontStyle;
            Font.Height := FontHeight;
            Font.CharSet := Self.Font.CharSet;
          end
        else
           Font.Assign(Self.Font);
        if MouseIn and not Active
        then
          Font.Color := MouseInFontColor
        else
        if Active and Focused
        then
          Font.Color := FocusFontColor
        else
          if Active
          then Font.Color := ActiveFontColor
          else Font.Color := FontColor;
      end;
    end
  else
    begin
      TB.Width := W;
      TB.Height := H;
      if MouseIn and not Active
      then
        begin
          TB.Canvas.Brush.Color := SP_XP_BTNACTIVECOLOR;
          TB.Canvas.FillRect(R);
        end
      else
      if Active and Focused
      then
        begin
          Frame3D(TB.Canvas, R, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
          TB.Canvas.Brush.Color := SP_XP_BTNDOWNCOLOR;
          TB.Canvas.FillRect(R);
        end
      else
      if Active
      then
        begin
          Frame3D(TB.Canvas, R, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
          TB.Canvas.Brush.Color := SP_XP_BTNACTIVECOLOR;
          TB.Canvas.FillRect(R);