Solved

Looking for a Transparent TEdit

Posted on 2002-05-13
13
2,488 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
Comment Utility
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
Comment Utility
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
Comment Utility
see also at www.cooldev.com at the coolcontrols,
but its comercial
0
 
LVL 2

Accepted Solution

by:
Tasomia earned 500 total points
Comment Utility
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
Comment Utility
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
Comment Utility
Nick, I can't seem to access your site (www.ginsonic.ro?)
0
What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

 
LVL 9

Expert Comment

by:ginsonic
Comment Utility
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
Comment Utility
wow ... really nice !
can I have it ? :)
to help test and maybe debug/fix some problems :)
0
 
LVL 44

Expert Comment

by:CrazyOne
Comment Utility
listening
0
 
LVL 1

Author Comment

by:DavidLeeding
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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

Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

Join & Write a Comment

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
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…
This demo shows you how to set up the containerized NetScaler CPX with NetScaler Management and Analytics System in a non-routable Mesos/Marathon environment for use with Micro-Services applications.
This tutorial demonstrates a quick way of adding group price to multiple Magento products.

743 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

12 Experts available now in Live!

Get 1:1 Help Now