(************************************************************************
*    This File is Part of the AHM Triton Tools                          *
*    for Borland Delphi and C++ Builder.                                *
*************************************************************************
* Copyright © 1995-1999 Alexander H. Mehlhorn (AHM) and Tritontools.com *
* All Rights reserved.                                                  *
*                                                                       *
*    For more Information contact us at                                 *
*    E-Mail : support@tritontools.com                                   *
*    URL : http://www.tritontools.com                                   *
*                                                                       *
*    AHM is copyright by Alexander H. Mehlhorn                          *
*    All Parts of this Collection were developed,                       *
*    designed and implemented by AHM                                    *
*                                                                       *
*    Under no Circumstances may you distribute this file                *
*    in this or any other format. This File is supplied                 *
*    as Evaluation of Source only. No Delphi Components may be developed*
*    using extracts or subsets of this code without expressed permission*
*    by AHM.                                                            *
*                                                                       *
*************************************************************************)
unit AHMTFileLabel;

interface

uses
  SysUtils, Windows, Controls,Dialogs,AHMStdClass,
   Classes, Graphics, Menus,StdCtrls;

type
  TAHMFileLabel = class(TCustomLabel)
  private
    FAboutStr : TAHMAboutSControlStr;
    FBitmap: TBitmap;
    FFilename: String;
    FSeparator: Char;
    FParts: TStringList;
    FFirstPartIsDrive: Boolean;
    procedure SetFilename(AFilename: String);
    procedure SetSeparator(ASeparator: Char);
    procedure FillParts;
    procedure AdjustCaption;
  protected
    procedure Paint; override;
    procedure Notification(AComponent: TComponent;Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    property WordWrap default false;
    property AutoSize default False;
  published
    property About : TAHMAboutSControlStr read FAboutStr write FAboutStr;
    {$IFDEF AHMONLY4}
    property Anchors;
    property BiDiMode;
    property Constraints;
    property DragKind;
    property ParentBiDiMode;
    {$ENDIF}
    property Filename : String read FFilename write SetFilename;
    property Separator: Char read FSeparator write SetSeparator default '\';
    property Align;
    property Enabled;
    property FocusControl;
    property Font;
    property ShowHint;
    property Visible;
    property OnClick;
    property OnDblClick;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnDragDrop;
    property OnEndDrag;
    property OnStartDrag;
    property OnDragOver;
    property DragCursor;
    property DragMode;
    property ParentColor;
    property ParentFont;
    Property ShowAccelChar;
  end;

implementation
uses ShellApi;

function AHMDirectoryExists(const Name: string): Boolean;
var
  Code: Integer;
begin
  Code := GetFileAttributes(PChar(Name));
  Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
end;

constructor TAHMFileLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  color:=clwhite;
  Transparent:=true;
  FBitmap := TBitmap.Create;
  FBitmap.Handle := LoadBitmap(HInstance, 'AHMFOLDER');
  ControlStyle  := ControlStyle + [csReplicatable];
  font.style    := [fsbold];
  FParts        := TStringList.Create;
  FSeparator    := '\';
  AutoSize      := False;
  WordWrap      := False;
end;

procedure TAHMFileLabel.Notification(AComponent: TComponent;Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
end;

procedure TAHMFileLabel.Loaded;
begin
  inherited Loaded;
end;

destructor TAHMFileLabel.Destroy;
begin
  FParts.Free;
  FBitmap.Free;
  inherited Destroy;
end;

procedure TAHMFileLabel.Paint;
const
  Alignments: array[TAlignment] of Word =(DT_LEFT, DT_RIGHT, DT_CENTER);
  WordWraps: array[Boolean] of Word = (0, DT_WORDBREAK);
var
  TempRect:TRect;
  flags : Longint;
  FAttr: Integer;
  Info : TSHFileInfo;
begin
  TempRect:=Clientrect;
  Canvas.Brush.Color := Self.Color;
  Canvas.Brush.Style := bsSolid;
  Canvas.Font:=self.Font;
  Canvas.FillRect(ClientRect);
  flags := DT_EXPANDTABS or WordWraps[WordWrap] or Alignments[Alignment];
  Text := GetLabelText;
  if (Flags and DT_CALCRECT <> 0) and ((Text = '') or ShowAccelChar and
    (Text[1] = '&') and (Text[2] = #0)) then Text := Text + ' ';
  with Canvas do
  begin
    FAttr := FileGetAttr(FFilename);
    if ((FAttr and faDirectory) > 0) and AHMDirectoryExists(FFilename) then
    begin
      Draw(1,1,fBitmap);
      TextOut(FBitmap.Width + 3, 1, Text);
    end else
    if FileExists(FFilename) then
    begin
      FillChar(Info,SizeOF(TSHFileInfo),0);
      with TImageList.Create(self) do
      try
        Handle:=SHGetFileInfo(PChar(FFilename),0,Info,
        SizeOf(TSHFileInfo),SHGFI_SYSICONINDEX or SHGFI_SMALLICON or SHGFI_OPENICON);
        ShareImages:=True;
        Draw(Canvas,1,1,Info.iIcon);
      finally
        Free;
      end;
      TextOut(19, 1,Text);
    end;
  end;
end;

procedure TAHMFileLabel.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  AdjustCaption;
end;

procedure TAHMFileLabel.SetFilename(AFilename: String);
begin
  if FFilename <> AFilename then begin
    FFilename := AFilename;
    FillParts;
    AdjustCaption;
  end;
end;

procedure TAHMFileLabel.SetSeparator(ASeparator: Char);
begin
  if FSeparator <> ASeparator then begin
    FSeparator := ASeparator;
    FillParts;
    AdjustCaption;
  end;
end;

function AHMStringIntoPieces(BaseString, BreakString: string; StringList: TStringList): TStringList;
var
  EndOfCurrentString: byte;
begin
  repeat
    EndOfCurrentString := Pos(BreakString, BaseString);
    if EndOfCurrentString = 0 then
      StringList.add(BaseString)
    else
      StringList.add(Copy(BaseString, 1, EndOfCurrentString - 1));
    BaseString := Copy(BaseString, EndOfCurrentString + length(BreakString),
                  length(BaseString) - EndOfCurrentString);
  until EndOfCurrentString = 0;
  result := StringList;
end;

procedure TAHMFileLabel.FillParts;
begin
  FParts.Clear;
  AHMStringIntoPieces(FFilename, FSeparator, FParts);
  if (FParts.Count <> 0) and (Length(FParts[0]) > 1)
    and (FParts[0][Length(FParts[0])] = ':') then
    FFirstPartIsDrive := True
  else
    FFirstPartIsDrive := False;
end;

procedure TAHMFileLabel.AdjustCaption;
var
  CurWidth, Start, Stop, iRep: Integer;
  StrDrive, StrEtc, StrRep, StrName: String;
begin
  start:=1;
  if (FFilename = '') or (Canvas.TextWidth(FFilename) <= Width-19) then Caption := FFilename
  else
  begin
    StrEtc := '...' + FSeparator;
    StrName := FParts[FParts.Count - 1];
    CurWidth := Canvas.TextWidth(StrName);
    if (CurWidth + Canvas.TextWidth(StrEtc)) < Width-19 then
    begin
      CurWidth := CurWidth + Canvas.TextWidth(StrEtc);
      if FFirstPartIsDrive then
      begin
        StrDrive := FParts[0] + FSeparator;
        Start := 1;
      end;
      if (CurWidth + Canvas.TextWidth(StrDrive)) < Width-19 then
      begin
        CurWidth := CurWidth + Canvas.TextWidth(StrDrive);
        Stop := FParts.Count - 2;
        for iRep := Stop downto Start do
        begin
          if (CurWidth + Canvas.TextWidth(FParts[iRep] + FSeparator + StrRep)) > Width-19 then break;
          StrRep := FParts[iRep] + FSeparator + StrRep;
        end;
        Caption := StrDrive + StrEtc + StrRep + StrName;
      end
      else Caption := StrEtc + StrName;
    end
    else
      Caption := StrName;
  end;
end;

end.

