程序師世界是廣大編程愛好者互助、分享、學習的平台,程序師世界有你更精彩!
首頁
編程語言
C語言|JAVA編程
Python編程
網頁編程
ASP編程|PHP編程
JSP編程
數據庫知識
MYSQL數據庫|SqlServer數據庫
Oracle數據庫|DB2數據庫
 程式師世界 >> 編程語言 >> 更多編程語言 >> 更多關於編程 >> 在Listbox中增加背景圖

在Listbox中增加背景圖

編輯:更多關於編程

     1.  建立一個窗體
    2.  放一個ComboBox和Listbox
    3.  改變Component的Style為csOwnerDrawVariable和ListBox的Style為lbOwnerDrawVariable。
    4.  聲明5個TBitmap的全局變量
    5.  覆蓋Form的OnCreate.
    6.  覆蓋ComboBox的OnDraw.
    7.  覆蓋ComboBox的OnMeasureItem.
    8.  釋放資源在Form的OnClose.

      
    unit Ownerdrw;

      interface

      uses
      SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
      Forms, Dialogs, StdCtrls;

      type
      TForm1 = class(TForm)
        ComboBox1: TComboBox;
        ListBox1: TListBox;
        procedure FormCreate(Sender: TObject);
        procedure FormClose(Sender: TObject; var Action: TCloseAction);
        procedure ComboBox1DrawItem(Control: TWinControl; Index: Integer;
          Rect: TRect; State: TOwnerDrawState);
        procedure ComboBox1MeasureItem(Control: TWinControl; Index: Integer;
          var Height: Integer);
        procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
          Rect: TRect; State: TOwnerDrawState);
        procedure ListBox1MeasureItem(Control: TWinControl; Index: Integer;
          var Height: Integer);

        private
        { Private declarations }

        public
        { Public declarations }

        end;

      var
      Form1: TForm1;
      TheBitmap1, TheBitmap2, TheBitmap3, TheBitmap4,
      TheBitmap5 : TBitmap;
    implementation

      {$R *.DFM}

      procedure TForm1.FormCreate(Sender: TObject);
    begin
      TheBitmap1 := TBitmap.Create;
      TheBitmap1.LoadFromFile('C:delphiimagesuttonsglobe.bmp');
      TheBitmap2 := TBitmap.Create;
      TheBitmap2.LoadFromFile('C:delphiimagesuttonsvideo.bmp');
      TheBitmap3 := TBitmap.Create;
      TheBitmap3.LoadFromFile('C:delphiimagesuttonsgears.bmp');
      TheBitmap4 := TBitmap.Create;
      TheBitmap4.LoadFromFile('C:delphiimagesuttonskey.bmp');
      TheBitmap5 := TBitmap.Create;
      TheBitmap5.LoadFromFile('C:delphiimagesuttons ools.bmp');
      ComboBox1.Items.AddObject('Bitmap1: Globe', TheBitmap1);
      ComboBox1.Items.AddObject('Bitmap2: Video', TheBitmap2);
      ComboBox1.Items.AddObject('Bitmap3: Gears', TheBitmap3);
      ComboBox1.Items.AddObject('Bitmap4: Key', TheBitmap4);
      ComboBox1.Items.AddObject('Bitmap5: Tools', TheBitmap5);
      ListBox1.Items.AddObject('Bitmap1: Globe', TheBitmap1);
      ListBox1.Items.AddObject('Bitmap2: Video', TheBitmap2);
      ListBox1.Items.AddObject('Bitmap3: Gears', TheBitmap3);
      ListBox1.Items.AddObject('Bitmap4: Key', TheBitmap4);
      ListBox1.Items.AddObject('Bitmap5: Tools', TheBitmap5);

      end;

       

      procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
    begin
      TheBitmap1.Free;
      TheBitmap2.Free;
      TheBitmap3.Free;
      TheBitmap4.Free;
      TheBitmap5.Free;
    end;

      procedure TForm1.ComboBox1DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    var
      Bitmap: TBitmap;
      Offset: Integer;
    begin
      with (Control as TComboBox).Canvas do
      begin
        FillRect(Rect);
        Bitmap := TBitmap(ComboBox1.Items.Objects[Index]);
        if Bitmap <> nil then
        begin
          BrushCopy(Bounds(Rect.Left + 2, Rect.Top + 2, Bitmap.Width,
                    Bitmap.Height), Bitmap, Bounds(0, 0, Bitmap.Width,
                    Bitmap.Height), clRed);
          Offset := Bitmap.width + 8;
        end;
        { display the text }
        TextOut(Rect.Left + Offset, Rect.Top, Combobox1.Items[Index])
      end;
    end;

      procedure TForm1.ComboBox1MeasureItem(Control: TWinControl; Index:
                                          Integer; var Height: Integer);
    begin
      height:= 20;
    end;

      procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    var
      Bitmap: TBitmap;
      Offset: Integer;
    begin
      with (Control as TListBox).Canvas do
      begin
        FillRect(Rect);
        Bitmap := TBitmap(ListBox1.Items.Objects[Index]);
        if Bitmap <> nil then
        begin
          BrushCopy(Bounds(Rect.Left + 2, Rect.Top + 2, Bitmap.Width,
                    Bitmap.Height), Bitmap, Bounds(0, 0, Bitmap.Width,
                    Bitmap.Height), clRed);
          Offset := Bitmap.width + 8;
        end;
        { display the text }
        TextOut(Rect.Left + Offset, Rect.Top, Listbox1.Items[Index])
      end;
    end;

      procedure TForm1.ListBox1MeasureItem(Control: TWinControl; Index: Integer;
      var Height: Integer);
    begin
      height:= 20;
    end;

      end.

       

      
    //該窗體的DFM文件

      object Form1: TForm1
      Left = 211
      Top = 155
      Width = 435
      Height = 300
      Caption = 'Form1'
      Font.Color = clWindowText
      Font.Height = -13
      Font.Name = 'System'
      Font.Style = []
      PixelsPerInch = 96
      OnClose = FormClose
      OnCreate = FormCreate
      TextHeight = 16
      object ComboBox1: TComboBox
        Left = 26
        Top = 30
        Width = 165
        Height = 22
        Style = csOwnerDrawVariable
        ItemHeight = 16
        TabOrder = 0
        OnDrawItem = ComboBox1DrawItem
        OnMeasureItem = ComboBox1MeasureItem
      end
      object ListBox1: TListBox
        Left = 216
        Top = 28
        Width = 151
        Height = 167
        ItemHeight = 16
        Style = lbOwnerDrawVariable
        TabOrder = 1
        OnDrawItem = ListBox1DrawItem
        OnMeasureItem = ListBox1MeasureItem
      end
    end

    1. 上一頁:
    2. 下一頁:
    Copyright © 程式師世界 All Rights Reserved