Solved

Looking for a Transparent TEdit

Posted on 2002-05-13
13
2,515 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
  • 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
 
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
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
Delphi application Soap connection 5 94
Create a path if not exists 7 68
control image tags in a string ? 12 110
Not able to call Delphi XE10 dll function from Delphi 6.0 4 16
Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
This tutorial demonstrates a quick way of adding group price to multiple Magento products.
Concerto provides fully managed cloud services and the expertise to provide an easy and reliable route to the cloud. Our best-in-class solutions help you address the toughest IT challenges, find new efficiencies and deliver the best application expe…

914 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

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now