Solved

Transarency problem with TCustomControl

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

Secure Your Active Directory - April 20, 2017

Active Directory plays a critical role in your company’s IT infrastructure and keeping it secure in today’s hacker-infested world is a must.
Microsoft published 300+ pages of guidance, but who has the time, money, and resources to implement? Register now to find an easier way.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
What is an NDK ? 3 104
Visual Studio 2010 and wwwroot level webconfig file 1 59
notepad++ shortcuts 6 153
Visual Studio 2013 5 85
Programmer's Notepad is, one of the best free text editing tools available, simply because the developers appear to have second-guessed every weird problem or issue a programmer is likely to run into. One of these problems is selecting and deleti…
How to install Selenium IDE and loops for quick automated testing. Get Selenium IDE from http://seleniumhq.org Go to that link and select download selenium in the right hand columnThat will then direct you to their download page.From that page s…
This tutorial covers a step-by-step guide to install VisualVM launcher in eclipse.
The viewer will learn how to use and create new code templates in NetBeans IDE 8.0 for Windows.

696 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