Solved

Transarency problem with TCustomControl

Posted on 2009-05-05
3
756 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

Networking for the Cloud Era

Join Microsoft and Riverbed for a discussion and demonstration of enhancements to SteelConnect:
-One-click orchestration and cloud connectivity in Azure environments
-Tight integration of SD-WAN and WAN optimization capabilities
-Scalability and resiliency equal to a data center

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
JTable - Group/UnGroup/Drag&Drop 2 97
notepad++ shortcuts 6 144
Eclipse insufficient memory error 3 113
Doxygen plugin for Android Studio 1 597
In our object-oriented world the class is a minimal unit, a brick for constructing our applications. It is an abstraction and we know well how to use it. In well-designed software we are not usually interested in knowing how objects look in memory. …
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: …
THe viewer will learn how to use NetBeans IDE 8.0 for Windows to perform CRUD operations on a MySql database.
The viewer will learn how to use and create keystrokes in Netbeans IDE 8.0 for Windows.

839 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