Как добавить отступы в TCustomControl, не теряя границы "внешний вид"?

Я написал пользовательский TMemo, но заметил, что текст попал в границу без заполнения. Хотя я мог бы попытаться исправить проблему внутри ClientRect, сместив ее и т. Д., На данном этапе это не было бы очень элегантным решением. У TMemo есть как минимум 1px отступа, который не является частью клиентской области, поэтому я подумал, что попробую сделать то же самое (я предполагаю, что это то, что они делают в любом случае).

Поэтому я сократил клиентскую область с помощью WM_NCCALCSIZE, но тогда, конечно, граница не полностью закрашена, поэтому я должен также реализовать WM_NCPAINT. Это работает. Теперь я рисую одну границу clBlack, за которой следует прямоугольник заполнения clWindow. Все идет нормально.

Однако в XP (классический стиль) граница в 1 пиксель выглядит немного странно, поэтому я подумал, что, возможно, есть способ нарисовать старую границу "края клиента", а также выполнить внешний вид края клиента темы XP/Vista/Win7 (я не не знаю, как нарисовать это вручную, используя градиенты).

И вот тут я немного застрял. Кто-нибудь знает, как нарисовать границу таким образом, чтобы я мог выполнять заполнение, а также как я могу поддерживать соответствующий "клиентский край" (1 или 2 пикселя)?

Очень признателен.;)

(Другие способы сделать это также приветствуются)

=====

РЕДАКТИРОВАТЬ: После некоторой переделки, я пришел к следующему решению. Я думал, что выложу это здесь.

procedure TTest.WMNCCalcSize(var Msg: TWMNCCalcSize);
begin
  inherited;

  InflateRect(Msg.CalcSize_Params.rgrc[0], -1, -1);

  Msg.Result := 0;
end;

procedure TTest.WMNCPaint(var Msg: TWMNCPaint);
var
  lCanvas: TCanvas;
  lRect: TRect;
  iBorderWidth: integer;
  iInflate: integer;
begin
  if ThemeServices.ThemesEnabled
    ThemeServices.PaintBorder(self, true)
  else
    inherited;

  lCanvas := TCanvas.Create;
  try
    lCanvas.Handle := GetWindowDC(Handle);
    with lCanvas do
    begin
      lRect := Rect(0, 0, Width, Height);
      iBorderWidth := (Width - ClientWidth) div 2;
      iInflate := -(iBorderWidth - 1);
      InflateRect(varRect, iInflate, iInflate);

      Brush.Color := clWindow;
      FrameRect(lRect);
    end;
  finally
    ReleaseDC(Handle, lCanvas.Handle);
    FreeAndNil(lCanvas);
  end;

  Msg.result := 0;
end;

РЕДАКТИРОВАТЬ: Argh! Этот материал ломается, когда в игре есть полоса прокрутки. У меня пока нет решения для этого. Какие-либо предложения?

0 ответов

Другие вопросы по тегам