jvdrivectrls.pas

East make Tray Icon in delphi

  OpenCurrent;
  inherited DblClick;
end;

procedure TJvDirectoryListBox.Change;
begin
  if FFileList <> nil then
    FFileList.Directory := Directory;
  if FDriveCombo <> nil then
    FDriveCombo.Drive := Drive;
  SetDirLabelCaption;
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TJvDirectoryListBox.CNDrawItem(var Msg: TWMDrawItem);
var
  State: TOwnerDrawState;
begin
  with Msg.DrawItemStruct^ do
  begin
    State := TOwnerDrawState(Lo(itemState));
    Canvas.Handle := hDC;
    Canvas.Font := Font;
    Canvas.Brush := Brush;
    if (Integer(itemID) >= 0) and (odSelected in State) then
    begin
      Canvas.Brush.Color := clHighlight;
      Canvas.Font.Color := clHighlightText;
    end;
    if Integer(itemID) >= 0 then
      DrawItem(itemID, rcItem, State)
    else
    begin
      Canvas.FillRect(rcItem);
      //if odFocused in State then
      //  DrawFocusRect(hDC, rcItem);
    end;
    Canvas.Handle := 0;
  end;
end;

procedure TJvDirectoryListBox.DrawItem(Index: Integer; Rect: TRect;
  State: TOwnerDrawState);
var
  BmpWidth: Integer;
  DirOffset: Integer;
  S: string;
  RectText: TRect;
begin
  with Canvas do
  begin
    FillRect(Rect);

    BmpWidth := FImages.Width;
    if Index = 0 then
      DirOffset := Rect.Left + 2
    else
      DirOffset := Rect.Left + (DirLevel(Items[Index]) + 1) * 4 + 2;
    FImages.Draw(Canvas, DirOffset, (Rect.Top + Rect.Bottom - FImages.Height) div 2,
      Integer(Items.Objects[Index]));

    S := FDisplayNames[Index];

    RectText := Rect;
    RectText.Left := RectText.Left + DirOffset + FImages.Width + 2;
    RectText.Right := RectText.Left + TextWidth(S) + 4;

    TextOut(Rect.Left + BmpWidth + DirOffset + 4, Rect.Top + 2, S);
    if odFocused in State then
      DrawFocusRect(RectText);
  end;
end;

function TJvDirectoryListBox.GetItemPath(Index: Integer): string;
begin
  Result := '';
  if Index < Items.Count then
    Result := Items[Index];
  Exit;
end;

procedure TJvDirectoryListBox.CreateWnd;
begin
  inherited CreateWnd;
  BuildList;
  ItemIndex := DirLevel(Directory);
end;

procedure TJvDirectoryListBox.FontChanged;
begin
  inherited FontChanged;
  ResetItemHeight;
end;

procedure TJvDirectoryListBox.ResetItemHeight;
var
  NewHeight: Integer;
begin
  NewHeight := GetItemHeight(Font);
  if NewHeight < (FImages.Height + 1) then
    NewHeight := FImages.Height + 1;
  ItemHeight := NewHeight;
end;

function TJvDirectoryListBox.GetDrive: Char;
begin
  Result := FDirectory[1];
end;

procedure TJvDirectoryListBox.SetDrive(Value: Char);
begin
  if UpCase(Value) <> UpCase(Drive) then
    SetDirectory(Format('%s:', [Value]));
end;

procedure TJvDirectoryListBox.SetDirectory(const NewDirectory: string);
var
  NewDrive: string;
begin
  { When reading from the stream, always set the directory; if we don't do this
    the image indexes aren't initialized }
  if (Length(NewDirectory) = 0) or
    (SameFileName(NewDirectory, Directory) and not (csReading in ComponentState)) then
    Exit;
  NewDrive := ExtractFileDrive(NewDirectory);
  if Length(NewDrive) <> 2 then // we only support single Char drives (no UNC's)
    Exit;
  //  ProcessPath(NewDirectory, NewDrive, DirPart, FilePart);
  try
    if Drive <> NewDrive[1] then
    begin
      FInSetDir := True;
      if FDriveCombo <> nil then
        FDriveCombo.Drive := NewDrive[1]
      else
        DriveChange(NewDrive[1]);
    end;
  finally
    FInSetDir := False;
  end;
  if not DirectoryExists(NewDirectory) then
    SetDir(GetCurrentDir) // we have to do this because we might have changed drive
  else
    SetDir(NewDirectory);
end;

procedure TJvDirectoryListBox.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);
  if Word(Key) = VK_RETURN then
    OpenCurrent;
end;

procedure TJvDirectoryListBox.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
  begin
    if AComponent = FFileList then
      FFileList := nil
    else
    if AComponent = FDriveCombo then
      FDriveCombo := nil
    else
    if AComponent = FDirLabel then
      FDirLabel := nil;
  end;
end;

procedure TJvDirectoryListBox.SetDirLabelCaption;
var
  DirWidth: Integer;
begin
  if FDirLabel <> nil then
  begin
    DirWidth := Width;
    if not FDirLabel.AutoSize then
      DirWidth := FDirLabel.Width;
    FDirLabel.Caption := MinimizeName(Directory, FDirLabel.Canvas, DirWidth);
  end;
end;

procedure TJvDirectoryListBox.SetDriveCombo(const Value: TJvDriveCombo);
begin
  if FDriveCombo <> nil then
    FDriveCombo.FDirList := nil;
  FDriveCombo := Value;
  if FDriveCombo <> nil then
  begin
    FDriveCombo.FDirList := Self;
    FDriveCombo.Drive := Drive;
    FDriveCombo.FreeNotification(Self);
  end;
end;

procedure TJvDirectoryListBox.Click;
begin
  if FAutoExpand then
    OpenCurrent;
  inherited Click;
end;

procedure TJvDirectoryListBox.SetShowAllFolders(const Value: Boolean);
begin
  if FShowAllFolders <> Value then
  begin
    FShowAllFolders := Value;
    BuildList;
  end;
end;

//=== { TJvFileListBox } =====================================================

constructor TJvFileListBox.Create(AOwner: TComponent);
var
  shi: TSHFileInfo;
begin
  inherited Create(AOwner);
  FImages := TImageList.CreateSize(16, 16);
  FImages.ShareImages := True;
  FillChar(shi, SizeOf(shi), 0);
  FImages.Handle := SHGetFileInfo('', 0, shi, SizeOf(shi), SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
  FImages.DrawingStyle := dsTransparent;

  FSearchFiles := TJvSearchFiles.Create(Self);
  FSearchFiles.Options := [soAllowDuplicates,
    soSearchDirs, soSearchFiles, soStripDirs];
  FSearchFiles.DirOption := doExcludeSubDirs;
  FSearchFiles.FileParams.FileMaskSeperator := ';';
  FSearchFiles.FileParams.SearchTypes := [stAttribute, stFileMask];
  FSearchFiles.FileParams.Attributes.IncludeAttr := 0;
  { No filter on drives }
  FSearchFiles.DirParams.SearchTypes := [];
  FSearchFiles.ErrorResponse := erIgnore;
end;

destructor TJvFileListBox.Destroy;
begin
  FImages.Free;
  inherited Destroy;
end;

procedure TJvFileListBox.ReadFileNames;
var
  shinf: SHFILEINFO;
  I, J: Integer;
  Flags: Cardinal;
  AttrIndex: TFileAttr;
  AttrWord: DWORD;
  SaveCursor: TCursor;
const
  SHGFI_OVERLAYINDEX = $00000040;
  {TFileAttr = (ftReadOnly, ftHidden, ftSystem, ftVolumeID, ftDirectory,
    ftArchive, ftNormal);}
  Attributes: array [TFileAttr] of Word = (FILE_ATTRIBUTE_READONLY, FILE_ATTRIBUTE_HIDDEN,
    FILE_ATTRIBUTE_SYSTEM, 0 {faVolumeID}, 0 {faDirectory}, FILE_ATTRIBUTE_ARCHIVE,
    FILE_ATTRIBUTE_READONLY or FILE_ATTRIBUTE_ARCHIVE or FILE_ATTRIBUTE_NORMAL {faNormal});
  CAllAttributes = FILE_ATTRIBUTE_READONLY or FILE_ATTRIBUTE_HIDDEN or
    FILE_ATTRIBUTE_SYSTEM or FILE_ATTRIBUTE_ARCHIVE or FILE_ATTRIBUTE_NORMAL;
begin
  AttrWord := 0;
  if HandleAllocated then
  begin
    { Set attribute flags based on values in FileType }
    for AttrIndex := Low(TFileAttr) to High(TFileAttr) do
      if AttrIndex in FileType then
        AttrWord := AttrWord or Attributes[AttrIndex];
    SetCurrentDir(FDirectory); { go to the directory we want }
    Clear; { clear the list }

    SaveCursor := Screen.Cursor;
    try
      FSearchFiles.RootDirectory := GetCurrentDir;
      FSearchFiles.FileParams.FileMask := FMask;
      { CAllAttributes is used to ensure that we do not filter out some new
        Attributes, such as FILE_ATTRIBUTE_NOT_CONTENT_INDEXED etc }
      FSearchFiles.FileParams.Attributes.ExcludeAttr := not AttrWord and CAllAttributes;
      if ftDirectory in FileType then
        FSearchFiles.Options := FSearchFiles.Options + [soSearchDirs]
      else
        FSearchFiles.Options := FSearchFiles.Options - [soSearchDirs];

      FSearchFiles.Search;

      { Overlay included to display linked folders or files etc. }
      Flags := SHGFI_SYSICONINDEX or SHGFI_ICON or SHGFI_SMALLICON or SHGFI_DISPLAYNAME;
      if GetShellVersion >= $00050000 then
        Flags := Flags or SHGFI_OVERLAYINDEX;

      { First add directories.. }
      with FSearchFiles.Directories do
        for J := 0 to Count - 1 do
        begin
          { Note that the strings in FSearchFiles.Directories do not include a path }
          FillChar(shinf, SizeOf(shinf), 0);
          SHGetFileInfo(PChar(Strings[J]), 0, shinf, SizeOf(shinf), Flags);
          if FForceFileExtensions then
            I := Items.Add(cDirPrefix + Strings[J])
          else
            I := Items.Add(cDirPrefix + string(shinf.szDisplayName));
          Items.Objects[I] := TObject(shinf.iIcon);
          if I = 100 then
            Screen.Cursor := crHourGlass;
        end;

      { ..then add files }
      with FSearchFiles.Files do
        for J := 0 to Count - 1 do
        begin
          FillChar(shinf, SizeOf(shinf), 0);
          SHGetFileInfo(PChar(Strings[J]), 0, shinf, SizeOf(shinf), Flags);
          if FForceFileExtensions then
            I := Items.Add(Strings[J])
          else
            I := Items.Add(shinf.szDisplayName);
          Items.Objects[I] := TObject(shinf.iIcon);
          if I = 100 then
            Screen.Cursor := crHourGlass;
        end;
    finally
      Screen.Cursor := SaveCursor;
    end;
    Change;
  end;
end;

procedure TJvFileListBox.ApplyFilePath(const EditText: string);
begin
  if (EditText <> '') and
    (AnsiCompareFileName(ExtractFilePath(FileName), ExtractFilePath(EditText)) <> 0) then
  begin
    inherited ApplyFilePath(EditText);
    ReadFileNames;
  end;
end;

procedure TJvFileListBox.SetForceFileExtensions(const Value: Boolean);
begin
  if FForceFileExtensions <> Value then
  begin
    FForceFileExtensions := Value;
    ReadFileNames;
  end;
end;

procedure TJvFileListBox.CNDrawItem(var Msg: TWMDrawItem);
var
  State: TOwnerDrawState;
begin
  with Msg.DrawItemStruct^ do
  begin
    State := TOwnerDrawState(Lo(itemState));
    Canvas.Handle := hDC;
    Canvas.Font := Font;
    Canvas.Brush := Brush;
    if (Integer(itemID) >= 0) and (odSelected in State) then
    begin
      Canvas.Brush.Color := clHighlight;
      Canvas.Font.Color := clHighlightText
    end;
    if Integer(itemID) >= 0 then
      DrawItem(itemID, rcItem, State)
    else
      Canvas.FillRect(rcItem);
    //    if odFocused in State then DrawFocusRect(hDC, rcItem);
    Canvas.Handle := 0;
  end;
end;

procedure TJvFileListBox.DrawItem(Index: Integer; Rect: TRect;
  State: TOwnerDrawState);
var
  Offset: Integer;
  tmpR: TRect;
  ImageIndex: Integer;
  OverlayIndex: Integer;
begin
  with Canvas do
  begin
    //    FillRect(Rect);
    Offset := 2;
    tmpR := Rect;
    if ShowGlyphs then
    begin
      ImageIndex := Integer(Items.Objects[Index]);
      OverlayIndex := (ImageIndex shr 24) - 1;
      if OverlayIndex >= 0 then
        FImages.DrawOverlay(Canvas, Rect.Left + 2, (Rect.Top + Rect.Bottom - FImages.Height) div 2,
          ImageIndex and $00FFFFFF, OverlayIndex)
      else
        FImages.Draw(Canvas, Rect.Left + 2, (Rect.Top + Rect.Bottom - FImages.Height) div 2,
          ImageIndex);
      Offset := FImages.Width + 6;
    end;

    // Use Trim because directories have a space as prefix, so that
    // the directory names appear above the files.
    tmpR.Left := tmpR.Left + Offset - 2;
    tmpR.Right := tmpR.Left + TextWidth(Trim(Items[Index])) + 4;
    FillRect(tmpR);
    TextOut(Rect.Left + Offset, Rect.Top, Trim(Items[Index]));

    if odFocused in State then
      DrawFocusRect(tmpR);
  end;
end;

function TJvDriveList.GetDrives(Index: Integer): string;
begin
  Result := FDrives[Index];
end;

function TJvDriveList.GetDriveCount: Integer;
begin
  Result := FDrives.Count;
end;

{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.