jvdrivectrls.pas

East make Tray Icon in delphi

  FLarge := GetSystemMetrics(SM_CXICON);
  FSmall := GetSystemMetrics(SM_CXSMICON);

  FDrives := TStringList.Create;
  FDriveTypes := dtStandard;

  FImageSize := isSmall;
  RecreateImageList;
  FImageWidth := FImages.Width;

  FItemIndex := 0;
  FOffset := 4;
  Color := clWindow;
  Style := csOwnerDrawFixed;
  ResetItemHeight;
  Application.HookMainWindow(DriveChangeMessage);
end;

destructor TJvDriveCombo.Destroy;
begin
  Application.UnhookMainWindow(DriveChangeMessage);
  FDrives.Free;
  FImages.Free;
  inherited Destroy;
end;

function TJvDriveCombo.DriveChangeMessage(var Msg: TMessage): Boolean;
begin
  Result := False;
  if Msg.Msg = WM_DEVICECHANGE then
    if ((TWMDeviceChange(Msg).Event = DBT_DEVICEARRIVAL) or
      (TWMDeviceChange(Msg).Event = DBT_DEVICEREMOVECOMPLETE)) and
      (PDevBroadcastVolume(TWMDeviceChange(Msg).dwData)^.dbcv_devicetype = DBT_DEVTYP_VOLUME) then
      Refresh;
end;

procedure TJvDriveCombo.RecreateImageList;
begin
  if FImageSize = isSmall then
    FImages := TImageList.CreateSize(FSmall, FSmall)
  else
    FImages := TImageList.CreateSize(FLarge, FLarge);

  FImages.DrawingStyle := dsTransparent;
  FImages.ShareImages := True;
end;

procedure TJvDriveCombo.BuildList;
var
  Info: TSHFileInfo;
  S: string;
  Options: Integer;
  Drv: Char;
  LastErrorMode: Cardinal;
  Tmp: array [0..104] of Char; // 4 chars ('C:\#0') * 26 possible drives + 1 terminating #0 = 105 chars
  P: PChar;
begin
  Drv := Drive;
  Items.Clear;
  FDrives.Clear;
  Options := SHGFI_SYSICONINDEX;
  if FImageSize = isSmall then
    Options := Options or SHGFI_SMALLICON
  else
    Options := Options or SHGFI_LARGEICON;

  FImages.Handle := SHGetFileInfo('', 0, Info, SizeOf(TSHFileInfo), Options);
  FImages.ShareImages := True;
  LastErrorMode := SetErrorMode(SEM_NOOPENFILEERRORBOX);
  try
    FillChar(Tmp[0], SizeOf(Tmp), #0);
    GetLogicalDriveStrings(SizeOf(Tmp), Tmp);
    P := Tmp;
    while P^ <> #0 do
    begin
      S := P;
      Inc(P, 4);
      if IsValidDriveType(DriveTypes, GetDriveType(PChar(S))) then
      begin
        SHGetFileInfo(PChar(S), 0, Info, SizeOf(TSHFileInfo), SHGFI_DISPLAYNAME or Options);
        Items.AddObject(Trim(Info.szDisplayName), TObject(Info.iIcon));
        FDrives.Add(S[1]);
      end
    end;
    Drive := Drv;
    Update;
  finally
    SetErrorMode(LastErrorMode);
  end;
end;

procedure TJvDriveCombo.CreateWnd;
begin
  inherited CreateWnd;
  BuildList;
  if FDrive = #0 then
  begin
    if FDrives.IndexOf(GetCurrentDir[1]) > 0 then
      Drive := GetCurrentDir[1]
    else
    if FDrives.Count > 0 then
      Drive := FDrives[0][1];
  end;
end;

procedure TJvDriveCombo.Refresh;
begin
  BuildList;
end;

procedure TJvDriveCombo.CNDrawItem(var Msg: TWMDrawItem);
var
  State: TOwnerDrawState;
begin
  with Msg.DrawItemStruct^ do
  begin
    State := [];
    if (itemState and ODS_CHECKED) <> 0 then
      Include(State, odChecked);
    if (itemState and ODS_COMBOBOXEDIT) <> 0 then
      Include(State, odComboBoxEdit);
    if (itemState and ODS_DEFAULT) <> 0 then
      Include(State, odDefault);
    if (itemState and ODS_DISABLED) <> 0 then
      Include(State, odDisabled);
    if (itemState and ODS_FOCUS) <> 0 then
      Include(State, odFocused);
    if (itemState and ODS_GRAYED) <> 0 then
      Include(State, odGrayed);
    if (itemState and ODS_SELECTED) <> 0 then
      Include(State, odSelected);
    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);
    Canvas.Handle := 0;
  end;
end;

procedure TJvDriveCombo.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
  Offset, I: Integer;
begin
  //  inherited;
  with Canvas do
  begin
    Offset := FImageWidth + FOffset + FOffset;
    if FImages.Count > 0 then
    begin
      I := Integer(Items.Objects[Index]);
      FImages.Draw(Canvas, Rect.Left + FOffset, Rect.Top, I);
      Rect.Left := Rect.Left + Offset;
      Rect.Right := Rect.Left + Canvas.TextWidth(Items[Index]) + 6;
    end;
    FillRect(Rect);
    if odSelected in State then
      DrawFocusRect(Rect);
    Inc(Rect.Left, 3);
    DrawText(Canvas, Items[Index], -1, Rect,
      DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX);
  end;
end;

procedure TJvDriveCombo.MeasureItem(Index: Integer; var Height: Integer);
begin
  Height := ItemHeight;
end;

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

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

procedure TJvDriveCombo.SetDriveTypes(Value: TJvDriveTypes);
begin
  FDriveTypes := Value;
  if FDriveTypes = [] then
    FDriveTypes := [dtFixed];
  BuildList;
  Change;
  // Drive := FDrive;
end;

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

  Value := UpCase(Value);
  if FDrive <> Value then
  begin
    I := FDrives.IndexOf(Value);
    if I > -1 then
    begin
      FDrive := Value;
      FItemIndex := I;
      ItemIndex := I;
      if FDirList <> nil then
        FDirList.DriveChange(FDrive);
      Change;
    end;
  end
  else
    ItemIndex := J;
end;

procedure TJvDriveCombo.SetImageSize(Value: TJvImageSize);
begin
  if FImageSize <> Value then
  begin
    FImageSize := Value;

    if Items.Count > 0 then
      Items.Clear;

    RecreateImageList;
    FImageWidth := FImages.Width;
    ResetItemHeight;
    RecreateWnd;
    BuildList;
    Change;
  end;
end;

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

procedure TJvDriveCombo.Change;

  function FirstChar(const S: string): Char;
  begin
    if Length(S) > 0 then
      Result := S[1]
    else
      Result := #0;
  end;

begin
  if ItemIndex <> -1 then
    FItemIndex := ItemIndex
  else
    FItemIndex := 0;
  if (FItemIndex >= 0) and (FItemIndex < FDrives.Count) then
    Drive := FirstChar(FDrives[FItemIndex]);
  if (ItemIndex > -1) and (ItemIndex < Items.Count) then
    FDisplayName := Items[ItemIndex]
  else
    FDisplayName := '';
  inherited Change;
end;

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

//=== { TJvDriveList } =======================================================

constructor TJvDriveList.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FLarge := GetSystemMetrics(SM_CXICON);
  FSmall := GetSystemMetrics(SM_CXSMICON);

  FDrives := TStringList.Create;
  FDriveTypes := dtStandard;
  FImageAlign := iaCentered;
  ScrollBars := ssNone;

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

  FImages.DrawingStyle := dsTransparent;
  FImageWidth := FImages.Width;
  FImages.ShareImages := True;

  FItemIndex := 0;
  Color := clWindow;
  SetBounds(0, 0, FImageWidth * 6 + 16, 97);
  FOffset := 4;
  Style := lbOwnerDrawFixed;
  ResetItemHeight;
  Application.HookMainWindow(DriveChangeMessage);
end;

destructor TJvDriveList.Destroy;
begin
  Application.UnhookMainWindow(DriveChangeMessage);
  FDrives.Free;
  FImages.Free;
  inherited Destroy;
end;

function TJvDriveList.DriveChangeMessage(var Msg: TMessage): Boolean;
begin
  Result := False;
  if Msg.Msg = WM_DEVICECHANGE then
    if ((TWMDeviceChange(Msg).Event = DBT_DEVICEARRIVAL) or
      (TWMDeviceChange(Msg).Event = DBT_DEVICEREMOVECOMPLETE)) and
      (PDevBroadcastVolume(TWMDeviceChange(Msg).dwData)^.dbcv_devicetype = DBT_DEVTYP_VOLUME) then
      Refresh;
end;

procedure TJvDriveList.BuildList;
var
  Info: TSHFileInfo;
  S: string;
  Options: Integer;
  Drv: Char;
  Tmp: array [0..104] of Char;
  P: PChar;
  LastErrorMode: Cardinal;
begin
  Drv := Drive;
  if Items.Count > 0 then
  begin
    Items.Clear;
    FDrives.Clear;
  end;

  Options := SHGFI_SYSICONINDEX;
  if FImageSize = isSmall then
    Options := Options or SHGFI_SMALLICON
  else
    Options := Options or SHGFI_LARGEICON;

  FImages.Handle := SHGetFileInfo('', 0, Info, SizeOf(TSHFileInfo), Options);
  FImages.ShareImages := True;
  FillChar(Tmp[0], SizeOf(Tmp), #0);
  LastErrorMode := SetErrorMode(SEM_NOOPENFILEERRORBOX);
  try
    GetLogicalDriveStrings(SizeOf(Tmp), Tmp);
    P := Tmp;
    while P^ <> #0 do
    begin
      S := P;
      Inc(P, 4);
      if IsValidDriveType(DriveTypes, GetDriveType(PChar(S))) then
      begin
        SHGetFileInfo(PChar(S), 0, Info, SizeOf(TSHFileInfo), SHGFI_DISPLAYNAME or Options);
        Items.AddObject(Trim(Info.szDisplayName), TObject(Info.iIcon));
        FDrives.Add(S[1]);
      end;
    end;
    Drive := Drv;
    Update;
  finally
    SetErrorMode(LastErrorMode);
  end;
end;

procedure TJvDriveList.CreateWnd;
begin
  inherited CreateWnd;
  BuildList;
  if Drive = #0 then
    if FDrives.IndexOf(GetCurrentDir[1]) > 0 then
      Drive := GetCurrentDir[1]
    else
    if FDrives.Count > 0 then
      Drive := FDrives[0][1];
end;

procedure TJvDriveList.Refresh;
begin
  BuildList;
end;

procedure TJvDriveList.CNDrawItem(var Msg: TWMDrawItem);
var
  State: TOwnerDrawState;
begin
  with Msg.DrawItemStruct^ do
  begin
    State := [];
    if (itemState and ODS_CHECKED) <> 0 then
      Include(State, odChecked);
    if (itemState and ODS_COMBOBOXEDIT) <> 0 then
      Include(State, odComboBoxEdit);
    if (itemState and ODS_DEFAULT) <> 0 then
      Include(State, odDefault);
    if (itemState and ODS_DISABLED) <> 0 then
      Include(State, odDisabled);
    if (itemState and ODS_FOCUS) <> 0 then
      Include(State, odFocused);
    if (itemState and ODS_GRAYED) <> 0 then
      Include(State, odGrayed);
    if (itemState and ODS_SELECTED) <> 0 then
      Include(State, odSelected);
    Canvas.Handle := hDC;
    Canvas.Font := Font;
    Canvas.Brush := Brush;