Solved

TPanel, Overriding The Draw Text Event.

Posted on 2001-07-17
14
461 Views
Last Modified: 2010-04-04
I have a component that is derived from tpanel.
What i am trying to do is put in a ShowAccelChar Property on it.

but there is no capture event for the setting of the text, can someone tell me how to do this please..

Cheers,
Kristian.
0
Comment
Question by:Kristian
  • 5
  • 4
  • 3
  • +1
14 Comments
 
LVL 3

Expert Comment

by:nnbbb09
ID: 6290854

You need to override the Paint method which is implemented in TCustomPanel. If you have a look at the Paint method for TCustomPanel in ExtCtls.pas you will notice that it uses an API call called DrawText you can pass certain flags to this call that determines how the caption should look. If you add DT_NOPREFIX to this set of flags if will prevent the Accelerator character being drawn.

Jo
0
 
LVL 27

Expert Comment

by:kretzschmar
ID: 6290889
sorry to be off topic now,

jo,

just read your profile,
and i'm promised that your second favourite language is Sinclair ZX Basic,
do you mean this basic on the little computer with 1K ram and a Z80 processor?

this was my first computer where i begun coding something, sometimes in the mid 80's :-)

meikl ;-)


0
 
LVL 3

Accepted Solution

by:
nnbbb09 earned 50 total points
ID: 6290900
Hello,

This is a code sample that I think implements what you want. The paint procedure is almost a direct copy of the one in the VCL. I have marked out the main difference.

unit ExtPanel;

interface

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

type
  TExtPanel = class(TPanel)
  private
    FblnShowAcceleratorChar: boolean;
    procedure SetShowAcceleratorChar(const Value: boolean);
  protected
    procedure Paint; override;
  public
  published
    property ShowAcceleratorChar : boolean read FblnShowAcceleratorChar write SetShowAcceleratorChar;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Xenicom', [TExtPanel]);
end;

{ TExtPanel }

procedure TExtPanel.Paint;
const
  Alignments: array[TAlignment] of Longint = (DT_LEFT, DT_RIGHT, DT_CENTER);
var
  Rect: TRect;
  TopColor, BottomColor: TColor;
  FontHeight: Integer;
  Flags: Longint;

  procedure AdjustColors(Bevel: TPanelBevel);
  begin
    TopColor := clBtnHighlight;
    if Bevel = bvLowered then TopColor := clBtnShadow;
    BottomColor := clBtnShadow;
    if Bevel = bvLowered then BottomColor := clBtnHighlight;
  end;

begin
  Rect := GetClientRect;
  if BevelOuter <> bvNone then
  begin
    AdjustColors(BevelOuter);
    Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
  end;
  Frame3D(Canvas, Rect, Color, Color, BorderWidth);
  if BevelInner <> bvNone then
  begin
    AdjustColors(BevelInner);
    Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
  end;
  with Canvas do
  begin
    Brush.Color := Color;
    FillRect(Rect);
    Brush.Style := bsClear;
    Font := Self.Font;
    FontHeight := TextHeight('W');
    with Rect do
    begin
      Top := ((Bottom + Top) - FontHeight) div 2;
      Bottom := Top + FontHeight;
    end;

    Flags := DT_EXPANDTABS or DT_VCENTER or Alignments[Alignment];

    {My change here}

    if NOT ShowAcceleratorChar then
      Flags := Flags or DT_NOPREFIX;

    {/My Change here}

    Flags := DrawTextBiDiModeFlags(Flags);
    DrawText(Handle, PChar(Caption), -1, Rect, Flags);
  end;
end;

procedure TExtPanel.SetShowAcceleratorChar(const Value: boolean);
begin
  if FblnShowAcceleratorChar = Value then
    exit;

  FblnShowAcceleratorChar := Value;
  Repaint;
end;

end.

Hope this helps

Jo
0
 
LVL 3

Expert Comment

by:nnbbb09
ID: 6290904

Hi Meikl,

Yes that's right. My first computer was a ZX81, before I upgraded to a 48k ZX Spectrum. Those were the days... :-}

Jo
0
 
LVL 1

Expert Comment

by:h_mohsenian
ID: 6290908
dear Kristian,

if u use D5 insert this line(with ---> ) to after line 1459 in ExtCtrl Unit :

              Flags := DrawTextBiDiModeFlags(Flags);
 ------>  Flags := Flags or DT_NOPREFIX;
              DrawText(Handle, PChar(Caption), -1, Rect, Flags);

this is equal to ShowAccelChar := False in TCustomPanel & if u del it is equalt to ShowAccelChar := True;

now u can use it to add a new property named ShowAccelChar to TCustomPanel.
For Help See StdCtrl Unit and ShowAccelChar property for TCustomLabel.

best regards
hamed
0
 
LVL 1

Expert Comment

by:h_mohsenian
ID: 6290918
sorry nnbbb09,

it is just like ur code and u give her better code.

i saw this just less than 10 min later. and started to solve it. at that time there is not any comments.when the page refreshed i say ur code.

kretzschmar as u know i had this problem at another q.

sorry again
hamed
0
 
LVL 3

Expert Comment

by:nnbbb09
ID: 6290929
Hi Hamed,

No problem. This has happened to me a lot as well :-)

Jo.
0
6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

 
LVL 27

Expert Comment

by:kretzschmar
ID: 6292475
to me too :-))
0
 
LVL 1

Expert Comment

by:h_mohsenian
ID: 6292528
dear meikl,

-did u see my pictures? ;-)
-what is ur idea about my comment to .DCU problem? i suggested Activex Control.I test it on VB6 ( as i said my D3 has problem after installing D5)?

best regards
hamed
0
 
LVL 1

Author Comment

by:Kristian
ID: 6293568
Fantastic, thank you very much,

and just to point out to the other guy im not a her !!! :-)

Cheers
Kristian
0
 
LVL 1

Expert Comment

by:h_mohsenian
ID: 6293928
dear Kristian ,

'Kristian' is a foreign name for me.sorry for my mistake. <  !!! :-)  > in ur message means i must never think it is a girl name (with her) . i dont know why i thought 'Kristian' is a girl name maybe i saw it in a file ( & maybe again it was Kristiana ). it seems profiles dont show mail or femail to us ,although they ask us.

now for example can u say which of the following names are becomes with him or her!!! :-) ( all of them are in my language )
parisa, payman, pegah, parvis,
bita, behrooz, bahman,
hamed, hadi, hoda

sorry again.I hope u accept it was just a mistake.;-)

best regards
hamed
0
 
LVL 1

Author Comment

by:Kristian
ID: 6293965
no worries !!!!

( it actually happens quite a lot with mail and such like )..


Kris.
0
 
LVL 27

Expert Comment

by:kretzschmar
ID: 6294142
:-)))

well, hamed, got your pictures,
and an answer is in work

>now for example can u say which of the following names are becomes with him or her!!! :-)
>( all of them are in my language )
>parisa, payman, pegah, parvis,
>bita, behrooz, bahman,
>hamed, hadi, hoda

hamed i guess is male :-)
the rest, i don't know

meikl ;-)

sorry to be off topic again

0
 
LVL 1

Expert Comment

by:h_mohsenian
ID: 6297333
although male & female is True in dictation , but yes it may happens in mails , chat rooms ,sites like ex-ex and ... ;-)
( it was just a way for hide my dictation mistake ) ;-)

have a good time
hamed

dear meikl, :-)) u are realy clever ;-) , i insert my name becouse of  i wating for this type of replying from kristian , but u said ;-)

best regards
hamed
0

Featured Post

Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

Join & Write a Comment

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
Get a first impression of how PRTG looks and learn how it works.   This video is a short introduction to PRTG, as an initial overview or as a quick start for new PRTG users.
Here's a very brief overview of the methods PRTG Network Monitor (https://www.paessler.com/prtg) offers for monitoring bandwidth, to help you decide which methods you´d like to investigate in more detail.  The methods are covered in more detail in o…

746 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