На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Поиск Участники Календарь Избранное RSS
msm.ru
Модераторы: jack128, Rouse_, Krid
  
    > Отрисовка кнопки на заголовке формы , Включена поддержка тем XP
    Guru Rouse_
    Сообщ. #1 ,

      Moderator
      *******
      Профиль · PM
      Поощрения: 4 Dgm
      Рейтинг (т): 320
      ExpandedWrap disabled
        unit Unit1;
         
        interface
         
        uses
          Windows, Buttons, Messages, SysUtils, Classes, Graphics, Controls, Forms,
          Dialogs, Themes, XPMan;
         
        const
          htCaptionBtn = htSizeLast + 1;
         
        type
          TForm1 = class(TForm)
            XPManifest1: TXPManifest;
            procedure FormResize(Sender: TObject);
            procedure FormCreate(Sender: TObject);
          private
            CaptionBtn : TRect;
            FButtonDown, FButtonHot: Boolean;
            procedure DrawCaptButton;
            procedure WMNCPaint(var Msg : TWMNCPaint); message WM_NCPaint;
            procedure WMNCActivate(var Msg : TWMNCActivate); message WM_NCACTIVATE;
            procedure WMSetText(var Msg : TWMSetText); message WM_SETTEXT;
            procedure WMNCHitTest(var Msg : TWMNCHitTest); message WM_NCHITTEST;
            procedure WMNCLButtonDown(var Msg : TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
            procedure WMNCLButtonUp(var Msg : TWMNCLButtonUp); message WM_NCLBUTTONUP;
            procedure WMNCmouseMove(var Msg : TWMNCMouseMove); message WM_NCMOUSEMOVE;
          end;
         
        var
          Form1: TForm1;
         
        implementation
         
        uses Types;
         
        {$R *.dfm}
         
        procedure TForm1.DrawCaptButton;
        var
          FrameWidth,
          FrameHeight,
          BtnWidth,
          BtnHeight  : Integer;
          TmpCanvas: TCanvas;
          BtnCaption: String;
          Details: TThemedElementDetails;
        begin
          // Смотрим размеры бордюра
          // (при помощи которого производится изменение размеров формы)
          FrameWidth := GetSystemMetrics(SM_CXFRAME);
          FrameHeight := GetSystemMetrics(SM_CYFRAME);
          // Смотрим - какого размера должна быть кнопка на заголовке
          BtnWidth  := GetSystemMetrics(SM_CXSIZE);
          BtnHeight  := GetSystemMetrics(SM_CYSIZE);
          // Определяем позицию новой кнопки
          CaptionBtn := Bounds(Width - FrameWidth - 4 * BtnWidth + 2,
            FrameHeight + 2, BtnWidth - 2, BtnHeight - 4);
          TmpCanvas := TCanvas.Create;
          try
            // Получаем ссылку на канвас всего окна
            // (Form.Canvas - указывает на канвас только клиентской области)
            TmpCanvas.Handle := GetWindowDC(Handle);
            try
              TmpCanvas.Font.Color := clBlue;
              TmpCanvas.Font.Style := [fsBold];
              TmpCanvas.Pen.Color := clYellow;
              TmpCanvas.Brush.Color := clBtnFace;
              // Если включена поддержка тем в приложении - то рисуем в новом стиле
              if ThemeServices.ThemesEnabled and (not(csDesigning in ComponentState)) then
              begin
                if FButtonDown then
                  Details := ThemeServices.GetElementDetails(tbPushButtonPressed)
                else
                  if FButtonHot then
                    Details := ThemeServices.GetElementDetails(tbPushButtonHot)
                  else
                    Details := ThemeServices.GetElementDetails(tbPushButtonNormal);
                ThemeServices.DrawElement(TmpCanvas.Handle, Details, CaptionBtn);
              end
              else
              begin
                // или рисуем так как рисует кнопки Windows 98
                DrawButtonFace(TmpCanvas, CaptionBtn, 1, bsAutoDetect, False, FButtonDown, False);
              end;
              // Определяем координаты текста на ней
              BtnCaption := 'Z';
              CaptionBtn.Left := CaptionBtn.Left +
                ((CaptionBtn.Right - CaptionBtn.Left - TmpCanvas.TextWidth(BtnCaption)) div 2);
              CaptionBtn.Top := CaptionBtn.Top +
                ((CaptionBtn.Bottom - CaptionBtn.Top - TmpCanvas.TextHeight(BtnCaption)) div 2);
              // рисуем текст
              TmpCanvas.Brush.Style := bsClear;
              with CaptionBtn do
                TmpCanvas.TextRect(CaptionBtn, Left, Top, BtnCaption);
            finally
              ReleaseDC(Handle, TmpCanvas.Handle);
            end;
          finally
            TmpCanvas.Free;
          end;
        end;
         
        procedure TForm1.WMNCActivate(var Msg: TWMNCActivate);
        begin
          inherited;
          DrawCaptButton;
        end;
         
        procedure TForm1.WMNCPaint(var Msg: TWMNCPaint);
        begin
          inherited;
          DrawCaptButton;
        end;
         
        procedure TForm1.FormResize(Sender: TObject);
        begin
          Perform(WM_NCACTIVATE, Word(Active), 0);
        end;
         
        procedure TForm1.WMSetText(var Msg: TWMSetText);
        begin
          inherited;
          DrawCaptButton;
        end;
         
        procedure TForm1.WMNCHitTest(var Msg: TWMNCHitTest);
        begin
          inherited;
          with Msg do
          begin
            FButtonHot := PtInRect(CaptionBtn, Point(XPos - Left, YPos - Top));
            if FButtonHot then Result := htCaptionBtn;
          end;
        end;
         
        procedure TForm1.WMNCLButtonDown(var Msg: TWMNCLButtonDown);
        begin
          inherited;
          if (Msg.HitTest = htCaptionBtn) then
          begin
            FButtonDown := True;
            DrawCaptButton;
            // Тут добавить обработку нажатия кнопки
          end;
        end;
         
        procedure TForm1.WMNCLButtonUp(var Msg: TWMNCLButtonDown);
        begin
          inherited;
          FButtonDown := False;
          DrawCaptButton;
        end;
         
        procedure TForm1.FormCreate(Sender: TObject);
        begin
          FButtonDown := False;
        end;
         
        procedure TForm1.WMNCmouseMove(var Msg: TWMNCMouseMove);
        begin
          inherited;
          with Msg do
          begin
            FButtonHot := PtInRect(CaptionBtn, Point(XCursor - Left, YCursor - Top));
            DrawCaptButton;
          end;
        end;
         
        end.
      0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
      0 пользователей:


        Рейтинг@Mail.ru
        [ Script execution time: 0,0443 ]   [ 16 queries used ]   [ Generated: 27.04.24, 09:11 GMT ]  
        Powered by Invision Power Board(U) v1.2 © 2003  IPS, Inc.