PageControlタブの背景色
解決初歩的な質問です。
PageControlのタブの背景色を個別に指定する方法を
教えてください。
よろしくお願いします。
ナニは無くともケンサク
https://www.petitmonte.com/bbs/answers?question_id=2258
PageControlにこだわったせいか、検索でこのページは出ませんでした。
いろいろやってみましたが、タブの背景色のさらに外側の色が
気になります。 タブを乗せている、pagecontrolの上部の色ですね。
この部分の色をPagecontrolの色とは異なる色に設定する方法が
あれば教えていただけませんか。
よろしくお願いします。
自己レスです。
PageControlの全体タブの背景色を下記で指定しましたが、
再描画の際、タブの部分の文字列が消えてしまいます。
クリックしたタブのみが表示される状態です。
タブのInvalidate,updateでもNGです。
PageControl1.Canvas.Brush.color:=clred; //getColor(bkTab);
NewRect:=Rect(0,0,PageControl1.ClientWidth,PageControl1.ClientHeight);
PageControl1.Canvas.FillRect(NewRect);
>PageControlにこだわったせいか、検索でこのページは出ませんでした。
PageControlで検索できました。
言い訳ではではなく、感謝をしましょう。
>https://www.petitmonte.com/bbs/answers?question_id=2258
もう一度これを吟味するする事をお奨めします。
>初歩的な質問です。
ホントに「初歩的な質問」？
>タブの背景色のさらに外側の色が気になります...
特注だね...
procedure TForm1.PageControl1Change(Sender: TObject);
begin
PageControl1.Invalidate;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
OldWinProc := PageControl1.WindowProc;
PageControl1.WindowProc := NewWinProc;
end;
procedure ExtDrawTab(Canvas: TCanvas; R: TRect; S: string; Index: Integer);
const
dr = 5;
CL: array[0..7]of TColor = (clBlue, clRed, clFuchsia, clLime, clAqua, clYellow, clGreen, clInfobk);
var
hR: HRGN;
begin
with Canvas do begin
Pen.Color := clAqua;
hR := CreateRectRgn(R.Left, R.Top, R.Right, R.Bottom);
SelectClipRgn(Handle, hR);
RoundRect(R.Left, R.Top, R.Right, R.Bottom + 30, dr, dr);
SelectClipRgn(Handle, 0);
DeleteObject(hR);
Pen.Color := clGray;
OffsetRect(R, 1, 1);
hR := CreateRectRgn(R.Right -dr div 2, R.Top, R.Right, R.Bottom);
SelectClipRgn(Handle, hR);
RoundRect(R.Left, R.Top, R.Right, R.Bottom + 30, dr, dr);
SelectClipRgn(Handle, 0);
DeleteObject(hR);
Canvas.Brush.Color := CL[Index];
Canvas.FillRect(R);
InflateRect(R, -2, -2);
TextRect(R, R.Left + 2, R.Top + 1, S);
end;
end;
type
_TPageControl = class(TPageControl)
end;
procedure ExtDrawPageControl(PageCtrl: TPageControl);
var
I, Y: Integer;
R: TRect;
begin
with PageCtrl, Canvas do begin
DoubleBuffered := True;
Canvas.Font := PageCtrl.Font;
Canvas.Brush.Color := $ffaa99; // TForm(PageCtrl).Color;
R := ClientRect;
FillRect(R);
R := _TPageControl(PageCtrl).DisplayRect;
InflateRect(R, 4, 4);
Frame3D(Canvas, R, clAqua, clBlue, 1);
Y := R.Top;
Font.Color := clGray;
for I := PageCount - 1 downto 0 do begin
if I <> ActivePageIndex then begin
R := TabRect(I);
R.Left := R.Left - 2;
ExtDrawTab(Canvas, R, Pages[I].Caption, I);
Pen.Color := clAqua;
MoveTo(R.Left, Y - 1);
LineTo(R.Right + 1, Y - 1);
end;
end;
if (ActivePageIndex >= 0) then begin
Font.Color := clBlack;
Font.Style := [fsBold];
R := TabRect(ActivePageIndex);
R.Top := R.Top - 2;
R.Left := R.Left - 2;
R.Bottom := R.Bottom + 1;
ExtDrawTab(Canvas, R, Pages[ActivePageIndex].Caption, ActivePageIndex);
end;
end;
end;
procedure TForm1.NewWinProc(var Msg: TMessage);
var
ps: TPaintStruct;
begin
if Msg.Msg = WM_PAINT then begin
BeginPaint(PageControl1.Handle, ps);
EndPaint(PageControl1.Handle, ps);
Msg.Result := 0;
ExtDrawPageControl(PageControl1);
end
else
OldWinProc(Msg);
end;
注文の多い料理店さん、長いソースまで書いて頂いて
ありがとうございます。
Delphiを使って長いのですが、こういうソースを見ると
表面的な機能しか使っていないと実感します。
とても参考になりましたので、この件は解決として
ソースを参考に、さらにいろいろ試してみたいと思います。
| ツイート |  |