Добрый день жители Королевства
Пишу run-time компонент наследник от TCustomControl. В работе использовал материалы из статей и форума Королевства.
Всё было нормально пока не понадобилось при отрисовке компонента использовать только часть канвы.
Требуется нарисовать фигуру состоящую из разных примитивов с различными градиентными заливками, поэтому часть ClientRectanglе дложна быть прозрачной(должен быть виден Parent или нижележащий Control).
В коде переопределяется метод Paint. Реализацию взял из статьи статьи "Градиентная фантазия" http://delphikingdom.ru/asp/viewitem.asp?catalogid=1090
Насколько я понял ситуацию то еще до вызова моего метода TMyObj.Paint вызываются методы родительских компонентов TCustomcontrol, TWinControl, TControl которые закрашивают ВСЮ клиентскую область и только потом рисуется мой компонент.
Вопрос можно ли добится прозрачности на канве потомка от TCustomControl.
Наследование от TGraphicControl не устраивает нужен фокус.
procedure TMyObj.Paint;
var
X, Y, W: Integer;
BtnRect: TRect;
ColArr: TColorArray;
begin
btnrect:=Clientrect;
InflateRect(btnrect,-30,-30);
W:=abs(btnRect.top-btnRect.bottom);
SetLength(ColArr,W + 1);
ComplexFillArray(Self.Color,fToColor,ColArr,w);
H_Gradient(Canvas,btnRect,ColArr);
if (fMode=mDesTime) and fCanMove then
DrawAnchors(Canvas,ClientRect);
DoDrawText(Canvas,fvalue,fFont);
Finalize(ColArr);
end;
Уважаемые авторы вопросов! Большая просьба сообщить о результатах решения проблемы на этой странице. Иначе, следящие за обсуждением, возможно имеющие аналогичные проблемы, не получают ясного представления об их решении. А авторы ответов не получают обратной связи. Что можно расценивать, как проявление неуважения к отвечающим от автора вопроса.
19-03-2008 09:07
ОК. Вопрос закрыт.
невнимательное копирование не освобождает от ответственности.
Действительно все решается с помощью SetWindowRgn.
Огромное спасибо за помощь.
Вопервых в Вашем фрагменте не SetWindowRgn а, SelectClipRgn.
В вторых - Paint не подходящее для этого место. Лучше посадить это на изменение размеров, родителя и ваших свойств, от которых зависят очертания фигуры
SetWindowRgn было испробовано в первую очередь. Результат 0(Null).
У меня остается стойкое подозрение что отрисовкой BackGrounda занимается предок TWinContorl-a.
Появилась идея наследовать от TControl (для наследования обработки мыши и Handle, для графики прикрутить наследника от TGraphicControl в качестве переменной.
Совет с копированием обязательно попробую, мож подойдет.
Спасибо.
Единственный паривльный вариант - это SetWindowRgn, как сказал bems. WS_EX_TRANSPARENT - тяжёлое наследие старых версий Windows, обращаться с ним сложно. Запоминание того, что находится снизу - работа тяжёлая, само по себе это не прокатит, потому что то, что снизу, само по себе не нарисуется, система старается не тратить время на рисование того, что потом не будет видно. Поэтому приходится прибегать к относительно затратным способам типа предложенного F.I.N., чтобы нарисовать то, что нужно. Это оправдано только тогда, когда фон нужен для дальнейшей обработки - например, для создания полупрозрачного изображения. Но у вас такой задачи, кажется, не просматривается, вам фон не нужен, а нужно только, чтобы компонент не занимал всю прямоугольную область - для таких задач SetWindowRgn идеальное решение.
Я иногда пользуюсь вот такой процедуркой. Писал не я. Выдернул с какого-то компонента...помнится там тоже было выдернуто :) и по-моему их RX. Косяков в работе не обнаружено.
procedure CopyParentImage(Control: TControl; Dest: TCanvas);
var
I, Count, X, Y, SaveIndex: Integer;
DC: HDC;
R, SelfR, CtlR: TRect;
begin
if (Control = nil) or (Control.Parent = nil) then Exit;
Count := Control.Parent.ControlCount;
DC := Dest.Handle;
{$IFDEF WIN32}
with Control.Parent do
ControlState := ControlState + [csPaintCopy];
try
{$ENDIF}
with Control do
begin
SelfR := Bounds(Left, Top, Width, Height);
X := -Left; Y := -Top;
end;
SaveIndex := SaveDC(DC);
try
SetViewportOrgEx(DC, X, Y, nil);
IntersectClipRect(DC, 0, 0, Control.Parent.ClientWidth, Control.Parent.ClientHeight);
with TParentControl(Control.Parent) do
begin
Perform(WM_ERASEBKGND, DC, 0);
PaintWindow(DC);
end;
finally
RestoreDC(DC, SaveIndex);
end;
for I := 0 to Count - 1 do
begin
if Control.Parent.Controls[I] = Control then
Break
else
if (Control.Parent.Controls[I] <> nil) and (Control.Parent.Controls[I] is TGraphicControl) then
begin
with TGraphicControl(Control.Parent.Controls[I]) do
begin
CtlR := Bounds(Left, Top, Width, Height);
if Bool(IntersectRect(R, SelfR, CtlR)) and Visible then
begin
{$IFDEF WIN32}
ControlState := ControlState + [csPaintCopy];
{$ENDIF}
SaveIndex := SaveDC(DC);
try
SetViewportOrgEx(DC, Left + X, Top + Y, nil);
IntersectClipRect(DC, 0, 0, Width, Height);
Perform(WM_PAINT, DC, 0);
finally
RestoreDC(DC, SaveIndex);
{$IFDEF WIN32}
ControlState := ControlState - [csPaintCopy];
{$ENDIF}
end;
end;
end;
end;
end;
{$IFDEF WIN32}
finally
with Control.Parent do
ControlState := ControlState - [csPaintCopy];
end;
{$ENDIF}
end;
Процедура копирует на указанный канвас (Canvas) "все что сзади" указанного контрола (Control).
Ну тут пару вариантов есть...
Первый.
Компонент делается прозрачным с помощью WM_EX_TRANSPARENT следующим образом
procedure TSomeComponent.CreateParams(var Params:TCreateParams);
begin
inherited;
Params.ExStyle:=Params.ExStyle or WS_EX_TRANSPARENT;
end;
Правда после этого есть одна проблемка. Будет рябить немного. Ну тут можно немного помухлевать с FDoubleBuffered и областями отрисовки...
Второй.
Запоминаете то, что находится под вашим компонентом, и при приходе WM_ERASEBKGND отрисовываете те области, где нету градиента. С FDoubleBuffered тоже придется помухлевать
Если вы заметили орфографическую ошибку на этой странице, просто выделите ошибку мышью и нажмите Ctrl+Enter. Функция может не работать в некоторых версиях броузеров.
