نمايش hint در هنگام تايپ در Edit Box

[kamand314]

سلام
آيا مي توان در هنگامي كه در يك edit box يك عدد يا متن را تايپ مي كنيم همزمان با
تايپ در hint آن اين عدد يا متن نمايش داده شود يعني لازم نباشد براي ديدن hint اشاره گر ماوس
روي آن قرار گيرد . از زمانيكه focus ميگيرد در صورتيكه محتواي آن تغيير كرد hint نشان داده شود

[hassan p.b]

دوستان لطفا در این مورد راهنمایی نمایید
با تشکر

[behzad_dr]

سلام دوست محترم .

آیا این کار رو بخاطر نمایش عدد داخل ادیت همراه ، به صورت هر سه رقم می خوای انجام بدی ؟

[hassan p.b]

سلام بسیار خوشحال شدم همراهی نمودید بله و بتوانیم تا یک تریلیون برویم چون بعضا اگر ایدیتمان برای ریال باشد رقم کوچکی داریم
با تشکر

[hassan p.b]

دوستان از application.activehint
showhint
گفتند ولی بنده نتوانستم hint را بنمایش در آورم اگر مهم باشد من از دلفی شش بهره می برم
با تشکر

[behzad_dr]

سلام دوست خوب
البته شاید کار بهینه تری بتونید انجام بدید ، اما من این مشکلمو اینطوری رفع کردم


یه استتیک تکست روی صفحه گذاشتم ، بعد موقعیت اونو با ورود به هر ادیتم کنترل می کردم و تکست داخل ادیتمو به اون انتقال میدم و نهایتتا با یه زیر برنامه که ویرگول گذاری کنه تکست داخل استتیک رو ویرگول گذاری می کنم . به کد زیر دقت کن

یکی از ادیتها onenter


StaticText1.Top:=TDBEdit(sender).Top-28;
StaticText1.left:=TDBEdit(sender).left;
StaticText1.Visible:=true;
StaticText1.Caption:=trim(tdbedit(sender).Text);
Form1.kama(StaticText1);



یکی از ادیتها onexit


StaticText1.Visible:=false;



یکی از ادیتها onChange

StaticText1.Caption:=trim(tdbedit(sender).Text);
Form1.kama(StaticText1);

[hassan p.b]

ضمن تشکر
راستی یک کامپوننت از سایت پیدا کردم ولی مشکلاتی دارد مانند نشناختن عدد صفر در ابتدا و محدودیت تا یک میلیارد
دوستان می توانند مورد کاملتری ارائه نمایند
این هم کد داخل کامپوننت:
{
| -----------------------------------------------------------------------------------------------|
| Çíä íæäíÊ ãÌãæÚå Çí ÓÇÏå æ ÇáÈÊå ãÝíÏ ÈÑÇí ÇíÌÇÏ í˜ ˜ÇãæääÊ ãÎÕæÕ æÑæÏ ÚÏÏ ãíÈÇÔÏ |
| ˜ÇÑ Çíä ˜ÇãæääÊ ˜å ÎæÇÕ æ ãÊÏåÇí ˜áÇÓ ÇÏíÊ ÑÇ Èå ÇÑË ãí ÈÑÏ ÏÑíÇÝÊ ÇÚÏÇÏ ÇÚÔÇÑí ãËÈÊ |
| æ ãäÝí ÈæÏå æ ÏÑ Ííä æÑæÏ ÇÚÏÇÏ ãÚÇÏá ÍÑæÝí Âä ÑÇ Èå ÝÇÑÓí ÏÑ ÞÇáÈ í˜ ÈÇáæä Èå ˜ÇÑÈÑ |
| äãÇíÔ ãí ÏåÏ.Çíä ˜ÇãæääÊ ÞÇÈáíÊ ÊäÙíã Ñä Òãíäå æ Þáã ÈÇáæä æ åãäíä Âí˜æä æ |
| ÚäæÇä Âä ÑÇ ÏÇÑÇ ãí ÈÇÔÏ. Öãä Çíä˜å åäÇã æÑæÏ Ýæ˜Ó Èå Çíä ˜ÇãæääÊ(ÇÏíÊ ÓÝÇÑÔí)Ñä |
| Òãíäå Âä ÊÛííÑ ˜ÑÏå æ Ó ÇÒ ÎÑæÌ ÇÒ Çä Çíä Ñä Èå ÍÇáÊ Çæáíå ÈÇÒ ãí ÑÏÏ. |
| |
| ÏÑ ÇíÇä ÎæÇåÔãäÏã ÇÑ ˜Óí Çíä ˜ÇãæääÊ ÑÇ ÊæÓÚå ÏÇÏ Âä ÑÇ ÈÑÇí ãÞÇÕÏ ÂãæÒÔí ÏÑ |
|ÓÇíÊ ÈÑäÇãå äæíÓ ÞÑÇÑ ÏåÏ ÊÇ ÓÇíÑíä äíÒ ÈÊæÇääÏ ÇÒ Çíä ÇíÏå ÈÑÇí ÊæÓÚå ˜ÇãæääÊ ÎæÏ ÇÓÊÝÇÏå ˜ääÏ |
| |
| ***ÚáíÑÖÇ äÌÝíÇä*** |
| -----------------------------------------------------------------------------------------------|
}
unit MonyEdit;

interface

uses
SysUtils, Classes, Controls, StdCtrls, Messages, ShellAPI, Windows, Graphics,
Commctrl, Clipbrd, Strutils, dialogs;

type
TMonyEdit = class(TEdit)
private
{ Private declarations }
FTipDisplay : Boolean;
FTipTitle : String;
FTipIcon : Integer;
FOnEnterColor : TColor;
FBalloonBackColor : TColor;
FBalloonTextColor : TColor;
FAuthor : String;
FPunctuationMark : Char;
FNumber : Real;
procedure ShowBalloonTip(Control: TWinControl; MsgText: string);
Function GetName() : String;
function DeletePunctuationMarks(SignedText : String) : String;
procedure InsertPunctuationMarks();
procedure ConvertTextToNumber();
protected
{ Protected declarations }
public
{ Public declarations }
Constructor Create(AOwner : TComponent); Override;
procedure Change; Override;
procedure DoEnter; Override;
procedure DoExit; Override;
procedure KeyDown(var Key: Word; Shift: TShiftState);override;
Property Number : Real Read FNumber Write FNumber;
published
{ Published declarations }
Property TipDispaly : Boolean Read FTipDisplay Write FTipDisplay Default True;
Property TipIcon : Integer Read FTipIcon Write FTipIcon Default 1;
Property TipTitle : String Read FTipTitle Write FTipTitle;
Property OnEnterColor : TColor Read FOnEnterColor Write FOnEnterColor Default $00AAFFFF;
Property BalloonBackColor : TColor Read FBalloonBackColor Write FBalloonBackColor Default $00FFFFFF;
Property BalloonTextColor : TColor Read FBalloonTextColor Write FBalloonTextColor Default clNavy;
Property Author : String Read GetName Write FAuthor;
Property PunctuationMark : Char Read FPunctuationMark Write FPunctuationMark;
end;

procedure Register;

implementation
//================================================== ============================
Function Phonetics(Number : integer) : string;
var s : string[3];
a : array[1..3] of string;
i : Integer;
begin
Result := '';
s := IntToStr(Number);

case length(s) of
0 : s := '000';
1 : s := '00' + s;
2 : s := '0' + s;
end;
//----------------
if ((Number mod 100) < 20) and ((Number mod 100) > 10) then
begin
case (Number mod 100) of
11 : a[1] := 'íÇÒÏå';
12 : a[1] := 'ÏæÇÒÏå';
13 : a[1] := 'ÓíÒÏå';
14 : a[1] := 'åÇÑÏå';
15 : a[1] := 'ÇäÒÏå';
16 : a[1] := 'ÔÇäÒÏå';
17 : a[1] := 'åÝÏå';
18 : a[1] := 'åÌÏå';
19 : a[1] := 'äæÒÏå';
end;
end
else
begin
case s[3] of
'0' : a[1] := '';
'1' : a[1] := 'í˜';
'2' : a[1] := 'Ïæ';
'3' : a[1] := 'Óå';
'4' : a[1] := 'åÇÑ';
'5' : a[1] := 'äÌ';
'6' : a[1] := 'ÔÔ';
'7' : a[1] := 'åÝÊ';
'8' : a[1] := 'åÔÊ';
'9' : a[1] := 'äå';
end;
//----------------
case s[2] of
'0' : a[2] := '';
'1' : a[2] := 'Ïå';
'2' : a[2] := 'ÈíÓÊ';
'3' : a[2] := 'Óí';
'4' : a[2] := 'åá';
'5' : a[2] := 'äÌÇå';
'6' : a[2] := 'ÔÕÊ';
'7' : a[2] := 'åÝÊÇÏ';
'8' : a[2] := 'åÔÊÇÏ';
'9' : a[2] := 'äæÏ';
end;
end;
//----------------
case s[1] of
'0' : a[3] := '';
'1' : a[3] := 'í˜ÕÏ';
'2' : a[3] := 'ÏæíÓÊ';
'3' : a[3] := 'Óí ÕÏ';
'4' : a[3] := 'åÇÑÕÏ';
'5' : a[3] := 'ÇäÕÏ';
'6' : a[3] := 'ÔÔ ÕÏ';
'7' : a[3] := 'åÝÊ ÕÏ';
'8' : a[3] := 'åÔÊ ÕÏ';
'9' : a[3] := 'äå ÕÏ';
end;
//----------------
For i := 3 downto 1 do if trim(a[i]) <> '' then Result := Result + a[i] + ' æ ';
Result := copy(Result, 0, length(Result) - 2)
end;
//================================================== ============================
Function NumberToWords(Number : Int64) : string; export; StdCall;
var c : integer;
A : Array[1..4] of String;
ts : string;
begin
Result := '';
A[1] := ' ';
A[2] := ' åÒÇÑ ';
A[3] := ' ãíáíæä ';
A[4] := ' ãíáíÇÑÏ ';

c := 1;
While (Number > 0) Do
Begin
ts := Phonetics(Number mod 1000);
if ts <> '' Then
if Trim(Result) = '' Then Result := ts + A[c] + Result Else Result := ts + A[c] + ' æ ' + Result;
Number := Number div 1000;
if c = 4 then break;
Inc(c);
End;
end;
//================================================== ============================
//================================================== ============================
procedure TMonyEdit.ConvertTextToNumber;
begin
if Trim(Text) = '' Then Number := 0
Else Number := StrToFloat(DeletePunctuationMarks(Text));
end;
//================================================== ============================
function TMonyEdit.DeletePunctuationMarks(SignedText : String) : String;
var I : Integer;
begin
For I := 1 to length(SignedText) do
If SignedText[I] = PunctuationMark then
delete(SignedText, I, 1);
DeletePunctuationMarks := SignedText;
end;
//================================================== ============================
procedure TMonyEdit.InsertPunctuationMarks;
var I : Integer;
TSB, TSA : string;
begin
if Text <> '' then
begin
TSB := ''; TSA := '';
If Pos('.', Trim(Text)) > 0 then
begin
TSB := Copy(Trim(Text), 1, Pos('.', Trim(Text)) - 1);
TSA := Copy(Trim(Text), (Pos('.', Trim(Text))), (Length(Text) - Pos('.', Trim(Text)) + 1));
end
else TSB := Text;

if TSB <> '' Then
begin
TSB := DeletePunctuationMarks(TSB);
I := length(TSB);
while i > 3 do
begin
insert(PunctuationMark, TSB, I-2);
i := i-3;
end;
end;

If TSA <> '' Then
begin
delete(TSA, 1, 1);
TSA := DeletePunctuationMarks(TSA);
I := length(TSA);
while i > 3 do
begin
insert(PunctuationMark, TSA, I-2);
i := i-3;
end;
TSA := '.' + TSA;
end;

Text := TSB + TSA;
SelStart := length(Text);
end;
end;
//================================================== ============================}
function TMonyEdit.GetName() : string;
begin
Result := 'ÚáíÑÖÇ äÌÝíÇä ÑÖæí';
end;
//================================================== ============================
type
TOOLINFO = packed record
cbSize: Integer;
uFlags: Integer;
hwnd: THandle;
uId: Integer;
rect: TRect;
hinst: THandle;
lpszText: PWideChar;
lParam: Integer;
end;

var
TipHandle : THandle;
TInfo : TOOLINFO;
ControlHandle : THandle;
MT : array[0..150] of WideChar;
//================================================== ============================
procedure TMonyEdit.ShowBalloonTip(Control: TWinControl; MsgText: string);
const
TOOLTIPS_CLASS = 'tooltips_class32';
TTS_ALWAYSTIP = $01;
TTS_NOPREFIX = $02;
TTS_BALLOON = $40;
TTF_SUBCLASS = $0010;
TTF_TRANSPARENT = $0100;
TTF_CENTERTIP = $0002;
TTM_ADDTOOL = $0400 + 50;
TTM_SETTITLE = (WM_USER + 32);
ICC_WIN95_CLASSES = $000000FF;

begin
StringToWideChar(MsgText, MT, sizeof(MT));

SendMessage(TipHandle, TTM_DELTOOL, Ord(True), integer(@TInfo));

ControlHandle := Control.Handle;
TipHandle := CreateWindow(TOOLTIPS_CLASS,
nil,
TTS_ALWAYSTIP or WS_POPUP or TTS_NOPREFIX or TTS_BALLOON,
0, 0, 0, 0,
ControlHandle,
0,
HInstance,
nil);
If TipHandle <> 0 then
begin
SetWindowPos(TipHandle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);

TInfo.cbSize := SizeOf(TInfo);
TInfo.uFlags := TTF_CENTERTIP or TTF_TRANSPARENT or TTF_SUBCLASS;
TInfo.hwnd := ControlHandle;
TInfo.lpszText := MT;
Windows.GetClientRect(ControlHandle, TInfo.rect);

SendMessage(TipHandle, TTM_SETTIPBKCOLOR, BalloonBackColor, 0);
SendMessage(TipHandle, TTM_SETTIPTEXTCOLOR, BalloonTextColor, 0);
SendMessage(TipHandle, TTM_ADDTOOL, 1, Integer(@TInfo));
If Trim(TipTitle) <> '' Then SendMessage(TipHandle, TTM_SETTITLE, TipIcon mod 4, Integer(TipTitle));
SendMessage(TipHandle, TTM_TRACKACTIVATE, Ord(true), Integer(@TInfo));
end;
end;
//================================================== ============================
procedure EditKD(var Key : Word; Shift: TShiftState; Obj : TCustomEdit);
Var Mgs : TMsg;
S : String;

Procedure EatKey;
begin
PeekMessage(Mgs, 0, WM_CHAR, WM_CHAR, PM_REMOVE);
end;

begin
If (ssShift in Shift) Then EatKey;
//-----------------------
If (ssCtrl in Shift) Then
Case Key Of
86 : {Ctrl + v}
begin
if Clipboard.HasFormat(CF_TEXT) Then
Try
StrToFloat(clipboard.AsText);
Except
EatKey;
end;
end;
67 : {Ctrl + c}
{do nothing}
else
EatKey;
end
else if not(char(Key) in [#8, #13, #48 .. #57, #96 ..#105, #109, #110, #190, #189]) Then EatKey;
S := Obj.Text;
//-----------------------
if ( ((obj.SelStart <> 0) and ( (char(key) = #189) or (char(key) = #109) )) or
((obj.SelStart = 0) and ( (char(key) = #190) or (char(key) = #110) )) or
((Obj.Text <> '') And (Char(s[obj.SelStart]) = '-') and ( (char(key) = #190) or (char(key) = #110) )) or
((AnsiContainsStr(trim(obj.Text), '.') = true) and ((char(key) = #190) or (char(key) = #110)))) Then EatKey;
end;
//================================================== ============================
Constructor TMonyEdit.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
Parent := parent;
BiDiMode := bdLeftToRight;
Text := '';
TipDispaly := True;
TipIcon := 1;
TipTitle := 'ÚäæÇä';
BalloonBackColor := $00FFFFFF;
BalloonTextColor := clNavy;
OnEnterColor := $00AAFFFF;
PunctuationMark := ',';
end;
//================================================== ============================
procedure TMonyEdit.Change;
var TS, TX : string;
A, B : Integer;
begin
inherited;
If (TipDispaly = True) And (Text = '') Then SendMessage(TipHandle, TTM_DELTOOL, Ord(True), integer(@TInfo));
TX := DeletePunctuationMarks(Text);
Ts := '';
Val(TX, A, B);
If (Text = '') Or ( (B <> 0) and (TX[B] <> '.') ) Then Exit;

If Pos('.', Text) > 0 Then
begin
TS := Copy(TX, (Pos('.', TX) + 1), (Length(TX) - Pos('.', TX)));
If TS <> '' Then TS := 'ããíÒ ' + NumberToWords(StrToInt64(TS));;
end;

ConvertTextToNumber;
TS := NumberToWords(trunc(Number)) + TS;
If TipDispaly = True Then ShowBalloonTip(Self, TS);

InsertPunctuationMarks;
end;

//================================================== ============================
procedure TMonyEdit.DoEnter;
begin
Change;
Tag := ColorToRGB(Color);
Color := OnEnterColor;
end;
//================================================== ============================
procedure TMonyEdit.DoExit;
begin
SendMessage(TipHandle, TTM_DELTOOL, Ord(True), integer(@TInfo));
Color := Tag;
end;
//================================================== ============================
procedure TMonyEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
inherited;
EditKD(Key, shift, self);
end;
//================================================== ============================
procedure Register;
begin
RegisterComponents('MAD', [TMonyEdit]);
end;

end.

[hassan p.b]

راستی قسمت فارسی دیده نمی شونند خودتان در notpad ببینید چگونه این را می توان کامل نمود
با تشکر
قبول عدد صفر در ابتدا
محدودیت تا یک تریلیون

[hassan p.b]

این هم خود فایل:

[MOJTABAATEFEH]

دوست عزيز از اين استفاده كن هم سه رقم سه رقم جدا مي كنه و هم به صورت Hint نمايش ميده انشاالله مشكلت حل ميشه :



type
tagEDITBALLOONTIP = record
cbStruct: Longword;
pszTitle: PWChar;
pszText: PWChar;
ttiIcon: Integer;
end;
type
PEDITBALLOONTIP = ^tagEDITBALLOONTIP;

const
ECM_FIRST = $00001500;
EM_SHOWBALLOONTIP = ECM_FIRST + 3;

procedure TForm1.edit1Onchange(Sender: TObject);
var
N : Currency;
ebt: tagEDITBALLOONTIP;
title, Text: Widestring;
icon: Integer;
begin
N := StrToCurr(Edit1.Text);
title := 'MojtabaIE';
Text := 'CurrToStrF(N,ffCurrency,0)';
icon := 1; //0,1,2,3
with ebt do
begin
cbStruct := SizeOf(ebt);
pszTitle := PWideChar(title);
pszText := PWideChar(Text);
ttiIcon := icon;
end;
SendMessage(Edit1.Handle, EM_SHOWBALLOONTIP, 0, Longint(@ebt));
end;

//حتما از XPMAN استفاده شود




موفق باشي

[hassan p.b]

با سلام و درود به شما و تشکر از همراهیتان
لطف شمارا تست می نمایم
با تشکر مجدد
حسن پوریوسف

[hassan p.b]

با سلام
مورد دوست عزيز كه فرمودند اجرا نشد
دو فايل ضميمه مي نمايم لطفا راهنمايي نماييد
با تشكر

[hassan p.b]

در نمونه هاي بالا numberedit كامپوننتي است براي جداسازي ارقام ولي قسمت عدم ورود حروف درست از آب در نيامد مورد تست هم لطف يكي از دوستان است كه كار نكرد براي نمايش اتوماتيك هينت
با تشكر

[young_man1365]

با سلام
فکر کنم راحت ترین راه حل برای شما استفاده از کامپوننت balloonhint باشه. اگه باهاش آشنایی ندارید بهتره تو سایت جستجو کنید. اگه چیزی دستگیرتون نشد در خدمتم.:لبخندساده:

[hassan p.b]

با تشكر
در جستجو از تبريز جستجو ها ناقص هستند من خودم پست هاي خودم را بعضا در جستجو پيدا نمي شونند
با تشكر

[A.Nemati]

دوست عزيز از اين استفاده كن هم سه رقم سه رقم جدا مي كنه و هم به صورت Hint نمايش ميده انشاالله مشكلت حل ميشه :
...


خيلي كد جالبي بود. البته اگه بخواي درست كار كنه بايد تو سورس، كوتيشن رو از خط


Text := 'CurrToStrF(N,ffCurrency,0)';

برداريد

تنها اشكالي كه به نظر مي‌رسه اينه كه مجبوريم تو مد XPMan باشيم

[khoshblagh]

دوست عزيز از اين استفاده كن هم سه رقم سه رقم جدا مي كنه و هم به صورت Hint نمايش ميده انشاالله مشكلت حل ميشه :



type




tagEDITBALLOONTIP = record

cbStruct: Longword;
pszTitle: PWChar;
pszText: PWChar;
ttiIcon: Integer;
end;
type
PEDITBALLOONTIP = ^tagEDITBALLOONTIP;


const
ECM_FIRST = $00001500;
EM_SHOWBALLOONTIP = ECM_FIRST + 3;


procedure TForm1.edit1Onchange(Sender: TObject);
var
N : Currency;
ebt: tagEDITBALLOONTIP;
title, Text: Widestring;
icon: Integer;
begin
N := StrToCurr(Edit1.Text);
title := 'MojtabaIE';
Text := 'CurrToStrF(N,ffCurrency,0)';
icon := 1; //0,1,2,3
with ebt do
begin
cbStruct := SizeOf(ebt);
pszTitle := PWideChar(title);
pszText := PWideChar(Text);
ttiIcon := icon;
end;
SendMessage(Edit1.Handle, EM_SHOWBALLOONTIP, 0, Longint(@ebt));
end;


//حتما از XPMAN استفاده شود









با تشکر از شما
من نتونستم از اون استفاده کنم . اگه ممکنه یک نمونه ارائه بدید . متشکرم.

[hassan p.b]

لطفا نمونه بزاريد
با تشكر

[AFTABGARDAN2006]

این تابع توی هر ویندوزی کار می کنه؟

[A.Nemati]

با اجازه MOJTABAATEFEH


لطفا نمونه بزاريد

يك نمونه كوچك براتون گذاشتم


این تابع توی هر ویندوزی کار می کنه؟
از آنجايي كه حتما بايد از XpMan استفاده بشه. پس از ويندوز XP به بعد كار مي‌كنه

[hassan p.b]

با سپاس لطفا همراهی نمایید

[hassan p.b]

با تشکر از راهنمایی جناب نعمتـــــــــــــــــــــ ـــی مورد حل شد
با تشکر