Помощь с Pagecontrol

Тема в разделе "Delphi - Компоненты", создана пользователем denisko, 24 ноя 2009.

Статус темы:
Закрыта.
  1. denisko

    denisko Гость

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

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

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

    vital Больной Компом Детектед
    Команда форума Web Team

    Регистрация:
    29 янв 2006
    Сообщения:
    2.470
    Симпатии:
    27
    Напишите код здесь. Никто не будет его качать...
     
  3. Titan

    Titan Well-Known Member

    Регистрация:
    10 июн 2004
    Сообщения:
    105
    Симпатии:
    0
    качал , но там комопнент используется, который надо дополнительно ставить. пока на это нет времени...
     
  4. vital

    vital Больной Компом Детектед
    Команда форума Web Team

    Регистрация:
    29 янв 2006
    Сообщения:
    2.470
    Симпатии:
    27
    Еще одна причина просто выложить код сюда=)
     
  5. denisko

    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>
     
  6. denisko

    denisko Гость

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

    hosm * so what *

    Регистрация:
    18 май 2009
    Сообщения:
    2.450
    Симпатии:
    7
    может, Некто и поможет, но пока никто не хочет.
    Скорее всего, как тебе отписали, народ не хочет качать и ставить себе лишний компонент (по крайней мере, я бы так поступила на их месте, но я уже давно делфи не занимаюсь), а пробовавших его поблизости не оказалось.
     
  8. denisko

    denisko Гость

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

    zubr Гость

    Блин, стыдно такие примитивные вопросы задавать. Сколько дней уж прошло, за это время можно было весь help по Delphi перечитать. А потом на многих форумах смеются над Delphi-программистами - типа тупой-еще тупее и ленивые до невозможности. Ничего личного, просто наболело.
    Теперь по сути вопроса - у компонента TPageControl (если посмотреть в Help, клавиша F1) есть свойство TabWidth, которое устанавливает ширину для всех заголовков TPageControl.
    Borland Help.
    А вот тебе вариант решения установки ширины заголовка по максимально широкому заголовку:
    Код (Text):
    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;
     
  10. zubr

    zubr Гость

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

Поделиться этой страницей