» Вопросы по Delphi (все версии) - часть 4

ShIvADeSt
Да у меня в овнердрав процедуре же проверяется элемент в списке, больше ли -1 или нет он. Может как-то по другому надо проверять? Я думал что так логичнее ведь элементы же с нуля отсчитываются как бы, значит все что меньше нуля и не ноль - по другому отрисовываются.

[more=Скрытый текст]procedure CheckListBox_OnDrawItem(lpdis : PDRAWITEMSTRUCT);
var
tchBuffer : Array [0..MAX_PATH] of WideChar;
itemdata : LongInt;
BrushNew : hBrush;
BrushOld : hBrush;
PenBrush : hPen;
begin
if lpdis.ItemID > -1 then
begin
if ((lpdis.itemState and ODS_SELECTED) <> 0) then
begin
BrushNew := CreateSolidBrush(RGB(235, 235, 250));
BrushOld := SelectObject(lpdis.hdc, BrushNew);
FillRect(lpdis.hdc, lpdis.rcItem, BrushNew);
PenBrush := CreatePen(PS_SOLID, 1, RGB(65, 105, 225));
SelectObject(lpdis.hdc, PenBrush);
Rectangle(lpdis.hdc, lpdis.rcItem.Left, lpdis.rcItem.Top, lpdis.rcItem.Right, lpdis.rcItem.Bottom);
DeleteObject(PenBrush);
SetBkColor(lpdis.hdc, RGB(235, 235, 250));
SelectObject(lpdis.hdc, BrushOld);
DeleteObject(BrushNew);
SetBkMode(lpdis.hdc, TRANSPARENT);
SetTextColor(lpdis.hdc, RGB(255, 0, 0));
end
else
begin
FillRect(lpdis.hdc, lpdis.rcItem, GetSysColorBrush(COLOR_WINDOW));
SetBkColor(lpdis.hdc, GetSysColor(COLOR_WINDOW));
SetTextColor(lpdis.hdc, GetSysColor(COLOR_WINDOWTEXT));
if (lpdis.itemID mod 2) <> 0 then
begin
BrushNew := CreateSolidBrush(RGB(240, 240, 240));
BrushOld := SelectObject(lpdis.hdc, BrushNew);
FillRect(lpdis.hdc, lpdis.rcItem, BrushNew);
SetBkColor(lpdis.hdc, RGB(240, 240, 240));
SelectObject(lpdis.hdc, BrushOld);
DeleteObject(BrushNew);
end;
end;
if ((lpdis.itemState and ODS_FOCUS) <> 0) then
DrawFocusRect(lpdis.hdc, lpdis.rcItem);
itemdata := SendMessageW(lpdis.hwndItem, LB_GETITEMDATA, lpdis.itemID, 0);
if itemdata <> 0 then
begin
if InitThemeLibrary and UseThemes then
DrawThemeBackground(CheckTheme, lpdis.hdc, BP_CHECKBOX, CBS_CHECKEDNORMAL, Rect(lpdis.rcItem.Left + 2, lpdis.rcItem.Top + 2, lpdis.rcItem.Left + lpdis.rcItem.Bottom - lpdis.rcItem.Top - 1, lpdis.rcItem.Bottom - 2), nil)
else
DrawFrameControl(lpdis.hdc, Rect(lpdis.rcItem.Left + 2, lpdis.rcItem.Top + 2, lpdis.rcItem.Left + lpdis.rcItem.Bottom - lpdis.rcItem.Top - 1, lpdis.rcItem.Bottom - 2), DFC_BUTTON, DFCS_BUTTONCHECK or DFCS_CHECKED or DFCS_FLAT);
end
else
begin
if InitThemeLibrary and UseThemes then
DrawThemeBackground(CheckTheme, lpdis.hdc, BP_CHECKBOX, CBS_UNCHECKEDNORMAL, Rect(lpdis.rcItem.Left + 2, lpdis.rcItem.Top + 2, lpdis.rcItem.Left + lpdis.rcItem.Bottom - lpdis.rcItem.Top - 1, lpdis.rcItem.Bottom - 2), nil)
else
DrawFrameControl(lpdis.hdc, Rect(lpdis.rcItem.Left + 2, lpdis.rcItem.Top + 2, lpdis.rcItem.Left + lpdis.rcItem.Bottom - lpdis.rcItem.Top - 1, lpdis.rcItem.Bottom - 2), DFC_BUTTON, DFCS_BUTTONCHECK or DFCS_FLAT);
end;
SendMessageW(lpdis.hwndItem, LB_GETTEXT, lpdis.itemID, LPARAM(@tchBuffer));
lpdis.rcItem.Left := lpdis.rcItem.Left + 22;
lpdis.rcItem.Right := lpdis.rcItem.Right - 5;
DrawTextW(lpdis.hdc, @tchBuffer[0], -1, lpdis.rcItem, DT_SINGLELINE or DT_VCENTER);
end
else
begin
FillRect(lpdis.hdc, lpdis.rcItem, GetSysColorBrush(COLOR_WINDOW));
SetBkColor(lpdis.hdc, GetSysColor(COLOR_WINDOW));
SetTextColor(lpdis.hdc, GetSysColor(COLOR_WINDOWTEXT));
DrawTextW(lpdis.hdc, PWideChar(szEmptyStr), -1, lpdis.rcItem, DT_SINGLELINE or DT_VCENTER or DT_CENTER);
end;
end;[/more]

Хотя чего-то и чекбокс лепится и мусор, вобщем, я чего-то не пойму в чем ошибка...

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;

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

Maks150988
Если честно, то твой код я просто посмотрел, а опыты ставил на другом коде, в котором и нашел данный прикол. Так что даже не подскажу, в чем дело. Как всегда закоменть весь лишний код и посмотри, что происходит при отрисовке по шагам.

Привет всем. У меня такая проблема:
как на rasapi узнать занята телефонная линия или нет и
если занята, то как реализовать перезвон.
Заранее спасибо.

PS. Прошу прощения если вопрос задан не в том топике

ShIvADeSt
Ладно. Спасибо. Методом тыка нашел ошибку. Как оказалось почему-то если код прорисовки в отдельном модуле, то код для координат надо еще дописывать.

Вобщем кому интересно что получилось в итоге:

Ссылка

- Установка и снятие галочки в чекбоксе одного или всех пунктов
- Получение информации о состоянии выделенности чекбокса в пункте
- Отображение строк всех выделенных пунктов списка в сообщении
- Работа с кодировкой Юникод для загрузки и отображения строк
- Самостоятельная прорисовка строк в списке с некоторыми особенностями

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

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;

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

Цитата:

создать DDE сервер с именем 'EXCEL'

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

DmitryKz потому что в Action.OnExecute Sender'ом является сам Action и его приведение к TTBXItem само собой не верно...

DmitryKz
как я понял - пусть приятель использует PrivateExeProtector

Это, вобщем возник такой вопрос. Я должен скачать файл с сервера. Необходимо перед закачкой данных проверить наличие файла на сервере и номер ошибки. Если 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;

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

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

Здравствуйте.

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

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

Цитата:

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

IsWow64Process

Здраствуйте. Такие вопросы.

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;

DmitryKz
http://www.appcontrols.com/manuals/autoupgraderpro/index.html?autoupgraderscreenshot1.htm

Maks150988

Цитата:

1) Необходимо чтобы появлялось всплывающее меню по нажатии правой кнопки мыши на листбоксе. Код для отображения меню такой:

http://www.cyberguru.ru/programming/win32/win32-menu-page15.html тут пример, как я и думал надо просто вернуть TRUE если показываешь и FALSE если нет.

Для градиента попробуй смотреть в сторону регионов, создай пару регионов, потом скомбинируй их. Либо как вариант делай след образом - ты точно знаешь внутри какой области тебе надо делать градиентную заливку. Определи верхнюю и нижнюю границу для линии градиента через GetPixel (вроде так), как только получишь цвет границы внутри которой надо заливать останавливаешься и рисуешь линию на 1 пиксель ниже верха и на 1 пиксель выше низа. Таким образом(чтобы ускорить работаешь только на области закругления, а дальше просто рисуешь.
Если не понятно объяснил - то напиши, попробую на примере показать.

ShIvADeSt
Спасибо. =) Результат FALSE помог.
Да, лучше покажите на примере, а то так сразу непонятно, тем более я никогда не комбинировал регионы вообще.

Maks150988
погуглил немного, так как сам примерно представлял, нашел тут http://www.eggheadcafe.com/software/aspnet/30788108/fill-gradient-round-rect.aspx все что надо SelectClipRgn. Вот рабочий код
[more]

Код:
procedure TForm1.FormPaint(Sender: TObject);
const
x1=10;
y1=10;
x2=110;
y2=100;
a1=255;
a2=255;
a3=0;
b1=0;
b2=255;
b3=255;
var
h, i: integer;
Rgn :HRGN;
begin
Form1.Canvas.Pen.Color:=clBlack;
Form1.Canvas.RoundRect(10,10,100,100,20,20);
Rgn:=CreateRoundRectRgn(11,11,100,100,20,20);
SelectClipRgn(Form1.Canvas.Handle,Rgn);
h:=X2-X1-1;
for i:=0 to h do
with Form1.Canvas do
begin
Pen.Color:=RGB(A1-Round((A1-B1)/h*i), A2-Round((A2-B2)/h*i), A3-Round((A3-B3)/h*i));
Rectangle(I,Y1,I+1,Y2);
end;
SelectClipRgn(Form1.Canvas.Handle,0);
DeleteObject(Rgn);
end;

Не подскажете, почему может быть недоступным свойство Terminated у потока?

DmitryKz
Может потому, что когда это свойство true, то потока уже нет? Как проверяешь для начала?

Не знаю, глюк или не глюк, но когда код потока находился в отдельном юните, это свойство было недоступным, даже если просто написать Terminated получишь сообщение о не определенном идентификаторе. Перенес код пототка в юнит формы, теперь Terminated доступно

DmitryKz
TThread = class
...
protected
property Terminated: Boolean read FTerminated;
...

Вопросец такой, как перевести строку в число. В строку изначально могут быть введены только цифры + символ "."

I_Win
А с каких пор строка вида 5+5 является числом? Это, извините, выражение. Тут два варианта либо парсить из нее числа и делать операции, либо найти компонент, который умеет вычислять значение выражения.

ShIvADeSt
+ использовался вместо "и". То есть в строке только цифры и символ "."


В принципе уже сам разобрался с вопросом.

Подскажите, пожалуйста, что за глюк такой: есть форма настроек, при старте программы (в событии OnShow главной формы) из реестра и файла настроек загружаются сами настройки (т.е. когда, скажем, форма frmOptions еще невидима). Но есть один Edit, в котором всегда появляется значение, прописанное еще в дизайне. Хотя, когда пошагово проходишь код, значение из реестра туда прописывается. Почему же возвращается значение из дизайна??? Ради интереса прописал код заполнения Edit в событие OnShow формы опций - понятно, что все работает. Но все-то остальные настройки в кантролы и без этого нормально загружаются!