关于一个透明的Edit控件!(50分)

  • 主题发起人 主题发起人 jbas
  • 开始时间 开始时间
J

jbas

Unregistered / Unconfirmed
GUEST, unregistred user!
小弟初学控件制作,我想作一个透明的Edit控件,但用下面的代码,一开始是透明胡,但总是当我输入东西时,就
出现了白色的底色,去不掉,各位高手帮一下谢谢了!
unit TransEdit;

interface

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

type
TTransEdit = class(TEdit)
private
{ Private declarations }
protected
{ Protected declarations }
procedure createparams(Var Params:TCreateParams);override;
public
{ Public declarations }
published
{ Published declarations }
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Samples', [TTransEdit]);
end;

{ TTransEdit }

procedure TTransEdit.createparams(var Params: TCreateParams);
begin
inherited createparams(Params);
params.ExStyle:=params.ExStyle or WS_EX_TRANSPARENT;
invalidate;
end;

end.
 
这个是网上的一个源码,代码长了许多,但还是有上面的毛病。各位高手帮忙一下了。
unit RbsWiredEdit;

interface

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

const
TWM_RbsInvalidate=WM_USER+1;

type
TRbsWiredEdit = class(TEdit)
private
{ Private declarations }
procedure RbsInvalidate(var Message:TMessage); message
TWM_RbsInvalidate;
procedure CNCTLCOLOREDIT(var Message:TWMCTLCOLOREDIT); message
CN_CTLCOLOREDIT;
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
procedure WMMove(var Message: TMessage); message WM_MOVE;

protected
{ Protected declarations }
FTransparent: boolean;
procedure CreateWnd; override;
procedure CreateParams(var Params: TCreateParams); override;
procedure DoExit; override;
procedure DoEnter; override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
procedure Invalidate; override;

published
{ Published declarations }
end;

procedure Register;

implementation

constructor TRbsWiredEdit.Create(AOwner:TComponent);
begin
inherited create(AOwner);
ftransparent:=true;
end;

procedure TRbsWiredEdit.CreateWnd;
begin
inherited CreateWnd;
if fTransparent then
begin
SetWindowLong(Parent.Handle, GWL_STYLE,
GetWindowLong(Parent.Handle, GWL_STYLE) and not WS_CLIPCHILDREN);
end;
end;

procedure TRbsWiredEdit.RbsInvalidate(var Message:TMessage);
var r:TRect;
begin
if (Parent<>nil) and FTransparent then
begin
r:=ClientRect;
r.TopLeft:=Parent.ScreenToClient(ClientToScreen(r.TopLeft));
r.BottomRight:=Parent.ScreenToClient(ClientToScreen(r.BottomRight));
RedrawWindow(Handle,nil,0,RDW_FRAME+RDW_INVALIDATE);
end;
end;

procedure TRbsWiredEdit.CNCTLCOLOREDIT(var Message:TWMCTLCOLOREDIT);
begin
if FTransparent then
with Message do
begin
SetBkMode(ChildDC,Windows.TRANSPARENT);
Result:=GetStockObject(HOLLOW_BRUSH)
end
else inherited;
end;



procedure TRbsWiredEdit.WMEraseBkgnd(var Message:TWMERASEBKGND);
begin
if FTransparent and not (csDesigning in ComponentState) then
PostMessage(Handle,TWM_RbsInvalidate,0,0)
else inherited;
end;

procedure TRbsWiredEdit.WMMove(var message:TMessage);
begin
inherited;
if FTransparent then SendMessage(Handle,TWM_RbsInvalidate,0,0)
else Invalidate;
end;

procedure TRbsWiredEdit.CreateParams(var Params:TCreateParams);
begin
inherited CreateParams(Params);
if (CsDesigning in ComponentState) then exit;
with Params do
begin
ExStyle:=ExStyle or WS_EX_TRANSPARENT;
end;
end;

procedure TRbsWiredEdit.DoExit;
begin
inherited;
FTransparent:=true;
SetCursor(0);
RecreateWnd;
end;

procedure TRbsWiredEdit.DoEnter;  //有高手说改这里,但我怎么改都不行,各位看看。
var exstyle,stdstyle:longint;
begin
inherited;
Ftransparent:=false;
StdStyle:= Windows.GetWindowLong(handle, GWL_EXSTYLE);
exStyle:= StdStyle and not WS_EX_TRANSPARENT;
Windows.SetWindowLong(handle, GWL_EXSTYLE, exStyle);
invalidate;
end;

procedure TRbsWiredEdit.Invalidate;
begin
if FTransparent then SendMessage(Handle,TWM_RbsInvalidate,0,0)
else inherited;
end;

procedure Register;
begin
RegisterComponents('Rombest', [TRbsWiredEdit]);
end;

end.
 
使用coolctrl
 
老兄,哪里下载呀?for D6要有source的。谢了!
 
论坛上很多有这样的帖子,你看看别人是怎么做的就OK
 
>>论坛上很多有这样的帖子,你看看别人是怎么做的就OK
老兄,我当然看过了,找不到能用的,才发分问的,难到我不心疼我的分?
你能否帮我找找?
 
哈哈,通过一个朋友的帮忙找到一个控件透明memo,edit。代码如下:
{**************************************************************}
{ Name: Transparent Components for Delphi 32 }
{ Author: Medialight Software Solutions }
{ E-Mail: Medialight@yahoo.com }
{ Home Page: http://www.geocities.com/medialight }
{ Created: December, 02, 2000 }
{ Legal: Copyright (c) 2000, Medialight Software Solutions }
{**************************************************************}
{ PUBLISHED PROPERTIES: }
{ Transparent - Sets a memo or an edit box transparent }
{**************************************************************}
{ Transparent Components currently includes 2 components: Memo }
{ and Edit box. All these components have "Transparent" }
{ property, which gives you window transparency. }
{**************************************************************}
{ IMPORTANT NOTE: }
{ This software is provided 'as-is', without any express or }
{ implied warranty. In no event will the author be held }
{ liable for any damages arising from the use of this }
{ software. }
{ Permission is granted to anyone to use this software for }
{ any purpose, including commercial applications, and to }
{ alter it and redistribute it freely, subject to the }
{ following restrictions: }
{ 1. The origin of this software must not be misrepresented, }
{ you must not claim that you wrote the original software. }
{ If you use this software in a product, an acknowledgment }
{ in the product documentation would be appreciated but is }
{ not required. }
{ 2. Altered source versions must be plainly marked as such, }
{ and must not be misrepresented as being the original }
{ software. }
{ 3. This notice may not be removed or altered from any }
{ source distribution. }
{**************************************************************}

unit TranComp;

interface

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

type
TCtrl = class(TWinControl);

TTransEdit = class(TEdit)
private
FAlignText: TAlignment;
FTransparent: Boolean;
FPainting: Boolean;
procedure SetAlignText(Value: TAlignment);
procedure SetTransparent(Value: Boolean);
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
procedure WMNCPaint (var Message: TMessage); message WM_NCPAINT;
procedure WMEraseBkGnd(var Message: TWMEraseBkGnd); message WM_ERASEBKGND;
procedure CNCtlColorEdit(var Message: TWMCtlColorEdit); message CN_CTLCOLOREDIT;
procedure CNCtlColorStatic(var Message: TWMCtlColorStatic); message CN_CTLCOLORSTATIC;
procedure CMParentColorChanged(var Message: TMessage); message CM_PARENTCOLORCHANGED;
procedure WMSize(var Message: TWMSize); message WM_SIZE;
procedure WMMove(var Message: TWMMove); message WM_MOVE;
protected
procedure RepaintWindow;
procedure CreateParams(var Params: TCreateParams); override;
procedure Change; override;
procedure SetParent(AParent: TWinControl); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property AlignText: TAlignment read FAlignText write SetAlignText default taLeftJustify;
property Transparent: Boolean read FTransparent write SetTransparent default false;
end;

// Transparent Memo
TTransMemo = class(TMemo)
private
FAlignText: TAlignment;
FTransparent: Boolean;
FPainting: Boolean;
procedure SetAlignText(Value: TAlignment);
procedure SetTransparent(Value: Boolean);
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
procedure WMNCPaint (var Message: TMessage); message WM_NCPAINT;
procedure WMEraseBkGnd(var Message: TWMEraseBkGnd); message WM_ERASEBKGND;
procedure CNCtlColorEdit(var Message: TWMCtlColorEdit); message CN_CTLCOLOREDIT;
procedure CNCtlColorStatic(var Message: TWMCtlColorStatic); message CN_CTLCOLORSTATIC;
procedure CMParentColorChanged(var Message: TMessage); message CM_PARENTCOLORCHANGED;
procedure WMSize(var Message: TWMSize); message WM_SIZE;
procedure WMMove(var Message: TWMMove); message WM_MOVE;
protected
procedure RepaintWindow;
procedure CreateParams(var Params: TCreateParams); override;
procedure Change; override;
procedure SetParent(AParent: TWinControl); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property AlignText: TAlignment read FAlignText write SetAlignText default taLeftJustify;
property Transparent: Boolean read FTransparent write SetTransparent default false;
end;

procedure Register;

implementation

const
BorderRec: array[TBorderStyle] of Integer = (1, -1);

procedure Register;
begin
RegisterComponents('Transparent Components', [TTransEdit, TTransMemo]);
end;

function GetScreenClient(Control: TControl): TPoint;
var
p: TPoint;
begin
p := Control.ClientOrigin;
ScreenToClient(Control.Parent.Handle, p);
Result := p;
end;

constructor TTransEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FAlignText := taLeftJustify;
FTransparent := false;
FPainting := false;
end;

destructor TTransEdit.Destroy;
begin
inherited Destroy;
end;

procedure TTransEdit.SetAlignText(Value: TAlignment);
begin
if FAlignText <> Value then
begin
FAlignText := Value;
RecreateWnd;
Invalidate;
end;
end;

procedure TTransEdit.SetTransparent(Value: Boolean);
begin
if FTransparent <> Value then
begin
FTransparent := Value;
Invalidate;
end;
end;

procedure TTransEdit.WMEraseBkGnd(var Message: TWMEraseBkGnd);
var
DC: hDC;
i: integer;
p: TPoint;
begin
if FTransparent then
begin
if Assigned(Parent) then
begin
DC := Message.DC;
i := SaveDC(DC);
p := GetScreenClient(self);
p.x := -p.x;
p.y := -p.y;
MoveWindowOrg(DC, p.x, p.y);
SendMessage(Parent.Handle, $0014, DC, 0);
TCtrl(Parent).PaintControls(DC, nil);
RestoreDC(DC, i);
end;
end else inherited;
end;

procedure TTransEdit.WMPaint(var Message: TWMPaint);
begin
inherited;
if FTransparent then
if not FPainting then
RepaintWindow;
end;

procedure TTransEdit.WMNCPaint(var Message: TMessage);
begin
inherited;
end;

procedure TTransEdit.CNCtlColorEdit(var Message: TWMCtlColorEdit);
begin
inherited;
if FTransparent then
SetBkMode(Message.ChildDC, 1);
end;

procedure TTransEdit.CNCtlColorStatic(var Message: TWMCtlColorStatic);
begin
inherited;
if FTransparent then
SetBkMode(Message.ChildDC, 1);
end;

procedure TTransEdit.CMParentColorChanged(var Message: TMessage);
begin
inherited;
if FTransparent then
Invalidate;
end;

procedure TTransEdit.WMSize(var Message: TWMSize);
begin
inherited;
Invalidate;
end;

procedure TTransEdit.WMMove(var Message: TWMMove);
begin
inherited;
Invalidate;
end;

procedure TTransEdit.RepaintWindow;
var
DC: hDC;
TmpBitmap, Bitmap: hBitmap;
begin
if FTransparent then
begin
FPainting := true;
HideCaret(Handle);
DC := CreateCompatibleDC(GetDC(Handle));
TmpBitmap := CreateCompatibleBitmap(GetDC(Handle), Succ(ClientWidth), Succ(ClientHeight));
Bitmap := SelectObject(DC, TmpBitmap);
PaintTo(DC, 0, 0);
BitBlt(GetDC(Handle), BorderRec[BorderStyle], BorderRec[BorderStyle], ClientWidth, ClientHeight, DC, 1, 1, SRCCOPY);
SelectObject(DC, Bitmap);
DeleteDC(DC);
ReleaseDC(Handle, GetDC(Handle));
DeleteObject(TmpBitmap);
ShowCaret(Handle);
FPainting := false;
end;
end;

procedure TTransEdit.CreateParams(var Params: TCreateParams);
const
Alignments: array [TAlignment] of DWord = (ES_LEFT, ES_RIGHT, ES_CENTER);
begin
inherited CreateParams(Params);
Params.Style := Params.Style or ES_MULTILINE or Alignments[FAlignText];
end;

procedure TTransEdit.Change;
begin
RepaintWindow;
inherited Change;
end;

procedure TTransEdit.SetParent(AParent: TWinControl);
begin
inherited SetParent(AParent);
end;

// Transparent Memo
constructor TTransMemo.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FAlignText := taLeftJustify;
FTransparent := false;
FPainting := false;
end;

destructor TTransMemo.Destroy;
begin
inherited Destroy;
end;

procedure TTransMemo.SetAlignText(Value: TAlignment);
begin
if FAlignText <> Value then
begin
FAlignText := Value;
RecreateWnd;
Invalidate;
end;
end;

procedure TTransMemo.SetTransparent(Value: Boolean);
begin
if FTransparent <> Value then
begin
FTransparent := Value;
Invalidate;
end;
end;

procedure TTransMemo.WMEraseBkGnd(var Message: TWMEraseBkGnd);
var
DC: hDC;
i: integer;
p: TPoint;
begin
if FTransparent then
begin
if Assigned(Parent) then
begin
DC := Message.DC;
i := SaveDC(DC);
p := GetScreenClient(self);
p.x := -p.x;
p.y := -p.y;
MoveWindowOrg(DC, p.x, p.y);
SendMessage(Parent.Handle, $0014, DC, 0);
TCtrl(Parent).PaintControls(DC, nil);
RestoreDC(DC, i);
end;
end else inherited;
end;

procedure TTransMemo.WMPaint(var Message: TWMPaint);
begin
inherited;
if FTransparent then
if not FPainting then
RepaintWindow;
end;

procedure TTransMemo.WMNCPaint(var Message: TMessage);
begin
inherited;
end;

procedure TTransMemo.CNCtlColorEdit(var Message: TWMCtlColorEdit);
begin
inherited;
if FTransparent then
SetBkMode(Message.ChildDC, 1);
end;

procedure TTransMemo.CNCtlColorStatic(var Message: TWMCtlColorStatic);
begin
inherited;
if FTransparent then
SetBkMode(Message.ChildDC, 1);
end;

procedure TTransMemo.CMParentColorChanged(var Message: TMessage);
begin
inherited;
if FTransparent then
Invalidate;
end;

procedure TTransMemo.WMSize(var Message: TWMSize);
begin
inherited;
Invalidate;
end;

procedure TTransMemo.WMMove(var Message: TWMMove);
begin
inherited;
Invalidate;
end;

procedure TTransMemo.RepaintWindow;
var
DC: hDC;
TmpBitmap, Bitmap: hBitmap;
begin
if FTransparent then
begin
FPainting := true;
HideCaret(Handle);
DC := CreateCompatibleDC(GetDC(Handle));
TmpBitmap := CreateCompatibleBitmap(GetDC(Handle), Succ(ClientWidth), Succ(ClientHeight));
Bitmap := SelectObject(DC, TmpBitmap);
PaintTo(DC, 0, 0);
BitBlt(GetDC(Handle), BorderRec[BorderStyle], BorderRec[BorderStyle], ClientWidth, ClientHeight, DC, 1, 1, SRCCOPY);
SelectObject(DC, Bitmap);
DeleteDC(DC);
ReleaseDC(Handle, GetDC(Handle));
DeleteObject(TmpBitmap);
ShowCaret(Handle);
FPainting := false;
end;
end;

procedure TTransMemo.CreateParams(var Params: TCreateParams);
const
Alignments: array [TAlignment] of DWord = (ES_LEFT, ES_RIGHT, ES_CENTER);
begin
inherited CreateParams(Params);
Params.Style := Params.Style or ES_MULTILINE or Alignments[FAlignText];
end;

procedure TTransMemo.Change;
begin
RepaintWindow;
inherited Change;
end;

procedure TTransMemo.SetParent(AParent: TWinControl);
begin
inherited SetParent(AParent);
end;

end.
 
多人接受答案了。
 
如果你觉得这里找不到答案,请去
www.experts-exchange.com
绝对有你要的,跟这里不是一个档次的。真的。
 
控件已经给你发过去了。
 

Similar threads

I
回复
0
查看
553
import
I
I
回复
0
查看
728
import
I
I
回复
0
查看
515
import
I
I
回复
0
查看
527
import
I
后退
顶部