關於TabSheet的顏色~~ |
尚未結案
|
aresu
一般會員 ![]() ![]() 發表:14 回覆:14 積分:5 註冊:2004-07-13 發送簡訊給我 |
|
hagar
版主 ![]() ![]() ![]() ![]() ![]() ![]() 發表:143 回覆:4056 積分:4445 註冊:2002-04-14 發送簡訊給我 |
參考這篇看看 "change the color of a TPageControls"
http://www.swissdelphicenter.ch/en/showcode.php?id=788:
type TTabSheet = class(ComCtrls.TTabSheet) private FColor: TColor; procedure SetColor(Value: TColor); procedure WMEraseBkGnd(var Msg: TWMEraseBkGnd); message WM_ERASEBKGND; public constructor Create(aOwner: TComponent); override; property Color: TColor read FColor write SetColor; end; type TForm1 = class(TForm) Button1: TButton; PageControl1: TPageControl; TabSheet1: TTabSheet; TabSheet2: TTabSheet; TabSheet3: TTabSheet; procedure PageControl1DrawTab(Control: TCustomTabControl; TabIndex: Integer; const Rect: TRect; Active: Boolean); procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} constructor TTabSheet.Create(aOwner: TComponent); begin inherited; FColor := clBtnFace; end; procedure TTabSheet.SetColor(Value: TColor); begin if FColor <> Value then begin FColor := Value; Invalidate; end; end; procedure TTabSheet.WMEraseBkGnd(var Msg: TWMEraseBkGnd); begin if FColor = clBtnFace then inherited else begin Brush.Color := FColor; Windows.FillRect(Msg.dc, ClientRect, Brush.Handle); Msg.Result := 1; end; end; procedure TForm1.FormCreate(Sender: TObject); begin Tabsheet1.Color := clWhite; TabSheet2.Color := clLime; end; // PageControl1.OwnerDraw := True ! procedure TForm1.PageControl1DrawTab(Control: TCustomTabControl; TabIndex: Integer; const Rect: TRect; Active: Boolean); var AText: string; APoint: TPoint; begin with (Control as TPageControl).Canvas do begin Brush.Color := ClGreen; FillRect(Rect); AText := TPageControl(Control).Pages[TabIndex].Caption; with Control.Canvas do begin APoint.x := (Rect.Right - Rect.Left) div 2 - TextWidth(AText) div 2; APoint.y := (Rect.Bottom - Rect.Top) div 2 - TextHeight(AText) div 2; TextRect(Rect, Rect.Left APoint.x, Rect.Top APoint.y, AText); end; end; end; end.-- 向 KTop 的弟兄們致敬! ![]() |
aresu
一般會員 ![]() ![]() 發表:14 回覆:14 積分:5 註冊:2004-07-13 發送簡訊給我 |
|
hagar
版主 ![]() ![]() ![]() ![]() ![]() ![]() 發表:143 回覆:4056 積分:4445 註冊:2002-04-14 發送簡訊給我 |
您要的是紅色的部份?
procedure TForm1.PageControl1DrawTab(Control: TCustomTabControl; TabIndex: Integer; const Rect: TRect; Active: Boolean); var AText: string; APoint: TPoint; begin with (Control as TPageControl).Canvas do begin Brush.Color := ClGreen; FillRect(Rect); AText := TPageControl(Control).Pages[TabIndex].Caption; with Control.Canvas do begin APoint.x := (Rect.Right - Rect.Left) div 2 - TextWidth(AText) div 2; APoint.y := (Rect.Bottom - Rect.Top) div 2 - TextHeight(AText) div 2; TextRect(Rect, Rect.Left APoint.x, Rect.Top APoint.y, AText); end; Pen.Color := clRed; Pen.Width := 3; MoveTo(Rect.Left 1, Rect.Top 1); LineTo(Rect.Left 1, Rect.Top (Rect.Bottom - Rect.Top) - 1); MoveTo(Rect.Left 1, Rect.Top 1); LineTo(Rect.Left (Rect.Right - Rect.Left) - 1, Rect.Top 1); MoveTo(Rect.Left (Rect.Right - Rect.Left) - 1, Rect.Top 1); LineTo(Rect.Left (Rect.Right - Rect.Left) - 1, Rect.Top (Rect.Bottom - Rect.Top) - 1); MoveTo(Rect.Left 1, Rect.Top (Rect.Bottom - Rect.Top) - 1); LineTo(Rect.Left (Rect.Right - Rect.Left) - 1, Rect.Top (Rect.Bottom - Rect.Top) - 1); end; end;-- 向 KTop 的弟兄們致敬! ![]() |
aresu
一般會員 ![]() ![]() 發表:14 回覆:14 積分:5 註冊:2004-07-13 發送簡訊給我 |
|
hagar
版主 ![]() ![]() ![]() ![]() ![]() ![]() 發表:143 回覆:4056 積分:4445 註冊:2002-04-14 發送簡訊給我 |
|
aresu
一般會員 ![]() ![]() 發表:14 回覆:14 積分:5 註冊:2004-07-13 發送簡訊給我 |
|
aresu
一般會員 ![]() ![]() 發表:14 回覆:14 積分:5 註冊:2004-07-13 發送簡訊給我 |
|
hagar
版主 ![]() ![]() ![]() ![]() ![]() ![]() 發表:143 回覆:4056 積分:4445 註冊:2002-04-14 發送簡訊給我 |
|
aresu
一般會員 ![]() ![]() 發表:14 回覆:14 積分:5 註冊:2004-07-13 發送簡訊給我 |
|
hagar
版主 ![]() ![]() ![]() ![]() ![]() ![]() 發表:143 回覆:4056 積分:4445 註冊:2002-04-14 發送簡訊給我 |
在這篇 http://www.swissdelphicenter.ch/en/showcode.php?id=788 中
加入紅色的部份試試:
unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Buttons, StdCtrls, ComCtrls, Mask, ExtCtrls; type TTabSheet = class(ComCtrls.TTabSheet) private FColor: TColor; procedure SetColor(Value: TColor); procedure WMEraseBkGnd(var Msg: TWMEraseBkGnd); message WM_ERASEBKGND; public constructor Create(aOwner: TComponent); override; property Color: TColor read FColor write SetColor; end; type TForm1 = class(TForm) Button1: TButton; PageControl1: TPageControl; TabSheet1: TTabSheet; TabSheet2: TTabSheet; procedure FormCreate(Sender: TObject); procedure PageControl1DrawTab(Control: TCustomTabControl; TabIndex: Integer; const Rect: TRect; Active: Boolean); procedure PageControl1Change(Sender: TObject); procedure DrawTabSheetBorder; public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} { TTabSheet } constructor TTabSheet.Create(aOwner: TComponent); begin inherited; FColor := clBtnFace; end; procedure TTabSheet.SetColor(Value: TColor); begin if FColor <> Value then begin FColor := Value; Invalidate; end; end; procedure TTabSheet.WMEraseBkGnd(var Msg: TWMEraseBkGnd); begin if FColor = clBtnFace then inherited else begin Brush.Color := FColor; Windows.FillRect(Msg.dc, ClientRect, Brush.Handle); Msg.Result := 1; end; end; { Form1 } procedure TForm1.FormCreate(Sender: TObject); begin Tabsheet1.Color := clWhite; TabSheet2.Color := clLime; end; procedure TForm1.PageControl1DrawTab(Control: TCustomTabControl; TabIndex: Integer; const Rect: TRect; Active: Boolean); var AText: string; APoint: TPoint; begin with (Control as TPageControl).Canvas do begin Brush.Color := ClGreen; FillRect(Rect); AText := TPageControl(Control).Pages[TabIndex].Caption; with Control.Canvas do begin APoint.x := (Rect.Right - Rect.Left) div 2 - TextWidth(AText) div 2; APoint.y := (Rect.Bottom - Rect.Top) div 2 - TextHeight(AText) div 2; TextRect(Rect, Rect.Left APoint.x, Rect.Top APoint.y, AText); end; end; DrawTabSheetBorder; end; procedure TForm1.PageControl1Change(Sender: TObject); begin DrawTabSheetBorder; end; procedure TForm1.DrawTabSheetBorder; var Canvas: TCanvas; R: TRect; begin Canvas := PageControl1.Canvas; R.Left := PageControl1.ClientRect.Left; R.Top := PageControl1.ClientRect.Bottom - PageControl1.Pages[PageControl1.ActivePageIndex].Height - 3; R.Right := PageControl1.ClientRect.Right; R.Bottom := PageControl1.ClientRect.Bottom; case PageControl1.ActivePageIndex of 0: Canvas.Pen.Color := TabSheet1.Color; 1: Canvas.Pen.Color := TabSheet2.Color; end; Canvas.Pen.Width := 9; Canvas.MoveTo(R.Left, R.Top); Canvas.LineTo(R.Left, R.Bottom); Canvas.MoveTo(R.Left, R.Top); Canvas.LineTo(R.Right, R.Top); Canvas.MoveTo(R.Right, R.Top); Canvas.LineTo(R.Right, R.Bottom); Canvas.MoveTo(R.Left, R.Bottom); Canvas.LineTo(R.Right, R.Bottom); end; end.-- 向 KTop 的弟兄們致敬! ![]() |
aresu
一般會員 ![]() ![]() 發表:14 回覆:14 積分:5 註冊:2004-07-13 發送簡訊給我 |
本站聲明 |
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇! |