Примеры для пользователей

GVS276

Старожил
Проверенный
Примеры для Delphi
[HR][/HR]
Тут выкладываем ваши примеры для других пользователей!

Вот мой пример
 

Вложения

  • 217.5 KB Просмотры: 37
Последнее редактирование модератором:

LexBell

Борода
Супер модератор
Мой пример веббраузер на WinApi + RTL. Кометариев мизер - ну не умею я нормально коментировать, поскольку зачастую сам плохо понимаю, как и что работает :rofl:
[SOURCE="pas"]program IWebBrowser_2;

uses
windows,CommCtrl,System;
{$R 'XPMan.res'}

const
ole32 = 'ole32.dll';
CLSID_InternetExplorer: TGUID = '{8856F961-340A-11D0-A96B-00C04FD705A2}';
IID_IWebBrowser2: TGUID = '{D30C1661-CDAF-11D0-8A3E-00C04FC9E26E}';

type
IWebBrowser2 = interface(IDispatch)
['{EAB22AC1-30C1-11CF-A7EB-0000C05BAE0B}']
procedure GoBack; safecall;
procedure GoForward; safecall;
procedure GoHome; safecall;
procedure GoSearch; safecall;
procedure Navigate(const URL: WideString; var Flags: OleVariant;
var TargetFrameName: OleVariant; var PostData: OleVariant;
var Headers: OleVariant); safecall;
procedure Refresh; safecall;
procedure Stop; safecall;
function Get_LocationURL: WideString; safecall;
property LocationURL: WideString read Get_LocationURL;
end;

function AtlAxAttachControl(const pControl: IUnknown; hWnd: HWND; ppUnkContainer: IUnknown): DWORD; stdcall; external 'ATL.DLL';
function CoInitializeEx(pvReserved: Pointer; coInit: Longint): HResult; stdcall;external ole32 name 'CoInitializeEx';
function CoCreateInstance(const clsid: TGUID; unkOuter: IUnknown; dwClsContext: Longint; const iid: TGUID; out pv): HResult; stdcall;external ole32 name 'CoCreateInstance';
procedure CoUninitialize; external ole32 name 'CoUninitialize';

var
WinClass : TWndClass; //переменная класса TWndClass для создания главного окна
hInst : HWND; //хандлер приложения
AddrEdit,WebWindow,ToolWnd,Handle : HWND; //локальный хандлер
Msg : TMSG; //сообщение
WB:IWebBrowser2; //Собственно наш браузер
EmptyParam: OleVariant;
WebFont:HFONT;
i, j: Integer;
ArrTTBButton: array [0..11] of TTBButton;
WRect:TRect;
Addres: PAnsiChar;
next,prew:Integer;
procedure ShutDown; //процедура завершения программы
begin
CoUninitialize;
UnRegisterClass('TAPIxForm', hInst); //удаление окна
ExitProcess(hInst); //закрытие программы
end;

function WindowProc(hwnd, msg, wparam, lparam: longint): longint; stdcall; //обработчик сообщений
begin
Result := DefWindowProc(hwnd, msg, wparam, lparam);
case Msg of
$0014:Result:=1;
$0019:Result:=1;
$0001:
begin
//Инициализируем библиотеку COM
CoInitializeEx(nil, 2);
//Создаем екземпляр браузера
CoCreateInstance(CLSID_InternetExplorer, nil, 1,IID_IWebBrowser2, WB);
//Прикрепляем к панельке на форме, а можно и не прикреплять =)
end;
$0005:
begin
GetClientRect(hwnd,WRect);
SetWindowPos(WebWindow,hwnd,0,30,WRect.Right,WRect.Bottom-30,$514);
end;
$0111:
if (lParam = AddrEdit) and (HiWord(wParam) = $0300) then
//OnChange компонента AddrEdit
begin
GetMem(Addres,GetWindowTextLength(lParam));
GetWindowText(lParam,Addres,GetWindowTextLength(lParam));
WB.Navigate(Addres, EmptyParam, EmptyParam, EmptyParam, EmptyParam);
Next:=Next+1;
FreeMem(Addres);
end else
if (lParam = ToolWnd) then begin
if (HiWord(wParam) = 0) then
begin
if Next>0 then
begin
WB.GoBack;
prew:=prew+1;
Next:=Next-1;
end;
end else
if (HiWord(wParam) = 1) then
begin
if prew>=0 then begin
WB.GoForward;
Next:=Next+1;
if prew>0 then prew:=prew-1;
end;
end;
if (HiWord(wParam) = 1) then
begin
WB.Refresh;
end;
end;
$0002: ShutDown;
end;
end;

begin
hInst := GetModuleHandle(nil);
with WinClass do
begin
Style := CS_PARENTDC; //стиль класса главного окна
hIcon := LoadIcon(hInst, MAKEINTRESOURCE('APIXICON')); //иконка программы
lpfnWndProc := @WindowProc; //назначение обработчика сообщений
hInstance := hInst;
hbrBackground := COLOR_BTNFACE + 1; //цвет окна
lpszClassName := 'TAPIxForm'; //класс окна
hCursor := LoadCursor(0, IDC_ARROW); //активный курсор
end;
RegisterClass(WinClass); //регистрация класса в системе

Handle := CreateWindowEx(0, 'TAPIxForm', 'IWebBrowser2', WS_OVERLAPPEDWINDOW or WS_VISIBLE or WS_MINIMIZEBOX or WS_MAXIMIZEBOX or WS_SYSMENU, (GetSystemMetrics(16) div 2)-400, (GetSystemMetrics(17) div 2)-200, 800, 400, 0, 0, hInst, nil);

j:=0;
Next:=0;
prew:=0;
for i:=0 to 6 do
begin
if (i=3)or(i=6) then
begin
ArrTTBButton.iBitmap:=0;
ArrTTBButton.idCommand:=0;
ArrTTBButton.fsStyle:=tbstyle_sep;
end
else
begin
ArrTTBButton.iBitmap:=j;
ArrTTBButton.idCommand:=210+j;
ArrTTBButton.fsStyle:=tbstyle_button;
inc(j);
end;
ArrTTBButton.fsState:=tbstate_enabled;
ArrTTBButton.dwData:=0;
ArrTTBButton.iString:=0;
end;

WebFont:=CreateFont(-11, 0, 0, 0, 0, 0, 0, 0,DEFAULT_CHARSET,OUT_DEFAULT_PRECIS,CLIP_DEFAULT_PRECIS,DEFAULT_QUALITY,DEFAULT_PITCH or FF_DONTCARE, 'MS Sans Serif');


ToolWnd:=CreateToolBarEx(Handle, ccs_top or ws_child or TBSTYLE_TOOLTIPS or ws_visible, 0, 9, hInst, 0, @ArrTTBButton,
7, 40, 16, 40, 16, SizeOf(TTBButton));

GetClientRect(Handle,WRect);

WebWindow := CreateWindowEx(0, 'Static', '', WS_CHILD or WS_VISIBLE, 0, 30, WRect.Right, WRect.Bottom-30, Handle, 0, hInst, nil);

AddrEdit := CreateWindowEx(WS_EX_CLIENTEDGE, 'Edit', 'http://innoultra.ru/', WS_CHILD or ES_AUTOHSCROLL or WS_VISIBLE,
280, 0, 200, 21, ToolWnd, 0, hInst, nil);

SendMessage(AddrEdit, $0030, WebFont, 0);

AtlAxAttachControl(WB,WebWindow, nil);

GetMem(Addres,GetWindowTextLength(AddrEdit));

GetWindowText(AddrEdit,Addres,GetWindowTextLength(AddrEdit));

WB.Navigate(Addres, EmptyParam, EmptyParam, EmptyParam, EmptyParam);

FreeMem(Addres);
// Цикл сбора сообщений
while(GetMessage(Msg, 0, 0, 0)) do
begin
TranslateMessage(Msg); //прием сообщений
DispatchMessage(Msg); //удаление сообщений из очереди
end;
end.[/SOURCE]
 
Последнее редактирование:
  • Like
Реакции: Adil

David.D.Rocco

Участник
Проверенный
Пример сплеш заставки на gdi+.
 

Вложения

  • 2.2 KB Просмотры: 54
Последнее редактирование модератором:
  • Like
Реакции: Adil

GVS276

Старожил
Проверенный
MBU - версия 1.1
поддержка https
так же исправил главную процедуру OpenUrlIcon
 

Вложения

Последнее редактирование модератором:

YURSHAT

Тех. админ
Администратор
2ALL
 

GVS276

Старожил
Проверенный
Компонент PVK - это созданый мной компонент browser в Page Control с изменёным внешнем видом (в новом стиле)...
Версия компонентая: beta
P.S.: Выкладываю компонент только ради примера...
 

Вложения

  • 226 KB Просмотры: 29
Последнее редактирование:
  • Like
Реакции: Adil

GVS276

Старожил
Проверенный
Пример распаковки 7z.exe (7Zip) архивов с плавным прогресс баром.
1. чтобы прогресс бар был плавным, нужно провести тестовый прогон (как в ISDone, но чуть по другому)
2. инструкция использования в проекте описана
3. с помощью этого примера можно собрать любую распаковку
Версия примера 1.0, может обновлю в скорем времени..
 

Вложения

  • 249.9 KB Просмотры: 46
Последнее редактирование:
  • Like
Реакции: Adil

GVS276

Старожил
Проверенный
Расширенный пример распаковки 7z.exe (7Zip) архивов с плавным прогресс баром
Версия 1.0.1

Добавлено:
--- показ сколько распаковано в BT | KB | MB | GB | TB + процентовка
--- Поиск архива, используется API функция FileExists
--- Вычисление количество архивов (файлов) с нужным форматом в папке
--- Кнопки: Остановить распаковку / Возобновить распаковку
--- Вывод список распакованых файлов в ListBox (TStrings)
--- Пароль к архиву

Исправлены многие ошибки при распаковки и не только!

Примичание:
Внимательно читайте инструкцию возле константы (Const): Records

P.S:
Быстренко обновил распаковку и исправил элементарные ошибки!
 

Вложения

  • 89.1 KB Просмотры: 43

GVS276

Старожил
Проверенный
Обновил: Пример распаковки 7z.exe (7Zip) архивов с плавным прогресс баром, уже без Records.ini[HR][/HR]Стою вчера я на балконе и тут пришла мне в голову одна идея, ну я подумал грех не воспользоватся идеей и так вот мне удалось сделать распаковку 7-Zip архивов с плавным прогресс баром без тестового прогона (Records.ini)..
Я сделал так: Узнал размер самого архива и папки куда архив будет распаковывается, вообщем из размера архива, я вычел размер папки (получился общий процент сжатия архива), потом в MAX (прогресс бара), я записал размер архива и прибавил общий процент сжатия, получился оригинальный размер архива без сжатия =)
Ну а в Position (прогресс бара) я записываю исходный размер папки куда распаковывается архив.[HR][/HR]Версия 1.0.2 (Не расширенная версия)

От Winst@n:
AVMan, На нагрузку проверить не забыл,какая нагрузка на проц. имеется ли или нет?
просто что то подобное я делал через inno и нагрузка была ох не хилая.
[HR][/HR]От Gnom:
Winst@n, ключевое слово:
[HR][/HR]От AVMan:
Winst@n, Без 7z.exe, чисто EX.exe --- от 0 до 1%
 

Вложения

  • 250.2 KB Просмотры: 39

GVS276

Старожил
Проверенный
Обновил (FIX): Пример распаковки Arc.exe (7-Zip + FreeArc) архивов с плавным прогресс баром, уже без Records.ini[HR][/HR]Распаковка проходит через Arc.exe, т.к. я смог вывести информацию о размере файлов в архиве с консоли!
Так же была добавлена ещё одна распаковка: FreeArc архивов[HR][/HR]Версия 1.0.2 (FIX | Не расширенная версия)
 

Вложения

  • 1.3 MB Просмотры: 102

GVS276

Старожил
Проверенный
Пример создания синтаксиса
версия: 1.0
 

Вложения

GVS276

Старожил
Проверенный
Syntax: Расширенный код процедуры
Код
ЗЫ: Не стал выкладывать архив с проектом, ибо не охото =\
 
Последнее редактирование:

GVS276

Старожил
Проверенный
Обновил пример вывода веб-иконки MBU
* Корректное отображение иконки в TImage
* Добавил вывод ошибок EIdHTTPProtocolException

Скрин:
 

Вложения

Сверху