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

Maks150988

Цитата:

Переделал пример. Теперь нужно просто узнать сепаратор пункта меню.

Меню динамически создаешь? Если нет, то я просто проверял ItemID и если он был айдишником разделителя, то рисовал разделитель. Так как у меня их было немного, то мне такой способ помог. Насчет полоски слева меню. А она и рисуется кусками для каждого пункта меню В свое время намучился с этой полоской - кстати совет (с этим столкнулся, когда запустил свою программу с другим разрешением), не используй констант при отрисовке пунтков, получай их в программе (в частности, высоту пункта меню).

ShIvADeSt
Да как проверить то?

Код:
ItemState := GetMenuState( GetMenu(hApp), lpdis.itemID, MF_BYPOSITION );
if (ItemState and MFT_SEPARATOR <> 0) then

Maks150988

Цитата:

if (ItemState and MFT_SEPARATOR <> 0) then

Эммм попробуй так условие
if (ItemState and MFT_SEPARATOR) <> 0 then
возможно что приоритет операций косячит
или вот еще код
GetMenuItemInfo(Menu,i,true,mii);

//Если разделитель, то ставим соответствующее название
if (mii.fType and MFT_SEPARATOR) = MFT_SEPARATOR then
Buff:= '[SEPARATOR]'#0;

Не выходит. Может нужно вообще в каждой ситуцации проверки типа пункта отрисовку делать? Вы хотя бы код по ссылке смотрели? Надо понимать нужно приделать еще массив и в зависимости от пункта запонять его и если есть такие-то символы в нем - производить отрисовку. Так или я уже не в ту степь пошел? Я не знаю уж как тогда заставить все правильно работать. Никогда не думал что с прорисовкой меню такие грабли...

Maks150988
Много косяков было, первое - если пункт меню не имеет текста (а это именно разделитель), то у тебя был выход из процедуры отрисовки пункта. Далее, ты пытался получить статус разделитель или не разделитель передавая в функцию GetMenuState ID иконки, но статус получал по позиции, а не по команде. Что конечно в корне не верно, плюс много мелких багов, когда ты рисуешь часть пункта, а потом поверх того, что уже отрисовал рисуешь что то другое. В общем вот рабочий код
[more]

Код:
function MainDlgFunc(hWnd : THandle; uMsg : UINT; wParam : wParam; lParam : lParam) : BOOL; stdcall;
var
lpmis : PMEASUREITEMSTRUCT;
lpdis : PDRAWITEMSTRUCT;
MenuIndex : Integer;
MenuRect : TRect;
MenuText : Array [0..MAX_PATH] of Char;
MenuUINT : UINT;
BrushNew : HBRUSH;
BrushOld : HBRUSH;
PenBrush : HPEN;
PixelInx : Integer;
SelTmp : HGDIOBJ;
ItemState : DWORD;
begin
Result := TRUE;
case uMsg of

WM_MEASUREITEM :
case PDRAWITEMSTRUCT(lParam).CtlType of
ODT_MENU :
begin
MenuDC := GetDC(0);
lpmis := Pointer(lParam);
lstrcpy(MenuName, SizeMenu[lpmis.itemID]);
SetRectEmpty(RectData);
if MenuName[0] <> #0 then
begin
MenuDC := GetDC(0);
DrawText(MenuDC, MenuName, lstrlen(MenuName), RectData, DT_SINGLELINE or DT_CALCRECT or DT_LEFT);
ReleaseDC(0, MenuDC);
end;
lpmis.itemWidth := RectData.Right;
if (PChar(lpmis.itemData) = nil) then
lpmis.itemHeight := 10
else
lpmis.itemHeight := 22;
end;
end;

WM_DRAWITEM :
begin
case PDRAWITEMSTRUCT(lParam).CtlType of
ODT_MENU :
begin
lpdis := Pointer(lParam);
lstrcpy(MenuText, SizeMenu[lpdis.itemID]);
CopyRect(RectData, lpdis.rcItem);
SetRect(MenuRect, lpdis.rcItem.Left, lpdis.rcItem.Top, lpdis.rcItem.Left + 18, lpdis.rcItem.Bottom-3);
Inc(RectData.Left, 28);
if (lpdis.itemState and ODS_SELECTED) <> 0 then
begin
BrushNew := CreateSolidBrush(RGB(200, 210, 240));
BrushOld := SelectObject(lpdis.hDC, BrushNew);
FillRect(lpdis.hDC, lpdis.rcItem, BrushNew);
PenBrush := CreatePen(PS_SOLID, 1, RGB(50, 105, 200));
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(200, 210, 240));
SelectObject(lpdis.hDC, BrushOld);
DeleteObject(BrushNew);
SetBkMode(lpdis.hDC, TRANSPARENT);
SetTextColor(lpdis.hDC, GetSysColor(COLOR_WINDOWTEXT));
end
else
begin
FillRect(lpdis.hDC, lpdis.rcItem, GetSysColorBrush(COLOR_MENU));
SetBkColor(lpdis.hDC, GetSysColor(COLOR_WINDOW));
SetBkMode(lpdis.hDC, TRANSPARENT);
SetTextColor(lpdis.hDC, GetSysColor(COLOR_WINDOWTEXT));
for PixelInx := 22 downto 0 do
begin
SetDCPenColor(lpdis.hDC, GetGradientColor(RGB(205, 255, 255), PixelInx * 2));
SelTmp := SelectObject(lpdis.hDC, GetStockObject(DC_PEN));
MoveToEx(lpdis.hDC, lpdis.rcItem.Left + PixelInx, lpdis.rcItem.Top - 4, nil);
LineTo(lpdis.hDC, lpdis.rcItem.Left + PixelInx, lpdis.rcItem.Bottom);
DeleteObject(SelTmp);
end;
end;
if (lpdis.itemState and ODS_FOCUS) <> 0 then
DrawFocusRect(lpdis.hDC, PDRAWITEMSTRUCT(lParam).rcItem);

if (lpdis.itemState and ODS_GRAYED) <> 0 then
begin
SetBkMode(lpdis.hDC, TRANSPARENT);
SetBkColor(lpdis.hDC, GetSysColor(COLOR_GRAYTEXT));
SetTextColor(lpdis.hDC, GetSysColor(COLOR_GRAYTEXT));
end;
ItemState := GetMenuState(GetMenu(hApp), lpdis.itemID, MF_BYCOMMAND );
if (ItemState and MF_SEPARATOR =MF_SEPARATOR) then
begin
SetDCPenColor(lpdis.hDC, GetGradientColor(RGB(0, 0, 0), 0));
MoveToEx(lpdis.hDC, 22 + 4,lpdis.rcItem.Top + ((lpdis.rcItem.Bottom -lpdis.rcItem.Top) div 2), nil);
LineTo(lpdis.hDC, lpdis.rcItem.Right-4, lpdis.rcItem.Top + ((lpdis.rcItem.Bottom -lpdis.rcItem.Top) div 2));
end
else
begin
SetDCPenColor(lpdis.hDC, GetGradientColor(RGB(160, 175, 190), 0));
MoveToEx(lpdis.hDC, 22 + 4, lpdis.rcItem.Bottom - 3, nil);
LineTo(lpdis.hDC, lpdis.rcItem.Right-4, lpdis.rcItem.Bottom - 3);
lpdis.rcItem.Left := lpdis.rcItem.Left + 3;
DrawIconEx(lpdis.hDC, lpdis.rcItem.Left, (lpdis.rcItem.Top + lpdis.rcItem.Bottom - 16) div 2, MenuIcons[lpdis.itemID], 0, 0, 0, 0, DI_NORMAL) ;
DrawText(lpdis.hDC, MenuText, lstrlen(MenuText), RectData, DT_SINGLELINE or DT_VCENTER or DT_LEFT);
end;
end;
end;
end;

WM_CLOSE :
begin
for MenuIndex := MinCntMenu to MaxCntMenu do
begin
if MenuIcons[MenuIndex] <> 0 then
DeleteObject(MenuIcons[MenuIndex]);
end;
PostQuitMessage(0);
end;

WM_INITDIALOG :
begin
hApp := hWnd;
SetMenu(hApp, LoadMenu(hInstance, MAKEINTRESOURCE(101)));
CreateImageListMenuItems;
for MenuUINT := MinCntMenu to MaxCntMenu do
begin
GetMenuString(GetMenu(hApp), MenuUINT, MenuName, SizeOf(MenuName), MF_BYCOMMAND);
lstrcpyn(SizeMenu[MenuUINT], MenuName, SizeOf(SizeMenu[MenuUINT]));
end;
end;

WM_COMMAND :
if HiWord(wParam) = BN_CLICKED then
case LoWord(wParam) of
51 : MessageBox(hApp, '', '', MB_OK);
end;

else
Result := FALSE;
end;
end;

ShIvADeSt
Спасибо. Закомментировал только строки MoveToEx и LineTo (в самом конце кода прорисовки) чтобы линии повторно не рисовались для всех пунктов.
Тогда в догонку собственно еще хотелось бы знать, почему значок в пункте ListBox не отображается. Вместо него изредка мелькает какой-то неизвестный значок. Может нужно что-то ImageList для Listbox использовать? Код по ссылке.
http://webdrive.avtograd.ru/Download/Explorer/Download/listbox_test_draw.rar
P.S. Значок гружу в начале программы и при закрытии удаляю его. Пробовал каждый раз загружать значок при прорисовке - такая же ситуация - ничего не отображается.

Maks150988

Цитата:

Тогда в догонку собственно еще хотелось бы знать, почему значок в пункте ListBox не отображается. Вместо него изредка мелькает какой-то неизвестный значок. Может нужно что-то ImageList для Listbox использовать? Код по ссылке.

Ай-я-я-яй, кто же догадался ListIco : hIcon; сделать локальной переменной? У тебя сразу после инициализации диалога она стала ссылаться хз куда.
Надо объявить тут
var
hWndPls : THandle;

BeginDrag : Integer;
EndDrag : Integer;
IsDragging : Boolean = FALSE;
DL_Message : DWORD;
DragBuffer : Array [0..MAX_PATH - 1] of Char;
DragCursor : hCursor;
ListIco : hIcon;

а в локальных переменных функции убрать ее, тогда все отлично работает. Красивенько все рисует
и еще, данное сравнение
lpdis.ItemID > -1
всегда истинно, так как ItemID по сути longword, то есть меньше нуля быть не может

Простите за идиотский вопрос, но все же)
Как при заполнении dbase-овской таблицы данными, обновлять таблицу после занесения каждой записи?
А то данные в таблице появляются только после завершения работы проги (или закрытия таблицы).

diodio
По идее надо делать либо Refresh либо закрывать и открывать таблицу.

diodio

если делается прямо в эту таблицу - типа table.insert; .... table.post;
то, возможно, поможет помещение операций добавления в отдельный поток ..., а если данные попадают в результате каких либо сторонних действий - то только то что порекомендовал ShIvADeSt

diodio
Что стоит за словами "dbase-овской таблицы" , если файл
- Paradox, все должно и так работать ошибка гдето в другом
- если SQL база, то все зависит от используемых компонент доступа
...
В общем повтори вопрос, но подробно.

НАрод помогите плиз
как в Delphi 7 определить кол-во совпадаюших элементов в 2-ух массивах одинаковой размерности! СРОчно !!

Traestan
Вообще-то задание неполное. Например, может ли быть 3 или более совпадений (1 элемент в первом массиве равен 3-м элементам в другом) и как их считать: как одно совпадение или разные?

А вообще алгоритм простой:
Сначала отсортировать массивы.
Внутри цикла проверять на совпадение и увеличивать счетчик при выполнении условия.

Массивы отсартированные и одинаковые такчто надо просто -Внутри цикла проверять на совпадение и увеличивать счетчик при выполнении условия.
А как ето сделать я не знаю!!

Добавлено:
Народ ну ктонибуть помогите сравнить два массива одинаковой размерности и найти кол-во совпадаюших элементов! Плиз срочно нада!!!

ShIvADeSt
спасибо, как-то не подумал что-то я с этой переменной. Ну а собственно интересно, почему она в никуда при инициализации указывает-то? Вроде ж для функции диалога она, и при появлении диалога должна проиницализироваться. Что-то не пойму.
И кстати что можете посоветовать насчет двойной буферизации если конечно знаете как ее выполнить ну или кто-нибудь тут из собравшихся знает.
Есть код:

Код:
WM_PAINT :
begin
GetClientRect(hWndApp, Rect);
hdcWnd := BeginPaint(hWndApp, PS);
hbmMem := CreateCompatibleBitmap(hdcWnd, Rect.Right - Rect.Left, Rect.Bottom - Rect.Top);
hdcMem := CreateCompatibleDC(hdcWnd);
hbmWnd := SelectObject(hdcMem, hbmMem);
BitBlt(hbmWnd, 0, 0, Rect.Right - Rect.Left, Rect.Bottom - Rect.Top, hdcMem, 0, 0, SRCCOPY);
SelectObject(hdcMem, hbmWnd);
DeleteObject(hbmMem);
DeleteDC(hdcMem);
EndPaint(hWndApp, PS);
end;

не туда делаешь BitBlt. Вот код с инета, я в свое время так же делал отрисовку окна, мерцания не было.
case WM_PAINT:

Код:
hDC = BeginPaint(hDlg,&ps);
GetClientRect(hDlg,&rect);

hdcMem = CreateCompatibleDC(hDC);
hbmMem = CreateCompatibleBitmap(hDC,rect.right,rect.bottom);
hold = SelectObject(hdcMem,hbmMem);
BitBlt(hdcMem ,0,0,rect.right,rect.bottom,hDC,0,0,SRCCOPY);// копирование фона в hdcMem
Рисую уже в hdcMem
..................................
...................................
после рисования в hdcMem Вывожу содержимое на экран

BitBlt(hDC,0,0,rect.right,rect.bottom,hdcMem,0,0,SRCCOPY);

SelectObject(hdcMem,hold);
DeleteObject(hbmMem);
DeleteObject(hdcMem);

Ребята, подскажите, как можно передать именованные константы в функцию, которая требует параметров типа OleVariant, если они другого типа, например, integer?

DmitryKz
Параметры OleVariant объявлены как var? Описать переменную типа OleVariant, присвоить ей значение константы и передать в функцию.
Если не так понял - напиши как у тебя константы описаны и как заголовок функции выглядит.

Да в принципе ты все правильно пишешь. Код:

Цитата:

interface
uses Word_TLB;
...
implementation
const
wdBrowseHeading = 9;
wdParagraph = 4;
wdExtend = 1;
...
function CreateSectionsList(PWordApp: WordApplication): Boolean;

begin
PWordApp.Selection.Start := 0;
PWordApp.Selection.End_ := 0;
PWordApp.Browser.Target := wdBrowseHeading;
PWordApp.Browser.Next;
PWordApp.Selection.MoveDown(wdParagraph, 1, wdExtend);
...

В сгенерированном средой модуле Word_TLB функция MoveDown описывается как:

Цитата:

unit Word_TLB;
...
function MoveDown(var Unit_: OleVariant; var Count: OleVariant; var Extend: OleVariant): Integer; safecall;

Через IDispatch (позднее связывание) работать не хоу - никакого контроля типов при вводе кода. Просто некоторые функции требуют не одного, не двух параметров и вводить буферные переменный и назначать им каждый раз значения констант для передачи в параметры, тоже как-то не особо хотца. Ну раз другого пути нет...

2 V1s1ter

Таблица парадоксовская.
Вот
Код:
Table2.append;
Table2.fieldbyname('IM_FILE').asString:=SearchRec.name;
Table2.fieldbyname('NOMER_KSA').asString:=s3;
Table2.fieldbyname('VIG_N').asString:='GOOD';
Table2.fieldbyname('DATE').AsDateTime := now;
Table2.fieldbyname('DATE_FILE').AsDateTime := StrToDate(s+'.'+s2);
Table2.fieldbyname('OTDELEN').asString:=s5;
Table2.fieldbyname('FROM').asString:=Dir;
Table2.post;

diodio
Table2.Refresh тебя спасет.

Хорошо бы. Но не спасает. Данные в таблице не обновляются!

НАрод помпогите плиз найти доинаковые элементы в 2-ух отсартированных по убыванию массивах одинаковой размерности (array[0..6])!!!

Traestan, для таких размеров сортировка, имхо, не играет роли. В том плане, что можно сделать так:


Код: {$apptype console}

var
A: array[0..6] of integer = (10, 7, 6, 5, 3, 1, 0);
B: array[0..6] of integer = (13, 10, 8, 6, 5, 2, 1);
i,j: integer;

begin
for i := 0 to 6 do
for j := 0 to 6 do
if A[i] = B[j] then write(A[i], ' ');
readln;
end.

Traestan
В типовые задачи по Паскалю с таким примитивом

Народ, помогите в вопросе. Есть ли какой-нибудь способ перевести string в PAnsiChar? Просто я написал небольшую прогу, которая, используя winexec, отправляет net send * или с помощью msg * сообщение, например, "Сервер будет перезагружен ч-з 15 мин", которое прописано в коде программы. Мне бы хотелось, чтоб это сообщение мною вводилось в какое-нибудь поле (едит, мемо - не важно). Создал переменную PAnsiChar. Да вот беда, мемо и едиты - это стринг, а winexec "кушает" только PAnsiChar. Как это обрулить? Или есть более грамотные предложения, как по сети послать сообщение, набранное в строке ввода?

pavel1978
Фигню пишешь, WinExec работает с обычными строками. Откуда ты выкопал насчет PAnsiChar - хз.

ShIvADeSt
Секундочку! При написании winexec( делфи выдает подсказку: LpCmdLine: PAnsiChar. При присвоении переменной текста из едита или мемо дельфи матерится, что несовместимые типы string и PAnsiChar. Может, я что-то не понимаю - тогда пример, как запихнуть текст из едита (а лучше мемо) в winexec?

pavel1978
У меня выдает подсказку насчет PChar - в этом случае пишешь так
WinExec(PChar(Edit1.text),второй параметр).
Просто 100 лет уже не работал с WinExec - помню, что проблем не было с передачей туда строк.

DmitryKz
var-параметр предусматривает возвращение через него значения. Наверное, теоретически, компилятор мог бы догадаться, что если ты передаешь константу, то надо неявно создать переменную соответствующего типа, записать константу в нее, вызвать функцию, а значение, которое вернулось, наплевать... но, имхо, слишком неожиданные результаты можно получить от такого "умного" компилятора, запаришься разбирать что же он накомпилял когда не так заработает