窗体皮肤实现 - 重绘窗体非客户区(三)

窗体边框基本的绘制和控制完成,在第二篇中主要遗留的问题。

  • 标题区域图标和按钮没绘制
  • 缩放时客户区显示有问题

解决完上述两个的问题,皮肤处理基本完整。

主要内容:

  • 绘制标题区域内容
  • 标题区按钮响应鼠标消息
  • 绘制客户区

绘制标题区域内容

  • 获取标题有效区域
  • 绘制窗体图标
  • 绘制按钮
  • 绘制标题

标题区域主要考虑窗体是否在最大化状态,最大化后实际的标题绘制区域会有变化。可以通过 IsZoomedGetWindowLong(Handle, GWL_STYLE) and WS_MAXIMIZE = WS_MAXIMIZE 的方式获取。

AMaxed := IsZoomed(Handle);    // 获取窗体最大化状态

function TTest.GetCaptionRect(AMaxed: Boolean): TRect;
var
  rFrame: TRect;
begin
  rFrame := GetFrameSize;         // 窗体上下左右的边框尺寸
  // 最大化状态简易处理
  if AMaxed then
    Result := Rect(8, 8, FWidth - 9 , rFrame.Top)
  else
    Result := Rect(rFrame.Left, 3, FWidth - rFrame.right, rFrame.Top);
end;

获取窗体图标并绘制

绘制窗体图标稍微有些麻烦,需要获取窗体的Icon图标。窗体图标并不一定是程序图标。主要过程通过WM_GETICON 这个消息获取图标。

TmpHandle := THandle(SendMessage(Handle, WM_GETICON, ICON_SMALL, 0));
if TmpHandle = 0 then
    TmpHandle := THandle(SendMessage(Handle, WM_GETICON, ICON_BIG, 0));

如果上述方法无法获得,需要通过GetClassNameGetClassInfoEx 这2个API获取。

{ Get instance }
GetClassName(Handle, @Buffer, SizeOf(Buffer));
FillChar(Info, SizeOf(Info), 0);
Info.cbSize := SizeOf(Info);

if GetClassInfoEx(GetWindowLong(Handle, GWL_HINSTANCE), @Buffer, Info) then
begin
  TmpHandle := Info.hIconSm;
  if TmpHandle = 0 then
    TmpHandle := Info.HICON;
end

上述这2种方法还是无法获取。那~~ 就没有办法了。如果非要绘制图标可以使用Application的图标进行代替。

Application.Icon.Handle
// 完整获取窗体图标的方法
function TTest.GetIcon: TIcon;
var
  IconX, IconY: integer;
  TmpHandle: THandle;
  Info: TWndClassEx;
  Buffer: array [0 .. 255] of Char;
begin
  ///
  /// 获取当前form的图标
  /// 这个图标和App的图标是不同的
  TmpHandle := THandle(SendMessage(Handle, WM_GETICON, ICON_SMALL, 0));
  if TmpHandle = 0 then
    TmpHandle := THandle(SendMessage(Handle, WM_GETICON, ICON_BIG, 0));

  if TmpHandle = 0 then
  begin
    { Get instance }
    GetClassName(Handle, @Buffer, SizeOf(Buffer));
    FillChar(Info, SizeOf(Info), 0);
    Info.cbSize := SizeOf(Info);

    if GetClassInfoEx(GetWindowLong(Handle, GWL_HINSTANCE), @Buffer, Info) then
    begin
      TmpHandle := Info.hIconSm;
      if TmpHandle = 0 then
        TmpHandle := Info.HICON;
    end
  end;

  if FIcon = nil then
    FIcon := TIcon.Create;

  if TmpHandle <> 0 then
  begin
    IconX := GetSystemMetrics(SM_CXSMICON);
    if IconX = 0 then
      IconX := GetSystemMetrics(SM_CXSIZE);
    IconY := GetSystemMetrics(SM_CYSMICON);
    if IconY = 0 then
      IconY := GetSystemMetrics(SM_CYSIZE);
    FIcon.Handle := CopyImage(TmpHandle, IMAGE_ICON, IconX, IconY, 0);
    FIconHandle := TmpHandle;
  end;

  Result := FIcon;
end;

绘制窗体最小化、最大化和关闭按钮

绘制系统最小化、最大化和关闭按钮直接使用贴图的方法。做一张PNG图片,做成资源文件加入到单元中。

注:图标是白色的没底色看不见,所以在贴的图上加了个黑底。

计算好实际位置后,直接把从资源中加载的图标绘制上去。

procedure TTest.DrawButton(DC: HDC; AKind: TFormButtonKind; AState: TSkinIndicator; const R: TRect);
var
  hB: HBRUSH;
  iColor: Cardinal;
  rSrcOff: TPoint;
  x, y: integer;
begin
  /// 绘制背景
  case AState of
    siHover         : iColor := SKINCOLOR_BTNHOT;
    siPressed       : iColor := SKINCOLOR_BTNPRESSED;
    siSelected      : iColor := SKINCOLOR_BTNPRESSED;
    siHoverSelected : iColor := SKINCOLOR_BTNHOT;
  else                iColor := SKINCOLOR_BAKCGROUND;
  end;
  hB := CreateSolidBrush(iColor);
  FillRect(DC, R, hB);
  DeleteObject(hB);

  /// 绘制图标
  rSrcOff := Point(SIZE_RESICON * ord(AKind), 0);
  x := R.Left + (R.Right - R.Left - SIZE_RESICON) div 2;
  y := R.Top + (R.Bottom - R.Top - SIZE_RESICON) div 2;
  DrawTransparentBitmap(FSkinData, rSrcOff.X, rSrcOff.Y, DC, x, y, SIZE_RESICON, SIZE_RESICON);
end;

最后绘制标题,设置背景SetBkMode透明,设置字体颜色SetTextColor为白色。

/// 绘制Caption
sData :=  GetCaption;
SetBkMode(DC, TRANSPARENT);
SaveColor := SetTextColor(DC, $00FFFFFF);
Flag := DT_LEFT or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX;
DrawTextEx(DC, PChar(sData), Length(sData), rCaptionRect, Flag, nil);
SetTextColor(DC, SaveColor);

整个标题区域就绘制完成。

标题区按钮响应鼠标消息

基本的绘制完成,鼠标滑到窗体按钮区域(最大化、最小化和关闭)和点击并不会相应。需要自己处理相应的消息。WM_NCHITTEST 消息是系统用来确定鼠标位置对应的窗体区域,可以通过这个消息实现对窗体按钮的相应。

为实现窗体按钮的响应,只要处理这个区域。其他区域消息还是交由窗体原有消息处理。

相应两种状态:

  • 滑入时的显示样式
  • 按下时的显示样式
procedure TTest.WMNCHitTest(var Message: TWMNCHitTest);
var
  P: TPoint;
  iHit: integer;
begin
  // 需要把位置转换到实际窗口位置
  P := NormalizePoint(Point(Message.XPos, Message.YPos));

  // 获取 位置
  // 只对监控区域处理,其他由系统处理
  iHit := HitTest(p);
  if FHotHit > HTNOWHERE then
  begin
    Message.Result := iHit;
    Handled := True;            // 处理完成,不再交由系统处理
  end;

  // 响应鼠标滑入监控区域后,通知非客户区重绘
  if iHit <> FHotHit then
  begin
    FHotHit := iHit;
    InvalidateNC;
  end;
end;
function TTest.HitTest(P: TPoint):integer;
var
  bMaxed: Boolean;
  r: TRect;
  rCaptionRect: TRect;
  rFrame: TRect;
begin
  Result := HTNOWHERE;

  ///
  /// 检测位置
  ///
  rFrame := GetFrameSize;
  if p.Y > rFrame.Top then
    Exit;

  ///
  ///  只关心窗体按钮区域
  ///
  bMaxed := IsZoomed(Handle);
  rCaptionRect := GetCaptionRect(bMaxed);
  if PtInRect(rCaptionRect, p) then
  begin
    r.Right := rCaptionRect.Right - 1;
    r.Top := 0;
    if bMaxed then
      r.Top := rCaptionRect.Top;
    r.Top := r.Top + (rFrame.Top - r.Top - SIZE_SYSBTN.cy) div 2;
    r.Left := r.Right - SIZE_SYSBTN.cx;
    r.Bottom := r.Top + SIZE_SYSBTN.cy;

    ///
    /// 实际绘制的按钮就三个,其他没处理
    ///
    if (P.Y >= r.Top) and (p.Y <= r.Bottom) and (p.X <= r.Right) then
    begin
      if (P.X >= r.Left) then
        Result := HTCLOSE
      else if p.X >= (r.Left - SIZE_SYSBTN.cx) then
        Result := HTMAXBUTTON
      else if p.X >= (r.Left - SIZE_SYSBTN.cx * 2) then
        Result := HTMINBUTTON;
    end;
  end;
end;

function HitTest(P: TPoint):integer

上面代码获取当前鼠标所在位置,这样滑入的Hot状态信息已经获取。还个是记录按下的状态,需要使用WM_NCLBUTTONDOWN消息获得鼠标按下后的位置来实现。

procedure TTest.WMNCLButtonDown(var message: TWMNCHitMessage);
var
  iHit: integer;
begin
  // 对监控的区域作相应
  iHit := HTNOWHERE;
  if (Message.HitTest = HTCLOSE) or (Message.HitTest = HTMAXBUTTON) or (Message.HitTest = HTMINBUTTON) or
    (Message.HitTest = HTHELP) then
  begin
    iHit := Message.HitTest;
    Message.Result := 0;
    Message.Msg := WM_NULL;
    Handled := True;           // 消息已经处理完成,不再交由系统处理
  end;

  // 如果按下的位置发生变化,重绘标题区
  if iHit <> FPressedHit then
  begin
    FPressedHit := iHit;
    InvalidateNC;
  end;
end;

通过上述两个消息,获取到鼠标所在按钮的位置。在绘制标题区函数中直接使用。

// 注意:
//   按钮样式枚举的顺序不要颠倒,这个和资源图标的排列顺序是一致的
TFormButtonKind = (fbkMin, fbkMax, fbkRestore, fbkClose, fbkHelp);

procedure TTest.PaintNC(DC: HDC);
const
  HITVALUES: array [TFormButtonKind] of integer = (HTMINBUTTON, HTMAXBUTTON, HTMAXBUTTON, HTCLOSE, HTHELP);

  function GetBtnState(AKind: TFormButtonKind): TSkinIndicator;
  begin
    // 按下区域 一定和 Hot区域一致,保证鼠标点击到弹起的区域是一致,才能执行
    if (FPressedHit = FHotHit) and (FPressedHit = HITVALUES[AKind]) then
      Result := siPressed
    else if FHotHit = HITVALUES[AKind] then
      Result := siHover
    else
      Result := siInactive;
  end;

  ... ...
begin
    ... ...
    // 绘制 关闭按钮
    DrawButton(Dc, fbkClose, GetBtnState(fbkClose), rButton);

    ... ...
end;

上述的绘制相应已经完成,但鼠标点击是不会有任何反应的。需要处理WM_NCLBUTTONUP消息

procedure TTest.WMNCLButtonUp(var Message: TWMNCHitMessage);
var
  iWasHit: Integer;
begin
  iWasHit := FPressedHit;

  // 处理监控区域的鼠标弹起消息
  if iWasHit <> HTNOWHERE then
  begin
    FPressedHit := HTNOWHERE;
    //InvalidateNC;

    if iWasHit = FHotHit then
    begin
      case Message.HitTest of
        HTCLOSE     : SendMessage(Handle, WM_SYSCOMMAND, SC_CLOSE, 0);
        HTMAXBUTTON : Maximize;
        HTMINBUTTON : Minimize;
        HTHELP      : SendMessage(Handle, WM_SYSCOMMAND, SC_CONTEXTHELP, 0);
      end;

      Message.Result := 0;
      Message.Msg := WM_NULL;
      Handled := True;           // 消息已经处理完成,不需要控件再处理
    end;
  end;
end;
procedure TTest.Maximize;
begin
  if Handle <> 0 then
  begin
    FPressedHit := 0;
    FHotHit := 0;
    if IsZoomed(Handle) then
      SendMessage(Handle, WM_SYSCOMMAND, SC_RESTORE, 0)
    else
      SendMessage(Handle, WM_SYSCOMMAND, SC_MAXIMIZE, 0);
  end;
end;

procedure TTest.Minimize;
begin
  if Handle <> 0 then
  begin
    FPressedHit := 0;
    FHotHit := 0;
    if IsIconic(Handle) then
      SendMessage(Handle, WM_SYSCOMMAND, SC_RESTORE, 0)
    else
      SendMessage(Handle, WM_SYSCOMMAND, SC_MINIMIZE, 0);
   end;
end;

整个标题区的消息基本处理完成,能正常相应标题区应有的功能。还有些细节上面需要处理一下,如修改窗体标题没有及时响应。WM_SETTEXT消息用于处理标题修改。

procedure TTest.WMSetText(var Message: TMessage);
begin
  CallDefaultProc(Message);   // 优先有系统处理此消息
  InvalidateNC;               // 重绘标题区
  Handled := true;
end;

绘制客户区

还有最后一个问题。在缩放窗体时,客户区惨不忍睹。其实这个还是比较简单,处理擦除背景(WM_ERASEBKGND)和响应绘制(WM_PAINT)消息就能完成。

擦除处理

procedure TTest.WMEraseBkgnd(var message: TWMEraseBkgnd);
var
  DC: HDC;
  SaveIndex: integer;
begin
  DC := Message.DC;
  if DC <> 0 then
  begin
    // 如果是容器控件,擦除一定要处理。填色也行。
    // 否则会出现因主绘制延迟,出现短暂的未刷新色块残留。特别在使用Buffer方式绘制时常出现
    SaveIndex := SaveDC(DC);
    PaintBackground(DC);
    RestoreDC(DC, SaveIndex);
  end;

  Handled := True;       // 消息处理完成,控件不再处理
  Message.Result := 1;   // 绘制结束,外部不用处理
end;

绘制客户区,需要通知子控件刷新。

procedure TTest.WMPaint(var message: TWMPaint);
var
  DC, hPaintDC: HDC;
  cBuffer: TBitmap;
  PS: TPaintStruct;
begin
  ///
  /// 绘制客户区域
  ///
  DC := Message.DC;

  hPaintDC := DC;
  if DC = 0 then
    hPaintDC := BeginPaint(Handle, PS);

  if DC = 0 then
  begin
    /// 缓冲模式绘制,减少闪烁
    cBuffer := TBitmap.Create;
    try
      cBuffer.SetSize(FWidth, FHeight);
      PaintBackground(cBuffer.Canvas.Handle);
      Paint(cBuffer.Canvas.Handle);
      /// 通知子控件进行绘制
      /// 主要是些图形控件的重绘制(如TShape),否则停靠在Form上的图像控件无法正常显示
      if Control is TWinControl then
        TacWinControl(Control).PaintControls(cBuffer.Canvas.Handle, nil);
      BitBlt(hPaintDC, 0, 0, FWidth, FHeight, cBuffer.Canvas.Handle, 0, 0, SRCCOPY);
    finally
      cBuffer.Free;
    end;
  end
  else
  begin
    Paint(hPaintDC);
    // 通知子控件重绘
    if Control is TWinControl then
      TacWinControl(Control).PaintControls(hPaintDC, nil);
  end;

  if DC = 0 then
    EndPaint(Handle, PS);

  Handled := True;
end;

其中的Paint不需要处理任何代码。

procedure TTest.Paint(DC: HDC);
begin
  // 不需要处理。
end;

基本的窗体绘制控制基本完成。

大致的效果, GIF中TShape的颜色表现有些问题,实际是正常的。

现在时下流行的换肤,还是比较容易实现。增加一块背景图资源,在绘制时算好位置贴上去就OK。还有一些鼠标滑入按钮的渐变效果,可以创建一个时钟记录每个按钮的背景褪色值(透明度)使用AlphaBlend 这个函数进行绘制,或是用混色的方法处理。

通过透明度控制背景动画效果,参考DrawTransparentBitmap

procedure DrawTransparentBitmap(Source: TBitmap; sx, sy: Integer; Destination: HDC;
  const dX, dY: Integer;  w, h: Integer; const Opacity: Byte = 255); overload;
var
  BlendFunc: TBlendFunction;
begin
  BlendFunc.BlendOp := AC_SRC_OVER;
  BlendFunc.BlendFlags := 0;
  BlendFunc.SourceConstantAlpha := Opacity;

  if Source.PixelFormat = pf32bit then
    BlendFunc.AlphaFormat := AC_SRC_ALPHA
  else
    BlendFunc.AlphaFormat := 0;

  AlphaBlend(Destination, dX, dY, w, h, Source.Canvas.Handle, sx, sy, w, h, BlendFunc);
end;

感觉XE3有些伤不起,Release版本的exe竟然要2.42M。哎~。看来要搞个C版的。

相关API和消息:

  • IsZoomed --- 窗体是否最大化
  • GetClassInfoEx --- 获取窗体图标
  • WM_GETICON --- 获取窗体图标
  • DrawTransparentBitmap --- 绘制透明图片
  • GetWindowLong --- 获取窗体信息
  • DrawIconEx --- 绘制ICON
  • SetBkMode --- 设置字体绘制背景
  • SetTextColor --- 设置字体绘制颜色

开发环境:

  • XE3
  • win7

源代码:


蘑菇房 GDI 相关文章