skintabs.pas

一套及时通讯的原码

  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
      SetItemSize(0, FDefaultItemHeight);
      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: 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 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);
      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);
        end
      else
        begin
          TB.Canvas.Brush.Color := clBtnFace;
          TB.Canvas.FillRect(R);
        end;
      with TB.Canvas do
      begin
        Brush.Style := bsClear;
        Font.Assign(Self.Font);
      end;
    end;
  //
  if DrawGlyph
  then
    DrawTabGlyphAndText(TB.Canvas, TB.Width, TB.Height, S,
                        Images, TI, Pages[TI].Enabled)
  else
    DrawText(TB.Canvas.Handle, PChar(S), Length(S), R, DT_CENTER or DT_SINGLELINE or DT_VCENTER);
  if TabPosition = tpLeft
  then
    DrawRotate90_1(Cnvs, TB, Rct.Left, Rct.Top)
  else
  if TabPosition = tpRight
  then
    DrawRotate90_2(Cnvs, TB, Rct.Left, Rct.Top)
  else
    Cnvs.Draw(Rct.Left, Rct.Top, TB);
  TB.Free;
end;


{ TspSkinTabControl }

constructor TspSkinTabControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FUseSkinFont := True;
  Ctl3D := False;
  FIndex := -1;
  Picture := nil;
  Font.Name := 'Arial';
  Font.Style := [];
  Font.Color := clBtnText;
  Font.Height := 14;
  FOldTop := 0;
  FOldBottom := 0;