{ 文件名：RealICQExPageControl.pas 功 能：自定义PageControl组件，派生自TPageControl。 建 立：m_llw } unit RealICQExPageControl; interface uses RealICQUIColor, RealICQColors, RealICQHoverImage,SingleBorderHintWindow, Graphics, Dialogs, SysUtils, Windows, Messages, Classes, CommCtrl, ComCtrls, ExtCtrls, Controls ; type TRealICQExPageControlTabChangingEvent = procedure(Sender: TObject; NewIndex: Integer; var AllowChanged: Boolean) of object; TRealICQExPageControlWebPanelButtonClickEvent=procedure(Sender: TObject) of object; TRealICQExPageControl = class(TPageControl ,IRealICQUIColor) private FWebPanelButton:TRealICQHoverImage; FWebPanelButtonIcon:TRealICQHoverImage; FScrolledImageButton: Integer; FShapeBorder: TShape; FShapeButtonImageBack: TShape; FShapeButtonImageBackBottom:TShape; FTabPictureNormal: TPicture; FTabPictureEnter: TPicture; FTabPictureActive: TPicture; FWebPanelImage:TPicture; FScrollUPPictureDisabled: TPicture; FScrollUPPictureNormal: TPicture; FScrollUPPictureHover: TPicture; FScrollDownPictureDisabled: TPicture; FScrollDownPictureNormal: TPicture; FScrollDownPictureHover: TPicture; FScrollUPImage: TRealICQHoverImage; FScrollDownImage: TRealICQHoverImage; FHintWindow: TSingleBorderHintWindow; FOnTabChanging: TRealICQExPageControlTabChangingEvent; FOnWebPanelButtonClick:TRealICQExPageControlWebPanelButtonClickEvent; FPageButtons: TList; FPageButtonIcons: TList; FOverlapHeight: Integer; FButtonImageTransparent: Boolean; procedure SetControlsPosition; procedure DrawImageButtonIcon(ButtonIndex: Integer); procedure SetTabPictureNormal(Value: TPicture); procedure SetTabPictureEnter(Value:TPicture); procedure SetTabPictureActive(Value: TPicture); procedure SetWebPanelImage(Value: TPicture); procedure SetScrollUPPictureDisabled(Value: TPicture); procedure SetScrollUPPictureNormal(Value: TPicture); procedure SetScrollUPPictureHover(Value: TPicture); procedure SetScrollDownPictureDisabled(Value: TPicture); procedure SetScrollDownPictureNormal(Value: TPicture); procedure SetScrollDownPictureHover(Value: TPicture); procedure SetOverlapHeight(Value: Integer); procedure SetBorderColor(Value: TColor); function GetBorderColor: TColor; procedure SetButtonImageTransparent(Value: Boolean); procedure ImageButtonMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ImageButtonMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ImageButtonEnter(Sender: TObject); procedure ImageButtonLeave(Sender: TObject); procedure ScrollImageButtonEnter(Sender: TObject); procedure ScrollImageButtonLeave(Sender: TObject); procedure ScrollImageButtonClick(Sender: TObject); procedure RealICQPageControlResize(Sender: TObject); procedure SetActivePageIndex(const Value: Integer); function GetActivePageIndex: Integer; procedure SetBackColor(Value: TColor); function GetBackColor: TColor; function GetCopyRight: String; protected procedure DrawTab(TabIndex: Integer; const Rect: TRect; Active: Boolean); override; procedure UpdateActivePage; override; procedure WndProc(var Message:TMessage); override; procedure DoWebPanelClick(Sender:TObject); procedure DoTabChanging(NewIndex: Integer; var AllowChanged: Boolean); public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure ChangeUIColor(AColor: TColor); property ActivePageIndex: Integer read GetActivePageIndex write SetActivePageIndex; published property CopyRight: String read GetCopyRight; property Color; property BackColor: TColor read GetBackColor write SetBackColor; property TabPictureNormal: TPicture read FTabPictureNormal write SetTabPictureNormal; property TabPictureActive: TPicture read FTabPictureActive write SetTabPictureActive; property TabPictureEnter:TPicture read FTabPictureEnter write SetTabPictureEnter; property WebPanelImage:TPicture read FWebPanelImage write SetWebPanelImage; property ScrollUPPictureDisabled: TPicture read FScrollUPPictureDisabled write SetScrollUPPictureDisabled; property ScrollUPPictureNormal: TPicture read FScrollUPPictureNormal write SetScrollUPPictureNormal; property ScrollUPPictureHover: TPicture read FScrollUPPictureHover write SetScrollUPPictureHover; property ScrollDownPictureDisabled: TPicture read FScrollDownPictureDisabled write SetScrollDownPictureDisabled; property ScrollDownPictureNormal: TPicture read FScrollDownPictureNormal write SetScrollDownPictureNormal; property ScrollDownPictureHover: TPicture read FScrollDownPictureHover write SetScrollDownPictureHover; property OverlapHeight: Integer read FOverlapHeight write SetOverlapHeight; property ButtonImageTransparent: boolean read FButtonImageTransparent write SetButtonImageTransparent; property BorderColor: TColor read GetBorderColor write SetBorderColor; property OnTabChanging: TRealICQExPageControlTabChangingEvent read FOnTabChanging write FOnTabChanging; property OnWebPanelButtonClick:TRealICQExPageControlWebPanelButtonClickEvent read FOnWebPanelButtonClick write FOnWebPanelButtonClick; end; procedure Register; implementation //------------------------------------------------------------------------------ function TRealICQExPageControl.GetCopyRight: String; begin Result := ''; end; {TRealICQPageControl} //------------------------------------------------------------------------------ procedure TRealICQExPageControl.ImageButtonMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var ButtonIndex: Integer; ImageButtonIcon: TRealICQHoverImage; begin ButtonIndex := (Sender as TRealICQHoverImage).Tag; if ButtonIndex=100 then begin ImageButtonIcon:= (Sender as TRealICQHoverImage); end else ImageButtonIcon := FPageButtonIcons[ButtonIndex]; ImageButtonIcon.Left := ImageButtonIcon.Left + 1; ImageButtonIcon.Top := ImageButtonIcon.Top + 1; end; //------------- procedure TRealICQExPageControl.DoWebPanelClick(Sender:TObject); begin if Assigned(FOnWebPanelButtonClick) then FOnWebPanelButtonClick(Sender); end; //------------------------------------------------------------------------------ procedure TRealICQExPageControl.ImageButtonMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var ButtonIndex: Integer; ImageButton: TRealICQHoverImage; ImageButtonIcon: TRealICQHoverImage; P1,P2: ^TRGBTripleArray; AllowChanged: Boolean; procedure CloseHint; begin FHintWindow.ReleaseHandle; FHintWindow.Visible := False; end; begin ButtonIndex := (Sender as TRealICQHoverImage).Tag; if ButtonIndex<>100 then begin ImageButton := FPageButtons[ButtonIndex]; ImageButtonIcon := FPageButtonIcons[ButtonIndex]; ImageButtonIcon.Left := ImageButtonIcon.Left - 1; ImageButtonIcon.Top := ImageButtonIcon.Top - 1; if (FButtonImageTransparent) and (ButtonIndex (ImageButton.Height - FOverlapHeight) ) then begin ImageButton.Picture.Bitmap.PixelFormat:=pf24bit; p1 := ImageButton.Picture.Bitmap.ScanLine[0]; if (Y >= ImageButton.Height) or (Y < 0) or (X >= ImageButton.Width) or (X < 0) then Exit; P2 := ImageButton.Picture.Bitmap.ScanLine[Y]; if (p1[0].rgbtRed = p2[X].rgbtRed) and (p1[0].rgbtGreen = p2[X].rgbtGreen) and (p1[0].rgbtBlue = p2[X].rgbtBlue) then begin ButtonIndex := ButtonIndex + 1; end; end; if ActivePageIndex <> ButtonIndex then begin AllowChanged := True; DoTabChanging(ButtonIndex, AllowChanged); if AllowChanged then ActivePageIndex := ButtonIndex; end; end else DoWebPanelClick(Sender); CloseHint; end; //------------------------------------------------------------------------------ procedure TRealICQExPageControl.ImageButtonEnter(Sender: TObject); var ImageButton: TRealICQHoverImage; TabIndex:Integer; HintStr:String; procedure OpenHint(HintStr:String); var TextWidth,TextHeight:Integer; rect:TRect; begin TextWidth:=FHintWindow.Canvas.TextWidth(HintStr); TextHeight:=FHintWindow.Canvas.TextHeight(HintStr); rect.Left:= Mouse.CursorPos.X+10; rect.Top:=Mouse.CursorPos.Y; rect.Right:=rect.Left+TextWidth+5; rect.Bottom:=rect.Top+TextHeight; FHintWindow.Color := clInfoBk; FHintWindow.ActivateHint(Rect, HintStr); FHintWindow.Visible := True; end; begin if csDesigning in ComponentState then Exit; TabIndex:=(Sender as TRealICQHoverImage).Tag; if TabIndex=100 then begin FWebPanelButton.Picture.Assign(FTabPictureEnter); HintStr:='标签管理'; end else begin ImageButton := FPageButtons[TabIndex]; HintStr:=ImageButton.Hint; ImageButton.Picture.Assign(FTabPictureEnter); end; OpenHint(HintStr); end; //------------------------------------------------------------------------------ procedure TRealICQExPageControl.ImageButtonLeave(Sender: TObject); var ImageButton: TRealICQHoverImage; procedure CloseHint; begin FHintWindow.ReleaseHandle; FHintWindow.Visible := False; end; begin if (Sender as TRealICQHoverImage).Tag<>100 then begin ImageButton := FPageButtons[(Sender as TRealICQHoverImage).Tag]; ImageButton.Picture.Assign(FTabPictureNormal); end else begin FWebPanelButton.Picture.Assign(FTabPictureNormal); end; CloseHint; end; //------------------------------------------------------------------------------ procedure TRealICQExPageControl.ScrollImageButtonEnter(Sender: TObject); begin if (Sender as TRealICQHoverImage).Tag = -1 then FScrollUPImage.Picture.Assign(FScrollUPPictureHover) else FScrollDownImage.Picture.Assign(FScrollDownPictureHover) end; //------------------------------------------------------------------------------ procedure TRealICQExPageControl.ScrollImageButtonLeave(Sender: TObject); begin if (Sender as TRealICQHoverImage).Tag = -1 then FScrollUPImage.Picture.Assign(FScrollUPPictureNormal) else FScrollDownImage.Picture.Assign(FScrollDownPictureNormal) end; //------------------------------------------------------------------------------ procedure TRealICQExPageControl.ScrollImageButtonClick(Sender: TObject); begin if (Sender as TRealICQHoverImage).Tag = -1 then begin FScrolledImageButton := FScrolledImageButton - 1; end else begin FScrolledImageButton := FScrolledImageButton + 1; end; SetControlsPosition; end; //------------------------------------------------------------------------------ procedure TRealICQExPageControl.RealICQPageControlResize(Sender: TObject); begin SetControlsPosition; end; //------------------------------------------------------------------------------ procedure TRealICQExPageControl.DrawImageButtonIcon(ButtonIndex: Integer); var ImageButtonIcon: TRealICQHoverImage; begin if Images<> nil then begin ImageButtonIcon := FPageButtonIcons[ButtonIndex]; ImageButtonIcon.Picture.Bitmap.FreeImage; ImageButtonIcon.Picture.Bitmap.Canvas.Brush.Color := clWhite; ImageButtonIcon.Picture.Bitmap.Canvas.Brush.Style := bsSolid; ImageButtonIcon.Picture.Bitmap.Canvas.Pen.Color := clWhite; ImageButtonIcon.Picture.Bitmap.Canvas.Pen.Style := psSolid; ImageButtonIcon.Picture.Bitmap.Canvas.Rectangle(0, 0, ImageButtonIcon.Width, ImageButtonIcon.Height); ImageButtonIcon.Transparent := True; Images.GetBitmap(Pages[ButtonIndex].ImageIndex,ImageButtonIcon.Picture.Bitmap); end; end; //------------------------------------------------------------------------------ procedure TRealICQExPageControl.SetActivePageIndex(const Value: Integer); var iLoop: Integer; ImageButton:TRealICQHoverImage; ImageButtonIcon:TRealICQHoverImage; begin inherited ActivePageIndex := Value; for iLoop := 0 to FPageButtons.Count-1 do begin ImageButton := FPageButtons[iLoop]; ImageButtonIcon := FPageButtonIcons[iLoop]; if iLoop <> ActivePageIndex then begin ImageButton.Picture.Assign(FTabPictureNormal); ImageButtonIcon.SendToBack; ImageButton.SendToBack; ImageButton.OnMouseDown := ImageButtonMouseDown; ImageButton.OnMouseUp := ImageButtonMouseUp; ImageButton.OnMouseEnter := ImageButtonEnter; ImageButton.OnMouseLeave := ImageButtonLeave; ImageButtonIcon.OnMouseDown := ImageButtonMouseDown; ImageButtonIcon.OnMouseUp := ImageButtonMouseUp; ImageButtonIcon.OnMouseEnter := ImageButtonEnter; ImageButtonIcon.OnMouseLeave := ImageButtonLeave; end else begin ImageButton.Picture.Assign(FTabPictureActive); ImageButton.BringToFront; ImageButtonIcon.BringToFront; ImageButton.OnMouseDown := nil; ImageButton.OnMouseUp := nil; ImageButton.OnMouseEnter := nil; ImageButton.OnMouseLeave := nil; ImageButtonIcon.OnMouseDown := nil; ImageButtonIcon.OnMouseUp := nil; ImageButtonIcon.OnMouseEnter := nil; ImageButtonIcon.OnMouseLeave := nil; end; end; FShapeButtonImageBack.SendToBack; end; //------------------------------------------------------------------------------ function TRealICQExPageControl.GetActivePageIndex: Integer; begin Result := inherited ActivePageIndex; end; //------------------------------------------------------------------------------ procedure TRealICQExPageControl.DrawTab(TabIndex: Integer; const Rect: TRect; Active: Boolean); begin end; //------------------------------------------------------------------------------ procedure TRealICQExPageControl.UpdateActivePage; var ImageButton: TRealICQHoverImage; ImageButtonIcon: TRealICQHoverImage; begin inherited UpdateActivePage; ActivePageIndex:=0; while (FPageButtons.Count < Self.Tabs.Count) do begin ImageButton := TRealICQHoverImage.Create(Self); ImageButton.Parent := Self; ImageButton.AutoSize := True; ImageButton.ShowHint := False; FPageButtons.Add(ImageButton); ImageButtonIcon := TRealICQHoverImage.Create(Self); ImageButtonIcon.Parent := Self; ImageButtonIcon.AutoSize := True; ImageButtonIcon.ShowHint :=False; FPageButtonIcons.Add(ImageButtonIcon); end; while (FPageButtons.Count > Tabs.Count) do begin ImageButton := FPageButtons[0]; FPageButtons.Delete(0); ImageButton.Free; end; while (FPageButtonIcons.Count > Tabs.Count) do begin ImageButtonIcon := FPageButtonIcons[0]; FPageButtonIcons.Delete(0); ImageButtonIcon.Free; end; SetControlsPosition; end; //------------------------------------------------------------------------------ procedure TRealICQExPageControl.SetBackColor(Value: TColor); begin FShapeButtonImageBack.Pen.Color := Value; FShapeButtonImageBack.Brush.Color := Value; end; //------------------------------------------------------------------------------ function TRealICQExPageControl.GetBackColor: TColor; begin Result := FShapeButtonImageBack.Pen.Color; end; //------------------------------------------------------------------------------ procedure TRealICQExPageControl.SetBorderColor(Value: TColor); begin FShapeBorder.Pen.Color := Value; FShapeButtonImageBackBottom.Pen.Color := Value; end; //------------------------------------------------------------------------------ function TRealICQExPageControl.GetBorderColor: TColor; begin Result := FShapeBorder.Pen.Color; end; //------------------------------------------------------------------------------ procedure TRealICQExPageControl.SetTabPictureNormal(Value: TPicture); begin FTabPictureNormal.Assign(Value); SetControlsPosition; end; //------------------------------------------------------------------------------ procedure TRealICQExPageControl.SetTabPictureActive(Value: TPicture); begin FTabPictureActive.Assign(Value); SetControlsPosition; end; //------------------------------------------------------------------------------ procedure TRealICQExPageControl.SetTabPictureEnter(Value: TPicture); begin FTabPictureEnter.Assign(Value); end; //------------------------------------------------------------------------------ procedure TRealICQExPageControl.SetWebPanelImage(Value: TPicture); begin FWebPanelImage.Assign(Value); end; //------------------------------------------------------------------------------ procedure TRealICQExPageControl.SetScrollUPPictureDisabled(Value: TPicture); begin FScrollUPPictureDisabled.Assign(Value); SetControlsPosition; end; //------------------------------------------------------------------------------ procedure TRealICQExPageControl.SetScrollUPPictureNormal(Value: TPicture); begin FScrollUPPictureNormal.Assign(Value); SetControlsPosition; end; //------------------------------------------------------------------------------ procedure TRealICQExPageControl.SetScrollUPPictureHover(Value: TPicture); begin FScrollUPPictureHover.Assign(Value); SetControlsPosition; end; //------------------------------------------------------------------------------ procedure TRealICQExPageControl.SetScrollDownPictureDisabled(Value: TPicture); begin FScrollDownPictureDisabled.Assign(Value); SetControlsPosition; end; //------------------------------------------------------------------------------ procedure TRealICQExPageControl.SetScrollDownPictureNormal(Value: TPicture); begin FScrollDownPictureNormal.Assign(Value); SetControlsPosition; end; //------------------------------------------------------------------------------ procedure TRealICQExPageControl.SetScrollDownPictureHover(Value: TPicture); begin FScrollDownPictureHover.Assign(Value); SetControlsPosition; end; //------------------------------------------------------------------------------ procedure TRealICQExPageControl.SetOverlapHeight(Value: Integer); begin FOverlapHeight := Value; SetControlsPosition; end; //------------------------------------------------------------------------------ procedure TRealICQExPageControl.SetButtonImageTransparent(Value: Boolean); begin FButtonImageTransparent := Value; SetControlsPosition; end; //------------------------------------------------------------------------------ procedure TRealICQExPageControl.ChangeUIColor(AColor: TColor); begin BorderColor := ConvertColorToColor(BorderColor,AColor); ConvertBitmapToColor(FTabPictureActive.Bitmap, AColor); ConvertBitmapToColor(FTabPictureNormal.Bitmap, AColor); ConvertBitmapToColor(FTabPictureEnter.Bitmap, AColor); // ConvertBitmapToColor(FWebPanelImage.Bitmap, AColor); ConvertBitmapToColor(FScrollUPPictureDisabled.Bitmap, AColor); ConvertBitmapToColor(FScrollUPPictureHover.Bitmap, AColor); ConvertBitmapToColor(FScrollUPPictureNormal.Bitmap, AColor); ConvertBitmapToColor(FScrollDownPictureDisabled.Bitmap, AColor); ConvertBitmapToColor(FScrollDownPictureHover.Bitmap, AColor); ConvertBitmapToColor(FScrollDownPictureNormal.Bitmap, AColor); SetControlsPosition; end; //------------------------------------------------------------------------------ constructor TRealICQExPageControl.Create(AOwner: TComponent); begin inherited Create(AOwner); DoubleBuffered := True; Style := tsFlatButtons; TabPosition := tpTop; ParentColor := True; OnResize := RealICQPageControlResize; FScrolledImageButton := 0; FButtonImageTransparent := True; FTabPictureNormal := TPicture.Create; FTabPictureEnter:= TPicture.Create; FTabPictureActive := TPicture.Create; FWebPanelImage:= TPicture.Create; FScrollUpPictureDisabled := TPicture.Create; FScrollUpPictureNormal := TPicture.Create; FScrollUpPictureHover := TPicture.Create; FScrollDownPictureDisabled := TPicture.Create; FScrollDownPictureNormal := TPicture.Create; FScrollDownPictureHover := TPicture.Create; FScrollUPImage := TRealICQHoverImage.Create(Self); FScrollUPImage.Parent := Self; FScrollUPImage.AutoSize := True; FScrollUPImage.Transparent := True; FScrollUPImage.Tag := -1; FScrollDownImage := TRealICQHoverImage.Create(Self); FScrollDownImage.Parent := Self; FScrollDownImage.AutoSize := True; FScrollDownImage.Transparent := True; FScrollDownImage.Tag := 0; FPageButtons := TList.Create; FPageButtonIcons := TList.Create; FShapeBorder := TShape.Create(Self); FShapeBorder.Parent := Self; FShapeBorder.Pen.Color := $00CFA882; FShapeButtonImageBack := TShape.Create(Self); FShapeButtonImageBack.Parent := Self; FShapeButtonImageBack.Pen.Color := Color; FShapeButtonImageBack.Pen.Style := psClear; FShapeButtonImageBack.Brush.Color := Color; FShapeButtonImageBack.Brush.Style := bsClear; FShapeButtonImageBackBottom:= TShape.Create(Self); FShapeButtonImageBackBottom.Parent := Self; FShapeButtonImageBackBottom.Pen.Color :=$00CFA882; FWebPanelButton:= TRealICQHoverImage.Create(self); FWebPanelButton.Parent := Self; FWebPanelButton.AutoSize :=False; FWebPanelButton.Transparent := True; FWebPanelButton.Tag :=100; FWebPanelButton.OnMouseDown := ImageButtonMouseDown; FWebPanelButton.OnMouseUp := ImageButtonMouseUp; FWebPanelButton.OnMouseEnter := ImageButtonEnter; FWebPanelButton.OnMouseLeave := ImageButtonLeave; // FWebPanelButton.OnClick:=ImageButtonClick; FWebPanelButton.ShowHint:=False; FWebPanelButtonIcon:= TRealICQHoverImage.Create(self); FWebPanelButtonIcon.Parent := Self; FWebPanelButtonIcon.AutoSize :=True; FWebPanelButtonIcon.Transparent := True; FWebPanelButtonIcon.Tag :=100; FWebPanelButtonIcon.OnMouseDown := ImageButtonMouseDown; FWebPanelButtonIcon.OnMouseUp := ImageButtonMouseUp; FWebPanelButtonIcon.OnMouseEnter := ImageButtonEnter; FWebPanelButtonIcon.OnMouseLeave := ImageButtonLeave; // FWebPanelButtonIcon.OnClick:=ImageButtonClick; FWebPanelButtonIcon.ShowHint:=False; FHintWindow := TSingleBorderHintWindow.Create(Self); FHintWindow.Visible := False; end; //------------------------------------------------------------------------------ destructor TRealICQExPageControl.Destroy; var ImageButton: TRealICQHoverImage; ImageButtonIcon: TRealICQHoverImage; begin FreeAndNil(FWebPanelButton); FreeAndNil(FWebPanelButtonIcon); FreeAndNil(FWebPanelImage); FreeAndNil(FShapeBorder); FreeAndNil(FShapeButtonImageBack); FreeAndNil(FShapeButtonImageBackBottom); FreeAndNil(FScrollUPImage); FreeAndNil(FScrollDownImage); FreeAndNil(FScrollUpPictureDisabled); FreeAndNil(FScrollUpPictureNormal); FreeAndNil(FScrollUpPictureHover); FreeAndNil(FScrollDownPictureDisabled); FreeAndNil(FScrollDownPictureNormal); FreeAndNil(FScrollDownPictureHover); FreeAndNil(FTabPictureNormal); FreeAndNil(FTabPictureEnter); FreeAndNil(FTabPictureActive); while (FPageButtons.Count > 0) do begin ImageButton := FPageButtons[0]; FPageButtons.Delete(0); ImageButton.Free; end; FreeAndNil(FPageButtons); while (FPageButtonIcons.Count > 0) do begin ImageButtonIcon := FPageButtonIcons[0]; FPageButtonIcons.Delete(0); ImageButtonIcon.Free; end; FreeAndNil(FPageButtonIcons); FHintWindow.ReleaseHandle; FHintWindow.Free; inherited Destroy; end; procedure TRealICQExPageControl.SetControlsPosition; var iLoop,CanDrawImageButtonNO: Integer; ImageButton:TRealICQHoverImage; ImageButtonIcon:TRealICQHoverImage; begin try //计算当前高度可以显示多少个 TabButton CanDrawImageButtonNO := (FShapeButtonImageBack.Height-FTabPictureNormal.Height-FShapeButtonImageBackBottom.Height - OverlapHeight) div FTabPictureNormal.Height; if (CanDrawImageButtonNO < Tabs.Count) then begin FScrollUPImage.Visible := True; FScrollDownImage.Visible := True; FScrollUPImage.Left := (FTabPictureNormal.Width - FScrollUPPictureNormal.Width) div 2; FScrollUPImage.Top := FShapeButtonImageBack.Height-FTabPictureNormal.Height-FShapeButtonImageBackBottom.Height - FScrollUPPictureNormal.Height - FScrollDownPictureNormal.Height - 4; FScrollDownImage.Left := (FTabPictureNormal.Width - FScrollDownPictureNormal.Width) div 2; FScrollDownImage.Top := FShapeButtonImageBack.Height-FTabPictureNormal.Height-FShapeButtonImageBackBottom.Height- FScrollDownPictureNormal.Height - 2; if FScrollUPImage.Top <= 0 then begin FScrollUPImage.Visible := False; FScrollDownImage.Visible := False; FScrollUPImage.Left := - 100; FScrollDownImage.Left := -100; Exit; end; //因为显示了ScrollButton,所以canDrawImageButtonNO的值需要重新计算 CanDrawImageButtonNO := (FShapeButtonImageBack.Height-FTabPictureNormal.Height-FShapeButtonImageBackBottom.Height - OverlapHeight - (FShapeButtonImageBack.Height-FTabPictureNormal.Height-FShapeButtonImageBackBottom.Height - FScrollUPImage.Top)) div FTabPictureNormal.Height; if FScrolledImageButton = 0 then begin FScrollUPImage.Picture.Assign(FScrollUPPictureDisabled); FScrollUPImage.OnMouseEnter := nil; FScrollUPImage.OnMouseLeave := nil; FScrollUPImage.OnClick := nil; FScrollUPImage.ShowHint := False; end else begin FScrollUPImage.Picture.Assign(FScrollUPPictureNormal); FScrollUPImage.OnMouseEnter := ScrollImageButtonEnter; FScrollUPImage.OnMouseLeave := ScrollImageButtonLeave; FScrollUPImage.OnClick := ScrollImageButtonClick ; FScrollUPImage.ShowHint := True; FScrollUPImage.Hint := '可上翻 ' + IntToStr(FScrolledImageButton) + ' 页'; end; if Tabs.Count <= CanDrawImageButtonNO + FScrolledImageButton then begin FScrollDownImage.Picture.Assign(FScrollDownPictureDisabled); FScrollDownImage.OnMouseEnter := nil; FScrollDownImage.OnMouseLeave := nil; FScrollDownImage.OnClick := nil; FScrollDownImage.ShowHint := False; end else begin FScrollDownImage.Picture.Assign(FScrollDownPictureNormal); FScrollDownImage.OnMouseEnter := ScrollImageButtonEnter; FScrollDownImage.OnMouseLeave := ScrollImageButtonLeave; FScrollDownImage.OnClick := ScrollImageButtonClick; FScrollDownImage.ShowHint := True; FScrollDownImage.Hint := '可下翻 ' + IntToStr(Tabs.Count - (CanDrawImageButtonNO + FScrolledImageButton)) + ' 页'; end; end else begin FScrollUPImage.Visible := False; FScrollDownImage.Visible := False; FScrollUPImage.Left := - 100; FScrollDownImage.Left := -100; end; if (Tabs.Count - CanDrawImageButtonNO) < FScrolledImageButton then begin FScrolledImageButton := Tabs.Count - CanDrawImageButtonNO; if FScrolledImageButton < 0 then FScrolledImageButton := 0; end; ImageButtonIcon := nil; for iLoop := 0 to FScrolledImageButton - 1 do begin ImageButton := FPageButtons[iLoop]; ImageButton.Visible := False; if Images <> nil then begin ImageButtonIcon := FPageButtonIcons[iLoop]; ImageButtonIcon.Visible := False; end; end; for iLoop := FScrolledImageButton to FPageButtonIcons.Count-1 do begin ImageButton := FPageButtons[iLoop]; ImageButton.Tag := iLoop; ImageButton.Transparent := FButtonImageTransparent; ImageButton.Left := 0; ImageButton.Top := (iLoop - FScrolledImageButton)*(FTabPictureNormal.Height-OverlapHeight); ImageButton.Picture.Assign(FTabPictureNormal); ImageButton.SendToBack; ImageButton.Hint := Pages[iLoop].Caption; if Images <> nil then begin DrawImageButtonIcon(iLoop); ImageButtonIcon := FPageButtonIcons[iLoop]; ImageButtonIcon.Tag := iLoop; ImageButtonIcon.Transparent := True; ImageButtonIcon.Left :=Round(ImageButton.Left + (ImageButton.Width - ImageButtonIcon.Width) / 2); ImageButtonIcon.Top := Round(ImageButton.Top + (ImageButton.Height - ImageButtonIcon.Height - OverlapHeight) / 2); ImageButtonIcon.BringToFront; end; if iLoop = ActivePageIndex then begin if csDesigning in ComponentState then continue; ImageButton.Picture.Assign(FTabPictureActive); ImageButton.BringToFront; if ImageButtonIcon <> nil then begin ImageButtonIcon.BringToFront; end; end; if iLoop - FScrolledImageButton >= CanDrawImageButtonNO then begin ImageButton.Visible := False; if ImageButtonIcon <> nil then ImageButtonIcon.Visible := False; end else begin ImageButton.Visible := True; if ImageButtonIcon <> nil then ImageButtonIcon.Visible := True; end; end; FShapeButtonImageBack.SendToBack; ActivePageIndex := ActivePageIndex; except end; end; //------------------------------------------------------------------------------ procedure TRealICQExPageControl.DoTabChanging(NewIndex: Integer; var AllowChanged: Boolean); begin if Assigned(FOnTabChanging) then FOnTabChanging(Self, NewIndex, AllowChanged); end; //------------------------------------------------------------------------------ procedure TRealICQExPageControl.WndProc(var Message:TMessage); begin if (Message.Msg = TCM_ADJUSTRECT) then begin if Tabs.Count = 0 then begin FShapeBorder.Left := 0; FShapeBorder.Top := 0; FShapeBorder.Width := ClientWidth; FShapeBorder.Height := ClientHeight; end else begin if FTabPictureNormal.Width = 0 then Exit; if FTabPictureActive.Width = 0 then Exit; FShapeBorder.Left := FTabPictureNormal.Width - 1+1; FShapeBorder.Top := 0; FShapeBorder.Width := ClientWidth - (FTabPictureNormal.Width - 1+1); FShapeBorder.Height := ClientHeight; PRect(Message.LParam)^.Left := FTabPictureNormal.Width + 1+1; PRect(Message.LParam)^.Top := 0; PRect(Message.LParam)^.Right := ClientWidth - 1 - 1; PRect(Message.LParam)^.Bottom := ClientHeight - 1 - 1; FShapeButtonImageBack.Left := 0; FShapeButtonImageBack.Top := 0; FShapeButtonImageBack.Width := FTabPictureNormal.Width-1+2; FShapeButtonImageBack.Height := ClientHeight-1; FShapeButtonImageBackBottom.Left:=0; FShapeButtonImageBackBottom.Top:=FShapeButtonImageBack.Top+FShapeButtonImageBack.Height; FShapeButtonImageBackBottom.Width:=FTabPictureNormal.Width+2; FShapeButtonImageBackBottom.Height:=1; FWebPanelButton.Left:=0; FWebPanelButton.Width:=32; FWebPanelButton.Top:=FShapeButtonImageBackBottom.Top-FTabPictureNormal.Height-1; FWebPanelButton.Picture.Assign(FTabPictureNormal); FWebPanelButtonIcon.Picture.Bitmap.Assign(FWebPanelImage.Bitmap); FWebPanelButtonIcon.Transparent := True; FWebPanelButtonIcon.Left :=0; FWebPanelButtonIcon.Top :=FWebPanelButton.Top; end; end else begin Inherited WndProc(Message); end; end; //------------------------------------------------------------------------------ procedure Register; begin RegisterComponents('ICQComponnets', [TRealICQExPageControl]); end; end.