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.
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.
(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 ;)
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 ;)
looks like russel's code:
unit pathimages;
//////////////////////////
//
// Unit : TPathImages
// Author : rllibby
guess he's the one who can solve it quickly:)
ziolko.
unit pathimages;
//////////////////////////
//
// Unit : TPathImages
// Author : rllibby
guess he's the one who can solve it quickly:)
ziolko.
ASKER
ciuly: would really appreciate it. not in such a big rush. :-)
>> 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)
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)
>>you shouldn't have said that :D
ok i admit i thought you were still asleep;)
ziolko.
ok i admit i thought you were still asleep;)
ziolko.
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Dinilud: i have installed your sample but cannot see any changes.
ciuly: will test your solution in a few minutes.
ciuly: will test your solution in a few minutes.
Let me know if you guys have any problems with the source, otherwise I will stay out of this one ;-)
Russell
Russell
ASKER
rlibby: welcome... you are more than welcome to participate :-)
i am getting the folder list of this order
CD01 CD02 ,..,CD108
CD01 CD02 ,..,CD108
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
>> 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
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Hi rlibby,
I installed the new component but I get an error Property SelWidth does not exist. Do I need to change anything?
I installed the new component but I get an error Property SelWidth does not exist. Do I need to change anything?
change
property SelWidth: Integer read FSelWidth write SetSelWidth default 100;
property SelWidth: Integer read FSelWidth write SetSelWidth default 100;
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
- 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
ASKER
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.
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.
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
- 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
I would just edit the dfm :) it's faster and less painfull
ASKER
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.
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.
My bad on that....
Update the following line:
>> bImage:=(FPaths.AddObject(
in procedure TPathImages.SetPath(Value:
to
>> bImage:=(FPaths.AddObject(
Update the following line:
>> bImage:=(FPaths.AddObject(
in procedure TPathImages.SetPath(Value:
to
>> bImage:=(FPaths.AddObject(
ASKER
Thank you very much again. Experts Exchange is the best thing I am spending money on. :-)
ASKER
Thanks to all who commented....
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.
never mind now, but pay more attention next time.
You might have to have the image sat on something else to draw a better border.