bsskinshellctrls.pas

布林电话收费管理系统

  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;

function TbsSkinDirTreeView.AddNewNode(ParentNode: TTreeNode;
  NodeName: string): Boolean;
var
  Path: string;
  Dir: string;
  NewNode: TTreeNode;
begin
  Result := False;
  if ParentNode = nil then
    ParentNode := Selected;
  if ParentNode.Level = 0 then
  begin
    MessageDlg('不能添加驱动器', mtError, [mbOK], 0);
    exit;
  end;

  if NodeName = '' then
  begin
    NodeName := '新建 文件夹';
    FIsNewFolder := True;
  end;
  try
    Path := GetPathFromNode(ParentNode);
    if Path = '' then exit;
    Path := AddSlash(Path);
    Dir := Path + NodeName;

    if StrContains(InvalidDosChars, NodeName) then
    begin
      MessageBeep(MB_ICONHAND);
      MessageDlg('文件夹名称包含非法字符!', mtError, [mbOK], 0);
      exit;
    end;
    Items.BeginUpdate;

    Result := CreateDirectory(PChar(Dir), nil);

    if Result then
    begin
      ReLoad;
      Dir := AddSlash(Dir);
      OpenPath(Dir);
      NewNode := Selected;
      if (NewNode <> nil) and (NodeName = '新建 文件夹') then
        NewNode.EditText;
    end;
  finally
    Items.EndUpdate;
  end;
end; {AddNewNode}


function TbsSkinDirTreeView.DeleteNode(Node: TTreeNode): Boolean;
var
  DelDir: string;
  DelPath: string;
  PrevNode: TTreeNode;
  oldCur: TCursor;
  Aborted: Boolean;
begin
  Result := False;
  Aborted := True;
  PrevNode := Node.Parent;
  if (Assigned(Node)) and (Node.Level > 1) then
  begin
    oldCur := Screen.Cursor;
    Screen.Cursor := crHourGlass;
    if Selected <> nil then
      DelDir := GetPathFromNode(Selected);
    if DelDir = '' then exit;
    if not DirectoryExists(Deldir) then
    begin
      MessageBeep(MB_ICONHAND);
      MessageDlg(DelDir + '不存在', mtError, [mbOK], 0);
      Screen.Cursor := oldCur;
      Exit;
    end;
    DelDir := DelSlash(Deldir);
    DelPath := ExtractFilePath(DelDir);
    Result := DoSHFileOp(Parent.Handle, FO_DELETE, DelDir, '', Aborted);
    if Result then
    begin
      if Assigned(PrevNode) then
        Selected := PrevNode;
      Node.Delete;
    end;
    Screen.Cursor := oldCur;
  end;
end;

procedure TbsSkinDirTreeView.CutOrCopyNode(Mode: integer); 
begin
  FOpMode := -1;
  if (Selected = nil) or (FSelectedPath = '') then
    exit;
  FSrcPath := FSelectedPath;
  FOpMode := Mode;
  FisCutCopy := True;
end;

procedure TbsSkinDirTreeView.PasteNode; 
var
  Abort: Boolean;
begin
  if (Selected = nil) or (FSelectedPath = '') or
    (FSrcPath = '') then
  begin
    FisCutCopy := False;
    exit;
  end;
  Abort := False;
  FDestPath := AddSlash(FSelectedPath);
  if DoSHFileOp(Parent.Handle, FileOpMode[FOpMode], FSrcPath, FDestPath, Abort) then
  begin
    Reload;
    OpenPath(FDestPath)
  end else
    MessageDlg('文件操作失败', mtError, [mbOK], 0);
  FisCutCopy := False;
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;
//  BorderStyle := bsDialog;
  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 := '确定';
    CanFocused := True;
    Left := 20;
    Top := 15;
    Width := 70;
    DefaultHeight := 25;
    Parent := BottomPanel;
    ModalResult := mrOk;
  end;

  CancelButton := TbsSkinButton.Create(Self);
  with CancelButton do
  begin
    Caption := '取消';
    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);
  DialogWidth := 0;
  DialogHeight := 0;
  FAlphaBlend := False;
  FAlphaBlendAnimation := False;
  FAlphaBlendValue := 200;
  FTitle := '选择文件夹';
  FDefaultFont := TFont.Create;
  with FDefaultFont do
  begin
    Name := '宋体';
    Style := [];
    Height := 12;
  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;
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.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