Текущий архив: 2005.02.27;
Скачать: CL | DM;

Вниз

завтра утром прогу сдавать а проблема возникла там где ее ни кто   Найти похожие ветки 

← →
Вудзрш5.01   (2004-04-26 21:01) [0]

Вот проблема, завтра утром прогу сдавать а проблема возникла там где ее ни кто не ожидал. Создал компонент, ну типа кнопки, когда маусом переводишь кнопка становится выпуклой! Все работает ок, до того как я не прицепил еще одно свойство уже из программы на MouseMove, теперь на перемещение кнопка не реагирует, не происходит ее прорисовка в выпуклом виде.

---

← →
Delphi5.01 ©   (2004-04-26 21:23) [1]

Тестирования показало что моя процедура MouseMove полностью перекрывает процедуру MouseMove компонента, так что она вообще не выполняется?!

---

← →
z007   (2004-04-26 21:39) [2]

Видимо, не выполняется. Это надо особо обработать в WndProc компонента или хотя бы в OnMessage .

Как я понимаю, в компоненте кнопка становится выпуклой при обработке сообщения в WndProc ?
Если так, попробуй посмотреть в код KOL и продублировать в WndProc компонента вызов типа if assigned(fOnMouseMove) then...

Результат иногда может быть разным в зависимости от того, вызывается ли fOnMouseMove в WndProc до или после выполнения своего кода.

---

← →
SPeller ©   (2004-04-27 02:54) [3]

А что за компонент?

---

← →
Delphi5.01 ©   (2004-04-27 17:32) [4]

Da komponent eto CrazyButton, ochen pomogaet kogda neskolko knopok ochen blizko drug s drugom raspolojeni i ih konturi ochen izvilistie!

2 z007
ia snachala perekrival pramo svoistvo OnMouseMove, potom v WndProc perenos. WndProc pomoglo no teper soobshenie mouseleave proishodit tolko v tom sluchae esli ia krome WndProc ispolzuiu perekritie OnMouseLeave! A pochemu?
...
 case Msg.message of
   WM_LBUTTONDOWN:
     begin
       pCrazyButton(Sender).fMouseDown(Sender,SmallPointToPoint(TSmallPoint(Msg.LParam)));
     end;
   WM_LBUTTONUP:
     begin
       pCrazyButton(Sender).fMouseUp(Sender,SmallPointToPoint(TSmallPoint(Msg.LParam)));
     end;
   WM_MOUSEMOVE:
     begin
       pCrazyButton(Sender).fMouseMove(Sender,SmallPointToPoint(TSmallPoint(Msg.LParam)));
     end;
   WM_MOUSELEAVE:
     begin
//        MsgOK("OK");
       pCrazyButton(Sender).fLeave(Sender);
     end;
 end;
 Result:=false;  
end;

esli v kode vklucheno
function NewCrazyButton(AParent: pControl): TKOLCrazyButton;
...
Result.OnMouseLeave:=Result.fMouseLeave;
...

to vso ok, a esli net to problemi, mesaga s MouseLeave voobshe ne dohodit do moego komponenta! A pochemu?

---

← →
Delphi5.01 ©   (2004-04-27 17:54) [5]

Testirovanie pokazalo chto po ne izvestnoi mne prichine posle WM_MOUSELEAVE proishodit WM_MOUSEMOVE mesedg?!

---

← →
z007   (2004-04-27 22:42) [6]

См.: kol.WndProcMouseEnterLeave

Программу-то сдал?

---

← →
Delphi5.01 ©   (2004-04-27 23:13) [7]

Da, na konferencie pervoe mesto zanal. Teper na respublikanskuiu konferenciu pustili! :-)

---

← →
Delphi5.01 ©   (2004-04-27 23:15) [8]

Na shot kol.WndProcMouseEnterLeave
Ia prosmotrel kak KOL delaet MouseLeave, u nego kajetsa vso toje samoe chto u mena. No u mena ne raboataet :-)

---

← →
SPeller ©   (2004-04-28 09:39) [9]

Будешь дальше писать на латинице, тем более помогать всем в ломы будет (совет полезный :-)

---

← →
Gandalf ©   (2004-04-28 13:13) [10]

Реально - Delphi5.01 ©  - втою латиницу принципиально не читаю - у меня скорость чтения латиницы очень низкая.

---

← →
Delphi5.01 ©   (2004-04-28 14:31) [11]

A vot i po ruski!

Вот появилась такая мысля!
Что является аналогом inhereted в KOL?
Вот например если а хочу перекрыть свойство MouseClick у моего компонента.
Один из вариантов который мне пришел в голову это старомодный (не работает)

function NewCrazyButton(AParent: pControl): TKOLCrazyButton;
...
begin
...
Result.OnMouseClick:=fMouseClick;
...
end;

procedure TKOLCrazyButton.fMouseClick(...)
...
begin
...
// здесь все что надо чтоб произошло на MouseClick
...
end;

но когда в программе надо прикрепить к моему новому компоненту обработку MouseClick я пишу:
MyButton.OnMouseClick:=MyMouseClick;
Фактически я сам удаляю указатель на процедуру компонента fMouseClick в которой хранится информация что именно должен сделать компонент при MouseClick. Как я заметил в данном случае решением является inhereted но его у KOL нету, или я не смог найти.

Вторым решением является (работает, но не для всех месаг)

function CrazyButtonWndProc(Sender: PControl; var Msg: TMsg; var Rslt: Integer): Boolean;
...
begin
...
Result:=false;
case Msg.message of
  WM_LBUTTONDBLCLK:
    begin
      pCrazyButton(Sender).fMouseClick(Sender,
        SmallPointToPoint(TSmallPoint(Msg.LParam)));
    end;
end;
...
end;

procedure TKOLCrazyButton.fMouseClick(...)
...
begin
...
// здесь все что надо чтоб произошло на MouseClick
...
end;

все работает без сбоев, переменная OnMouseMove свободна, при программировании в нее можно помещать указатель на нашу функцию, нижу указанный код не даст сбоев
MyButton.OnMouseClick:=MyMouseClick;

Зачем мне нужно было так длинно все изъяснять, "это же и так всем ясно".

Так вот перейду к сути. Проблема в том что данным методом не возможно обработать сообщение:
WM_MOUSELEAVE:
  begin
    MsgOK("OK");
  end;
А почему? Оно появляется только в том случае если в конструктора есть строка
Result.OnMouseLeave:=fMouseLeave;
Не имеет значения что делает процедура fMouseLeave, она может быть вообще пустой.

В чем загвоздка?

П.С. Не один раз перечитал статью "Создание визуальных компонентов для библиотеки KOL"

---

← →
Delphi5.01 ©   (2004-04-28 14:31) [12]

A vot i po ruski!

Вот появилась такая мысля!
Что является аналогом inhereted в KOL?
Вот например если а хочу перекрыть свойство MouseClick у моего компонента.
Один из вариантов который мне пришел в голову это старомодный (не работает)

function NewCrazyButton(AParent: pControl): TKOLCrazyButton;
...
begin
...
Result.OnMouseClick:=fMouseClick;
...
end;

procedure TKOLCrazyButton.fMouseClick(...)
...
begin
...
// здесь все что надо чтоб произошло на MouseClick
...
end;

но когда в программе надо прикрепить к моему новому компоненту обработку MouseClick я пишу:
MyButton.OnMouseClick:=MyMouseClick;
Фактически я сам удаляю указатель на процедуру компонента fMouseClick в которой хранится информация что именно должен сделать компонент при MouseClick. Как я заметил в данном случае решением является inhereted но его у KOL нету, или я не смог найти.

Вторым решением является (работает, но не для всех месаг)

function CrazyButtonWndProc(Sender: PControl; var Msg: TMsg; var Rslt: Integer): Boolean;
...
begin
...
Result:=false;
case Msg.message of
  WM_LBUTTONDBLCLK:
    begin
      pCrazyButton(Sender).fMouseClick(Sender,
        SmallPointToPoint(TSmallPoint(Msg.LParam)));
    end;
end;
...
end;

procedure TKOLCrazyButton.fMouseClick(...)
...
begin
...
// здесь все что надо чтоб произошло на MouseClick
...
end;

все работает без сбоев, переменная OnMouseMove свободна, при программировании в нее можно помещать указатель на нашу функцию, нижу указанный код не даст сбоев
MyButton.OnMouseClick:=MyMouseClick;

Зачем мне нужно было так длинно все изъяснять, "это же и так всем ясно".

Так вот перейду к сути. Проблема в том что данным методом не возможно обработать сообщение:
WM_MOUSELEAVE:
  begin
    MsgOK("OK");
  end;
А почему? Оно появляется только в том случае если в конструктора есть строка
Result.OnMouseLeave:=fMouseLeave;
Не имеет значения что делает процедура fMouseLeave, она может быть вообще пустой.

В чем загвоздка?

П.С. Не один раз перечитал статью "Создание визуальных компонентов для библиотеки KOL"

---

← →
Delphi5.01 ©   (2004-04-28 14:31) [13]

Я имею в виду конструкцию которая дает аналог inhereted в KOL. Как я уже изъяснился обыкновенный старый метод в кол не работает а вот WM_MOUSELEAVE не могу использовать.
Вот еще одна загвоздка, почему-то после WM_MOUSELEAVE я получая и WM_MOUSEMOVE?

---

← →
Delphi5.01 ©   (2004-04-28 17:32) [14]

Вот решил, пусть будет лишнее присваивание Result.OnMouseLeave:=Result.fMouseLeave; Просто присвою какую-то не нужную функцию, и все будет работать (конечно не стабильно но все-таки временно подойдет), но возникла проблема:
По не известной причине после сообщения WM_MOUSELEAVE мгновенно возникает второе сообщение  WM_MOUSEMOVE что реально не должно происходит!

---

← →
z007   (2004-04-28 20:06) [15]

Насчет Inherited, кажется открывалась отдельная ветка.
Мы натурально по разные стороны баррикад и языки у нас непохожие. Шли свою суперкнопку. Сделаем ей все чего надо.

---

← →
Delphi5.01 ©   (2004-04-28 20:17) [16]

Я наверно не правильно выразился когда сказал "Что является аналогом inhereted в KOL?".
Я имел в виду, какая конструкция является аналогом VCL кода:

procedure MouseDown(Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer); override;

procedure TMyComp.MouseDown(Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
...
begin
...
 // делаю что-то
...
 inhereted;
end;

Спасибо за помощь

---

← →
Delphi5.01 ©   (2004-04-28 20:23) [17]

Код не маленький :-)

uses
 Windows, KOL, Messages;

const
 DelimChar=#13;
 MaskColor=clLime;

type
 TPointArray = array of TPoint;
 TRGNArray = array of HRGN;
 TRGNSPoints = record
                 PointsCount: Integer;
                 PointsArray: TPointArray;
               end;

type
 pCrazyButton = ^TCrazyButton;
 TKOLCrazyButton = pCrazyButton;
 TCrazyButton = object(TControl)
 private
   { Private declarations }
   function GetFileName: String;
   procedure SetFileName(Value: String);
   function GetActiveButton: Integer;

   function ReadWord(FileStream: pStream): String;
   Procedure ReadBitMapFile(FileStream: pStream;
                            Index: Byte;
                        var MemoryStream: pStream);
   procedure LoadRGNS(FileStream: PStream);
   procedure MakeRGNSMask;
   procedure DrawBitMapRGN(DestCanvas: PCanvas;
                           SrcBitMap: PBitMap;
                           BkGround: PBitMap;
                           RGN: HRGN);
   procedure LoadData;
   procedure fPaint(Sender: PControl; DC: HDC);
   procedure fMouseMove(Sender: PControl; pt: TPoint);
   procedure fMouseDown(Sender: PControl; pt: TPoint);
   procedure fMouseUp(Sender: PControl; pt: TPoint);
   procedure fMouseLeave(Sender: PObj);
 public
   { Public declarations }
   property FileName: String read GetFileName write SetFileName;
   property ActiveButton: Integer read GetActiveButton;
 end;

type
 pCrazyButtonData = ^TCrazyButtonData;
 TCrazyButtonData = object(TObj)
 private
   { Private declarations }
   fActiveButton: Integer;
   fFileName: String;
   fMMove: Boolean;
   fMDown: Boolean;
   RGNSCount: Integer;
   RGNSPoints: array of TRGNSPoints;
   RGNS: TRGNArray; //kundulebis regionebi
   MaskRGNS: TRGNArray; //Maskis regionebi
   NormalBitMap: pBitMap;
   OverBitMap: pBitMap;
   DownBitMap: pBitMap;
   BufferBitMap1: pBitMap;
   BufferBitMap2: pBitMap;
   BRUSH_: HBRUSH;
 public
   { Public declarations }
   destructor Destroy; virtual;
 end;

function NewCrazyButton(AParent: pControl): TKOLCrazyButton;

implementation

function CrazyButtonWndProc(Sender: PControl; var Msg: TMsg; var Rslt: Integer): Boolean;
begin
 case Msg.message of
   WM_LBUTTONDOWN:
     begin
       pCrazyButton(Sender).fMouseDown(Sender,SmallPointToPoint(TSmallPoint(Msg.LParam)));
     end;
   WM_LBUTTONUP:
     begin
       pCrazyButton(Sender).fMouseUp(Sender,SmallPointToPoint(TSmallPoint(Msg.LParam)));
     end;
   WM_MOUSEMOVE:
     begin
       pCrazyButton(Sender).fMouseMove(Sender,SmallPointToPoint(TSmallPoint(Msg.LParam)));
     end;
   WM_MOUSELEAVE:
     begin
       MsgOK("OK");
       pCrazyButton(Sender).fMouseLeave(Sender);
     end;
 end;
 Result:=false;  
end;  

function NewCrazyButton(AParent: pControl): TKOLCrazyButton;
var
 Data: pCrazyButtonData;
begin
 Result:=pCrazyButton(NewPanel(AParent,esNone));
 Result.OnMouseLeave:=Result.fMouseLeave;
 Result.OnPaint:=Result.fPaint;
 Result.AttachProc(@CrazyButtonWndProc);
 Result.Show;

 New(Data,Create);
 Result.CustomObj:=Data;
 Data.NormalBitMap:=NewBitMap(0,0);
 Data.OverBitMap:=NewBitMap(0,0);
 Data.DownBitMap:=NewBitMap(0,0);
 Data.BRUSH_:=CreateSolidBrush(MaskColor);
 Data.FActiveButton:=-1;
end;

destructor TCrazyButtonData.Destroy;
begin
 NormalBitMap.Free;
 OverBitMap.Free;
 DownBitMap.Free;
end;

function TCrazyButton.GetFileName: String;
begin
 Result:=pCrazyButtonData(CustomObj).fFileName;
end;

procedure TCrazyButton.SetFileName(Value: String);
begin
 pCrazyButtonData(CustomObj).fFileName:=Value;
 if pCrazyButtonData(CustomObj).fFileName<>"" then
   LoadData;
end;

function TCrazyButton.GetActiveButton: Integer;
begin
 result:=pCrazyButtonData(CustomObj).fActiveButton;
end;

function TCrazyButton.ReadWord(FileStream: pStream): String;
   var Text_: String;
       Ch: Char;
 begin
   ...
 end;

Procedure TCrazyButton.ReadBitMapFile(FileStream: pStream;
                                     Index: Byte;
                                 var MemoryStream: pStream);
   var i: Integer;
       FileSize: Integer;
       Buffer: array of Char;
 begin
   ...
 end;

procedure TCrazyButton.LoadRGNS(FileStream: PStream);
   var i,j: Integer;
       FileSize: Integer;
 begin
   ...
 end;

procedure TCrazyButton.MakeRGNSMask;
   var i: Integer;
       RGN: HRGN;
 begin
   ...
 end;

procedure TCrazyButton.DrawBitMapRGN(DestCanvas: PCanvas;
                              SrcBitMap: PBitMap;
                              BkGround: PBitMap;
                              RGN: HRGN);
   var TransparentColor: Integer;
 begin
   ...
 end;

procedure TCrazyButton.LoadData;
 var FileStream: PStream;
     MemoryStream: PStream;

 begin
   ...
 end;

procedure TCrazyButton.fPaint(Sender: PControl; DC: HDC);
 begin
   if pCrazyButtonData(CustomObj).fFileName="" then exit;
   if pCrazyButtonData(CustomObj).fActiveButton=-1 then
     begin
       pCrazyButtonData(CustomObj).NormalBitMap.Draw(Canvas.Handle,0,0);
       exit;
     end;
   if pCrazyButtonData(CustomObj).FMMove then
     if Not pCrazyButtonData(CustomObj).FMDown then
       begin
         DrawBitMapRGN(Canvas,pCrazyButtonData(CustomObj).OverBitMap,pCrazyButtonData(CustomObj).NormalBitMap,pCrazyButtonData(Cu stomObj).MaskRGNS[pCrazyButtonData(CustomObj).FActiveButton]);
         exit;
       end else
       begin
         DrawBitMapRGN(Canvas,pCrazyButtonData(CustomObj).DownBitMap,pCrazyButtonData(CustomObj).NormalBitMap,pCrazyButtonData(Cu stomObj).MaskRGNS[pCrazyButtonData(CustomObj).FActiveButton]);
         exit;
       end;
 end;

procedure TCrazyButton.fMouseMove(Sender: PControl; pt: TPoint);
   var i: Integer;
 begin
   pCrazyButtonData(CustomObj).FActiveButton:=-1;
   pCrazyButtonData(CustomObj).FMMove:=True;
   for i:=0 to pCrazyButtonData(CustomObj).RGNSCount-1 do
     if PtInRegion(pCrazyButtonData(CustomObj).RGNS[i],pt.X,pt.Y) then
       begin
         pCrazyButtonData(CustomObj).FActiveButton:=i;
         Break;
       end;
   fPaint(Sender,Canvas.Handle);
 end;

procedure TCrazyButton.fMouseDown(Sender: PControl; pt: TPoint);
 begin
   pCrazyButtonData(CustomObj).FMDown:=True;
   fPaint(Sender,Canvas.Handle);
 end;

procedure TCrazyButton.fMouseUp(Sender: PControl; pt: TPoint);
 begin
   pCrazyButtonData(CustomObj).FMDown:=False;
   fPaint(Sender,Canvas.Handle);
 end;

procedure TCrazyButton.fMouseLeave(Sender: PObj);
begin
 pCrazyButtonData(CustomObj).FActiveButton:=-1;
 fPaint(PControl(Sender),Canvas.Handle);
end;

end.


---

← →
Delphi5.01 ©   (2004-04-30 07:55) [18]

Всем кто считает что вопрос легкий!
На легкие вопросы мне кажется ответы есть а я что-то не вижу ни одного реального ответа!
Хочу поблагодарить z007 который реально посоветовал, и благодаря его совету вопрос был решен.
Всем спасибо кто реально хотел помочь, а не показать что они умней и что я задаю глупые вопросы!
Всегда найдется легкий вопрос в котором что-то можно научится.
Объявляю тему закрытой

---

← →
Дмитрий Галин   (2004-08-12 09:34) [19]

Удалено модератором

---

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

Текущий архив: 2005.02.27;
Скачать: CL | DM;

Наверх

Память: 0.54 MB
Время: 0.062 c