Solved

Transarency problem with TCustomControl

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

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

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…
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: …
This tutorial covers a step-by-step guide to install VisualVM launcher in eclipse.
THe viewer will learn how to use NetBeans IDE 8.0 for Windows to perform CRUD operations on a MySql database.

762 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

15 Experts available now in Live!

Get 1:1 Help Now