jvdrivectrls.pas

East make Tray Icon in delphi

    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);

    Canvas.Handle := 0;
  end;
end;

procedure TJvDriveList.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
  HOffset, I: Integer;
  tmpCol: TColor;
  tmpR: TRect;
begin
  with Canvas do
  begin
    tmpCol := Canvas.Brush.Color;
    Canvas.Brush.Color := Self.Color;
    FillRect(Rect);
    Canvas.Brush.Color := tmpCol;
    if FImageAlign = iaCentered then
    begin
      HOffset := (Rect.Right - Rect.Left) div 2 - FImageWidth div 2;
      if FImages.Count > 0 then
      begin
        I := Integer(Items.Objects[Index]);
        FImages.Draw(Canvas, HOffset, Rect.Top, I);
      end;
      InflateRect(Rect, 1, -6);
      tmpR := Rect;
      DrawText(Canvas, Items[Index], -1, tmpR,
        DT_SINGLELINE or DT_BOTTOM or DT_CENTER or DT_NOPREFIX or DT_CALCRECT);
      Rect.Top := tmpR.Bottom - CanvasMaxTextHeight(Canvas);
      Rect.Left := (Rect.Right - Rect.Left) div 2 - Canvas.TextWidth(PChar(Items[Index])) div 2;
      Rect.Right := Rect.Left + Canvas.TextWidth(PChar(Items[Index]));
      DrawText(Canvas, Items[Index], -1, Rect, DT_SINGLELINE or DT_CENTER or DT_NOPREFIX);
    end
    else
    begin
      if FImages.Count > 0 then
      begin
        I := Integer(Items.Objects[Index]);
        FImages.Draw(Canvas, Rect.Left + FOffset * 2, Rect.Top + FOffset * 2, I);
      end;
      tmpR := Rect;
      DrawText(Canvas, Items[Index], -1, tmpR,
        DT_SINGLELINE or DT_VCENTER or DT_CENTER or DT_NOPREFIX or DT_CALCRECT);
      Rect.Top := tmpR.Bottom - CanvasMaxTextHeight(Canvas);
      Rect.Bottom := Rect.Top + CanvasMaxTextHeight(Canvas);
      Rect.Left := FImageWidth + FOffset * 3;
      Rect.Right := Rect.Left + Canvas.TextWidth(PChar(Items[Index]));
      DrawText(Canvas, Items[Index], -1, Rect, DT_SINGLELINE or DT_TOP or DT_NOPREFIX);
    end;
  end;
  if odFocused in State then
    DrawFocusRect(Canvas.Handle, Rect);
end;

procedure TJvDriveList.MeasureItem(Index: Integer; var Height: Integer);
begin
  if FImageAlign = iaCentered then
    Height := FImageWidth + GetItemHeight(Font)
  else
    Height := Max(GetItemHeight(Font), FImageWidth);
end;

procedure TJvDriveList.SetImageAlign(Value: TJvImageAlign);
begin
  if FImageAlign <> Value then
  begin
    FImageAlign := Value;
    Invalidate;
  end;
end;

procedure TJvDriveList.FontChanged;
begin
  inherited FontChanged;
  ResetItemHeight;
  RecreateWnd;
end;

procedure TJvDriveList.ResetItemHeight;
begin
  ItemHeight := GetItemHeight(Font) + FImageWidth + 8;
end;

procedure TJvDriveList.SetDriveTypes(Value: TJvDriveTypes);
begin
  FDriveTypes := Value;
  if FDriveTypes = [] then
    FDriveTypes := [dtFixed];
  BuildList;
end;

procedure TJvDriveList.SetDrive(Value: Char);
var
  I, J: Integer;
begin
  J := 0;
  if FItemIndex <> -1 then
    J := FItemIndex;

  Value := UpCase(Value);
  if (FDrive <> Value) and (Value <> #0) then
  begin
    I := FDrives.IndexOf(Value);
    if I > -1 then
    begin
      FDrive := Value;
      FItemIndex := I;
      ItemIndex := I;
    end;
  end
  else
    ItemIndex := J;
end;

procedure TJvDriveList.SetImageSize(Value: TJvImageSize);
begin
  if FImageSize <> Value then
  begin
    FImageSize := Value;
    if Items.Count > 0 then
      Items.Clear;
    if Assigned(FImages) then
      FImages.Free;

    if Value = isSmall then
      FImages := TImageList.CreateSize(FSmall, FSmall)
    else
      FImages := TImageList.CreateSize(FLarge, FLarge);

    FImages.DrawingStyle := dsTransparent;
    FImages.ShareImages := True;
    FImageWidth := FImages.Width;
    ResetItemHeight;
    RecreateWnd;
    BuildList;
    Change;
  end;
end;

procedure TJvDriveList.SetOffset(Value: Integer);
begin
  if FOffset <> Value then
  begin
    FOffset := Value;
    Refresh;
  end;
end;

procedure TJvDriveList.Resize;
begin
  inherited Resize;
  Invalidate;
end;

procedure TJvDriveList.Change;
begin
  if ItemIndex <> -1 then
    FItemIndex := ItemIndex;
  Drive := FDrives[FItemIndex][1];
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TJvDriveList.CNCommand(var Msg: TWMCommand);
begin
  inherited;
  case Msg.NotifyCode of
    {    CBN_EDITCHANGE:
          Change;}
    CBN_SELCHANGE:
      Change;
  end;
end;

//=== { TJvDirectoryListBox } ================================================

function AddPathBackslash(const Path: string): string;
begin
  Result := Path;
  if (Length(Path) > 1) and (AnsiLastChar(Path) <> '\') then
    Result := Path + '\';
end;

function DirLevel(const PathName: string): Integer; { counts '\' in path }
var
  P: PChar;
begin
  Result := 0;
  P := AnsiStrScan(PChar(PathName), '\');
  while P <> nil do
  begin
    Inc(Result);
    Inc(P);
    P := AnsiStrScan(P, '\');
  end;
end;

function ConcatPaths(const Path, S: string): string;
begin
  if Path = '' then
  begin
    Result := AddPathBackslash(S);
    Exit;
  end;
  if AnsiLastChar(Path)^ <> '\' then
    Result := Path + '\' + S
  else
    Result := Path + S;
end;

constructor TJvDirectoryListBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := 145;
  Style := lbOwnerDrawFixed;
  Sorted := False;
  ScrollBars := ssNone;
  FAutoExpand := True;
  FImages := TImageList.Create(Self);
  FImages.ShareImages := True;
  FDisplayNames := TStringList.Create;
  ReadBitmaps;
  GetDir(0, FDirectory);
  ResetItemHeight;
end;

destructor TJvDirectoryListBox.Destroy;
begin
  FDisplayNames.Free;
  inherited Destroy;
end;

function TJvDirectoryListBox.DoDriveChangeError(var NewDrive: Char): Boolean;
begin
  Result := Assigned(FOnDriveChangeError);
  if Result then
    FOnDriveChangeError(Self, NewDrive);
end;

procedure TJvDirectoryListBox.DriveChange(NewDrive: Char);
var
  VolFlags, MLength: DWORD;
  TmpDrive: Char;
begin
  if UpCase(NewDrive) <> UpCase(Drive) then
  begin
    if NewDrive <> #0 then
    begin
      if not SetCurrentDir(NewDrive + ':') then
      begin
        TmpDrive := NewDrive;
        if DoDriveChangeError(NewDrive) and (NewDrive <> TmpDrive) then
        begin
          DriveChange(NewDrive)
        end
        else
        if TmpDrive <> Drive then
          DriveChange(Drive); // ...if not, revert
      end;
      FDirectory := GetCurrentDir; { store correct directory name }
      GetVolumeInformation(PChar(NewDrive + ':\'), nil, 0, nil, MLength, VolFlags, nil, 0);
      FPreserveCase := VolFlags and (FS_CASE_IS_PRESERVED or FS_CASE_SENSITIVE) <> 0;
      FCaseSensitive := (VolFlags and FS_CASE_SENSITIVE) <> 0;
    end;
    if not FInSetDir then
    begin
      BuildList;
      Change;
    end;
  end;
end;

procedure TJvDirectoryListBox.SetFileList(Value: TJvFileListBox);
begin
  if FFileList <> nil then
    FFileList.FDirList := nil;
  FFileList := Value;
  if FFileList <> nil then
  begin
    FFileList.FreeNotification(Self);
    FFileList.Directory := Directory;
  end;
end;

procedure TJvDirectoryListBox.SetDirLabel(Value: TLabel);
begin
  FDirLabel := Value;
  if Value <> nil then
    Value.FreeNotification(Self);
  SetDirLabelCaption;
end;

procedure TJvDirectoryListBox.SetDir(const NewDirectory: string);
begin
  if DirectoryExists(FDirectory) then
    SetCurrentDir(FDirectory);
  SetCurrentDir(NewDirectory); { exception raised if invalid dir }
  FDirectory := GetCurrentDir; { store correct directory name }
  BuildList;
  Change;
end;

procedure TJvDirectoryListBox.OpenCurrent;
begin
  Directory := GetItemPath(ItemIndex);
end;

procedure TJvDirectoryListBox.Update;
begin
  BuildList;
  Change;
end;

function TJvDirectoryListBox.ReadDirectoryNames(const ParentDirectory: string;
  DirectoryList: TStrings): Integer;
const
  cAttr: array [Boolean] of Integer = (faDirectory,
    {$IFDEF VCL} faReadOnly or faHidden or faSysFile or faArchive or {$ENDIF} faDirectory);
var
  Status: Integer;
  SearchRec: TSearchRec;
begin
  Result := 0;
  DirectoryList.BeginUpdate;
  Status := FindFirst(ConcatPaths(ParentDirectory, AllFilePattern), cAttr[ShowAllFolders], SearchRec);
  try
    while Status = 0 do
    begin
      if (SearchRec.Attr and faDirectory) = faDirectory then
      begin
        if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
        begin
          DirectoryList.Add(ConcatPaths(ParentDirectory, SearchRec.Name));
          Inc(Result);
        end;
      end;
      Status := FindNext(SearchRec);
    end;
  finally
    FindClose(SearchRec);
    DirectoryList.EndUpdate;
  end;
end;

procedure TJvDirectoryListBox.BuildList;
const
  CFlagsDir = SHGFI_ICON or SHGFI_SMALLICON or SHGFI_SELECTED or SHGFI_OPENICON or SHGFI_DISPLAYNAME;
  CFlagsSubDirs = SHGFI_ICON or SHGFI_SMALLICON or SHGFI_DISPLAYNAME;
var
  TempPath: string;
  DirName: string;
  BackSlashPos: Integer;
  I: Integer;
  Siblings: TStringList;
  NewSelect: Integer;
  tmpFolder: string;
  psfi: TSHFileInfo;
begin
  Items.BeginUpdate;
  try
    Items.Clear;
    FDisplayNames.Clear;

    TempPath := Directory;
    tmpFolder := '';

    if Length(TempPath) > 0 then
    begin
      if AnsiLastChar(TempPath)^ <> '\' then
      begin
        BackSlashPos := AnsiPos('\', TempPath);
        while BackSlashPos <> 0 do
        begin
          DirName := Copy(TempPath, 1, BackSlashPos - 1);
          tmpFolder := ConcatPaths(tmpFolder, DirName);
          Delete(TempPath, 1, BackSlashPos);
          SHGetFileInfo(PChar(tmpFolder), 0, psfi, SizeOf(TSHFileInfo), CFlagsDir);
          Items.AddObject(tmpFolder, TObject(psfi.iIcon));
          FDisplayNames.Add(psfi.szDisplayName);
          BackSlashPos := AnsiPos('\', TempPath);
        end;
      end;
      // add the selected dir:
      SHGetFileInfo(PChar(Directory), 0, psfi, SizeOf(TSHFileInfo), CFlagsDir);
      Items.AddObject(Directory, TObject(psfi.iIcon));
      FDisplayNames.Add(psfi.szDisplayName);
    end;
    NewSelect := Items.Count - 1;

    Siblings := TStringList.Create;
    try
      Siblings.Sorted := True;
      { read all the subdir names into Siblings }
      ReadDirectoryNames(Directory, Siblings);
      for I := 0 to Siblings.Count - 1 do
      begin
        SHGetFileInfo(PChar(Siblings[I]), 0, psfi, SizeOf(TSHFileInfo), CFlagsSubDirs);
        Items.AddObject(Siblings[I], TObject(psfi.iIcon));
        FDisplayNames.Add(psfi.szDisplayName);
      end;
    finally
      Siblings.Free;
    end;
  finally
    Items.EndUpdate;
  end;
  if HandleAllocated then
    ItemIndex := NewSelect;
end;

procedure TJvDirectoryListBox.ReadBitmaps;
var
  psfi: TSHFileInfo;
begin
  FImages.Handle := SHGetFileInfo('', 0, psfi, SizeOf(TSHFileInfo), SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
  FImages.ShareImages := True;
  FImages.DrawingStyle := dsTransparent;
end;

procedure TJvDirectoryListBox.DblClick;
begin