[Delphi] Wyświetlenie znaku unicode nad przyciskiem

0

Witam
Chce aby w moim programie była możliwośc wypisania znaku unicode nad przyciskiem ponieważ standardowe komponenty TButton nie umożliwiają wprowadzania znaków unicode. Instalowanie gotowych komponentów odpada w mojej wersji Delphi personal 2005 ponieważ nie ma w Component-> Install Component. Najlepszym rozwiązaniem było by napisanie w moim projekcie własnej klasy np TUnicodeButton = class(TButton) i dynamiczne utworzenie przycisku w programie oraz ustawieniem Caption(unicode) ale jakoś mi to nie wychodziło tak jak chciałem poza tym potrzebuje wyświetlić tylko 1 znak. Do tego doszedłem:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;



var
  Form1: TForm1;


implementation

{$R *.dfm}


procedure TForm1.Button1Click(Sender: TObject);
var c: pwidechar;
begin
 Canvas.Font.Color:=clRed;
 Canvas.Font.Height:=24;
 c:=#0923;
 //Canvas.TextOut(ClientHeight div 4, ClientWidth div 4, 'NAPIS');
 //ExtTextOutW(Canvas.Handle, 1, 1, 0, @Rect, c, 1, nil);
 TextOutW(Canvas.Handle, 1, 1, c, 1);
 TextOutW(Canvas.Handle, 100, 100, c, 1);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 //
end;

end.

po kliknięciu na przycisk ma wyświetlić znak nad przyciskiem ale niestety wyświetla pod jak widać tutaj:
user image

nie wiem za bardzo dlaczego tak jest może trzeba coś zmienić przy samym wywołaniu tekstu żeby wyświetlał nad wszytkimi komponentami lub jakaś właściwość w TForm lub TButton. Szukałem caly dzień po internecie i nie znalazłem nic co by ten problem rozwiązało.

z góry thx

0

http://www.codegear.pl/cgi-bin/tip.exe/showtip?mode=1&id_tip=77 i poszukaj sobie darmowej wersji tnt unicode controls

0

dodawania nowego komponentu chciałem właśnie uniknąć no chyba że to niemozliwe poki co może jeszcze komuś wpadnie jakiś pomysł do głowy może da się złapać jakis uchwyt canvasa najwyższy w aplikacji(wyższy od dowolnych komponentów na formie), postaram sie napisąć własny komponent dziedziczący TButton i dodać możliwośc wczytywania znaków unicode w Caption jak w gotowych juz komponentach

0

nied ma czegoś takiego jak "uchwyt canvasa najwyższy w aplikacji"- każdy obiekt graficzny ma swój własny, a Ty malujesz po canvasie formy a nie przycisku, który tak btw przycisk ma ukryty

0

postanowiłem napisać jednak własna klase dziedzicząca i dodać w niej możliwość uchwytu canvasu aby pisać po TBitBtn wygląda to tak:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  //protected
  // procedure Paint(); override;
  public
    { Public declarations }
  end;

  TMyButton = class(TBitBtn)
  private
   BHDC : HDC;
   BCanvas: TCanvas;
   procedure SetHandle(BHandle: HDC);
   //procedure GetCanvas(GCanvas: TCanvas);
  protected
   property Canvas: TCanvas read BCanvas;
  published
   property Handle: HDC read BHDC write SetHandle;

  end;


var
  Form1: TForm1;
  MyButton1: TMyButton;


implementation

{$R *.dfm}

//procedure TForm1.Paint();
//begin
  //
//end;

(*procedure TMyButton.GetCanvas(GCanvas: TCanvas);
begin

end;*)

procedure TMyButton.SetHandle(BHandle: HDC);
begin
 BHDC := BHandle;
 // RecreateWnd;
end;

procedure TForm1.Button1Click(Sender: TObject);
var c: pwidechar;
begin
 Canvas.Font.Color:=clRed;
 Canvas.Font.Height:=24;
 c:=#0923;
 TextOutW(MyButton1.Canvas.Handle, 1, 1, c, 1);

 //ExtTextOutW(Canvas.Handle, 1, 1, 0, @Rect, c, 1, nil);
 //TextOutW(Canvas.Handle, 100, 100, c, 1);
 //inherited Paint();
 //TextOutW(Canvas.Handle, Button1.Top+3, Button1.Left+5, c, 1);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 MyButton1:=TMyButton.Create(self);
 MyButton1.Parent:=Self;
 MyButton1.Top:= 50;
 MyButton1.Left:=50;

end;

end.

ale niestety nie działa i zwraca błąd przy probie wypisania znaku
http://www.vpx.pl/foto,buni2.html

wydaje mi sie że to dlatego że nie wiem jak połączyć Canvas z Handle ale może sie myle

0

ehh.. jak juz piszesz wlasny komponent to wykorzystaj OnPaint.
a jesli chodzi o otrzymanie canvasa danego buttona to mniej-wiecej tak:

procedure...
var C:TCanvas;
begin
c:=TCanvas.Create;
c.Handle:=GetWindowDC(button1.handle);
c.textount(16,16, 'ala ma kota');
c.free;
end;
0

super teraz działa jedyne co mnie ciekawi to dlaczego pisze na białym tle a nie transparent-nie jak pisał na formie no i po kliknieciu w przycisk znika ale dobrze ze uchwyt juz dziala

0

Brush.Style := bsClear - problem białego tła
OnPaint - problem znikania

0

bsClear pomogło ale nie jestem pewny czy dobrze uzywam OnPaint

procedure TForm1.FormPaint(Sender: TObject);
begin
 Cv:=TCanvas.Create;
 Cv.Handle:=GetWindowDC(MyButton1.Handle);
 Cv.Font.Name:='Tahoma';
 Cv.Font.Size:=10;
 Cv.Font.Style:=[fsBold];
 Cv.Font.Color:=clRed;
 Cv.Brush.Style:=bsClear;
 TextOutW(Cv.Handle, 5, 5, #0228, 1);
 Cv.Free;
end;

i w FormCreate wywołuje Paint ale przy starcie formy i tak nic się nie wypisuje (tylko jak uzywam XPManifest to wtedy się wypisuje przy starcie) ale z kolei na XPManifest po najechaniu kursorem na przycisk lub kliknieciu znika, ale za to jak klikne w przycisk wywołujący Paint to dopiero się pojawia a w FormCreate nie działalo w sumie nawet dobrze by było bo aplikacje robie z XPManifest wiec potrzevbuje tylko zeby nie znikalo po najechaniu i kliknieciu i sie tworzylo przy starcie

0

kombinujesz od kilku dni jak koń pod górkę a wystarczy słuchać co się do Ciebie mówi i trochę się dokształcić

  1. robisz nowy komponent dziedziczący po TButton
  2. dodajesz mu do private FCanvas: TCanvas;
  3. w konstruktorze FCanvas := TCanvas.Create;
  4. w destruktorze FCanvas.Free;
  5. do private
procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM; 
procedure DrawItem(const DrawItemStruct: TDrawItemStruct);

i w kodzie

procedure xxx.CNDrawItem(var Message: TWMDrawItem);
begin
  DrawItem(Message.DrawItemStruct^);
end;

procedure xxx.DrawItem(const DrawItemStruct: TDrawItemStruct);
begin
  FCanvas.Handle := DrawItemStruct.hDC;
  FCanvas.Font := Self.Font;

  //tu rysujesz co chcesz

  FCanvas.Handle := 0;
end;
0

nie wiem skąd wygrzebałeś te DrawItem ale po 7 dnich z delphi nie bardzo wiem jak korzystać z dokumentacji no chyba że znasz to z jakiejś książki lub strony ale nie ważne starałem się zrobić z OnPaint ale teraz juz nie wiem napisałem dokładnie tak jak mi poradziłeś wygląda to tak:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TMyButton = class(TButton)
  private
   FCanvas : TCanvas;
   procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
   procedure DrawItem(const DrawItemStruct: TDrawItemStruct);
  public
   Constructor Create(AOwner: TComponent); override;
   Destructor Destroy; override;
  end;

var
  Form1: TForm1;
  MyButton1: TMyButton;

implementation

{$R *.dfm}

Constructor TMyButton.Create(AOwner: TComponent);
begin
 inherited;
 FCanvas:=TCanvas.Create;
end;

procedure TMyButton.CNDrawItem(var Message: TWMDrawItem);
begin
  DrawItem(Message.DrawItemStruct^);
end;

procedure TMyButton.DrawItem(const DrawItemStruct: TDrawItemStruct);
begin
  FCanvas.Handle := DrawItemStruct.hDC;
  FCanvas.Font := Self.Font;

  //tu rysujesz co chcesz
  TextOutW(FCanvas.Handle, 1, 1, 'X', 1);

  FCanvas.Handle := 0;
end;

Destructor TMyButton.Destroy;
begin
 FCanvas.Free;
 inherited;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 MyButton1:=TMyButton.Create(Self);
 MyButton1.Parent:=Self;
 MyButton1.Height:=25;
 MyButton1.Width:=25;
 MyButton1.Top:=10;
 MyButton1.Left:=10;
end;

end.

po starcie programu nic nie wypisuje a nawet jak uzywam Paint to nic nie zmienia , moim zdaniem trwałe rysowanie z onpaint nie ma prawa działać na niektórych kontrolkach a juz na pewno na przycisku, pokombinowałem z evantami przycisku i już wygląda znacznie lepiej to przynajmniej jak nie uzywam XPManifest jedyny problem jaki pozostał to że nie działa przy naciśniętym przycisku OnMouseDown nie wiem dlaczego, zresztą na xpmanifest to nawet nie mozna wyjustować tekstu w TEdit bez dodatnia Aligmentu więc może w tym wypadku też trzeba coś dodać? i jak tak to co?:D

edit: dobra wrzuciłem onpaint w TTimer i już działa jak trzeba odświeża czały czas po prostu chociaż nie jest to najlepsze rozwiązanie najlepij jakby się dało jakoś zablokować to czyszczenie płotna przycisku przy kliknieciu ale na XPManiferst to jakos nie działa w ogóle

0

jednak na nie dziala w timer jak trzeba zreszta z CNDrawItem tez bo nie zachowuje Manifestu

1 użytkowników online, w tym zalogowanych: 0, gości: 1