PageControl

← →
Marij (2008-05-15 15:34) [0]

Помогите плиз.
Как сделать кнопки переключения межу Tabsheet, чтобы закладок видно не было, а при нажатии кнопки "Далее" и "Назад" происходил переход между страницами.

← →
Ega23 © (2008-05-15 15:40) [1]

TTabSheet.TabVisible, TPageControl.Pages + F1

← →
Palladin © (2008-05-15 15:40) [2]

TPageControl.ActivePageIndex
TTabSheet.TabVisible

+

F1

← →
Игорь Шевченко © (2008-05-15 15:42) [3]

может кто еще подскажет, как легко и просто убрать 3-D эффекты с закладок и с самого PageControl ? :)

← →
Palladin © (2008-05-15 15:59) [4]

:) хе...

Var sbx,sby:Integer; p:TPanel; p:=TPanel.Create(PageControl.Owner); p.BevelOuter:=bvNone; p.Parent:=PageControl.Parent; p.BoundsRect:=PageControl.BoundsRect; PageControl.Parent:=p; sbx:=GetSystemMetrics(SM_CXEDGE)+GetSystemMetrics(SM_CXBORDER); sby:=GetSystemMetrics(SM_CYEDGE)+GetSystemMetrics(SM_CYBORDER); PageControl.SetBounds(-sbx,-sby,p.Width+sbx*2,p.Height+sby*2);

так? :)

← →
Игорь Шевченко © (2008-05-15 16:07) [5]

Palladin © (15.05.08 15:59) [4]

Не, не так. Чтобы вкладки были видны, но плоские
Нечто вроде такого:

http://demos.devexpress.com/ASPxperienceDemos/TabControl/Features.aspx

← →
Ega23 © (2008-05-15 16:11) [6]

> Не, не так. Чтобы вкладки были видны, но плоские

И штобы сам PC плоским можно было зделоть.
Да, это проблема...

← →
TIF © (2008-05-15 16:13) [7]

TMS вам в помощь

← →
Игорь Шевченко © (2008-05-15 16:15) [8]

Ega23 © (15.05.08 16:11) [6]

Сколько не рылся, не нашел примеров. Как саму рамку убрать, нашел, а вкладки, видно, только рисованием. Причем эта зараза после вызова OnDrawTab 3D-эффекты сама рисует.
Хочется быстрого решения, желательно не в 1000 строк кода:) Ну и разумеется, без сторонних компонент

← →
TIF © (2008-05-15 16:33) [9]

TAdvPageControl = class(TCustomTabControl) private FPages: TList; FActivePage: TAdvTabSheet; FNewDockSheet: TAdvTabSheet; FUndockingPage: TAdvTabSheet; FTabMargin: TTabMargin; . . . procedure SetTabSplitLine(Value: Boolean); procedure SetRoundEdges(Value: Boolean); procedure SetTabMargins; procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND; procedure WMPaint(var Message: TWMPaint); message WM_PAINT; . . .

Вот тут-то и запрятано удаление 3D... TMSовцы ребята умные, но ранние версии их новых компонентов иногда глючат и тормозят :(

Футы-нуты! Самое главное забыл:
FTabBorder3D: Boolean;

Вот это свойтсво и включает/отключает 3D рамки!

procedure TAdvPageControl.SetTabBorder3D(Value: Boolean);
var
i: integer;
begin
if FTabBorder3D <> Value then
begin
FTabBorder3D := Value;
if Value then
begin
inherited Images := FImages;
end
else
begin
inherited Images := FDummyImages;
end;
OwnerDraw := not TabBorder3D;

for i := PageCount - 1 downto 0 do
begin
UpdateTab(Pages[I]);
end;

if not FTabBorder3D then
UpdateTabForActiveFont(FActivePage);

Invalidate;
end;
end;

Ну, кто хочет копнуть глубже и подробно изучить принцип, ищите AdvPageControl.pas

← →
Игорь Шевченко © (2008-05-15 16:36) [10]

TIF © (15.05.08 16:33) [9]

К чему этот неформатированный поток сознания ?

← →
TIF © (2008-05-15 16:41) [11]

> К чему этот неформатированный поток сознания ?

к этому

> Сколько не рылся, не нашел примеров.

Без обид

← →
Игорь Шевченко © (2008-05-15 16:44) [12]

TIF © (15.05.08 16:41) [11]

Ты явно не понимаешь. Было сказано, что без сторонних компонентов, без упертых где-то исходников, и т.д.
Или исходники того, откуда ты выдрал кусок, лежат где-то в общеизвестном свободном доступе ? Тогда ссылочку.

← →
TIF © (2008-05-15 17:09) [13]

> Было сказано, что без сторонних компонентов, без упертых
> где-то исходников

Ну, хоть это и сторонний компонент, но в нём используется способ удаления 3д-рамок! А это и является интересной вещью

> Или исходники того, откуда ты выдрал кусок, лежат где-то
> в общеизвестном свободном доступе ? Тогда ссылочку.

Уже да ;)

http://www.infodelphi.narod.ru/advpagecontrol.pas

← →
tormoz (2008-05-15 17:21) [14]

PageControl1.SelectNextPage(true) - вперед
PageControl1.SelectNextPage(false) - назад

← →
Игорь Шевченко © (2008-05-15 17:23) [15]

"No parts of the source code can be included in any other component or application without written authorization of the author."

Вот это внимательно читал ?

← →
tormoz (2008-05-15 17:24) [16]

А чем не подходит TPageControl.Style := tsFlatButtons ?

← →
Palladin © (2008-05-15 17:26) [17]

> tormoz (15.05.08 17:24) [16]

наверное тем, что это не то что нужно...

← →
Игорь Шевченко © (2008-05-15 17:26) [18]

tormoz (15.05.08 17:24) [16]

Тем, что не получается такой картинки, как в [5]

← →
Style © (2008-05-15 17:38) [19]

Ничего не могу умнее придумать кроме того как рисовать все самому

суть такая :)

TXWinControl = class (TWinControl); TForm1 = class(TForm) PageControl1: TPageControl; TabSheet1: TTabSheet; TabSheet2: TTabSheet; Button1: TButton; Button2: TButton; TabSheet3: TTabSheet; TabSheet4: TTabSheet; procedure Button1Click(Sender: TObject); private procedure CustomDraw(Msg: TMessage); { Private declarations } public WndProc: tWndMethod; procedure OnPageWndProc(var Msg: TMessage); { Public declarations } end; procedure TForm1.Button1Click(Sender: TObject); begin TXWinControl(PageControl1).Color := clRed; WndProc := PageControl1.WindowProc; PageControl1.WindowProc := OnPageWndProc; TXWinControl(PageControl1).RecreateWnd; PageControl1.Repaint; end; procedure TForm1.CustomDraw(Msg: TMessage); var i: integer; begin for i := 0 to PageControl1.PageCount-1 do begin PageControl1.Canvas.Rectangle(PageControl1.TabRect(i)); PageControl1.Pages[i].Repaint; end; Msg.Result := 1; end; procedure TForm1.OnPageWndProc(var Msg: TMessage); begin if (Msg.Msg = WM_NCPAINT ) or (Msg.Msg = WM_PAINT )then begin CustomDraw(Msg); end else WndProc(Msg); end;

Только надо работать напильнегом чтобы получилось как [5]

← →
TIF © (2008-05-15 17:41) [20]

> Вот это внимательно читал ?

Читал, изучал. Только для России это не препятствие.

А если уж хочется всё делать законно, то нужно просто купить этот компонент (входит в пакет, стоимость которого около $5000, упрощённая модификация - $50-100)

PS: можно и на форумах всех пересажать за то, что выкладывают в ответ на вопросы куски кода, авторы которых не указаны явно. Кто знает, чьё авторское право они нарушают?

Теперь, как всегда напоследок, главная мысль:

"Не может быть использована полностью (частично)?"

А зачем всё слизывать вподчистую? Может быть, имеет смысл изучить код и на его основе написать свой вариант?!

← →
Игорь Шевченко © (2008-05-15 17:50) [21]

TIF © (15.05.08 17:41) [20]

> Только для России это не препятствие.

Это иллюзия.

> PS: можно и на форумах всех пересажать за то, что выкладывают
> в ответ на вопросы куски кода, авторы которых не указаны
> явно. Кто знает, чьё авторское право они нарушают?

тебя можно не сажать, тебя достаточно просто забанить

← →
TIF © (2008-05-15 18:00) [22]

> тебя можно не сажать, тебя достаточно просто забанить

Кто ж это сказал, "всех не пересажаете"? Это вроде из "Матери" Горького или я опять что-то путаю...
Так вот, "всех не забаните" :) Это нереально

Ну, это право я оставлю российскому законодательству и госдуме. Решайте сами

И всё-таки, на основе изучения этого кода можно написать небольшую процедурку, которая будет убирать 3д-рамки. Кому это реально надо, тот потрудится и сделает это
Мне - не надо. В висте, например, этих рамок и так нет :-)

← →
ketmar © (2008-05-15 19:09) [23]

>[22] TIF © (2008-05-15 18:00:00)
тебе и мозг не нужен — всё равно ты не знаешь, что с ним делать.

---
Understanding is not required. Only obedience.

← →
TIF © (2008-05-15 20:24) [24]

> всё равно ты не знаешь, что с ним делать.

составлять из букв слова? :)

А вот принципом: подсмотрел - сделал как там (почти как там) пользоваться нужно. И волки сыты, и овцы целы. Вот для этого мозг надо

Повторюсь: меня эти рамки не интересуют, ибо проще взять готовый компонент

← →
silver © (2008-05-15 20:28) [25]

> А вот принципом: подсмотрел - сделал как там (почти как
> там) пользоваться нужно. И волки сыты, и овцы целы. Вот
> для этого мозг надо

Для этого не надо.

← →
TIF © (2008-05-15 20:44) [26]

> Для этого не надо.

Слово почти предполагает не тупое списывание, а разбор алгоритма, по пунктам, распознавание слабых мест и лишних операций, реструктцризацию кода и его полное воссоздание с нуля на основе собственного опыта и полученных из представленного примера знаний

Не знаю, как вы, но я при необходимости включить в программу новую незнакомую функцию разбираю её от и до, полностью переписываю. Начиная от простого переименовывания переменных и оформления кода и заканчивания внедрением новых операций/удаления лишних и ненужных и объединения некоторых строк, потому что часто сложные операции разбиваются на несколько простых

Так что надо. Ну, а если списывааааать - то нет...

← →
silver © (2008-05-15 21:01) [27]

Все это и есть - "тупое списывание"

← →
Palladin © (2008-05-15 21:47) [28]

>Игорь Шевченко ©

сдается мне, все рисовать самому нуна :)

← →
Игорь Шевченко © (2008-05-15 21:54) [29]

Palladin © (15.05.08 21:47) [28]

Увы. На уровне TabControl"а я сделал то, чего хотел, а хотелось бы PageControl - у TabControl"а TabSheet-ов нету, а управлять видимостью фреймов при переходе с вкладки на вкладку как-то тоже не очень кузяво.

Придется делать оценку стоимости, что быстрее :)

← →
b z (2008-05-15 22:00) [30]

> управлять видимостью фреймов

А PageControl для этого почему не подходит? т.е. управлять видимостью его TabSheet-ов.

← →
Palladin © (2008-05-15 22:03) [31]

> На уровне TabControl"а я сделал то, чего хотел

если видимость фреймов некузяво почему бы не решить составным? берем TTabControl и TPageControl, с кастрированными табами (и бордюром по желанию) и просто переключать страницы на нем?

или, тоже, не кузяво?

← →
Игорь Шевченко © (2008-05-15 22:24) [32]

Palladin © (15.05.08 22:03) [31]

Куда бы фотку положить, чего я хочу...

http://picasaweb.google.com/ISchevchenko/MoneyScreenshots/photo#5200671843024341890

Вот там как раз то, чего я хочу добиться. В смысле, такого же PageControl-а по виду

← →
DVM © (2008-05-15 22:52) [33]

> Игорь Шевченко © (15.05.08 22:24) [32]

Что-то Вас в последнее время на красивости потянуло. То Edit-ы с градиентами, то табконтролы нестандартные :)

Кстати в отличие от Edit, пейдж котролу с OwnerDraw и без HotTrack вроде как и незачем рисоваться помимо WM_PAINT, что мешает просто WM_PAINT обработать как хочется ?

guav © (15.05.08 23:18) [35]

Ничего не мешает. Просто те решения, которые я видел, были
а) довольно громоздкие.
б) коммерческие.

Если не найду негромоздкого решения, то оставлю TabControl с фреймами, которые буду переключать при смене закладок.

> Edit с градиентом

Я б конечно посоветовал исходники freeware компонента TFlatEdit, но в нём есть один маленький глюк, поэтому ничего не скажу

Игорь Шевченко © (16.05.08 00:01) [38]

Зачем читать, если можно сразу чушь писать?

ТИФ, успокойся, и действительно читай что пишут.

> Игорь Шевченко © (15.05.08 23:03) [34]
>
> DVM © (15.05.08 22:52) [33]
>
> Эстетствую :)
>

В отпуске что-ли?
Вспомни цитату из Швейка.
:)

Игорь вот теперь похоже на [5] ;)

unit u_pcpainter; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, ComCtrls; type TPageControlPainter = class private FPageControl: TPageControl; FWindowProc: TWndMethod; FCanvas: TCanvas; fhTab,FMx,FMy: integer; procedure SetCanvas(const Value: TCanvas); procedure DrawGradient(ACanvas: TCanvas; Rect: TRect; Horicontal: Boolean; Colors: array of TColor); protected procedure CustomWindowProc(var Message: TMessage); virtual; procedure CustomPaint; virtual; procedure PaintTabs(Invalidate: boolean); virtual; public constructor Create(APageControl: TPageControl); destructor Destroy; override; property Canvas: TCanvas read FCanvas write SetCanvas; end; implementation const PCP_BORDERCOLOR = $a68c52; PCP_TABBORDERCOLOR = clSilver; PCP_ACTIVETABGRADUP1 = $ccb893; PCP_ACTIVETABGRADUP2 = $af925b; PCP_ACTIVETABGRADDOWN1 = $8a6a24; PCP_ACTIVETABGRADDOWN2 = $A28649; PCP_HOVERTABGRADUP2 = $f7f5ee; PCP_HOVERTABGRADDOWN1 = $ebe9d4; PCP_HOVERTABGRADDOWN2 = $e2dfc3; type TXControl = class(TControl); TXWinControl = class(TWinControl); { TPageControlPainter } constructor TPageControlPainter.Create(APageControl: TPageControl); begin inherited Create; FPageControl := APageControl; FWindowProc := FPageControl.WindowProc; FPageControl.WindowProc := CustomWindowProc; FCanvas := FPageControl.Canvas; FPageControl.Style := tsButtons; end; procedure TPageControlPainter.CustomPaint; begin Canvas.Pen.Color := PCP_BORDERCOLOR; Canvas.Rectangle( FPageControl.ClientRect.Left, FPageControl.TabRect(0).Bottom-1, FPageControl.ClientRect.Right, FPageControl.ClientRect.Bottom); end; procedure TPageControlPainter.DrawGradient(ACanvas: TCanvas; Rect: TRect; Horicontal: Boolean; Colors: array of TColor); type RGBArray = array[0..2] of Byte; var x, y, z, stelle, mx, bis, faColorsh, mass: Integer; Faktor: double; A: RGBArray; B: array of RGBArray; merkw: integer; merks: TPenStyle; merkp: TColor; begin mx := High(Colors); if mx > 0 then begin if Horicontal then mass := Rect.Right - Rect.Left else mass := Rect.Bottom - Rect.Top; SetLength(b, mx + 1); for x := 0 to mx do begin Colors[x] := ColorToRGB(Colors[x]); b[x][0] := GetRValue(Colors[x]); b[x][1] := GetGValue(Colors[x]); b[x][2] := GetBValue(Colors[x]); end; merkw := ACanvas.Pen.Width; merks := ACanvas.Pen.Style; merkp := ACanvas.Pen.Color; ACanvas.Pen.Width := 1; ACanvas.Pen.Style := psSolid; faColorsh := Round(mass / mx); for y := 0 to mx - 1 do begin if y = mx - 1 then bis := mass - y * faColorsh - 1 else bis := faColorsh; for x := 0 to bis do begin Stelle := x + y * faColorsh; faktor := x / bis; for z := 0 to 3 do a[z] := Trunc(b[y][z] + ((b[y + 1][z] - b[y][z]) * Faktor)); ACanvas.Pen.Color := RGB(a[0], a[1], a[2]); if Horicontal then begin ACanvas.MoveTo(Rect.Left + Stelle, Rect.Top); ACanvas.LineTo(Rect.Left + Stelle, Rect.Bottom); end else begin ACanvas.MoveTo(Rect.Left, Rect.Top + Stelle); ACanvas.LineTo(Rect.Right, Rect.Top + Stelle); end; end; end; b := nil; ACanvas.Pen.Width := merkw; ACanvas.Pen.Style := merks; ACanvas.Pen.Color := merkp; end; end; procedure TPageControlPainter.PaintTabs(Invalidate: boolean); var i: integer; rct: tRect; procedure localpaintTab(color: TColor); begin rct := FPageControl.TabRect(i); rct.Left := rct.Left - 2; rct.Right := rct.Right + 2; Canvas.Pen.Color := Color; FPageControl.Canvas.Rectangle(rct); if Invalidate then FPageControl.Pages[i].Invalidate; end; procedure doubleGrad(c1,c2,c3,c4: tColor); begin InflateRect(rct,-1,-1); DrawGradient(Canvas,Rect(rct.Left,rct.Top,rct.Right,rct.Bottom-((rct.Bottom-rct.Top) div 2)+2),false,[c1,c2]); DrawGradient(Canvas,Rect(rct.Left,rct.Top+((rct.Bottom-rct.Top) div 2)+2,rct.Right,rct.Bottom),false,[c3,c4]); end; begin SetBkMode(Canvas.Handle,TRANSPARENT); for i := 0 to FPageControl.PageCount-1 do begin if i <> FPageControl.ActivePageIndex then begin localpaintTab(PCP_TABBORDERCOLOR); if fhTab = i then doublegrad(PCP_HOVERTABGRADUP2, clWhite, PCP_HOVERTABGRADDOWN1, PCP_HOVERTABGRADDOWN2) else doublegrad(clWhite,clwhite,clwhite, PCP_HOVERTABGRADUP2); Canvas.Font.Color := clBlack; SetBkMode(Canvas.Handle,TRANSPARENT); DrawText(Canvas.Handle, PChar(FPageControl.Pages[i].Caption), Length(FPageControl.Pages[i].Caption), Rct, DT_SINGLELINE or DT_VCENTER or DT_CENTER); end else continue; end; i := FPageControl.ActivePageIndex; localpaintTab(PCP_BORDERCOLOR); doublegrad(PCP_ACTIVETABGRADUP1, PCP_ACTIVETABGRADUP2, PCP_ACTIVETABGRADDOWN1, PCP_ACTIVETABGRADDOWN2); DrawGradient(Canvas,Rect(0,rct.Bottom,FpageControl.Width,rct.Bottom+4),false,[PCP_ACTIVETABGRADDOWN2,PCP_BORDERCOLOR]); Canvas.Font.Color := clWhite; SetBkMode(Canvas.Handle,TRANSPARENT); DrawText(Canvas.Handle, PChar(FPageControl.Pages[i].Caption), Length(FPageControl.Pages[i].Caption), Rct, DT_SINGLELINE or DT_VCENTER or DT_CENTER); end; procedure TPageControlPainter.CustomWindowProc(var Message: TMessage); var i: integer; pt: TPoint; begin FWindowProc(Message); if(Message.Msg = WM_NCHITTEST) then begin pt := Point(LOWORD(Message.LParam),HIWORD(Message.LParam)); ScreenToClient(FPageControl.Handle,pt); fMx := pt.X; fMy := pt.Y; i := fhTab; fhTab := -1; fhTab := FPageControl.IndexOfTabAt(fMx,fMy); if(fhTab <> i) then PaintTabs(false); end; if(Message.Msg = WM_NCPAINT ) or (Message.Msg = WM_PAINT ) then begin CustomPaint; PaintTabs(true); end else end; destructor TPageControlPainter.Destroy; begin FPageControl.WindowProc := FWindowProc; inherited; end; procedure TPageControlPainter.SetCanvas(const Value: TCanvas); begin FCanvas := Value; end; end.

Мигает из-за перерисовки страницы.

Во первых надо еще в Create паинтера добавить

FPageControl.OwnerDraw := true;

потом

procedure localpaintTab(color: TColor); begin rct := FPageControl.TabRect(i); rct.Left := rct.Left - 2; rct.Right := rct.Right + 2; Canvas.Pen.Color := Color; FPageControl.Canvas.Rectangle(rct); // Вот это убрать if Invalidate then // Вот это убрать FPageControl.Pages[i].Invalidate; end;

и добавить

begin
if FPageControl.ActivePageIndex > -1 then if Invalidate then FPageControl.Pages[FPageControl.ActivePageIndex].Invalidate;
перед SetBkMode(Canvas.Handle,TRANSPARENT);

Да и вообще хотелось сделать вот так.

procedure TPageControlPainter.CustomWindowProc(var Message: TMessage); var i: integer; pt: TPoint; begin if(Message.Msg = WM_NCHITTEST) then begin FWindowProc(Message); pt := Point(LOWORD(Message.LParam),HIWORD(Message.LParam)); ScreenToClient(FPageControl.Handle,pt); fMx := pt.X; fMy := pt.Y; i := fhTab; fhTab := -1; fhTab := FPageControl.IndexOfTabAt(fMx,fMy); if(fhTab <> i) then PaintTabs(false); end; if(Message.Msg = WM_NCPAINT ) or (Message.Msg = WM_PAINT ) then begin CustomPaint; PaintTabs(true); end else FWindowProc(Message); end;

т.е. чтобы вообще не передавать старому WindowProc
события WM_PAINT и WM_NCPAINT
а рисовать самому.
CustomPaint;
PaintTabs(true);

Но так почему-то, я пока не понял, все трясется вообще и постоянно моргает. Возможно надо обработать еще WM_ERASEBKGND.

Style © (16.05.08 10:23) [43]

Поменял. Трясется также. При тряске (например, при изменении размера) видны старые нарисованные следы (например, рамка фокуса и 3D-бордюр от табов). Если при изменении размера возникает скроллер табов (две кнопки со стрелками), то их фон не перерисовывается и остается то, что было до ресайза.
Но в любом случае - спасибо.

> При тряске (например, при изменении размера) видны старые
> нарисованные следы (например, рамка фокуса и 3D-бордюр от
> табов).

Во-во я про это и писал что пока не понял почему вообще все трясется если не передавать WindowProc. И рисую поверх старого :(

> Если при изменении размера возникает скроллер табов (две
> кнопки со стрелками), то их фон не перерисовывается и остается
> то, что было до ресайза.

На счет кнопок я тоже думал, но пока до них не дошел.

Вообще по-хорошему надо ограничить регион ClipingRect только областью тела табшита, а все Табы не только рисовать самому, но и обрабатывать нажатия мыши, переносы на други строки и соотвественно размеры табов делать свои ,а не те к которые TabCtrl_GetItemRect(Handle, Index, Result); возвращает
и не зависимо от Style самого PageControl"а

Style © (16.05.08 10:48) [45]

> обрабатывать нажатия мыши, переносы на други строки и соотвественно
> размеры табов делать свои ,а не те к которые TabCtrl_GetItemRect(Handle,
> Index, Result); возвращает

в Wine надо поглядеть, как оно там устроено,они ж старались полной совместимости по внешнему виду добиться.

ну да собсно это же comctl32.dll
а в Wine эта библиотека должна быть реализована.

PageControl Найти похожие ветки