Помощь с Pagecontrol

[denisko]

Вопрос таков.
Как сделать заголовок PageControl одного размера?
Суть в том что я сздаю вкладки программно.

Ссылка на исходник в каторм код каторый я испльзую для создание новй вкладки.

Ссылка скрыта от гостей

Желательно покажите на примере как это сделать.

 

[vital]

Напишите код здесь. Никто не будет его качать...

 

[Titan]

качал , но там комопнент используется, который надо дополнительно ставить. пока на это нет времени...

 

[vital]

Еще одна причина просто выложить код сюда=)

 

[denisko]

<div class="sp-wrap"><div class="sp-head-wrap"><div class="sp-head folded clickable">Код</div></div><div class="sp-body"><div class="sp-content"><!--shcode--><pre><code class='ruby'>unit frmMain;

interface

uses
Classes, Controls, Forms, OleCtrls, EmbeddedWB, ComCtrls, StdCtrls,
IEAddress, ExtCtrls, SysUtils;

type
TForm1 = class(TForm)
PageControl1: TPageControl;
Panel1: TPanel;
Button1: TButton;
IEAddress1: TIEAddress;
cbNewTab: TCheckBox;
StatusBar1: TStatusBar;
procedure PageControl1Change(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
procedure DownloadCompleteEvent(Sender: TObject);
function GetActiveEWB: TEmbeddedWB;
procedure UpdateAddress;
procedure UpdateTab;
function CreateNewTabBrowser(Url: string): TTabSheet;
procedure NewWindowEvent(Sender: TObject; var ppDisp: IDispatch; var Cancel: WordBool);
procedure NewWebStatusTextChange(Sender: TObject;
const Text: WideString);
public
{ Public declarations }
end;

var
Form1: TForm1;
DesignTimeWB: TEmbeddedWB;
NewTab: TTabSheet;
i: integer;

implementation

{$R *.dfm}

//--------Private Section---------------------------------------------

procedure TForm1.UpdateTab;
begin
PageControl1.ActivePage := NewTab;
UpdateAddress;
end;

function TForm1.GetActiveEWB: TEmbeddedWB;
var
i: Integer;
begin
Result := nil;
if PageControl1.ActivePage <> nil then
for i := 0 to PageControl1.ActivePage.ControlCount - 1 do
begin
if PageControl1.ActivePage.Controls is TEmbeddedWB then
begin
Result := TEmbeddedWB(PageControl1.ActivePage.Controls);
Exit;
end;
end;
end;

procedure TForm1.UpdateAddress;
var
WB: TEmbeddedWB;
begin
WB := GetActiveEWB;
if Assigned(WB) then
begin
IEAddress1.EmbeddedWB := WB;
IEAddress1.Text := WB.LocationURL;
PageControl1.ActivePage.Caption := WB.LocationName;
end;
end;

procedure TForm1.DownloadCompleteEvent(Sender: TObject);
begin
UpdateAddress;
end;

function TForm1.CreateNewTabBrowser(Url: string): TTabSheet;
begin
NewTab := TTabSheet.Create(PageControl1);
with NewTab do
begin
PageControl := PageControl1;
Parent := PageControl1;
PageIndex := PageControl1.ActivePageIndex;
end;
DesignTimeWB := TEmbeddedWB.Create(NewTab);
TControl(DesignTimeWB).Parent := NewTab;
with DesignTimeWB do
begin
EnableMessageHandler := True;
LoadSettings;
Align := alClient;
OnStatusTextChange := NewWebStatusTextChange;
OnNewWindow2 := NewWindowEvent;
OnDownloadComplete := DownloadCompleteEvent;
if Trim(URL) <> '' then
DesignTimeWB.NavigateWait(URL);
end;
PageControl1.ActivePage := NewTab;
Result := NewTab;
end;

procedure TForm1.NewWindowEvent(Sender: TObject; var ppDisp: IDispatch; var Cancel: WordBool);
begin
CreateNewTabBrowser(DesignTimeWB.LocationURL);
PageControl1.ActivePage := NewTab;
ppdisp := DesignTimeWB.Application;
UpdateTab;
end;

procedure TForm1.PageControl1Change(Sender: TObject);
begin
UpdateAddress;
end;

procedure TForm1.NewWebStatusTextChange(Sender: TObject;
const Text: WideString);
begin
StatusBar1.SimpleText := Text;
end;

//--------End Of Private Section---------------------------------------------

procedure TForm1.FormShow(Sender: TObject);
begin
CreateNewTabBrowser(DesignTimeWB.GetIEHomePage);
UpdateTab;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if cbNewtab.Checked then
begin
CreateNewTabBrowser(IEAddress1.Text);
UpdateTab;
end
else
begin
DesignTimeWB.Go(IEAddress1.Text);
UpdateTab;
end;
end;

end.[/CODE]


Простите прсто вчера деньги кончились на счету,сёдне только положил

<table valign="top" style='margin:0;width:100%;border:1px dashed red;'>[tr]<td align='middle' bgcolor='#ff6060' valign='top' width='1%'>
<FONT color='#ffffff' size='+3'> ! </font>
</td><td align="midle" valign='top' style='background:#fff;'>Спойлер - хорошо, но используйте тег оформления кода, так смотреть удобней.</td>[/tr]</table>

 

[denisko]

Ну что,некто не поможет?

 

[hosm]

Ну что,некто не поможет?

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

 

[denisko]

Ну для этого написан код как и просили

 

[zubr]

Блин, стыдно такие примитивные вопросы задавать. Сколько дней уж прошло, за это время можно было весь help по Delphi перечитать. А потом на многих форумах смеются над Delphi-программистами - типа тупой-еще тупее и ленивые до невозможности. Ничего личного, просто наболело.
Теперь по сути вопроса - у компонента TPageControl (если посмотреть в Help, клавиша F1) есть свойство TabWidth, которое устанавливает ширину для всех заголовков TPageControl.

Specifies the horizontal size, in pixels, of the tabs in the tab control.

Delphi syntax:

property TabWidth: Smallint;

C++ syntax:

__property short TabWidth = {read=FTabSize.x, write=SetTabWidth, default=0};

Description

TabWidth specifies a fixed width for all tabs. If TabWidth is 0, then each tab is automatically made wide enough to show its caption.

Borland Help.
А вот тебе вариант решения установки ширины заголовка по максимально широкому заголовку:

private
{ Private declarations }
procedure SetPageControlTabWidth;

implementation

procedure TForm1.SetPageControlTabWidth;
var
i, widthMax: Integer;
canv: TCanvas;
begin
if PageControl1.PageCount = 0 then
exit;
canv := TCanvas.Create;
try
canv.Handle := GetDC(PageControl1.Handle);
canv.Font.Assign(PageControl1.Font);
PageControl1.TabWidth := canv.TextWidth(PageControl1.Pages[0].Caption);
for i := 1 to PageControl1.PageCount - 1 do
begin
if canv.TextWidth(PageControl1.Pages[i].Caption) > PageControl1.TabWidth then
PageControl1.TabWidth := canv.TextWidth(PageControl1.Pages[i].Caption);
end;
finally
canv.Free;
end;
end;

 

[zubr]

Флуд удалил. Тема закрыта. Все претензии в личку.