[Webinar] Streamline your web hosting managementRegister Today

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 477
  • Last Modified:

Need help with this component

Ok I need help with the following:

1. How do I sort the diretories? eg: the folders are named CD01 CD02 etc, so I want to have CD01 in the first postion while CD108 as the last. So need to be listed in sequence.

2. The border showing the selected image must be much thicker.

Thanks, hope someone have a solution for me.
unit pathimages;
////////////////////////////////////////////////////////////////////////////////
//
//   Unit        :  TPathImages
//   Author      :  rllibby
//   Date        :  10.06.2006
//   Description :  Component that can be used for a jukebox like display of
//                  images located in the subdirectories of a given path.
//
//   ---- Overview ----
//
//   function GetCellRect(ACol, ARow: Integer): TRect;
//
//      Returns the cell rect for a given cell(col, row)
//
//   function GetIndex(ACol, ARow: Integer): Integer;
//
//      Returns the item index of the cell(col, row). If no item, then (-1) is
//      returned.
//
//   property Count: Integer;
//
//      Returns the count of path items that are loaded. Also see Paths[Index] and
//      Images[Index] property.
//
//   property Images[Index: Integer]: TJPEGImage;
//
//      Returns the jpeg image for the specified item. If no jpeg was loaded, nil
//      will be returned.
//
//   property Paths[Index: Integer]: String;
//
//      Returns the path for the specified item.
//
//   property SelIndex: Integer;
//
//      Returns the index of the selected item, or (-1) if no item is selected.
//      Also see the count property.
//
//   property Col: Integer;
//
//      Gets / sets the current column.
//
//   property ColCount: Integer;
//
//      Gets / sets the number of columns
//
//   property CellBorder: Integer;
//
//      Gets / sets the minimum cell border width between cells
//
//   property DefaultPicture: TPicture;
//
//      Gets / sets the image to use to fill in cells that have no item
//
//   property FixedColor: TColor;
//
//      Gets / sets the border color for an unselected cell
//
//   property Path: String;
//
//      Gets / sets the path to process subdirectories for
//
//   property Row: Integer;
//
//      Gets / sets the current row.
//
//   property RowCount: Integer;
//
//      Gets / sets the number of rows
//
//   property SelColor: TColor;
//
//      Gets / sets the border color for a selected cell
//
//   Event OnDrawCell;
//
//      Fired when each cell is drawn. Allows the developer to perform custom
//      drawing over a cell.
//
//   Event OnSelectCell;
//
//      Fired when either the current row or current column has changed. For
//      handling of item selection change, please see OnSelChange.
//
//   Event OnSelChange;
//
//      Fired when the selected item index (not to be confused with selected
//      cell) changes. When an empty cell is selected (SelIndex = (-1)), this event
//      will not fire again until a valid item is selected. Can be used to handle
//      custom processing when an item is selected.
//
////////////////////////////////////////////////////////////////////////////////
interface
 
////////////////////////////////////////////////////////////////////////////////
//   Include units
////////////////////////////////////////////////////////////////////////////////
uses
  Windows, Messages, SysUtils, Classes, Contnrs, Graphics, Controls, Forms,
  Dialogs, Jpeg;
 
////////////////////////////////////////////////////////////////////////////////
//   TPathImages component
////////////////////////////////////////////////////////////////////////////////
type
  TOnDrawCell       =  procedure(Sender: TObject; ACol, ARow: Integer; ARect: TRect; Selected: Boolean) of object;
  TPathImages       =  class(TCustomControl)
  private
     // Private declarations
     FPath:         String;
     FDeferPath:    String;
     FDefPicture:   TPicture;
     FOnDrawCell:   TOnDrawCell;
     FOnSelChange:  TNotifyEvent;
     FOnSelectCell: TNotifyEvent;
     FImages:       TObjectList;
     FPaths:        TStringList;
     FSelColor:     TColor;
     FFixedColor:   TColor;
     FCellBorder:   Integer;
     FRowCount:     Integer;
     FColCount:     Integer;
     FOldIndex:     Integer;
     FRow:          Integer;
     FCol:          Integer;
     FGroup:        Integer;
     function       GetGroupCount: Integer;
     procedure      SetColRow(ACol, ARow: Integer);
     function       GetColRowAtPoint(X, Y: Integer): TPoint;
     procedure      UpdateParent(lpRect: PRect = nil);
  protected
     // Protected declarations
     function       GetCount: Integer;
     function       GetImages(Index: Integer): TJPEGImage;
     function       GetPaths(Index: Integer): String;
     function       GetSelIndex: Integer;
     procedure      DoOnSelChange;
     procedure      DoOnSelectCell;
     procedure      CreateParams(var Value: TCreateParams); override;
     procedure      Loaded; override;
     procedure      Paint; override;
     procedure      PaintText(ARect: TRect; Text: String);
     procedure      PaintCell(ACol, ARow: Integer; ARect: TRect; Selected: Boolean);
     procedure      SetDefPicture(Value: TPicture);
     procedure      SetCol(Value: Integer);
     procedure      SetRow(Value: Integer);
     procedure      SetCellBorder(Value: Integer);
     procedure      SetFixedColor(Value: TColor);
     procedure      SetSelColor(Value: TColor);
     procedure      SetRowCount(Value: Integer);
     procedure      SetColCount(Value: Integer);
     procedure      SetPath(Value: String);
     procedure      WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE;
     procedure      WMEraseBkGnd(var Msg: TWMEraseBkGnd); message WM_ERASEBKGND;
     procedure      WMKeyUp(var Msg: TWMKeyDown); message WM_KEYUP;
     procedure      WMKeyDown(var Msg: TWMKeyDown); message WM_KEYDOWN;
     procedure      WMLButtonDown(var Msg: TWMLButtonDown); message WM_LBUTTONDOWN;
     procedure      WMMove(var Msg: TWMMove); message WM_MOVE;
     procedure      WMSize(var Msg: TWMSize); message WM_SIZE;
  public
     // Public declarations
     constructor    Create(AOwner: TComponent); override;
     destructor     Destroy; override;
     function       GetCellRect(ACol, ARow: Integer): TRect;
     function       GetIndex(ACol, ARow: Integer): Integer;
     property       Count: Integer read GetCount;
     property       Images[Index: Integer]: TJPEGImage read GetImages;
     property       Paths[Index: Integer]: String read GetPaths;
     property       SelIndex: Integer read GetSelIndex;
  published
     // Published declarations
     property       Col: Integer read FCol write SetCol;
     property       ColCount: Integer read FColCount write SetColCount;
     property       CellBorder: Integer read FCellBorder write SetCellBorder;
     property       DefaultPicture: TPicture read FDefPicture write SetDefPicture;
     property       FixedColor: TColor read FFixedColor write SetFixedColor;
     property       Path: String read FPath write SetPath;
     property       Row: Integer read FRow write SetRow;
     property       RowCount: Integer read FRowCount write SetRowCount;
     property       SelColor: TColor read FSelColor write SetSelColor;
     property       Align;
     property       Canvas;
     property       Font;
     property       TabOrder;
     property       TabStop;
     property       OnDrawCell: TOnDrawCell read FOnDrawCell write FOnDrawCell;
     property       OnSelectCell: TNotifyEvent read FOnSelectCell write FOnSelectCell;
     property       OnSelChange: TNotifyEvent read FOnSelChange write FOnSelChange;
     property       OnClick;
     property       OnDblClick;
     property       OnEnter;
          property       OnExit;
     property       OnKeyDown;
          property       OnKeyPress;
          property       OnKeyUp;
     property       OnMouseDown;
     property       OnMouseMove;
     property       OnMouseUp;
          property       OnMouseWheel;
          property       OnMouseWheelDown;
          property       OnMouseWheelUp;
  end;
 
////////////////////////////////////////////////////////////////////////////////
//   Utility functions
////////////////////////////////////////////////////////////////////////////////
function   Max(X1, X2: Integer): Integer;
 
////////////////////////////////////////////////////////////////////////////////
//   Component registration
////////////////////////////////////////////////////////////////////////////////
procedure  Register;
 
implementation
 
//// TPathImages ///////////////////////////////////////////////////////////////
procedure TPathImages.DoOnSelChange;
begin
 
  // Check old index against new index
  if (FOldIndex <> GetSelIndex) then
  begin
     // Update old index
     FOldIndex:=GetSelIndex;
     // Check for event
     if Assigned(FOnSelChange) then FOnSelChange(Self);
  end;
 
end;
 
procedure TPathImages.DoOnSelectCell;
begin
 
  // Check event
  if Assigned(FOnSelectCell) then FOnSelectCell(Self);
 
end;
 
procedure TPathImages.Loaded;
begin
 
  // Perform inherited
  inherited Loaded;
 
  // Check for path change
  if (Length(FDeferPath) > 0) then SetPath(FDeferPath);
 
end;
 
procedure TPathImages.SetPath(Value: String);
var  jpgImage:      TJPEGImage;
     srFind:        TSearchRec;
     srImage:       TSearchRec;
     bImage:        Boolean;
begin
 
  // Check loading state
  if (csLoading in ComponentState) then
     // Defer the path until fully loaded
     FDeferPath:=Value
  // Check for path change
  else if not(CompareText(Value, FPath) = 0) then
  begin
     // Reset the current group
     FGroup:=0;
     // Reset the row and col
     SetColRow(0, 0);
     // Update path
     if (Length(Value) > 0) then
        FPath:=IncludeTrailingBackslash(Value)
     else
        SetLength(FPath, 0);
     // Resource protection
     try
        // Lock list
        FPaths.BeginUpdate;
        // Resource protection
        try
           // Clear list
           FPaths.Clear;
           FImages.Clear;
           // Fire the selection change
           DoOnSelChange;
           // Get the sub paths
           if (Length(FPath) > 0) and (FindFirst(FPath + '*.*', faAnyFile, srFind) = 0) then
           begin
              // Resource protection
              try
                 // Iterate all sub paths
                 repeat
                    // Check for path
                    if ((srFind.Attr and faDirectory) = faDirectory) and (srFind.Name <> '.') and (srFind.Name <> '..') then
                    begin
                       // Set image flag
                       bImage:=False;
                       // Check sub path for jpeg files
                       if (FindFirst(FPath + srFind.Name + '\*.jpeg', faAnyFile, srImage) = 0) or
                          (FindFirst(FPath + srFind.Name + '\*.jpg', faAnyFile, srImage) = 0) then
                       begin
                          // Resource protection
                          try
                             // Iterate all images to find the first acceptable one
                             repeat
                                // Check for file
                                if ((srImage.Attr and faDirectory) = 0) then
                                begin
                                   // Create image
                                   jpgImage:=TJPEGImage.Create;
                                   // Resource protection
                                   try
                                      // Load from file
                                      jpgImage.LoadFromFile(FPath + srFind.Name + '\' + srImage.Name);
                                      // Add to (image) object list
                                      FImages.Add(jpgImage);
                                      // Set flag
                                      bImage:=True;
                                   except
                                      // Free the image
                                      jpgImage.Free;
                                   end;
                                   // Done processing
                                   break;
                                end;
                             until (FindNext(srImage) <> 0);
                          finally
                             // Close the find
                             FindClose(srImage);
                          end;
                       end;
                       // Add path to list
                       FPaths.Add(FPath + srFind.Name);
                       // No image available, add nil to list
                       if not(bImage) then FImages.Add(nil);
                    end
                 until (FindNext(srFind) <> 0);
              finally
                 // Close the find handle
                 FindClose(srFind);
              end;
           end;
        finally
           // Unlock list
           FPaths.EndUpdate;
        end;
     finally
        // Update the selection change
        DoOnSelChange;
     end;
     // Repaint
     UpdateParent;
  end;
 
end;
 
procedure TPathImages.SetDefPicture(Value: TPicture);
begin
 
  // Assign new picture
  FDefPicture.Assign(Value);
 
  // Repaint
  UpdateParent;
 
end;
 
function TPathImages.GetColRowAtPoint(X, Y: Integer): TPoint;
var  rcCell:        TRect;
     dwRow:         Integer;
     dwCol:         Integer;
begin
 
  // Set default, which is the current col and row
  result:=Point(FCol, FRow);
 
  // Walk the cells to peform the hit test
  for dwRow:=0 to Pred(FRowCount) do
  begin
     for dwCol:=0 to Pred(FColCount) do
     begin
        // Get rect
        rcCell:=GetCellRect(dwCol, dwRow);
        // Hit test
        if PtInRect(rcCell, Point(X, Y)) then
        begin
           // Found the cell
           result:=Point(dwCol, dwRow);
           // Done
           exit;
        end;
     end;
  end;
 
end;
 
procedure TPathImages.SetCellBorder(Value: Integer);
begin
 
  // Check new value
  if (Value < 0) then Value:=0;
 
  // Check against current value
  if (Value <> FCellBorder) then
  begin
     // Update value
     FCellBorder:=Value;
     // Repaint
     UpdateParent;
  end;
 
end;
 
procedure TPathImages.SetFixedColor(Value: TColor);
begin
 
  // Check against fixed color
  if (Value <> FFixedColor) then
  begin
     // Update the fixed color
     FFixedColor:=Value;
     // Repaint
     UpdateParent;
  end;
 
end;
 
procedure TPathImages.SetSelColor(Value: TColor);
begin
 
  // Check against selected color
  if (Value <> FSelColor) then
  begin
     // Update the sel color
     FSelColor:=Value;
     // Repaint
     UpdateParent;
  end;
 
end;
 
procedure TPathImages.SetColRow(ACol, ARow: Integer);
begin
 
  // Check for change
  if (ACol <> FCol) or (ARow <> FRow) then
  begin
     // Update values
     FCol:=ACol;
     FRow:=ARow;
     // Fire the select cell
     DoOnSelectCell;
  end;
 
  // Fire the selection change
  DoOnSelChange;
 
  // Repaint
  UpdateParent;
 
end;
 
procedure TPathImages.SetCol(Value: Integer);
begin
 
  // Range check
  if (Value < FColCount) and (Value >= 0) and (Value <> FCol) then
  begin
     // Update current col
     SetColRow(Value, FRow);
  end;
 
end;
 
procedure TPathImages.SetRow(Value: Integer);
begin
 
  // Range check
  if (Value < FRowCount) and (Value >= 0) and (Value <> FRow) then
  begin
     // Update current row
     SetColRow(FCol, Value);
  end;
 
end;
 
procedure TPathImages.SetRowCount(Value: Integer);
begin
 
  // Check min range
  if (Value < 1) then
     // Min value of one
     Value:=1
  // Check max range (keep minimum of 20 pixels for each row)
  else if (Value > (Height div 20)) then
     // Set max value
     Value:=Max((Height div 20), 1);
 
  // Check against current value
  if (Value <> FRowCount) then
  begin
     // Update the value
     FRowCount:=Value;
     // Reset the current group
     FGroup:=0;
     // Set col and row
     SetColRow(0, 0);
  end;
 
end;
 
procedure TPathImages.SetColCount(Value: Integer);
begin
 
  // Check min range
  if (Value < 1) then
     // Min value of one
     Value:=1
  // Check max range (keep minimum of 20 pixels for each col)
  else if (Value > (Width div 20)) then
     // Set max value
     Value:=Max((Width div 20), 1);
 
  // Check against current value
  if (Value <> FColCount) then
  begin
     // Update the value
     FColCount:=Value;
     // Reset the current group
     FGroup:=0;
     // Update the col and row
     SetColRow(0, 0);
  end;
 
end;
 
function TPathImages.GetImages(Index: Integer): TJPEGImage;
begin
 
  // Return the desired image
  if Assigned(FImages[Index]) then
     // Recast the result
     result:=TJPEGImage(FImages[Index])
  else
     // No image
     result:=nil;
 
end;
 
function TPathImages.GetPaths(Index: Integer): String;
begin
 
  // Return the desired path
  result:=FPaths[Index];
 
end;
 
function TPathImages.GetGroupCount: Integer;
begin
 
  // Return the set count
  result:=FColCount * FRowCount;
 
end;
 
function TPathImages.GetCount: Integer;
begin
 
  // Return count of items
  result:=FPaths.Count;
 
end;
 
function TPathImages.GetCellRect(ACol, ARow: Integer): TRect;
var  dwWidth:       Integer;
     dwHeight:      Integer;
begin
 
  // Check bounds
  if (ARow < FRowCount) and (ARow >= 0) and (ACol < FColCount) and (ACol >= 0) then
  begin
     // Calculate the cell width and height
     dwWidth:=(Width div FColCount);
     dwHeight:=(Height div FRowCount);
     // Create result rect for cell
     result:=Rect(dwWidth * ACol, dwHeight * ARow, dwWidth * Succ(ACol), dwHeight * Succ(ARow));
  end
  else
     // Return null rect
     result:=Rect(0, 0, 0, 0);
 
end;
 
function TPathImages.GetIndex(ACol, ARow: Integer): Integer;
var  dwIndex:       Integer;
begin
 
  // Get item index based on col / row
  dwIndex:=FGroup + (ACol mod FColCount) + (ARow * FColCount);
 
  // Make sure it is in range,
  if (dwIndex >= FPaths.Count) then
     // Return no item selected
     result:=(-1)
  else
     // Return index of item
     result:=dwIndex;
 
end;
 
function TPathImages.GetSelIndex: Integer;
begin
 
  // Get selected item index
  result:=GetIndex(FCol, FRow);
 
end;
 
procedure TPathImages.UpdateParent(lpRect: PRect);
var  rcControl:     TRect;
begin
 
  // Have the parent invalidate the new location of this control
  if Assigned(Parent) and IsWindow(Parent.Handle) then
  begin
     // Get control rect relative to the parents coords
     rcControl.TopLeft:=Point(Left, Top);
     // Check rect
     if Assigned(lpRect) then
     begin
        // Remove area painted from the parents update region
        Inc(rcControl.Left, lpRect^.Left);
        Inc(rcControl.Top, lpRect^.Top);
        rcControl.Right:=rcControl.Left + (lpRect^.Right - lpRect^.Left);
        rcControl.Bottom:=rcControl.Top + (lpRect^.Bottom - lpRect^.Top);
        // Validate in parent
        ValidateRect(Parent.Handle, @rcControl);
     end
     else
     begin
        // Update bounds
        rcControl.Right:=rcControl.Left + Width;
        rcControl.Bottom:=rcControl.Top + Height;
        // Invalidate control within the parent coods
        InvalidateRect(Parent.Handle, @rcControl, True);
        // Paint now
        Paint;
     end;
  end;
 
end;
 
procedure TPathImages.WMKeyUp(var Msg: TWMKeyDown);
begin
 
  // Eat special keys
  if not(Msg.CharCode in [VK_END, VK_HOME, VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN]) then
  begin
     // Inherited
     inherited;
  end;
 
end;
 
procedure TPathImages.WMGetDlgCode(var Msg: TWMGetDlgCode);
begin
 
  // Want all keys
  Msg.Result:=DLGC_WANTCHARS or DLGC_WANTARROWS;
 
end;
 
procedure TPathImages.WMKeyDown(var Msg: TWMKeyDown);
begin
 
  // Handle key processing
  case Msg.CharCode of
     // Go to last group
     VK_END   :
     begin
        // Move to last
        FGroup:=(Pred(FPaths.Count) div GetGroupCount) * GetGroupCount;
        // Set col and row
        SetColRow(0, 0);
     end;
     // Go to first group
     VK_HOME  :
     begin
        // Move first
        FGroup:=0;
        // Set col and row
        SetColRow(0, 0);
     end;
     // Either move to last group, move to previous group, or move previous
     VK_LEFT  :
     begin
        // Check current column
        if (FCol > 0) then
           // Move prev
           SetColRow(FCol -1, FRow)
        else
        begin
           // Check for another set
           if (FGroup > 0) then
              // Move to prev set
              Dec(FGroup, GetGroupCount)
           else
              // Move to last group
              FGroup:=(Pred(FPaths.Count) div GetGroupCount) * GetGroupCount;
           // Set col and row
           SetColRow(FCol, FRow);
        end;
     end;
     // Either move up, wrap around, or move to prev group
     VK_UP    :
     begin
        // Check col and row
        if (FCol = 0) and (FRow = 0) then
        begin
           // Check for another set
           if (FGroup > 0) then
              // Move to prev group
              Dec(FGroup, GetGroupCount)
           else
              // Move to last set
              FGroup:=(Pred(FPaths.Count) div GetGroupCount) * GetGroupCount;
           // Set to cell (0, 0)
           SetColRow(0, 0);
        end
        // Check row
        else if (FRow > 0) then
           // Move up one
           SetColRow(FCol, FRow - 1)
        else if (FCol > 0) then
           // Wrap around
           SetColRow(FCol - 1, Pred(FRowCount));
     end;
     // Either move to first set, move to next group, or move next
     VK_RIGHT :
     begin
        // Check current column
        if (FCol < Pred(FColCount)) then
           // Move next
           SetColRow(FCol + 1, FRow)
        else
        begin
           // Check for another set
           if ((FGroup + GetGroupCount) < FPaths.Count) then
              // Move to next group
              Inc(FGroup, GetGroupCount)
           else
              // Move to first group
              FGroup:=0;
           // Set to cell (0, 0)
           SetColRow(0, 0);
        end;
     end;
     // Either move up, wrap around, or move to next group
     VK_DOWN  :
     begin
        // Check col and row
        if (FCol = Pred(FColCount)) and (FRow = Pred(FRowCount)) then
        begin
           // Check for another group
           if ((FGroup + GetGroupCount) < FPaths.Count) then
              // Move to next group
              Inc(FGroup, GetGroupCount)
           else
              // Move to first group
              FGroup:=0;
           // Set to cell (0, 0)
           SetColRow(0, 0);
        end
        // Check row
        else if (FRow < Pred(FRowCount)) then
           // Move down one
           SetColRow(FCol, FRow + 1)
        else
           // Wrap around
           SetColRow(FCol + 1, 0);
     end;
  else
     // Perform inherited
     inherited;
  end;
 
end;
 
procedure TPathImages.WMSize(var Msg: TWMSize);
begin
 
  // Perform inherited
  inherited;
 
  // Invalidate location where control resides on parent
  UpdateParent;
 
end;
 
procedure TPathImages.WMMove(var Msg: TWMMove);
begin
 
  // Perform inherited
  inherited;
 
  // Invalidate location where control resides on parent
  UpdateParent;
 
end;
 
procedure TPathImages.WMLButtonDown(var Msg: TWMLButtonDown);
var  ptCell:        TPoint;
begin
 
  // Set focus
  SetFocus;
 
  // Check for new cell change
  ptCell:=GetColRowAtPoint(Msg.Pos.x, Msg.Pos.y);
 
  // Is this a new cell change
  if (ptCell.x <> FCol) or (ptCell.y <> FRow) then
  begin
     // Update the col and row
     SetColRow(ptCell.x, ptCell.y);
  end;
 
  // Perform inherited
  inherited;
 
end;
 
procedure TPathImages.PaintText(ARect: TRect; Text: String);
var  rcText:        TRect;
     dwOffsetX:     Integer;
     dwOffsetY:     Integer;
begin
 
  // Check text
  if (Length(Text) > 0) then
  begin
     // Create rect for text size calculation
     rcText.TopLeft:=Point(0, 0);
     rcText.Right:=(ARect.Right - ARect.Left) - 2;
     rcText.Bottom:=(ARect.Bottom - ARect.Top - 2);
     // Calculate the rect required for the multiline text
     if (DrawText(Canvas.Handle, PChar(Text), -1, rcText, DT_NOPREFIX or DT_CALCRECT or DT_CENTER or DT_WORDBREAK or DT_END_ELLIPSIS) > 0) then
     begin
        // Calculate the x and y offset
        dwOffsetX:=((ARect.Right - ARect.Left) - (rcText.Right - rcText.Left)) div 2;
        dwOffsetY:=((ARect.Bottom - ARect.Top) - (rcText.Bottom - rcText.Top)) div 2;
        // Update the text rect
        Inc(ARect.Left, dwOffsetX);
        Dec(ARect.Right, dwOffsetX);
        Inc(ARect.Top, dwOffsetY);
        Dec(ARect.Bottom, dwOffsetY);
        // Draw the text
        DrawText(Canvas.Handle, PChar(Text), -1, ARect, DT_NOPREFIX or DT_CENTER or DT_WORDBREAK or DT_END_ELLIPSIS);
     end;
  end;
 
end;
 
procedure TPathImages.PaintCell(ACol, ARow: Integer; ARect: TRect; Selected: Boolean);
var  rcCell:        TRect;
     bValidate:     Boolean;
     hbrFrame:      HBRUSH;
     dwWidth:       Integer;
     dwHeight:      Integer;
     dwOffset:      Integer;
     dwIndex:       Integer;
begin
 
  // Set default validation
  bValidate:=True;
 
  // Adjust the rect based on the cell border
  if (FCellBorder > 0) then
  begin
     Inc(ARect.Left, FCellBorder);
     Inc(ARect.Top, FCellBorder);
     Dec(ARect.Right, FCellBorder);
     Dec(ARect.Bottom, FCellBorder);
  end;
 
  // Calculate the width and height of the rect
  dwWidth:=(ARect.Right - ARect.Left);
  dwHeight:=(ARect.Bottom - ARect.Top);
 
  // Calculate a square image area in the rect
  if (dwWidth > dwHeight) then
  begin
     // Adjust left and right sides
     dwOffset:=(dwWidth - dwHeight) div 2;
     Inc(ARect.Left, dwOffset);
     Dec(ARect.Right, dwOffset);
  end
  else if (dwHeight > dwWidth) then
  begin
     // Adjust top and bottom sides
     dwOffset:=(dwHeight - dwWidth) div 2;
     Inc(ARect.Top, dwOffset);
     Dec(ARect.Bottom, dwOffset);
  end;
 
  // Get copy of rect
  rcCell:=ARect;
 
  // Get index of item
  dwIndex:=GetIndex(ACol, ARow);
 
  // Check against the item count
  if (dwIndex <> (-1)) then
  begin
     // Check list object
     if Assigned(FImages[dwIndex]) then
        // Draw the image
        Canvas.StretchDraw(rcCell, TJPEGImage(FImages[dwIndex]))
     else
     begin
        // Dont validate this rect
        bValidate:=False;
        // No image for the path, just text out the path name
        PaintText(rcCell, UpperCase(ExtractFileName(FPaths[dwIndex])));
     end;
  end
  // Check to see if the default image has been set
  else if Assigned(FDefPicture.Graphic) then
     // Draw picture
     Canvas.StretchDraw(rcCell, FDefPicture.Graphic)
  else
     // Dont validate this rect
     bValidate:=False;
 
  // Set brush color depending on selected state
  if Selected then
     hbrFrame:=CreateSolidBrush(ColorToRGB(FSelColor))
  else
     hbrFrame:=CreateSolidBrush(ColorToRGB(FFixedColor));
 
  // Resource protection
  try
     // Draw the frame rectangle
     FrameRect(Canvas.Handle, rcCell, hbrFrame);
     // Check selected again
     if Selected then
     begin
        // Adjust and draw again for emphasis
        InflateRect(rcCell, 1, 1);
        // Draw the frame rectangle
        FrameRect(Canvas.Handle, rcCell, hbrFrame);
     end;
  finally
     // Free the brush
     DeleteObject(hbrFrame);
  end;
 
  // Validate the area just painted (unless no default image or text is used)
  if bValidate then UpdateParent(@rcCell);
 
  // Allow user to peform painting
  if Assigned(FOnDrawCell) then FOnDrawCell(Self, ACol, ARow, ARect, Selected);
 
end;
 
procedure TPathImages.Paint;
var  dwRow:         Integer;
     dwCol:         Integer;
begin
 
  // Set back mode to transparent
  SetBkMode(Canvas.Handle, TRANSPARENT);
 
  // Iterate the rows
  for dwRow:=0 to Pred(FRowCount) do
  begin
     // Iterate the columns
     for dwCol:=0 to Pred(FColCount) do
     begin
        // Set canvas font (may end up modified by user event)
        Canvas.Font.Assign(Font);
        // Paint the cell
        PaintCell(dwCol, dwRow, GetCellRect(dwCol, dwRow), (FRow = dwRow) and (FCol = dwCol));
     end;
  end;
 
end;
 
procedure TPathImages.WMEraseBkGnd(var Msg: TWMEraseBkGnd);
begin
 
  // Set message result
  Msg.result:=1;
 
end;
 
procedure TPathImages.CreateParams(var Value: TCreateParams);
begin
 
  // Perform inherited
  inherited CreateParams(Value);
 
  // Set transparent flag
  Value.ExStyle:=Value.ExStyle or WS_EX_TRANSPARENT;
 
  // Make sure parent does not clip its children
  if (Value.WndParent <> 0) then
  begin
     // Make sure parent does not clip the children
     SetWindowLong(Value.WndParent, GWL_STYLE, GetWindowLong(Value.WndParent, GWL_STYLE) and not(WS_CLIPCHILDREN));
  end;
 
end;
 
constructor TPathImages.Create(AOwner: TComponent);
begin
 
  // Perform inherited
  inherited Create(AOwner);
 
  // Set double buffering for parent
  if (AOwner is TWinControl) then TWinControl(AOwner).DoubleBuffered:=True;
 
  // Set defaults
  ControlStyle:=[csCaptureMouse, csClickEvents, csDoubleClicks];
  TabStop:=True;
  SetLength(FPath, 0);
  SetLength(FDeferPath, 0);
  FDefPicture:=TPicture.Create;
  FPaths:=TStringList.Create;
  FImages:=TObjectList.Create(True);
  FSelColor:=clHighlight;
  FFixedColor:=clWindow;
  FCellBorder:=2;
  FColCount:=3;
  FRowCount:=2;
  FOldIndex:=(-1);
  FGroup:=0;
  FRow:=0;
  FCol:=0;
 
end;
 
destructor TPathImages.Destroy;
begin
 
  // Resource protection
  try
     // Free item lists
     FPaths.Free;
     FImages.Free;
     // Free default picture
     FDefPicture.Free;
  finally
     // Perform inherited
     inherited Destroy;
  end;
 
end;
 
//// Component registration ////////////////////////////////////////////////////
procedure Register;
begin
 
  // Register component
  RegisterComponents('Additional', [TPathImages]);
 
end;
 
//// Utility functions /////////////////////////////////////////////////////////
function Max(X1, X2: Integer): Integer;
begin
 
  // Return larger of the 2 values
  if (X1 > X2) then
     result:=X1
  else
     result:=X2;
 
end;
 
end.

Open in new window

0
DigitalNam
Asked:
DigitalNam
  • 8
  • 6
  • 4
  • +3
2 Solutions
 
mikelittlewoodCommented:
I'm not sure you can put a wider border on a JPEG object as it has no canvas of it's own.
You might have to have the image sat on something else to draw a better border.
0
 
2266180Commented:
(I didn't run the code, but as I look over it ...)
the component seems to use a TPicutre to display the jpeg.

all one must do is change the way setdefpicture works:

it wil not use assign, but instead, it will create a temporary bitmap (or timage with a bitmap, whichever), in which you draw the jpg at a certain coordinate, and of course, prior to that, you set the size of the picture to be the size of the jpg + twice the width of the border you want. then you assign/draw the temp picture in the defpicture and destroy the temp picture.

if you want, I can make the modifications, but not just now: in about 30-60 min to finish what I'm working on ;)
0
 
ziolkoCommented:
looks like russel's code:

unit pathimages;
////////////////////////////////////////////////////////////////////////////////
//
//   Unit        :  TPathImages
//   Author      :  rllibby

guess he's the one who can solve it quickly:)

ziolko.
0
Upgrade your Question Security!

Your question, your audience. Choose who sees your identity—and your question—with question security.

 
DigitalNamAuthor Commented:
ciuly: would really appreciate it. not in such a big rush. :-)
0
 
2266180Commented:
>> guess he's the one who can solve it quickly:)

you shouldn't have said that :D

well, first of all, sorry for miss-understanding the problem. I thought you want a bigger border around all images :)

ok, well, for your problem, the fix is very easy. just go to
procedure TPathImages.PaintCell, after the line with comment, "// Draw the frame rectangle", on line 945 and change

     if Selected then
     begin
        // Adjust and draw again for emphasis
        InflateRect(rcCell, 1, 1);
        // Draw the frame rectangle
        FrameRect(Canvas.Handle, rcCell, hbrFrame);
     end;

to

     if Selected then
     begin
       for i:=1 to BorderWidth do
       begin
        // Adjust and draw again for emphasis
        InflateRect(rcCell, 1, 1);
        // Draw the frame rectangle
        FrameRect(Canvas.Handle, rcCell, hbrFrame);
       end;
     end;

then go to line 875 and insert the following line

     i:             Integer;

then go to line 128 and insert the following line

     FBorderWidth:  Integer;

then go to line 174 and insert the following line:

     property       BorderWidth: Integer read FBorderWidth write FBorderWidth;

then in your code (or from the ide) just set the borderwidth to whatever you want (for the ide to show changes, compile the component, and reopen the project)
0
 
ziolkoCommented:
>>you shouldn't have said that :D

ok i admit i thought you were still asleep;)

ziolko.
0
 
diniludCommented:
Try like this
unit pathimages;
////////////////////////////////////////////////////////////////////////////////
//
//   Unit        :  TPathImages
//   Author      :  rllibby
//   Date        :  10.06.2006
//   Description :  Component that can be used for a jukebox like display of
//                  images located in the subdirectories of a given path.
//
//   ---- Overview ----
//
//   function GetCellRect(ACol, ARow: Integer): TRect;
//
//      Returns the cell rect for a given cell(col, row)
//
//   function GetIndex(ACol, ARow: Integer): Integer;
//
//      Returns the item index of the cell(col, row). If no item, then (-1) is
//      returned.
//
//   property Count: Integer;
//
//      Returns the count of path items that are loaded. Also see Paths[Index] and
//      Images[Index] property.
//
//   property Images[Index: Integer]: TJPEGImage;
//
//      Returns the jpeg image for the specified item. If no jpeg was loaded, nil
//      will be returned.
//
//   property Paths[Index: Integer]: String;
//
//      Returns the path for the specified item.
//
//   property SelIndex: Integer;
//
//      Returns the index of the selected item, or (-1) if no item is selected.
//      Also see the count property.
//
//   property Col: Integer;
//
//      Gets / sets the current column.
//
//   property ColCount: Integer;
//
//      Gets / sets the number of columns
//
//   property CellBorder: Integer;
//
//      Gets / sets the minimum cell border width between cells
//
//   property DefaultPicture: TPicture;
//
//      Gets / sets the image to use to fill in cells that have no item
//
//   property FixedColor: TColor;
//
//      Gets / sets the border color for an unselected cell
//
//   property Path: String;
//
//      Gets / sets the path to process subdirectories for
//
//   property Row: Integer;
//
//      Gets / sets the current row.
//
//   property RowCount: Integer;
//
//      Gets / sets the number of rows
//
//   property SelColor: TColor;
//
//      Gets / sets the border color for a selected cell
//
//   Event OnDrawCell;
//
//      Fired when each cell is drawn. Allows the developer to perform custom
//      drawing over a cell.
//
//   Event OnSelectCell;
//
//      Fired when either the current row or current column has changed. For
//      handling of item selection change, please see OnSelChange.
//
//   Event OnSelChange;
//
//      Fired when the selected item index (not to be confused with selected
//      cell) changes. When an empty cell is selected (SelIndex = (-1)), this event
//      will not fire again until a valid item is selected. Can be used to handle
//      custom processing when an item is selected.
//
////////////////////////////////////////////////////////////////////////////////
interface
 
////////////////////////////////////////////////////////////////////////////////
//   Include units
////////////////////////////////////////////////////////////////////////////////
uses
  Windows, Messages, SysUtils, Classes, Contnrs, Graphics, Controls, Forms,
  Dialogs, Jpeg;
 
////////////////////////////////////////////////////////////////////////////////
//   TPathImages component
////////////////////////////////////////////////////////////////////////////////
type
  TOnDrawCell       =  procedure(Sender: TObject; ACol, ARow: Integer; ARect: TRect; Selected: Boolean) of object;
  TPathImages       =  class(TCustomControl)
  private
     // Private declarations
     FPath:         String;
     FDeferPath:    String;
     FDefPicture:   TPicture;
     FOnDrawCell:   TOnDrawCell;
     FOnSelChange:  TNotifyEvent;
     FOnSelectCell: TNotifyEvent;
     FImages:       TObjectList;
     FPaths:        TStringList;
     FSelColor:     TColor;
     FFixedColor:   TColor;
     FCellBorder:   Integer;
     FRowCount:     Integer;
     FColCount:     Integer;
     FOldIndex:     Integer;
     FRow:          Integer;
     FCol:          Integer;
     FGroup:        Integer;
     function       GetGroupCount: Integer;
     procedure      SetColRow(ACol, ARow: Integer);
     function       GetColRowAtPoint(X, Y: Integer): TPoint;
     procedure      UpdateParent(lpRect: PRect = nil);
  protected
     // Protected declarations
     function       GetCount: Integer;
     function       GetImages(Index: Integer): TJPEGImage;
     function       GetPaths(Index: Integer): String;
     function       GetSelIndex: Integer;
     procedure      DoOnSelChange;
     procedure      DoOnSelectCell;
     procedure      CreateParams(var Value: TCreateParams); override;
     procedure      Loaded; override;
     procedure      Paint; override;
     procedure      PaintText(ARect: TRect; Text: String);
     procedure      PaintCell(ACol, ARow: Integer; ARect: TRect; Selected: Boolean);
     procedure      SetDefPicture(Value: TPicture);
     procedure      SetCol(Value: Integer);
     procedure      SetRow(Value: Integer);
     procedure      SetCellBorder(Value: Integer);
     procedure      SetFixedColor(Value: TColor);
     procedure      SetSelColor(Value: TColor);
     procedure      SetRowCount(Value: Integer);
     procedure      SetColCount(Value: Integer);
     procedure      SetPath(Value: String);
     procedure      WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE;
     procedure      WMEraseBkGnd(var Msg: TWMEraseBkGnd); message WM_ERASEBKGND;
     procedure      WMKeyUp(var Msg: TWMKeyDown); message WM_KEYUP;
     procedure      WMKeyDown(var Msg: TWMKeyDown); message WM_KEYDOWN;
     procedure      WMLButtonDown(var Msg: TWMLButtonDown); message WM_LBUTTONDOWN;
     procedure      WMMove(var Msg: TWMMove); message WM_MOVE;
     procedure      WMSize(var Msg: TWMSize); message WM_SIZE;
  public
     // Public declarations
     constructor    Create(AOwner: TComponent); override;
     destructor     Destroy; override;
     function       GetCellRect(ACol, ARow: Integer): TRect;
     function       GetIndex(ACol, ARow: Integer): Integer;
     property       Count: Integer read GetCount;
     property       Images[Index: Integer]: TJPEGImage read GetImages;
     property       Paths[Index: Integer]: String read GetPaths;
     property       SelIndex: Integer read GetSelIndex;
  published
     // Published declarations
     property       Col: Integer read FCol write SetCol;
     property       ColCount: Integer read FColCount write SetColCount;
     property       CellBorder: Integer read FCellBorder write SetCellBorder;
     property       DefaultPicture: TPicture read FDefPicture write SetDefPicture;
     property       FixedColor: TColor read FFixedColor write SetFixedColor;
     property       Path: String read FPath write SetPath;
     property       Row: Integer read FRow write SetRow;
     property       RowCount: Integer read FRowCount write SetRowCount;
     property       SelColor: TColor read FSelColor write SetSelColor;
     property       Align;
     property       Canvas;
     property       Font;
     property       TabOrder;
     property       TabStop;
     property       OnDrawCell: TOnDrawCell read FOnDrawCell write FOnDrawCell;
     property       OnSelectCell: TNotifyEvent read FOnSelectCell write FOnSelectCell;
     property       OnSelChange: TNotifyEvent read FOnSelChange write FOnSelChange;
     property       OnClick;
     property       OnDblClick;
     property       OnEnter;
          property       OnExit;
     property       OnKeyDown;
          property       OnKeyPress;
          property       OnKeyUp;
     property       OnMouseDown;
     property       OnMouseMove;
     property       OnMouseUp;
          property       OnMouseWheel;
          property       OnMouseWheelDown;
          property       OnMouseWheelUp;
  end;
 
////////////////////////////////////////////////////////////////////////////////
//   Utility functions
////////////////////////////////////////////////////////////////////////////////
function   Max(X1, X2: Integer): Integer;
 
 
 
function StrCmpLogicalW(psz1, psz2: PWideChar): Integer; Stdcall;
 
////////////////////////////////////////////////////////////////////////////////
//   Component registration
////////////////////////////////////////////////////////////////////////////////
procedure  Register;
 
implementation
 
//// TPathImages ///////////////////////////////////////////////////////////////
procedure TPathImages.DoOnSelChange;
begin
 
  // Check old index against new index
  if (FOldIndex <> GetSelIndex) then
  begin
     // Update old index
     FOldIndex:=GetSelIndex;
     // Check for event
     if Assigned(FOnSelChange) then FOnSelChange(Self);
  end;
 
end;
 
procedure TPathImages.DoOnSelectCell;
begin
 
  // Check event
  if Assigned(FOnSelectCell) then FOnSelectCell(Self);
 
end;
 
procedure TPathImages.Loaded;
begin
 
  // Perform inherited
  inherited Loaded;
 
  // Check for path change
  if (Length(FDeferPath) > 0) then SetPath(FDeferPath);
 
end;
 
 
function StrCmpLogicalW; external 'shlwapi.dll' name 'StrCmpLogicalW';
 
function _SortW(List: TStrings; Index1, Index2: Integer): Integer;
begin
  result := StrCmpLogicalW( PWideChar(WideString(List[Index1])),
                            PWideChar(WideString(List[Index2])) );
end;
 
 
 
procedure TPathImages.SetPath(Value: String);
var  jpgImage:      TJPEGImage;
     srFind:        TSearchRec;
     srImage:       TSearchRec;
     bImage:        Boolean;
begin
 
  // Check loading state
  if (csLoading in ComponentState) then
     // Defer the path until fully loaded
     FDeferPath:=Value
  // Check for path change
  else if not(CompareText(Value, FPath) = 0) then
  begin
     // Reset the current group
     FGroup:=0;
     // Reset the row and col
     SetColRow(0, 0);
     // Update path
     if (Length(Value) > 0) then
        FPath:=IncludeTrailingBackslash(Value)
     else
        SetLength(FPath, 0);
     // Resource protection
     try
        // Lock list
        FPaths.BeginUpdate;
        // Resource protection
        try
           // Clear list
           FPaths.Clear;
           FImages.Clear;
           // Fire the selection change
           DoOnSelChange;
           // Get the sub paths
           if (Length(FPath) > 0) and (FindFirst(FPath + '*.*', faAnyFile, srFind) = 0) then
           begin
              // Resource protection
              try
                 // Iterate all sub paths
                 repeat
                    // Check for path
                    if ((srFind.Attr and faDirectory) = faDirectory) and (srFind.Name <> '.') and (srFind.Name <> '..') then
                    begin
                       // Set image flag
                       bImage:=False;
                       // Check sub path for jpeg files
                       if (FindFirst(FPath + srFind.Name + '\*.jpeg', faAnyFile, srImage) = 0) or
                          (FindFirst(FPath + srFind.Name + '\*.jpg', faAnyFile, srImage) = 0) then
                       begin
                          // Resource protection
                          try
                             // Iterate all images to find the first acceptable one
                             repeat
                                // Check for file
                                if ((srImage.Attr and faDirectory) = 0) then
                                begin
                                   // Create image
                                   jpgImage:=TJPEGImage.Create;
                                   // Resource protection
                                   try
                                      // Load from file
                                      jpgImage.LoadFromFile(FPath + srFind.Name + '\' + srImage.Name);
                                      // Add to (image) object list
                                      FImages.Add(jpgImage);
                                      // Set flag
                                      bImage:=True;
                                   except
                                      // Free the image
                                      jpgImage.Free;
                                   end;
                                   // Done processing
                                   break;
                                end;
                             until (FindNext(srImage) <> 0);
                          finally
                             // Close the find
                             FindClose(srImage);
                          end;
                       end;
                       // Add path to list
                       FPaths.Add(FPath + srFind.Name);
                       // No image available, add nil to list
                       if not(bImage) then FImages.Add(nil);
                    end
                 until (FindNext(srFind) <> 0);
              finally
                 // Close the find handle
                 FindClose(srFind);
              end;
           end;
        finally
           //sort
           FPaths.CustomSort(@_SortW);
 
           // Unlock list
           FPaths.EndUpdate;
        end;
     finally
        // Update the selection change
        DoOnSelChange;
     end;
     // Repaint
     UpdateParent;
  end;
 
end;
 
procedure TPathImages.SetDefPicture(Value: TPicture);
begin
 
  // Assign new picture
  FDefPicture.Assign(Value);
 
  // Repaint
  UpdateParent;
 
end;
 
function TPathImages.GetColRowAtPoint(X, Y: Integer): TPoint;
var  rcCell:        TRect;
     dwRow:         Integer;
     dwCol:         Integer;
begin
 
  // Set default, which is the current col and row
  result:=Point(FCol, FRow);
 
  // Walk the cells to peform the hit test
  for dwRow:=0 to Pred(FRowCount) do
  begin
     for dwCol:=0 to Pred(FColCount) do
     begin
        // Get rect
        rcCell:=GetCellRect(dwCol, dwRow);
        // Hit test
        if PtInRect(rcCell, Point(X, Y)) then
        begin
           // Found the cell
           result:=Point(dwCol, dwRow);
           // Done
           exit;
        end;
     end;
  end;
 
end;
 
procedure TPathImages.SetCellBorder(Value: Integer);
begin
 
  // Check new value
  if (Value < 0) then Value:=0;
 
  // Check against current value
  if (Value <> FCellBorder) then
  begin
     // Update value
     FCellBorder:=Value;
     // Repaint
     UpdateParent;
  end;
 
end;
 
procedure TPathImages.SetFixedColor(Value: TColor);
begin
 
  // Check against fixed color
  if (Value <> FFixedColor) then
  begin
     // Update the fixed color
     FFixedColor:=Value;
     // Repaint
     UpdateParent;
  end;
 
end;
 
procedure TPathImages.SetSelColor(Value: TColor);
begin
 
  // Check against selected color
  if (Value <> FSelColor) then
  begin
     // Update the sel color
     FSelColor:=Value;
     // Repaint
     UpdateParent;
  end;
 
end;
 
procedure TPathImages.SetColRow(ACol, ARow: Integer);
begin
 
  // Check for change
  if (ACol <> FCol) or (ARow <> FRow) then
  begin
     // Update values
     FCol:=ACol;
     FRow:=ARow;
     // Fire the select cell
     DoOnSelectCell;
  end;
 
  // Fire the selection change
  DoOnSelChange;
 
  // Repaint
  UpdateParent;
 
end;
 
procedure TPathImages.SetCol(Value: Integer);
begin
 
  // Range check
  if (Value < FColCount) and (Value >= 0) and (Value <> FCol) then
  begin
     // Update current col
     SetColRow(Value, FRow);
  end;
 
end;
 
procedure TPathImages.SetRow(Value: Integer);
begin
 
  // Range check
  if (Value < FRowCount) and (Value >= 0) and (Value <> FRow) then
  begin
     // Update current row
     SetColRow(FCol, Value);
  end;
 
end;
 
procedure TPathImages.SetRowCount(Value: Integer);
begin
 
  // Check min range
  if (Value < 1) then
     // Min value of one
     Value:=1
  // Check max range (keep minimum of 20 pixels for each row)
  else if (Value > (Height div 20)) then
     // Set max value
     Value:=Max((Height div 20), 1);
 
  // Check against current value
  if (Value <> FRowCount) then
  begin
     // Update the value
     FRowCount:=Value;
     // Reset the current group
     FGroup:=0;
     // Set col and row
     SetColRow(0, 0);
  end;
 
end;
 
procedure TPathImages.SetColCount(Value: Integer);
begin
 
  // Check min range
  if (Value < 1) then
     // Min value of one
     Value:=1
  // Check max range (keep minimum of 20 pixels for each col)
  else if (Value > (Width div 20)) then
     // Set max value
     Value:=Max((Width div 20), 1);
 
  // Check against current value
  if (Value <> FColCount) then
  begin
     // Update the value
     FColCount:=Value;
     // Reset the current group
     FGroup:=0;
     // Update the col and row
     SetColRow(0, 0);
  end;
 
end;
 
function TPathImages.GetImages(Index: Integer): TJPEGImage;
begin
 
  // Return the desired image
  if Assigned(FImages[Index]) then
     // Recast the result
     result:=TJPEGImage(FImages[Index])
  else
     // No image
     result:=nil;
 
end;
 
function TPathImages.GetPaths(Index: Integer): String;
begin
 
  // Return the desired path
  result:=FPaths[Index];
 
end;
 
function TPathImages.GetGroupCount: Integer;
begin
 
  // Return the set count
  result:=FColCount * FRowCount;
 
end;
 
function TPathImages.GetCount: Integer;
begin
 
  // Return count of items
  result:=FPaths.Count;
 
end;
 
function TPathImages.GetCellRect(ACol, ARow: Integer): TRect;
var  dwWidth:       Integer;
     dwHeight:      Integer;
begin
 
  // Check bounds
  if (ARow < FRowCount) and (ARow >= 0) and (ACol < FColCount) and (ACol >= 0) then
  begin
     // Calculate the cell width and height
     dwWidth:=(Width div FColCount);
     dwHeight:=(Height div FRowCount);
     // Create result rect for cell
     result:=Rect(dwWidth * ACol, dwHeight * ARow, dwWidth * Succ(ACol), dwHeight * Succ(ARow));
  end
  else
     // Return null rect
     result:=Rect(0, 0, 0, 0);
 
end;
 
function TPathImages.GetIndex(ACol, ARow: Integer): Integer;
var  dwIndex:       Integer;
begin
 
  // Get item index based on col / row
  dwIndex:=FGroup + (ACol mod FColCount) + (ARow * FColCount);
 
  // Make sure it is in range,
  if (dwIndex >= FPaths.Count) then
     // Return no item selected
     result:=(-1)
  else
     // Return index of item
     result:=dwIndex;
 
end;
 
function TPathImages.GetSelIndex: Integer;
begin
 
  // Get selected item index
  result:=GetIndex(FCol, FRow);
 
end;
 
procedure TPathImages.UpdateParent(lpRect: PRect);
var  rcControl:     TRect;
begin
 
  // Have the parent invalidate the new location of this control
  if Assigned(Parent) and IsWindow(Parent.Handle) then
  begin
     // Get control rect relative to the parents coords
     rcControl.TopLeft:=Point(Left, Top);
     // Check rect
     if Assigned(lpRect) then
     begin
        // Remove area painted from the parents update region
        Inc(rcControl.Left, lpRect^.Left);
        Inc(rcControl.Top, lpRect^.Top);
        rcControl.Right:=rcControl.Left + (lpRect^.Right - lpRect^.Left);
        rcControl.Bottom:=rcControl.Top + (lpRect^.Bottom - lpRect^.Top);
        // Validate in parent
        ValidateRect(Parent.Handle, @rcControl);
     end
     else
     begin
        // Update bounds
        rcControl.Right:=rcControl.Left + Width;
        rcControl.Bottom:=rcControl.Top + Height;
        // Invalidate control within the parent coods
        InvalidateRect(Parent.Handle, @rcControl, True);
        // Paint now
        Paint;
     end;
  end;
 
end;
 
procedure TPathImages.WMKeyUp(var Msg: TWMKeyDown);
begin
 
  // Eat special keys
  if not(Msg.CharCode in [VK_END, VK_HOME, VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN]) then
  begin
     // Inherited
     inherited;
  end;
 
end;
 
procedure TPathImages.WMGetDlgCode(var Msg: TWMGetDlgCode);
begin
 
  // Want all keys
  Msg.Result:=DLGC_WANTCHARS or DLGC_WANTARROWS;
 
end;
 
procedure TPathImages.WMKeyDown(var Msg: TWMKeyDown);
begin
 
  // Handle key processing
  case Msg.CharCode of
     // Go to last group
     VK_END   :
     begin
        // Move to last
        FGroup:=(Pred(FPaths.Count) div GetGroupCount) * GetGroupCount;
        // Set col and row
        SetColRow(0, 0);
     end;
     // Go to first group
     VK_HOME  :
     begin
        // Move first
        FGroup:=0;
        // Set col and row
        SetColRow(0, 0);
     end;
     // Either move to last group, move to previous group, or move previous
     VK_LEFT  :
     begin
        // Check current column
        if (FCol > 0) then
           // Move prev
           SetColRow(FCol -1, FRow)
        else
        begin
           // Check for another set
           if (FGroup > 0) then
              // Move to prev set
              Dec(FGroup, GetGroupCount)
           else
              // Move to last group
              FGroup:=(Pred(FPaths.Count) div GetGroupCount) * GetGroupCount;
           // Set col and row
           SetColRow(FCol, FRow);
        end;
     end;
     // Either move up, wrap around, or move to prev group
     VK_UP    :
     begin
        // Check col and row
        if (FCol = 0) and (FRow = 0) then
        begin
           // Check for another set
           if (FGroup > 0) then
              // Move to prev group
              Dec(FGroup, GetGroupCount)
           else
              // Move to last set
              FGroup:=(Pred(FPaths.Count) div GetGroupCount) * GetGroupCount;
           // Set to cell (0, 0)
           SetColRow(0, 0);
        end
        // Check row
        else if (FRow > 0) then
           // Move up one
           SetColRow(FCol, FRow - 1)
        else if (FCol > 0) then
           // Wrap around
           SetColRow(FCol - 1, Pred(FRowCount));
     end;
     // Either move to first set, move to next group, or move next
     VK_RIGHT :
     begin
        // Check current column
        if (FCol < Pred(FColCount)) then
           // Move next
           SetColRow(FCol + 1, FRow)
        else
        begin
           // Check for another set
           if ((FGroup + GetGroupCount) < FPaths.Count) then
              // Move to next group
              Inc(FGroup, GetGroupCount)
           else
              // Move to first group
              FGroup:=0;
           // Set to cell (0, 0)
           SetColRow(0, 0);
        end;
     end;
     // Either move up, wrap around, or move to next group
     VK_DOWN  :
     begin
        // Check col and row
        if (FCol = Pred(FColCount)) and (FRow = Pred(FRowCount)) then
        begin
           // Check for another group
           if ((FGroup + GetGroupCount) < FPaths.Count) then
              // Move to next group
              Inc(FGroup, GetGroupCount)
           else
              // Move to first group
              FGroup:=0;
           // Set to cell (0, 0)
           SetColRow(0, 0);
        end
        // Check row
        else if (FRow < Pred(FRowCount)) then
           // Move down one
           SetColRow(FCol, FRow + 1)
        else
           // Wrap around
           SetColRow(FCol + 1, 0);
     end;
  else
     // Perform inherited
     inherited;
  end;
 
end;
 
procedure TPathImages.WMSize(var Msg: TWMSize);
begin
 
  // Perform inherited
  inherited;
 
  // Invalidate location where control resides on parent
  UpdateParent;
 
end;
 
procedure TPathImages.WMMove(var Msg: TWMMove);
begin
 
  // Perform inherited
  inherited;
 
  // Invalidate location where control resides on parent
  UpdateParent;
 
end;
 
procedure TPathImages.WMLButtonDown(var Msg: TWMLButtonDown);
var  ptCell:        TPoint;
begin
 
  // Set focus
  SetFocus;
 
  // Check for new cell change
  ptCell:=GetColRowAtPoint(Msg.Pos.x, Msg.Pos.y);
 
  // Is this a new cell change
  if (ptCell.x <> FCol) or (ptCell.y <> FRow) then
  begin
     // Update the col and row
     SetColRow(ptCell.x, ptCell.y);
  end;
 
  // Perform inherited
  inherited;
 
end;
 
procedure TPathImages.PaintText(ARect: TRect; Text: String);
var  rcText:        TRect;
     dwOffsetX:     Integer;
     dwOffsetY:     Integer;
begin
 
  // Check text
  if (Length(Text) > 0) then
  begin
     // Create rect for text size calculation
     rcText.TopLeft:=Point(0, 0);
     rcText.Right:=(ARect.Right - ARect.Left) - 2;
     rcText.Bottom:=(ARect.Bottom - ARect.Top - 2);
     // Calculate the rect required for the multiline text
     if (DrawText(Canvas.Handle, PChar(Text), -1, rcText, DT_NOPREFIX or DT_CALCRECT or DT_CENTER or DT_WORDBREAK or DT_END_ELLIPSIS) > 0) then
     begin
        // Calculate the x and y offset
        dwOffsetX:=((ARect.Right - ARect.Left) - (rcText.Right - rcText.Left)) div 2;
        dwOffsetY:=((ARect.Bottom - ARect.Top) - (rcText.Bottom - rcText.Top)) div 2;
        // Update the text rect
        Inc(ARect.Left, dwOffsetX);
        Dec(ARect.Right, dwOffsetX);
        Inc(ARect.Top, dwOffsetY);
        Dec(ARect.Bottom, dwOffsetY);
        // Draw the text
        DrawText(Canvas.Handle, PChar(Text), -1, ARect, DT_NOPREFIX or DT_CENTER or DT_WORDBREAK or DT_END_ELLIPSIS);
     end;
  end;
 
end;
 
procedure TPathImages.PaintCell(ACol, ARow: Integer; ARect: TRect; Selected: Boolean);
var  rcCell:        TRect;
     bValidate:     Boolean;
     hbrFrame:      HBRUSH;
     dwWidth:       Integer;
     dwHeight:      Integer;
     dwOffset:      Integer;
     dwIndex:       Integer;
begin
 
  // Set default validation
  bValidate:=True;
 
  // Adjust the rect based on the cell border
  if (FCellBorder > 0) then
  begin
     Inc(ARect.Left, FCellBorder);
     Inc(ARect.Top, FCellBorder);
     Dec(ARect.Right, FCellBorder);
     Dec(ARect.Bottom, FCellBorder);
  end;
 
  // Calculate the width and height of the rect
  dwWidth:=(ARect.Right - ARect.Left);
  dwHeight:=(ARect.Bottom - ARect.Top);
 
  // Calculate a square image area in the rect
  if (dwWidth > dwHeight) then
  begin
     // Adjust left and right sides
     dwOffset:=(dwWidth - dwHeight) div 2;
     Inc(ARect.Left, dwOffset);
     Dec(ARect.Right, dwOffset);
  end
  else if (dwHeight > dwWidth) then
  begin
     // Adjust top and bottom sides
     dwOffset:=(dwHeight - dwWidth) div 2;
     Inc(ARect.Top, dwOffset);
     Dec(ARect.Bottom, dwOffset);
  end;
 
  // Get copy of rect
  rcCell:=ARect;
 
  // Get index of item
  dwIndex:=GetIndex(ACol, ARow);
 
  // Check against the item count
  if (dwIndex <> (-1)) then
  begin
     // Check list object
     if Assigned(FImages[dwIndex]) then
        // Draw the image
        Canvas.StretchDraw(rcCell, TJPEGImage(FImages[dwIndex]))
     else
     begin
        // Dont validate this rect
        bValidate:=False;
        // No image for the path, just text out the path name
        PaintText(rcCell, UpperCase(ExtractFileName(FPaths[dwIndex])));
     end;
  end
  // Check to see if the default image has been set
  else if Assigned(FDefPicture.Graphic) then
     // Draw picture
     Canvas.StretchDraw(rcCell, FDefPicture.Graphic)
  else
     // Dont validate this rect
     bValidate:=False;
 
  // Set brush color depending on selected state
  if Selected then
     hbrFrame:=CreateSolidBrush(ColorToRGB(FSelColor))
  else
     hbrFrame:=CreateSolidBrush(ColorToRGB(FFixedColor));
 
  // Resource protection
  try
     // Draw the frame rectangle
     FrameRect(Canvas.Handle, rcCell, hbrFrame);
     // Check selected again
     if Selected then
     begin
        // Adjust and draw again for emphasis
        InflateRect(rcCell, 1, 1);
        // Draw the frame rectangle
        FrameRect(Canvas.Handle, rcCell, hbrFrame);
     end;
  finally
     // Free the brush
     DeleteObject(hbrFrame);
  end;
 
  // Validate the area just painted (unless no default image or text is used)
  if bValidate then UpdateParent(@rcCell);
 
  // Allow user to peform painting
  if Assigned(FOnDrawCell) then FOnDrawCell(Self, ACol, ARow, ARect, Selected);
 
end;
 
procedure TPathImages.Paint;
var  dwRow:         Integer;
     dwCol:         Integer;
begin
 
  // Set back mode to transparent
  SetBkMode(Canvas.Handle, TRANSPARENT);
 
  // Iterate the rows
  for dwRow:=0 to Pred(FRowCount) do
  begin
     // Iterate the columns
     for dwCol:=0 to Pred(FColCount) do
     begin
        // Set canvas font (may end up modified by user event)
        Canvas.Font.Assign(Font);
        // Paint the cell
        PaintCell(dwCol, dwRow, GetCellRect(dwCol, dwRow), (FRow = dwRow) and (FCol = dwCol));
     end;
  end;
 
end;
 
procedure TPathImages.WMEraseBkGnd(var Msg: TWMEraseBkGnd);
begin
 
  // Set message result
  Msg.result:=1;
 
end;
 
procedure TPathImages.CreateParams(var Value: TCreateParams);
begin
 
  // Perform inherited
  inherited CreateParams(Value);
 
  // Set transparent flag
  Value.ExStyle:=Value.ExStyle or WS_EX_TRANSPARENT;
 
  // Make sure parent does not clip its children
  if (Value.WndParent <> 0) then
  begin
     // Make sure parent does not clip the children
     SetWindowLong(Value.WndParent, GWL_STYLE, GetWindowLong(Value.WndParent, GWL_STYLE) and not(WS_CLIPCHILDREN));
  end;
 
end;
 
constructor TPathImages.Create(AOwner: TComponent);
begin
 
  // Perform inherited
  inherited Create(AOwner);
 
  // Set double buffering for parent
  if (AOwner is TWinControl) then TWinControl(AOwner).DoubleBuffered:=True;
 
  // Set defaults
  ControlStyle:=[csCaptureMouse, csClickEvents, csDoubleClicks];
  TabStop:=True;
  SetLength(FPath, 0);
  SetLength(FDeferPath, 0);
  FDefPicture:=TPicture.Create;
  FPaths:=TStringList.Create;
  FImages:=TObjectList.Create(True);
  FSelColor:=clHighlight;
  FFixedColor:=clWindow;
  FCellBorder:=2;
  FColCount:=3;
  FRowCount:=2;
  FOldIndex:=(-1);
  FGroup:=0;
  FRow:=0;
  FCol:=0;
 
end;
 
destructor TPathImages.Destroy;
begin
 
  // Resource protection
  try
     // Free item lists
     FPaths.Free;
     FImages.Free;
     // Free default picture
     FDefPicture.Free;
  finally
     // Perform inherited
     inherited Destroy;
  end;
 
end;
 
//// Component registration ////////////////////////////////////////////////////
procedure Register;
begin
 
  // Register component
  RegisterComponents('Additional', [TPathImages]);
 
end;
 
//// Utility functions /////////////////////////////////////////////////////////
function Max(X1, X2: Integer): Integer;
begin
 
  // Return larger of the 2 values
  if (X1 > X2) then
     result:=X1
  else
     result:=X2;
 
end;
 
 
 
 
end.

Open in new window

0
 
DigitalNamAuthor Commented:
Dinilud: i have installed your sample but cannot see any changes.

ciuly: will test your solution in a few minutes.
0
 
Russell LibbySoftware Engineer, Advisory Commented:
Let me know if you guys have any problems with the source, otherwise I will stay out of this one  ;-)

Russell
0
 
DigitalNamAuthor Commented:
rlibby: welcome... you are more than welcome to participate :-)
0
 
diniludCommented:
i am getting the folder list of this order
   
CD01 CD02 ,..,CD108
0
 
Russell LibbySoftware Engineer, Advisory Commented:
Just for clarification:

>> 1. How do I sort the diretories? eg: the folders are named CD01 CD02 etc, so I want to have CD01 in the first postion while CD108 as the last. So need to be listed in sequence. <<

Are you looking at sorting the directories by name or by creation date? If by name, are the names standardized as CDXXX, or do you have CD01..CD09, then CD010, etc?

Russell
0
 
Russell LibbySoftware Engineer, Advisory Commented:
Btw, its not enough to just sort the paths.... you also need to take into account the object list that contains the corresponding images. Below is source that allows for selected border width setting (using SelWidth) as well as logical sorting of the paths (keeping the images in sync).

Side note: to better differentiate the selected / non-selected cells, you might consider using a darker color for the FixedColor property, and then use a lighter color for the SelColor property as well as 2-6 pixel setting for the SelWidth.

Regards,
Russell


unit PathImages;
////////////////////////////////////////////////////////////////////////////////
//
//   Unit        :  TPathImages
//   Author      :  rllibby
//   Date        :  10.06.2006
//   Description :  Component that can be used for a jukebox like display of
//                  images located in the subdirectories of a given path.
//
//   ---- Overview ----
//
//   function GetCellRect(ACol, ARow: Integer): TRect;
//
//      Returns the cell rect for a given cell(col, row)
//
//   function GetIndex(ACol, ARow: Integer): Integer;
//
//      Returns the item index of the cell(col, row). If no item, then (-1) is
//      returned.
//
//   property Count: Integer;
//
//      Returns the count of path items that are loaded. Also see Paths[Index] and
//      Images[Index] property.
//
//   property Images[Index: Integer]: TJPEGImage;
//
//      Returns the jpeg image for the specified item. If no jpeg was loaded, nil
//      will be returned.
//
//   property Paths[Index: Integer]: String;
//
//      Returns the path for the specified item.
//
//   property SelIndex: Integer;
//
//      Returns the index of the selected item, or (-1) if no item is selected.
//      Also see the count property.
//
//   property Col: Integer;
//
//      Gets / sets the current column.
//
//   property ColCount: Integer;
//
//      Gets / sets the number of columns
//
//   property CellBorder: Integer;
//
//      Gets / sets the minimum cell border width between cells
//
//   property DefaultPicture: TPicture;
//
//      Gets / sets the image to use to fill in cells that have no item
//
//   property FixedColor: TColor;
//
//      Gets / sets the border color for an unselected cell
//
//   property Path: String;
//
//      Gets / sets the path to process subdirectories for
//
//   property Row: Integer;
//
//      Gets / sets the current row.
//
//   property RowCount: Integer;
//
//      Gets / sets the number of rows
//
//   property SelColor: TColor;
//
//      Gets / sets the border color for a selected cell
//
//   property SelWidth: Integer;
//
//      Gets / sets the selected row border width
//
//   Event OnDrawCell;
//
//      Fired when each cell is drawn. Allows the developer to perform custom
//      drawing over a cell.
//
//   Event OnSelectCell;
//
//      Fired when either the current row or current column has changed. For
//      handling of item selection change, please see OnSelChange.
//
//   Event OnSelChange;
//
//      Fired when the selected item index (not to be confused with selected
//      cell) changes. When an empty cell is selected (SelIndex = (-1)), this event
//      will not fire again until a valid item is selected. Can be used to handle
//      custom processing when an item is selected.
//
////////////////////////////////////////////////////////////////////////////////
interface
 
////////////////////////////////////////////////////////////////////////////////
//   Include units
////////////////////////////////////////////////////////////////////////////////
uses
  Windows, Messages, SysUtils, Classes, Contnrs, Graphics, Controls, Forms,
  Dialogs, Jpeg;
 
////////////////////////////////////////////////////////////////////////////////
//   TPathImages component
////////////////////////////////////////////////////////////////////////////////
type
  TOnDrawCell       =  procedure(Sender: TObject; ACol, ARow: Integer; ARect: TRect; Selected: Boolean) of object;
  TPathImages       =  class(TCustomControl)
  private
     // Private declarations
     FPath:         String;
     FDeferPath:    String;
     FDefPicture:   TPicture;
     FOnDrawCell:   TOnDrawCell;
     FOnSelChange:  TNotifyEvent;
     FOnSelectCell: TNotifyEvent;
     FImages:       TObjectList;
     FPaths:        TStringList;
     FSelColor:     TColor;
     FFixedColor:   TColor;
     FSelWidth:     Integer;
     FCellBorder:   Integer;
     FRowCount:     Integer;
     FColCount:     Integer;
     FOldIndex:     Integer;
     FRow:          Integer;
     FCol:          Integer;
     FGroup:        Integer;
     function       GetColRowAtPoint(X, Y: Integer): TPoint;
     function       GetGroupCount: Integer;
     procedure      SetColRow(ACol, ARow: Integer);
     procedure      SortPaths;
     procedure      UpdateParent(lpRect: PRect = nil);
  protected
     // Protected declarations
     function       GetCount: Integer;
     function       GetImages(Index: Integer): TJPEGImage;
     function       GetPaths(Index: Integer): String;
     function       GetSelIndex: Integer;
     procedure      DoOnSelChange;
     procedure      DoOnSelectCell;
     procedure      CreateParams(var Value: TCreateParams); override;
     procedure      Loaded; override;
     procedure      Paint; override;
     procedure      PaintText(ARect: TRect; Text: String);
     procedure      PaintCell(ACol, ARow: Integer; ARect: TRect; Selected: Boolean);
     procedure      SetDefPicture(Value: TPicture);
     procedure      SetCol(Value: Integer);
     procedure      SetRow(Value: Integer);
     procedure      SetCellBorder(Value: Integer);
     procedure      SetFixedColor(Value: TColor);
     procedure      SetSelColor(Value: TColor);
     procedure      SetRowCount(Value: Integer);
     procedure      SetColCount(Value: Integer);
     procedure      SetSelWidth(Value: Integer);
     procedure      SetPath(Value: String);
     procedure      WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE;
     procedure      WMEraseBkGnd(var Msg: TWMEraseBkGnd); message WM_ERASEBKGND;
     procedure      WMKeyUp(var Msg: TWMKeyDown); message WM_KEYUP;
     procedure      WMKeyDown(var Msg: TWMKeyDown); message WM_KEYDOWN;
     procedure      WMLButtonDown(var Msg: TWMLButtonDown); message WM_LBUTTONDOWN;
     procedure      WMMove(var Msg: TWMMove); message WM_MOVE;
     procedure      WMSize(var Msg: TWMSize); message WM_SIZE;
  public
     // Public declarations
     constructor    Create(AOwner: TComponent); override;
     destructor     Destroy; override;
     function       GetCellRect(ACol, ARow: Integer): TRect;
     function       GetIndex(ACol, ARow: Integer): Integer;
     property       Count: Integer read GetCount;
     property       Images[Index: Integer]: TJPEGImage read GetImages;
     property       Paths[Index: Integer]: String read GetPaths;
     property       SelIndex: Integer read GetSelIndex;
  published
     // Published declarations
     property       Col: Integer read FCol write SetCol;
     property       ColCount: Integer read FColCount write SetColCount;
     property       CellBorder: Integer read FCellBorder write SetCellBorder;
     property       DefaultPicture: TPicture read FDefPicture write SetDefPicture;
     property       FixedColor: TColor read FFixedColor write SetFixedColor;
     property       Path: String read FPath write SetPath;
     property       Row: Integer read FRow write SetRow;
     property       RowCount: Integer read FRowCount write SetRowCount;
     property       SelColor: TColor read FSelColor write SetSelColor;
     property       SelWidth: Integer read FSelWidth write SetSelWidth;
     property       Align;
     property       Canvas;
     property       Font;
     property       TabOrder;
     property       TabStop;
     property       OnDrawCell: TOnDrawCell read FOnDrawCell write FOnDrawCell;
     property       OnSelectCell: TNotifyEvent read FOnSelectCell write FOnSelectCell;
     property       OnSelChange: TNotifyEvent read FOnSelChange write FOnSelChange;
     property       OnClick;
     property       OnDblClick;
     property       OnEnter;
     property       OnExit;
     property       OnKeyDown;
     property       OnKeyPress;
     property       OnKeyUp;
     property       OnMouseDown;
     property       OnMouseMove;
     property       OnMouseUp;
     property       OnMouseWheel;
     property       OnMouseWheelDown;
     property       OnMouseWheelUp;
  end;

////////////////////////////////////////////////////////////////////////////////
//   Imported functions
////////////////////////////////////////////////////////////////////////////////
function   StrCmpLogical(psz1, psz2: PWideChar): Integer; stdcall; external 'shlwapi.dll' name 'StrCmpLogicalW';

////////////////////////////////////////////////////////////////////////////////
//   Utility functions
////////////////////////////////////////////////////////////////////////////////
function   PathCompare(List: TStringList; Index1, Index2: Integer): Integer;
function   Max(X1, X2: Integer): Integer;
 
////////////////////////////////////////////////////////////////////////////////
//   Component registration
////////////////////////////////////////////////////////////////////////////////
procedure  Register;
 
implementation
 
//// TPathImages ///////////////////////////////////////////////////////////////
procedure TPathImages.DoOnSelChange;
begin
 
  // Check old index against new index
  if (FOldIndex <> GetSelIndex) then
  begin
     // Update old index
     FOldIndex:=GetSelIndex;
     // Check for event
     if Assigned(FOnSelChange) then FOnSelChange(Self);
  end;
 
end;
 
procedure TPathImages.DoOnSelectCell;
begin
 
  // Check event
  if Assigned(FOnSelectCell) then FOnSelectCell(Self);
 
end;
 
procedure TPathImages.Loaded;
begin
 
  // Perform inherited
  inherited Loaded;
 
  // Check for path change
  if (Length(FDeferPath) > 0) then SetPath(FDeferPath);

end;

procedure TPathImages.SortPaths;
var  dwIndex:       Integer;
begin

  // Sort the path list
  FPaths.CustomSort(PathCompare);

  // Now add the images to the image list
  for dwIndex:=0 to Pred(FPaths.Count) do
  begin
     // Add image to list
     FImages.Add(FPaths.Objects[dwIndex]);
  end;

end;

procedure TPathImages.SetPath(Value: String);
var  jpgImage:      TJPEGImage;
     srFind:        TSearchRec;
     srImage:       TSearchRec;
     bImage:        Boolean;
begin
 
  // Check loading state
  if (csLoading in ComponentState) then
     // Defer the path until fully loaded
     FDeferPath:=Value
  // Check for path change
  else if not(CompareText(Value, FPath) = 0) then
  begin
     // Reset the current group
     FGroup:=0;
     // Reset the row and col
     SetColRow(0, 0);
     // Update path
     if (Length(Value) > 0) then
        // Include backslash
        FPath:=IncludeTrailingBackslash(Value)
     else
        // Clear path
        SetLength(FPath, 0);
     // Resource protection
     try
        // Lock list
        FPaths.BeginUpdate;
        // Resource protection
        try
           // Clear list
           FPaths.Clear;
           FImages.Clear;
           // Fire the selection change
           DoOnSelChange;
           // Get the sub paths
           if (Length(FPath) > 0) and (FindFirst(FPath + '*.*', faAnyFile, srFind) = 0) then
           begin
              // Resource protection
              try
                 // Iterate all sub paths
                 repeat
                    // Check for path
                    if ((srFind.Attr and faDirectory) = faDirectory) and (srFind.Name <> '.') and (srFind.Name <> '..') then
                    begin
                       // Set image flag
                       bImage:=False;
                       // Check sub path for jpeg files
                       if (FindFirst(FPath + srFind.Name + '\*.jpeg', faAnyFile, srImage) = 0) or
                          (FindFirst(FPath + srFind.Name + '\*.jpg', faAnyFile, srImage) = 0) then
                       begin
                          // Resource protection
                          try
                             // Iterate all images to find the first acceptable one
                             repeat
                                // Check for file
                                if ((srImage.Attr and faDirectory) = 0) then
                                begin
                                   // Create image
                                   jpgImage:=TJPEGImage.Create;
                                   // Resource protection
                                   try
                                      // Load from file
                                      jpgImage.LoadFromFile(FPath + srFind.Name + '\' + srImage.Name);
                                      // Add path and image to string list
                                      bImage:=(FPaths.AddObject(FPath + srFind.Name, jpgImage) > 0);
                                   except
                                      // Free the image
                                      jpgImage.Free;
                                   end;
                                   // Done processing
                                   break;
                                end;
                             // Find next
                             until (FindNext(srImage) <> 0);
                          finally
                             // Close the find
                             FindClose(srImage);
                          end;
                       end;
                       // No image available, add nil to list
                       if not(bImage) then FPaths.AddObject(FPath + srFind.Name, nil);
                    end
                 until (FindNext(srFind) <> 0);
              finally
                 // Close the find handle
                 FindClose(srFind);
              end;
           end;
        finally
           // Unlock list
           FPaths.EndUpdate;
        end;
        // Sort paths and fill in the image list
        SortPaths;
     finally
        // Update the selection change
        DoOnSelChange;
     end;
     // Repaint
     UpdateParent;
  end;
 
end;
 
procedure TPathImages.SetDefPicture(Value: TPicture);
begin
 
  // Assign new picture
  FDefPicture.Assign(Value);
 
  // Repaint
  UpdateParent;
 
end;
 
function TPathImages.GetColRowAtPoint(X, Y: Integer): TPoint;
var  rcCell:        TRect;
     dwRow:         Integer;
     dwCol:         Integer;
begin
 
  // Set default, which is the current col and row
  result:=Point(FCol, FRow);
 
  // Walk the cells to peform the hit test
  for dwRow:=0 to Pred(FRowCount) do
  begin
     for dwCol:=0 to Pred(FColCount) do
     begin
        // Get rect
        rcCell:=GetCellRect(dwCol, dwRow);
        // Hit test
        if PtInRect(rcCell, Point(X, Y)) then
        begin
           // Found the cell
           result:=Point(dwCol, dwRow);
           // Done
           exit;
        end;
     end;
  end;
 
end;

procedure TPathImages.SetSelWidth(Value: Integer);
begin

  // Check new value
  if (Value < 0) then Value:=0;

  // Check against current value
  if (Value <> FSelWidth) then
  begin
     // Update value
     FSelWidth:=Value;
     // Repaint
     UpdateParent;
  end;

end;

procedure TPathImages.SetCellBorder(Value: Integer);
begin

  // Check new value
  if (Value < 0) then Value:=0;

  // Check against current value
  if (Value <> FCellBorder) then
  begin
     // Update value
     FCellBorder:=Value;
     // Repaint
     UpdateParent;
  end;

end;
 
procedure TPathImages.SetFixedColor(Value: TColor);
begin
 
  // Check against fixed color
  if (Value <> FFixedColor) then
  begin
     // Update the fixed color
     FFixedColor:=Value;
     // Repaint
     UpdateParent;
  end;
 
end;
 
procedure TPathImages.SetSelColor(Value: TColor);
begin
 
  // Check against selected color
  if (Value <> FSelColor) then
  begin
     // Update the sel color
     FSelColor:=Value;
     // Repaint
     UpdateParent;
  end;
 
end;
 
procedure TPathImages.SetColRow(ACol, ARow: Integer);
begin
 
  // Check for change
  if (ACol <> FCol) or (ARow <> FRow) then
  begin
     // Update values
     FCol:=ACol;
     FRow:=ARow;
     // Fire the select cell
     DoOnSelectCell;
  end;
 
  // Fire the selection change
  DoOnSelChange;
 
  // Repaint
  UpdateParent;
 
end;
 
procedure TPathImages.SetCol(Value: Integer);
begin
 
  // Range check
  if (Value < FColCount) and (Value >= 0) and (Value <> FCol) then
  begin
     // Update current col
     SetColRow(Value, FRow);
  end;
 
end;
 
procedure TPathImages.SetRow(Value: Integer);
begin
 
  // Range check
  if (Value < FRowCount) and (Value >= 0) and (Value <> FRow) then
  begin
     // Update current row
     SetColRow(FCol, Value);
  end;
 
end;
 
procedure TPathImages.SetRowCount(Value: Integer);
begin
 
  // Check min range
  if (Value < 1) then
     // Min value of one
     Value:=1
  // Check max range (keep minimum of 20 pixels for each row)
  else if (Value > (Height div 20)) then
     // Set max value
     Value:=Max((Height div 20), 1);
 
  // Check against current value
  if (Value <> FRowCount) then
  begin
     // Update the value
     FRowCount:=Value;
     // Reset the current group
     FGroup:=0;
     // Set col and row
     SetColRow(0, 0);
  end;
 
end;
 
procedure TPathImages.SetColCount(Value: Integer);
begin
 
  // Check min range
  if (Value < 1) then
     // Min value of one
     Value:=1
  // Check max range (keep minimum of 20 pixels for each col)
  else if (Value > (Width div 20)) then
     // Set max value
     Value:=Max((Width div 20), 1);
 
  // Check against current value
  if (Value <> FColCount) then
  begin
     // Update the value
     FColCount:=Value;
     // Reset the current group
     FGroup:=0;
     // Update the col and row
     SetColRow(0, 0);
  end;
 
end;
 
function TPathImages.GetImages(Index: Integer): TJPEGImage;
begin
 
  // Return the desired image
  if Assigned(FImages[Index]) then
     // Recast the result
     result:=TJPEGImage(FImages[Index])
  else
     // No image
     result:=nil;
 
end;
 
function TPathImages.GetPaths(Index: Integer): String;
begin
 
  // Return the desired path
  result:=FPaths[Index];
 
end;
 
function TPathImages.GetGroupCount: Integer;
begin
 
  // Return the set count
  result:=FColCount * FRowCount;
 
end;
 
function TPathImages.GetCount: Integer;
begin
 
  // Return count of items
  result:=FPaths.Count;
 
end;
 
function TPathImages.GetCellRect(ACol, ARow: Integer): TRect;
var  dwWidth:       Integer;
     dwHeight:      Integer;
begin
 
  // Check bounds
  if (ARow < FRowCount) and (ARow >= 0) and (ACol < FColCount) and (ACol >= 0) then
  begin
     // Calculate the cell width and height
     dwWidth:=(Width div FColCount);
     dwHeight:=(Height div FRowCount);
     // Create result rect for cell
     result:=Rect(dwWidth * ACol, dwHeight * ARow, dwWidth * Succ(ACol), dwHeight * Succ(ARow));
  end
  else
     // Return null rect
     result:=Rect(0, 0, 0, 0);
 
end;
 
function TPathImages.GetIndex(ACol, ARow: Integer): Integer;
var  dwIndex:       Integer;
begin
 
  // Get item index based on col / row
  dwIndex:=FGroup + (ACol mod FColCount) + (ARow * FColCount);
 
  // Make sure it is in range,
  if (dwIndex >= FPaths.Count) then
     // Return no item selected
     result:=(-1)
  else
     // Return index of item
     result:=dwIndex;
 
end;
 
function TPathImages.GetSelIndex: Integer;
begin
 
  // Get selected item index
  result:=GetIndex(FCol, FRow);
 
end;
 
procedure TPathImages.UpdateParent(lpRect: PRect);
var  rcControl:     TRect;
begin
 
  // Have the parent invalidate the new location of this control
  if Assigned(Parent) and IsWindow(Parent.Handle) then
  begin
     // Get control rect relative to the parents coords
     rcControl.TopLeft:=Point(Left, Top);
     // Check rect
     if Assigned(lpRect) then
     begin
        // Remove area painted from the parents update region
        Inc(rcControl.Left, lpRect^.Left);
        Inc(rcControl.Top, lpRect^.Top);
        rcControl.Right:=rcControl.Left + (lpRect^.Right - lpRect^.Left);
        rcControl.Bottom:=rcControl.Top + (lpRect^.Bottom - lpRect^.Top);
        // Validate in parent
        ValidateRect(Parent.Handle, @rcControl);
     end
     else
     begin
        // Update bounds
        rcControl.Right:=rcControl.Left + Width;
        rcControl.Bottom:=rcControl.Top + Height;
        // Invalidate control within the parent coods
        InvalidateRect(Parent.Handle, @rcControl, True);
        // Paint now
        Paint;
     end;
  end;
 
end;
 
procedure TPathImages.WMKeyUp(var Msg: TWMKeyDown);
begin
 
  // Eat special keys
  if not(Msg.CharCode in [VK_END, VK_HOME, VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN]) then
  begin
     // Inherited
     inherited;
  end;
 
end;
 
procedure TPathImages.WMGetDlgCode(var Msg: TWMGetDlgCode);
begin
 
  // Want all keys
  Msg.Result:=DLGC_WANTCHARS or DLGC_WANTARROWS;
 
end;
 
procedure TPathImages.WMKeyDown(var Msg: TWMKeyDown);
begin
 
  // Handle key processing
  case Msg.CharCode of
     // Go to last group
     VK_END   :
     begin
        // Move to last
        FGroup:=(Pred(FPaths.Count) div GetGroupCount) * GetGroupCount;
        // Set col and row
        SetColRow(0, 0);
     end;
     // Go to first group
     VK_HOME  :
     begin
        // Move first
        FGroup:=0;
        // Set col and row
        SetColRow(0, 0);
     end;
     // Either move to last group, move to previous group, or move previous
     VK_LEFT  :
     begin
        // Check current column
        if (FCol > 0) then
           // Move prev
           SetColRow(FCol -1, FRow)
        else
        begin
           // Check for another set
           if (FGroup > 0) then
              // Move to prev set
              Dec(FGroup, GetGroupCount)
           else
              // Move to last group
              FGroup:=(Pred(FPaths.Count) div GetGroupCount) * GetGroupCount;
           // Set col and row
           SetColRow(FCol, FRow);
        end;
     end;
     // Either move up, wrap around, or move to prev group
     VK_UP    :
     begin
        // Check col and row
        if (FCol = 0) and (FRow = 0) then
        begin
           // Check for another set
           if (FGroup > 0) then
              // Move to prev group
              Dec(FGroup, GetGroupCount)
           else
              // Move to last set
              FGroup:=(Pred(FPaths.Count) div GetGroupCount) * GetGroupCount;
           // Set to cell (0, 0)
           SetColRow(0, 0);
        end
        // Check row
        else if (FRow > 0) then
           // Move up one
           SetColRow(FCol, FRow - 1)
        else if (FCol > 0) then
           // Wrap around
           SetColRow(FCol - 1, Pred(FRowCount));
     end;
     // Either move to first set, move to next group, or move next
     VK_RIGHT :
     begin
        // Check current column
        if (FCol < Pred(FColCount)) then
           // Move next
           SetColRow(FCol + 1, FRow)
        else
        begin
           // Check for another set
           if ((FGroup + GetGroupCount) < FPaths.Count) then
              // Move to next group
              Inc(FGroup, GetGroupCount)
           else
              // Move to first group
              FGroup:=0;
           // Set to cell (0, 0)
           SetColRow(0, 0);
        end;
     end;
     // Either move up, wrap around, or move to next group
     VK_DOWN  :
     begin
        // Check col and row
        if (FCol = Pred(FColCount)) and (FRow = Pred(FRowCount)) then
        begin
           // Check for another group
           if ((FGroup + GetGroupCount) < FPaths.Count) then
              // Move to next group
              Inc(FGroup, GetGroupCount)
           else
              // Move to first group
              FGroup:=0;
           // Set to cell (0, 0)
           SetColRow(0, 0);
        end
        // Check row
        else if (FRow < Pred(FRowCount)) then
           // Move down one
           SetColRow(FCol, FRow + 1)
        else
           // Wrap around
           SetColRow(FCol + 1, 0);
     end;
  else
     // Perform inherited
     inherited;
  end;
 
end;
 
procedure TPathImages.WMSize(var Msg: TWMSize);
begin
 
  // Perform inherited
  inherited;
 
  // Invalidate location where control resides on parent
  UpdateParent;
 
end;
 
procedure TPathImages.WMMove(var Msg: TWMMove);
begin
 
  // Perform inherited
  inherited;
 
  // Invalidate location where control resides on parent
  UpdateParent;
 
end;
 
procedure TPathImages.WMLButtonDown(var Msg: TWMLButtonDown);
var  ptCell:        TPoint;
begin
 
  // Set focus
  SetFocus;
 
  // Check for new cell change
  ptCell:=GetColRowAtPoint(Msg.Pos.x, Msg.Pos.y);
 
  // Is this a new cell change
  if (ptCell.x <> FCol) or (ptCell.y <> FRow) then
  begin
     // Update the col and row
     SetColRow(ptCell.x, ptCell.y);
  end;
 
  // Perform inherited
  inherited;
 
end;
 
procedure TPathImages.PaintText(ARect: TRect; Text: String);
var  rcText:        TRect;
     dwOffsetX:     Integer;
     dwOffsetY:     Integer;
begin
 
  // Check text
  if (Length(Text) > 0) then
  begin
     // Create rect for text size calculation
     rcText.TopLeft:=Point(0, 0);
     rcText.Right:=(ARect.Right - ARect.Left) - 2;
     rcText.Bottom:=(ARect.Bottom - ARect.Top - 2);
     // Calculate the rect required for the multiline text
     if (DrawText(Canvas.Handle, PChar(Text), -1, rcText, DT_NOPREFIX or DT_CALCRECT or DT_CENTER or DT_WORDBREAK or DT_END_ELLIPSIS) > 0) then
     begin
        // Calculate the x and y offset
        dwOffsetX:=((ARect.Right - ARect.Left) - (rcText.Right - rcText.Left)) div 2;
        dwOffsetY:=((ARect.Bottom - ARect.Top) - (rcText.Bottom - rcText.Top)) div 2;
        // Update the text rect
        Inc(ARect.Left, dwOffsetX);
        Dec(ARect.Right, dwOffsetX);
        Inc(ARect.Top, dwOffsetY);
        Dec(ARect.Bottom, dwOffsetY);
        // Draw the text
        DrawText(Canvas.Handle, PChar(Text), -1, ARect, DT_NOPREFIX or DT_CENTER or DT_WORDBREAK or DT_END_ELLIPSIS);
     end;
  end;
 
end;
 
procedure TPathImages.PaintCell(ACol, ARow: Integer; ARect: TRect; Selected: Boolean);
var  rcCell:        TRect;
     bValidate:     Boolean;
     hbrFrame:      HBRUSH;
     dwWidth:       Integer;
     dwHeight:      Integer;
     dwOffset:      Integer;
     dwIndex:       Integer;
begin
 
  // Set default validation
  bValidate:=True;
 
  // Adjust the rect based on the cell border
  if (FCellBorder > 0) then
  begin
     Inc(ARect.Left, FCellBorder);
     Inc(ARect.Top, FCellBorder);
     Dec(ARect.Right, FCellBorder);
     Dec(ARect.Bottom, FCellBorder);
  end;
 
  // Calculate the width and height of the rect
  dwWidth:=(ARect.Right - ARect.Left);
  dwHeight:=(ARect.Bottom - ARect.Top);
 
  // Calculate a square image area in the rect
  if (dwWidth > dwHeight) then
  begin
     // Adjust left and right sides
     dwOffset:=(dwWidth - dwHeight) div 2;
     Inc(ARect.Left, dwOffset);
     Dec(ARect.Right, dwOffset);
  end
  else if (dwHeight > dwWidth) then
  begin
     // Adjust top and bottom sides
     dwOffset:=(dwHeight - dwWidth) div 2;
     Inc(ARect.Top, dwOffset);
     Dec(ARect.Bottom, dwOffset);
  end;
 
  // Get copy of rect
  rcCell:=ARect;
 
  // Get index of item
  dwIndex:=GetIndex(ACol, ARow);
 
  // Check against the item count
  if (dwIndex <> (-1)) then
  begin
     // Check list object
     if Assigned(FImages[dwIndex]) then
        // Draw the image
        Canvas.StretchDraw(rcCell, TJPEGImage(FImages[dwIndex]))
     else
     begin
        // Dont validate this rect
        bValidate:=False;
        // No image for the path, just text out the path name
        PaintText(rcCell, UpperCase(ExtractFileName(FPaths[dwIndex])));
     end;
  end
  // Check to see if the default image has been set
  else if Assigned(FDefPicture.Graphic) then
     // Draw picture
     Canvas.StretchDraw(rcCell, FDefPicture.Graphic)
  else
     // Dont validate this rect
     bValidate:=False;
 
  // Set brush color depending on selected state
  if Selected then
     // Selected
     hbrFrame:=CreateSolidBrush(ColorToRGB(FSelColor))
  else
     // Default
     hbrFrame:=CreateSolidBrush(ColorToRGB(FFixedColor));

  // Resource protection
  try
     // Draw the frame rectangle
     FrameRect(Canvas.Handle, rcCell, hbrFrame);
     // Check selected again
     if Selected then
     begin
        // One frame line has been drawn, draw the remainder
        for dwIndex:=1 to Pred(FSelWidth) do
        begin
           // Adjust and draw again for emphasis
           InflateRect(rcCell, 1, 1);
           // Draw the frame rectangle
           FrameRect(Canvas.Handle, rcCell, hbrFrame);
        end;
     end;
  finally
     // Free the brush
     DeleteObject(hbrFrame);
  end;
 
  // Validate the area just painted (unless no default image or text is used)
  if bValidate then UpdateParent(@rcCell);
 
  // Allow user to peform painting
  if Assigned(FOnDrawCell) then FOnDrawCell(Self, ACol, ARow, ARect, Selected);
 
end;
 
procedure TPathImages.Paint;
var  dwRow:         Integer;
     dwCol:         Integer;
begin
 
  // Set back mode to transparent
  SetBkMode(Canvas.Handle, TRANSPARENT);
 
  // Iterate the rows
  for dwRow:=0 to Pred(FRowCount) do
  begin
     // Iterate the columns
     for dwCol:=0 to Pred(FColCount) do
     begin
        // Set canvas font (may end up modified by user event)
        Canvas.Font.Assign(Font);
        // Paint the cell
        PaintCell(dwCol, dwRow, GetCellRect(dwCol, dwRow), (FRow = dwRow) and (FCol = dwCol));
     end;
  end;
 
end;
 
procedure TPathImages.WMEraseBkGnd(var Msg: TWMEraseBkGnd);
begin
 
  // Set message result
  Msg.result:=1;
 
end;
 
procedure TPathImages.CreateParams(var Value: TCreateParams);
begin
 
  // Perform inherited
  inherited CreateParams(Value);
 
  // Set transparent flag
  Value.ExStyle:=Value.ExStyle or WS_EX_TRANSPARENT;
 
  // Make sure parent does not clip its children
  if (Value.WndParent <> 0) then
  begin
     // Make sure parent does not clip the children
     SetWindowLong(Value.WndParent, GWL_STYLE, GetWindowLong(Value.WndParent, GWL_STYLE) and not(WS_CLIPCHILDREN));
  end;
 
end;
 
constructor TPathImages.Create(AOwner: TComponent);
begin
 
  // Perform inherited
  inherited Create(AOwner);
 
  // Set double buffering for parent
  if (AOwner is TWinControl) then TWinControl(AOwner).DoubleBuffered:=True;
 
  // Set defaults
  ControlStyle:=[csCaptureMouse, csClickEvents, csDoubleClicks];
  TabStop:=True;
  SetLength(FPath, 0);
  SetLength(FDeferPath, 0);
  FDefPicture:=TPicture.Create;
  FPaths:=TStringList.Create;
  FImages:=TObjectList.Create(True);
  FSelColor:=clHighlight;
  FFixedColor:=clWindow;
  FCellBorder:=2;
  FSelWidth:=2;
  FColCount:=3;
  FRowCount:=2;
  FOldIndex:=(-1);
  FGroup:=0;
  FRow:=0;
  FCol:=0;
 
end;
 
destructor TPathImages.Destroy;
begin
 
  // Resource protection
  try
     // Free item lists
     FPaths.Free;
     FImages.Free;
     // Free default picture
     FDefPicture.Free;
  finally
     // Perform inherited
     inherited Destroy;
  end;
 
end;
 
//// Component registration ////////////////////////////////////////////////////
procedure Register;
begin
 
  // Register component
  RegisterComponents('Additional', [TPathImages]);
 
end;
 
//// Utility functions /////////////////////////////////////////////////////////
function PathCompare(List: TStringList; Index1, Index2: Integer): Integer;
begin

  // Perform logical compare on paths
  result:=StrCmpLogical(PWideChar(WideString(List[Index1])), PWideChar(WideString(List[Index2])));

end;

function Max(X1, X2: Integer): Integer;
begin
 
  // Return larger of the 2 values
  if (X1 > X2) then
     result:=X1
  else
     result:=X2;
 
end;
 
end.
0
 
DigitalNamAuthor Commented:
Hi rlibby,

I installed the new component but I get an error Property SelWidth does not exist. Do I need to change anything?
0
 
diniludCommented:
change

property       SelWidth: Integer read FSelWidth write SetSelWidth  default 100;
0
 
Russell LibbySoftware Engineer, Advisory Commented:
I did not run into this problem after installing the new version. You can try the suggested "default xxx" as mentioned by dinilud (you might want to use something more reasonable, like 4).  Reinstall component and check again. If this does not work, we need to know the following:

- Does you application load in the IDE?
- Does the component get removed once the app is loaded in the IDE?
- If not, does the object inspector display the SelWidth property?

If it all loads up, and the new property is available, then this may be a one time warning.

Let us know how it goes.
Russell

0
 
DigitalNamAuthor Commented:
rlibby and dini,

I have tried dini's option but still the same. What is strange is when I start a new project with the new component it compile and runs 100%, but as soon as I open my project and use the new component it comes up with the error. removed and reinstalled the new version numerous times, same problem.

When I F9 in IDE, it compiles without errors just before running the app the error comes up.

The SelWidth property is in the object inspector.
0
 
Russell LibbySoftware Engineer, Advisory Commented:
My suggestion...

- Install old version of component
- Open your project, remove the component. Keep track of what properties and event handlers were assigned.
- Close project, save changes
- Install new vesion of component
- Open your project again, and this time drop in the new version of component. Set props and event handlers.

Russell
0
 
2266180Commented:
I would just edit the dfm :) it's faster and less painfull
0
 
DigitalNamAuthor Commented:
OK guys, sorted it out. I just loaded and older project and replaced the component and made some changes.

rlibby: everything seems fine except that the first picture is blank. all the rest is fine and in sequence it seems, but the first picture is missing.

Almost ready to award points. Just wished I could allocate more points because you guys really helped me out big time.
0
 
Russell LibbySoftware Engineer, Advisory Commented:
My bad on that....

Update the following line:

>> bImage:=(FPaths.AddObject(FPath + srFind.Name, jpgImage) > 0);

in procedure TPathImages.SetPath(Value: String);

to

>> bImage:=(FPaths.AddObject(FPath + srFind.Name, jpgImage) >= 0);


0
 
DigitalNamAuthor Commented:
Thank you very much again. Experts Exchange is the best thing I am spending money on. :-)
0
 
DigitalNamAuthor Commented:
Thanks to all who commented....
0
 
2266180Commented:
what was wrong with my answer? you said will test it but never came back with an update...
never mind now, but pay more attention next time.
0

Featured Post

Get expert help—faster!

Need expert help—fast? Use the Help Bell for personalized assistance getting answers to your important questions.

  • 8
  • 6
  • 4
  • +3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now