bsskintabs.pas

Delphi开发的图象处理软件

  w1 := RectWidth(R);
  h1 := RectHeight(R);
  XCnt := w1 div w;
  YCnt := h1 div h;
  for X := 0 to XCnt do
  for Y := 0 to YCnt do
  begin
    if X * w + w > w1 then XO := X * w + w - w1 else XO := 0;
    if Y * h + h > h1 then YO := Y * h + h - h1 else YO := 0;
     Cnvs.CopyRect(Rect(R.Left + X * w, R.Top + Y * h,
                        R.Left + X * w + w - XO, R.Top + Y * h + h - YO),
              Picture.Canvas,
              Rect(SkinRect.Left + ClRect.Left, SkinRect.Top + ClRect.Top,
                   SkinRect.Left + ClRect.Right - XO,
                   SkinRect.Top + ClRect.Bottom - YO));
  end;            
  // Draw tabs BG
  if not IsNullRect(TabsBGRect)
  then
    begin
      if TabPosition = tpLeft
      then
        begin
          TBGOffY := 0;
          TBGOffX := 0;
          rw := R.Left;
          rh := Height;
        end
      else
      if TabPosition = tpRight
      then
        begin
          TBGOffY := 0;
          TBGOffX := R.Right;
          rw := Width - R.Right;
          rh := Height;
        end
      else
      if TabPosition = tpTop
      then
        begin
          TBGOffX := 0;
          TBGOffY := 0;
          rh := R.Top;
          rw := Width;
        end
      else
        begin
          TBGOffX := 0;
          TBGOffY := R.Bottom;
          rh := Height - R.Bottom;
          rw := Width;
        end;
      w := RectWidth(TabsBGRect);
      h := RectHeight(TabsBGRect);
      XCnt := rw div w;
      YCnt := rh div h;
      for X := 0 to XCnt do
      for Y := 0 to YCnt do
      begin
        if X * w + w > rw then XO := X * w + w - rw else XO := 0;
        if Y * h + h > rh then YO := Y * h + h - rh else YO := 0;
        Cnvs.CopyRect(Rect(TBGOffX + X * w, TBGOffY + Y * h,
                           TBGOffX + X * w + w - XO, TBGOffY + Y * h + h - YO),
                      Picture.Canvas,
                      Rect(TabsBGRect.Left, TabsBGRect.Top,
                           TabsBGRect.Right - XO, TabsBGRect.Bottom - YO));
      end;
    end;
  // Draw frame around displayrect
    // draw lines
  w := RTPoint.X - LTPoint.X;
  XCnt := (NewRTPoint.X - NewLTPoint.X) div w;
  for X := 0 to XCnt do
  begin
    if NewLTPoint.X + X * w + w > NewRTPoint.X
    then XO := NewLTPoint.X + X * w + w - NewRTPoint.X else XO := 0;
    Cnvs.CopyRect(Rect(R.Left + NewLTPoint.X + X * w, R.Top,
                  R.Left + NewLTPoint.X + X * w + w - XO, R.Top + TOff),
             Picture.Canvas,
             Rect(SkinRect.Left + LTPoint.X, SkinRect.Top,
                  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 TbsSkinTabControl.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 TbsSkinTabControl.WMEraseBkGnd(var Msg: TWMEraseBkGnd);
begin
  Msg.Result := 1;
end;

procedure TbsSkinTabControl.WndProc(var Message:TMessage);
var
  TOff, LOff, Roff, BOff: Integer;
begin
  if Message.Msg = TCM_ADJUSTRECT
  then
    begin
      inherited WndProc(Message);
      TOff := 0;
      LOff := 0;
      ROff := 0;
      BOff := 0;
      if (FIndex <> -1) and (BGPictureIndex = -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)
  then
    begin
      CheckScroll;
    end;
end;

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

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

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

procedure TbsSkinTabControl.DrawTabs;
var
  i: integer;
  R: TRect;
begin
  for i := 0 to Tabs.Count-1 do
  begin
    R := GetItemRect(i);
    DrawTab(i, R, i = TabIndex, i = FActiveTab, Cnvs);
  end;
end;

procedure TbsSkinTabControl.UpDateTabs;
begin
  if FIndex <> -1
  then
    begin
      if TabHeight <= 0
      then
        SetItemSize(TabWidth, RectHeight(TabRect))
      else
        SetItemSize(TabWidth, TabHeight);
    end
  else
    begin
      if TabHeight <= 0
      then
        SetItemSize(TabWidth, FDefaultItemHeight)
      else
        SetItemSize(TabWidth, TabHeight);
    end;
  if MultiLine and (FSkinUpDown <> nil)
  then
    HideSkinUpDown;
  ReAlign;
end;

procedure TbsSkinTabControl.DrawTab;
var
  R: TRect;
  S: String;
  TB, BufferTB: TBitMap;
  DrawGlyph: Boolean;
  W, H: Integer;
begin
  DrawGlyph := (Images <> nil) and (TI < Images.Count);
  S := Tabs[TI];
  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)