Форум: "Начинающим";
Текущий архив: 2009.07.05;
Скачать: [xml.tar.bz2];

Вниз

Показ hint-а вручную   Найти похожие ветки 

← →
товарищ вася   (2009-05-18 10:49) [0]

Ещё раз всех приветствую! Показываю вручную hint
procedure TForm1.MyShowHint(var HintStr: String; var CanShow: Boolean;
 var HintInfo: THintInfo);
var
 j:integer; p: TPoint;
begin
 if not (HintInfo.HintControl is TRichEdit) then Exit;
 HintInfo.HintColor := clCream;
 HintInfo.HideTimeout:=5000;
 GetCaretPos(p);
 p := RichEdit1.ClientToScreen(p);
 HintInfo.HintPos := p;
end;
ОнФормКриэйт :
Application.OnShowHint:=MyShowHint;
 Application.HintPause:=1;
 Application.HintHidePause:=3000;
собсна вот для чего всё вышесказанное было нужно:

procedure TForm1.RichEdit1KeyUp(Sender: TObject; var Key: Word;
 Shift: TShiftState);
var i,j,line,count,z:integer; buff,code:string;slashpos:integer;
begin
 h:=nil;
 if (key=vk_left) or (key=vk_right) or (key=VK_UP) or (key=VK_DOWN) or (Key=VK_HOME) or (key=vk_end) then
  begin
     ShowHnt;
     RichEdit1.SetFocus;
 end;
end;

procedure TForm1.ShowHnt;
var i,j,line,count,z:integer; buff,code:string;slashpos:integer;
begin
    count:=0;  RichEdit1.Hint:="";
     line:=RichEdit1.CaretPos.Y;
     slashpos:=RichEdit1.CaretPos.X;
     buff:=richedit1.Lines.Strings[line];
     for i:=slashpos downto 1 do
     if buff[i]="\" then inc(count);
     slashpos:=0;
     i:=RichEdit1.CaretPos.X+1;
     while (length(buff)<>0) and (i > 0) and (buff[i] <> "\") do Dec(i);
     j := RichEdit1.CaretPos.x+1;
     while (j <= Length(buff)) and (buff[j] <> "\") do Inc(j);
     if (i<>j) then
       begin
         rICHeDIT1.hINT:=Copy(buff,i+1,j-(i+1)); slashpos:=0;
         for z:=1 to count do  slashpos:=posex("\",richedit2.Lines.Strings[line],slashpos+1);
         slashpos:=slashpos+length(rICHeDIT1.hINT);
         code:=copy(richedit2.Lines.Strings[line],slashpos+2,codelength-2);
         if (i<>0) then if adotable1.Locate("kod",code,[]) then
              rICHeDIT1.hINT:=rICHeDIT1.hINT+" - "+code+" - "+adoTable1.FieldValues["t&#601;svir"]+#13+RichEdit2.Lines.Strings[line]
         else rICHeDIT1.hINT:=rICHeDIT1.hINT+" - 000"+#13+RichEdit2.Lines.Strings[line];
         if (i=0) then if adotable2.Locate("kod",code,[]) then
              rICHeDIT1.hINT:=rICHeDIT1.hINT+" - "+code+" - "+adoTable2.FieldValues["t&#601;svir"]+#13+RichEdit2.Lines.Strings[line]
         else rICHeDIT1.hINT:=rICHeDIT1.hINT+" - 000"+#13+RichEdit2.Lines.Strings[line];
       end;
end;

Самое прикольное то что на  лаптопах при навигации каретки RichEdit1KeyUp подсказку показывает не всегда , а на моем десктопе показывает всегда,(проверял на 2 лаптопах) случайность?)))

---

← →
Товарищ Маузер   (2009-05-18 11:16) [1]

Так а в чём вопрос собстна ?

---

← →
товарищ вася   (2009-05-18 11:27) [2]

> Так а в чём вопрос собстна ?

Если поменять код на такой:
procedure TForm1.RichEdit1KeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
var i,j,line,count,z:integer; buff,code:string;slashpos:integer;pt:TPOint;
begin
h:=nil;
if (key=vk_left) or (key=vk_right) or (key=VK_UP) or (key=VK_DOWN) or (Key=VK_HOME) or (key=vk_end) then
 begin
    GetCursorPos(pt);
    SetCursorPos(pt.x,pt.y)
    ShowHnt;
    RichEdit1.SetFocus;
end;
end;
то подсказку показывает  всегда и везде
А теперь вопрос что делают эти две строки такого что все заработало?
    GetCursorPos(pt);
    SetCursorPos(pt.x,pt.y)
ведь поидее результат тот же самый курсор на том же месте...
по сути я  y:=y...
в чем фишка?

---

← →
brother ©   (2009-05-18 11:33) [3]

> в чем фишка?

сбросс мышиных сообщений?

---

← →
Anatoly Podgoretsky ©   (2009-05-18 11:45) [4]

> товарищ вася  (18.05.2009 11:27:02)  [2]

Это по сути PT, но суть шире.

---

Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2009.07.05;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.46 MB
Время: 0.004 c