Программирование на Delphi

Практика
Ребрендинг Edit'a и Memo дизайнерским напильником

:: Меню ::

:: На главную ::

:: FAQ ::

:: Заметки ::

:: Практика ::

:: Win API ::

:: Проекты ::

:: Скачать ::

:: Секреты ::

:: Ссылки ::

:: Сервис ::

:: Написать ::

:: MVP ::

:: RSS ::

Периодически в интернете на сайтах встречаются формы, в которых текстовые поля имеют фон, что визуально делает форму более привлекательной. Или другой момент – форма аутентификации. Можно разместить текстовую надпись, поясняющую назначение поля, рядом с полем ввода текста, а можно внутри него. Второй вариант выгладит более симпатично, и к тому же еще экономит место. Неплохо бы научиться делать так и в Delphi.

В своих приложениях я использую этот прием в ситуации, когда на форме есть обязательные для заполнения поля, в этом случае я вывожу на фоне компонента соответствующую надпись. Далее я расскажу о том, как я это делаю, и о “подводных камнях”, встретившихся мне на пути. Пример к статье я буду писать, используя технологию подмены класса, так что если кто с ней еще не знаком, читаем статью "Технология подмены класса".

Для начала решим основную задачу – вывод изображения на фоне компонента TEdit.

unit BackgroundEdit;

interface

uses
  Windows, Messages, Classes, StdCtrls, Graphics, Controls;

type
  TEdit = class( StdCtrls.TEdit )
  private
    Bitmap: TBitmap;
    hbs: Cardinal;
  protected
    procedure WndProc( var Message: TMessage ); override;
  public
    constructor Create( AOwner: TComponent ); override;
    destructor Free;
  end;

implementation

{ TEdit }

constructor TEdit.Create(AOwner: TComponent);
begin
   inherited;
   Bitmap := TBitmap.Create;
   Bitmap.LoadFromFile( 'Background.bmp' );
   hbs := CreatePatternBrush( Bitmap.Handle );
end;

destructor TEdit.Free;
begin
   DeleteObject( hbs );
   Bitmap.Free;
end;

procedure TEdit.WndProc(var Message: TMessage);
begin
   inherited;

   if Message.Msg = CN_CTLCOLOREDIT then
   begin
      SetBkMode( Message.WParam, TRANSPARENT );
      Message.Result := hbs;
   end;
end;

end.

Все гениальное просто, красивое и элегантное решение! На основе битмапа создаем кисть, которую применяем при получении сообщения CN_CTLCOLOREDIT. Протестировав код в Windows 2000/XP убеждаемся, что все работает как надо, причем как в обычном приложении, так и в MDI.

А вот при тестировании кода в Windows Vista и выше начинаются сюрпризы. Для начала разберемся с обычным приложением. Потаскаем форму по рабочему столу, причем сделаем это так, чтобы форма с расположенными на ней Edit’ами выходила за край монитора. Мы увидим, что фон Edit’а стал смазанным, он почему-то не перерисовывается. Но вот если на Edit навести курсор мыши, все становится нормально. Вывод напрашивается сам собой – нужно писать код, зависящий от платформы. Но это чуть позже, а пока надо решить проблему, и решение оказывается достаточно простым.

procedure TEdit.WndProc(var Message: TMessage);
begin
   inherited;

   if Message.Msg = CN_CTLCOLOREDIT then
   begin
      SetBkMode( Message.WParam, TRANSPARENT );
      Message.Result := hbs;
   end;

   if Message.Msg = WM_ERASEBKGND then
      InvalidateRect( Handle, nil, false );
end;

Все что нужно сделать – перерисовать компонент при получении им сообщения WM_ERASEBKGND. Ну а как же обстоят дела с MDI приложениями. Проверяем и видим, что сюрпризы для нас еще не закончены (Microsoft любит удивлять!). Чтобы увидеть сюрприз, возьмем дочернюю форму и переместим ее так, чтобы она, вместе с расположенными на ней Edit’ами, вышла за левый край формы. Пока все нормально, начинаем перетаскивать форму обратно. То, что начинает происходить, лучше один раз увидеть! Компонент начинает перерисовываться, и фон рисуется не от левого края компонента (который еще скрыт за левой границей родительской формы), а от начала видимой части компонента (той, которая не скрыта за левой границей формы). По мере “выезжания” формы фон смещается к началу компонента, создается эффект анимации – фоновое изображение скользит по канве компонента. Такого же эффекта можно добиться, если перекрыть форму с Edit'ами другой формой, “заехав” на текстовые поля с левой стороны.

Первые впечатления повергают в глубокий ступор, приходящее в последствии осознание абсурда происходящего усиливает это состояние. Меня до сих пор мучает вопрос – зачем нужно было столь кардинально менять поведение компонента?.. Становится очевидно, в момент получения компонентом события CN_CTLCOLOREDIT нужно произвести ряд дополнительных вычислений перед отрисовкой фона: посмотреть, не перекрыта ли левая часть компонента какой нибудь формой, а если нет, то не зашел ли компонент за левую границу главной формы проекта.

С учетом всего вышесказанного получается следующий модуль.

unit BackgroundEdit;

interface

uses
  Windows, Messages, SysUtils, Classes, StdCtrls, CommCtrl, Graphics, Forms,
  Dialogs, Controls;

type
  TEdit = class( StdCtrls.TEdit )
  private
    IncShamanism, isMDI: boolean;
    Bitmap, Bkg: TBitmap;
    hbs: Cardinal;
    ShowBkg: boolean;
    EdgeX: integer;
    function CalcOffsetX: integer;
    function CalcOffsetY: integer;
    procedure WMSetFokus( var Msg: TMessage ); message WM_SETFOCUS;
    procedure WMKillFokus( var Msg: TMessage ); message WM_KILLFOCUS;
    procedure WMSize( var Msg: TMessage ); message WM_SIZE;
  protected
    procedure WndProc( var Message: TMessage ); override;
    procedure Change; override;
  public
    constructor Create( AOwner: TComponent ); override;
    destructor Free;
  end;

implementation

{ TEdit }

function EnableShamanism: boolean;
var
  OsVer: OSVERSIONINFO;
begin
   OsVer.dwOSVersionInfoSize := SizeOf( OSVERSIONINFO );
   GetVersionEx( OsVer );
   Result := OsVer.dwMajorVersion >= 6;
end;

procedure ClearBitmap( var Bmp: TBitmap );
begin
   Bmp.Canvas.Brush.Color := clWhite;
   Bmp.Canvas.FillRect( Rect( 0, 0, Bmp.Width, Bmp.Height ) );
end;

constructor TEdit.Create(AOwner: TComponent);
begin
   inherited;

   IncShamanism := EnableShamanism;
   if IncShamanism then
      isMDI := ( AOwner as TForm ).FormStyle = fsMDIChild;

   Bitmap := TBitmap.Create;
   Bitmap.LoadFromFile( 'Background.bmp' );
   Bkg := TBitmap.Create;
   Bkg.Width := Width;
   Bkg.Height := Height;

   Bkg.Canvas.Draw( 0, 0, Bitmap );
   hbs := CreatePatternBrush( Bkg.Handle );

   EdgeX := GetSystemMetrics( SM_CXEDGE );

   ShowBkg := Text = '';
   InvalidateRect( Handle, nil, false );
end;

destructor TEdit.Free;
begin
   DeleteObject( hbs );
   Bkg.Free;
   Bitmap.Free;
end;

procedure TEdit.WndProc(var Message: TMessage);
var
  LeftPos: integer;
  offX, offY: integer;
begin
   inherited;

   if ( Message.Msg = CN_CTLCOLOREDIT ) and ShowBkg then
   begin
      SetBkMode( Message.WParam, TRANSPARENT );
      if IncShamanism then
      begin
         if isMDI and Visible then
         begin
            LeftPos := 0;
            offX := CalcOffsetX;
            offY := CalcOffsetY;

            DeleteObject( hbs );
            ClearBitmap( Bkg );
            if not ( Owner as TForm ).Active then
            begin
               with Application.MainForm do
               begin
                  if Assigned( ActiveMDIChild ) then
                     if PtInRect( ActiveMDIChild.BoundsRect, Point( offX, offY ) ) and
                        PtInRect( ActiveMDIChild.BoundsRect, Point( offX, offY + Self.Height ) ) and
                        ( offX >= ActiveMDIChild.BoundsRect.Left ) then
                        LeftPos :=  -( ActiveMDIChild.BoundsRect.Right - offX - EdgeX )
                     else
                     if PtInRect( ActiveMDIChild.BoundsRect, Point( offX, offY ) ) and
                        ( offY + Self.Height - ActiveMDIChild.BoundsRect.Bottom <= 2 ) then
                        LeftPos :=  -( ActiveMDIChild.BoundsRect.Right - offX - EdgeX )
                     else
                     if PtInRect( ActiveMDIChild.BoundsRect, Point( offX, offY + Self.Height ) ) and
                        ( ActiveMDIChild.BoundsRect.Top - offY <= 2 ) then
                           LeftPos :=  -( ActiveMDIChild.BoundsRect.Right - offX - EdgeX )
                     else
                        LeftPos := 0;
               end;
            end;

            if offX < 0 then
               LeftPos := offX + EdgeX;

            Bkg.Canvas.Draw( LeftPos, 0, Bitmap );
            hbs := CreatePatternBrush( Bkg.Handle );
         end;
      end;
      Message.Result := hbs;
   end;

   if IncShamanism then
      if Message.Msg = WM_ERASEBKGND then
         InvalidateRect( Handle, nil, false );
end;

procedure TEdit.Change;
begin
   inherited;
   ShowBkg := ( Text = '' ) and ( not Focused );
end;

function TEdit.CalcOffsetX: integer;
var
  CX_MAIN_FRAME: Cardinal;
begin
   if ( Owner as TForm ).BorderStyle in [bsSingle, bsToolWindow] then
      CX_MAIN_FRAME := GetSystemMetrics( SM_CXFIXEDFRAME )
   else
      CX_MAIN_FRAME := GetSystemMetrics( SM_CXFRAME );

   Result := ( Owner as TForm ).BoundsRect.Left + CX_MAIN_FRAME +
             Self.ClientToParent( Self.ClientRect.TopLeft, ( Owner as TForm ) ).X;
end;

function TEdit.CalcOffsetY: integer;
var
  CX_MAIN_FRAME,
  CY_CAPTION: Cardinal;
begin
   if ( Owner as TForm ).BorderStyle in [bsSingle, bsToolWindow] then
      CX_MAIN_FRAME := GetSystemMetrics( SM_CXFIXEDFRAME )
   else
      CX_MAIN_FRAME := GetSystemMetrics( SM_CXFRAME );
   CY_CAPTION := GetSystemMetrics( SM_CYCAPTION );

   Result := ( Owner as TForm ).BoundsRect.Top + CX_MAIN_FRAME + CY_CAPTION +
             Self.ClientToParent( Self.ClientRect.TopLeft, ( Owner as TForm ) ).Y;
end;

procedure TEdit.WMSetFokus(var Msg: TMessage);
begin
   inherited;
   ShowBkg := false;
   if not IncShamanism then
   begin
      Perform( WM_NCPAINT, 0, 0 );
      InvalidateRect( Handle, nil, false );
   end;
end;

procedure TEdit.WMKillFokus(var Msg: TMessage);
begin
   ShowBkg := Text = '';
   if not IncShamanism then
   begin
      Perform( WM_NCPAINT, 0, 0 );
      InvalidateRect( Handle, nil, false );
   end;
   inherited;
end;

procedure TEdit.WMSize(var Msg: TMessage);
begin
   inherited;
   if Visible then
   begin
      Bkg.Width := Self.Width;
      DeleteObject( hbs );
      Bkg.Canvas.Draw( 0, 0, Bitmap );
      hbs := CreatePatternBrush( Bkg.Handle );
   end;
end;

end.

Краткое пояснение происходящего. Первым делом смотрим, не перекрыт ли компонент какой либо формой, а это может быть только в случае, когда родительская форма Edit'а не активна (if not ( Owner as TForm ).Active). Если перекрыт, смотрим, компонент перекрыт "по всей высоте", или нет. Если да, рисовать нужно с того места, где заканчивается правый край перекрывающей формы, если нет, то от начала компонента. И вновь не обошлось без подвохов! Окна имеют скругленные края, а следовательно, их ширина не всегда одинакова (если можно так сказать), это нужно учитывать в расчетах, но, к сожалению, я не знаю как это сделать. В итоге фон немного дергается, в случае, когда верхняя граница перекрывающей формы находится чуть ниже верхней границы перекрытого Edit'а. Я специально не оптимизировал код, чтобы нагляднее продемонстрировать эту ситуацию (ее обработка происходит во 2-ом и 3-ем условии). Зачем разработчикам понадобилось так усложнять работу Edit'а остается загадкой.

Затем проверим, не зашел ли Edit за левую сторону главной формы MDI приложения, за это отвечает функция CalcOffsetX. В этой функции предполагается, что владельцем Edit’а является форма. Это так, если Edit брошен на форму в дизайнере, если же он создается в runtime, нужно самостоятельно указать в качестве владельца форму. Если функция возвращает отрицательное значение, значит часть компонента (или он весь) скрыта за левой границей главной формы приложения, и надо учитывать это значение при отрисовке фона.

В момент получения Edit’ом фокуса фон скрывается, и показывается в момент потери фокуса при условии, что в компоненте отсутствует текст. Обработка события Change нужна для того, чтобы скрыть фон компонента, в котором присутствует текст, в момент создания формы. Так как в Windows XP (возможно и в более ранних, я не тестировал) не происходит перерисовка компонента при получении и потере фокуса, приходится позаботиться об этом самостоятельно. При изменении размеров компонента модифицируем кисть, но тут есть одни нюанс. Приведенный выше код нужно применять тогда, когда в качестве фона используется рисунок (вертикальный градиент или повторяющийся орнамент), и нам нужно залить им всю канву компонента. Если в качестве фона используется надпись, например “Обязательное поле”, нам нужно чтобы надпись появлялась один раз в начале компонента, и тогда процедуру надо слегка изменить.

procedure ClearBitmap( var Bmp: TBitmap );
begin
   Bmp.Canvas.Brush.Color := clWhite;
   Bmp.Canvas.FillRect( Rect( 0, 0, Bmp.Width, Bmp.Height ) );
end;

{...}

procedure TEdit.WndProc(var Message: TMessage);
begin
   inherited;

   if ( Message.Msg = CN_CTLCOLOREDIT ) and ShowBkg then
   begin
      SetBkMode( Message.WParam, TRANSPARENT );
      if IncShamanism then
      begin
         if isMDI and Visible then
         begin
            DeleteObject( hbs );
            ClearBitmap( Bkg );
            {...}
         end;
      end;
      Message.Result := hbs;
   end;

   if IncShamanism then
      if Message.Msg = WM_ERASEBKGND then
         InvalidateRect( Handle, nil, false );
end;

{...}

procedure TEdit.WMSize(var Msg: TMessage);
begin
   inherited;
   if Visible then
   begin
      Bkg.Width := Self.Width;
      DeleteObject( hbs );
      Bkg.Canvas.Draw( 0, 0, Bitmap );
      hbs := CreatePatternBrush( Bkg.Handle );
   end;
end;

В листинге приведены только изменения, полный код модуля находится в примерах к статье.

Следует иметь ввиду, что этот способ не подходит для отрисовыки фона на компонентах, свойство Enabled которых равно false, так как такие компоненты не получают сообщение CN_CTLCOLOREDIT.

Но не только поля типа TEdit могут быть обязательными для заполнения, это может касаться и других текстовых полей, например TMemo. Принцип реализации примерно такой же, как в случае с TEdit, по этому приводить код в статье я не буду (смотрите пример к статье), а вот о нюансах расскажу. Их меньше, и таких “подводных камней” как в пред идущем случае нас не ожидает. Дополнительной обработки в Windiws XP, по тем же причинам, что и в случае с TEdit, требуют события WM_SETFOKUS и WM_KILLFOKUS. В случае отрисовки на канве сплошного фона не потребуется дополнительного битмапа и обработки сообщения WM_SIZE, а вот при выводе текста действовать придется по аналогии с TEdit.

.: Пример к данной статье :.

При использовании материала - ссылка на сайт обязательна