Я создал форму средствами API (этот код почти полностью повторяет код примера из справки по API), но когда вывожу текст функцией DrawText, то, во-первых, не могу изменить его цвет, во-вторых, строка печатается шрифтом System. Как мне поменять шрифт, есть ли такая функция?
И цвет не мешало бы тожк изменить.
| Код |
program sample;
uses
Windows,
Messages,
System,Types;
Var
iReturn:Cardinal;
wc : TWndClassEx; //Переменная шаблона класса окна
MainWnd : HWND; //Описатель главного окна
Mesg : TMsg; //Переменная для цикла сбора сообщений
function WindowProc(wnd:HWND; Msg : Integer; Wparam:Wparam; Lparam:Lparam):Lresult;
stdcall;
Begin
{Далее происходит цикл обработки сообщений}
case msg of
wm_destroy : //Сообщение посылаемое при уничтожении окна
Begin
postquitmessage(0);exit;
Result:=0;
End
else Result:=DefWindowProc(wnd,msg,wparam,lparam);
end;
End;
{$R *.res}
var
xPos,yPos,xDeskTop,yDeskTop,wDeskTop,hDeskTop,nWidth,nHeight : Integer;
TextRect:TRect;
DC: hdc;
begin
if MessageBox(GetDesktopWindow,'Текст окна','Заголовок окна',
MB_OKCANCEL+MB_ICONHAND)=ID_OK then
begin
{ Далее идет заполнение шаблона класса окна}
wc.cbSize:=sizeof(wc);
wc.style:=cs_hredraw or cs_vredraw;
wc.lpfnWndProc:=@WindowProc;
wc.cbClsExtra:=0;
wc.cbWndExtra:=0;
wc.hInstance:=HInstance;
wc.hIcon:=LoadIcon(HInstance,'MAINICON');//LoadIcon(0,idi_application);
wc.hCursor:=LoadCursor(0,idc_arrow);
wc.hbrBackground:=COLOR_BTNFACE+1;
wc.lpszMenuName:=nil;
wc.lpszClassName:='SampleWin : Main';
RegisterClassEx(wc); //Регистрация нового класса в системе
{'заполнение переменных xPos,yPos,nWidth,nHeight}
nWidth:=200;
nHeight:=50;
// ширина рабочего стола
wDeskTop:=GetSystemMetrics(SM_CXVIRTUALSCREEN);
// высота рабочего стола
hDeskTop:=GetSystemMetrics(SM_CYVIRTUALSCREEN);
// левый край рабочего стола
xDeskTop:=GetSystemMetrics(SM_XVIRTUALSCREEN);
// верхний край рабочего стола
yDeskTop:=GetSystemMetrics(SM_YVIRTUALSCREEN);
xPos:=xDeskTop+(wDeskTop-nWidth) div 2;
yPos:=yDeskTop+(hDeskTop-nHeight) div 2;
{ Создание главного окна}
MainWnd:=CreateWindowEx (
0, //флаги расширенных стилей
'SampleWin : Main', //имя класса окна, данное при заполнении структуры wc
'SampleWin', //заголовок окна
0,//WS_POPUP or WS_DLGFRAME, // ws_overlappedwindow, //флаги стилей окна
{подробнdее о стилях см. после текста программы}
xPos, //горизонтальная позиция окна
yPos, //вертикальная позиция окна
nWidth, //ширина окна
nHeight, //высота окна
0, //описатель родительского окна (parent) или окна-владельца (owner)
0, //описатель меню окна (меню нет, нет и описателя)
Hinstance, //описатель приложения
nil //address of window-creation data
);
ShowWindow(MainWnd,CmdShow); //Отображаем окно
// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// -------------------------------------------------------------- вот здесь все проблемы ------------------------------------
// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// выводим текст
DC:=GetWindowDC(MainWnd);
SetBkMode(DC,TRANSPARENT);
SetBkColor(DC,COLOR_BTNFACE+1);
SetTextColor(DC,$00FF0100); // синий цвет
TextRect:=Rect(15,25,200,100);
DrawText(DC, 'Текст на форме',14, TextRect,
DT_END_ELLIPSIS);
// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
//Цикл обработки сообщений
//он может слегка видоизменяться, но эти строчки присутсвуют всегда
While GetMessage(Mesg,0,0,0) do
begin
TranslateMessage(Mesg);
DispatchMessage(Mesg);
end;
end;
end.
|
|