suititlebar.pas

Delphi界面控件修饰

    UIStyle := GetSUIFormStyle(AOwner)
end;

procedure TsuiTitleBar.SetLeftBtnXOffset(const Value: Integer);
begin
    m_LeftBtnXOffset := Value;

    Repaint();
end;

procedure TsuiTitleBar.SetRightBtnXOffset(const Value: Integer);
begin
    m_RightBtnXOffset := Value;

    Repaint();
end;

procedure TsuiTitleBar.DblClick;
var
    i : Integer;
    ParentForm : TCustomForm;
begin
    inherited;

    if m_InButtons <> -1 then
    begin
        if m_Buttons.Items[m_InButtons].ButtonType = suiControlBox then
        begin
            ParentForm := GetParentForm(self);
            if ParentForm <> nil then
                ParentForm.Close();
        end;

        Exit;
    end;

    for i := 0 to m_Buttons.Count - 1 do
    begin
        if m_Buttons.Items[i].ButtonType = suiMax then
        begin
            m_Buttons.Items[i].DoClick();
            Exit;
        end;
    end;
end;

destructor TsuiTitleBar.Destroy();
begin
    m_Buttons.Free();
    m_Buttons := nil;

    m_Sections.Free();
    m_Sections := nil;

    m_DefPopupMenu.Free();
    m_DefPopupMenu := nil;

    inherited Destroy();
end;

procedure TsuiTitleBar.DrawButtons(Buf: TBitmap);
var
    i : Integer;
    Btn : TsuiTitleBarButton;
    nControlBox : Integer;
    BtnRect : TRect;
    nLeft : Integer;
    nLeft2 : Integer;
    MousePoint : TPoint;
    BtnBuf : TBitmap;
    Cap : String;
    Icon : TIcon;
    CaptionHeight : Integer;
begin
    nLeft := Buf.Width + 1 + m_RightBtnXOffset;
    nControlBox := -1;

    BtnBuf := TBitmap.Create();

    GetCursorPos(MousePoint);
    MousePoint := ScreenToClient(MousePoint);
    m_InButtons := -1;

    for i := 0 to m_Buttons.Count - 1 do
    begin
        Btn := m_Buttons.Items[i];
        if not Btn.Visible then
            continue;

        BtnBuf.Width := Btn.PicNormal.Width;
        BtnBuf.Height := Btn.PicNormal.Height;
        BtnBuf.Transparent := Btn.Transparent;

        if Btn.ButtonType = suiControlBox then
        begin
            nControlBox := i;
            continue;
        end;

        Dec(nLeft, Btn.PicNormal.Width + 1 + m_ButtonInterval);

        BtnRect := Rect(nLeft, Btn.Top, nLeft + Btn.PicNormal.Width, Btn.Top + Btn.PicNormal.Height);
        if InRect(MousePoint, BtnRect) then
        begin
            m_InButtons := i;

            if m_MouseDown then
            begin
                if Btn.PicMouseDown <> nil then
                    BtnBuf.Canvas.Draw(0, 0, Btn.PicMouseDown.Graphic)
            end
            else
            begin
                if Btn.PicMouseOn <> nil then
                    BtnBuf.Canvas.Draw(0, 0, Btn.PicMouseOn.Graphic);
            end;
        end
        else
            BtnBuf.Canvas.Draw(0, 0, Btn.PicNormal.Graphic);

        Buf.Canvas.Draw(nLeft, Btn.Top, BtnBuf);
    end;

    nLeft2 := 0 + m_LeftBtnXOffset;

    if nControlBox <> -1 then
    begin
        Btn := m_Buttons.Items[nControlBox];

        BtnRect := Rect(nLeft2, Btn.Top, nLeft2 + Btn.PicNormal.Width, Btn.Top + Btn.PicNormal.Height);
        
        if not m_DrawAppIcon then
        begin
            BtnBuf.Width := Btn.PicNormal.Width;
            BtnBuf.Height := Btn.PicNormal.Height;
            BtnBuf.Transparent := Btn.Transparent;

            if InRect(MousePoint, BtnRect) then
            begin
                m_InButtons := nControlBox;

                if m_MouseDown then
                    BtnBuf.Canvas.Draw(0, 0, Btn.PicMouseDown.Graphic)
                else
                    BtnBuf.Canvas.Draw(0, 0, Btn.PicMouseOn.Graphic);
            end
            else
                BtnBuf.Canvas.Draw(0, 0, Btn.PicNormal.Graphic);
            Buf.Canvas.Draw(nLeft2, Btn.Top, BtnBuf);
            Inc(nLeft2, Btn.PicNormal.Width + 5);
        end
        else
        begin
            if InRect(MousePoint, BtnRect) then
                m_InButtons := nControlBox;

            BtnBuf.Height := 16;
            BtnBuf.Width := 16;
            Icon := TIcon.Create();
            Icon.Handle := LoadImage(hInstance, 'MAINICON', IMAGE_ICON, 16, 16, LR_DEFAULTCOLOR);
            Buf.Canvas.Draw(nLeft2 + 3, Btn.Top, Icon);
            Icon.Free();
            Inc(nLeft2, 21);
        end;
    end;

    if nLeft2 = 0 then
        Inc(nLeft2, 6);

    if not m_Active then
        Buf.Canvas.Font.Color := clInactiveCaption;

    if Buf.Canvas.TextWidth(Caption) > nLeft - nLeft2 then
    begin
        Cap := Caption;
        while Buf.Canvas.TextWidth(Cap + '...') > nLeft - nLeft2 do
            SetLength(Cap, Length(Cap) - 1);
        Cap := Cap + '...'
    end
    else
        Cap := Caption;

    CaptionHeight := Buf.Canvas.TextHeight(Cap);


    Buf.Canvas.TextOut(nLeft2, m_BtnTop + (m_BtnHeight - CaptionHeight) div 2, Cap);

    BtnBuf.Free();
end;

function TsuiTitleBar.InForm: Boolean;
begin
    if (
        (Parent is TsuiForm) and
        (Parent <> nil)
    ) then
        Result := true
    else
        Result := false;
end;

procedure TsuiTitleBar.SetDrawAppIcon(const Value: Boolean);
begin
    m_DrawAppIcon := Value;

    Repaint();
end;

procedure TsuiTitleBar.DrawSectionsTo(Buf: TBitmap);
var
    i : Integer;
    nLeft, nRight : Integer;
    Sec : TsuiTitleBarSection;
    R : TRect;
    nClient : Integer;
begin
    nLeft := -1;
    nRight := Buf.Width + 1;
    nClient := -1;

    for i := 0 to m_Sections.Count - 1 do
    begin
        Sec := m_Sections.Items[i];

        case Sec.Align of

        suiLeft :
        begin

            if Sec.Stretch then
            begin
                if Sec.Picture <> nil then
                begin
                    R := Rect(nLeft + 1, 0, nLeft + 1 + Sec.Width, Buf.Height);
                    Buf.Canvas.StretchDraw(R, Sec.Picture.Graphic);
                end
            end
            else
            begin
                if Sec.Picture <> nil then
                    BitBlt(Buf.Canvas.Handle, nLeft + 1, 0, nLeft + 1 + Sec.Width, Buf.Height, Sec.Picture.Bitmap.Canvas.Handle, 0, 0, SRCCOPY);
            end;
            Inc(nLeft, Sec.Width);
        end; // suiLeft

        suiRight :
        begin
            if Buf.Width - nLeft < Sec.Width then
                continue;

            if Sec.Stretch then
            begin
                if Sec.Picture <> nil then
                begin
                    R := Rect(nRight - 1 - Sec.Width, 0, nRight - 1, Buf.Height);
                    Buf.Canvas.StretchDraw(R, Sec.Picture.Graphic);
                end;
            end
            else
            begin
                if Sec.Picture <> nil then
                    BitBlt(Buf.Canvas.Handle, nRight - 1 - Sec.Width, 0, nRight - 1, Buf.Height, Sec.Picture.Bitmap.Canvas.Handle, 0, 0, SRCCOPY);
            end;
            Dec(nRight, Sec.Width);
        end; // suiRight

        suiClient :
        begin
            nClient := i;
        end; // suiClient

        end; // case
    end; // for

    if nClient = -1 then
        Exit;

    Sec := m_Sections.Items[nClient];
    if Sec.Picture <> nil then
    begin
        R := Rect(nLeft + 1, 0, nRight - 1, Buf.Height);
        Buf.Canvas.StretchDraw(R, Sec.Picture.Graphic);
    end;
end;

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

    if Button <> mbLeft then
        Exit;

    m_MouseDown := true;
    Repaint();

    if (
        (m_InButtons = -1) and
        (GetParentForm(self).WindowState <> wsMaximized)
    ) then
    begin
        ReleaseCapture();
        SendMessage(GetParentForm(self).Handle, WM_NCLBUTTONDOWN, HTCAPTION, 0);
        m_MouseDown := false;
    end;
end;

procedure TsuiTitleBar.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
    inherited;

    Repaint();
end;

procedure TsuiTitleBar.MouseOut(var Msg: TMessage);
begin
    inherited;

    Repaint();
end;

procedure TsuiTitleBar.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
var
    Point : TPoint;
    InButtons : Integer;
begin
    inherited;

    if Button <> mbLeft then
        Exit;
    InButtons := m_InButtons;
    if InButtons <> -1 then
    begin
        if (
            (m_Buttons.Items[InButtons].ButtonType = suiControlBox) and
            (m_Buttons.Items[InButtons].ControlBoxMenu = nil)
        ) then
        begin
            Point.X := 0;
            Point.Y := Height;
            Point := ClientToScreen(Point);
            m_DefPopupMenu.Popup(Point.X, Point.Y);
        end
        else
        begin
            m_Buttons.Items[InButtons].DoClick();
            if (
                Assigned(m_OnBtnClick) and
                (m_Buttons.Items[InButtons].ButtonType = suiCustom)
            ) then
                m_OnBtnClick(self, InButtons)

            else if(
                Assigned(m_OnHelpBtnClick) and
                (m_Buttons.Items[InButtons].ButtonType = suiHelp)
            ) then
                m_OnHelpBtnClick(self, InButtons);
        end;
    end;
    m_MouseDown := false;
    Repaint();
end;

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

procedure TsuiTitleBar.Paint;
var
    Buf : TBitmap;
begin
    Buf := TBitmap.Create();
    Buf.Canvas.Brush.Style := bsClear;
    Buf.Canvas.Font := Font;

    try
        Buf.Width := Width;
        Buf.Height := Height;

        DrawSectionsTo(Buf);
        DrawButtons(Buf);

        if {$IFDEF RES_WINXP}(UIStyle <> WinXP){$ELSE} True {$ENDIF} and (RoundCorner <> 0) then
        begin
            if InForm() then
            begin
                Buf.Canvas.Pen.Color := m_BorderColor;
                Buf.Canvas.RoundRect(-1, 0, Buf.Width + 1, Buf.Height + 50, RoundCorner + 1, RoundCorner);
            end;
        end;
        BitBlt(Canvas.Handle, 0, 0, Buf.Width, Buf.Height, Buf.Canvas.Handle, 0, 0, SRCCOPY);

    finally
        Buf.Free();
    end;
end;

procedure TsuiTitleBar.OnFormReSize;
begin
    if InForm() then
        SetFormRoundCorner(m_RoundCorner);
end;

procedure TsuiTitleBar.SetActive(const Value: Boolean);
begin
    m_Active := Value;

    Repaint();
end;