Вопрос # 5 252

Вопрос задал: eclipse (статус: Посетитель)
Вопрос отправлен: 4 мая 2011, 19:38
Состояние вопроса: решён, ответов: 0.

min@y™ (статус: Доктор наук), 4 мая 2011, 19:56 [#1]:

Цитата (eclipse):

eclipse (статус: Посетитель), 4 мая 2011, 21:18 [#2]:

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls;
 
type
  TForm1 = class(TForm)
    lv1: TListView;
    procedure FormCreate(Sender: TObject);
    procedure lv1CustomDrawItem(Sender: TCustomListView; Item: TListItem;
      State: TCustomDrawState; var DefaultDraw: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  b:TBitmap;
implementation
 
{$R *.dfm}
 
procedure TForm1.FormCreate(Sender: TObject);
var e,i:integer;
begin
    b:=TBitmap.Create;
    b.LoadFromFile('C:\1.bmp');
    for i:=1 to 100 do begin
      with lv1.Items.Add do begin
        Caption:=TimeToStr(now);
        for e:=1 to 100 do SubItems.Add(TimeToStr(now));
      end;
    end;
end;
 
procedure TForm1.lv1CustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
const c=3;
var ARect:TRect;
begin
    DefaultDraw:=false;
    ARect:=Item.DisplayRect(drBounds);
    BitBlt(Sender.Canvas.Handle,ARect.Left+c,ARect.Top+c,ARect.Right-ARect.Left-c,
    ARect.Bottom-ARect.Top-c,b.Canvas.Handle,ARect.Left,ARect.Top,SRCCOPY);
end;
 
end.

eclipse (статус: Посетитель), 1 июля 2011, 13:43 [#3]:

unit RVListView; 
 
interface 
 
uses 
  SysUtils, Classes, Controls, ComCtrls, Messages, Windows, Graphics; 
 
type 
  TBitmapPos = (bpTopLeft, bpTopRight, bpBottomLeft, 
                bpBottomRight, bpTile, bpCenter); 
 
  TRVListView = class(TListView) 
  private 
    FTag: Integer; 
    FBitmap: TBitmap; 
    FBitmapPos: TBitmapPos; 
    procedure SetBitmap(const Value: TBitmap); 
    procedure SetBitmapPos(const Value: TBitmapPos); 
    procedure OnBitmapChange(Sender: TObject); 
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT; 
  protected 
    procedure Paint; virtual; 
  public 
    constructor Create(AOwner: TComponent); override; 
    destructor Destroy; override; 
  published 
    property Bitmap: TBitmap read FBitmap write SetBitmap; 
    property BitmapPos: TBitmapPos read FBitmapPos write SetBitmapPos; 
  end; 
 
procedure Register; 
 
implementation 
 
procedure Register; 
begin 
  RegisterComponents('Rendez-vous', [TRVListView]); 
end; 
 
{ TRVListView } 
 
constructor TRVListView.Create(AOwner: TComponent); 
begin 
  inherited Create(AOwner); 
  //Initialize some variables 
  FTag := 0; 
  FBitmap := TBitmap.Create; 
  FBitmap.OnChange := OnBitmapChange; 
  FBitmapPos := bpBottomRight; 
end; 
 
destructor TRVListView.Destroy; 
begin 
  FBitmap.Free; //Free the background image 
  inherited Destroy; 
end; 
 
procedure TRVListView.OnBitmapChange(Sender: TObject); 
begin 
  Invalidate; //Call a refresh 
end; 
 
procedure TRVListView.Paint; 
var 
  X : LongInt; 
  Y : LongInt; 
  W : LongInt; 
  H : LongInt; 
  R : TRect; 
  DC: HDC; 
begin 
  if not Assigned(FBitmap) then 
    exit; 
 
  R := GetClientRect; 
  W := FBitmap.Width; 
  H := FBitmap.Height; 
  DC := GetDC(Self.Handle); //Get an handle to the TListView 
 
  //Draw the bitmap at a specific position 
  if FBitmapPos = bpTopLeft then 
  begin 
    BitBlt(DC,0,0,W,H,FBitmap.Canvas.Handle,0,0,SrcAnd); 
  end 
  else if FBitmapPos = bpTopRight then 
  begin 
    BitBlt(DC,R.Right - W,0,W,H,FBitmap.Canvas.Handle,0,0,SrcAnd); 
  end 
  else if FBitmapPos = bpBottomLeft then 
  begin 
    BitBlt(DC,0,R.Bottom - H,W,H,FBitmap.Canvas.Handle,0,0,SrcAnd); 
  end 
  else if FBitmapPos = bpBottomRight then 
  begin 
    BitBlt(DC,R.Right - W,R.Bottom - H,W,H,FBitmap.Canvas.Handle,0,0,SrcAnd); 
  end 
  else if FBitmapPos = bpTile then 
  begin 
    Y := R.Top; 
    while Y  Height do 
    begin 
      X := R.Left; 
      while X  Width do 
      begin 
        BitBlt(DC,X,Y,W,H,FBitmap.Canvas.Handle,0,0,SrcAnd); 
        Inc(X,W); 
      end; 
      Inc(Y,H); 
    end; 
  end 
  else if FBitmapPos = bpCenter then 
  begin 
    BitBlt(DC,(R.Right - R.Left - W) div 2,(R.Bottom - R.Top - H) div 2, 
           W,H,FBitmap.Canvas.Handle,0,0,SrcAnd); 
  end; 
 
  ReleaseDC(Self.Handle,DC); //Release the handle 
 
  //This condition is necessary to prevent flickering 
  if FTag = 0 then 
  begin 
    Invalidate; 
    FTag := 1; 
  end 
  else 
    FTag := 0; 
end; 
 
procedure TRVListView.SetBitmap(const Value: TBitmap); 
begin 
  FBitmap.Assign(Value); 
end; 
 
procedure TRVListView.SetBitmapPos(const Value: TBitmapPos); 
begin 
  if FBitmapPos  Value then 
  begin 
    FBitmapPos := Value; 
    Invalidate; 
  end; 
end; 
 
procedure TRVListView.WMPaint(var Message: TWMPaint); 
begin 
  inherited; 
  Paint; 
end; 
 
end.