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

      Moderator
      *******
      Профиль · PM
      Поощрения: 4 Dgm
      Рейтинг (т): 320
      Форма, стиль выставлен таким образом чтобы появились боковые скроллы у формы. Далее пишется вот такой код, который помещает кнопку на пересечении двух сткроллов. Модифицируй его чтобы перерисовывал и область со скролами:

      ExpandedWrap disabled
        unit Unit26;
         
        interface
         
        uses
          Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
          Dialogs, ExtCtrls, StdCtrls;
         
        type
          TForm26 = class(TForm)
            Panel1: TPanel;
            Button1: TButton;
            procedure FormCreate(Sender: TObject);
            procedure FormResize(Sender: TObject);
          private
            Btn : TRect;
            FButtonDown, FButtonHot: Boolean;
            procedure DrawButton;
            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
          Form26: TForm26;
         
        implementation
         
        {$R *.dfm}
         
        uses
          Themes, Buttons, Types;
         
        const
          htCaptionBtn = htSizeLast + 1;
         
        procedure TForm26.DrawButton;
        var
          FrameWidth,
          FrameHeight,
          BtnWidth,
          BtnHeight  : Integer;
          TmpCanvas: TCanvas;
          BtnCaption: String;
          Details: TThemedElementDetails;
        begin
          FrameWidth := GetSystemMetrics(SM_CXBORDER);
          FrameHeight := GetSystemMetrics(SM_CYBORDER);
          // Смотрим - какого размера должна быть кнопка
          BtnWidth  := GetSystemMetrics(SM_CXHSCROLL);
          BtnHeight  := GetSystemMetrics(SM_CYHSCROLL);
          // Определяем позицию новой кнопки
          Btn := Bounds(Width - BtnWidth - FrameWidth - 4,
            Height - BtnHeight - FrameHeight - 4, BtnWidth, BtnHeight);
          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;
              // Отрисовка кнопки в случае если используются темы Windows
              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, Btn);
              end
              else
              begin // А так рисуем если темы отсутствуют
                // Рисуем кнопку
                DrawButtonFace(TmpCanvas, Btn, 1, bsAutoDetect, False, FButtonDown, False);
              end;
              // Определяем координаты текста на ней
              BtnCaption := 'Z';
              Btn.Left := Btn.Left +
                ((Btn.Right - Btn.Left - TmpCanvas.TextWidth(BtnCaption)) div 2);
              Btn.Top := Btn.Top +
                ((Btn.Bottom - Btn.Top - TmpCanvas.TextHeight(BtnCaption)) div 2);
              // рисуем текст
              TmpCanvas.Brush.Style := bsClear;
              with Btn do
                TmpCanvas.TextRect(Btn, Left, Top, BtnCaption);
            finally
              ReleaseDC(Handle, TmpCanvas.Handle);
            end;
          finally
            TmpCanvas.Free;
          end;
        end;
         
        procedure TForm26.FormCreate(Sender: TObject);
        begin
          FButtonDown := False;
        end;
         
        procedure TForm26.FormResize(Sender: TObject);
        begin
          Perform(WM_NCACTIVATE, Word(Active), 0);
        end;
         
        procedure TForm26.WMNCActivate(var Msg: TWMNCActivate);
        begin
          inherited;
          DrawButton;
        end;
         
        procedure TForm26.WMNCHitTest(var Msg: TWMNCHitTest);
        begin
          inherited;
          with Msg do
          begin
            FButtonHot := PtInRect(Btn, Point(XPos - Left, YPos - Top));
            if FButtonHot then Result := htCaptionBtn;
          end;
        end;
         
        procedure TForm26.WMNCLButtonDown(var Msg: TWMNCLButtonDown);
        begin
          inherited;
          if (Msg.HitTest = htCaptionBtn) then
          begin
            FButtonDown := True;
            DrawButton;
            // Тут добавить обработку нажатия кнопки
          end;
        end;
         
        procedure TForm26.WMNCLButtonUp(var Msg: TWMNCLButtonUp);
        begin
          inherited;
          FButtonDown := False;
          DrawButton;
        end;
         
        procedure TForm26.WMNCmouseMove(var Msg: TWMNCMouseMove);
        begin
          inherited;
          with Msg do
          begin
            FButtonHot := PtInRect(Btn, Point(XCursor - Left, YCursor - Top));
            DrawButton;
          end;
        end;
         
        procedure TForm26.WMNCPaint(var Msg: TWMNCPaint);
        begin
          inherited;
          DrawButton;
        end;
         
        procedure TForm26.WMSetText(var Msg: TWMSetText);
        begin
          inherited;
          DrawButton;
        end;
         
        end.
      0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
      0 пользователей:


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