Перейти из форума на сайт.

НовостиФайловые архивы
ПоискАктивные темыТоп лист
ПравилаКто в on-line?
Вход Забыли пароль? Первый раз на этом сайте? Регистрация
Компьютерный форум Ru.Board » Компьютеры » Прикладное программирование » Вопросы по Delphi (все версии) - часть 4

Модерирует : ShIvADeSt

ShIvADeSt (28-06-2009 02:10): Продолжение в http://forum.ru-board.com/topic.cgi?forum=33&topic=10477  Версия для печати • ПодписатьсяДобавить в закладки
Страницы: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101

   

ShIvADeSt



Moderator
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Maks150988

Цитата:
И вот еще что-то не получается выполнить правильную отрисовку контрола когда в нем строк нет - рисуется мусор какой-то. Я по идее поставил проверку на наличе строк и если они больше -1 то выполняется отрисовка иначе ее нет.

Проверяй на больше нуля, так как скорее всего работаешь с Count, а он с 0 начинается.
Насчет правой кнопки в ЛистБоксе - скорее всего подмена оконной функции на свою собственную и там уже можно что угодно перехватывать. Если в класс оформить - то самый правильный способ.

----------
И создал Бог женщину... Существо получилось злобное, но забавное...

Всего записей: 3956 | Зарегистр. 29-07-2003 | Отправлено: 03:00 03-11-2008
Maks150988



Advanced Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
ShIvADeSt
Да у меня в овнердрав процедуре же проверяется элемент в списке, больше ли -1 или нет он. Может как-то по другому надо проверять? Я думал что так логичнее ведь элементы же с нуля отсчитываются как бы, значит все что меньше нуля и не ноль - по другому отрисовываются.
 
Скрытый текст
 
Хотя чего-то и чекбокс лепится и мусор, вобщем, я чего-то не пойму в чем ошибка...

Всего записей: 836 | Зарегистр. 23-12-2006 | Отправлено: 12:00 03-11-2008
ShIvADeSt



Moderator
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Maks150988
Вот Хелп
Короче Борланд неправильно типы в  

Код:
 
  PDrawItemStruct = ^TDrawItemStruct;
  {$EXTERNALSYM tagDRAWITEMSTRUCT}
  tagDRAWITEMSTRUCT = packed record
    CtlType: UINT;
    CtlID: UINT;
    itemID: UINT;
    itemAction: UINT;
    itemState: UINT;
    hwndItem: HWND;
    hDC: HDC;
    rcItem: TRect;
    itemData: DWORD;
  end;
  TDrawItemStruct = tagDRAWITEMSTRUCT;
  {$EXTERNALSYM DRAWITEMSTRUCT}
  DRAWITEMSTRUCT = tagDRAWITEMSTRUCT;
 

проставила. У itemID надо поставить LongInt, в противном случае надо делать проверку не lpdis.ItemID > -1, а lpdis.ItemID < 4294967295 так как у UINT это LongBool, а у него в принципе нет -1.
Далее надо будет когда пустую строку рисуешь lpdis.rcItem.Bottom:= 15; выставить, где 15 высота пункта, по умолчанию у пустого пункта высота 0. Дальше дело техники, у меня получилось при пустом Листе вывести надпись Список пуст, а когда не пустой, то сами элементы.

----------
И создал Бог женщину... Существо получилось злобное, но забавное...

Всего записей: 3956 | Зарегистр. 29-07-2003 | Отправлено: 12:48 03-11-2008
Maks150988



Advanced Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
ShIvADeSt
Благодарю за разъяснение, а то все думал чтож такое-то...
И кстати, у вас правильно рисуется рамка выделения для пункта? А то я только сейчас заметил что есть отступы от левого и правого краев слишком большие и рисуется по 2 таких рамки по бокам еще. Если тот же код из CheckListBox_OnDrawItem подсовывать уже без всяких модулей в саму функцию, то рисуется без помарок. Не подскажете где моя ошибка?

Всего записей: 836 | Зарегистр. 23-12-2006 | Отправлено: 15:22 03-11-2008
ShIvADeSt



Moderator
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Maks150988
Если честно, то твой код я просто посмотрел, а опыты ставил на другом коде, в котором и нашел данный прикол. Так что даже не подскажу, в чем дело. Как всегда закоменть весь лишний код и посмотри, что происходит при отрисовке по шагам.

----------
И создал Бог женщину... Существо получилось злобное, но забавное...

Всего записей: 3956 | Зарегистр. 29-07-2003 | Отправлено: 16:46 03-11-2008
vetal71



Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Привет всем. У меня такая проблема:  
как на rasapi узнать занята телефонная линия или нет и
если занята, то как реализовать перезвон.
Заранее спасибо.
 
PS. Прошу прощения если вопрос задан не в том топике

Всего записей: 300 | Зарегистр. 08-09-2008 | Отправлено: 22:17 03-11-2008
Maks150988



Advanced Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
ShIvADeSt
Ладно. Спасибо. Методом тыка нашел ошибку. Как оказалось почему-то если код прорисовки в отдельном модуле, то код для координат надо еще дописывать.
 
Вобщем кому интересно что получилось в итоге:
 
Ссылка
 
- Установка и снятие галочки в чекбоксе одного или всех пунктов
- Получение информации о состоянии выделенности чекбокса в пункте
- Отображение строк всех выделенных пунктов списка в сообщении
- Работа с кодировкой Юникод для загрузки и отображения строк
- Самостоятельная прорисовка строк в списке с некоторыми особенностями

Всего записей: 836 | Зарегистр. 23-12-2006 | Отправлено: 10:06 04-11-2008
BofA



Junior Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Доброго времени суток!
Не подскажет ли уважаемый All, как решить следующую задачу на Delphi.
Имеется программа, которая с помощью DDE выводит данные в Excel. Мне нужно получать эти данные вместо Экселя. Попытка создать DDE сервер с именем 'EXCEL' ничего не дала. Подскажите пожалуйста, в каком направлении копать.

Всего записей: 119 | Зарегистр. 31-07-2006 | Отправлено: 12:09 04-11-2008
ShIvADeSt



Moderator
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Maks150988
Поправил косячек один  

Код:
 
procedure CheckListBox_SelAllItemsW(hList : Thandle; nFlag : Boolean);
var
  nItems   : Integer;
  nItem    : Integer;
  itemdata : LongInt;
begin
  nItems := SendMessageW(hList, LB_GETCOUNT, 0, 0);
  if nItems > -1 then // было nItem
    begin
      itemdata := Integer(nFlag);
      for nItem := 0 to nItems do
        begin
          SendMessageW(hList, LB_SETITEMDATA, nItem, itemdata);
          InvalidateRect(hList, nil, FALSE);
        end;
    end;
end;
 


----------
И создал Бог женщину... Существо получилось злобное, но забавное...

Всего записей: 3956 | Зарегистр. 29-07-2003 | Отправлено: 14:29 04-11-2008 | Исправлено: ShIvADeSt, 14:29 04-11-2008
MrZeRo



Advanced Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
BofA
Это достаточно трудно. Не лучше ли дать имеющейся программе возможность вывести данные в Excel, а потом прочитать их уже из Execel?
Если этот вариант неприемлем, то тогда надо "эмулировать" какую-то часть интерфейса Excel.  

Цитата:
создать DDE сервер с именем 'EXCEL'  
так точно не пройдет. Посмотрите в реестре HKEY_CLASSES_ROOT, может быть только что-нибудь из этого. Наиболее вероятны варианты Excel.Application, Excel.Sheet.

----------
... не это главное ...

Всего записей: 831 | Зарегистр. 30-01-2002 | Отправлено: 17:13 04-11-2008
f3ka

Full Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
DmitryKz потому что в Action.OnExecute Sender'ом является сам Action и его приведение к TTBXItem само собой не верно...

Всего записей: 497 | Зарегистр. 02-03-2007 | Отправлено: 11:20 05-11-2008
zvyagaaa



Advanced Member
Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
DmitryKz
как я понял - пусть приятель использует PrivateExeProtector

Всего записей: 776 | Зарегистр. 02-02-2005 | Отправлено: 20:11 09-11-2008
Maks150988



Advanced Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Это, вобщем возник такой вопрос. Я должен скачать файл с сервера. Необходимо перед закачкой данных проверить наличие файла на сервере и номер ошибки. Если 200 - качаем. Ранее использовал функции WinInet и код был таким, в коде вроде все должно работать как часы, наверное:
 

Код:
function GetTextFileFromServer(szURL : AnsiString) : AnsiString;
var
  FSession  : HINTERNET;
  hConnect  : HINTERNET;
  szBuffer  : Array [0..4095] of AnsiChar;
  dwIndex   : DWORD;
  dwCodeLen : DWORD;
  hRequest  : LongBool;
  szNotify  : AnsiString;
  dwTimeout : Integer;
  dwRead    : Cardinal;
begin
  Result := '';
  try
    { открываем интернет сессию для выполнения последующих действий }
    FSession := InternetOpen('Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
    { устанавливаем таймер на сессию - 10 секунд }
    dwTimeout := 10 * 1000;
    InternetSetOption(FSession, INTERNET_OPTION_CONNECT_TIMEOUT, @dwTimeout, SizeOf(dwTimeout));
    InternetSetOption(FSession, INTERNET_OPTION_RECEIVE_TIMEOUT, @dwTimeout, SizeOf(dwTimeout));
    InternetSetOption(FSession, INTERNET_OPTION_SEND_TIMEOUT, @dwTimeout, SizeOf(dwTimeout));
    if FSession <> nil then
    try
      { получаем хэндл открытого файла по сети }
      hConnect := InternetOpenUrl(FSession, PAnsiChar(szURL), nil, 0, INTERNET_FLAG_NO_UI, 0);
      if hConnect <> nil then
      try
        { проверяем открытое соединение на ошибки }
        dwIndex  := 0;
        dwCodeLen := Length(szBuffer);
        hRequest := HttpQueryInfo(hConnect, HTTP_QUERY_STATUS_CODE, @szBuffer[0], dwCodeLen, dwIndex);
        if hRequest then
          begin
            szNotify := szBuffer;
            { если код ошибки 200 - все прошло нормально и продолжаем }
            if szNotify = '200' then
              begin
                repeat
                  FillChar(szBuffer, SizeOf(szBuffer), 0);
                  if InternetReadFile(hConnect, @szBuffer[0], SizeOf(szBuffer), dwRead) then
                    Result := Result + szBuffer
                  else
                    Break;
                until
                  dwRead = 0;
              end;
          end;
      finally
        InternetCloseHandle(hConnect);
      end;
    finally
      InternetCloseHandle(FSession);
    end;
  except
  end;
end;

А наверное потому, потому как непонятно, почему вслучае неудачного соединения файл перестает закачиваться (функция возвращает пустой результат) и помогает только перезапуск программы.
Собственно решил перейти на сокеты. Почитал что пишут на форумах и за основу взял код и переделал под свои нужды. Конечно понравилось что все так быстро через сокеты грузит, но, хотелось бы сделать аналог HttpQueryInfo для проверки 200 кода. А также такой вопрос, помимо ответа с сервера возвращаются и другие данные - тип контента, его длина, время и т.д. Все это вначале возвращаемых данных. Я так понимаю это что-то типа приходящего пакета? Якобы заголовок или подобие? Или я ошибаюсь. Как можно извлечь то, что реально требуется, как в этом случае возвратило бы через WinInet функции? Парсить вручную чтоли? Вот код:

Код:
function GetHttpData(szURL, szMethod : AnsiString; TargetPort : WORD; szArgs, szContnt : AnsiString) : AnsiString;
const
  szUserAgent = 'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)';
  CRLF = #13#10;
var
  hSocket  : TSocket;
  SockAddr : TSockAddr;
  szBuffer : Array [0..1023] of AnsiChar;
  BuffSize : Cardinal;
  WSAData  : TWSAData;
  szTemp   : AnsiString;
  szHost   : AnsiString;
begin
  { возвращаем пустой результат в функцию }
  Result := '';
  { извлекаем название хоста для соединения }
  szTemp := szURL;
  if Pos('//', szTemp) > 0 then
    Delete(szTemp, 1, Pos('//', szTemp) + 1);
  szHost := Copy(szTemp, 1, Pos('/', szTemp) - 1);
  { запускаем библиотеку winsock версии 2 }
  WSAStartup(MAKEWORD(2, 0), WSAData);
  { создаем сокет с нужными нам параметрами }
  hSocket := socket(PF_INET, SOCK_STREAM, IPPROTO_TCP);
  SockAddr.sin_family := AF_INET;
  SockAddr.sin_addr   := PInAddr(GetHostByName(PAnsiChar(szHost))^.h_addr_list^)^;
  SockAddr.sin_port   := htons(TargetPort);
  { если не удалось соединиться - останавливаемся }
  if connect(hSocket, SockAddr, SizeOf(SockAddr)) = SOCKET_ERROR then
    begin
      closesocket(hSocket);
      Exit;
    end;
  { формируем строку для отправки запроса }
  szTemp := Format('%s %s HTTP/1.1'+ CRLF +
                   '%s' + CRLF +
                   'User-Agent: %s' + CRLF +
                   'Host: %s' + CRLF +
                   'Content-Length: %s' + CRLF +
                   'Connection: Keep-Alive' + CRLF +
                   'Cache-Control: no-cache' + CRLF + CRLF +
                   szArgs, [szMethod, szURL, szContnt, szUserAgent, szHost, IntToStr(Length(szArgs))]);
  { отправляем через сокет запрос }
  if send(hSocket, Pointer(szTemp)^, Length(szTemp), 0) = SOCKET_ERROR then
    begin
      closesocket(hSocket);
      Exit;
    end;
  { получаем результат и сохраняем его }
  FillChar(szBuffer, SizeOf(szBuffer), 0);
  repeat
    BuffSize := recv(hSocket, szBuffer, SizeOf(szBuffer), 0);
    if BuffSize > 0 then
      begin
        Result := Result + PAnsiChar(@szBuffer);
        FillChar(szBuffer, SizeOf(szBuffer), 0);
      end;
  until
    BuffSize > 0;
  { очищаем буфер, закрываем сокет и выгружаем winsock }
  FillChar(szBuffer, SizeOf(szBuffer), 0);
  closesocket(hSocket);
  WSACleanup;
end;
//s:=GetHttpData('http://адрес.ru/file.rar', 'GET', 80, '', 'Content-Type: text/plain');

Всего записей: 836 | Зарегистр. 23-12-2006 | Отправлено: 19:23 10-11-2008
GrHnd



Advanced Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Добрый день всем!
Подскажите компонент, работающий как Combobox, но позволяющий показывать для выбора не все загруженные строки, а только часть из них по условию.

Всего записей: 867 | Зарегистр. 01-04-2005 | Отправлено: 15:06 12-11-2008
ShIvADeSt



Moderator
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
GrHnd
LookupComboBox подключаешь к базе данных и фильтруешь в ней записи, показывает что надо. Либо делай массив строк и грузи что надо каждый раз.

----------
И создал Бог женщину... Существо получилось злобное, но забавное...

Всего записей: 3956 | Зарегистр. 29-07-2003 | Отправлено: 03:04 13-11-2008
Monsoj

Newbie
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Здравствуйте.
 
Есть ли функция для однозначного определения разрядности для всех ОС? Есть косвенные признаки, того что система 64-битная, но хочется чего-то стабильно работающего.

Всего записей: 2 | Зарегистр. 09-11-2008 | Отправлено: 09:27 13-11-2008
DmitryKz

Silver Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Ребята, как программа может проверить свое обновление на хомяке и в случае успеха сообщить о наличии новой версии пользователю? Какие компоненты для этого используются?

Всего записей: 3145 | Зарегистр. 29-09-2005 | Отправлено: 11:41 13-11-2008
LadyOfWood

Advanced Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору

Цитата:
Есть ли функция для однозначного определения разрядности для всех ОС?

IsWow64Process

Всего записей: 620 | Зарегистр. 16-09-2003 | Отправлено: 12:06 13-11-2008
Maks150988



Advanced Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Здраствуйте. Такие вопросы.
 
1) Необходимо чтобы появлялось всплывающее меню по нажатии правой кнопки мыши на листбоксе. Код для отображения меню такой:
 

Код:
    WM_CONTEXTMENU :
      begin
        GetCursorPos(CursorPt);
        GetWindowRect(GetDlgItem(hApp, IDC_LISTBOX_ADRESS), RectData);
        if PtInRect(RectData, CursorPt) then
          begin
            SetForegroundWindow(hApp);
            TrackPopupMenu(GetSubMenu(hMainMenu, 0), TPM_LEFTALIGN or TPM_LEFTBUTTON, CursorPt.X, CursorPt.Y, 0, hApp, nil);
            PostMessage(hApp, WM_NULL, 0, 0);
          end;
      end;

 
Но в этом случае теряется возможность вызовы системного меню, когда тыкаем правой кнопкой мыши на заголовок окна. Как поступать в этом случае, ведь системное меню необходимо, потому там тоже есть свои добавляемые пункты?
 
2) Сделал функцию для покраски HDC градиентной заливкой.
 

Код:
procedure GradientFillRect(DC : HDC; RC : TRect; v1Red, v1Green, v1Blue, v2Red, v2Green, v2Blue : WORD; gMode : DWORD);
var
  V : Array [0..1] of TTriVertex;
  R : TGradientRect;
begin
  V[0].x       := RC.Left;
  V[0].y       := RC.Top;
  V[0].Red     := v1Red;
  V[0].Green   := v1Green;
  V[0].Blue    := v1Blue;
  V[0].Alpha   := 0;
  V[1].x       := RC.Right - RC.Left;
  V[1].y       := RC.Bottom - RC.Top;
  V[1].Red     := v2Red;
  V[1].Green   := v2Green;
  V[1].Blue    := v2Blue;
  V[1].Alpha   := 0;
  R.UpperLeft  := 0;
  R.LowerRight := 1;
  GradientFill(DC, _TriVertex((@V[0])^), 2, @R, 1, gMode);
end;
//
    WM_PAINT :
      begin
        GetClientRect(GetDlgItem(hApp, ID_GRADIENT_STATIC), Rect);
        BeginPaint(GetDlgItem(hApp, ID_GRADIENT_STATIC), PS);
        PenBrush := CreatePen(PS_SOLID, 1, RGB(175, 200, 255));
        SelectObject(PS.HDC, PenBrush);
        RoundRect(PS.HDC, 0, 0, Rect.Right - Rect.Left, Rect.Bottom - Rect.Top, 0, 0);
        DeleteObject(PenBrush);
        Rect.Left := Rect.Left + 1;
        Rect.Right := Rect.Right - 1;
        Rect.Top := Rect.Top + 1;
        Rect.Bottom := Rect.Bottom - 1;
        GradientFillRect(PS.HDC, Rect, $F000, $F800, $FD00, $D500, $EF00, $FC00, GRADIENT_FILL_RECT_V);
        EndPaint(GetDlgItem(hApp, ID_GRADIENT_STATIC), PS);
      end;

 
Но мне нужно для функции RoundRect оставить градиентный фон чтобы закруглить потом границы. Криво проблема решается смещением границ на 1 пиксель, но ведь хочется побольше закругления сделать и тут вобщем нестыковка. Вот я и хотел узнать как оставить кисть фона.

Всего записей: 836 | Зарегистр. 23-12-2006 | Отправлено: 12:46 14-11-2008
oan42



Full Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
DmitryKz
http://www.appcontrols.com/manuals/autoupgraderpro/index.html?autoupgraderscreenshot1.htm

Всего записей: 488 | Зарегистр. 03-08-2004 | Отправлено: 16:24 14-11-2008
   

Страницы: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101

Компьютерный форум Ru.Board » Компьютеры » Прикладное программирование » Вопросы по Delphi (все версии) - часть 4
ShIvADeSt (28-06-2009 02:10): Продолжение в http://forum.ru-board.com/topic.cgi?forum=33&topic=10477


Реклама на форуме Ru.Board.

Powered by Ikonboard "v2.1.7b" © 2000 Ikonboard.com
Modified by Ru.B0ard
© Ru.B0ard 2000-2024

BitCoin: 1NGG1chHtUvrtEqjeerQCKDMUi6S6CG4iC

Рейтинг.ru