⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 suisidechannel.pas

📁 SUIPack是一款为Delphi和C++Builder开发的所见即所得的界面增强VCL组件
💻 PAS
📖 第 1 页 / 共 2 页
字号:
procedure TsuiSideChannel.OnPinClick(Sender: TObject);
begin
    m_Timer.Enabled := not m_PinBtn.Down;
    m_PinBtn.Glyph.LoadFromResourceName(hInstance, 'SIDECHANNEL_BTN');
    if m_PinBtn.Down then
        RoundPicture3(m_PinBtn.Glyph);
    m_StayOn := m_PinBtn.Down;
    if m_StayOn then
    begin
        if Assigned(m_OnPin) then
            m_OnPin(self);
    end
    else
    begin
        if Assigned(m_OnUnPin) then
            m_OnUnPin(self);
    end;
end;

function TsuiSideChannel.GetSideWidth: Integer;
begin
    Result := 10;
end;

procedure TsuiSideChannel.SetAlign(const Value: TsuiSideChannelAlign);
begin
    m_Align := Value;

    if m_Align = suiLeft then
        inherited Align := alLeft
    else
        inherited Align := alRight;
end;

procedure TsuiSideChannel.SetStayOn(const Value: Boolean);
begin
    m_StayOn := Value;

    if Value then
    begin
        if not (csDesigning in ComponentState) then
            Pop(m_QuickMove);
        m_PinBtn.Down := true;
    end
    else
    begin
        m_PinBtn.Down := false;
        if not (csDesigning in ComponentState) then
            Push(true);
    end;
    Resize();
    if not (csDesigning in ComponentState) then
        m_PinBtn.Click();
end;

procedure TsuiSideChannel.Paint;
var
    Buf : TBitmap;
    R : TRect;
    Y : Integer;
begin
    Buf := TBitmap.Create();
    Buf.Width := inherited Width;
    Buf.Height := Height;

    Buf.Canvas.Brush.Color := Color;
    Buf.Canvas.Pen.Color := m_BorderColor;
    Buf.Canvas.Rectangle(ClientRect);

    R := Rect(1, 0, inherited Width - 1, m_TitleBitmap.Height);
    Buf.Canvas.StretchDraw(R, m_TitleBitmap);

    if m_Poped or (csDesigning in ComponentState) then
    begin
        R.Left := R.Left + m_PinBtn.Width;
        R.Right := R.Right - m_PinBtn.Width;
        Buf.Canvas.Font.Assign(Font);
        Buf.Canvas.Font.Color := m_CaptionFontColor;
        Buf.Canvas.Brush.Style := bsClear;
        case Alignment of
        taLeftJustify : DrawText(Buf.Canvas.Handle, PChar(Caption), -1, R, DT_LEFT or DT_SINGLELINE or DT_VCENTER);
        taCenter : DrawText(Buf.Canvas.Handle, PChar(Caption), -1, R, DT_CENTER or DT_SINGLELINE or DT_VCENTER);
        taRightJustify : DrawText(Buf.Canvas.Handle, PChar(Caption), -1, R, DT_RIGHT or DT_SINGLELINE or DT_VCENTER);
        end;
    end;

    R := Rect(1, m_TitleBitmap.Height, 9, Height - 1);
    Buf.Canvas.Brush.Color := m_SideColor;
    Buf.Canvas.FillRect(R);
    Buf.Canvas.Pen.Color := clGray;
    Buf.Canvas.MoveTo(9, m_TitleBitmap.Height);
    Buf.Canvas.LineTo(9, Height - 1);
    Y := (Height - m_HandleBitmap.Height) div 2;
    if Y < m_TitleBitmap.Height + 1 then
        Y := m_TitleBitmap.Height + 1;
    Buf.Canvas.Draw(1, Y, m_HandleBitmap);
    
    BitBlt(Canvas.Handle, 0, 0, Width, Height, Buf.Canvas.Handle, 0, 0, SRCCOPY);

    Buf.Free();
end;

procedure TsuiSideChannel.Resize;
begin
    inherited;

    if (
        (not m_bMoving) and
        (inherited Width > 10)
    ) then
    begin
        m_nWidth := inherited Width;
    end;

    m_PinBtn.Left := Width - m_PinBtn.Width - 1; 
end;

function TsuiSideChannel.CanResize(var NewWidth,
  NewHeight: Integer): Boolean;
begin
    if (
        (not m_bMoving) and
        (m_PinBtn.Visible) and
        (NewWidth < 50)
    ) then
        Result := false
    else
        Result := true;
end;

procedure TsuiSideChannel.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
    inherited;
    if (
        (Operation = opRemove) and
        (AComponent = m_FileTheme)
    )then
    begin
        m_FileTheme := nil;
        ContainerApplyUIStyle(self, SUI_THEME_DEFAULT, nil);
        SetUIStyle(SUI_THEME_DEFAULT);          
    end;
end;

procedure TsuiSideChannel.SetFileTheme(const Value: TsuiFileTheme);
begin
    m_FileTheme := Value;
    m_FromTheme := true;
    SetUIStyle(m_UIStyle);
    m_FromTheme := false;
end;

procedure TsuiSideChannel.SetUIStyle(const Value: TsuiUIStyle);
var
    OutUIStyle : TsuiUIStyle;
    Tmp : TBitmap;
begin
    m_UIStyle := Value;

    if m_FromTheme and (m_UIStyle <> FromThemeFile) then
        Exit;    

    Color := clWhite;
    if UsingFileTheme(m_FileTheme, m_UIStyle, OutUIStyle) then
    begin
        m_SideColor := m_FileTheme.GetColor(SKIN2_FORMCOLOR);
        Tmp := m_FileTheme.GetBitmap(SKIN2_SIDECHANNELBAR);
        if Tmp <> nil then
            m_HandleBitmap.Assign(Tmp)
        else
            GetInsideThemeBitmap(SUI_THEME_DEFAULT, SUI_THEME_SIDECHENNEL_HANDLE_IMAGE, m_HandleBitmap);
        Tmp := m_FileTheme.GetBitmap(SKIN2_SIDECHANNELTITLE);
        if Tmp <> nil then
            m_TitleBitmap.Assign(Tmp)
        else
            GetInsideThemeBitmap(SUI_THEME_DEFAULT, SUI_THEME_SIDECHENNEL_BAR_IMAGE, m_TitleBitmap);
        m_BorderColor := m_FileTheme.GetColor(SKIN2_SIDECHANNELBORDERCOLOR);
        m_CaptionFontColor := m_FileTheme.GetColor(SKIN2_CONTROLFONTCOLOR);
    end
    else
    begin
        m_SideColor := GetInsideThemeColor(OutUIStyle, SUI_THEME_FORM_BACKGROUND_COLOR);
        GetInsideThemeBitmap(OutUIStyle, SUI_THEME_SIDECHENNEL_HANDLE_IMAGE, m_HandleBitmap);
        GetInsideThemeBitmap(OutUIStyle, SUI_THEME_SIDECHENNEL_BAR_IMAGE, m_TitleBitmap);
        m_BorderColor := GetInsideThemeColor(OutUIStyle, SUI_THEME_CONTROL_BORDER_COLOR);
{$IFDEF RES_MACOS}
        if OutUIStyle = MacOS then
            m_CaptionFontColor := clBlack
        else
{$ENDIF}        
            m_CaptionFontColor := GetInsideThemeColor(OutUIStyle, SUI_THEME_MENU_SELECTED_FONT_COLOR);
    end;
    if m_ShowButton then
        m_PinBtn.Top := Min((m_TitleBitmap.Height - m_PinBtn.Height) div 2, 5)
    else
    begin
        m_PinBtn.Top := -50;
        StayOn := True;
    end;

    ContainerApplyUIStyle(self, OutUIStyle, m_FileTheme);

    Repaint();
end;

procedure TsuiSideChannel.SetBorderColor(const Value: TColor);
begin
    m_BorderColor := Value;
    Repaint();
end;

procedure TsuiSideChannel.SetCaptionFontColor(const Value: TColor);
begin
    m_CaptionFontColor := Value;
    Repaint();
end;

procedure TsuiSideChannel.AlignControls(AControl: TControl;
  var Rect: TRect);
begin
    Rect.Right := Rect.Right - 3;
    Rect.Bottom := Rect.Bottom - 3;
    Rect.Top := Rect.Top + m_TitleBitmap.Height + 3;
    Rect.Left := Rect.Left + 13;
    inherited AlignControls(AControl, Rect);
end;

procedure TsuiSideChannel.MouseMove(Shift: TShiftState; X, Y: Integer);
var
    Form : TCustomForm;
begin
    inherited;

    if m_bMoving then
        Exit;

    if (
        m_Poped or
        (m_PopupMode <> suiMouseOn)
    ) then
        Exit;
    Form := GetParentForm(self);
    if Form = nil then
        Exit;
    if (not Form.Active) and ((Form as TForm).FormStyle <> fsMDIForm) then
        Exit;
    if not FormHasFocus(Form) then
        Exit;
    Pop(m_QuickMove);
end;

procedure TsuiSideChannel.SetSideWidth(const Value: Integer);
begin
    // do nothing
end;

procedure TsuiSideChannel.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
    inherited;

    if m_Poped or (m_PopupMode <> suiMouseClick) then
        Exit;

    Pop(m_QuickMove);
end;

procedure TsuiSideChannel.SetHandleBitmap(const Value: TBitmap);
begin
    m_HandleBitmap.Assign(Value);
    Repaint();
end;

procedure TsuiSideChannel.SetTitleBitmap(const Value: TBitmap);
begin
    m_TitleBitmap.Assign(Value);
    Repaint();
end;

procedure TsuiSideChannel.WMERASEBKGND(var Msg: TMessage);
begin
    // do nothing
end;

procedure TsuiSideChannel.CMTextChanged(var Msg: TMessage);
begin
    Repaint();
end;

procedure TsuiSideChannel.SetShowButton(const Value: Boolean);
begin
    m_ShowButton := Value;
    if Value then
    begin
        m_PinBtn.Top := 1;
    end
    else
    begin
        m_PinBtn.Top := -50;
        StayOn := True;
    end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -