Solved

Transarency problem with TCustomControl

Posted on 2009-05-05
3
752 Views
Last Modified: 2013-11-23
I have derived from a TCustomControl component in order to implement a guage that the user can interact with.
The problem is that although the component itself is transparent I need to be able to erase the previous guage needle when a new position is selected.
If you install the component from the code below you can see the problem.

unit TrackGuage;
 

interface
 

uses

 Windows, Messages, Classes, SysUtils, Graphics, ComCtrls, Controls, ExtCtrls,

 Math;
 

const

 TRACKGUAGE_VERSION = 'v0.21';
 

 TRACKGUAGE_MIN     = 0;

 TRACKGUAGE_MAX     = 24;
 

 TRACKGUAGE_TH_DEF  = 10;                // tic height default

 TRACKGUAGE_TW_DEF  = 1;                 // tic width default

 TRACKGUAGE_SR_DEF  = 5;                 // spindle radius default

 TRACKGUAGE_NW_DEF  = 5;                 // needle width default
 

type

 TTrackGuage = class (TCustomControl) // TTrackGuage

 private

   FVersion     : String;
 

   FBackColor,

   FTicColor,

   FTicFocusColor,

   FNeedleFocusColor,

   FNeedleEdgeFocusColor,

   FNeedleColor,

   FNeedleEdgeColor       : TColor;

   FNeedleWidth   : Integer;
 

   FMin,

   FMax,

   FPosition : Integer;
 

   FTicHeight : Integer;

   FTicWidth  : Integer;
 

   FSpindleRadius : Integer;

   FShowSpindle   : Boolean;
 

   FOnChangePosition : TNotifyEvent;

   FOnEnter  : TNotifyEvent;

   FOnFocus  : TNotifyEvent;
 

   IsFocused : Boolean;
 

   CMLastSpecialKey         : Word;

   CMLastSpecialKeyActioned : Boolean;
 

   procedure SetFVersion (Value : String);
 

   procedure SetFBackColor            (Value : TColor);

   procedure SetFTicColor             (Value : TColor);

   procedure SetFTicFocusColor        (Value : TColor);

   procedure SetFNeedleColor          (Value : TColor);

   procedure SetFNeedleFocusColor     (Value : TColor);

   procedure SetFNeedleEdgeColor      (Value : TColor);

   procedure SetFNeedleEdgeFocusColor (Value : TColor);

   procedure SetFNeedleWidth   (Value : Integer);
 

   procedure SetFMin      (Value : Integer);

   procedure SetFMax      (Value : Integer);

   procedure SetFPosition (Value : Integer);
 

   procedure SetFTicHeight     (Value : Integer);

   procedure SetFTicWidth      (Value : Integer);

   procedure SetFSpindleRadius (Value : Integer);

   procedure SetFShowSpindle   (Value : Boolean);

   procedure ChangePosition (X, Y : Integer);
 

   procedure PainTTrackGuageMeter (Canvas : TCanvas);
 

 protected

   procedure Paint; override;

   procedure MouseMove (Shift: TShiftState; X, Y: Integer); override;

   procedure MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;

   procedure DoEnter; override;

   procedure DoExit; override;
 

   // we need this because 'special' keys i.e. arrows/tabs do not appear in KeyDown, DoKeyDown or KeyPress

   procedure CMWantSpecialKey (var Message: TCMWantSpecialKey); message CM_WANTSPECIALKEY;
 

 public

   procedure   CreateParams(var Params: TCreateParams); override;

   constructor Create (AOwner : TComponent); override;

   destructor  Destroy; override;
 

   procedure SetPositionSilent (Value : Integer);
 

 published

   property Align;
 

   property TabStop;

   property TabOrder;
 

   property Version : String read FVersion write SetFVersion;
 

   property BackColor            : TColor read FBackColor            write SetFBackColor            default clBlack;

   property TicColor             : TColor read FTicColor             write SetFTicColor             default clSilver;

   property TicFocusColor        : TColor read FTicFocusColor        write SetFTicFocusColor        default clLime;

   property NeedleColor          : TColor read FNeedleColor          write SetFNeedleColor          default clRed;

   property NeedleFocusColor     : TColor read FNeedleFocusColor     write SetFNeedleFocusColor     default clYellow;

   property NeedleEdgeColor      : TColor read FNeedleEdgeColor      write SetFNeedleEdgeColor      default clMaroon;

   property NeedleWidth          : Integer read FNeedleWidth         write SetFNeedleWidth          default TRACKGUAGE_NW_DEF;
 
 

   property Min      : Integer read FMin      write SetFMin      default 0;

   property Max      : Integer read FMax      write SetFMax      default 10;

   property Position : Integer read FPosition write SetFPosition default 0;
 

   property TicHeight : Integer read FTicHeight write SetFTicHeight default TRACKGUAGE_TH_DEF;

   property TicWidth  : Integer read FTicWidth  write SetFTicWidth  default TRACKGUAGE_TW_DEF;
 

   property SpindleRadius : Integer read FSpindleRadius write SetFSpindleRadius default TRACKGUAGE_SR_DEF;

   property ShowSpindle   : Boolean read FShowSpindle   write SetFShowSpindle   default True;
 

   property OnChangePosition : TNotifyEvent read FOnChangePosition write FOnChangePosition;

   property OnEnter : TNotifyEvent read FOnEnter write FOnEnter;

   property OnFocus : TNotifyEvent read FOnFocus write FOnFocus;

 end; // TTrackGuage
 
 

procedure Register;
 

implementation
 

procedure TTrackGuage.CreateParams(var Params: TCreateParams);

begin

    { call the create of the params }

    inherited CreateParams(Params);

    Params.ExStyle := Params.ExStyle + WS_EX_Transparent;

    ControlStyle := ControlStyle - [csOpaque] + [csAcceptsControls]

end;
 

constructor TTrackGuage.Create (AOwner : TComponent);

begin // TTrackGuage.Create

 inherited Create (AOwner);
 

 FVersion       := TRACKGUAGE_VERSION;
 

 FBackColor            := clBlack;

 FTicColor             := clSilver;

 FTicFocusColor        := clLime;

 FNeedleColor          := clRed;

 FNeedleFocusColor     := clYellow;

 FNeedleEdgeColor      := clMaroon;

 FNeedleEdgeFocusColor := clOlive;

 FNeedleWidth          := TRACKGUAGE_NW_DEF;
 

 FMin           := TRACKGUAGE_MIN;

 FMax           := 10;

 FPosition      := 0;
 

 FTicHeight     := TRACKGUAGE_TH_DEF;

 FTicWidth      := TRACKGUAGE_TW_DEF;

 FSpindleRadius := TRACKGUAGE_SR_DEF;

 FShowSpindle   := True;
 

 Width          := 100;

 Height         := 100;
 

 TabStop        := True;
 

 IsFocused      := False;
 

 CMLastSpecialKey         := 0;

 CMLastSpecialKeyActioned := False;

end; // TTrackGuage.Create
 
 

destructor TTrackGuage.Destroy;

begin // TTrackGuage.Destroy

 inherited Destroy;

end; // TTrackGuage.Destroy
 
 

procedure TTrackGuage.SetFVersion (Value : String);

begin // TTrackGuage.SetFVersion

 FVersion := TRACKGUAGE_VERSION;

end; // TTrackGuage.SetFVersion
 
 

procedure TTrackGuage.SetFBackColor (Value : TColor);

begin // TTrackGuage.SetFBackColor

 FBackColor := Value;

 InvalidateRect (Handle, nil, False);

end; // TTrackGuage.SetFBackColor
 
 

procedure TTrackGuage.SetFTicColor (Value : TColor);

begin // TTrackGuage.SetFTicColor

 FTicColor := Value;

 InvalidateRect (Handle, nil, False);

end; // TTrackGuage.SetFTicColor
 
 

procedure TTrackGuage.SetFTicFocusColor (Value : TColor);

begin // TTrackGuage.SetFTicFocusColor

 FTicFocusColor := Value;

 InvalidateRect (Handle, nil, False);

end; // TTrackGuage.SetFTicFocusColor
 
 

procedure TTrackGuage.SetFNeedleColor (Value : TColor);

begin // TTrackGuage.SetFNeedleColor

 FNeedleColor := Value;

 InvalidateRect (Handle, nil, False);

end; // TTrackGuage.SetFNeedleColor
 
 

procedure TTrackGuage.SetFNeedleFocusColor (Value : TColor);

begin // TTrackGuage.SetFNeedleFocusColor

 FNeedleFocusColor := Value;

 InvalidateRect (Handle, nil, False);

end; // TTrackGuage.SetFNeedleFocusColor
 
 

procedure TTrackGuage.SetFNeedleEdgeColor (Value : TColor);

begin // TTrackGuage.SetFNeedleEdgeColor

 FNeedleEdgeColor := Value;

 InvalidateRect (Handle, nil, False);

end; // TTrackGuage.SetFNeedleEdgeColor
 
 

procedure TTrackGuage.SetFNeedleEdgeFocusColor (Value : TColor);

begin // TTrackGuage.SetFNeedleEdgeFocusColor

 FNeedleEdgeFocusColor := Value;

 InvalidateRect (Handle, nil, False);

end; // TTrackGuage.SetFNeedleEdgeFocusColor
 

procedure TTrackGuage.SetFNeedleWidth (Value : Integer);

begin // TTrackGuage.SetFNeedleEdgeFocusColor

 FNeedleWidth := Value;

 InvalidateRect (Handle, nil, False);

end; // TTrackGuage.SetFNeedleEdgeFocusColor
 

procedure TTrackGuage.SetFMin (Value : integer);

begin // TTrackGuage.SetFMin

 if ((Value < TRACKGUAGE_MIN) or (Value >= FMax)) then

   FMin := 0

 else

   FMin := Value;

 InvalidateRect (Handle, nil, False);

end; // TTrackGuage.SetFMin
 
 

procedure TTrackGuage.SetFMax (Value : integer);

begin // TTrackGuage.SetFMax

 if ((Value = TRACKGUAGE_MIN) or (Value > TRACKGUAGE_MAX) or (Value < FMin)) then

   FMax := TRACKGUAGE_MAX

 else

   FMax := Value;

 InvalidateRect (Handle, nil, False);

end; // TTrackGuage.SetFMax
 
 

procedure TTrackGuage.SetFPosition (Value : integer);

begin // TTrackGuage.SetFPosition

 if (Value <> FPosition) then begin // has changed

   SetPositionSilent (Value);

   if Assigned (FOnChangePosition) then

     FOnChangePosition (self);

 end; // has changed

end; // TTrackGuage.SetFPosition
 
 

procedure TTrackGuage.SetPositionSilent (Value : integer);

begin // TTrackGuage.SetPositionSilent

 FPosition := Value;

 InvalidateRect (Handle, nil, False);

end; // TTrackGuage.SetPositionSilent
 
 

procedure TTrackGuage.SetFTicHeight (Value : Integer);

begin // TTrackGuage.SetFTicHeight

 FTicHeight := Value;

 InvalidateRect (Handle, nil, False);

end; // TTrackGuage.SetFTicHeight
 
 

procedure TTrackGuage.SetFTicWidth (Value : Integer);

begin // TTrackGuage.SetFTicWidth

 FTicWidth := Value;

 InvalidateRect (Handle, nil, False);

end; // TTrackGuage.SetFTicWidth
 
 

procedure TTrackGuage.SetFSpindleRadius (Value : Integer);

begin // TTrackGuage.SetFSpindleRadius

 FSpindleRadius := Value;

 InvalidateRect (Handle, nil, False);

end; // TTrackGuage.SetFSpindleRadius
 
 

procedure TTrackGuage.SetFShowSpindle (Value : Boolean);

begin // TTrackGuage.SetFShowSpindle

 FShowSpindle := Value;

 InvalidateRect (Handle, nil, False);

end; // TTrackGuage.SetFShowSpindle
 
 

procedure TTrackGuage.MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin // TTrackGuage.MouseDown

 SetFocus;

 if Assigned (FOnEnter) then

     FOnEnter (self);

 if (Button = mbLeft) then

   ChangePosition (X, Y);

end; // TTrackGuage.MouseDown
 
 

procedure TTrackGuage.MouseMove (Shift: TShiftState; X, Y: Integer);

begin // TTrackGuage.MouseMove

 if (ssLeft in Shift) then

   ChangePosition (X, Y);

 inherited MouseMove (Shift, X, Y);

end; // TTrackGuage.MouseMove
 
 

procedure TTrackGuage.DoEnter;

begin // TTrackGuage.DoEnter

 inherited DoEnter;

 CMLastSpecialKey         := 0;

 CMLastSpecialKeyActioned := False;

 IsFocused := True;

 if Assigned (FOnEnter) then

     FOnEnter (self);

 InvalidateRect (Handle, nil, False);
 

end; // TTrackGuage.DoEnter
 
 

procedure TTrackGuage.DoExit;

begin // TTrackGuage.DoExit

 IsFocused := False;

 InvalidateRect (Handle, nil, False);

 inherited DoExit;

end; // TTrackGuage.DoExit
 
 

procedure TTrackGuage.CMWantSpecialKey (var Message: TCMWantSpecialKey);

var

 GoOn   : Boolean;

 TmpPos : Integer;
 

 // we need this otherwise we get 'double' key presses i.e. on a keydown and then a keyup

 function ActionThisKey : Boolean;

 begin // ActionThisKey

   if (Message.CharCode <> CMLastSpecialKey) then begin // key is different

     Result := True;

     CMLastSpecialKey         := Message.CharCode;

     CMLastSpecialKeyActioned := True;

   end // key is different

   else begin // key is same

     CMLastSpecialKeyActioned := (not CMLastSpecialKeyActioned);

     Result                   := CMLastSpecialKeyActioned;

   end; // key is same

 end; // ActionThisKey
 

begin // TTrackGuage.CMWantSpecialKey

 inherited;
 

 GoOn   := True;

 TmpPos := FPosition;
 

 if (Message.CharCode = VK_LEFT) or (Message.CharCode = VK_DOWN) then begin // decrement

   if (ActionThisKey) then begin // yes do it

     TmpPos := FPosition-1;

     if (TmpPos < FMin) then

       TmpPos := FMin;

   end; // yes do it

 end // decrement

 else if (Message.CharCode = VK_RIGHT) or (Message.CharCode = VK_UP) then begin // increment

   if (ActionThisKey) then begin // yes do it

     TmpPos := FPosition+1;

     if (TmpPos > FMax) then

       TmpPos := FMax;

   end; // yes do it

 end // increment

 else

   GoOn := False;
 

 if (GOOn) then begin // did something

   Message.Result := 1;

   Position       := TmpPos;

 end; // did something

end; // TTrackGuage.CMWantSpecialKey
 
 

procedure TTrackGuage.ChangePosition (X, Y : Integer);

var

 Center   : TPoint;

 TmpAngle : Double;
 

begin // TTrackGuage.ChangePosition

 Center := Point (Width div 2, Height div 2);

 TmpAngle := RadToDeg (ArcTan2 (Abs (Y - Center.Y), Abs (X - Center.X)));

 if (X >= Center.X) then

   if (Y > Center.Y) then

     TmpAngle := 90 + TmpAngle

     else

       TmpAngle := 90 - TmpAngle

 else

   if (Y > Center.Y) then

     TmpAngle := -90 - TmpAngle

   else

     TmpAngle := -90 + TmpAngle;

 

if (TmpAngle < 0) then

   TmpAngle := 360 + TmpAngle

else if (TmpAngle > 360) then

   TmpAngle := 0;
 

 if (TmpAngle > 365.96) and (TmpAngle < 365.99) then

   Position := Round (((TmpAngle ) * (Max - Min)) / 360)

 else

   Position := Round (((TmpAngle ) * (Max - Min)) / 360);

end; // TTrackGuage.ChangePosition
 
 

procedure TTrackGuage.Paint;

begin // TTrackGuage.Paint

 Canvas.Brush.Style := bsClear;

 SetWindowRgn(Handle, 0, False);

 PaintTrackGuageMeter (Canvas);

end; // TTrackGuage.Paint
 
 

procedure TTrackGuage.PaintTrackGuageMeter (Canvas : TCanvas);

var

 Center,

 Tic         : TPoint;

 Radius      : Integer;

 NeedleAngle,

 Angle,

 AngleStep   : Double;

 Needle      : array [0..3] of TPoint;

 Loop        : Integer;
 

begin // TTrackGuage.PainTTrackGuageMeter

 Center      := Point (Width div 2, Height div 2);

 Radius      := (Height div 2) - (FTicHeight + (FTicWidth div 2) + 1);
 

 // paint tics
 

 if (IsFocused) then

   Canvas.Pen.Color := FTicFocusColor

 else

   Canvas.Pen.Color := FTicColor;

 Canvas.Pen.Width := FTicWidth;

 Angle            := 0;//-140;

 NeedleAngle      := Angle;

 AngleStep        := 360 / (FMax - FMin);//280 / (FMax - FMin);
 

 for Loop := FMin to FMax do begin // for each tic

   Tic.X := Center.X + Trunc (Sin (DegToRad (Angle)) * Radius);

   Tic.Y := Center.Y - Trunc (Cos (DegToRad (Angle)) * Radius);

   Canvas.MoveTo (Tic.X, Tic.Y);

   Tic.X := Center.X + Trunc (Sin (DegToRad (Angle)) * (Radius + FTicHeight));

   Tic.Y := Center.Y - Trunc (Cos (DegToRad (Angle)) * (Radius + FTicHeight));

   Canvas.LineTo (Tic.X, Tic.Y);
 

   if (Loop = FPosition) then    // we'll need this in a moment

     NeedleAngle := Angle;
 

   Angle := Angle + AngleStep;

 end; // for each tic
 

 // paint spindle
 

 Canvas.Pen.Width := 1;

 if (FShowSpindle) then begin // required

   if (IsFocused) then begin // focused

     Canvas.Brush.Color := FNeedleFocusColor;

     Canvas.Pen.Color   := FNeedleEdgeFocusColor;

   end // focused

   else begin // not focused

     Canvas.Brush.Color := FNeedleColor;

     Canvas.Pen.Color   := FNeedleEdgeColor;

   end; // not focused

   Canvas.Ellipse (Center.X - FSpindleRadius, Center.Y - FSpindleRadius, Center.X + FSpindleRadius, Center.Y + FSpindleRadius);

 end; // required
 

 // paint needle
 

 Needle[0].X := Center.X;

 Needle[0].Y := Center.Y;

 Needle[1].X := Center.X + Trunc (Sin (DegToRad (NeedleAngle - 90)) * FNeedleWidth);

 Needle[1].Y := Center.Y - Trunc (Cos (DegToRad (NeedleAngle - 90)) * FNeedleWidth);

 Needle[2].X := Center.X + Trunc (Sin (DegToRad (NeedleAngle)) * (Radius - (FNeedleWidth div 2)));

 Needle[2].Y := Center.Y - Trunc (Cos (DegToRad (NeedleAngle)) * (Radius - (FNeedleWidth div 2)));

 Needle[3].X := Center.X + Trunc (Sin (DegToRad (NeedleAngle + 90)) * FNeedleWidth);

 Needle[3].Y := Center.Y - Trunc (Cos (DegToRad (NeedleAngle + 90)) * FNeedleWidth);

 if (IsFocused) then begin // focused

   Canvas.Brush.Color := FNeedleFocusColor;

   Canvas.Pen.Color   := FNeedleEdgeFocusColor;

 end // focused

 else begin // not focused

   Canvas.Brush.Color := FNeedleColor;

   Canvas.Pen.Color   := FNeedleEdgeColor;

 end; // not focused

 Canvas.Polygon (Needle);

end; // TTrackGuage.PainTTrackGuageMeter
 
 

procedure Register;

begin // Register

 RegisterComponents ('Transparent', [TTrackGuage]);

end; // Register
 

end.

Open in new window

0
Comment
Question by:pocupine999
3 Comments
 
LVL 8

Accepted Solution

by:
Haris V earned 500 total points
ID: 24302879

unit CustomCon;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics,
Controls, ExtCtrls;

type
TCustomCon = class( TCustomControl )
private
  { Private declarations }
  IsLoaded: Boolean;
  FRgn, FRgn2: HRGN;
  procedure MakeRegion;
  procedure WMSize(var Message: TMessage); message WM_SIZE;
protected
  { Protected declarations }
  procedure CreateWnd; override;
public
  { Public declarations }
  constructor Create(AOwner: TComponent); override;
  destructor Destroy; override;
published
  { Published declarations }
  property Height default 200;
  property Width default 200;
  property Color;
  property OnClick;
  property OnContextPopup;
  property OnDblClick;
  property OnEndDock;
  property OnEndDrag;
  property OnEnter;
  property OnExit;
  property OnMouseDown;
  property OnMouseMove;
  property OnMouseUp;
  property OnResize;
  property OnStartDrag;
end;

procedure Register;

implementation

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

constructor TCustomCon.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := [csCaptureMouse, csClickEvents,
                 csOpaque];
Width := 200;
Height := 200;
Color := clWhite;
IsLoaded := False;
FRgn := 0;
FRgn2 := 0;
end;

destructor TCustomCon.Destroy;
begin
DeleteObject(FRgn);
DeleteObject(FRgn2);
inherited;
end;

procedure TCustomCon.CreateWnd;
begin
inherited;
MakeRegion;
IsLoaded := True;
{IsLoaded is to make sure MakeRegion is not called before there is a
Handle for this control, but it may not be nessary}
end;

procedure TCustomCon.MakeRegion;
var
FPoints: array[0..3] of TPoint;
begin
SetWindowRgn(Handle, 0, False);
{this clears the window region}

if FRgn <> 0 then
 begin
{Make sure to Always DeleteObject for a Region}
 DeleteObject(FRgn);
 DeleteObject(FRgn2);
 FRgn := 0;
 end;
FPoints[0] := Point(0,0);
FPoints[1] := Point(Width,height div 2);
FPoints[2] := Point(0,height);
FPoints[3] := Point(0,0);
FRgn := CreatePolygonRgn(FPoints,4,Winding);
SetWindowRGN(Handle, FRgn, True);
FRgn2 := CreatePolygonRgn(FPoints,4,Winding);
end;

procedure TCustomCon.WMSize(var Message: TMessage);
var
TmpClr: TColor;
begin
inherited;
if IsLoaded then
 begin
 TmpClr := Canvas.Brush.Color;
 Canvas.Brush.Color := Color;
 MakeRegion;
 FillRgn(Canvas.Handle, FRgn2, Canvas.Brush.Handle);
 Paint;
 Canvas.Brush.Color := TmpClr;
 end;
end;

end.


- - - - - - - - - - - - - - - - - - -

Regions limit the active area of a window or control.
0
 
LVL 100

Expert Comment

by:mlmcc
ID: 34299517
This question has been classified as abandoned and is being closed as part of the Cleanup Program.  See my comment at the end of the question for more details.
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
how to become programmer? 12 32
Fast data scrub 19 95
What xml editor to use. 8 84
My project did see openJDK that I installed. What could be the problem 7 123
Here is a helpful source code for C++ Builder programmers that allows you to manage and manipulate HTML content from C++ code, while also handling HTML events like onclick, onmouseover, ... Some objects defined and used in this source include: …
Jaspersoft Studio is a plugin for Eclipse that lets you create reports from a datasource.  In this article, we'll go over creating a report from a default template and setting up a datasource that connects to your database.
This tutorial covers a step-by-step guide to install VisualVM launcher in eclipse.
The viewer will learn how to synchronize PHP projects with a remote server in NetBeans IDE 8.0 for Windows.

895 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

16 Experts available now in Live!

Get 1:1 Help Now