模拟一个类似上面窗口的窗体?
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.