Кнопки в загаловке формы

[dmitriegorovih]

не google chrome использует другую технологию как и Word 2007 здесь другой нужен подход.

Всем привет!Сабж, как например это "вытворяет" google chrome?
И можно ли сделать это в Делфи 7?

[$T@LKER]

Может установить форме BorderStyle = bsNone, а затем кинуть на форму че то на подобии ToolBar ?!

[ArtGrek]

есть код добавление своеи кнопки, там много, поетому спрашиваю, нужно? вылажить?

[dmitriegorovih]

есть код добавление своеи кнопки, там много, поетому спрашиваю, нужно? вылажить?

Выкладывайте ))

[ArtGrek]

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private { Private declarations }
    procedure WMNCPAINT(var  msg: Tmessage); message WM_NCPAINT;
    procedure WMNCACTIVATE(var msg: Tmessage); message WM_NCACTIVATE;
    procedure WMNCMOUSEDOWN(var msg: Tmessage); message WM_NCLBUTTONDOWN;
    procedure WMNCMOUSEMOVE(var Msg: TMessage); message WM_NCMOUSEMOVE;
    procedure WMMOUSEMOVE(var Msg: TMessage); message WM_MOUSEMOVE;
    procedure WMLBUTTONUP(var msg: Tmessage); message WM_LBUTTONUP;
    procedure WNCLBUTTONDBLCLICK(var msg: Tmessage); message WM_NCLBUTTONDBLCLK;
    procedure WMNCRBUTTONDOWN(var msg: Tmessage); message WM_NCRBUTTONDOWN;
    procedure WMNCHITTEST(var msg: Tmessage); message WM_NCHITTEST;
    procedure WMSYSCOMMAND(var msg: Tmessage); message WM_SYSCOMMAND;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Pressed:Boolean;
  FocusLost:Boolean;
  Rec: TRect;
  NovoMenuHandle: THandle;
  PT1: TPoint;
  FHintshow:Boolean;
  FHint: THintWindow;
  FHintText: string;
  FHintWidth: Integer;

implementation

{$R *.dfm}

procedure TForm1.WMSYSCOMMAND(var Msg: TMessage);
begin
  if Msg.WParam = LongInt(NovoMenuHandle) then
    //*********************************************
    //Кнопка была нажата! Добавьте сюда Вашу функцию
      //*********************************************
    inherited;
end;

procedure TForm1.WMNCHITTEST(var Msg: TMessage);
var
  Tmp: Boolean;
begin
  if Pressed then
  begin
    Tmp := FocusLost;
    PT1.X := Msg.LParamLo - Form1.Left;
    PT1.Y := Msg.LParamHi - Form1.Top;
    if PTInRect(Rec, PT1) then FocusLost := False
      else FocusLost := True;
    if FocusLost <> Tmp then InvalidateRect(Form1.Handle, @Rec, True);
  end;
  inherited;
end;

procedure TForm1.WMLBUTTONUP(var Msg: TMessage);
var
  Tmp: Boolean;
begin
  ReleaseCapture;
  Tmp := Pressed;
  Pressed := False;
  if Tmp and PTInRect(Rec, PT1) then
  begin
    InvalidateRect(Form1.Handle, @Rec, True);
    FHintShow := False;
    FHint.ReleaseHandle;
    //*********************************************
    //Кнопка была нажата! Добавьте сюда Вашу функцию
      //*********************************************
  end
  else inherited;
end;

procedure TForm1.WNCLBUTTONDBLCLICK(var Msg:
  TMessage);
begin
  PT1.X := Msg.LParamLo - Form1.Left;
  PT1.Y := Msg.LParamHi - Form1.Top;
  if not PTInRect(Rec, PT1) then inherited;
end;

procedure TForm1.WMNCRBUTTONDOWN(var Msg: TMessage);
begin
  PT1.X := Msg.LParamLo - Form1.Left;
  PT1.Y := Msg.LParamHi - Form1.Top;
  if not PTInRect(Rec, PT1) then
    inherited;
end;

procedure TForm1.WMNCMOUSEDOWN(var Msg: TMessage);
begin
  PT1.X := Msg.LParamLo - Form1.Left;
  PT1.Y := Msg.LParamHi - Form1.Top;
  FHintShow := False;
  if PTInRect(Rec, PT1) then
  begin
    Pressed := True;
    FocusLost := False;
    InvalidateRect(Form1.Handle, @Rec, True);
    SetCapture(TWinControl(Form1).Handle);
  end
  else begin
    Form1.Paint;
    inherited;
  end;
end;

//That function Create a Hint procedure
procedure TForm1.WMNCMOUSEMOVE(var Msg: TMessage);
begin
  PT1.X := Msg.LParamLo - Form1.Left;
  PT1.Y := Msg.LParamHi - Form1.Top;
  if PTInRect(Rec, PT1) then
  begin
    FHintWidth := FHint.Canvas.TextWidth(FHintText);
    if (FHintShow = False) and (Length(Trim(FHintText)) <> 0) then
      FHint.ActivateHint( Rect( Mouse.CursorPos.X, Mouse.CursorPos.Y + 20,
        Mouse.CursorPos.X + FHintWidth + 10, Mouse.CursorPos.Y + 35), FHintText );
    FHintShow := True;
  end
  else begin
    FHintShow := False;
    FHint.ReleaseHandle;
  end;
end;

procedure TForm1.WMMOUSEMOVE(var Msg: TMessage);
begin
  FHintShow := False;
  FHint.ReleaseHandle;
end;

procedure TForm1.WMNCACTIVATE(var Msg: TMessage);
begin
  InvalidateRect(Form1.Handle, @Rec, True);
  inherited;
end;

procedure TForm1.WMNCPAINT(var Msg: TMessage);
begin
  InvalidateRect(Form1.Handle, @Rec, True);
  inherited;
end;

...

[ArtGrek]

...
procedure TForm1.FormPaint(Sender: TObject);
var
  Border3D_Y, Border_Thickness, Btn_Width, Button_Width, Button_Height: Integer;
  MyCanvas: TCanvas;
begin
  MyCanvas := TCanvas.Create;
  MyCanvas.Handle := GetWindowDC(Form1.Handle);
  Border3D_Y := GetSystemMetrics(SM_CYEDGE);
  Border_Thickness := GetSystemMetrics(SM_CYSIZEFRAME);
  Button_Width := GetSystemMetrics(SM_CXSIZE);
  Button_Height := GetSystemMetrics(SM_CYSIZE);
      //Создаём квадратную кнопку,
      // но если Вы захотите создать кнопку другого размера,
      //то измените эту переменную на Вашу ширину.
  Btn_Width := Border3D_Y + Border_Thickness + Button_Height - (2 * Border3D_Y) - 1;
  Rec.Left := Form1.Width - (3 * Button_Width + Btn_Width);
  Rec.Right := Form1.Width - (3 * Button_Width + 03);
  Rec.Top := Border3D_Y + Border_Thickness - 1;
  Rec.Bottom := Rec.Top + Button_Height - (2 * Border3D_Y);
  FillRect(MyCanvas.Handle, Rec, HBRUSH(COLOR_BTNFACE + 1));
  if not Pressed or Focuslost then
    DrawEdge(MyCanvas.Handle, Rec, EDGE_RAISED, BF_SOFT or BF_RECT)
    else if Pressed and not Focuslost then
      DrawEdge(MyCanvas.Handle, Rec, EDGE_SUNKEN, BF_SOFT or BF_RECT);
      //It draw a the application icon to the button.Easy to change.
  DrawIconEX(MyCanvas.Handle, Rec.Left + 4, Rec.Top + 3, Application.Icon.Handle, 8, 8, 0, 0, DI_NORMAL);
  MyCanvas.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  InsertMenu(GetSystemMenu(Handle, False), 4, MF_BYPOSITION + MF_STRING, NovoMenuHandle, pchar('TEXT OF THE MENU'));
  Rec := Rect(0, 0, 0, 0);
  FHintText := 'Put the text of your Hint HERE';
  FHint := THintWindow.Create(Self);
  FHint.Color := clInfoBk; //Вы можете изменить бэкграунд подсказки...
end;

end.

[Johnson]

JEDI VCL -> TCaptionButton
не?

[dmitriegorovih]

JEDI VCL -> TCaptionButton
не?

не, пробовал не помогло вообще не работает

P.S. ArtGrek иконка тока не вставляется, а так норм, не подскажите как туды втулить картинку?

[MyLastHit]

Это же брэйнфак... По-моему пост #2 дал самое легкое и верное решение твоей задачи...

[Johnson]

Ну ещё в качестве извращенного варианта можно поставить Alpha Controls, там такое в принципе не сложно сделать...