bsskinshellctrls.pas

漂亮的皮肤控件 for delphi 567

    begin
      if CurNode.Level = 1 then
        CurPath := Copy(CurNode.Text, 3, 2) + '\'
      else if CurNode.Level > 1 then
        CurPath := CurNode.Text + '\';
      if AnsiCompareText(CurPath, tempPath) = 0 then
      begin
        CurNode.Selected := True;
        CurNode.Expand(False);
        Break;
      end;
      CurNode := CurNode.GetNext;
      if CurNode = nil then exit;
    end;
  end;
  Items.EndUpdate;
  if AnsiCompareText(FSelectedPath, FullPath) <> 0 then
  begin
    FullPath := AddSlash(FullPath);
    FSelectedPath := FullPath;
  end;
end;

procedure TbsSkinDirTreeView.KeyUp(var Key: Word; Shift: TShiftState);
var
  DrvChar: Char;
begin
  if (Key = VK_UP) or (Key = VK_DOWN) or (Key = VK_LEFT) or (Key = VK_RIGHT) then
  begin
    inherited KeyUp(Key, Shift);

    if selected = nil then exit;
    if (Selected.Level = 0) and (Items[0].getFirstChild = nil) then
      LoadDrives
    else
      MakePath(Selected);

    if (Selected.Level = 0) then
      FSelectedPath := 'Drives'
    else
      FSelectedPath := TreeViewPath;

    if Selected.Level = 1 then
      if GetDriveType(PChar(FSelectedPath)) in
        [DRIVE_REMOVABLE, DRIVE_CDROM] then
      begin
        DrvChar := FSelectedPath[1];
        if not DiskInDrive(DrvChar, 1, FSkinMessage) then
          exit;
      end;
  end;
  if Key=VK_F5 then
  begin
    Reload;
    OpenPath(FSelectedPath);
  end;
end;

function TbsSkinDirTreeView.GetPathFromNode(Node: TTreeNode): string;
begin
  Result := '';
  if Node = nil then exit;
  if Assigned(Node) then
  begin
    MakePath(Node);
    Result := TreeViewPath;
  end;
end;

function TbsSkinDirTreeView.CanEdit(Node: TTreeNode): Boolean;
begin
  Result := False;
  if (Assigned(Node.Parent)) and (Node.Level > 1) and
    (not ReadOnly) then
    Result := inherited CanEdit(Node);
end;

procedure TbsSkinDirTreeView.Edit(const Item: TTVItem);
var
  OldDirName: string;
  NewDirName: string;
  Aborted: Boolean;
  OldCur: TCursor;
  Rslt: Boolean;
  SelNode: TTreeNode;
  PrevNode: TTreeNode;

  function GetNodeFromItem(Item: TTVItem): TTreeNode;
  begin
    with Item do
      if (State and TVIF_PARAM) <> 0 then
        Result := Pointer(lParam)
      else
        Result := Items.GetNode(hItem);
  end;

begin
  SelNode := GetNodeFromItem(Item);
  PrevNode := SelNode.Parent;
  if not Assigned(SelNode) then exit;
  if (SelNode = Items[0]) or (SelNode.Level = 1) then
    exit;

  if (Length(Item.pszText) = 0)
    or (StrContains(InvalidDosChars, Item.pszText)) then
  begin
    MessageBeep(MB_ICONHAND);
    if (Length(Item.pszText) > 0) then Exit;
  end;
  if SelNode <> nil then
    OldDirName := GetPathFromNode(SelNode);
  if OldDirName = '' then exit;
  OldCur := Screen.Cursor;
  Screen.Cursor := crHourGlass;
  try
    Aborted := False;
    OldDirName := DelSlash(OldDirName);
    NewDirName := ExtractFilePath(OldDirName) + Item.pszText;

    if (OldDirName <> NewDirName) and (Item.pszText <> nil)
    then
      Rslt := DoSHFileOp(Parent.Handle, FO_RENAME, OldDirName,
      NewDirName, Aborted);

    if Rslt then
    begin
      inherited Edit(Item);
      Selected := PrevNode;
    end;
  finally
    Screen.Cursor := OldCur;
    FIsNewFolder := False;
  end;
end;

constructor TbsSkinShellDriveComboBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Style := bscbFixedStyle;
  OnListBoxDrawItem := DrawItem;
  OnComboBoxDrawItem := DrawItem;
  Drives := TStringList.Create;
  Images := TImagelist.CreateSize(GetSystemMetrics(SM_CXSMICON), GetSystemMetrics(SM_CYSMICON));
  with Images do
  begin
    DrawingStyle := dsTransparent;
    ShareImages := True;
  end;
end;

destructor TbsSkinShellDriveComboBox.Destroy;
begin
  Drives.Free;
  Images.Free;
  inherited Destroy;
end;

procedure TbsSkinShellDriveComboBox.BuildList;
var
  Info      : TSHFileInfo;
  DriveChar : Char;
  CurrDrive : string;
  DriveType:Integer;
begin
  if Items.Count > 0
  then
    begin
      if ItemIndex > -1 then DriveItemIndex := ItemIndex;
      Items.Clear;
    end;
  Images.Handle := SHGetFileInfo('', 0, Info, SizeOf(TShFileInfo), SHGFI);
  for DriveChar:='A' to 'Z' do
  begin
    CurrDrive := DriveChar + ':\';
    DriveType := GetDriveType(PChar(CurrDrive));
    if DriveType in [0,1] then Continue;
    SHGetFileInfo(PChar(CurrDrive), 0, Info, SizeOf(TShFileInfo), SHGFI_DISPLAYNAME or SHGFI);
    Items.AddObject(Info.szDisplayName, TObject(Info.iIcon));
    Drives.Add(DriveChar);
  end;
  SetDrive(Drives[DriveItemIndex][1]);
  Update;
end;

procedure TbsSkinShellDriveComboBox.CreateWnd;
begin
  inherited CreateWnd;
  BuildList;
end;

procedure TbsSkinShellDriveComboBox.DrawItem;
var
  ImageTop: Integer;
begin
  if Images.Count > 0
  then
    begin
      ImageTop := TextRect.Top + ((TextRect.Bottom - TextRect.Top - Images.Height) div 2);
      Images.Draw(Cnvs, TextRect.Left, ImageTop, Integer(Items.Objects[Index]));
      TextRect.Left := TextRect.Left + Images.Width + 4;
    end;
  Cnvs.TextOut(TextRect.Left,
  TextRect.Top + (TextRect.Bottom - TextRect.Top) div 2 - Cnvs.TextHeight('Wg') div 2,
  Items[Index]);
end;

procedure TbsSkinShellDriveComboBox.SetDrive(Value: Char);
var
  i: Integer;
  j: Integer;
begin
  j := 0;
  if DriveItemIndex <> -1 then j := DriveItemIndex;
  Value := UpCase(Value);
  if FDrive <> Value
  then
    begin
      for i := 0 to Items.Count - 1 do
         if Drives[i][1] = Value
         then
           begin
             FDrive := Value;
             DriveItemIndex := i;
             ItemIndex := i;
             Exit;
           end;
    end
  else
    if ItemIndex <> j then ItemIndex := j;
end;

procedure TbsSkinShellDriveComboBox.Change;
begin
  if ItemIndex <> -1 then DriveItemIndex := ItemIndex;
  SetDrive(Drives[DriveItemIndex][1]);
  if Assigned(FOnChange) then FOnChange(Self);
end;

procedure TbsSkinShellDriveComboBox.UpdateDrives;
var
  Info : TSHFileInfo;
begin
  if Assigned(Images) then Images.Free;
  Images := TImagelist.CreateSize(GetSystemMetrics(SM_CXSMICON), GetSystemMetrics(SM_CYSMICON));
  with Images do
  begin
    DrawingStyle := dsTransparent;
    ShareImages := True;
  end;
  Images.Handle := SHGetFileInfo('', 0, Info, SizeOf(TShFileInfo), SHGFI);
  BuildList;
end;

{Dialogs}

constructor TbsSelDirDlgForm.Create(AOwner: TComponent);
begin
  inherited CreateNew(AOwner);
  KeyPreview := True;

  Position := poScreenCenter;
  BSF := TbsBusinessSkinForm.Create(Self);
  DirTreeViewPanel := TbsSkinPanel.Create(Self);

  with DirTreeViewPanel do
  begin
    Parent := Self;
    Align := alClient;
    BorderStyle := bvFrame;
    Height := 200;
  end;

  VScrollBar := TbsSkinScrollBar.Create(Self);
  with VScrollBar do
  begin
    Kind := sbVertical;
    Parent := DirTreeViewPanel;
    Align := alRight;
    DefaultWidth := 19;
    Enabled := False;
    SkinDataName := 'vscrollbar';
  end;
  HScrollBar := TbsSkinScrollBar.Create(Self);
  with HScrollBar do
  begin
    Parent := DirTreeViewPanel;
    Align := alBottom;
    DefaultHeight := 19;
    Enabled := False;
    BothMarkerWidth := 19;
    SkinDataName := 'hscrollbar';
  end;

  DirTreeView := TbsSkinDirTreeView.Create(Self);
  with DirTreeView do
  begin
    Parent := DirTreeViewPanel;
    Align := alClient;
    HScrollBar := Self.HScrollBar;
    VScrollBar := Self.VScrollBar;
    HideSelection := False;
  end;

  BottomPanel := TbsSkinPanel.Create(Self);
  with BottomPanel do
  begin
    Parent := Self;
    Align := alBottom;
    BorderStyle := bvNone;
    Height := 50;
  end;

  OkButton := TbsSkinButton.Create(Self);
  with OkButton do
  begin
    Default := True;
    Caption := BS_MSG_BTN_OK;
    CanFocused := True;
    Left := 20;
    Top := 15;
    Width := 70;
    DefaultHeight := 25;
    Parent := BottomPanel;
    ModalResult := mrOk;
  end;

  CancelButton := TbsSkinButton.Create(Self);
  with CancelButton do
  begin
    Caption := BS_MSG_BTN_CANCEL;
    CanFocused := True;
    Left := 100;
    Top := 15;
    Width := 70;
    DefaultHeight := 25;
    Parent := BottomPanel;
    ModalResult := mrCancel;
    Cancel := True;
  end;
end;

constructor TbsSkinSelectDirectoryDialog.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FSkinMessage := nil;
  DialogWidth := 0;
  DialogHeight := 0;
  FAlphaBlend := False;
  FAlphaBlendAnimation := False;
  FAlphaBlendValue := 200;
  FTitle := 'Select folder';
  FDefaultFont := TFont.Create;
  with FDefaultFont do
  begin
    Name := 'Arial';
    Style := [];
    Height := 14;
  end;
  FDirectory := ''; 
end;

destructor TbsSkinSelectDirectoryDialog.Destroy;
begin
  FDefaultFont.Free;
  inherited Destroy;
end;


procedure TbsSkinSelectDirectoryDialog.SetDefaultFont;
begin
  FDefaultFont.Assign(Value);
end;

procedure TbsSkinSelectDirectoryDialog.Notification;
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = FSD) then FSD := nil;
  if (Operation = opRemove) and (AComponent = FCtrlFSD) then FCtrlFSD := nil;
  if (Operation = opRemove) and (AComponent = FSkinMessage)
  then
    FSkinMessage := nil;
end;

function TbsSkinSelectDirectoryDialog.GetTitle: string;
begin
  Result := FTitle;
end;

procedure TbsSkinSelectDirectoryDialog.SetTitle(const Value: string);
begin
  FTitle := Value;
end;

procedure TbsSkinSelectDirectoryDialog.Change;
begin
  if Assigned(FOnChange) then FOnChange(Self);
end;

function TbsSkinSelectDirectoryDialog.Execute: Boolean;
var
  FW, FH: Integer;
begin
  FDlgFrm := TbsSelDirDlgForm.Create(Application);
  with FDlgFrm do
  try
    Caption := Self.Title;
    BSF.BorderIcons := [];
    BSF.SkinData := FSD;
    BSF.MenusSkinData := CtrlSkinData;
    BSF.AlphaBlend := AlphaBlend;
    BSF.AlphaBlendAnimation := AlphaBlendAnimation;
    BSF.AlphaBlendValue := AlphaBlendValue;
    //
    DirTreeViewPanel.SkinData := FCtrlFSD;
    DirTreeView.DefaultFont := DefaultFont;
    DirTreeView.SkinData := FCtrlFSD;
    DirTreeView.SkinMessage := FSkinMessage;
//    DirTreeView.Color := clWindow;
    if FDirectory <> '' then DirTreeView.OpenPath(FDirectory);
    //
    HScrollBar.SkinData := FCtrlFSD;
    VScrollBar.SkinData := FCtrlFSD;
    OkButton.SkinData := FCtrlFSD;
    CancelButton.SkinData := FCtrlFSD;
    BottomPanel.SkinData := FCtrlFSD;
    OkButton.DefaultFont := DefaultFont;
    CancelButton.DefaultFont := DefaultFont;

    if (DialogWidth <> 0)
    then
      begin
        FW := DialogWidth;
        FH := DialogHeight;
      end
    else
      begin
        FW := 250;
        FH := 250;
      end;

    if (SkinData <> nil) and not SkinData.Empty
    then
      begin
        if FW < BSF.GetMinWidth then FW := BSF.GetMinWidth;
        if FH < BSF.GetMinHeight then FH := BSF.GetMinHeight;
      end;

    ClientWidth := FW;
    ClientHeight := FH;

    Result := (ShowModal = mrOk);

    DialogWidth := ClientW