Solved

Looking for a Transparent TEdit

Posted on 2002-05-13
13
2,631 Views
Last Modified: 2008-03-10
I need to find a TEdit replacement that can have a transparent background. Transparency must be available when the control has the focus as well as when it doesn't. It also must allow font.color to be selectable.

(I came across a TEdit-derived component that was transparent when it *didn't* have the focus, but looked like a normal TEdit when edited...and worse, it would not allow the text colour to be changed)

Ideally, I'd like to find a component with source code so I can understand why it works (and why my attempts haven't!).



0
Comment
Question by:DavidLeeding
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 5
  • 2
  • 2
  • +4
13 Comments
 
LVL 14

Expert Comment

by:DragonSlayer
ID: 7007527
Don't have time to write the full code, but try something like this:

create a descendant of TCustomEdit
add a procedure to handle the WM_NCPAINT message
in the procedure,
  a. create a TBitmap
  b. call DrawParentImage (below) with the parameters Self and the TBitmap variable
  c. draw a frame (using FrameRect) onto the TBitmap
  d. do a Canvas.CopyRect from the TBitmap

procedure DrawParentImage(Control: TControl; Dest: TCanvas);
var
  SaveIndex: Integer;
  DC: HDC;
  Position: TPoint;
begin
  with Control do
  begin
    if Parent = nil then
      Exit;
    DC := Dest.Handle;
    SaveIndex := SaveDC(DC);
    GetViewportOrgEx(DC, Position);
    SetViewportOrgEx(DC, Position.X - Left, Position.Y - Top, nil);
    IntersectClipRect(DC, 0, 0, Parent.ClientWidth, Parent.ClientHeight);
    Parent.Perform(WM_ERASEBKGND, DC, 0);
    Parent.Perform(WM_PAINT, DC, 0);
    RestoreDC(DC, SaveIndex);
  end;
end;


HTH
DragonSlayer
0
 
LVL 9

Expert Comment

by:ginsonic
ID: 7007666
Go to http://www.ginsonic.ro for alike edit box . I say that is cool. Transparent background, transparent selection , or semi-transparent :). Your choice . Flicker free , antialiasing , own text color for selection or disabled state...

If you use D6 I can send you a registered version ( no source code , sorry but I don't wish to make public - yet - these ). Using my custom class I can make replacements for almost all controls .
0
 
LVL 27

Expert Comment

by:kretzschmar
ID: 7007767
see also at www.cooldev.com at the coolcontrols,
but its comercial
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 2

Accepted Solution

by:
Tasomia earned 500 total points
ID: 7007891
Hi,

Try this:

{**************************************************************}
{ 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.
0
 
LVL 9

Expert Comment

by:ginsonic
ID: 7007905
Tasomia,
I'm not sure if this is the code what I tested in past, but I remember that is a problem with painting of the selected text. Test it and see if ,when you move the mouse faster from a part ( left or right ) to another ( with left mouse button pressed of course ), the edit box text is painted corect .
Maybe I wrong and is another code !?

Regards,
Nick
0
 
LVL 14

Expert Comment

by:DragonSlayer
ID: 7007919
Nick, I can't seem to access your site (www.ginsonic.ro?)
0
 
LVL 9

Expert Comment

by:ginsonic
ID: 7008233
Interesting , I just tested the link now and work for me . But ... you can find a demo at www.torry.net or www.delphipages.com . Look for TgnEdit .
0
 
LVL 12

Expert Comment

by:Lee_Nover
ID: 7008551
wow ... really nice !
can I have it ? :)
to help test and maybe debug/fix some problems :)
0
 
LVL 44

Expert Comment

by:CrazyOne
ID: 7008566
listening
0
 
LVL 1

Author Comment

by:DavidLeeding
ID: 7009758
To Tasomia,

Thankyou! That's **exactly** what I was looking for...compiled perfectly without a hitch. I can see from this code that my own efforts were close, but missed a few fundemental aspects. Thanks again!

(To Ginsonic..great looking components...I will download the demos at some point. But I was really after source code, though, because I was wanting to understand how to get the transparency happening)

0
 
LVL 9

Expert Comment

by:ginsonic
ID: 7010196
Your choice :)
And if you don't found the reported bug then mean that isn't the code that I know ( in past, I found a tip on net that use same idea to do this job ... just for edit boxes ).

See you on net,
Nick

P.S. I have on finish line DBGrid and ComboBox replacements.
0
 
LVL 12

Expert Comment

by:Lee_Nover
ID: 7011306
dbgrid great ! I'm using my own stringgrid and I was about to make some major mods to add a bitmap background to it
(actually a video preview)
ginsonic : will these compos be free ?
0
 
LVL 9

Expert Comment

by:ginsonic
ID: 7012880
Not sure yet , but possible to use a GPL license . I'm interested to develope fast my components and not to gain money from this direction.

Nick
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
select query - oracle 16 103
how to change, disabled button color FMX ? 1 66
Firemonkey Tcameracomponent resultion 1 51
Connect to SQL 2008 r2 server over the Internet 4 86
Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
Exchange organizations may use the Journaling Agent of the Transport Service to archive messages going through Exchange. However, if the Transport Service is integrated with some email content management application (such as an antispam), the admini…

710 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question