dvpt » 09.04.2009 20:38:14
Код довольно простой, выводит список файлов
procedure TForm1.KinoGrid1DrawCell(Sender: TObject; aCol, aRow: Integer;
aRect: TRect; aState: TGridDrawState);
var
h, c: Integer;
i, ii: Integer;
s, ss : String;
a : String;
begin
if VideoLst = NIL then exit;
if VideoLst.Count = 0 then exit;
i := KinoGrid1.ColCount * ARow + ACol;// Пересчитываем координаты ячейки в индекс списка:
with KinoGrid1.Canvas, VideoLst do begin
if (gdFocused in aState) then
if i < VideoLst.Count then iVideo := i;// запоминаю текущую строку
CopyMode := cmSrcCopy;
Brush.Style := bsClear;
Brush.Color := clWhite;
FillRect( ARect);
CopyRect( ARect, Image4.Canvas, Image4.Canvas.ClipRect);
if i < VideoLst.Count then begin
ii := Pos(':',VideoLst[i]);// разбираем имя файла
if ii > 0 then begin
s := Copy(VideoLst[i],1,ii-1);
ss := Copy(VideoLst[i],ii+1,255);
end else begin
s := VideoLst[i];
ss := '';
end;
CopyMode := cmSrcAnd;
Font.Name := Family.Font.Name;
Font.Name := Family.Font.Name;
//рисую имя файла
Font.Color := clGreen;
Font.Style := [fsBold];
c := TextWidth('W');//ширина одного символа
h := TextHeight('W');//высота одного символа
ii := 1;
a := '';
for i := 1 to Length(s) do begin
a := a + Copy(s,i,1);
if (((TextWidth(a)+c) >= (ARect.Bottom - ARect.Top)) or (i = Length(s))) then begin
TextRect( ARect, ARect.Left+4, ARect.Top+(ii-1)*h, a);
a := '';
Inc(ii);
if (ii > (((ARect.Bottom - ARect.Top) div 2) div h)) then break;//max колич. строк
end;
end;
//рисую пояснения к файлу
Font.Color := clBlue;
Font.Style := [fsBold,fsItalic];
c := TextWidth('W');//ширина одного символа
h := TextHeight('W');//высота одного символа
a := '';
for i := 1 to Length(ss) do begin
a := a + Copy(ss,i,1);
if (((TextWidth(a)+c) >= (ARect.Bottom - ARect.Top)) or (i = Length(ss))) then begin
TextRect( ARect, ARect.Left+4, ARect.Top+(ii-1)*h, a);
a := '';
Inc(ii);
if (ii > (((ARect.Bottom - ARect.Top) div 2) div h)) then break;//max колич. строк
end;
end;
end;
end;
end;