Форум: "Основная";
Текущий архив: 2004.12.05;
Скачать: [xml.tar.bz2];
ВнизHelp Button Найти похожие ветки
← →
Jay (2004-11-17 10:08) [0]Подскажите (может у кого есть пример), как использовать кнопку "?", которая слева от кнопки минимизировать?
← →
Amoeba © (2004-11-17 10:10) [1]У формы нужно написать обработчик сообщения WM_Help, если не ошибаюсь.
← →
Jay (2004-11-17 10:16) [2]А как перехватывать, куда я кликну знаком вопроса?
← →
bon © (2004-11-17 12:01) [3]unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, ExtCtrls, StdCtrls;
const
wm_BtnClk = wm_User + 111;{Определяем своё сообщение}
type
TForm1 = class(TForm)
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
R: TRect;{Переменная для обозначения прямоугольной области кнопки}
Press: Boolean;
procedure WmNcPaint(var Msg: TWmNcPaint); message wm_NcPaint;
procedure WMNcActivate(var msg: TwmncActivate); message wm_NcActivate;
procedure WmNcLButtonDown( var Msg: TWMNCLBUTTONDOWN); message Wm_NCLbuttonDown;
procedure wmnchittest(var Msg: TWMncHITTEST); message wm_NcHittest;
procedure wmSize(var Msg: TMessage); message wm_Size;
procedure wmncLButtonUp(var msg: TWMncLBUTTONUP); message wm_NclButtonUp;
procedure wmLbuttonUp(var Msg: TMessage); message wm_LbuttonUp;
procedure wmBtnClk(var msg: TMessage); message wm_BtnClk;
public
{ Public declarations }
procedure DrawBtn;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.WmNcPaint(var Msg: TWmNcPaint);
begin
inherited;
Drawbtn;{При перерисовке окна прорисовываем кнопку}
end;
procedure TForm1.DrawBtn;{Код прорисовки кнопки}
var
WDc: HDc;
Cx, Cy: Integer;
XFrame, Yframe: Integer;
begin
{Получаем контекст нашего окна, снимаем мерки с оконных размеров,
вычисляем положение нашей кнопки и прорисовываем её в зависимости
от того нажата ли кнопка мыши над ней}
WDc := GetWindowDc(Handle);
Cx := GetSystemMetrics(SM_CXSize);
Cy := GetSystemMetrics(SM_CYSize);
xFrame := GetSystemMetrics(SM_CXFrame);
yFrame := GetSystemMetrics(SM_CYFrame);
R := Bounds(Width - xFrame - 4*Cx + 2, yFrame + 2, Cx - 2, Cy - 4);
if Press then
DrawFrameControl(WDc,R,DFC_BUTTON,DFCS_ButtonPUSH or DFCS_PUSHED)
else
DrawFrameControl(WDc,R,DFC_BUTTON,DFCS_ButtonPUSH);
ReleaseDc(Handle,WDC);
end;
procedure TForm1.WMNcActivate(var msg: TwmncActivate);
begin
inherited;
DrawBtn;
end;
procedure TForm1.WmNcLButtonDown(var Msg: TWMNCLBUTTONDOWN);
var
pt: TPoint;
begin
inherited;
drawbtn;
pt := Point(msg.XCursor - Left,msg.YCursor - top);
if PtInRect(R,pt) then
begin
Press := True;
drawbtn;
end;
end;
procedure TForm1.wmnchittest(var Msg: TWMncHITTEST);
var
pt: tpoint;
begin
inherited;
pt :=Point(msg.XPos - Left, msg.YPos - Top);
if PtinRect(r,pt) then
msg.Result := htBorder;
end;
procedure TForm1.wmSize(var Msg: TMessage);
begin
inherited;
RedrawWindow(Handle, PRect(0), 0, RDW_FRAME or RDW_NOINTERNALPAINT
or RDW_INVALIDATE);
end;
procedure TForm1.wmncLButtonUp(var msg: TWMncLBUTTONUP);
var
pt: TPoint;
begin
inherited;
pt := Point(msg.XCursor - Left,msg.YCursor - top);
if PtInRect(R,pt) then
begin
Press := False;
drawbtn;
PostMessage(Handle,wm_btnClk,0,0);
end;
end;
procedure TForm1.wmLbuttonUp(var Msg: TMessage);
begin
inherited;
if Press then
begin
Press := False;
DrawBtn;
end;
end;
procedure TForm1.wmBtnClk(var msg: TMessage);
begin
{Объявили константу своего сообщения,
посылаем его своему окну при отпускании кнопки мыши над новой кнопкой,
а здесь обрабатываем своё сообщение}
ShowMessage("Вот тебе и кнопка, незабудь сказать спасибо");
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
RedrawWindow(Handle, PRect(0), 0, RDW_FRAME or RDW_NOINTERNALPAINT
or RDW_INVALIDATE);
end;
end.
← →
Jay (2004-11-17 14:36) [4]Большое СПАСИБО
← →
Amoeba © (2004-11-17 14:54) [5]На самом деле все это делается несколькими строчками кода в обработчике сообщения. К сожалению сейчас не могу привести пример, т.к. он у меня дома.
← →
Юрий Зотов © (2004-11-17 15:02) [6]На самом деле не надо писать вообще ни одной строчки кода. Надо сделать сам хелп и подключить его к программе, а у контролов расставить свойство HelpContext (по номерам топиков хелпа).
Все остальное уже сделано в VCL.
← →
Юрий Зотов © (2004-11-17 15:02) [7]На самом деле не надо писать вообще ни одной строчки кода. Надо сделать сам хелп и подключить его к программе, а у контролов расставить свойство HelpContext (по номерам топиков хелпа).
Все остальное уже сделано в VCL.
Страницы: 1 вся ветка
Форум: "Основная";
Текущий архив: 2004.12.05;
Скачать: [xml.tar.bz2];
Память: 0.47 MB
Время: 0.034 c