1. Уважаемые гости и пользователи форума.
    Администрация настоятельно рекомендует не регистрировать несколько аккаунтов для одного пользователя. При выявлении наличия мультиаккаунтов будут заблокированы все учетные записи данного пользователя.
    Аккаунты, зарегистрированные на временную почту будут также заблокированы.

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

Тема в разделе "Delphi", создана пользователем GVS276, 9 сен 2012.

  1. Ветеран Проверенный

    Регистрация:
    1 июл 2011
    Сообщения:
    351
    Симпатии:
    188
    Примеры для Delphi
    [HR][/HR]
    Тут выкладываем ваши примеры для других пользователей!

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

    Вложения:

    • MBU.rar
      Размер файла:
      217,5 КБ
      Просмотров:
      26
    Последнее редактирование модератором: 10 сен 2012
  2. Борода Модератор

    Регистрация:
    15 июн 2011
    Сообщения:
    719
    Симпатии:
    536
    Пол:
    Мужской
    Мой пример веббраузер на 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]
     
    Последнее редактирование: 9 сен 2012
    Adil нравится это.
  3. Ветеран Проверенный

    Регистрация:
    28 июн 2011
    Сообщения:
    165
    Симпатии:
    218
    Пол:
    Мужской
    Пример сплеш заставки на gdi+.
     

    Вложения:

    • spash.7z
      Размер файла:
      2,2 КБ
      Просмотров:
      41
    Последнее редактирование модератором: 10 сен 2012
    Adil нравится это.
  4. Ветеран Проверенный

    Регистрация:
    1 июл 2011
    Сообщения:
    351
    Симпатии:
    188
    MBU - версия 1.1
    поддержка https
    так же исправил главную процедуру OpenUrlIcon
     

    Вложения:

    Последнее редактирование модератором: 10 сен 2012
  5. Тех. админ Администратор

    Регистрация:
    26 дек 2011
    Сообщения:
    514
    Симпатии:
    605
    Пол:
    Мужской
    2ALL
     
    Adil и GVS276 нравится это.
  6. Ветеран Проверенный

    Регистрация:
    1 июл 2011
    Сообщения:
    351
    Симпатии:
    188
    Компонент PVK - это созданый мной компонент browser в Page Control с изменёным внешнем видом (в новом стиле)...
    Версия компонентая: beta
    P.S.: Выкладываю компонент только ради примера...
     

    Вложения:

    • PVK.rar
      Размер файла:
      226 КБ
      Просмотров:
      28
    Последнее редактирование: 18 сен 2012
    Adil нравится это.
  7. Ветеран Проверенный

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

    Вложения:

    • Ex7z.rar
      Размер файла:
      249,9 КБ
      Просмотров:
      34
    Последнее редактирование: 28 сен 2012
    Adil нравится это.
  8. Ветеран Проверенный

    Регистрация:
    1 июл 2011
    Сообщения:
    351
    Симпатии:
    188
    Расширенный пример распаковки 7z.exe (7Zip) архивов с плавным прогресс баром
    Версия 1.0.1

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

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

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

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

    Вложения:

    • Ex7z.rar
      Размер файла:
      89,1 КБ
      Просмотров:
      37
    vint56, Adil, YURSHAT и ещё 1-му нравится это.
  9. Ветеран Проверенный

    Регистрация:
    1 июл 2011
    Сообщения:
    351
    Симпатии:
    188
    Обновил: Пример распаковки 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%
     

    Вложения:

    • Ex7z.rar
      Размер файла:
      250,2 КБ
      Просмотров:
      22
    Adil и Winst@n нравится это.
  10. Ветеран Проверенный

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

    Вложения:

    • Ex7z.rar
      Размер файла:
      1,3 МБ
      Просмотров:
      84
    Adil и vint56 нравится это.
  11. Ветеран Проверенный

    Регистрация:
    1 июл 2011
    Сообщения:
    351
    Симпатии:
    188
    Пример создания синтаксиса
    версия: 1.0
     

    Вложения:

    • Syntax.rar
      Размер файла:
      166,4 КБ
      Просмотров:
      30
  12. Ветеран Проверенный

    Регистрация:
    1 июл 2011
    Сообщения:
    351
    Симпатии:
    188
    Syntax: Расширенный код процедуры
    Код
    ЗЫ: Не стал выкладывать архив с проектом, ибо не охото =\
     
    Последнее редактирование: 7 ноя 2012
  13. Ветеран Проверенный

    Регистрация:
    1 июл 2011
    Сообщения:
    351
    Симпатии:
    188
    Обновил пример вывода веб-иконки MBU
    * Корректное отображение иконки в TImage
    * Добавил вывод ошибок EIdHTTPProtocolException

    Скрин:
    [​IMG]
     

    Вложения:

    • web_ico.rar
      Размер файла:
      7,6 КБ
      Просмотров:
      9
    Mailchik нравится это.

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