一个有助于用纯API建立窗口的单元 [ small.pas ]

  • 主题发起人 主题发起人 import
  • 开始时间 开始时间
I

import

Unregistered / Unconfirmed
GUEST, unregistred user!
unit Small;
interface
function CreateButton(ACaption : String; AHandle : Integer; Left, Top, Right, Bottom : Integer):Integer;
function CreateLabel(AHandle : Integer; Left, Top, Right, Bottom : Integer):Integer;
function CreateEdit(AHandle : Integer; Left, Top, Right, Bottom : Integer):Integer;
function CreateMaskedEdit(AHandle : Integer; Left, Top, Right, Bottom : Integer):Integer;
function CreateListBox(AHandle : Integer; Left, Top, Right, Bottom : Integer):Integer;
function CreateComboBox(AHandle : Integer; Left, Top, Right, Bottom : Integer):Integer;
function MakeFont(AFont : String):Integer;
function FastForm(AClassName, ACaption : String; Left, Top, Right, Bottom : Integer):Integer;
function LaunchOpenDialog(AHandle : Integer; var AFileName : String; AInitialDir, AFilter : String):Boolean;
function LaunchSaveDialog(AHandle : Integer; var AFileName : String; AInitialDir, AFilter : String):Boolean;
procedure ListBoxAdd(AHandle : Integer; AString : String);
procedure ListBoxDelete(AHandle, Index : Integer);
procedure ComboBoxAdd(AHandle : Integer; AString : String);
procedure SetFont(AHandle, AFont : Integer);
procedure SetInstance(AInstance : Integer);
implementation
uses
Windows, Messages, CommDlg;
var
TheInstance : Integer;
procedure SetInstance;
begin
TheInstance := AInstance;
end;{ SetInstance }
function CreateButton;
begin
Result := CreateWindow('Button', PChar(ACaption), WS_VISIBLE or WS_CHILD or BS_PUSHLIKE or BS_TEXT,
Left, Top, Right, Bottom, AHandle, 0, TheInstance, nil);
end;{ CreateButton }
function CreateLabel;
begin
Result := Createwindow('Static','', WS_VISIBLE or WS_CHILD or SS_LEFT,
Left, Top, Right, Bottom, AHandle, 0, TheInstance, nil);
end;{ CreateLabel }
function CreateEdit;
begin
Result := CreateWindowEx(WS_EX_CLIENTEDGE, 'Edit', '', WS_CHILD or WS_VISIBLE or
WS_BORDER, Left, Top, Right, Bottom, AHandle, 0, TheInstance, nil);
end;{ CreateEdit }
function MakeFont;
begin
Result := CreateFont(-11, 0, 0, 0, 400, 0, 0, 0, DEFAULT_CHARSET,
OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY,
DEFAULT_PITCH or FF_DONTCARE, PChar(AFont));
end;{ CreateFont }
procedure SetFont;
begin
SendMessage(AHandle, WM_SETFONT, AFont, 0);
end;{ SetFont }
function FastForm;
var
WinClass: TWndClassA;
begin
{ ** Create Main Window ** }
Result := CreateWindowEx(WS_EX_WINDOWEDGE,PChar(AClassName),PChar(ACaption),
WS_VISIBLE or WS_SIZEBOX or WS_CAPTION or WS_SYSMENU
or WS_MAXIMIZEBOX or WS_MINIMIZEBOX,
Left, Top, Right, Bottom, 0, 0, TheInstance, nil);
end;{ FastForm }
function CreateMaskedEdit;
begin
Result := CreateWindowEx(WS_EX_CLIENTEDGE,'Edit', '', WS_CHILD or WS_VISIBLE or
WS_BORDER or ES_PASSWORD, Left, Top, Right, Bottom, AHandle, 0, TheInstance, nil);
end;{ CreateMaskedEdit }
function CreateListBox;
begin
Result := CreateWindowEx(WS_EX_CLIENTEDGE,'LISTBOX', '', WS_CHILD or WS_VISIBLE or
LBS_DISABLENOSCROLL or LBS_NOINTEGRALHEIGHT or LBS_NOTIFY,
Left, Top, Right, Bottom, AHandle, 0, TheInstance, nil);
end;
procedure ListBoxAdd;
begin
SendMessage(AHandle, LB_ADDSTRING , 0, Integer(PChar(AString)));
end;{ ListBoxAdd }
procedure ListBoxDelete;
begin
SendMessage(AHandle, LB_DELETESTRING , Index, 0);
end;{ ListBoxDelete }
function CreateComboBox;
begin
Result := CreateWindowEx(WS_EX_CLIENTEDGE,'COMBOBOX', '', WS_CHILD or WS_VISIBLE or
CBS_NOINTEGRALHEIGHT ,
Left, Top, Right, Bottom, AHandle, 0, TheInstance, nil);
end;{ CreateComboBox }
procedure ComboBoxAdd;
begin
SendMessage(AHandle, CB_ADDSTRING , 0, Integer(PChar(AString)));
end;{ ComboBoxAdd }
procedure LaunchOpenDialog;
var
OpenFileName : TOpenFilename;
begin
SetLength(AFileName,MAX_PATH);
FillChar(OpenFileName, SizeOf(OpenFileName), 0);
with OpenFileName do
begin
lStructSize := SizeOf(TOpenFilename);
hWndOwner := AHandle;
hInstance := TheInstance;
lpstrFilter := PChar(AFilter);
nMaxFile := MAX_PATH;
lpstrFile := PChar(AFileName);
lpstrInitialDir := PChar(AInitialDir);
lpstrTitle := PChar('Open');
Flags := OFN_HIDEREADONLY;
end;
Result := GetOpenFileName(OpenFilename);
end;{ LaunchOpenDialog }
procedure LaunchSaveDialog;
var
OpenFileName : TOpenFilename;
begin
SetLength(AFileName,MAX_PATH);
FillChar(OpenFileName, SizeOf(OpenFileName), 0);
with OpenFileName do
begin
lStructSize := SizeOf(TOpenFilename);
hWndOwner := AHandle;
hInstance := TheInstance;
lpstrFilter := PChar(AFilter);
nMaxFile := MAX_PATH;
lpstrFile := PChar(AFileName);
lpstrInitialDir := PChar(AInitialDir);
lpstrTitle := PChar('Save');
Flags := OFN_HIDEREADONLY;
end;
Result := GetSaveFileName(OpenFilename);
end;{ LaunchSaveDialog }
end.
 
后退
顶部