GVKun编程网logo

delphi – 从NC区域删除vcl样式时不显示TMainMenu（delphi 删除文件）

20

对于delphi–从NC区域删除vcl样式时不显示TMainMenu感兴趣的读者，本文将会是一篇不错的选择，我们将详细介绍delphi删除文件，并为您提供关于DelphiTStatusBarSizeG

对于delphi – 从NC区域删除vcl样式时不显示TMainMenu感兴趣的读者，本文将会是一篇不错的选择，我们将详细介绍delphi 删除文件，并为您提供关于Delphi TStatusBar SizeGrip和VCL样式、Delphi VCL样式教程 – 如何在运行时更改样式、Delphi XE2 VCL样式,从TLabel中删除样式或禁用类外观、Delphi XE2 VCL样式,更改窗口Icon在标题栏上不会更新,直到RecreateWnd的有用信息。

本文目录一览：

delphi – 从NC区域删除vcl样式时不显示TMainMenu（delphi 删除文件）

delphi – 从NC区域删除vcl样式时不显示TMainMenu（delphi 删除文件）

我正在使用此代码从表单的非客户区域中删除vcl样式. 

type
  TFormStyleHookNC= class(TMouseTrackControlStyleHook)
  protected
    procedure PaintBackground(Canvas: TCanvas); override;
    constructor Create(AControl: TWinControl); override;
  end;

constructor TFormStyleHookNC.Create(AControl: TWinControl);
begin
  inherited;
  OverrideEraseBkgnd := True;
end;

procedure TFormStyleHookNC.PaintBackground(Canvas: TCanvas);
var
  Details: TThemedElementDetails;
  R: TRect;
begin
  if StyleServices.Available then
  begin
    Details.Element := teWindow;
    Details.Part := 0;
    R := Rect(0,Control.ClientWidth,Control.ClientHeight);
    StyleServices.DrawElement(Canvas.Handle,Details,R);
  end;
end;


initialization
 TStyleManager.Engine.RegisterStyleHook(TForm3,TFormStyleHookNC);

在应用此样式挂钩之前,表单看起来像

之后

正如您所看到的菜单消失,问题是：我如何解决这个问题？我是说如何在不删除TMainMenu的情况下从表单的非客户区删除vcl样式？

解决方法

当你使用vcl样式时,TMain菜单是由TMainMenuBarStyleHook vcl样式钩子绘制的,它在TFormStyleHook(表单的钩子)里面定义,在这种情况下,因为你没有使用这个钩子,所以没有代码可以绘制TMainMenu.

两种可能的解决方案

1)为TFormStyleHookNC内部的TMainMenu实现vcl样式钩子,就像TFormStyleHook一样.

2)甚至更好地使用TActionMainMenuBar组件而不是TMainMenu,这个组件与vcl样式很好地集成(检查下一个样本图像).

Delphi TStatusBar SizeGrip和VCL样式

Delphi TStatusBar SizeGrip和VCL样式

我有TStatusBar的问题.

启用VCL样式后,即使Sizegrip属性设置为false,sizegrip也始终可见.

有办法解决吗？

解决方法

该问题位于TStatusBarStyleHook类的Paint方法中,VCl代码不检查Sizegrip属性的值并始终绘制控件.解决方法是创建一个从TStatusBarStyleHook类派生的新样式钩子并覆盖paint方法.

试试这个样本

uses
  Winapi.CommCtrl,Vcl.Styles,Vcl.Themes;

 type
 TStatusBarStyleHookFix=class(TStatusBarStyleHook)
 protected
    procedure Paint(Canvas: TCanvas); override;
 end;

 TCustomStatusBarHelper= class helper for TCustomStatusBar
  private
    function GetCanvas: TCanvas;
    procedure SetCanvas(const Value: TCanvas);
  public
    property  CanvasRW : TCanvas read GetCanvas write SetCanvas;
 end;



{ TCustomStatusBarHelper }

function TCustomStatusBarHelper.GetCanvas: TCanvas;
begin
   Result:=Canvas;
end;

procedure TCustomStatusBarHelper.SetCanvas(const Value: TCanvas);
begin
  Self.FCanVas:=Value;
end;


{ TStatusBarStyleHookFix }

procedure TStatusBarStyleHookFix.Paint(Canvas: TCanvas);
const
  AlignStyles: array [TAlignment] of Integer = (DT_LEFT,DT_RIGHT,DT_CENTER);
var
  LServices : TCustomStyleServices;
  LgripRect: TRect;
  LDetails: TThemedElementDetails;
  LText: string;
  LCanvas: TCanvas;
  Res,Count,I: Integer;
  Idx,Flags: Cardinal;
  Borders: array [0..2] of Integer;
  LRect : TRect;
begin
  LServices:=StyleServices;
  if not LServices.Available then
    Exit;

  LDetails := LServices.GetElementDetails(tsstatusRoot);
  LServices.DrawElement(Canvas.Handle,LDetails,Rect(0,Control.Width,Control.Height));

  if SendMessage(Handle,SB_ISSIMPLE,0) > 0 then
  begin
    LRect := Control.ClientRect;
    FillChar(Borders,SizeOf(Borders),0);
    SendMessage(Handle,SB_GETBORDERS,IntPtr(@Borders));
    LRect.Left := Borders[0] + Borders[2];
    LRect.Top := Borders[1];
    LRect.Bottom := LRect.Bottom - Borders[1];
    LRect.Right := LRect.Right - Borders[2];

    LDetails := LServices.GetElementDetails(tsPane);
    LServices.DrawElement(Canvas.Handle,LRect);

    //draw the grip only if the  Sizegrip property is true
    if TCustomStatusBar(Control).Sizegrip then
    begin
      LgripRect := Control.ClientRect;
      LgripRect.Left := LgripRect.Right - LRect.Height;
      LDetails := LServices.GetElementDetails(tsgripper);
      LServices.DrawElement(Canvas.Handle,LgripRect);
    end;

    LDetails := LServices.GetElementDetails(tsPane);
    SetLength(LText,Word(SendMessage(Handle,SB_GETTEXTLENGTH,0)));
    if Length(LText) > 0 then
    begin
     SendMessage(Handle,SB_GETTEXT,IntPtr(@LText[1]));
     Flags := Control.DrawTextBiDiModeFlags(DT_LEFT);
     DrawControlText(Canvas,LText,LRect,Flags);
    end;
  end
  else
  begin
    if Control is TStatusBar then
      Count := TStatusBar(Control).Panels.Count
    else
      Count := SendMessage(Handle,SB_GETPARTS,0);
    for I := 0 to Count - 1 do
    begin
      LRect := Rect(0,0);
      SendMessage(Handle,SB_GETRECT,I,IntPtr(@LRect));
      if IsRectEmpty(LRect) then
        Continue;
      LDetails := LServices.GetElementDetails(tsPane);
      LServices.DrawElement(Canvas.Handle,LRect);
      //draw the grip only if the  Sizegrip property is true
      if TCustomStatusBar(Control).Sizegrip and (I = Count - 1) then
      begin
        LgripRect := Control.ClientRect;
        LgripRect.Left := LgripRect.Right - LRect.Height;
        LDetails := LServices.GetElementDetails(tsgripper);
        LServices.DrawElement(Canvas.Handle,LgripRect);
      end;
      LDetails := LServices.GetElementDetails(tsPane);
      InflateRect(LRect,-1,-1);
      if Control is TCustomStatusBar then
        Flags := Control.DrawTextBiDiModeFlags(AlignStyles[TCustomStatusBar(Control).Panels[I].Alignment])
      else
        Flags := Control.DrawTextBiDiModeFlags(DT_LEFT);
      Idx := I;
      SetLength(LText,Idx,0)));
      if Length(LText) > 0 then
      begin
        Res := SendMessage(Handle,IntPtr(@LText[1]));
        if (Res and SBT_OWNERDRAW = 0) then
          DrawControlText(Canvas,Flags)
        else
        if (Control is TCustomStatusBar) and Assigned(TCustomStatusBar(Control).OnDrawPanel) then
        begin
          LCanvas := TCustomStatusBar(Control).Canvas;
          TCustomStatusBar(Control).CanvasRW := Canvas;
          try
            TCustomStatusBar(Control).OnDrawPanel(TCustomStatusBar(Control),TCustomStatusBar(Control).Panels[I],LRect);
          finally
            TCustomStatusBar(Control).CanvasRW := LCanvas;
          end;
        end;
      end
      else if (Control is TCustomStatusBar) then
       if (TCustomStatusBar(Control).Panels[I].Style <> psOwnerDraw) then
         DrawControlText(Canvas,TCustomStatusBar(Control).Panels[I].Text,Flags)
       else
         if Assigned(TCustomStatusBar(Control).OnDrawPanel) then
         begin
           LCanvas := TCustomStatusBar(Control).Canvas;
           TCustomStatusBar(Control).CanvasRW := Canvas;
           try
             TCustomStatusBar(Control).OnDrawPanel(TCustomStatusBar(Control),LRect);
           finally
             TCustomStatusBar(Control).CanvasRW := LCanvas;
           end;
         end;
    end;
  end;

end;

别忘了像这样注册新式钩子

TStyleManager.Engine.RegisterStyleHook(TCustomStatusBar,TStatusBarStyleHookFix);
TStyleManager.Engine.RegisterStyleHook(TStatusBar,TStatusBarStyleHookFix);

Delphi VCL样式教程 – 如何在运行时更改样式

Delphi VCL样式教程 – 如何在运行时更改样式

是否有一个很好的VCL样式教程,我们看到如何动态(在运行时)加载/更改样式？

这应该适用于Delphi XE2及更高版本,因为XE2是第一个带有VCL样式的版本.

解决方法

我正在添加一个答案,因为本地信息通常比链接更受欢迎.

以下是您在开始之前需要了解的关键事实：

>许多VCL控件都有颜色属性,但是当打开样式时,这些属性将被忽略,而像Button这样的默认“常用控件”将由Delphi本身绘制,而不是使用“或”.配有窗户“.
>不知何故,在你的应用程序的深处,VCL样式会引入一些钩子来接管绘制你的控件.它可以处理的所有东西都将使用常规控件顶部的“皮肤”绘制.很多人称之为“剥皮vcl”,在VCL风格之前,你可能已经找到了第三方皮肤系统.现在它已经内置了.
>任何没有挂钩的东西,仍然会得到常规风格.所以大多数第三方控件,以及VCL的一些位都不是主题.不要指望完美的即时结果.此外,您可能有时会看到一些由于蒙皮造成的瞬间闪烁或毛刺,这是可以预料的.在运行时添加样式加载,结果的最终质量是任何人的猜测.您不一定能保证在运行时加载的样式将包含您可能希望它包含的所有内容.你也不能保证在你的应用程序中静态包含一个,但至少你静态包含的那些可以由你的QA团队(可能是你)验证.

这是开始的最简单的步骤：真的只有步骤#2到#4是必不可少的.

>点击文件 – >新 – > VCL表单项目.
>右键单击“项目管理器”窗格中的项目选项,然后单击“属性”.导航到应用程序 – >出现
>单击自定义样式将其打开. (Amakrits是我列表中的第一个,所以我会点击它).
>单击默认样式组合框并将其更改为默认值以外的其他值.
>在表单上放一些东西,这样就不会空了. (按钮,列表框等).
>运行你的应用程序.

现在,高级的东西：在运行时改变你的风格：

我使用这个按钮click和formcreate来做到这一点：

添加fdefaultStyleName：String;到您表单的私人部分.

确保Vcl.Themes在您的使用条款中.

procedure TForm1.Button1Click(Sender: TObject);
begin
 if Assigned(TStyleManager.ActiveStyle) and (TStyleManager.ActiveStyle.Name<>'Windows') then begin
   TStyleManager.TrySetStyle('Windows');
 end else begin
   TStyleManager.TrySetStyle(fdefaultStyleName); // whatever was in the project settings.
 end;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
if Assigned(TStyleManager.ActiveStyle) then
  fdefaultStyleName := TStyleManager.ActiveStyle.Name;

end;

Delphi XE2 VCL样式,从TLabel中删除样式或禁用类外观

Delphi XE2 VCL样式,从TLabel中删除样式或禁用类外观

使用XE2 VCL样式,我想禁用TLabel(或属性sfTextLabelnormal)的外观

我已经尝试过其他问题的所有解决方案,比如使用Engine.UnRegisterStyleHook,但它没有任何效果.

解决方法

TLabel组件不使用样式挂钩,因为它不是 TWinControl后代,因此您无法使用 UnRegisterStyleHook功能.相反,您必须覆盖Paint DoDrawText方法.

UPDATE

这里有一个如何覆盖TLabel的绘制过程的示例.

//declare this code in the implementation part 
uses
 Vcl.Themes,Vcl.Styles;

type
  TLabelHelper= class helper for TCustomLabel
    procedure DrawnormalText(DC: HDC; const Text: UnicodeString; var TextRect: TRect; TextFlags: Cardinal);
  end;

{ TLabelHelper }

procedure TLabelHelper.DrawnormalText(DC: HDC; const Text: UnicodeString;
  var TextRect: TRect; TextFlags: Cardinal);
begin
  Self.DoDrawnormalText(DC,Text,TextRect,TextFlags);
end;


{ TLabel }

procedure TLabel.DoDrawText(var Rect: TRect; Flags: Integer);
const
  Ellipsisstr = '...';
  Ellipsis: array[TEllipsisPosition] of Longint = (0,DT_PATH_ELLIPSIS,DT_END_ELLIPSIS,DT_WORD_ELLIPSIS);
var
  Text,DText: string;
  NewRect: TRect;
  Height,Delim: Integer;
begin
  Text := GetLabelText;
  if (Flags and DT_CALCRECT <> 0) and
     ((Text = '') or ShowAccelChar and (Text[1] = '&') and (Length(Text) = 1)) then
    Text := Text + ' ';

  if Text <> '' then
  begin
    if not ShowAccelChar then Flags := Flags or DT_nopREFIX;
    Flags := DrawTextBiDiModeFlags(Flags);
    Canvas.Font := Font;
    if (EllipsisPosition <> epNone) and not AutoSize then
    begin
      DText := Text;
      Flags := Flags and not DT_EXPANDTABS;
      Flags := Flags or Ellipsis[EllipsisPosition];
      if WordWrap and (EllipsisPosition in [epEndEllipsis,epWordEllipsis]) then
      begin
        repeat
          NewRect := Rect;
          Dec(NewRect.Right,Canvas.TextWidth(Ellipsisstr));
          DrawnormalText(Canvas.Handle,DText,NewRect,Flags or DT_CALCRECT);
          Height := NewRect.Bottom - NewRect.Top;
          if (Height > ClientHeight) and (Height > Canvas.Font.Height) then
          begin
            Delim := LastDelimiter(' '#9,Text);
            if Delim = 0 then
              Delim := Length(Text);
            Dec(Delim);
            if ByteType(Text,Delim) = mbLeadByte then
              Dec(Delim);
            Text := copy(Text,1,Delim);
            DText := Text + Ellipsisstr;
            if Text = '' then
              Break;
          end else
            Break;
        until False;
      end;
      if Text <> '' then
        Text := DText;
    end;

    if Enabled or StyleServices.Enabled then
      DrawnormalText(Canvas.Handle,Rect,Flags)
    else
    begin
      OffsetRect(Rect,1);
      Canvas.Font.Color := clBtnHighlight;
      DrawnormalText(Canvas.Handle,Flags);
      OffsetRect(Rect,-1,-1);
      Canvas.Font.Color := clBtnShadow;
      DrawnormalText(Canvas.Handle,Flags);
    end;
  end;
end;

在使用它之前以这种方式声明一个内插器类

TLabel = class (Vcl.StdCtrls.TLabel)
    procedure DoDrawText(var Rect: TRect; Flags: Longint); override;
  end;

这就是结果

Delphi XE2 VCL样式,更改窗口Icon在标题栏上不会更新,直到RecreateWnd

Delphi XE2 VCL样式,更改窗口Icon在标题栏上不会更新,直到RecreateWnd

VCL风格的另一个奇怪的故障：

更改表单的图标仅更新其任务栏按钮,除非您使用RecreateWnd,否则标题中的图标不会更新. (使用VCL样式时)

ImageList3.GetIcon(0,Form1.Icon);

有没有办法解决它而不必使用RecreateWnd？ (实际上可以创建other issues)

解决方法

这是VCL风格中的(又一个)错误. TFormStyleHook.GetIconFast函数返回一个陈旧的图标句柄.我通过用TFormStyleHook.GetIcon替换TFormStyleHook.GetIconFast来修复它.将其添加到您的某个单位,一切都很好. 

procedure PatchCode(Address: Pointer; const NewCode; Size: Integer);
var
  OldProtect: DWORD;
begin
  if VirtualProtect(Address,Size,PAGE_EXECUTE_READWRITE,OldProtect) then
  begin
    Move(NewCode,Address^,Size);
    FlushInstructionCache(GetCurrentProcess,Address,Size);
    VirtualProtect(Address,OldProtect,@OldProtect);
  end;
end;

type
  PInstruction = ^TInstruction;
  TInstruction = packed record
    Opcode: Byte;
    Offset: Integer;
  end;

procedure RedirectProcedure(OldAddress,NewAddress: Pointer);
var
  NewCode: TInstruction;
begin
  NewCode.Opcode := $E9;//jump relative
  NewCode.Offset := NativeInt(NewAddress)-NativeInt(OldAddress)-SizeOf(NewCode);
  PatchCode(OldAddress,NewCode,SizeOf(NewCode));
end;

type
  TFormStyleHookHelper = class helper for TFormStyleHook
    function GetIconFastAddress: Pointer;
    function GetIconAddress: Pointer;
  end;

function TFormStyleHookHelper.GetIconFastAddress: Pointer;
var
  MethodPtr: function: TIcon of object;
begin
  MethodPtr := Self.GetIconFast;
  Result := TMethod(MethodPtr).Code;
end;

function TFormStyleHookHelper.GetIconAddress: Pointer;
var
  MethodPtr: function: TIcon of object;
begin
  MethodPtr := Self.GetIcon;
  Result := TMethod(MethodPtr).Code;
end;

initialization
  RedirectProcedure(
    Vcl.Forms.TFormStyleHook(nil).GetIconFastAddress,Vcl.Forms.TFormStyleHook(nil).GetIconAddress
  );

关于delphi – 从NC区域删除vcl样式时不显示TMainMenu和delphi 删除文件的介绍现已完结，谢谢您的耐心阅读，如果想了解更多关于Delphi TStatusBar SizeGrip和VCL样式、Delphi VCL样式教程 – 如何在运行时更改样式、Delphi XE2 VCL样式,从TLabel中删除样式或禁用类外观、Delphi XE2 VCL样式,更改窗口Icon在标题栏上不会更新,直到RecreateWnd的相关知识，请在本站寻找。

本文标签：

上一篇Delphi(Indy)TIdTCPClient的主题（delphi coinitialize）

下一篇Delphi 2010 – 无法加载SSL lib（delphi 加载dll）

相关文章