Solved

Looking for a Transparent TEdit

Posted on 2002-05-13
13
2,568 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
Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
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

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
Magic Software info 18 138
TServerSocket - file via sendbuf or Text via sendtext ? 1 65
How to define IfThen functions in one common unit? 4 60
Create a path if not exists 7 89
In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
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…
Two types of users will appreciate AOMEI Backupper Pro: 1 - Those with PCIe drives (and haven't found cloning software that works on them). 2 - Those who want a fast clone of their boot drive (no re-boots needed) and it can clone your drive wh…
In an interesting question (https://www.experts-exchange.com/questions/29008360/) here at Experts Exchange, a member asked how to split a single image into multiple images. The primary usage for this is to place many photographs on a flatbed scanner…

856 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