Здравствуйте форумчани в этой статье будут все возможные компоненты для Delphi AlphaControls
Итак, AlphaControls - это набор стандартных и некоторых уникальных компонентов, поддерживающих скины (AlphaSkins), а также имеющих некоторые дополнительнвые возможности. Все элементы скина могут иметь свои собственные свойства для рисования продвинутого градиента, реалистичных рамок, полу-прозрачности и размытых теней. Графические функции производят все расчеты и рисования в real-time, что позволяет гибко приспосабливаться к используемым цветовым схемам системы. Добавлено свойство BoundLabel для элементов редактирования. Обрабатываются различные события мыши, что дает некоторые допонительные возможности компонентам. Менеджер подсказок управляет подсказками в приложении и придает им красивый вид с множеством настроек, которые можно изменять с помощью специального дизайнера. Аналоги стандартных компонентов обеспечивают все функциональные возможности и добавляют множество новых решений для улучшения работы программ и качества их внешнего вида.
[Ссылки могут видеть только зарегистрированные пользователи. ]
[Ссылки могут видеть только зарегистрированные пользователи. ]
[Ссылки могут видеть только зарегистрированные пользователи. ]
JCL поставляется в виде архива, содержащего исходные файлы библиотеки, файлы справки, несколько экспертов для IDE и установщик, способный установить всё это в Delphi. Библиотека JCL может установлена в Delphi с 6й(более ранние не проверял) по 2009 версию, включая Delphi Turbo Explorer.
Примечание: при первой установке JCL и JVCL не получится установить с помощью Lazy Delphi Builder. Причина в том, что обе библиотеки настраиваются при помощи .inc-файлов, а эти файлы генерируются установщиком Jedi при первой установке. Впрочем, при желании их можно сгенерировать и вручную из шаблона.
Полностью разобраться со всем и подробно описать, задача нереальная. Поэтому я дам только поверхностное описание Jedi Code Library 3.35, основанное на справке той же версии:
Функции, процедуры и типы появившиеся только в старших версиях Delphi, для облегчения поддержания классов и компонентов в старых версиях Delphi. Проще говоря, если необходимо скомпилировать код из Delphi 2007, например, в Delphi 5, то JCL может немного упростить процесс перевода.
Containers. Абстрактный класс и интерфейсы для реализации потокобезопасных(thread-safe) контейнеров(векторы, связанные списки, ассоциативные массивы).
Интерфейсы: IJclIterator, IJclIntfCollection, IJclCollection, IJclIntfList, IJclList, IJclIntfArray, IJclArray, IJclIntfSet, IJclSet, IJclIntfTree, IJclTree, IJclIntfIntfMap, IJclMap, IJclIntfQueue, IJclQueue, IJclSortedMap, IJclIntfSortedSet, IJclSortedSet, IJclIntfStack, IJclStack, IJclStrIterator, IJclStrCollection, IJclStrList, IJclStrSet, IJclStrTree, IJclMultiIntfIntfMap, IJclStrIntfMap, IJclStrStrMap, IJclStrMap, IJclStrStrSortedMap, IJclStrStack, TJclTraverseOrder
Классы реализующие: хеш-таблицы, ассоциативные массивы, векторы, стеки, очереди, массивы, ordered sets(упорядоченные множества?).
Date and time. Функции по работе с датой и временем(вычисление Пасхи, преобразование в формат дат других ОС и файловых систем), функции и интерфейсы для реализации планировщика задач(IJclSchedule, IJclScheduleDayFrequency, IJclDailySchedule, IJclWeeklySchedule, IJclMonthlySchedule, IJclYearlySchedule – если кому-нибудь доводилось реализовывать планирование "как в Outlook-е”, то он в курсе сколько там возни;-)), а также таймеры для замеров времени выполнения кода.
Debugging. Очень мощная поддержка отладки кода: функции по отправке сообщения отладчику, перехват исключений(exceptions hooks), получение информации об обработчике исключения(except frame), парсер map-файлов, получение информации из стека вызовов, включая получение имени класса, процедуры и номера строки вызвавшей исключение. См. также статью на Rsdn: Локализация ошибок в приложениях Delphi с помощью библиотеки Jedi Code Library.
Expression Evaluation. Разбор и вычисление выражений. Классы для анализа и вычисления математических выражений, позволяющих контролировать анализ, вычисления, классы умеющие компилировать вычисленное выражение в бинарный код и возвращать указатель на скомпилированную функцию, работа со списками выражений.
Files and IO. Работа с файловой системой. Функции для получения детальной информации о файлах(дата время модификации, создателя, владельца), поиска файлов по маске, получения списка файлов в каталоге, создания резервных копий, удаления в корзину, блокировка диска(lock volume), работа с NTFS(сжатие, работа с потоками и другие, - более 20 функций), манипуляции с путями(paths), работа с временными файлами, работа с отображаемыми в память файлами.
Graphics. Сюда входят классы для манипуляций с изображениями(бывшая библиотека Graphics32), функции для работы с цветовыми каналами, функции для сохранения полноцветных иконок(allowing for > 16 colors) в Tstream и файл, функции для манипуляции с TRect, класс-обёртка над регионами(wrapper for windows regions) - TjclRegion,
Internationalisation. Классы для работы с клавиатурными раскладками(keyboard layout): получение списка доступных, активация, выгрузка, просмотр свойств раскладки. Классы для получения информации о локалях(locale) – получение списка, чтение информации.
MAPI. Классы и функции по работе с мейлами через MAPI. Содержит классы: TJclEmail, TJclEmailRecip, TJclEmailRecips, TJclSimpleMapi.
Libraries, Processes and Threads. Классы и структуры для чтения Portable Executable File Format. Потокобезопасные функции по работе с integer(LockedCompareExchange, LockedExchangeAdd, LockedAdd, LockedExchangeSub, LockedSub, LockedExchange, LockedExchangeInc, LockedInc, LockedExchangeDec, LockedDec). Объекты синхронизации: TJclCriticalSection, TJclCriticalSectionEx, TJclDispatcherObject, TJclEvent, TJclMeteredSection, TJclMultiReadExclusiveWrite, TJclMutex, TJclOptex, TJclSemaphore, TJclWaitableTimer.
Math routines.
TJclComplex – класс, реализующий комплексные числа и следующие операции над ними: базовая арифметика, натуральные логарифмические и экспоненциальные функции, тригонометрические функции, гиперболические тригонометрические функции, комплексные функции Бесселя.
Функции по работе с CRC(crc16 и crc32)
Поддержка чисел с плавающей запятой.
Работа с FPU(8087) (чтение каких-то данных)
Различные математические функции .
Memory, Classes and Objects. Функции и классы по работе с памятью, манипуляции с DMT, VMT.
Guards отвечают за автоматическое освобождение выделенной памяти при выходе из области видимости(scope). Насколько я понял, guards делает то же, что и try…finally блок, но с меньшим количеством набранного кода.
Манипуляции с классами. Включают в себя функции, проверяющие является ли указатель классом или объектом(IsClass, IsObject), функцию пытающуюся реализовать грязный хак по подмене родительского класса – SetClassParent(не представляю где подобное может понадобится), а также функции по получению информации о виртуальных и динамических методах, списках методов и полей
MIME. Функции по MIME кодированию, декодированию(MIME64).
Miscellaneous. Функции позволяющие выключить, перезагрузить компьютер, запустить процесс от имени пользователя, изменить разрешение экрана.
Ordinal Math and Logic. (затрудняюсь описать)
Registry and Ini files. Функции(только функции) для работы с реестром(без использования TRegistry) и ini-файлами.
Runtime Type Information. Получение и генерация RTTI информации. Для получения информации в JCL объявлена функция JclTypeInfo, возвращающая один из интерфейсов: IJclBaseInfo, IJclClassTypeInfo, IJclDynArrayTypeInfo, IJclEnumerationTypeInfo, IJclEventTypeInfo, IJclFloatTypeInfo, IJclInt64TypeInfo, IJclInterfaceTypeInfo, IJclOrdinalRangeTypeInfo, IJclOrdinalTypeInfo, IJclSetTypeInfo, IJclStringTypeInfo, IJclTypeInfo. Для генерации RTTI, JCL предоставляет следующие функции: JclGenerateSetType, JclGenerateEnumType, JclGenerateEnumTypeBasedOn, JclGenerateSubRange, RemoveTypeInfo.
String Manipulation. Функции для манипуляции со строками и списками строк: поиск, замена, тестирование символов.
System Information Routines. Получение информации о системе
Common Folders. Функции возвращающие пути до системных папок. Примерно такие: GetCommonAppdataFolder, GetStartmenuFolder, GetSendToFolder
Environment. Функции для чтения, создания, удаления и редактирования переменных окружения(Environment variables).
Hardware. Чтение информации о процессоре(-ах), о кэше процессора, CPUID, Mac-адреса, TestFDIVInstruction.
Identification. Получение серийных номеров дисков(Volumes), информации о BIOS-е, компьютере, домене.
А также, функции реализующие получение информации о свободной памяти, версии Windows, проверкe включен ли User Account Control, чтение состояния клавиатуры.
Unicode. Функции по работе с юникодом, в основном из библиотеки Mike Lischke. Включает в себя классы TWideStrings, TWideStringList, а также классы для поиска TURESearch(поиск с использованием регулярных выражений) и TUTBMSearch(поиск по алгоритму Бойера — Мура). Все эти функции работают также в версиях Delphi, не поддерживающих юникод(!).
Unit Conversions. Функции для перевода из одних единиц измерения в другие.
LAN Manager. Функции для управления группами и пользователями: чтение, создание, удаление.
RegularExpressions. Регулярные выражения. Согласно хелпу, содержит заголовки и классы к pcre.dll(Perl-compatible Regular Expressions).
Security. Проверка доступа и наличия привилегий.
Shell. Работа с shortcuts, PIDL-ами, иконками shell, и такими функциями: SHDeleteFolder, SHDeleteFiles, SHRenameFile, SHEnumFolderFirst, SHEnumFolderClose, SHEnumFolderNext.
Windows NT Service control
[Ссылки могут видеть только зарегистрированные пользователи. ] Установка
После скачивания распаковать папки jcl и jvcl в диск C для корректной работы. Установка JCL
Открываем папку jcl, потом ещё раз jcl
Запускаем файл Install.bat
Откроется такое окно
[Ссылки могут видеть только зарегистрированные пользователи. ]
Выберите вкладку MPL 1.1 License и согласитесь с условиями лицензии, поставив галочку на I agree with the terms of the MPL 1.1 license
Нажмите кнопку Install
Появится вот такое маленькое окошко
[Ссылки могут видеть только зарегистрированные пользователи. ]
Нажмите Yes
Откроется ещё одно вот такое окошко
[Ссылки могут видеть только зарегистрированные пользователи. ]
Жмёте No
Произойдет компиляция файлов jcl
[Ссылки могут видеть только зарегистрированные пользователи. ]
После завершения компиляции можете закрывать JEDI Installer нажав на кнопку Quit
Идём в папку JVCL
Ищем install.bat и запускаем его
Откроется такое окно
[Ссылки могут видеть только зарегистрированные пользователи. ]
Жмём Next ещё раз Next
Убираем галочку с Build packages и жмём Next
[Ссылки могут видеть только зарегистрированные пользователи. ]
Теперь там где находится Show packages меняем с Desegntime на Runtime
и снимаем галочки с jvBDE, jvDB, JVDLgs, JVDotNetCtrls ,JVNet
[Ссылки могут видеть только зарегистрированные пользователи. ]
Жмём Next, потом Install
Результат
[Ссылки могут видеть только зарегистрированные пользователи. ]
Жмёте Finish заходите в Delphi и смотрите.
[Ссылки могут видеть только зарегистрированные пользователи. ]
1)Помощник ввода кода
2)Подсветка структуры кода и выделение линиями блоков кода
3)Расширенные формы поиска Модулей/Форм
4)Мастер автоматической установки TabOrder
5)Дополнительные панели инструментов в конструкторе форм
6)Интеграция MSDN справки в среду разработки
7)Панель инструментов в редакторе кода
8)Инструменты для расширенной работы с проектом
9)Много строчная палитра компонентов
10(Сворачивание установка \"поверх всех\" для окон IDE
11)Статистика по исходным кодам
12)Очистка секции Uses от неиспользуемых модулей
13)Быстрый поиск компонента
Советую!!!!!!! Скачать
[Ссылки могут видеть только зарегистрированные пользователи. ]
Простой не визуальный delphi компонент, способный добавить вашу программу в Автозапуск Windows.
Имеет следующие параметры:
[Ссылки могут видеть только зарегистрированные пользователи. ]
Key: За автозапуск отвечают три ключа реестра: RUN, RUNSERVICES, RUNONCE
последний запустит вашу программу один раз;
Active: Если это значение true, то ваше приложения добавляется в автозапуск,
иначе удаляется (если было до этого добавлено);
Title: Не обязательный параметр, помечает вашу программу в реестре;
[Ссылки могут видеть только зарегистрированные пользователи. ]
Сегодня хочу выложить на ваш суд компонент под названием Dynamic Skin Form. На мой взгляд, отличный компонент способный сделать из ваших простых серых программ, некие шедевры дизайнерской мысли. Не верите, смотрите на скриншот
[Ссылки могут видеть только зарегистрированные пользователи. ]
[Ссылки могут видеть только зарегистрированные пользователи. ]
Короче если кто не понял, dynamic skin form - это компонент для поддержки скинов в вашей программе. Честно вам признаюсь что после установки с компонентом надо немного разобраться. Но я думаю для вас это не составит большого труда. В общем качаем, устанавливаем, разбираемся и Наслаждаемся !
Установка: тестировалось 7 версии delphi. Никаких проблем. Да еще хочу сказать пару слов об установке данного компонента. Распаковываем архив=> В Delphi 7 жмем на вкладку Component => Instal Packages => Давим на кнопку Add => Заходим в папку куда распаковали архив => выбираем соответствующий bpl файл. После этого рекомендую скопировать все файлы из архива в папку установки Delphi\Projects\Bpl\
[Ссылки могут видеть только зарегистрированные пользователи. ]
Компонент предназначен для создания своего собственного Icq клиента, бота или просто программы для быстрого обмена сообщениями по протоколу ICQ. Кстати на счет протокола. В настоящее время это единственный стабильно работающий компонент, а данная версия заточена под новые изменения в нем. Пример Работы
Код:
unit MainForm;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, XPMan, ICQClient, ICQWorks, StdCtrls, Buttons, ExtCtrls, ExtDlgs,
GetUserInfo, Menus;
type
TfrmMain = class(TForm)
ICQClient: TICQClient;
XPManifest: TXPManifest;
grbLogin: TGroupBox;
lblUIN: TLabel;
edtUIN: TEdit;
lblPwd: TLabel;
edtPwd: TEdit;
btnConnect: TBitBtn;
btnDisconnect: TBitBtn;
grbStatuses: TGroupBox;
cmbStatus: TComboBox;
lblStatusNote: TLabel;
lblXStatusNote: TLabel;
cmbXStatus: TComboBox;
lblNewXStatusNote: TLabel;
cmbNewXStatus: TComboBox;
lblNewXStatusTextNote: TLabel;
mmoNewXStatusText: TMemo;
btnSetNewXStatus: TButton;
shpLineDIV: TShape;
grbContacts: TGroupBox;
grbEvents: TGroupBox;
mmoEvents: TMemo;
lstContactList: TListBox;
tmrWaitToAskCL: TTimer;
gtbSendMsg: TGroupBox;
edtUINToSendTo: TLabeledEdit;
mmoSendMsg: TMemo;
btnSendMsg: TBitBtn;
btnExit: TBitBtn;
grbAbout: TGroupBox;
lblAbout1: TLabel;
lblAbout2: TLabel;
lblAbout3: TLabel;
lblAbout4: TLabel;
lblHyperlink: TLabel;
lblAbout5: TLabel;
btnMask: TButton;
tmrTypingNotification: TTimer;
dlgUploadAvatar: TOpenPictureDialog;
ppmContactMenu: TPopupMenu;
ppmnAskAvatar: TMenuItem;
grbAvatarsControl: TGroupBox;
btnUploadMyAvatar: TButton;
btnResetMyAvatar: TButton;
procedure AddEvent(EventText : String);
function GetStatusFromCmbStatus : Cardinal;
procedure btnConnectClick(Sender: TObject);
procedure cmbXStatusChange(Sender: TObject);
procedure btnSetNewXStatusClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ICQClientLogin(Sender: TObject);
procedure ICQClientLogOff(Sender: TObject);
procedure btnDisconnectClick(Sender: TObject);
procedure cmbStatusChange(Sender: TObject);
procedure ICQClientConnectionFailed(Sender: TObject);
procedure ICQClientError(Sender: TObject; ErrorType: TErrorType;
ErrorMsg: String);
procedure ICQClientServerListRecv(Sender: TObject;
SrvContactList: TList);
procedure ICQClientStatusChange(Sender: TObject; UIN: String;
Status: Cardinal);
procedure tmrWaitToAskCLTimer(Sender: TObject);
procedure ICQClientUserOffline(Sender: TObject; UIN: String);
procedure ICQClientMessageRecv(Sender: TObject; Msg, UIN: String);
procedure ICQClientOfflineMsgRecv(Sender: TObject; DateTime: TDateTime;
Msg, UIN: String);
procedure ICQClientAddedYou(Sender: TObject; UIN: String);
procedure btnSendMsgClick(Sender: TObject);
procedure lblHyperlinkClick(Sender: TObject);
procedure lstContactListMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure btnMaskClick(Sender: TObject);
procedure ICQClientTypingNotification(Sender: TObject; UIN: String;
NotificationType: Word);
procedure tmrTypingNotificationTimer(Sender: TObject);
procedure mmoSendMsgChange(Sender: TObject);
procedure ICQClientAvatarReceive(Sender: TObject; UIN: String;
AvatarId: Word; AvatarFlags: Byte; AvatarHash, AvatarData,
AvatarExt: String);
procedure ICQClientExtServiceReady(Sender: TObject);
procedure ppmnAskAvatarClick(Sender: TObject);
procedure btnUploadMyAvatarClick(Sender: TObject);
procedure btnResetMyAvatarClick(Sender: TObject);
procedure ICQClientOnlineInfo(Sender: TObject; UIN: String; Port: Word;
InternalIP, ExternalIP: String; OnlineTime: TDateTime;
IdleTime: Word; ICQVersion, MirandaVersion: Cardinal; ProtoVer: Byte;
UserCaps: String; AvatarId: Word; AvatarFlags: Byte;
AvatarHash: String; NewXStatusSet: Boolean; NewXStatusMoodNum: Byte;
NewXStatusNote: String);
private
{ Private declarations }
public
{ Public declarations }
end;
const
Crlf = Chr(13) + Chr(10);
var
frmMain: TfrmMain;
NeedToConnectAgain, FullReloadContactList : Boolean;
T : TextFile;
implementation
{$R *.dfm}
procedure TfrmMain.AddEvent(EventText : String);
begin
EventText := DateToStr(Date) + ' ' + TimeToStr(Time) + ' | ' + EventText;
if mmoEvents.Text = '' then
mmoEvents.Text := EventText
else
mmoEvents.Lines.Add(EventText);
Write(T, Crlf + EventText);
end;
function TfrmMain.GetStatusFromCmbStatus : Cardinal;
var
Rs : Cardinal;
begin
Rs := S_ONLINE;
case cmbStatus.ItemIndex of
1: Rs := S_INVISIBLE;
2: Rs := S_AWAY;
3: Rs := S_NA;
4: Rs := S_OCCUPIED;
5: Rs := S_DND;
6: Rs := S_FFC;
7: Rs := S_HOME; //дома
8: Rs := S_ANGRY; //злой
9: Rs := S_DEPRESSION; //депрессия
10: Rs := S_WORK; //на работе
11: Rs := S_EATING; //кушаю
end;
Result := Rs;
end;
procedure TfrmMain.btnConnectClick(Sender: TObject);
begin
ICQClient.ConvertToPlaintext := True; //Convert RTF text to plain (when you don't use TRichEdit)
ICQClient.UIN := StrToInt(edtUIN.Text);
ICQClient.Password := edtPwd.Text;
try
if cmbStatus.ItemIndex = 0 then
ICQClient.Login(S_ALLOWDAUTH)
else
ICQClient.Login(GetStatusFromCmbStatus + S_ALLOWDAUTH);
except
ShowMessage('Невозможно установить соединение, проверьте настройки файерволла и подключения к интернету!');
end;
end;
procedure TfrmMain.cmbXStatusChange(Sender: TObject);
begin
ICQClient.XStatus := cmbXStatus.ItemIndex;
end;
procedure TfrmMain.btnSetNewXStatusClick(Sender: TObject);
begin
if cmbNewXStatus.ItemIndex > 0 then
ICQClient.SetNewXStatusByICQMoodNum(cmbNewXStatus.ItemIndex - 1, mmoNewXStatusText.Text + ' ')
else
ICQClient.SetNewXStatus(X_NONE, mmoNewXStatusText.Text + ' ');
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
ChDir(ExtractFilePath(Application.ExeName));
AssignFile(T, 'events.log');
if FileExists('events.log') then
Append(T)
else
begin
Rewrite(T);
Write(T, '------ Лог событий программы CheatICQ ------');
end;
UINNickList := TList.Create;
UINStatusList := TList.Create;
UINInfoList := TList.Create;
UINForAvatarsToBeLoadedList := TList.Create;
end;
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
UINNickList.Destroy;
UINStatusList.Destroy;
UINInfoList.Destroy;
UINForAvatarsToBeLoadedList.Destroy;
if ICQClient.LoggedIn then
ICQClient.LogOff;
CloseFile(T);
end;
procedure TfrmMain.ICQClientLogin(Sender: TObject);
begin
AddEvent('Успешно подключились под номером ' + IntToStr(ICQClient.UIN));
NeedToConnectAgain := True;
btnConnect.Enabled := False;
btnDisconnect.Enabled := True;
tmrWaitToAskCL.Enabled := True; //запрос списка контактов и оффлайн-сообщений
//делаем с небольшой задержкой
end;
procedure TfrmMain.ICQClientLogOff(Sender: TObject);
begin
AddEvent('Успешно отключились');
btnDisconnect.Enabled := False;
btnConnect.Enabled := True;
end;
procedure TfrmMain.btnDisconnectClick(Sender: TObject);
begin
NeedToConnectAgain := False;
ICQClient.LogOff;
end;
procedure TfrmMain.cmbStatusChange(Sender: TObject);
begin
ICQClient.Status := GetStatusFromCmbStatus + S_ALLOWDAUTH;
ICQClient.Status := GetStatusFromCmbStatus + S_ALLOWDAUTH;
end;
procedure TfrmMain.ICQClientConnectionFailed(Sender: TObject);
begin
if NeedToConnectAgain then
begin
AddEvent('Подключение сорвалось! Переподключаемся...');
btnConnectClick(Self);
end;
end;
procedure TfrmMain.ICQClientError(Sender: TObject; ErrorType: TErrorType;
ErrorMsg: String);
begin
AddEvent('Ошибка! ' + ErrorMsg);
end;
procedure TfrmMain.ICQClientServerListRecv(Sender: TObject;
SrvContactList: TList);
var
i : LongInt;
UserInfo: TUINEntry;
UINNickItem : PUINNickItem;
begin
//Список контактов может прийти по частям!
//Версия 1.26 это не учитывала!
//Очищаем списки только тогда, когда сделали новый запрос списка контактов
if FullReloadContactList then
begin
FullReloadContactList := False;
lstContactList.Clear;
UINNickList.Clear;
end;
if SrvContactList.Count > 0 then
for i := 0 to SrvContactList.Count - 1 do
begin
UserInfo := PUINEntry(SrvContactList.Items[i])^;
if UserInfo.CType = 0 then //если это пользователь (CType = 0), то добавляем в список
begin
lstContactList.AddItem(UserInfo.Nick + ' (' + IntToStr(UserInfo.UIN) + ') - ' + GetStatusFor(UserInfo.UIN), Self);
GetMem(UINNickItem, SizeOf(UINNickItem^));
UINNickItem^.UIN := UserInfo.UIN;
UINNickItem^.Nick := UserInfo.Nick;
UINNickList.Add(UINNickItem);
end;
end;
AddEvent('Получен список контактов');
ICQClient.DestroyUINList(SrvContactList);
end;
procedure TfrmMain.ICQClientStatusChange(Sender: TObject; UIN: String;
Status: Cardinal);
var
i : LongInt;
begin
AddEvent(GetNickFor(StrToInt(UIN)) + ' (' + UIN + ') сменил статус на ' + StatusToStr_rus(Status) + ': ' + IntToStr(Status));
SetStatusToStatusList(UIN, Status);
//Теперь меняем статус в списке контактов
if UINNickList.Count > 0 then
for i := 0 to UINNickList.Count - 1 do
if PUINNickItem(UINNickList.Items[i])^.UIN = StrToInt(UIN) then
lstContactList.Items.Strings[i] := PUINNickItem(UINNickList.Items[i])^.Nick + ' (' + IntToStr(PUINNickItem(UINNickList.Items[i])^.UIN) + ') - ' + StatusToStr_rus(Status);
end;
procedure TfrmMain.tmrWaitToAskCLTimer(Sender: TObject);
begin
tmrWaitToAskCL.Enabled := False;
FullReloadContactList := True;
ICQClient.RequestContactList;
AddEvent('Запрошен список контактов');
ICQClient.RequestOfflineMessages;
AddEvent('Запрошены оффлайн сообщения');
end;
procedure TfrmMain.ICQClientUserOffline(Sender: TObject; UIN: String);
begin
ICQClientStatusChange(Self, UIN, S_OFFLINE);
end;
procedure TfrmMain.ICQClientMessageRecv(Sender: TObject; Msg, UIN: String);
begin
AddEvent('От ' + GetNickFor(StrToInt(UIN)) + ' (' + UIN + ') принято сообщение: [' + Msg + ']');
end;
procedure TfrmMain.ICQClientOfflineMsgRecv(Sender: TObject;
DateTime: TDateTime; Msg, UIN: String);
begin
AddEvent('От ' + GetNickFor(StrToInt(UIN)) + ' (' + UIN + ') принято сообщение в оффлайн в {' + DateTimeToStr(DateTime) + '}: [' + Msg + ']');
end;
procedure TfrmMain.ICQClientAddedYou(Sender: TObject; UIN: String);
begin
AddEvent('Меня добавил UIN ' + UIN + '.');
end;
procedure TfrmMain.btnSendMsgClick(Sender: TObject);
begin
if ICQClient.LoggedIn then
begin
if tmrTypingNotification.Enabled = True then
begin
tmrTypingNotification.Enabled := False;
ICQClient.SendTypingNotification(edtUINToSendTo.Text, 0); //даём знать, что прекратили печатать
end;
ICQClient.SendMessage(StrToInt(edtUINToSendTo.Text), mmoSendMsg.Text);
AddEvent('Собеседнику ' + GetNickFor(StrToInt(edtUINToSendTo.Text)) + ' (' + edtUINToSendTo.Text + ') отправлено сообщение: [' + mmoSendMsg.Text + '].');
mmoSendMsg.Clear;
end;
end;
procedure TfrmMain.lblHyperlinkClick(Sender: TObject);
begin
WinExec(PChar('explorer ' + lblHyperlink.Caption), 0);
end;
procedure TfrmMain.lstContactListMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if lstContactList.ItemIndex >= 0 then //если в списке выделен контакт
begin
if Button = mbLeft then
edtUINToSendTo.Text := IntToStr(PUINNickItem(UINNickList.Items[lstContactList.ItemIndex])^.UIN);
if Button = mbRight then
ppmContactMenu.Popup(frmMain.Left + (frmMain.Width - frmMain.ClientWidth) + grbContacts.Left + lstContactList.Left + X, frmMain.Top + (frmMain.Height - frmMain.ClientHeight) + grbContacts.Top + lstContactList.Top + Y);
end;
end;
procedure TfrmMain.btnMaskClick(Sender: TObject);
begin
ICQClient.MaskIntoQIP($09090909);
end;
procedure TfrmMain.ICQClientTypingNotification(Sender: TObject;
UIN: String; NotificationType: Word);
begin
case NotificationType of
0: AddEvent(GetNickFor(StrToInt(UIN)) + ' (' + UIN + ') закончил печатать вам сообщение');
1: AddEvent(GetNickFor(StrToInt(UIN)) + ' (' + UIN + ') закончил печатать вам сообщение');
2: AddEvent(GetNickFor(StrToInt(UIN)) + ' (' + UIN + ') печатает вам сообщение');
end;
end;
procedure TfrmMain.tmrTypingNotificationTimer(Sender: TObject);
begin
tmrTypingNotification.Enabled := False;
ICQClient.SendTypingNotification(edtUINToSendTo.Text, 0); //даём знать, что прекратили печатать
end;
procedure TfrmMain.mmoSendMsgChange(Sender: TObject);
begin
if GetCapsFor(StrToInt(edtUINToSendTo.Text)).typingnots = 1 then //если у собеседника работают Typing Notifications
begin
if tmrTypingNotification.Enabled = True then //если мы ещё не сообщили, что перестали печатать
tmrTypingNotification.Enabled := False //то откладываем уведомление о том, что мы прекратили печатать, на потом
else
ICQClient.SendTypingNotification(edtUINToSendTo.Text, 2); //даём знать, что печатаем
tmrTypingNotification.Enabled := True;
end;
end;
procedure TfrmMain.ICQClientAvatarReceive(Sender: TObject; UIN: String;
AvatarId: Word; AvatarFlags: Byte; AvatarHash, AvatarData,
AvatarExt: String);
var
AvatarFile : TextFile;
begin
if AvatarData = '' then
AddEvent('У собеседника ' + GetNickFor(StrToInt(UIN)) + ' (' + UIN + ') не поставлена аватара.')
else
begin
AssignFile(AvatarFile, 'avatars\' + UIN + AvatarExt);
Rewrite(AvatarFile);
Write(AvatarFile, AvatarData);
CloseFile(AvatarFile);
//imgLoadedAvatar.Picture.LoadFromFile('avatars\' + UIN + AvatarExt);
AddEvent('Получена аватара собеседника ' + GetNickFor(StrToInt(UIN)) + ' (' + UIN + ').');
end;
end;
//Следующее событие извещает о готовности приёма и передачи аватар
procedure TfrmMain.ICQClientExtServiceReady(Sender: TObject);
begin
ppmnAskAvatar.Enabled := True;
end;
procedure TfrmMain.ppmnAskAvatarClick(Sender: TObject);
var
SomeUIN : Cardinal;
AvatarInfo : TUINInfoAvatar;
begin
SomeUIN := StrToInt(edtUINToSendTo.Text);
AvatarInfo := GetAvatarInfoFor(SomeUIN);
if AvatarInfo.Hash = '' then
AddEvent('У собеседника ' + GetNickFor(SomeUIN) + ' (' + IntToStr(SomeUIN) + ') отсутствует аватара, или у нас ещё нет о ней информации.')
else
begin
ICQClient.RequestAvatar(IntToStr(SomeUIN), AvatarInfo.Id, AvatarInfo.Flags, AvatarInfo.Hash);
AddEvent('У собеседника ' + GetNickFor(SomeUIN) + ' (' + IntToStr(SomeUIN) + ') запрошена аватара.');
end;
end;
procedure TfrmMain.btnUploadMyAvatarClick(Sender: TObject);
begin
if dlgUploadAvatar.Execute then
ICQClient.UploadAvatar(dlgUploadAvatar.FileName);
end;
procedure TfrmMain.btnResetMyAvatarClick(Sender: TObject);
begin
//might be not really correct
ICQClient.DeleteAvatar(1);
end;
procedure TfrmMain.ICQClientOnlineInfo(Sender: TObject; UIN: String;
Port: Word; InternalIP, ExternalIP: String; OnlineTime: TDateTime;
IdleTime: Word; ICQVersion, MirandaVersion: Cardinal; ProtoVer: Byte;
UserCaps: String; AvatarId: Word; AvatarFlags: Byte; AvatarHash: String;
NewXStatusSet: Boolean; NewXStatusMoodNum: Byte; NewXStatusNote: String);
begin
if AvatarFlags <> 0 then
SetInfoToInfoList(UIN, UserCaps, AvatarId, AvatarFlags, AvatarHash)
else
SetInfoToInfoList(UIN, UserCaps, GetAvatarInfoFor(StrToInt(UIN)).Id, GetAvatarInfoFor(StrToInt(UIN)).Flags, GetAvatarInfoFor(StrToInt(UIN)).Hash);
if NewXStatusSet then
AddEvent('Пришла информация о ' + GetNickFor(StrToInt(UIN)) + ' (' + UIN + ') и его NewXStatus (icqmood' + IntToStr(NewXStatusMoodNum) + '): [' + NewXStatusNote + '].')
else
AddEvent('Пришла информация о ' + GetNickFor(StrToInt(UIN)) + ' (' + UIN + ').');
end;
end.
[Ссылки могут видеть только зарегистрированные пользователи. ]
Не плохой набор компонентов, позволяющий вам создать свой собственный полнофункциональный браузер или чат. Лично меня очень сильно порадовало то, что в архиве с компонентом идет куча демок, которые помогут вам быстро разобраться с ним.
[Ссылки могут видеть только зарегистрированные пользователи. ]
А сейчас что бы не возникало лишних вопросов в кратцее расскажу, как установить этот компонент.
Итак,
Шаг номер 1. Распаковываем архив с компонентом.
Шаг номер 2. Открываем Delphi и закрываем все активные проекты.
Шаг номер 3. В папке, куда распаковался компонент есть еще одна папка под названием Source заходим в неё и копируем все от туда, в ...Delphi\Projects\Bpl\
Шаг номер 4. Находим файл EmbeddedWebBrowser_D7.dpk (если у вас установлена 7-ая версия Delphi) и запускаем его.
Шаг номер 5. Delphi выдаст нам окошечко в, котором нужно сначала нажать Compile, а затем Instal.
Шаг номер 6. Все компонент установлен)
[Ссылки могут видеть только зарегистрированные пользователи. ]
DelphiX - Лучший на сегодняшний день пакет для работы с графикой и звуком, отличный варинт для создания простеньких игрушек. Изменённая версия поддержки DirectX в Delphi. Теперь пакет можно устанавливать на Delphi 3,4,5,6,7. Откройте файл DelphiX_for7.dpk из среды Delphi, нажмите Install и пользуйтесь. Поддерживаются объекты DirectDraw, DirectPlay, Direct3D, DirectSound, DirectSoundCapture, DirectInput.
[Ссылки могут видеть только зарегистрированные пользователи. ]
Тема будет пополнятся!!!
Последний раз редактировалось DirectD3D; 27.02.2014 в 13:09.