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

Вниз

кнопка в заголовке   Найти похожие ветки 

← →
тим   (2007-10-15 19:26) [0]

у меня xp, как в заголовок формы добавить кнопку рядом с другими, чтобы она была тоже в стиле кнопок закрыть свернуть развернуть???

---

← →
asm_viator ©   (2007-10-15 19:34) [1]

Мой тебе совет - лучше этим не заниматься!
В Win98 это выглядело так:

(с) DelphiWorld

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}

{ TForm1 }

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("О, круто, наша кнопка нажимается! Спасибо проекту Delphi World!");
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 RedrawWindow(Handle, PRect(0), 0, RDW_FRAME or RDW_NOINTERNALPAINT
   or RDW_INVALIDATE);
end;

end.

---

← →
тим   (2007-10-15 19:43) [2]

мне нужно чтобы кнопка была в стиле остальных трех

---

← →
asm_viator ©   (2007-10-15 19:44) [3]

Да, я понял, просто предупредил

---

← →
тим   (2007-10-15 19:51) [4]

спасибо

---

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

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

Наверх

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