groundbrush
刘耀文的大沙雕
钟意阿满
怎么改变VS2012背景
这种情况应该是填充的进度条的是有损图片资源 ，在填充后放大出现拉伸。
建议使用WPF上面的画刷 SolidColorBrush或Color进行对进度条填充，这些资源在WPF框架都是矢量的。无论你放大多少倍都不会失真。
下面是我自己用的一个ProgressBar模板，可以使用下面的模板或自己定义：
<LinearGradientBrush x:Key="WindowBackgroundBrush" EndPoint="0.5,1" StartPoint="0.5,0">。
<GradientStop Color="#FF4785B0" Offset="0"/>。
<GradientStop Color="#FF63AADA" Offset="1"/>。
</LinearGradientBrush>。
<Color x:Key="PrimaryColor">#FF63AADA</Color>。
<Color x:Key="SecondaryColor">#FFA0FCFF</Color>。
<SolidColorBrush x:Key="PrimaryBrush" Color="{StaticResource PrimaryColor}" />。
<SolidColorBrush x:Key="SecondaryBrush" Color="{DynamicResource SecondaryColor}" />。
<SolidColorBrush x:Key="TextBrush" Color="#FF152937" />。
<Style x:Key="{x:Type ProgressBar}" TargetType="{x:Type ProgressBar}">。
<Setter Property="Foreground" Value="{StaticResource TextBrush}" />。
<Setter Property="Background">。
<Setter.Value>。
<LinearGradientBrush EndPoint="0.5,1" StartPoint="0.5,0">。
<GradientStop Color="#FFB4B4B4" />。
<GradientStop Color="#FFFFFFFF" Offset="1" />。
</LinearGradientBrush>。
</Setter.Value>。
</Setter>。
<Setter Property="BorderThickness" Value="1" />。
<Setter Property="Maximum" Value="100" />。
<Setter Property="IsTabStop" Value="False" />。
<Setter Property="BorderBrush" Value="{StaticResource PrimaryBrush}" />。
<Setter Property="Template">。
<Setter.Value>。
<ControlTemplate TargetType="{x:Type ProgressBar}">。
<Grid x:Name="Root" SnapsToDevicePixels="True">。
<Grid.RowDefinitions>。
<RowDefinition Height="0.5*" />。
<RowDefinition Height="0.5*" />。
</Grid.RowDefinitions>。
<Border CornerRadius="4" x:Name="White" BorderBrush="#FFFFFFFF" BorderThickness="1" Grid.RowSpan="2">。
<Border.Background>。
<RadialGradientBrush>。
<RadialGradientBrush.RelativeTransform>。
<TransformGroup>。
<ScaleTransform CenterX="0.5" CenterY="0.5" ScaleX="1.35" ScaleY="1.35" />。
</TransformGroup>。
</RadialGradientBrush.RelativeTransform>。
<GradientStop Color="#FFFFFFFF" Offset="0" />。
<GradientStop Color="#FFFFFFFF" Offset="1" />。
</RadialGradientBrush>。
</Border.Background>。
</Border>。
<Border x:Name="PART_Track" BorderBrush="{TemplateBinding BorderBrush}" BorderThickness="1" CornerRadius="4,4,4,4" Grid.RowSpan="2" Opacity="0.65" />。
<Grid x:Name="ProgressBarRootGrid" Grid.RowSpan="2">。
<Rectangle x:Name="ProgressBarRootGradient" Canvas.ZIndex="1" Stroke="#FFFFFFFF" StrokeThickness="1" RadiusX="4" RadiusY="4" Opacity="0.65">。
<Rectangle.Fill>。
<LinearGradientBrush EndPoint="0.7,1.263" StartPoint="0.699999988079071,0">。
<GradientStop Color="{StaticResource PrimaryColor}" Offset="0.312" />。
<GradientStop Color="{StaticResource SecondaryColor}" Offset="1" />。
</LinearGradientBrush>。
</Rectangle.Fill>。
</Rectangle>。
<Grid x:Name="IndeterminateRoot" Visibility="Collapsed">。
<Rectangle Margin="{TemplateBinding BorderThickness}" x:Name="IndeterminateSolidFill" Opacity="1" RenderTransformOrigin="0.5,0.5" Fill="{TemplateBinding Foreground}" Stroke="#FF448DCA" StrokeThickness="0" RadiusX="4" RadiusY="4" />。
<Rectangle Margin="{TemplateBinding BorderThickness}" x:Name="IndeterminateGradientFill" Opacity="0.7" StrokeThickness="1" RadiusX="4" RadiusY="4">。
<Rectangle.Fill>。
<LinearGradientBrush MappingMode="Absolute" SpreadMethod="Repeat" EndPoint="0,1" StartPoint="20,1">。
<LinearGradientBrush.Transform>。
<TransformGroup>。
<TranslateTransform X="0" />。
<SkewTransform AngleX="-30" />。
</TransformGroup>。
</LinearGradientBrush.Transform>。
<GradientStop Color="#FFFFFFFF" Offset="0" />。
<GradientStop Color="#00FFFFFF" Offset=".25" />。
<GradientStop Color="#FFFFFFFF" Offset="0.85" />。
</LinearGradientBrush>。
</Rectangle.Fill>。
</Rectangle>。
</Grid>。
<Grid Margin="1" x:Name="DeterminateRoot">。
<Rectangle HorizontalAlignment="Left" Margin="2" x:Name="PART_Indicator" StrokeThickness="0.5" RadiusX="4" RadiusY="4" Fill="{StaticResource PrimaryBrush}" />。
</Grid>。
</Grid>。
<Border BorderBrush="#ccFFFFFF" BorderThickness="1" CornerRadius="3.5" x:Name="InnerBorder" Margin="2" Grid.RowSpan="2" />。
<Border CornerRadius="3.5" x:Name="Shadow" Margin="2" Opacity="0.2" Grid.RowSpan="2">。
<Border.OpacityMask>。
<RadialGradientBrush>。
<RadialGradientBrush.RelativeTransform>。
<TransformGroup>。
<TranslateTransform X="0" Y="-0.5" />。
</TransformGroup>。
</RadialGradientBrush.RelativeTransform>。
<GradientStop Color="#00FFFFFF" Offset="0.3" />。
<GradientStop Color="#FFFFFFFF" Offset="1" />。
</RadialGradientBrush>。
</Border.OpacityMask>。
<Border.Background>。
<RadialGradientBrush>。
<RadialGradientBrush.RelativeTransform>。
<TransformGroup>。
<ScaleTransform CenterX="0.5" CenterY="0.5" ScaleX="1.75" ScaleY="2.25" />。
<TranslateTransform Y="0.65" />。
</TransformGroup>。
</RadialGradientBrush.RelativeTransform>。
<GradientStop Color="#00000000" Offset="0.55" />。
<GradientStop Color="#4C000000" Offset="1" />。
</RadialGradientBrush>。
</Border.Background>。
</Border>。
<Border Margin="1" CornerRadius="4,4,4,10" x:Name="Highlight" Opacity="0.8" RenderTransformOrigin="0.5,1">。
<Border.Background>。
<RadialGradientBrush>。
<RadialGradientBrush.RelativeTransform>。
<TransformGroup>。
<ScaleTransform CenterX="0.5" CenterY="0.5" ScaleX="1.25" ScaleY="2" />。
<TranslateTransform Y="-0.6" />。
</TransformGroup>。
</RadialGradientBrush.RelativeTransform>。
<GradientStop Color="#BFFFFFFF" Offset="0" />。
<GradientStop Color="#4CFFFFFF" Offset="1" />。
</RadialGradientBrush>。
</Border.Background>。
</Border>。
</Grid>。
<ControlTemplate.Triggers>。
<Trigger Property="IsIndeterminate" Value="True">。
<Trigger.EnterActions>。
<BeginStoryboard>。
<Storyboard RepeatBehavior="Forever">。
<DoubleAnimationUsingKeyFrames Storyboard.TargetName="IndeterminateGradientFill" Storyboard.TargetProperty="(Shape.Fill).(LinearGradientBrush.Transform).(TransformGroup.Children)[0].X">。
<SplineDoubleKeyFrame KeyTime="0" Value="0" />。
<SplineDoubleKeyFrame KeyTime="00:00:.5" Value="20" />。
</DoubleAnimationUsingKeyFrames>。
</Storyboard>。
</BeginStoryboard>。
</Trigger.EnterActions>。
<Setter Property="Visibility" Value="Visible" TargetName="IndeterminateRoot" />。
<Setter Property="Visibility" Value="Collapsed" TargetName="DeterminateRoot" />。
</Trigger>。
</ControlTemplate.Triggers>。
</ControlTemplate>。
</Setter.Value>。
</Setter>。
</Style>。
亲测有效，运行效果：
这样，无论将ProgressBar怎样放大，进度条不会产生失真或拉伸的现象。
抱起亚轩找小葵
地下 英文是什么？
在开始之前，先准备Visual Studio 2012 SDK。
安装好SDK后，进入VS。先新建一个Project，在“其它项目类型”那里找到“Visual Studio Package”
接下来的对话框里，选“C#”，然后基本是下一步。在最后一步把那两个复选框取消，因为那个在这里没什么用处。最后就成功新建了个VS扩展的Project。
三、初步改造
第一步我们给VS加上背景图。首先对Project添加WPF的程序集为引用，有四个，分别为“PresentationCore”、“PresentationFramework”、“System.Xaml”、“WindowsBase”。然后打开“XXXPackage.cs”（XXX一般为这个Project的名字）文件，代码如下：
usingMicrosoft.VisualStudio.Shell;。
usingMicrosoft.VisualStudio.Shell.Interop;。
using System;
using System.Runtime.InteropServices;。
using System.Windows;。
using System.Windows.Controls;。
using System.Windows.Media;。
using System.Windows.Media.Imaging;。
namespace Moen.IDEBackground //命名空间自己修改回自己用的。
[PackageRegistration(UseManagedResourcesOnly = true)]。
[InstalledProductRegistration("#110", "#112","1.0", IconResourceID = 400)]。
[Guid(GuidList.guidIDE_BackgroundPkgString)]。
[ProvideAutoLoad(UIContextGuids.NoSolution)]。
[ProvideAutoLoad(UIContextGuids.SolutionExists)]。
public sealed class IDEBackgroundPackage :Package。
{
protected override void Initialize()。
{
base.Initialize();。
Application.Current.MainWindow.Loaded += MainWindow_Loaded;。
}
void MainWindow_Loaded(object sender, RoutedEventArgs e)。
{
var rWindow = (Window)sender;。
//加载图片。
var rImageSource =BitmapFrame.Create(new Uri(@"G:\Picture\Pool\絵师100人展02_p109.png"/*图片路径*/),BitmapCreateOptions.None, BitmapCacheOption.OnLoad);。
rImageSource.Freeze();。
var rImageControl = new Image()。
{。
Source = rImageSource,。
Stretch =Stretch.UniformToFill, //按比例填充。
HorizontalAlignment =HorizontalAlignment.Center, //水平方向中心对齐。
VerticalAlignment =VerticalAlignment.Center, //垂直方向中心对齐。
};。
Grid.SetRowSpan(rImageControl, 4);。
var rRootGrid =(Grid)rWindow.Template.FindName("RootGrid", rWindow);。
rRootGrid.Children.Insert(0, rImageControl);。
}
}
代码修改一下后，调试，这时就会编译扩展，然后启动实验用VS。（如果这是第一次启动实验用VS，可能要像刚安装完VS那样设置一下）接着你会看到角落处显现出那张背景图。
（免调试进入实验用VS方法：开始菜单->Microsoft Visual Studio 2012->Microsoft Visual Studio SDK->Tools->Start Experimental Instance of Visual Studio 2012）
四、修改皮肤配色
为了方便，在实验用VS处进入“工具->扩展功能和更新程序”，选“在线”部分，然后在中间找到“Visual Studio 2012 Color ThemeEditor”并安装，重启实验用VS。
重启后，进入“工具->CustomizeColors”。本例子已深色为基础，于是在左边“New Theme”处，直接在文本框输入一个皮肤名，然后点“Create”。这样就进入了皮肤配色表。
首先把主界面那一大块灰色给除掉。找到“Environment→ EnvironmentBackgroundGradient”为开头的，统统都把不透明度设为0。然后点表左上角的“Save andApply Theme”，关掉所有页面。然后你就会看到背景啦。
再继续，找到“Environment→ MainWindowActiveCaption”、“Environment→ MainWindowInactiveCaption”、“Environment→ CommandShelfBackgroundGradientXXX”、“Environment→ CommandShelfHighlightGradientXXX”、“Environment→ CommandBarGradientXXX”、“Environment→ CommandBarToolBarBorder”，都把不透明度设为0，
然后应用。上面那部分灰色的也没啦。
至于这些是对应哪里的呢，可以通过那名字来确定，不过不准。要详细弄清楚很麻烦，要用反编译软件反要修改的控件的xaml文档，找到对应的画刷名。非常复杂，所以我这里提供我自己用的。在“Customize Colors”那里点“Import Theme”即可。
五、编辑器
到目前为止，打开文件后，编辑器的背景还是黑的。接下来就是把这层黑的去掉。
先打开“source.extension.vsixmanifest”文件，进入“Assets”选项卡，单击“New”按钮。在弹出的对话框里，“Type”选“Microsoft.VisualStudio.MefComponent”，“Source”选“Aproject in current solution”，“Project”选当前的Project，目前应该就一个选项的。最后OK。
接下来新建一个文件，这里就叫“EditorBackground.cs”
在输入代码前添加几个引用——System.ComponentModel.Composition、Microsoft.VisualStudio.CoreUtility、Microsoft.VisualStudio.Text.UI、Microsoft.VisualStudio.Text.UI.Wpf（后三个在“扩展”处找）
搞定后文件代码如下：
usingMicrosoft.VisualStudio.Text.Classification;。
usingMicrosoft.VisualStudio.Text.Editor;。
usingMicrosoft.VisualStudio.Utilities;。
usingSystem;
usingSystem.ComponentModel.Composition;。
usingSystem.Windows;。
usingSystem.Windows.Controls;。
usingSystem.Windows.Media;。
using System.Windows.Threading;。
namespaceMoen.IDEBackground。
[Export(typeof(IWpfTextViewCreationListener))]。
[ContentType("Text")]。
[ContentType("BuildOutput")]。
[TextViewRole(PredefinedTextViewRoles.Document)]。
class Listener : IWpfTextViewCreationListener。
{
[Import]。
IEditorFormatMapServiceEditorFormatMapService = null;。
public voidTextViewCreated(IWpfTextView rpTextView)。
{
new EditorBackground(rpTextView);。
//去掉断点边栏的背景。
var rProperties =EditorFormatMapService.GetEditorFormatMap(rpTextView).GetProperties("IndicatorMargin");。
rProperties["BackgroundColor"] = Colors.Transparent;。
rProperties["Background"]= Brushes.Transparent;。
}
}
class EditorBackground。
{
IWpfTextView r_TextView;。
ContentControl r_Control;。
Grid r_ParentGrid;。
Canvas r_ViewStack;。
public EditorBackground(IWpfTextViewrpTextView)。
{
r_TextView = rpTextView;。
r_Control = (ContentControl)r_TextView;。
r_TextView.Background =Brushes.Transparent;。
r_TextView.BackgroundBrushChanged+= TextView_BackgroundBrushChanged;。
r_TextView.Closed +=TextView_Closed;。
r_Control.Loaded +=TextView_Loaded;。
}
void MakeBackgroundTransparent()。
{
r_TextView.Background =Brushes.Transparent;。
r_ViewStack.Background =Brushes.Transparent;。
r_ParentGrid.ClearValue(Grid.BackgroundProperty);。
}
void TextView_Loaded(object sender,RoutedEventArgs e)。
{
if (r_ParentGrid == null)。
r_ParentGrid =(Grid)r_Control.Parent;。
if (r_ViewStack == null)。
r_ViewStack =(Canvas)r_Control.Content;。
MakeBackgroundTransparent();。
}
voidTextView_BackgroundBrushChanged(object sender, BackgroundBrushChangedEventArgse)。
{
r_Control.Dispatcher.BeginInvoke(new Action(() =>。
{
while (r_ParentGrid.Background!= null)。
MakeBackgroundTransparent();。
}), DispatcherPriority.Render);。
}
void TextView_Closed(object sender,EventArgs e)。
{
//清除委托，以防内存泄露。
r_TextView.Closed -=TextView_Closed;。
r_TextView.BackgroundBrushChanged-= TextView_BackgroundBrushChanged;。
}
}
调试进入实验用VS，进入配色表，找到“Environment →EnvironmentBackground”，设置一个颜色值（我这里是#A0000000），作为编辑器的背景色。再找到“Environment → Window”设置为透明。
六、结尾
基本的VS界面改造就是这么多了。不过有个棘手的问题——xaml编辑器和个别的编辑器（如HTML的）因为是承载在VS的一个子窗口上，而这个窗口的背景是黑色的。目前仍在研究中……
大圣杰锅是
使用vc如何改变控件颜色
地下的英文是：underground。
underground
英 [ˈʌndəgraʊnd] 美 [ˈʌndərgraʊnd] 。
adj.地下的;秘密的;先锋派的;隐蔽的。
adv.在地下;秘密地，偷偷地。
n.地下;地铁;地下组织或活动;地道。
例句：
1、We'll visit some of the underground passages.。
我们将会参观一些地下的通道。
2、Hopes are fading for those still trapped underground.。
那些仍陷在地下的人的信心正在一点点衰退。
扩展资料：
underground记忆技巧：under 在…下或内 + ground 地 → 地下的。
underground dustbin 地下垃圾坑。
underground passages〔caves, water〕 地下通道。
underground，subway，tube这些名词均可表示“地铁”之意。
1、underground一般用词，指城市中的地铁，主要用于英国。
2、subway指城市中的地铁或通道，主要用于美国。
3、tube主要用于英国口语中。
under词根：在…下或内
1、underbrush，n. 树林下的草丛。
under 在…下或内 + brush 小树丛 → 树林下的草丛。
2、underclass，n. 下层社会；低年级。
under 在…下或内 + class 社会等级；班级 → 下层社会；低年级。
3、undercurrent，n. 潜流，暗流。
under 在…下或内 + current 潮流 → 潜流，暗流。
4、underfoot，adv. 在脚下面。
under 在…下或内 + foot 脚 → 在脚下面。
小韩在追星
在vb怎么用API把text设置为透明又可以接受光标
有两种方法。其一，可以在父类中指定控件的颜色，或者利用MFC4.0新的消息反射在控件类中指定颜色。 当控件需要重新着色时，工作框调用父窗口（通常是对话框）的CWnd: : OnCrtlColor,可以在父窗口类中重置该函数并指定控件的新的绘画属性。例如，下述代码将对话中的所有编辑控件文本颜色改为红色：
HBRUSH CAboutDig : : OnCtlColor (CDC * pDCM , CWnd * pWnd , UINT nCtlColor)。
HBRUSH hbr = CDialog : : OnCtlColor (pDC, pWnd , nCtlColor )。
//Draw red text for all edit controls .。
if (nCtlColor= = CTLCOLOR_EDIT )。
pDC —> SetTextColor (RGB (255, 0 , 0 , ) )。
return hbr
然而，由于每个父窗口必须处理通知消息并指定每个控件的绘画属性，所以，这种方法不完全的面向对象的方法。控件处理该消息并指定绘画属性更合情合理。消息反射允许用户这样做。通知消息首先发送给父窗口，如果父窗口没有处理则发送给控件。创建一个定制彩色列表框控件必须遵循下述步骤。
首先，使用ClassWizard 创建一个CListBox 的派生类并为该类添加下述。
数据成员。
class CMyListBox publilc CListBox。
…
private
COLORREF m_clrFor // foreground color。
COLORREF m_clrBack //background color。
Cbrush m_brush //background brush。
…
其次，在类的构造函数中，初始化数据中。
CMyListBox : : CMyListBox ()。
//Initialize data members .。
m_clrFore =RGB (255 , 255 , 0) //yellow text。
m_clrBack=RGB (0 , 0 , 255) // blue background。
m_brush . CreateSolidBrush (m _clrBack )。
最后，使用ClassWizard处理反射的WM_CTLCOLOR(=WM_CTLCOLOR)消息并指定。
新的绘画属性。
HBRUSH CMyListBox : : CtlColor (CDC* pDC, UINT nCtlColor )。
pDC—>SetTextColor (m_clrFore)。
pDC—>SetBkColor (m_clrBack)。
return (HBRUSH) m_brush.GetSafeHandle ()。
现在，控件可以自己决定如何绘画，与父窗口无关。
小韩在追星
关于拷贝构造函数的问题
具体代码如下:
新建一个模块,把以下代码复制进去:。
Option Explicit。
' APIs to install our subclassing routines。
Private Const GWL_WNDPROC = (-4)。
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long。
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long。
Private Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long。
' These APIs are used to create a pattern brush for each textbox...。
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long。
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long。
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long。
Private Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBitmap As Long) As Long。
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long。
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long。
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long。
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long。
Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long。
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long。
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long。
' Messages which we will be processing in our subclassing routines。
Private Const WM_COMMAND As Long = &H111。
Private Const WM_CTLCOLOREDIT As Long = &H133。
Private Const WM_DESTROY As Long = &H2。
Private Const WM_ERASEBKGND As Long = &H14。
Private Const WM_HSCROLL As Long = &H114。
Private Const WM_VSCROLL As Long = &H115。
' A rectangle.
Private Type RECT。
Left As Long
Top As Long
Right As Long
Bottom As Long。
End Type
' APIs used to keep track of brush handles and process addresses。
Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As Long, ByVal lpString As String) As Long。
Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As Long, ByVal lpString As String) As Long。
Private Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As Long, ByVal lpString As String, ByVal hData As Long) As Long。
' APIs used in our subclassing routine to create the "transparent" effect.。
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long。
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long。
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long。
Private Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long, ByVal lpRect As Long, ByVal bErase As Long) As Long。
Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long。
Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long。
Private Declare Function UpdateWindow Lib "user32" (ByVal hwnd As Long) As Long。
Private Declare Function WindowFromDC Lib "user32" (ByVal hdc As Long) As Long。
Public Function makeTransparentTextbox(aTxt As TextBox)。
' Make sure we don't have any typos in our subclassing procedures.。
NewWindowProc 0, 0, 0, 0。
NewTxtBoxProc 0, 0, 0, 0。
' Create a background brush for this textbox, which we will used to give。
' the textbox an APPEARANCE of transparency。
CreateBGBrush aTxt。
' Subclass the textbox's form, IF NOT ALREADY subclassed。
If GetProp(GetParent(aTxt.hwnd), "OrigProcAddr") = 0 Then。
SetProp GetParent(aTxt.hwnd), "OrigProcAddr", SetWindowLong(GetParent(aTxt.hwnd), GWL_WNDPROC, AddressOf NewWindowProc)。
End If
' Subclass the textbox, IF NOT ALREADY subclassed。
If GetProp(aTxt.hwnd, "OrigProcAddr") = 0 Then。
SetProp aTxt.hwnd, "OrigProcAddr", SetWindowLong(aTxt.hwnd, GWL_WNDPROC, AddressOf NewTxtBoxProc)。
End If
End Function
Private Sub CreateBGBrush(aTxtBox As TextBox)。
Dim screenDC As Long ' The screen's device context.。
Dim imgLeft As Long ' The X location inside the image which we are going to copy from.。
Dim imgTop As Long ' The Y location inside the image which we are going to copy from.。
Dim picDC As Long ' A temporary DC to pull the form's picture into。
Dim picBmp As Long ' the 1x1 bitmap which is created with picDC。
Dim aTempBmp As Long ' A temporary bitmap we'll use to create the pattern brush for our textbox。
Dim aTempDC As Long ' the temporary device context used to hold aTempBmp。
Dim txtWid As Long ' The form's width。
Dim txtHgt As Long ' the form's height.。
Dim solidBrush As Long ' Solid brush used to color in the bitmap... incase the textbox。
' gets sized outside the dimensions of the picture。
Dim aRect As RECT ' Rectangle to fill in with solid brush。
If aTxtBox.Parent.Picture Is Nothing Then Exit Sub。
' Get our form's dimensions, in pixels。
txtWid = aTxtBox.Width / Screen.TwipsPerPixelX。
txtHgt = aTxtBox.Height / Screen.TwipsPerPixelY。
' Get the location within the bitmap picture we're copying from。
imgLeft = aTxtBox.Left / Screen.TwipsPerPixelX。
imgTop = aTxtBox.Top / Screen.TwipsPerPixelY。
' Get the screen's device context。
screenDC = GetDC(0)。
' Create a device context to hold the form's picture.。
picDC = CreateCompatibleDC(screenDC)。
picBmp = SelectObject(picDC, aTxtBox.Parent.Picture.Handle)。
' Create a temporary bitmap to blt the underlying image onto。
aTempDC = CreateCompatibleDC(screenDC)。
aTempBmp = CreateCompatibleBitmap(screenDC, txtWid, txtHgt)。
DeleteObject SelectObject(aTempDC, aTempBmp)。
' create a brush the color of BUTTON_FACE。
solidBrush = CreateSolidBrush(GetSysColor(15))。
aRect.Right = txtWid。
aRect.Bottom = txtHgt。
' Fill in the area。
FillRect aTempDC, aRect, solidBrush。
' clean up our resource。
DeleteObject solidBrush。
' Transfer the image。
BitBlt aTempDC, 0, 0, txtWid, txtHgt, picDC, imgLeft, imgTop, vbSrcCopy。
' Check to make sure that a brush hasn't already been made for this one。
If GetProp(aTxtBox.hwnd, "CustomBGBrush") <> 0 Then。
' If so, then delete it and free its memory before storing the new one's handle.。
DeleteObject GetProp(aTxtBox.hwnd, "CustomBGBrush")。
End If
' Create a pattern brush from our bitmap and store its handle against。
' the textbox's handle。
SetProp aTxtBox.hwnd, "CustomBGBrush", CreatePatternBrush(aTempBmp)。
' Clean up our temporary DC and bitmap resources。
DeleteDC aTempDC。
DeleteObject aTempBmp。
' Replace the original 1x1 bitmap, releasing the form's picture。
SelectObject picDC, picBmp。
' Clean up our picture DC and the 1x1 bitmap that was created with it。
DeleteDC picDC。
DeleteObject picBmp。
' Release the screen's DC back to the system... forgetting to do this。
' causes a nasty memory leak.。
ReleaseDC 0, screenDC。
End Sub
Private Function NewWindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long。
' ******************************************************。
' SUBCLASSING ROUTINE FOR THE TEXTBOX'S >>>>PARENT<<<<。
' ******************************************************。
Dim origProc As Long ' The original process address for the window.。
Dim isSubclassed As Long ' Whether a certain textbox is subclassed or not.。
' I've gotten in the habit of passing 0 values to the subclassing functions before。
' actually installing them, just to make sure that I don't have any typos or other。
' problems which can be easily detected. As such, if there is a hwnd of 0, its not。
' a "valid" message, so we'll just exit right away.。
If hwnd = 0 Then Exit Function。
' Get the original process address which we stored earlier.。
origProc = GetProp(hwnd, "OrigProcAddr")。
If origProc <> 0 Then。
If (uMsg = WM_CTLCOLOREDIT) Then。
' Check to see if our window has a stored value for the original。
' process address. If so, we're subclassing this one.。
isSubclassed = (GetProp(WindowFromDC(wParam), "OrigProcAddr") <> 0)。
If isSubclassed Then。
' Invoke the default process... This will set the font, font color。
' and other stuff we don't really want to fool with.。
CallWindowProc origProc, hwnd, uMsg, wParam, lParam。
' Make the words print transparently。
SetBkMode wParam, 1。
' Return the handle to our custom brush rather than that which。
' the default process would have returned.。
NewWindowProc = GetProp(WindowFromDC(wParam), "CustomBGBrush")。
Else
' The textbox in question isn't subclassed, so we aren't going。
' to do anything out of the ordinary. Just invoke the default proc.。
NewWindowProc = CallWindowProc(origProc, hwnd, uMsg, wParam, lParam)。
End If
ElseIf uMsg = WM_COMMAND Then。
' Check to see if our window has a stored value for the original。
' process address. If so, we're subclassing this one.。
isSubclassed = (GetProp(lParam, "OrigProcAddr") <> 0)。
If isSubclassed Then。
' We are going lock the window from updating while we invalidate。
' and redraw it. This prevents flickering.。
LockWindowUpdate GetParent(lParam)。
' Force windows to redraw the window.。
InvalidateRect lParam, 0&, 1&。
UpdateWindow lParam。
End If
' Invoke the default process。
NewWindowProc = CallWindowProc(origProc, hwnd, uMsg, wParam, lParam)。
If isSubclassed Then LockWindowUpdate 0&。
ElseIf uMsg = WM_DESTROY Then。
' The window is being destroyed... time to unhook our process so we。
' don't cause a big fat error which crashes the application.。
' Install the default process address again。
SetWindowLong hwnd, GWL_WNDPROC, origProc。
' Invoke the default process。
NewWindowProc = CallWindowProc(origProc, hwnd, uMsg, wParam, lParam)。
' Remove our stored value since we don't need it anymore。
RemoveProp hwnd, "OrigProcAddr"。
Else
' We're not concerned about this particular message, so we'll just。
' let it go on its merry way.。
NewWindowProc = CallWindowProc(origProc, hwnd, uMsg, wParam, lParam)。
End If
Else
' A catch-all in case something freaky happens with the process addresses.。
NewWindowProc = DefWindowProc(hwnd, uMsg, wParam, lParam)。
End If
End Function
Private Function NewTxtBoxProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long。
' *********************************************。
' SUBCLASSING ROUTINE FOR THE >>>>TEXTBOX<<<<。
' *********************************************。
Dim aRect As RECT。
Dim origProc As Long。
Dim aBrush As Long。
If hwnd = 0 Then Exit Function。
' Get the original process address which we stored earlier.。
origProc = GetProp(hwnd, "OrigProcAddr")。
If origProc <> 0 Then。
' We're subclassing! Which is silly, 'cause otherwise we wouldn't be in。
' this function, however we double check the process address just in case.。
If uMsg = WM_ERASEBKGND Then。
' We're going to get our custom brush for this textbox and fill the。
' textbox's background area with it...。
aBrush = GetProp(hwnd, "CustomBGBrush")。
If aBrush <> 0 Then。
' Get the area dimensions to fill。
GetClientRect hwnd, aRect。
' Fill it with our custom brush。
FillRect wParam, aRect, aBrush。
' Tell windows that we took care of the "erasing"。
NewTxtBoxProc = 1。
Else
' Something happened to our custom brush :-\ We'll just invoke。
' the default process。
NewTxtBoxProc = CallWindowProc(origProc, hwnd, uMsg, wParam, lParam)。
End If
ElseIf uMsg = WM_HSCROLL Or uMsg = WM_VSCROLL Then。
' We are scrolling, either horizontally or vertically. This requires。
' us to totally repaint the background area... so we'll lock the。
' window updates so we don't see any of the freaky flickering。
LockWindowUpdate GetParent(hwnd)。
' Invoke the default process so the user actually get's the scroll。
' they want
NewTxtBoxProc = CallWindowProc(origProc, hwnd, uMsg, wParam, lParam)。
' Force window to repaint itself。
InvalidateRect hwnd, 0&, 1&。
UpdateWindow hwnd。
' Release the update lock。
LockWindowUpdate 0&。
ElseIf uMsg = WM_DESTROY Then。
' The textbox's parent is closing / destroying, so we need to。
' unhook our subclassing routine ... or bad things happen。
' Clean up our brush object... muy importante!!!。
aBrush = GetProp(hwnd, "CustomBGBrush")。
' Delete the brush object, freeing its resource.。
DeleteObject aBrush。
' Remove our values we stored against the textbox's handle。
RemoveProp hwnd, "OrigProcAddr"。
RemoveProp hwnd, "CustomBGBrush"。
' Replace the original process address。
SetWindowLong hwnd, GWL_WNDPROC, origProc。
' Invoke the default "destroy" process。
NewTxtBoxProc = CallWindowProc(origProc, hwnd, uMsg, wParam, lParam)。
Else
' We're not interested in this message, so we'll just let it truck。
' right on thru... invoke the default process。
NewTxtBoxProc = CallWindowProc(origProc, hwnd, uMsg, wParam, lParam)。
End If
Else
' A catch-all in case something freaky happens with the process addresses.。
NewTxtBoxProc = DefWindowProc(hwnd, uMsg, wParam, lParam)。
End If
End Function
---------------------------------------------------------------------------------。
在窗体Form代码中，把以下代码复制进去:。
Private Sub Form_Load()。
makeTransparentTextbox Text1 'Text1是需要透明的文本框。
End Sub