自画TListBox界面

【例子介绍】

1. 仿QQ好友列表

2. 修改zw_sun代码去掉三方控件

3. TListBox显示图片与文字列表
【相关图片】

【源码结构】
procedure TMainForm.FormCreate(Sender: TObject);
var
  i: Integer;
begin
  // ListBox的风格，要自画必须选lbOwnerDrawFixed和lbOwnerDrawVariable
   lbxMain.Style := lbOwnerDrawFixed;
  // ListBox的每一项的高度
  lbxMain.ItemHeight := 50;
  pStrList := TStringList.Create;
  // 往ListBox中添加些数据

  for i := 1 to 5 do
  begin
    lbxMain.Items.Add('列表项 ' IntToStr(i));
    pStrList.Add('第二列 ' IntToStr(i) #13 '第三项 ' IntToStr(i));
  end;

end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
pStrList.Free;
end;

procedure TMainForm.FormShow(Sender: TObject);
begin
  lbxMain.ItemIndex := 0;
  lbxMain.Repaint();
end;

procedure TMainForm.lbxMainClick(Sender: TObject);
var
  p:TEditForm;
  strTemp:string;
begin
    p:= TEditForm.Create(lbxMain);
    p.edtFirst.Text := lbxMain.Items.Strings[lbxMain.ItemIndex];
    strTemp := pStrList.Strings[lbxMain.ItemIndex];
    p.edtSecond.Text := Copy(strTemp,1,Pos(#13,strTemp)-1);
    p.edtThird.Text := Copy(strTemp,Pos(#13,strTemp) 1,Length(strTemp));
    p.pnlTitle.Caption := ' 当前ListBox选中项：' IntToStr(lbxMain.ItemIndex);
    p.pnlTitle.Tag := lbxMain.ItemIndex;
    p.Left := Left (Width - p.Width) div 2;
    p.Top := Top (Height - p.Height) div 2;
    p.ShowModal();
    p.Free;
end;

procedure TMainForm.lbxMainDrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  strTemp: string;
begin

  // 填充的背景颜色
    lbxMain.Canvas.Brush.Color :=clred;
  // 文字颜色
  lbxMain.Canvas.Font.Color := clBlack;
  // 填充背景
   lbxMain.Canvas.FillRect(Rect);

  // 圆角矩形的背景颜色
  lbxMain.Canvas.Brush.Color := clSilver;
  // 圆角矩形的边框颜色
  lbxMain.Canvas.Pen.Color := clYellow;
  // 画出圆角矩形
  lbxMain.Canvas.RoundRect(Rect.Left 3, Rect.Top 3,
    Rect.Right - 2, Rect.Bottom - 2, 8, 8);
  // 以不同的宽度和高度再画一次，实现立体效果
  lbxMain.Canvas.RoundRect(Rect.Left 3, Rect.Top 3,
    Rect.Right - 3, Rect.Bottom - 3, 5, 5);
  // 如果是当前选中项

  if (odSelected in State) then
  begin
    // 选中项的背景颜色
    lbxMain.Canvas.Brush.Color := TColor($00FFB2B5);
    // 以不同的背景色画出选中项的圆角矩形
    lbxMain.Canvas.RoundRect(Rect.Left 3, Rect.Top 3,
      Rect.Right - 3, Rect.Bottom - 3, 5, 5);
    // 选中项的文字颜色
    lbxMain.Canvas.Font.Color := clBlue;
    // 如果当前项拥有焦点
    if (odFocused in State) then
      // 重画焦点虚框，实际上就是擦除了原先的焦点虚框
      // 我看到CnPack的设置中好象没有去除那个框. ccrun注
      DrawFocusRect(lbxMain.Canvas.Handle, Rect);
  end;

 // 画出图标
  ImageList1.Draw(lbxMain.Canvas, Rect.Left 7,
    Rect.top (lbxMain.ItemHeight - ImageList1.Height) div 2, Index);
   strTemp := pStrList.Strings[Index];
   // Item的第一行文字
  lbxMain.Canvas.TextOut(Rect.Left 32 10, Rect.Top 4,
   lbxMain.Items[Index] );
  // Item的第二行文字
  lbxMain.Canvas.TextOut(Rect.Left 32 10, Rect.Top 18,
    Copy(strTemp, 1, Pos(#13, strTemp) - 1));
  //     Item的第三行文字
  lbxMain.Canvas.TextOut(Rect.Left 32 10, Rect.Top 32,
    Copy(strTemp, Pos(#13, strTemp) 1, Length(strTemp)));

end;

procedure TMainForm.pnlTitleMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
    // 移动没有标题栏的窗体
    Refresh();
    if(Button = mbLeft) then
      begin
        ReleaseCapture();
        Perform(WM_SYSCOMMAND, $F017, 0);
      end;
end;