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

Maks150988
С точки зреня компилятора оба варианта равнозначны. Компилятор вычисляет составные булевые выражения начиная с первого (левого) подвыражения до тех пор, пока не поймет, что дальнейшие подвыражения уже не изменят результат.
Скажем, если в выражении (hToolTip <> 0) and IsWindowVisible(hToolTip) hToolTip будет равен нулю, то каково бы ни было значение, возвращаемое вторым подвыражением, суммарное значение всего выражения будет false: (false and IsWindowVisible(hToolTip)) всегда будет false. Для компилятора это ясно как день и он не будет заморачиваться проверкой всех остальных подвыражений.

Ну а с точки зрения читабельности кода - кому как привычнее...

Добавлено:
Благодаря этому можно строить интересные конструкции, например (с потолка пример):
repeat
...
until Result or not NextRecord;
тут будет выполняться переход на следующую запись некоего набора данных (вызов функции NextRecord) только в том случае, если в ходе выполнения тела цикла Result еще не стало истиной. Ну и переход на следующий шаг цикла произойдет, если также и сама ф-ция вернула истину.

repeat
...
until not NextRecord or Result;
а тут будет выполняться переход на следующую запись некоего набора данных (вызов NextRecord) ВСЕГДА, независимо от значения переменной Result, вычисленной в ходе выполнения тела цикла! Вызов NextRecord произойдет даже если нет необходимости переходить на следующий шаг цикла.

Кто имел дело с регулярными выражениями подскажите пожалуйста как можно слово в кавычках найти, в одинарных кавычках " ' ", ведь в делфи строка для регулярки сама заключается в кавычки и любые лишние одинарные кавычки в pattern вызывают ошибки

AlexIntegral
а если так:[more=пример с использованием TRegExpr]procedure TForm2.Button1Click(Sender: TObject);
begin
with TRegExpr.Create do
try
Expression:= '''.*''';
if Exec('asfas'' asdasd''asdasd') then
ShowMessage(Match[0]);
finally
Free;
end;
end;[/more] Любая кавычка ' внутри строки заменяется парой этих кавычек.

psa1974, Maks150988
Это поведение полностью контролируется директивой компилятора BOOLEVAL.

Bonivur
Цитата:

Есть форма, на ней компонент PageControl. На первой Page - Image.

Попробуйте разместить имидж над PageControl'ом (но чтобы родитель и у него, и у PageControl'а был один и тот же)

AviDen
Оригинально мыслите, но все равно не помогло. Без Image PageControl сам по себе не мерцает, но при отрисовке изображения мерцание появляется. Причем нерегулярно.

Добавлено:
Frodo_Torbins

Цитата:

На счет OnCreate не уверен, на всякий случай проверьте в рантайме вдруг сбрасывается. Вообще демку бы, так как у меня все работает без мелькания.

Демка приложения с PageControl - http://rghost.ru/2080884 . У меня на WinXP SP3, NVidia 8800 GT 512 моргает.

Bonivur
Хм, в D2009 добавили обработку WM_ERASEBKGND у табшита. Ее конечно можно отключить (к примеру методом Geo), или вообще на время переключения заблокировать отрисовку через WM_SETREDRAW. Но по моему намного проще будет заменить пейджконтрол на табконтрол и во время переключения самому прятать и показывать контролы. Или в конце концов использовать скины, раз вам так важен внешний вид приложения.

Frodo_Torbins
Спасибо за помощь. А что такое "метод Geo"? Вы можете, если не трудно, выложить исправленный исходник, чтобы там не было мирцания? Честно говоря я уже и не надеюсь, что это вообще возможно - по-моему, мирцание Image это неискоренимо


Цитата:

Или в конце концов использовать скины, раз вам так важен внешний вид приложения.

Не понял. Я не использую скины. Это XPManifest (или соответсвующая галка в опциях приложения). Без него вообще фигово-то смотрится На дворе уже 2010 год.

Bonivur
Шаманский метод Geo. Вам надо перекрыть обработчик сообщения:[more]
Код: [no]type
TTabSheet = class(ComCtrls.TTabSheet)
private
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
end;

//...

{ TTabSheet }

procedure TTabSheet.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
//if ... then - иногда возможно стоит вызывать родительский обработчик
//inherited
//else
Message.Result := 1;
end;
[/no]

Frodo_Torbins
Спасибо. Сделал точно как Вы указали. Перекрыл обработчик события класса TTabSheet, но не помогло

А как скины могут здесь помочь? И какой компонент для скинов Вы можете посоветсовать? Раз уж другого способа нет - придется видимо прибегнуть к скинам...

Bonivur
Лично мне очень нравятся AlphaControls. Выберите себе скин по вкусу и редактором скинов замените фоновый рисунок на свой. Должно получится как в ихнем скине "Winter 2003".

Frodo_Torbins
А зачем заменять фоновый рисунок? У меня Image не во весь ТабШит.

Bonivur
Тогда попробуйте положить рисунок под пейджконтрол, сейчас нет времени проверить, но кажется это должно работать на скинах с прозрачными элементами управления.

Frodo_Torbins
Это работает и без скинов - Image выводится поверх PageControl'a, но мерцание все равно остается.

Насчет пейджконтрола, не знаю как на VCL все сделано и желания нет в VCL код заглядывать, но как вариант http://rsdn.ru/forum/winapi/716573.1.aspx для буферизации.

Maks150988
В новых версиях Delphi уже есть свойство DoubleBuffered для TabSheet'ов (делает ту же самую буферизацию), только оно не помогает, как не помогает и перекрытие WM_ERASEBKGND. Без Image'a Page Control не мерцает. Проблема вывода именно Image на PageControl'e без мерцания. Выше я давал демку - сами посмотрите.

Bonivur
Хм, решение тупо на WinApi, что сразу тупо на ум пришло. =)


Код:
procedure SetDoubleBuffer(hWnd: THandle);
var
dwStyle: DWORD;
begin
dwStyle := GetWindowLongW(hWnd, GWL_EXSTYLE);
SetWindowLongW(hWnd, GWL_EXSTYLE, dwStyle or WS_EX_COMPOSITED);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
i:Integer;
begin
Image1.Picture.Bitmap.LoadFromResourceName(HInstance,'OIL');
for i := 0 to PageControl1.PageCount - 1 do
begin
PageControl1.Pages[i].ControlStyle := PageControl1.Pages[i].ControlStyle - [csParentBackground];
SetDoubleBuffer(PageControl1.Pages[i].Handle);
end;
SetDoubleBuffer(PageControl1.Handle);
SetDoubleBuffer(Image1.Parent.Handle);
end;

Maks150988
Опаньки!!! Работает! Огромное спасибо, смогли все-таки найти выход. WinAPI рулит! И я не могу понять тогда цель использования DoubleBuffered если толку от него ноль.

Bonivur
Ну тут же еще есть вкладки - те же окна. Видимо стандартно буферизируется лишь сам контейнер их - пейджер. Тут мы все подряд буферизируем. Правда стиль WS_EX_COMPOSITED предназначен только для XP судя по MSDN (хотя и на младших системах он превосходно работает), если использовать старшие системы - надо вручную сабклассить.

Подскажите пожалуйста компонент для Delphi 2007
чтобы можно было отрисовать график с левой и правой осями Y
Например левая ось отображает абсолютные значения
а правая отображает значения в %.

TChart не подходит.

Спасибо.

Maks150988
Ох, я уж обрадовался, что это универсальное "лекарство". Ладно уж пусть хоть на XP без мерцания будет

Bonivur
Можно ограничится одним единственным "SetDoubleBuffer(PageControl1.Handle);", но конечно на виндах ниже XP это работать не будет. Выше - работает.

Frodo_Torbins
А что делать в случае с системами ниже XP?

Bonivur
Может пусть мигает?

[more=Так?]
Код: unit F_DblBuf;

interface

uses
Windows, Messages;

procedure CreateDoubleBufferControlW(hWnd: HWND);
procedure RemoveDoubleBufferControlW(hWnd: HWND);

implementation

type
TCtrlWndProc = function(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
P_CTRL_PRO = ^T_CTRL_PRO;
T_CTRL_PRO = packed record
CtrlProc : TCtrlWndProc;
rcClient : TRect;
hdcMem : HDC;
hbmMem : HBITMAP;
hbmOld : HBITMAP;
end;

var
pcp: P_CTRL_PRO;

//

function CtrlWndProc_WmSize(pcp: P_CTRL_PRO; hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
var
hdcIn: HDC;
begin

GetClientRect(hWnd, pcp.rcClient);

if (pcp.hdcMem <> 0) then
begin
SelectObject(pcp.hdcMem, pcp.hbmOld);
DeleteObject(pcp.hbmMem);
DeleteDC(pcp.hdcMem);
end;

hdcIn := GetDC(hWnd);
pcp.hdcMem := CreateCompatibleDC(hdcIn);
pcp.hbmMem := CreateCompatibleBitmap(
hdcIn,
pcp.rcClient.Right - pcp.rcClient.Left,
pcp.rcClient.Bottom - pcp.rcClient.Top
);
pcp.hbmOld := SelectObject(pcp.hdcMem, pcp.hbmMem);
ReleaseDC(hWnd, hdcIn);

Result := CallWindowProcW(@pcp.CtrlProc, hWnd, uMsg, wParam, lParam);

RedrawWindow(hWnd, nil, 0, RDW_INVALIDATE or RDW_UPDATENOW or RDW_NOERASE);

end;

//

function CtrlWndProc_WmPaint(pcp: P_CTRL_PRO; hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;

var
hdcIn: HDC;
ps : TPaintStruct;
begin

if (wParam = 0) then
hdcIn := BeginPaint(hWnd, ps)
else
hdcIn := wParam;

CallWindowProcW(@pcp.CtrlProc, hWnd, WM_ERASEBKGND, pcp.hdcMem, 0);
CallWindowProcW(@pcp.CtrlProc, hWnd, WM_PRINTCLIENT, pcp.hdcMem, PRF_CLIENT);

BitBlt(
hdcIn,
0,
0,
pcp.rcClient.Right - pcp.rcClient.Left,
pcp.rcClient.Bottom - pcp.rcClient.Top,
pcp.hdcMem,
0,
0,
SRCCOPY
);

if (wParam = 0) then
EndPaint(hWnd, ps);

Result := CallWindowProcW(@pcp.CtrlProc, hWnd, uMsg, wParam, lParam);

end;

//

function CtrlWndProc_WmEraseBkgnd(pcp: P_CTRL_PRO; hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
begin

Result := 1;

end;

//

function CtrlWndProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin

pcp := P_CTRL_PRO(GetWindowLongW(hWnd, GWL_USERDATA));

if (pcp = nil) then
begin
Result := DefWindowProcW(hWnd, uMsg, wParam, lParam);
Exit;
end;

case uMsg of

//

WM_DESTROY:
begin
RemoveDoubleBufferControlW(hWnd);
end;

//

WM_SIZE:
begin
Result := CtrlWndProc_WmSize(pcp, hWnd, uMsg, wParam, lParam);
end;

//

WM_PRINTCLIENT,
WM_PAINT:
begin
Result := CtrlWndProc_WmPaint(pcp, hWnd, uMsg, wParam, lParam);
end;

//

WM_ERASEBKGND:
begin
Result := CtrlWndProc_WmEraseBkgnd(pcp, hWnd, uMsg, wParam, lParam);
end;

else
Result := CallWindowProcW(@pcp.CtrlProc, hWnd, uMsg, wParam, lParam);
end;

end;

//

procedure CreateDoubleBufferControlW(hWnd: HWND);
begin

RemoveDoubleBufferControlW(hWnd);

pcp := P_CTRL_PRO(HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, SizeOf(T_CTRL_PRO)));
ZeroMemory(pcp, SizeOf(T_CTRL_PRO));

pcp.CtrlProc := TCtrlWndProc(Pointer(GetWindowLongW(hWnd, GWL_WNDPROC)));

SetWindowLongW(hWnd, GWL_USERDATA, Longint(pcp));

SetWindowLongW(hWnd, GWL_WNDPROC, Longint(@CtrlWndProc));

SendMessageW(hWnd, WM_SIZE, 0, 0);

end;

//

procedure RemoveDoubleBufferControlW(hWnd: HWND);
begin

pcp := P_CTRL_PRO(GetWindowLongW(hWnd, GWL_USERDATA));
if (pcp <> nil) then
begin

if (pcp.hdcMem <> 0) then
begin
SelectObject(pcp.hdcMem, pcp.hbmOld);
DeleteObject(pcp.hbmMem);
DeleteDC(pcp.hdcMem);
end;

SetWindowLongW(hWnd, GWL_WNDPROC, Longint(@pcp.CtrlProc));
RedrawWindow(hWnd, nil, 0, RDW_FRAME or RDW_INVALIDATE or RDW_ERASE);

SetWindowLongW(hWnd, GWL_USERDATA, 0);
HeapFree(GetProcessHeap, 0, pcp);

end;

end;

end.

Есть ли функция, которая по элементу массива, выдаст индекс этого элемента?

4t

Ого, ну если только перебором от Low до High инкрементировать самому значение и если строка в массиве по такому-то индеку сойдется, значит делаем Break в цикле.


Код: Result := FALSE;
i := 0;
for index := Low(Массив) to High(Массив) do
begin
s := Array[index];
if (s = Строка) then
begin
Result := TRUE;
Break;
end;
Inc(i)
end;

4t

Можно [more=так]

Код:
var
temp_array : array [0..4] of string =
(
'James',
'Kevin',
'Steve',
'Malcolm',
'Duayt'
);

function GetElementOfArray(const word:string; const input : array of string):Integer;
var
i:Integer;
begin
Result := -1;
for I := 0 to High(input) do
if input[i] = word then
begin
Result := i;
Break;
end
else
Result := -1;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
element:Integer;
begin
element := GetElementOfArray('Steve',temp_array);
ShowMessage(IntToStr(element));
end;

Maks150988
Попробуйте в обработчике WM_NCCalcSize размеры запоминать. А вообще чтобы виста говорила вам правильные размеры, нужно компилировать приложение особым образом, указывая параметр SubSystem=6.0 в PE-заголовке. В новых версиях делфи для этого есть опция компилятора "--pesubsysversion".

Frodo_Torbins
Спасибо, посмотрим, очень интересно стало. Ну а впринципе заголовок можно сменить редактором PE файлов.