Listbox с фоновым рисунком

Тема в разделе "Delphi - Multimedia, Графика, Игры", создана пользователем Dock1100, 23 апр 2010.

  1. Dock1100

    Dock1100 :-]

    Регистрация:
    9 ноя 2009
    Сообщения:
    678
    Симпатии:
    0
    Вот мой код отрисовки листбокса, но
    1. рисунок блымает, и глючит
    2. Почемуто надписи видны токо при выделении
    Код (Text):
    procedure TForm8.ListBox1DrawItem(Control: TWinControl; Index: Integer;
    Rect: TRect; State: TOwnerDrawState);
    begin

    ListBox1.Canvas.Brush.Color:=rgb(120,120,120);
    ListBox1.Canvas.pen.Style :=psclear;
    listbox1.Canvas.Font.Color:=rgb(255,255,255);
    ListBox1.Canvas.StretchDraw(bounds(0,0,listbox1.Width,listbox1.Height),bmp);
    //если вместо етого написать ListBox1.Canvas.fillrect(bounds(0,Rect.Top,rect.Right,listbox1.ItemHeight));
    //то надписи видны и нету ефкта блыманья
    ListBox1.Canvas.TextRect(rect,rect.left+3,rect.top+20,'');
    listbox1.Canvas.TextOut(rect.left+3,rect.top+3,ListBox1.Items[Index]);
    listbox1.Canvas.TextOut(rect.left+3,rect.top+20,ListBox1.Items[Index]);
    if odselected in state then
    begin
    ListBox1.Canvas.pen.Width:=1;
    ListBox1.Canvas.pen.Color :=rgb(100,100,100);
    ListBox1.Canvas.Brush.Color:=rgb(120,139,130);
    ListBox1.Canvas.roundrect(0,rect.Top,rect.Right,rect.bottom,10,10);
    ListBox1.Canvas.Brush.Style:=bsclear;
    ListBox1.Canvas.Font.Color:=rgb(255,255,255);
    ListBox1.Canvas.Font.style:=[fsbold];
    ListBox1.Canvas.TextRect(rect,rect.left+3,rect.top+20,'');
    listbox1.Canvas.TextOut(rect.left++3,rect.top+3,ListBox1.Items[Index]);
    listbox1.Canvas.TextOut(rect.left++3,rect.top+20,ListBox1.Items[Index]);
    end;


    if odFocused in State then
    ListBox1.Canvas.DrawFocusRect(Rect);



    end;
     
  2. VahaC

    VahaC Well-Known Member

    Регистрация:
    10 янв 2007
    Сообщения:
    116
    Симпатии:
    0
    А ты как хотел??

    Ты ведь рисуешь в OnDrawItem
    а значит вызывается для отрисовки каждого итема
    а ты делаешь
    что как раз "скрывает" всё что ты нарисовал раньше

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

    Для копирования используй Canvas.CopyRect
     
  3. VahaC

    VahaC Well-Known Member

    Регистрация:
    10 янв 2007
    Сообщения:
    116
    Симпатии:
    0
    Вот мой вариант кода
    Код (Delphi):
    procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
    Rect: TRect; State: TOwnerDrawState);
    var
    textheight : Integer;
    vcntr : Integer;
    str : String;
    begin
    str := ListBox1.Items[Index];
    textheight := listbox1.Canvas.TextHeight(str);
    vcntr := (listbox1.ItemHeight - textheight) div 2;

    ListBox1.Canvas.CopyRect(Rect, Image1.Canvas, Rect);
    ListBox1.Canvas.Brush.Style := bsClear;
    listbox1.Canvas.Font.Color := clBlack;
    listbox1.Canvas.TextOut(Rect.Left + 3, Rect.Top + vcntr, str);

    if odselected in state then
    begin
    ListBox1.Canvas.pen.Width := 1;
    ListBox1.Canvas.pen.Color := clSkyBlue;
    ListBox1.Canvas.Brush.Color := clSkyBlue;
    ListBox1.Canvas.roundrect(0, Rect.Top, Rect.Right, Rect.Bottom, 10, 10);
    ListBox1.Canvas.Font.Color := clBlack;
    ListBox1.Canvas.Font.style := [fsbold];
    listbox1.Canvas.TextOut(Rect.Left + 3, Rect.Top + vcntr, str);
    end;

    if odFocused in State then
    ListBox1.Canvas.DrawFocusRect(Rect);
    end;
    Его ещё надо допиливать так как есть глюки при прокрутке
     
  4. Dock1100

    Dock1100 :-]

    Регистрация:
    9 ноя 2009
    Сообщения:
    678
    Симпатии:
    0
    Мда, у меня выходило примерно тоже самое.
    Решил проще самому сделать подобие компонента листбокса, на основе рисунка(ну и трекбара для прокрутки):
    Код (Text):
    unit Unit5;

    interface

    uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs, ComCtrls, ExtCtrls, StdCtrls;

    type
    TForm5 = class(TForm)
    Image1: TImage;
    TrackBar1: TTrackBar;
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    Button2: TButton;
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure drawitem(canvas:tcanvas;pos:integer; image:TBitmap; bkcol:TColor);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
    Shift: TShiftState; X, Y: Integer);
    private
    { Private declarations }
    public
    { Public declarations }
    end;

    const itemh=40;

    var
    Form5: TForm5;
    items:Tstringlist;
    bmp:Tbitmap;
    pos:integer;
    selected:integer;


    implementation

    {$R *.dfm}

    procedure TForm5.FormCreate(Sender: TObject);
    var i,j:integer;
    s:string;
    begin
    items:=Tstringlist.Create;
    bmp:=TBitmap.Create;

    items.LoadFromFile('1.txt'); //тут выдаст ошибку просто сделайте тхт файл стекстом в корне с ехе
    memo1.Lines:=items;//использовал для проверки(сходства), правильноли рисует текст
    form5.DoubleBuffered:=true;
    drawitem(image1.Canvas,0,bmp,clcream);
    end;

    procedure TForm5.Image1MouseDown(Sender: TObject; Button: TMouseButton;
    Shift: TShiftState; X, Y: Integer); //выделение
    begin
    with image1 do
    begin
    selected:=pos+(y div itemh);
    drawitem(canvas,pos,bmp,clcream);
    end;

    end;

    procedure TForm5.TrackBar1Change(Sender: TObject);
    begin
    drawitem(image1.Canvas,trackbar1.Position,bmp,clcream);
    pos:=trackbar1.Position;
    end;

    procedure TForm5.Button1Click(Sender: TObject);
    begin
    if opendialog1.Execute then
    begin
    bmp.LoadFromFile(opendialog1.FileName);
    image1.Transparent:=false;
    end;
    end;

    procedure TForm5.Button2Click(Sender: TObject);
    begin
    drawitem(image1.Canvas,trackbar1.Position,bmp,clcream);
    end;

    procedure TForm5.drawitem(canvas: TCanvas; pos: Integer; image:TBitmap; bkcol:TColor); //отрисовка рисунка
    var i,k:integer;
    begin
    with image1 do
    begin
    Canvas.Brush.Color:=bkcol;
    Canvas.Brush.Style:=bssolid;
    canvas.FillRect(bounds(0,0,width,height));
    canvas.StretchDraw(bounds(0,0,width,height),image);
    k:=items.count;
    if (pos+(height div itemh))<k then k:=(pos+(height div itemh));
    for i:= pos to k-1 do
    begin
    if i<>selected then
    begin
    Canvas.Brush.Color:=rgb(120,120,120);
    Canvas.Brush.Style:=bsclear;
    Canvas.pen.Style :=psclear;
    Canvas.Font.Color:=rgb(0,0,0);
    Canvas.TextRect(bounds(0,0,width,height),0,itemh*(i-pos),Items[i]);
    end
    else
    begin
    Canvas.Brush.Color:=rgb(150,150,200);
    Canvas.Brush.Style:=bssolid;
    canvas.FillRect(bounds(0,(i-pos)*itemh,width,itemh));
    Canvas.Brush.Style:=bsclear;
    Canvas.pen.Style :=psclear;
    Canvas.Font.Color:=rgb(0,0,0);
    Canvas.TextRect(bounds(0,0,width,height),0,itemh*(i-pos),Items[i]);
    end;
    end;
    end;
    end;

    end.
     
  5. VahaC

    VahaC Well-Known Member

    Регистрация:
    10 янв 2007
    Сообщения:
    116
    Симпатии:
    0
    Можно ещё вот такой вариант попробовать
     
  6. Dock1100

    Dock1100 :-]

    Регистрация:
    9 ноя 2009
    Сообщения:
    678
    Симпатии:
    0
    Тоже вариант, но я его гуглом за 2 часа так и не нашол.
     
Загрузка...
Похожие Темы - Listbox фоновым рисунком
  1. Serduko
    Ответов:
    2
    Просмотров:
    839
  2. radivill
    Ответов:
    0
    Просмотров:
    1.267
  3. virtpro
    Ответов:
    1
    Просмотров:
    1.272
  4. jorjva
    Ответов:
    7
    Просмотров:
    2.589
  5. KingGLEB
    Ответов:
    3
    Просмотров:
    1.316

Поделиться этой страницей