Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2018.10.21;
Скачать: [xml.tar.bz2];

Вниз

TPanel на потомке от TCustomControl   Найти похожие ветки 

 
Денис11998833   (2016-09-06 02:56) [0]

Наткнулся на полезный компонент на базе TCustomControl, который показывает в области трея окно.

Всё было хорошо пока не положил TPanel на этот контрол. Почему то ни панель, ни компоненты на панели не отображаются. Простой пример кидаю лэйбл прямо на KMAlert, он отрисовывается, кидаю его панель, а панель в свою очередь кидаю на KMAlert и ничего не отрисовывается.

День убил на сабж, истинна где то рядом, но так и не разобрался что ему надо.

Вот оригинальный исходник (авторство не моё, автору спасибо):


unit KMAlert;

interface

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

type
 TAlertDirection = (adNone, adUp, adDown, adLeft, adRight);
 TOnShow = procedure (Sender: TObject) of object;
 TOnClose = procedure (Sender: TObject) of object;

type
TKMAlert = class(TCustomControl)
 private
  FAlertDirection: TAlertDirection;
   FCloseDelay: Integer;
   FDelayTimer: TTimer;
   FForegroundColor: TColor;
   FInProgress: Boolean;
   FOnShow: TOnShow;
   FOnClose: TOnClose;
   TaskBarRect: TRect;
   FPanel1: TPanel;
   function FindTaskbar(var ARect: TRect): Integer;
   procedure GetTaskBar;
   procedure SetCloseDelay(const Value: Integer);
   procedure SetForegroundColor(const Value: TColor);
   procedure GoPopUp;
 protected
   procedure CreateParams(var Params: TCreateParams); override;
   procedure CreateWnd; override;
   procedure DoDelayTimer(Sender: TObject);
   procedure Paint; override;
   procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
   procedure WMSize(var Message: TWMSize); message WM_SIZE;
   procedure Loaded; override;
   procedure SetParent(AParent: TWinControl); override;
 public
  constructor Create(AOwner: TComponent); override;
  procedure PopUp;
  procedure CloseUp;
   procedure Show(X, Y: Integer);
 published
   property CloseDelay: Integer read FCloseDelay write SetCloseDelay;
   property Font;
   property ForegroundColor: TColor read FForegroundColor write SetForegroundColor;
   property OnShow: TOnShow read FOnShow write FOnShow;
   property OnClose: TOnClose read FOnClose write FOnClose;
   property OnClick;
   property OnContextPopup;
   property OnDblClick;
   property OnDragDrop;
   property OnDragOver;
   property OnEndDock;
   property OnEndDrag;
   property OnMouseDown;
   property OnMouseMove;
   property OnMouseUp;
   property OnStartDock;
   property OnStartDrag;
 end;

procedure Register;

var
 TaskBarPos: Cardinal;

implementation

{ TKMAlert }

procedure Register;
begin
 RegisterComponents("KMAlert", [TKMAlert]);
end;

constructor TKMAlert.Create(AOwner: TComponent);
begin
 inherited;
 Visible:= csDesigning in ComponentState;
 ControlStyle:= ControlStyle + [csAcceptsControls, csReplicatable];
 FAlertDirection:= adNone;
 FCloseDelay:= 5000;
 FForegroundColor:= clInfoBk;
 FInProgress:= False;
 FDelayTimer:= TTimer.Create(Self);
 FDelayTimer.Enabled:= False;
 FDelayTimer.OnTimer:= DoDelayTimer;
 FDelayTimer.Interval:= FCloseDelay;
 FPanel1:=TPanel.Create(Self);
 FOnShow:= nil;
 ParentColor:= True;
 Height:= 153;
 Width:= 169;
end;

procedure TKMAlert.CreateParams(var Params: TCreateParams);
begin
 inherited CreateParams(Params);
 with Params do
  if not (csDesigning in ComponentState) then
   begin
    WndParent:= GetDesktopWindow;
     Style:= WS_CLIPSIBLINGS or WS_CHILD;
    ExStyle:= WS_EX_TOPMOST or WS_EX_TOOLWINDOW;
     WindowClass.Style:= CS_DBLCLKS or CS_SAVEBITS and not(CS_HREDRAW or CS_VREDRAW);
  end;
end;

procedure TKMAlert.CreateWnd;
begin
 inherited;
end;

procedure TKMAlert.SetCloseDelay(const Value: Integer);
begin
 FCloseDelay:= Value;
 FDelayTimer.Interval:= Value;
end;

procedure TKMAlert.SetForegroundColor(const Value: TColor);
begin
 FForegroundColor:= Value;
 Invalidate;
end;

procedure TKMAlert.DoDelayTimer(Sender: TObject);
begin
 FInProgress:= False;

 FDelayTimer.Enabled:= False;

 CloseUp;
end;

procedure TKMAlert.GoPopUp;
var
delta: Integer;
begin
 if Assigned(FOnShow) then FOnShow(Self);

 delta:= 0;

 case TaskBarPos of
   ABE_BOTTOM:
     delta:= TaskbarRect.Bottom - TaskbarRect.Top;
   ABE_TOP:
     delta:= TaskbarRect.Bottom;
   ABE_LEFT:
     delta:= TaskbarRect.Right;
   ABE_RIGHT:
     delta:= TaskbarRect.Right - TaskbarRect.Left;
 end;

 case FAlertDirection of
   adUp:
   begin
     SetWindowPos(Handle, HWND_TOPMOST, (Screen.Width - Width),
         (Screen.Height - delta) - Height, Width, Height, SWP_HIDEWINDOW);
     AnimateWindow(Handle, 500, AW_VER_NEGATIVE + AW_SLIDE);
     FDelayTimer.Enabled:= True;
   end;
   adDown:
   begin
     SetWindowPos(Handle, HWND_TOPMOST, Screen.Width - Width,
                  delta, Width, Height, SWP_HIDEWINDOW);
     AnimateWindow(Handle, 500, AW_VER_POSITIVE + AW_SLIDE);
     FDelayTimer.Enabled:= True;
   end;
   adLeft:
   begin
     SetWindowPos(Handle, HWND_TOPMOST, (Screen.Width - delta) - Width,
         Screen.Height - Height, Width, Height, SWP_HIDEWINDOW);
     AnimateWindow(Handle, 500, AW_HOR_NEGATIVE + AW_SLIDE);
     FDelayTimer.Enabled:= True;
   end;
   adRight:
   begin
     SetWindowPos(Handle, HWND_TOPMOST, delta,
                  Screen.Height - Height, Width, Height, SWP_HIDEWINDOW);
     AnimateWindow(Handle, 500, AW_HOR_POSITIVE + AW_SLIDE);
     FDelayTimer.Enabled:= True;
   end;
 end;
end;


 
Денис11998833   (2016-09-06 02:57) [1]



procedure TKMAlert.CloseUp;
var
 OldPos: Cardinal;
begin
 if Assigned(FOnClose) then FOnClose(Self);

 OldPos:= TaskBarPos;

 GetTaskBar;

 FDelayTimer.Enabled:= False;

 if OldPos <> TaskBarPos then
   FAlertDirection:= adNone;

 case FAlertDirection of
   adUp:
     AnimateWindow(Handle, 500, AW_VER_POSITIVE + AW_SLIDE + AW_HIDE);
   adDown:
     AnimateWindow(Handle, 500, AW_VER_NEGATIVE + AW_SLIDE + AW_HIDE);
   adLeft:
     AnimateWindow(Handle, 500, AW_HOR_POSITIVE + AW_SLIDE + AW_HIDE);
   adRight:
     AnimateWindow(Handle, 500, AW_HOR_NEGATIVE + AW_SLIDE + AW_HIDE);
   adNone:
     AnimateWindow(Handle, 500, AW_CENTER + AW_SLIDE + AW_HIDE);
 end;
end;

procedure TKMAlert.Show(X, Y: Integer);
begin
 if Assigned(FOnShow) then FOnShow(Self);

 FInProgress:= True;

 SetWindowPos(Handle, HWND_TOPMOST, X, Y,
              Width, Height, SWP_HIDEWINDOW);

 AnimateWindow(Handle, 500, AW_CENTER + AW_SLIDE);

 FAlertDirection:= adNone;

 FDelayTimer.Enabled:= True;
end;

procedure TKMAlert.WMNCPaint(var Message: TMessage);
begin
 inherited;
end;

procedure TKMAlert.WMSize(var Message: TWMSize);
begin
 inherited;
end;

procedure TKMAlert.Paint;
var
 R: TRect;
begin
 inherited;
{ with Canvas do
 begin
   Brush.Color:= ForegroundColor;
   FillRect(ClientRect);

   R:= ClientRect;
   OffsetRect(R, R.Left, R.Top);
   DrawEdge(Handle, R, EDGE_RAISED, BF_RECT);
   InflateRect(R, -2, -2);
   DrawEdge(Handle, R, EDGE_SUNKEN, BF_RECT);
 end;  }
end;

procedure TKMAlert.Popup;
begin
 ShowWindow(Handle, SW_HIDE);

 GetTaskBar;

 case TaskBarPos of
   ABE_BOTTOM:
    FAlertDirection:= adUp;
   ABE_TOP:
     FAlertDirection:= adDown;
   ABE_LEFT:
     FAlertDirection:= adRight;
   ABE_RIGHT:
     FAlertDirection:= adLeft;
 end;

 FInProgress:= True;

 GoPopUp;
end;

function TKMAlert.FindTaskbar(var ARect: TRect): Integer;
var
AppData: TAppBarData;
begin
AppData.Hwnd:= FindWindow("Shell_TrayWnd", nil);
 AppData.cbSize:= SizeOf(TAppBarData);
 if SHAppBarMessage(ABM_GETTASKBARPOS, AppData) = 0 then
   raise Exception.Create("SHAppBarMessage returned false when trying " +
     "to find the Task Bar""s position");
 Result:= AppData.uEdge;
 ARect:= AppData.rc;
end;

procedure TKMAlert.GetTaskBar;
begin
 TaskBarPos:= FindTaskBar(TaskBarRect);
end;

end.


 
Денис11998833   (2016-09-06 02:58) [2]

Попутный теоретический вопрос. Автор зачем то написал:


procedure TKMAlert.WMNCPaint(var Message: TMessage);
begin
inherited;
end;


Разве это не равносильно отсутствующему куску кода в данном случае?


 
Игорь Шевченко ©   (2016-09-06 10:54) [3]


> Автор зачем то написал:


Задумывал свершить, не вышло.


> Разве это не равносильно отсутствующему куску кода в данном
> случае?


Это равносильно отсутствию кода в любом случае, не только в этом.


>  Почему то ни панель, ни компоненты на панели не отображаются


Не используй панель


 
Денис11998833   (2016-09-06 12:53) [4]

В том и проблема что есть компонент кастомный на основе TCustomPanel, без котрого будет сложно обойтись(

А все таки корень причины и направление ее решения есть?


 
Игорь Шевченко ©   (2016-09-06 17:03) [5]


> А все таки корень причины и направление ее решения есть?


Всегда есть. Например, попользоваться отладчиком или трассировкой сообщений.

кстати, а это зачем ?

FPanel1:=TPanel.Create(Self);


 
Денис11998833   (2016-09-06 19:03) [6]

> Всегда есть. Например, попользоваться отладчиком или трассировкой сообщений.

Чтож вы сразу не сказали, теперь всё стало ясно! Я отладчиком уже заездил все вдоль и поперёк. И сюда пришёл не после 5 минутных проб пера, уже 2 дня с этой проблемой мучаюсь.

А по существу что нибудь можете сказать?

> кстати, а это зачем ?

забыл убрать, экспериментировал с панелькой.


 
Денис11998833   (2016-09-06 20:18) [7]

Visible:=True

Частично решило проблему.

Осталось проблема в том что AnimateWindow не посылает WM_PAINT в процессе анимации. Только WM_PRINT и WM_RPINTCLIENT в начале и в конце рисования. Т.е. контролы прорисовываются только по окончанию анимации.

Вопрос, как заставить отрисоваться дочерние компоненты на контроле которые ещё скрыт (Visible=False). Насколько знаю винда противиться этому(..


 
Eraser ©   (2016-09-06 21:14) [8]


> Денис11998833

когда-то нужно было решить подобную задачу, по-моему нормального решения сходу не нашлось и забили.

не так давно увидел такой компонент TdxCalloutPopup (из набора devexpress), он делает то что нужно. каким образом - не разбирался.



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

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

Наверх





Память: 0.49 MB
Время: 0.001 c
11-1267468114
Boguslaw
2010-03-01 21:28
2018.10.21
time difference


2-1473077853
валя
2016-09-05 15:17
2018.10.21
указатели


2-1473244823
валя
2016-09-07 13:40
2018.10.21
чтение запись строки из файла


2-1473119810
Денис11998833
2016-09-06 02:56
2018.10.21
TPanel на потомке от TCustomControl


2-1472882501
RusSun
2016-09-03 09:01
2018.10.21
Как быстро узнать что в строке одни нули?





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский