VPF::Как изменить щрифт для формы, созданной

ДЫМ

Дата 4.11.2004, 03:27 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 224
Регистрация: 6.1.2004

Репутация: нет
Всего: 8

Я создал форму средствами 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.

<Spawn>

Дата 4.11.2004, 18:56 (ссылка)

(нет голосов)

Загрузка ...

Око кары:)

Профиль
Группа: Экс. модератор
Сообщений: 2776
Регистрация: 29.1.2003
Где: Екатеринбург

Репутация: 1
Всего: 64

Не понял какие проблемы у тебя с цветом - у меня все выводится. Вот пример задания шрифта:

Код


var
  hFont: THandle;

...

 hFont := CreateFont(0, 0, 0, 0, FW_NORMAL, 0, 0, 0, DEFAULT_CHARSET,
                     OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY,
                     DEFAULT_PITCH, 'Arial');
 SelectObject(DC, hFont);

Это сообщение отредактировал(а) <Spawn> - 4.11.2004, 18:56

--------------------

"Для некоторых людей программирование является такой же внутренней потребностью, подобно тому, как коровы дают молоко, или писатели стремятся писать" - Николай Безруков.

ДЫМ

Дата 5.11.2004, 02:46 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 224
Регистрация: 6.1.2004

Репутация: нет
Всего: 8

Да, с цветом все в порядке, просто не обратил внимания

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: WinAPI и системное программирование \| Следующая тема »