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

Вниз

Не подскажет кто, каким образом в область Caption добавить свою   Найти похожие ветки 

← →
Voyager TM   (2002-09-13 18:28) [0]

кнопку рядом со стандартными Minimize, Maximixe, Close?

---

← →
Poirot ©   (2002-09-13 18:53) [1]

Вообще-то рисовать!!!!
Разиеры и расположения этих кнопок получить можно GetSystemMetrics РТФМ!!!
И обрабатывай сообщения WM_NCPAINT - Drawing
WM_SYSCOMMAND - poluchenie koordinat mousa i pomoemu dlia opredeleniya klika? no ya mogu OBSHIBATSIA!!!

---

← →
Ketmar ©   (2002-09-13 18:56) [2]

на самом деле там намного больше сообщений надо обрабатывать для корректного отображения. прямо с ходу и не упомню даже все. activate/deactivate как минимум...

Satanas Nobiscum! 13-Sep-XXXVII A.S.

---

← →
Song ©   (2002-09-13 19:39) [3]

DrawFrameControl()

---

← →
Diamond Cat ©   (2002-09-13 23:58) [4]

Song прав , но обрабатывать сообщения всеравно придется
вот примерно так


TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
function DrawButton(State: Cardinal): boolean;
protected
procedure WndProc(var Message: TMessage); override;
procedure WMNCLButtonDown(var Message: TWMNCLButtonDown ); message WM_NCLButtonDown;
procedure WMNCLButtonUp(var Message: TWMNCLButtonUp ); message WM_NCLButtonUp;
public
procedure ButtonClicked;
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.ButtonClicked;
begin
if height>height-clientheight then height:=height-clientheight else height:=171;
end;

function TForm1.DrawButton(State: Cardinal): boolean;
var
P: TPoint;
R: TRect;
DC: hDC;
begin
GetCursorPos(P);
Dec(P.X, Left);
Dec(P.Y, Top);
R.Left := GetSystemMetrics(SM_CxFrame)+45 + Canvas.TextWidth(Caption);
R.Right := Width - GetSystemMetrics(SM_CxFrame) - 20;
R.Top := GetSystemMetrics(SM_CyFrame)+GetSystemMetrics(SM_CYEDGE);
R.Bottom := GetSystemMetrics(SM_CYSIZE)+GetSystemMetrics(SM_CYEDGE);
Result := (State = 0) or PtInRect(R, P);
if Result
then begin
DC := GetWindowDC(Handle);
try
if height=height-clientheight then DrawFrameControl(DC, R, DFC_SCROLL , DFCS_SCROLLDOWN or State) else
DrawFrameControl(DC, R, DFC_SCROLL , DFCS_SCROLLUP or State)
finally
ReleaseDC(Handle, DC)
end
end;
end;

procedure TForm1.WMNCLButtonDown(var Message: TWMNCLButtonDown);
begin
if not DrawButton(DFCS_Pushed) then inherited
end;

procedure TForm1.WMNCLButtonUp(var Message: TWMNCLButtonUp);
begin
if DrawButton(0) then ButtonClicked else inherited
end;

procedure TForm1.WndProc(var Message: TMessage);
begin
inherited WndProc(Message);
case Message.Msg of
wm_ncactivate,WM_NCCALCSIZE, WM_Activate, WM_ncPaint, WM_WindowPosChanging: DrawButton(0)
end { of case };
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
BorderIcons := BorderIcons - [biminimize];
BorderIcons := BorderIcons - [bimaximize];
borderStyle:=bssizeable;
height:=171;
width:=400;
end;

end.


---

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

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

Наверх

Память: 0.48 MB
Время: 0.017 c