Link to home
Start Free TrialLog in
Avatar of ginsonic
ginsonicFlag for Romania

asked on

Image list in my TCustomControl (1.000 points)

I need to create in my TustomControl a list of images and to be able to scroll these up and down to can select one.

Someone can help me to do this job?

I offer 1.000 points for a real support (codes or very good comments, not just summary ideas)
Avatar of Member_2_248744
Member_2_248744
Flag of United States of America image

hello ginsonic, maybe you could give some more info about what you need to do and some specs for image sizes and will images be loaded into list at program design time, run time or added to the component. The options for graphical display are really very many. Have you considered a TDrawGrid and A TImageList?
Avatar of ginsonic

ASKER

My component look alike a vertical band (a photofilm). Into my program I need to make couple snapshots and to add these to my component alike photos (simmilary of thumbnails).

In present I use a TList of TImage32. When I call Add procedure a new image32 is added to my list .Call Delete ...

The problem is when I try to display these thumbnails.

Must show just a number of images what will fit the component area.

I must can scroll the list up ( when press a button, don't wish to use scrollbars)., and simmilary for down.

And when I will delete an image all next images can go up with one position.

For image size I use in this moment 100x75 pixels.

To have an idea about my component just think about a rollfilm what is scrolled up&down to can look at each photo.
ASKER CERTIFIED SOLUTION
Avatar of Member_2_248744
Member_2_248744
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
I had some time this weekend -


unit RollFilm;

interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Buttons;

type
TSelRec = Record
  Draw: Boolean;
  SelNum: Integer;
  sRect: TRect;
  end;

TRollFilm = class(TCustomControl)
  private
  { Private declarations }
    FFilm: TBitmap;
    FTopNum, FImageNum: Integer;
    FFilmRect: TRect;
    FUpBut, FDownBut, FDelSelBut: TSpeedButton;
    FSel: TSelRec;
    procedure UpClick(Sender: TObject);
    procedure DownClick(Sender: TObject);
    procedure DelSelClick(Sender: TObject);
    procedure DrawFilm;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;

  protected
  { Protected declarations }
    procedure Paint; override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure CreateWnd; override;
    property Canvas;

  public
  { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure AddBitmap(Bmp: TBitmap);

  published
  { Published declarations }

end;

procedure Register;

const
FSize = 86;

implementation

procedure Register;
begin
RegisterComponents('Samples', [TRollFilm]);
end;

constructor TRollFilm.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := [csOpaque, csReplicatable];
Width := 178;
Height := 210;
FFilm := TBitmap.Create;
FFilm.PixelFormat := pf24Bit;
FFilm.Canvas.Brush.Color := clBlack;
FFilm.Height := (FSize*2)+4;
FFilm.Width := FSize;
FFilm.Canvas.Font.Color := clWhite;
FFilm.Canvas.TextOut(10,FSize div 2,'Frame 1');
FFilm.Canvas.TextOut(10,FSize+(FSize div 2),'Frame 2');
FFilmRect := Rect(8,8,FSize+8,(FSize*2)+12);
FTopNum := 0;
FImageNum := 0;
Canvas.Pen.Color := clHighLight;
Canvas.Pen.Width := 3;
Canvas.Brush.Color := Color;
Canvas.Brush.Style := bsClear;
FSel.Draw := False;
FSel.SelNum := -1;
FSel.sRect := Rect(FFilmRect.Left+1,FFilmRect.Top+1,
                FFilmRect.Right-1,FFilmRect.Top+FSize+2);
end;

destructor TRollFilm.Destroy;
begin
if Assigned(FFilm) then
FFilm.Free;
inherited Destroy;
end;

procedure TRollFilm.CreateWnd;
begin
inherited;
if not Assigned(FUpBut) then
  begin
  FUpBut := TSpeedButton.Create(Self);
  with FUpBut do
    begin
    Parent := Self;
    Caption := 'Up';
    Width := 34;
    Height := 24;
    Top := 14;
    Left := FSize + 20;
    Enabled := False;
    OnClick := UpClick;
    end;
  end;

if not Assigned(FDownBut) then
  begin
  FDownBut := TSpeedButton.Create(Self);
  with FDownBut do
    begin
    Parent := Self;
    Caption := 'Down';
    Width := 34;
    Height := 24;
    Top := 150;
    Left := FSize + 20;
    Enabled := False;
    OnClick := DownClick;
    end;
  end;

if not Assigned(FDelSelBut) then
  begin
  FDelSelBut := TSpeedButton.Create(Self);
  with FDelSelBut do
    begin
    Parent := Self;
    Caption := 'Delete Sel';
    Width := 60;
    Height := 24;
    Top := 44;
    Left := FSize + 20;
    Enabled := False;
    OnClick := DelSelClick;
    end;
  end;
end;

procedure TRollFilm.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
  begin
  Style := Style and not WS_BORDER;
  ExStyle := ExStyle or WS_EX_DLGMODALFRAME;
  end;
end;

procedure TRollFilm.WMSize(var Message: TWMSize);
var
New, More: Integer;
begin

New := Message.Height - FFilmRect.Top;
More := (New div FSize) - ((FFilmRect.Bottom-FFilmRect.Top) div FSize);
if More = 0 then Exit;
if New > FFilmRect.Bottom+ FSize then
FFilmRect.Bottom :=  FFilmRect.Bottom+ (FSize*More)+(2*More);

if New < FFilmRect.Bottom then
if New < (FSize*2)+6 then
FFilmRect.Bottom :=  FFilmRect.Top+(FSize)+2 else
FFilmRect.Bottom :=  FFilmRect.Bottom+ (FSize*More)+(2*More);
Paint;
inherited;
end;

procedure TRollFilm.UpClick(Sender: TObject);
begin
if FTopNum > 0 then
  begin
  Dec(FTopNum);
  DrawFilm;
  FSel.Draw := False;
  FSel.SelNum := -1;
  FDelSelBut.Enabled := False;
  end;
end;

procedure TRollFilm.DownClick(Sender: TObject);
begin
if FTopNum < FImageNum-(FFilmRect.Bottom div (FSize+2)) then
  begin
  Inc(FTopNum);
  DrawFilm;
  FSel.Draw := False;
  FSel.SelNum := -1;
  FDelSelBut.Enabled := False;
  end;
end;

procedure TRollFilm.DelSelClick(Sender: TObject);
var
TempBmp: TBitmap;
begin
if (FSel.SelNum < 0) or (FSel.SelNum > FImageNum -1) then Exit;
if (FSel.SelNum <> FImageNum -1) then
  begin
  TempBmp := TBitmap.Create;
  try
    TempBmp.Canvas.Brush.Color := clBlack;
    TempBmp.Height := (FSize*(FImageNum -1-FSel.SelNum))+
                      ((FImageNum -1-FSel.SelNum)*2);
    TempBmp.Width := FSize;
    BitBlt(TempBmp.Canvas.Handle,0, 0,FFilm.Width,TempBmp.Height,
       FFilm.Canvas.Handle,0,((FSel.SelNum+1)*FSize)+(2*(FSel.SelNum+1)), SRCCOPY);
    BitBlt(FFilm.Canvas.Handle,0, (FSel.SelNum*FSize)+(2*FSel.SelNum),FFilm.Width,
       TempBmp.Height, TempBmp.Canvas.Handle,0,0, SRCCOPY);
    finally
    TempBmp.Free;
    end;
  end;
FFilm.Height := FFilm.Height - FSize - 2;
Dec(FImageNum);
FTopNum := 0;
FSel.Draw := False;
Paint;
end;

procedure TRollFilm.DrawFilm;
begin
if Assigned(FFilm) then
  BitBlt(Canvas.Handle,FFilmRect.Left, FFilmRect.Top,FFilm.Width,
       FFilmRect.Bottom-FFilmRect.Top, FFilm.Canvas.Handle,0,(FTopNum*FSize)+(FTopNum*2), SRCCOPY);
end;

procedure TRollFilm.Paint;
begin
inherited;
Canvas.Brush.Color := Color;
Canvas.Brush.Style := bsSolid;
Canvas.TextOut(FFilmRect.Right+8,100,IntToStr(FImageNum)+' Images');
Canvas.Brush.Style := bsClear;
DrawFilm;
InflateRect(FFilmRect,4,4);
DrawEdge(Canvas.Handle,FFilmRect, EDGE_SUNKEN, BF_RECT);
InflateRect(FFilmRect,-4,-4);
if FSel.Draw then
Canvas.Rectangle(FSel.sRect);
end;

procedure TRollFilm.AddBitmap(Bmp: TBitmap);
var
ThumBmp: TBitmap;
DWidth, DHeight: Integer;
begin
if (not Assigned(Bmp)) or Bmp.Empty then Exit;
Inc(FImageNum);
if FImageNum > 2 then
FFilm.Height := FFilm.Height + 102;
if (Bmp.Width = FSize) and (Bmp.Height = FSize) then
  BitBlt(FFilm.Canvas.Handle,0, ((FImageNum-1) * FSize)+((FImageNum-1) * 2),FFilm.Width,
       FSize, Bmp.Canvas.Handle,0,0, SRCCOPY)
else
  begin
  ThumBmp := TBitmap.Create;
  try
  ThumBmp.PixelFormat := pf24Bit;
  ThumBmp.Canvas.Brush.Color := clBlack;
  ThumBmp.Width := FSize;
  ThumBmp.Height := FSize;
  if Bmp.Width < Bmp.Height then
    begin
    DHeight := FSize;
    DWidth := Trunc(FSize / (Bmp.Height / Bmp.Width));
    end else
  if Bmp.Width > Bmp.Height then
    begin
    DWidth := FSize;
    DHeight := Trunc(FSize / (Bmp.Width / Bmp.Height));
    end  else
    begin
    DWidth := FSize;
    DHeight := FSize;
    end;
    ThumBmp.Canvas.StretchDraw(Rect((FSize div 2)-(DWidth div 2),(FSize div 2)-(DHeight div 2),(FSize div 2)-(DWidth div 2)+DWidth,(FSize div 2)-(DHeight div 2)+DHeight), Bmp);
    BitBlt(FFilm.Canvas.Handle,0, ((FImageNum-1) * FSize)+((FImageNum-1) * 2),FFilm.Width,
       FSize, ThumBmp.Canvas.Handle,0,0, SRCCOPY);
    FFilm.Canvas.TextOut(67,((FImageNum-1) * FSize)+(FSize-14),IntToStr(FImageNum));
    finally
    ThumBmp.Free;
    end;
  end;

if FImageNum > 2 then
  begin
  FUpBut.Enabled := True;
  FDownBut.Enabled := True;
  end else
  DrawFilm;
if FSel.Draw then
Canvas.Rectangle(FSel.sRect);
Canvas.Brush.Color := Color;
Canvas.Brush.Style := bsSolid;
Canvas.TextOut(FFilmRect.Right+8,100,IntToStr(FImageNum)+' Images');
Canvas.Brush.Style := bsClear;
end;

procedure TRollFilm.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
Pt1: TPoint;
i: Integer;
begin
inherited MouseDown(Button, Shift, X, Y);
Pt1.x := X;
Pt1.y := Y;
if (Button = mbLeft) AND PtInRect(FFilmRect, Pt1) then
  begin
  FSel.SelNum := -1;
  Pt1.x := 0;
  for i := 0 to 20 do
    begin
    if Y < FFilmRect.Top+(FSize*(i+1))+(2*(i+1)) then
      begin
      if FTopNum+i < FImageNum then
      FSel.SelNum := FTopNum+i;
      if i = 0 then
        begin
        FSel.sRect.Top := FFilmRect.Top+1;
        FSel.sRect.Bottom := FFilmRect.Top+FSize+2;
        end else
        begin
        FSel.sRect.Top := FFilmRect.Top+(FSize*i)+(2*i)-1;
        FSel.sRect.Bottom := FFilmRect.Top+(FSize*(i+1)+(2*i)+1);
        end;
      Break;
      end;
    end;
  DrawFilm;
  Canvas.Rectangle(FSel.sRect);
  FSel.Draw := True;
  FDelSelBut.Enabled := True;
  end;
end;

end.
I will test the new code. Anyway look alike the points are your :)
I figure out a solution. Still working. But in max. next 24 hours I will accept your comment.
Into the new sample nothing happening on up&down action
Search for next 500 points :)
OK, I did some updates for the selected number and delete image, I also added the Mouse Wheel thing





unit RollFilm;

interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Buttons;

type
TSelRec = Record
  Draw: Boolean;
  SelNum: Integer;
  sRect: TRect;
  end;

TRollFilm = class(TCustomControl)
  private
  { Private declarations }
    FTopNum: Integer;
    FFilmRect: TRect;
    FUpBut, FDownBut, FDelSelBut: TSpeedButton;
    FGotFocus: Boolean;

  protected
  { Protected declarations }
    FFilmBmp: TBitmap;
    FSelectRec: TSelRec;
    FImageNum: Integer;
    procedure UpClick(Sender: TObject);
    procedure DownClick(Sender: TObject);
    procedure DelSelClick(Sender: TObject);
    procedure DrawFilm;
    procedure DrawSelect;
    procedure EnableButtons;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure Paint; override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
    function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
    procedure DoEnter; override;
    procedure DoExit; override;
    procedure CreateWnd; override;
    property Canvas;

  public
  { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure AddBitmap(Bmp: TBitmap);

  published
  { Published declarations }

end;

procedure Register;

const
FSize = 86;

implementation

procedure Register;
begin
RegisterComponents('Samples', [TRollFilm]);
end;

constructor TRollFilm.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := [csOpaque, csReplicatable];
Width := 178;
Height := 210;
FFilmBmp := TBitmap.Create;
FFilmBmp.PixelFormat := pf24Bit;
FFilmBmp.Canvas.Brush.Color := clBlack;
FFilmBmp.Height := 2;
FFilmBmp.Width := FSize;
FFilmBmp.Canvas.Font.Color := clWhite;
FFilmRect := Rect(8,8,FSize+8,(FSize*2)+14);
FTopNum := 0;
FImageNum := 0;
Canvas.Pen.Color := clHighLight;
Canvas.Pen.Width := 3;
Canvas.Brush.Color := Color;
Canvas.Brush.Style := bsClear;
FSelectRec.Draw := False;
FSelectRec.SelNum := -1;
FSelectRec.sRect := Rect(FFilmRect.Left+1,FFilmRect.Top+1,
                FFilmRect.Right-1,FFilmRect.Top+FSize+2);
FGotFocus := False;
end;

destructor TRollFilm.Destroy;
begin
if Assigned(FFilmBmp) then
FFilmBmp.Free;
inherited Destroy;
end;

procedure TRollFilm.CreateWnd;
begin
inherited;
if not Assigned(FUpBut) then
  begin
  FUpBut := TSpeedButton.Create(Self);
  with FUpBut do
    begin
    Parent := Self;
    Caption := 'Up';
    Width := 34;
    Height := 24;
    Top := 14;
    Left := FSize + 20;
    Enabled := False;
    OnClick := UpClick;
    end;
  end;

if not Assigned(FDownBut) then
  begin
  FDownBut := TSpeedButton.Create(Self);
  with FDownBut do
    begin
    Parent := Self;
    Caption := 'Down';
    Width := 34;
    Height := 24;
    Top := 150;
    Left := FSize + 20;
    Enabled := False;
    OnClick := DownClick;
    end;
  end;

if not Assigned(FDelSelBut) then
  begin
  FDelSelBut := TSpeedButton.Create(Self);
  with FDelSelBut do
    begin
    Parent := Self;
    Caption := 'Delete Sel';
    Width := 60;
    Height := 24;
    Top := 44;
    Left := FSize + 20;
    Enabled := False;
    OnClick := DelSelClick;
    end;
  end;
end;

procedure TRollFilm.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
  begin
  Style := Style and not WS_BORDER;
  ExStyle := ExStyle or WS_EX_DLGMODALFRAME;
  end;
end;

procedure TRollFilm.EnableButtons;
begin
if FImageNum > FFilmRect.Bottom div (FSize+2) then
  begin
  FUpBut.Enabled := True;
  FDownBut.Enabled := True;
  end else
  begin
  FUpBut.Enabled := False;
  FDownBut.Enabled := False;
  end;
end;

function TRollFilm.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean;
begin
inherited DoMouseWheelDown(Shift, MousePos);
Result := False;
DownClick(FDownBut);
end;

function TRollFilm.DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean;
begin
inherited DoMouseWheelDown(Shift, MousePos);
Result := False;
UpClick(FUpBut);
end;

procedure TRollFilm.WMSize(var Message: TWMSize);
var
New, More: Integer;
begin
New := Message.Height - FFilmRect.Top;
More := (New div FSize) - ((FFilmRect.Bottom-FFilmRect.Top) div FSize);
if More = 0 then Exit;
if New > FFilmRect.Bottom+ FSize then
FFilmRect.Bottom :=  FFilmRect.Bottom+ (FSize*More)+(2*More);

if New < FFilmRect.Bottom then
if New < (FSize*2)+6 then
FFilmRect.Bottom :=  FFilmRect.Top+(FSize)+4 else
FFilmRect.Bottom :=  FFilmRect.Bottom+ (FSize*More)+(2*More);
if Assigned(FUpBut) then
EnableButtons;
Paint;
inherited;
end;

procedure TRollFilm.UpClick(Sender: TObject);
begin
if FTopNum > 0 then
  begin
  Dec(FTopNum);
  DrawFilm;
  FSelectRec.sRect.Top := FSelectRec.sRect.Top+(FSize+2);
  FSelectRec.sRect.Bottom := FSelectRec.sRect.Bottom +(FSize+2);
  DrawSelect;
  end;
end;

procedure TRollFilm.DownClick(Sender: TObject);
begin
if FTopNum < FImageNum-(FFilmRect.Bottom div (FSize+2)) then
  begin
  Inc(FTopNum);
  DrawFilm;
  FSelectRec.sRect.Top := FSelectRec.sRect.Top-(FSize+2);
  FSelectRec.sRect.Bottom := FSelectRec.sRect.Bottom -(FSize+2);
  DrawSelect;
  end;
end;

procedure TRollFilm.DelSelClick(Sender: TObject);
var
TempBmp: TBitmap;
begin
if (FSelectRec.SelNum < 0) or (FSelectRec.SelNum > FImageNum -1) or (FImageNum < 1) then Exit;
if (FSelectRec.SelNum <> FImageNum -1) then
  begin
  TempBmp := TBitmap.Create;
  try
    TempBmp.Canvas.Brush.Color := clBlack;
    TempBmp.Height := (FSize+2)*(FImageNum -1-FSelectRec.SelNum);
    TempBmp.Width := FSize;
    BitBlt(TempBmp.Canvas.Handle,0, 0, FFilmBmp.Width,TempBmp.Height,
       FFilmBmp.Canvas.Handle,0,(FSelectRec.SelNum+1)*(FSize+2), SRCCOPY);
    BitBlt(FFilmBmp.Canvas.Handle,0, FSelectRec.SelNum*(FSize+2),FFilmBmp.Width,
       TempBmp.Height, TempBmp.Canvas.Handle,0,0, SRCCOPY);
    finally
    TempBmp.Free;
    end;
  end;
FFilmBmp.Height := FFilmBmp.Height - FSize - 2;
Dec(FImageNum);
FTopNum := 0;
FSelectRec.Draw := False;
FSelectRec.SelNum := -1;
FDelSelBut.Enabled := False;
InvalidateRect(Handle,nil, True);
EnableButtons;
end;

procedure TRollFilm.DrawSelect;
begin
if FSelectRec.Draw and
(FSelectRec.sRect.Top > -2) and (FSelectRec.sRect.Top < FFilmRect.Bottom - FSize) then
Canvas.Rectangle(FSelectRec.sRect);
end;

procedure TRollFilm.DrawFilm;
begin
if Assigned(FFilmBmp) and (FImageNum >0) then
  BitBlt(Canvas.Handle,FFilmRect.Left, FFilmRect.Top,FFilmBmp.Width,
       FFilmRect.Bottom-FFilmRect.Top, FFilmBmp.Canvas.Handle,0,FTopNum*(FSize+2), SRCCOPY);
end;

procedure TRollFilm.Paint;
var
Rect1: TRect;
begin
inherited;
Canvas.Brush.Color := Color;
Canvas.Brush.Style := bsSolid;
Canvas.TextOut(FFilmRect.Right+8,100,IntToStr(FImageNum)+' Images');
Canvas.Brush.Style := bsClear;
DrawFilm;
InflateRect(FFilmRect,4,4);
DrawEdge(Canvas.Handle,FFilmRect, EDGE_SUNKEN, BF_RECT);
InflateRect(FFilmRect,-4,-4);
DrawSelect;

if FGotFocus then
  begin
  SetRect(Rect1,2,2,ClientWidth -2,ClientHeight-2);
  Canvas.Pen.Mode := pmXor;
  Canvas.Rectangle(Rect1);
  Canvas.Pen.Mode := pmCopy;
  end;
end;

procedure TRollFilm.AddBitmap(Bmp: TBitmap);
var
ThumBmp: TBitmap;
DWidth, DHeight: Integer;
begin
if (not Assigned(Bmp)) or Bmp.Empty then Exit;
Inc(FImageNum);
FFilmBmp.Height := FFilmBmp.Height + FSize+2;
if (Bmp.Width = FSize) and (Bmp.Height = FSize) then
  BitBlt(FFilmBmp.Canvas.Handle,0, ((FImageNum-1) * FSize)+((FImageNum) * 2),FFilmBmp.Width,
       FSize+2, Bmp.Canvas.Handle,0,0, SRCCOPY)
else
  begin
  ThumBmp := TBitmap.Create;
  try
  ThumBmp.PixelFormat := pf24Bit;
  ThumBmp.Canvas.Brush.Color := clBlack;
  ThumBmp.Width := FSize;
  ThumBmp.Height := FSize;
  if Bmp.Width < Bmp.Height then
    begin
    DHeight := FSize;
    DWidth := Trunc(FSize / (Bmp.Height / Bmp.Width));
    end else
  if Bmp.Width > Bmp.Height then
    begin
    DWidth := FSize;
    DHeight := Trunc(FSize / (Bmp.Width / Bmp.Height));
    end  else
    begin
    DWidth := FSize;
    DHeight := FSize;
    end;
    ThumBmp.Canvas.StretchDraw(Rect((FSize div 2)-(DWidth div 2),(FSize div 2)-(DHeight div 2),
               (FSize div 2)-(DWidth div 2)+DWidth,(FSize div 2)-(DHeight div 2)+DHeight), Bmp);
    BitBlt(FFilmBmp.Canvas.Handle,0, ((FImageNum-1) * FSize)+((FImageNum) * 2),FFilmBmp.Width,
       FSize+2, ThumBmp.Canvas.Handle,0,0, SRCCOPY);
    FFilmBmp.Canvas.TextOut(67,((FImageNum-1) * FSize)+(FSize-14),IntToStr(FImageNum));
    finally
    ThumBmp.Free;
    end;
  end;

EnableButtons;
DrawFilm;
if FSelectRec.Draw then
Canvas.Rectangle(FSelectRec.sRect);
Canvas.Brush.Color := Color;
Canvas.Brush.Style := bsSolid;
Canvas.TextOut(FFilmRect.Right+8,100,IntToStr(FImageNum)+' Images');
Canvas.Brush.Style := bsClear;
end;

procedure TRollFilm.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
Pt1: TPoint;
i: Integer;
begin
SetFocus;
inherited MouseDown(Button, Shift, X, Y);
Pt1.x := X;
Pt1.y := Y;
if FImageNum = 0 then Exit;
if (Button = mbLeft) AND PtInRect(FFilmRect, Pt1) then
  begin
  FSelectRec.SelNum := -1;
  Pt1.x := 0;
  for i := 0 to 20 do
    begin
    if Y < FFilmRect.Top+(FSize*(i+1))+(2*(i+1)) then
      begin
      if FTopNum+i < FImageNum then
      FSelectRec.SelNum := FTopNum+i;
      FSelectRec.sRect.Top := FFilmRect.Top+((FSize+2)*i)+1;
      FSelectRec.sRect.Bottom := FFilmRect.Top+(FSize*(i+1)+(2*i)+3);
      Break;
      end;
    end;
  if FSelectRec.SelNum > -1 then
    begin
    DrawFilm;
    Canvas.Rectangle(FSelectRec.sRect);
    FSelectRec.Draw := True;
    FDelSelBut.Enabled := True;
    end else
    begin
    FSelectRec.Draw := False;
    DrawFilm;
    FDelSelBut.Enabled := False;
    end;
  end;
end;

procedure TRollFilm.DoEnter;
var
Rect1: TRect;
begin
SetRect(Rect1,2,2,ClientWidth -2,ClientHeight-2);
FGotFocus := True;
Canvas.Pen.Mode := pmXor;
Canvas.Rectangle(Rect1);

Canvas.Pen.Mode := pmCopy;
end;

procedure TRollFilm.DoExit;
var
Rect1: TRect;
begin
FGotFocus := False;
SetRect(Rect1,2,2,ClientWidth -2,ClientHeight-2);
Canvas.Pen.Mode := pmXor;
Canvas.Rectangle(Rect1);
Canvas.Pen.Mode := pmCopy;
end;

end.