首页  编辑  

无边框的模拟窗体

Tags: /超级猛料/VCL/Form,窗体/窗体特效/   Date Created:

模拟一个类似上面窗口的窗体?

You need to make your form Border style bsNone and Color $00B0F3FF. Set ClientHeight = 317 ClientWidth = 304. Now add 2 TBitBtn buttons, BitBtn_CloseX and BitBtn_Min, in the upper right corner, set the Anchors for both BitBnts as akTop = True and akRight = True, others false, button width = 19, height = 17. Each of these buttons will have a click event. . .

Place a TMemo on your form, set the top = 29 Height = 265 Left = 0 and set the right side to touch the right side of the form, set ALL the Anchors to True, and set the ParentColor to True. There should be 29 pixels of Form above Memo1 and about 20 pixels of form below it.  Now Put a TPopupMemu and add 5 menu Items - Move, Size, Minimize, (separator N1), and Close, 4 of these menu Items will have a click event.

code for Notes.Pas

unit Notes1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, Buttons, Menus;

type

TForm1 = class(TForm)

  BitBtn_CloseX: TBitBtn;

  BitBtn_Min: TBitBtn;

  Memo1: TMemo;

  PopupMenu1: TPopupMenu;

  Move1: TMenuItem;

  Size1: TMenuItem;

  Minimize1: TMenuItem;

  N1: TMenuItem;

  {N1 is menu separator}

  Close1: TMenuItem;

  procedure BitBtn_CloseXClick(Sender: TObject);

  procedure FormCreate(Sender: TObject);

  procedure FormPaint(Sender: TObject);

  procedure FormMouseDown(Sender: TObject; Button: TMouseButton;

    Shift: TShiftState; X, Y: Integer);

  procedure BitBtn_MinClick(Sender: TObject);

  procedure Move1Click(Sender: TObject);

  procedure Size1Click(Sender: TObject);

  procedure FormClose(Sender: TObject; var Action: TCloseAction);

private

  { Private declarations }

  hSmIcon: THandle;

  procedure WMDrawItem(var Message: TWMDrawItem); message WM_DrawItem;

  procedure CreateParams(var Params: TCreateParams); override;

public

  { Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

uses ShellApi;

procedure TForm1.CreateParams(var Params: TCreateParams);

begin

inherited CreateParams(Params);

with Params do

begin

  Style := Style or WS_SIZEBOX {or WS_CAPTION} or WS_SYSMENU;

  WindowClass.style := WindowClass.style or CS_HREDRAW or CS_VREDRAW or CS_BYTEALIGNCLIENT;

end;

end;

procedure TForm1.WMDrawItem(var Message: TWMDrawItem);

var

Brush1: THandle;

begin

Message.Result := 1;

if Message.Ctl = BitBtn_CloseX.Handle then

begin

if (Message.DrawItemStruct.itemState and ODS_SELECTED) <> 0  then

  DrawFrameControl(Message.DrawItemStruct.hDC,Message.DrawItemStruct.rcItem,DFC_CAPTION,DFCS_CAPTIONCLOSE or DFCS_PUSHED)

  else

  DrawFrameControl(Message.DrawItemStruct.hDC,Message.DrawItemStruct.rcItem,DFC_CAPTION,DFCS_CAPTIONCLOSE);

end else

if Message.Ctl = BitBtn_Min.Handle then

begin

if (Message.DrawItemStruct.itemState and ODS_SELECTED) <> 0  then

  DrawFrameControl(Message.DrawItemStruct.hDC,Message.DrawItemStruct.rcItem,DFC_CAPTION,DFCS_CAPTIONMIN or DFCS_PUSHED)

  else

  DrawFrameControl(Message.DrawItemStruct.hDC,Message.DrawItemStruct.rcItem,DFC_CAPTION,DFCS_CAPTIONMIN);

end else

Inherited;

end;

procedure TForm1.BitBtn_CloseXClick(Sender: TObject);

begin

Close;

end;

procedure TForm1.FormCreate(Sender: TObject);

var

ShInfo1: SHFILEINFO;

sz: Integer;

begin

sz := GetSystemMetrics(SM_CXSIZE);

if sz > 0 then

begin

BitBtn_CloseX.Width := sz-2;

BitBtn_Min.Width := sz-2;

end;

sz := GetSystemMetrics(SM_CYSIZE);

if sz > 0 then

begin

BitBtn_CloseX.Height := sz-4;

BitBtn_Min.Height := sz-4;

end;

BitBtn_CloseX.Left := ClientRect.Right - BitBtn_CloseX.Width - 3;

BitBtn_Min.Left := BitBtn_CloseX.Left- (sz);

SHGetFileInfo(PChar(ParamStr(0)), 0, ShInfo1, SizeOf(SHFILEINFO),SHGFI_ICON or SHGFI_SMALLICON);

hSmIcon := ShInfo1.hIcon;

Canvas.Brush.Color := $0000A3BA;

Canvas.Font.Name := 'New Times Roman';

Canvas.Font.Size := 10;

Canvas.Font.Color := clWhite;

DoubleBuffered := True;

Memo1.DoubleBuffered := True;

Close1.Caption := 'Close'#9'Alt+F4';

if fileExists(ExtractFilePath(ParamStr(0))+'Notes.nte') then

Memo1.Lines.LoadFromFile(ExtractFilePath(ParamStr(0))+'Notes.nte') else

Memo1.Text := 'Notes';

end;

procedure TForm1.FormPaint(Sender: TObject);

//var

//Rect1: Trect;

begin

Canvas.RoundRect(29,1,Width-(BitBtn_Min.Width+BitBtn_CloseX.Width+17),

               BitBtn_Min.Height+6,5,5);

DrawIconEx(Canvas.Handle,5,3, hSmIcon, 0, 0, 0, 0, DI_NORMAL);

Canvas.TextOut(34,3,'Notes');

Canvas.Pen.Color := $0000A3BA;

Canvas.MoveTo(1,Memo1.Top-2);

Canvas.LineTo(ClientRect.Right-1,Memo1.Top-2);

Canvas.MoveTo(1,Memo1.Top+Memo1.Height+2);

Canvas.LineTo(ClientRect.Right-1,Memo1.Top+Memo1.Height+2);

Canvas.MoveTo(1,Memo1.Top+Memo1.Height+2);

Canvas.LineTo(1,ClientRect.Bottom-1);

Canvas.LineTo(ClientRect.Right-1,ClientRect.Bottom-1);

Canvas.LineTo(ClientRect.Right-1,Memo1.Top+Memo1.Height+2);

Canvas.MoveTo(ClientRect.Right-6,ClientRect.Bottom-1);

Canvas.LineTo(ClientRect.Right-1,ClientRect.Bottom-6);

Canvas.MoveTo(ClientRect.Right-10,ClientRect.Bottom-1);

Canvas.LineTo(ClientRect.Right-1,ClientRect.Bottom-10);

Canvas.MoveTo(ClientRect.Right-15,ClientRect.Bottom-1);

Canvas.LineTo(ClientRect.Right-1,ClientRect.Bottom-15);

Canvas.Pen.Color := clBlack;

Canvas.Font.Color := clBlack;

Canvas.Brush.Style := bsClear;

Canvas.TextOut(7,ClientRect.Bottom-19,DateTimeToStr(Now){DateToStr(Date)});

Canvas.Brush.Style := bsSolid;

Canvas.Font.Color := clWhite;

Canvas.Brush.Color := $0000A3BA;

//Rect1 := Rect(2,2,Width-7,22);

//DrawCaption(Handle, Canvas.Handle, Rect1, DC_ACTIVE or DC_ICON or DC_TEXT);

end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

var

hSysMenu: THandle;

begin

if Button = mbLeft then

if PtInRect(Rect(4,3,22,21), Point(X,Y)) then

begin

PopupMenu1.Popup(Left+4, Top+27);

end else

if PtInRect(Rect(29,1,Width-(BitBtn_Min.Width+BitBtn_CloseX.Width+17), BitBtn_Min.Height+6), Point(X,Y)) then

  begin

  ReleaseCapture;

  Form1.perform(WM_SysCommand, $F012, 0);

  end;

//ShowMessage('Clicked Point');

end;

procedure TForm1.BitBtn_MinClick(Sender: TObject);

begin

Application.Minimize;

end;

procedure TForm1.Move1Click(Sender: TObject);

begin

Perform(WM_SYSCOMMAND, SC_MOVE, 0);

end;

procedure TForm1.Size1Click(Sender: TObject);

begin

Perform(WM_SYSCOMMAND, SC_SIZE, 0);

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

Memo1.Lines.SaveToFile(ExtractFilePath(ParamStr(0))+'Notes.nte');

end;

end.

img_15206.bmp (129.0KB)