[VahaC]

Иконка пропадает при выключении скина и снова появляется при включении, это если компилить проект с вкл скинами

А если скомпилить с выкл скинами то иконка не пропадает при вкл а потом выкл скинов

[VahaC]

7,43 баг присутствует

[VahaC]

7.43 проблема осталась

[VahaC]

вот что получилось в итоге

Code:

procedure TSubListBox.DrawItem(Index: Integer; Rect: TRect;
State: TOwnerDrawState);
var
sel_ind, unsel_ind : integer;
TmpBmp : TBitmap;
BGBmp: TBitmap;
BGRect: TRect;
TxtRect, TmpRect: TRect;
CI: TCacheInfo;
begin
if SkinData.Skinned then
begin
sel_ind := DefaultManager.GetSkinIndex(s_Selection);
unsel_ind := DefaultManager.GetSkinIndex(s_MainMenu);

BGRect := Classes.Rect(0, 0, Self.Width, Self.Height);
BGBmp := CreateBmp32(Self.Width, Self.Height);
TmpBmp := CreateBmp32(WidthOf(Rect), HeightOf(Rect));
TmpRect := Classes.Rect(0, 0, TmpBmp.Width, TmpBmp.Height);
TxtRect := Classes.Rect(20, 0, TmpBmp.Width – 20, TmpBmp.Height);

ci := MakeCacheInfo(BGBmp);
PaintItemBG(unsel_ind, s_MainMenu, CI, 0, BGRect, BGRect.TopLeft, BGBmp);

if odSelected in State then
begin
PaintItem(sel_ind, s_Selection, CI, True, 2, TmpRect, Rect.TopLeft, TmpBmp);
WriteTextEx(TmpBmp.Canvas, PChar(Items[Index]), True, TxtRect, DT_SINGLELINE or DT_VCENTER, sel_ind, True);
end
else
begin
TmpBmp.Canvas.CopyRect(TmpRect, BGBmp.Canvas, Rect);
WriteTextEx(TmpBmp.Canvas, PChar(Items[Index]), True, TxtRect, DT_SINGLELINE or DT_VCENTER, unsel_ind, False);
end;

BitBlt(Canvas.Handle, Rect.Left, Rect.Top, TmpBmp.Width, TmpBmp.Height, TmpBmp.Canvas.Handle, 0, 0, SRCCOPY);
FreeAndNil(TmpBmp);
FreeAndNil(BGBmp);

if FImages <> nil then
if FIconIndexList.Count > Index then
FImages.Draw(Canvas, 1, Rect.Top, Integer(FIconIndexList[Index]));
end
else
begin
if odSelected in State then
Canvas.Brush.Color := RGB(51, 153, 255)
else
Canvas.Brush.Color := clWhite;
Canvas.FillRect(Rect);
Canvas.TextOut(18, Rect.Top + 1, Items[Index]);
if FImages <> nil then
if FIconIndexList.Count > Index then
FImages.Draw(Canvas, 1, Rect.Top, Integer(FIconIndexList[Index]));
end;
end;

работает как надо.

Если есть предложения по усовершенствованию то готов их выслушать

[VahaC]

'ALR' wrote:

Чтоб не создавать новую тему добавлю сюда, тоже о кнопках закрыть.

На этом форуме как раз и нужно для каждого нового бага создавать новую тему. Support-у так намного удобнее отслеживать сообщения о новых багах

[VahaC]

Короче не нравилась мне предыдущая прорисовка посему переделал ее вот что получилось

Code:

procedure TSubListBox.DrawItem(Index: Integer; Rect: TRect;
State: TOwnerDrawState);
var
sel_ind, unsel_ind : integer;
TmpBmp : TBitmap;
BGBmp: TBitmap;
BGRect: TRect;
TxtRect, TmpRect: TRect;
begin
if SkinData.Skinned then
begin
sel_ind := DefaultManager.GetSkinIndex(s_Selection);
unsel_ind := DefaultManager.GetSkinIndex(s_MainMenu);

BGRect := Classes.Rect(0, 0, Self.Width, Self.Height);
BGBmp := TBitmap.Create;
BGBmp.PixelFormat := pf24bit;
BGBmp.Width := Self.Width;
BGBmp.Height := Self.Height;
PaintItemBG(unsel_ind, s_MainMenu, EmptyCI, 0, BGRect, BGRect.TopLeft, BGBmp);

TmpBmp := TBitmap.Create;
TmpBmp.PixelFormat := pf24bit;
TmpBmp.Width := WidthOf(Rect);
TmpBmp.Height := HeightOf(Rect);

TmpRect := Classes.Rect(0, 0, TmpBmp.Width, TmpBmp.Height);
TxtRect := Classes.Rect(20, 0, TmpBmp.Width – 20, TmpBmp.Height);
if odSelected in State then
begin
PaintItem(sel_ind, s_Selection, EmptyCI, True, 2, TmpRect, TmpRect.TopLeft, TmpBmp.Canvas.Handle);
WriteTextEx(TmpBmp.Canvas, PChar(Items[Index]), True, TxtRect, DT_SINGLELINE or DT_VCENTER, sel_ind, True);
end
else
begin
TmpBmp.Canvas.CopyRect(tmpRect, BGBmp.Canvas, tmpRect);

WriteTextEx(TmpBmp.Canvas, PChar(Items[Index]), True, TxtRect, DT_SINGLELINE or DT_VCENTER, unsel_ind, False);
end;

BitBlt(Canvas.Handle, Rect.Left, Rect.Top, TmpBmp.Width, TmpBmp.Height, TmpBmp.Canvas.Handle, 0, 0, SRCCOPY);
FreeAndNil(TmpBmp);
FreeAndNil(BGBmp);

if FImages <> nil then
if Integer( Items.Objects[Index]) <> -1 then
FImages.Draw(Canvas, 1, Rect.Top, Integer( Items.Objects[Index]));
end
else
begin
if odSelected in State then
Canvas.Brush.Color := RGB(51, 153, 255)
else
Canvas.Brush.Color := clWhite;
Canvas.FillRect(Rect);
Canvas.TextOut(18, Rect.Top + 1, Items[Index]);
if FImages <> nil then
if Integer( Items.Objects[Index]) <> -1 then
FImages.Draw(Canvas, 1, Rect.Top, Integer( Items.Objects[Index]));
end;
end;

Выглядит конечно очень страшно но рисует красиво.

Может есть у кого идеи как этот код поправить?

[VahaC]

Действительно. Просто раньше никогда не дисейблил компоненты целыми группами.

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

[VahaC]

AC 7.42 / D2010 / Win 7 Aero

ничего такого незаметил

[VahaC]

Тогда надо что то придумать чтобы и при откл скинах было идентичное поведение.

[VahaC]

а пропадание иконки формы?

[VahaC]

[attachment=4844:TsListView.zip]

[VahaC]

ой темой ошибся :a8:

[VahaC]

интересный нюанс если скомпилить проект с откл скинами а потом их вкл и снова откл то иконка не пропадает но меню рисуется не верно

[VahaC]

7,42 обе проблемы остались

при откл скинах пропадает иконка и неверно рисуется меню

[VahaC]

Обалдеть, в 7.42 кажись все работает как надо и без костылей

Спасибо

[VahaC]

Спасибо в 7,42 все работает

[VahaC]

Я так понимаю ничего еще не придумано

[VahaC]

AC 7.42

выделение не скинируется [attachment=4841:tlistview_skinned.PNG]

[VahaC]

OnActivate происходит при получении формой фокуса ввода. OnActivate вызывается только при переходе фокуса ввода от одной формы к другой в пределах одного приложения. При переключении между приложениями Delphi генерирует событие OnActivate глобального объекта Application.

[VahaC]

'VahaC' wrote:

У меня в АС 7,41 Д2010, Вин7 вообще это событие не срабатывает.

Извините не совсем точно выразился.

Если на форме нету sSkinManager-а или sSkinManager.Active = False то изменение значения sCheckListBox.Style на lbOwnerDraw… ни на что не влияет.

[Author]

Posts