bsskintabs.~pas

一套非常好用的delphi控件,方便程序员工作

  inherited Notification(AComponent, Operation);
end;

{ TbsSkinPageControl }

constructor TbsSkinPageControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Ctl3D := False;
  FIndex := -1;
  Picture := nil;
  Font.Name := 'Arial';
  Font.Style := [];
  Font.Color := clBtnText;
  Font.Height := 14;
  FSkinUpDown := nil;
  FSkinDataName := 'tab';
  FDefaultFont := TFont.Create;
  FDefaultFont.Name := 'Arial';
  FDefaultFont.Style := [];
  FDefaultFont.Color := clBtnText;
  FDefaultFont.Height := 14;
  FDefaultItemHeight := 20;
  FActiveTab := -1;
  FOldActiveTab := -1;
  FActiveTabIndex := -1;
  FOldActiveTabIndex := -1;
  FUseSkinFont := True;
end;

destructor TbsSkinPageControl.Destroy;
begin
  FDefaultFont.Free;
  inherited Destroy;
end;

procedure TbsSkinPageControl.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 TbsSkinPageControl.CMMouseLeave;
var
  R: TRect;
begin
  if (FOldActiveTabIndex <> - 1) and (FOldActiveTabIndex <> TabIndex) and
     (FOldActiveTabIndex < PageCount)
  then
    begin
      R := GetItemRect(FOldActiveTabIndex);
      DrawTab(FOldActiveTab, R, False, False, Canvas);
      FOldActiveTabIndex := -1;
      FOldActiveTab := -1;
    end;

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

procedure TbsSkinPageControl.MouseDown;
begin
  inherited;
  if (Button = mbLeft) and not (csDesigning in ComponentState)
  then
    TestActive(X, Y);
end;

procedure TbsSkinPageControl.MouseMove;
begin
 inherited;
 if  not (csDesigning in ComponentState)
 then
   TestActive(X, Y);
end;

procedure TbsSkinPageControl.SetDefaultItemHeight;
begin
  FDefaultItemHeight := Value;
  if FIndex = -1
  then
    begin
      SetItemSize(TabWidth, FDefaultItemHeight);
      Change2;
      ReAlign;
    end;
end;


procedure TbsSkinPageControl.SetDefaultFont;
begin
  FDefaultFont.Assign(Value);
end;

procedure TbsSkinPageControl.OnUpDownChange(Sender: TObject);
begin
  FSkinUpDown.Max := GetInVisibleItemCount;
  SendMessage(Handle, WM_HSCROLL,
    MakeWParam(SB_THUMBPOSITION, FSkinUpDown.Position), 0);
end;

function TbsSkinPageControl.GetPosition: Integer;
var
  i, j, k: Integer;
  R: TRect;
begin
  j := 0;
  k := -1;
  for i := 0 to PageCount - 1 do
  if Pages[i].TabVisible then
  begin
    inc(k);
    R := GetItemRect(k);
    if R.Right <= 0 then inc(j);
  end;
  Result := j;
end;

function TbsSkinPageControl.GetInVisibleItemCount;
var
  i, j, k: Integer;
  R: TRect;
  Limit: Integer;
begin
  if FSkinUpDown = nil
  then
    Limit := Width - 3
  else
    Limit := Width - FSkinUpDown.Width - 3;
  j := 0;
  k := -1;
  for i := 0 to PageCount - 1 do
  if Pages[i].TabVisible
  then
  begin
    inc(k);
    R := GetItemRect(k);
    if (R.Right > Limit) or (R.Right <= 0)
    then inc(j);
  end;
  Result := j;
end;

procedure TbsSkinPageControl.CheckScroll;
var
  Wnd: HWND;
  InVCount: Integer;
begin
  Wnd := FindWindowEx(Handle, 0, 'msctls_updown32', nil);
  if Wnd <> 0 then DestroyWindow(Wnd);
  InVCount := GetInVisibleItemCount;
  if ((InVCount = 0) or MultiLine) and (FSkinUpDown <> nil)
  then
    HideSkinUpDown
  else
  if (InVCount > 0) and (FSkinUpDown = nil)
  then
    ShowSkinUpDown;
  if FSkinUpDown <> nil
  then
    begin
      FSkinUpDown.Max := InVCount;
      FSkinUpDown.Left := Width - FSkinUpDown.Width;
      if TabPosition = tpTop
      then
        FSkinUpDown.Top := 0
      else
       FSkinUpDown.Top := Height - FSkinUpDown.Height;
    end;
end;

procedure TbsSkinPageControl.ShowSkinUpDown;
begin
  FSkinUpDown := TbsSkinUpDown.Create(Self);
  FSkinUpDown.Parent := Self;
  FSkinUpDown.Width := FDefaultItemHeight * 2;
  FSkinUpDown.Height := FDefaultItemHeight;
  FSkinUpDown.Min := 0;
  FSkinUpDown.Max := GetInVisibleItemCount;
  FSkinUpDown.Position := GetPosition;
  FSkinUpDown.Increment := 1;
  FSkinUpDown.OnChange := OnUpDownChange;
  FSkinUpDown.Left := Width - FSkinUpDown.Width;
  if TabPosition = tpTop
  then
    FSkinUpDown.Top := 0
  else
    FSkinUpDown.Top := Height - FSkinUpDown.Height;
  FSkinUpDown.SkinDataName := UpDown;
  FSkinUpDown.SkinData := SkinData;
  FSkinUpDown.Visible := True;
end;

procedure TbsSkinPageControl.HideSkinUpDown;
begin
  FSkinUpDown.Free;
  FSkinUpDown := nil;
end;

procedure TbsSkinPageControl.WMHSCROLL;
begin
  inherited;
  RePaint;
end;

procedure TbsSkinPageControl.WMSize;
begin
  GetSkinData;
  inherited;
end;

procedure TbsSkinPageControl.Change;
begin
  if FSkinUpDown <> nil
  then FSkinUpDown.Position := GetPosition;
  inherited;
  Invalidate;
  if ActivePage <> nil then ActivePage.Invalidate;
end;

procedure TbsSkinPageControl.Change2;
begin
  if FSkinUpDown <> nil
  then FSkinUpDown.Position := GetPosition;
  Invalidate;
end;

procedure TbsSkinPageControl.GetSkinData;
begin
  BGPictureIndex := -1;
  if FSD = nil
  then
    begin
      FIndex := -1;
      Exit;
    end;
  if FSD.Empty
  then
    FIndex := -1
  else
    FIndex := FSD.GetControlIndex(FSkinDataName);
  //
  if FIndex <> -1
  then
    if TbsDataSkinControl(FSD.CtrlList.Items[FIndex]) is TbsDataSkinTabControl
    then
      with TbsDataSkinTabControl(FSD.CtrlList.Items[FIndex]) do
      begin
        if (PictureIndex <> -1) and (PictureIndex < FSD.FActivePictures.Count)
        then
          Picture := TBitMap(FSD.FActivePictures.Items[PictureIndex])
        else
          Picture := nil;
        Self.SkinRect := SkinRect;
        Self.ClRect := ClRect;
        Self.TabRect := TabRect;
        if IsNullRect(ActiveTabRect)
        then
          Self.ActiveTabRect := TabRect
        else
          Self.ActiveTabRect := ActiveTabRect;
        if IsNullRect(FocusTabRect)
        then
          Self.FocusTabRect := ActiveTabRect
        else
          Self.FocusTabRect := FocusTabRect;
        //
        Self.TabsBGRect := TabsBGRect;
        Self.LTPoint := LTPoint;
        Self.RTPoint := RTPoint;
        Self.LBPoint := LBPoint;
        Self.RBPoint := RBPoint;
        Self.TabLeftOffset := TabLeftOffset;
        Self.TabRightOffset := TabRightOffset;
        //
        Self.FontName := FontName;
        Self.FontColor := FontColor;
        Self.ActiveFontColor := ActiveFontColor;
        Self.FocusFontColor := FocusFontColor;
        Self.FontStyle := FontStyle;
        Self.FontHeight := FontHeight;
        Self.UpDown := UpDown;
        Self.BGPictureIndex := BGPictureIndex;
        Self.MouseInTabRect := MouseInTabRect;
        Self.MouseInFontColor := MouseInFontColor;
        Self.TabStretchEffect := TabStretchEffect;
        Self.ShowFocus := ShowFocus;
        Self.FocusOffsetX := FocusOffsetX;
        Self.FocusOffsetY := FocusOffsetY;
      end;
end;

procedure TbsSkinPageControl.ChangeSkinData;
var
  UpDownVisible: Boolean;
begin
   GetSkinData;
  //
  if FIndex <> -1
  then
    begin
      if FUseSkinFont
      then
        begin
          Font.Name := FontName;
          Font.Height := FontHeight;
          Font.Style := FontStyle;
        end
      else
        Font.Assign(FDefaultFont);

      if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
      then
        Font.Charset := SkinData.ResourceStrData.CharSet
       else
        Font.CharSet := DefaultFont.CharSet;

      Font.Color := FontColor;
      if TabHeight <= 0
      then
        SetItemSize(TabWidth, RectHeight(TabRect))
      else
        SetItemSize(TabWidth, TabHeight);
    end
  else
    begin
      Font.Assign(FDefaultFont);
      if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
      then
        Font.Charset := SkinData.ResourceStrData.CharSet;

      if TabHeight <= 0
      then
        SetItemSize(TabWidth, FDefaultItemHeight)
      else
        SetItemSize(TabWidth, TabHeight);
    end;
  //
  Change2;
  ReAlign;
  if FSkinUpDown <> nil
  then
    begin
      HideSkinUpDown;
      CheckScroll;
    end;
  if ActivePage <> nil then ActivePage.RePaint;
end;

procedure TbsSkinPageControl.SetSkinData;
begin
  FSD := Value;
  if (FSD <> nil) then
  if not FSD.Empty and not (csDesigning in ComponentState)
  then
    ChangeSkinData;
end;

procedure TbsSkinPageControl.Notification;
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = FSD) then FSD := nil;
end;

procedure TbsSkinPageControl.PaintDefaultWindow;
var
  R: TRect;
begin
  with Cnvs do
  begin
    Brush.Color := clBtnFace;
    FillRect(ClientRect);
    R := Self.DisplayRect;
    InflateRect(R, 1, 1);
    Frame3D(Cnvs, R, clBtnShadow, clBtnShadow, 1);
  end;
end;

procedure TbsSkinPageControl.PaintSkinWindow;
var
  TOff, LOff, Roff, BOff: Integer;
  NewClRect, DR, R: TRect;
  TBGOffX, TBGOffY, X, Y, XCnt, YCnt, w, h, rw, rh, XO, YO: Integer;
  NewLTPoint, NewRTPoint, NewLBPoint, NewRBPoint: TPoint;
  LB, RB, TB, BB, ClB: TBitMap;
  R1, R2: TRect;
begin
  GetSkinData;
  TOff := ClRect.Top;
  LOff := ClRect.Left;
  ROff := RectWidth(SkinRect) - ClRect.Right;
  BOff := RectHeight(SkinRect) - ClRect.Bottom;
  //
  DR := Self.DisplayRect;
  //
  R := Rect(DR.Left - LOff, DR.Top - TOff, DR.Right + ROff, DR.Bottom + BOff);
  XO := RectWidth(R) - RectWidth(SkinRect);
  YO := RectHeight(R) - RectHeight(SkinRect);
  NewLTPoint := LTPoint;
  NewRTPoint := Point(RTPoint.X + XO, RTPoint.Y);
  NewLBPoint := Point(LBPoint.X, LBPoint.Y + YO);
  NewRBPoint := Point(RBPoint.X + XO, RBPoint.Y + YO);
  NewCLRect := Rect(ClRect.Left, ClRect.Top, ClRect.Right + XO, ClRect.Bottom + YO);
  // Draw frame around displayrect
  LB := TBitMap.Create;
  TB := TBitMap.Create;
  RB := TBitMap.Create;
  BB := TBitMap.Create;
  CreateSkinBorderImages(LtPoint, RTPoint, LBPoint, RBPoint, ClRect,
     NewLTPoint, NewRTPoint, NewLBPoint, NewRBPoint, NewClRect,
     LB, TB, RB, BB, Picture, SkinRect, RectWidth(R), RectHeight(R), False, False, False, False);
  Cnvs.Draw(R.Left, R.Top, TB);
  Cnvs.Draw(R.Left, R.Top + TB.Height, LB);
  Cnvs.Draw(R.Left + RectWidth(R) - RB.Width, R.Top + TB.Height, RB);
  Cnvs.Draw(R.Left, R.Top + RectHeight(R) - BB.Height, BB);
  LB.Free;
  TB.Free;
  RB.Free;
  BB.Free;
end;


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

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