Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом

Логин:
Пароль:
Регистрация | Забыли пароль?

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

#   

Статистика за сегодня:  


Лучшие эксперты

Подробнее »



Вопрос # 2 269

/ вопрос открыт /

Здравствуйте, эксперты! Пытаюсь программно перейти на первую вкладку в TabControl, но что-то не то с синтаксисом. Подскажете, что не так?

Приложение:
  1. SendMessage(TabControl1.Handle, 0);
  2. TabControl1.Perform(WM_LBUTTONDOWN, 0);
  3. TabControl1.Perform(WM_LBUTTONUP, 0);


YPCom Вопрос ожидает решения (принимаются ответы, доступен мини-форум)

Вопрос задал: YPCom (статус: Посетитель)
Вопрос отправлен: 6 января 2009, 12:39
Состояние вопроса: открыт, ответов: 1.

Ответ #1. Отвечает эксперт: Пупкин В.В.

Не проще сделать так:

TabControl1.TabIndex:=0;

Ответ отправил: Пупкин В.В. (статус: 1-ый класс)
Время отправки: 6 января 2009, 12:55


Мини-форум вопроса

Всего сообщений: 5; последнее сообщение — 6 января 2009, 13:33; участников в обсуждении: 2.
YPCom

YPCom (статус: Посетитель), 6 января 2009, 13:08 [#1]:

Не подходит. Вкладка выбирается первая, но цвет шрифта на ней не меняется (http://www.delphikingdom.com/asp/answer.asp?IDAnswer=67681).
YPCom

YPCom (статус: Посетитель), 6 января 2009, 13:14 [#2]:

Нужно как-то так TabControl1.OnChange ... и на первую вкладку
Пупкин В.В.

Пупкин В.В. (статус: 1-ый класс), 6 января 2009, 13:18 [#3]:

Принципиальное отличие его от PageControl заключается в том, что TabControl не имеет множества панелей (страниц). Компонент представляет собой одну страницу с управляющим элементом типа кнопки со многими положениями. И надо написать соответствующие обработчики событий OnChanging и OnChange, чтобы определить, что именно должно происходить на панели при переключениях закладок пользователем.

а ваш вопрос-программно перейти на первую вкладку в TabControl
пожалуйста задавайте корректно вопрос, бо какой вопрос такой ответ =)
YPCom

YPCom (статус: Посетитель), 6 января 2009, 13:32 [#4]:

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

YPCom (статус: Посетитель), 6 января 2009, 13:33 [#5]:

unit Unit1;

interface

uses // Использование
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, OleCtrls, SHDocVw, ShellAPI, ActiveX, ExtCtrls,
XPMan;

type // Тип
TForm1 = class(TForm)
TabControl1: TTabControl;
ListBox1: TListBox;
WebBrowser1: TWebBrowser;
Button1: TButton;
Panel1: TPanel;
Panel2: TPanel;
Panel3: TPanel;
Panel4: TPanel;
Panel5: TPanel;
Panel6: TPanel;
XPManifest1: TXPManifest;
procedure TabControl1DrawTab(Control: TCustomTabControl; TabIndex: Integer;
const Rect: TRect; Active: Boolean);
procedure Button1Click(Sender: TObject);
procedure findaddress;
procedure ListBox1Click(Sender: TObject);
procedure TabControl1Change(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure WebBrowser1NavigateComplete2(ASender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
procedure noscroll;

private
{ Private declarations }
public
{ Public declarations }
end;

var
SaveMessageHandler,MyMessageHandler: TMessageEvent; // Надо для возможности копирования из TWebBrowser
Form1: TForm1; // Надо для возможности копирования из TWebBrowser
dir:string; URLs:string;

implementation

{$R *.dfm}
{$R nodescription.RES}



procedure TForm1.FormActivate(Sender: TObject); // При активации формы
var
srSearch: TSearchRec;
path: string;
begin
SaveMessageHandler := Application.OnMessage; // Надо для возможности копирования из TWebBrowser
Application.OnMessage := MyMessageHandler; // Надо для возможности копирования из TWebBrowser
WebBrowser1.Navigate('about:blank'); // Инициализируем пустой документ в TWebBrowser
GetDir(0, dir); // Считываем текущий каталог
if FindFirst(dir + '\*' , faDirectory, srSearch) = 0 then // Ищем в нем каталоги
repeat
if ((srSearch.Attr and faDirectory) = faDirectory) and
(srSearch.Name <> '.') and
(srSearch.Name <> '..') then // Исключаем пустые строки как в проводнике
begin
TabControl1.Tabs.Add(srSearch.Name); // Заполняем TabControl именами корневых каталогов
TabControl1.TabIndex:=0;
end;
until (FindNext(srSearch) <> 0);
FindClose(srSearch); // Завершаем поиск
begin
ListBox1.Clear; // Очищаем ListBox
TabControl1.TabIndex:= 0; // Переходим на 1-ю вкладку в TabControl
path:= dir + '\' + TabControl1.Tabs.Strings[0]; // Считываем каталог с 1-й вкладки
if FindFirst(path + '\*' , faDirectory, srSearch) = 0 then // Ищем в нем каталоги
repeat
if ((srSearch.Attr and faDirectory) = faDirectory) and
(srSearch.Name <> '.') and
(srSearch.Name <> '..') then // Исключаем пустые строки как в проводнике
begin
ListBox1.Items.Add(srSearch.Name); // Заполняем ListBox именами каталогов
end;
until (FindNext(srSearch) <> 0);
FindClose(srSearch); // Завершаем поиск
end;
SendMessage(ListBox1.Handle, LB_SETCURSEL, 0{порядковый номер строки}, 0); // Программно выбираем 1-ю строку в ListBOX
ListBox1.Perform(WM_LBUTTONDOWN, 0, 0);
ListBox1.Perform(WM_LBUTTONUP, 0, 0); // Программно имитируем щелчок по выбранной строке в ListBox
end;



procedure TForm1.ListBox1Click(Sender: TObject); // Щелчок по ListBox
var
i, MaxWidth: integer; // Для гориз. прокрутки в ListBox
begin
GetDir(0, dir); // Считываем текущий каталог
URLs:= dir + '\' + TabControl1.Tabs.Strings[TabControl1.TabIndex] + '\' + ListBox1.Items.Strings[ListBox1.ItemIndex] + '\' + '9.mht';
// Путь к файлу с описанием
if fileexists(URLs) then findaddress // Если файл существует, то показываем его
else // Иначе показываем 'Описание отсутствует' из ресурса
begin
URLs:='';
if URLs='' then WebBrowser1.Navigate('res://' + Application.ExeName + '/HTML/nodescription')
else findaddress;
end;
MaxWidth := 0; // Далее для гориз. прокрутки в ListBox, если назв. не умещается
for i := 0 to LIstBox1.Items.Count - 1 do
if MaxWidth < LIstBox1.Canvas.TextWidth(LIstBox1.Items.Strings[i]) then
MaxWidth := LIstBox1.Canvas.TextWidth(LIstBox1.Items.Strings[i]);
SendMessage(LIstBox1.Handle, LB_SETHORIZONTALEXTENT, (Round(MaxWidth * 1.35) + 2), 0);
end;

procedure TForm1.Button1Click(Sender: TObject); // Щелчок по кнопке "Обзор"
begin
try
ShellExecute(Handle, 'open', PChar(dir + '\' + TabControl1.Tabs.Strings[TabControl1.TabIndex] + '\' + ListBox1.Items.Strings[ListBox1.ItemIndex]), nil, nil, SW_SHOWNORMAL);
// Если такой папки нет, то открываем тематическую
except
ShellExecute(Handle, 'open', PChar(dir + '\' + TabControl1.Tabs.Strings[TabControl1.TabIndex]), nil, nil, SW_SHOWNORMAL);
end;
end;

procedure TForm1.findaddress; // Открываем найденный файл в WebBrowser
var
Flags: OLEVariant;
begin
Flags := 0;
WebBrowser1.Navigate(WideString(URLs), Flags, Flags, Flags, Flags);
end;

procedure TForm1.TabControl1Change(Sender: TObject); // При переходе на другую вкладку
var
srSearch: TSearchRec;
dir_temp: string;
begin
WebBrowser1.Navigate('about:blank'); // Инициализируем пустой документ в TWebBrowser
listBox1.Clear;
GetDir(0, dir); // Считываем текущий каталог
dir_temp:= dir + '\' + TabControl1.Tabs.Strings[TabControl1.TabIndex]; // Находим в нем нужный каталог
if FindFirst(dir_temp + '\*' , faDirectory, srSearch) = 0 then // Ищем в нем каталоги
repeat
if ((srSearch.Attr and faDirectory) = faDirectory) and
(srSearch.Name <> '.') and
(srSearch.Name <> '..') then // Исключаем пустые строки как в проводнике
begin
ListBox1.Items.Add(srSearch.Name); // Заполняем ListBox
end;
until (FindNext(srSearch) <> 0);
FindClose(srSearch); // Заканчиваем поиск
SendMessage(ListBox1.Handle, LB_SETCURSEL, 0{порядковый номер строки}, 0); // Программно выбираем 1-ю строку в ListBOX
ListBox1.Perform(WM_LBUTTONDOWN, 0, 0);
ListBox1.Perform(WM_LBUTTONUP, 0, 0); // Программно имитируем щелчок по выбранной строке в ListBox
end;

procedure TForm1.TabControl1DrawTab(Control: TCustomTabControl;
TabIndex: Integer; const Rect: TRect; Active: Boolean);
var
R:TRect;
Pt:TPoint;
begin
R:=Rect;
SetTextColor(Control.Canvas.Handle,clBlack);
GetCursorPos(Pt);
Pt:=TabControl1.ScreenToClient(Pt);
if PtInRect(R,Pt) then SetTextColor(Control.Canvas.Handle,clBlue)
else SetTextColor(Control.Canvas.Handle,clBlack);
DrawText(Control.Canvas.Handle,PChar((Control as TTabControl).Tabs[TabIndex]),
Length((Control as TTabControl).Tabs[TabIndex]),R,
DT_SINGLELINE or DT_CENTER or DT_VCENTER);
end;

procedure TForm1.WebBrowser1NavigateComplete2(ASender: TObject; // Скрытие скролла в WebBrowser для нулевого URL
const pDisp: IDispatch; var URL: OleVariant);
begin
if URLs='' then noscroll;
end;

procedure TForm1.noscroll; // Скрытие скролла в WebBrowser
begin
WebBrowser1.OleObject.Document.Body.Style.OverflowX := 'hidden';
WebBrowser1.OleObject.Document.Body.Style.OverflowY := 'hidden';
end;

initialization
OleInitialize(nil); // Надо для возможности копирования из TWebBrowser

finalization
OleUninitialize; // Надо для возможности копирования из TWebBrowser

end.

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.

Версия движка: 2.6+ (26.01.2011)
Текущее время: 26 сентября 2020, 04:59
Выполнено за 0.02 сек.
Рейтинг@Mail.ru