Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2006.05.14;
Скачать: [xml.tar.bz2];

Вниз

задний фон в TTreeView   Найти похожие ветки 

 
119   (2006-03-15 09:42) [0]

Как можно сделать задний фон TreeView картинкой. хочу поместить туда картинку строго соответствующую размерам самого TreeView. Все мои попытки не привели не к чему, или если и что то получалось, то это ужасно функционировало с добавлением новых элеменов и прочими ужасами некорректной прорисовки!


 
clickmaker ©   (2006-03-15 09:51) [1]


> 119   (15.03.06 09:42)

а как пытался-то?
через WM_ERASEBKGND или OnAdvancedCustomDraw?


 
119   (2006-03-15 09:59) [2]

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


 
clickmaker ©   (2006-03-15 10:03) [3]


> 119   (15.03.06 09:59) [2]

у меня нет конкретного примера. Ты напиши как сам делал, может что-то прояснится


 
119   (2006-03-15 10:12) [4]

Вроде вопрос закрыт :) Я нешел более-менее работающий код, вроде все гут.
type
TMyTreeView = class(TTreeView)
private
  FBitmap: TBitmap;
protected
  procedure WndProc(var Message: TMessage); override;
  procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
public
  property Bitmap: TBitmap read FBitmap write FBitmap;
end;

TTreeView = class(TMyTreeView);

TForm1 = class(TForm)
  Image1: TImage;
  TreeView1: TTreeView;
  Button1: TButton;
  XPManifest1: TXPManifest;
  procedure FormCreate(Sender: TObject);
private
  { Private declarations }
public
  { Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

uses
CommCtrl;

procedure TMyTreeView.WndProc(var Message: TMessage);
begin
if Message.Msg = WM_ERASEBKGND then begin
  Message.Result := 1
end else begin
  case Message.Msg of
    CN_NOTIFY: if TWMNotify(Message).NMHdr^.code = TVN_ITEMEXPANDING then
                 InvalidateRect(Handle, nil, False);
    WM_KEYDOWN, WM_HSCROLL, WM_VSCROLL, WM_MOUSEWHEEL:
                 InvalidateRect(Handle, nil, False);
  end;
  inherited
end
end;

procedure TMyTreeView.WMPaint(var Message: TWMPaint);
var
DC, TempDC, TempDC1: HDC;
TempBmp, OldBmp, OldBmp1, TempBMP1: HBITMAP;
PS: TPaintStruct;
TempRect: TRect;
begin
if Message.DC <> 0 then
  inherited
else begin
  TempRect := ClientRect;
  BeginPaint (Handle, PS);
  DC       := GetDC(Handle);
  TempDC   := CreateCompatibleDC(DC);
  TempDC1  := CreateCompatibleDC(DC);
  TempBMP  := CreateCompatibleBitmap(DC, TempRect.Right, TempRect.Bottom);
  TempBMP1 := CreateCompatibleBitmap(DC, TempRect.Right, TempRect.Bottom);
  OldBmp   := SelectObject(TempDC, TempBMP);
  OldBmp1  := SelectObject(TempDC1, TempBMP1);
  try
    Message.DC := TempDC;
    WMPaint(Message);
    Message.DC := 0;
    FillRect(TempDC1, TempRect, GetStockObject(WHITE_BRUSH));
    if FBitmap <> nil then
      BitBlt(TempDC1, 0, 0, FBitmap.Width, FBitmap.Height, FBitmap.Canvas.Handle, 0, 0, SRCCOPY);
    TransparentBlt (TempDC1, 0, 0, TempRect.Right, TempRect.Bottom, TempDC, 0, 0,
                    TempRect.Right, TempRect.Bottom, clFuchsia);
    BitBlt(DC, 0, 0, TempRect.Right, TempRect.Bottom, TempDC1, 0, 0, SRCCOPY);
  finally
    SelectObject (TempDC, OldBmp);
    SelectObject (TempDC1, OldBmp1)
  end;
  DeleteObject (TempBMP);
  DeleteObject (TempBMP1);
  ReleaseDC (Handle, TempDC);
  ReleaseDC (Handle, TempDC1);
  ReleaseDC (Handle, DC);
  EndPaint (Handle, PS)
end
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
TreeView1.Bitmap := Image1.Picture.Bitmap;
TreeView1.Color := clFuchsia;
TreeView1.BorderStyle := bsNone;
end;

end.


 
Алексей_Ш   (2006-04-06 15:53) [5]

Код вроде работает, даже суперски работает, но если программа работает долго то возникает Ошибка перепонения стека на строчке

TempBMP  := CreateCompatibleBitmap(DC, TempRect.Right, TempRect.Bottom);

кто подскажет почему это может происходить?



Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2006.05.14;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.47 MB
Время: 0.01 c
15-1145456846
geserx
2006-04-19 18:27
2006.05.14
Снесла курочка...


3-1142929367
WhiteBarin
2006-03-21 11:22
2006.05.14
Запуск Script через FIBPLUS для FireBird


15-1145442317
DelphiN!
2006-04-19 14:25
2006.05.14
Как перейти по ссылке на JScript


2-1145691993
News
2006-04-22 11:46
2006.05.14
параметры ОЗУ


2-1145971127
Виктор1985
2006-04-25 17:18
2006.05.14
как переменную типа double привести к integer?





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский