Виртуальная библиотека Delphi - [15]

  dmPelsHeight:=480;
  dmFields:=DM_BITSPERPEL or DM_PELSWIDTH or DM_PELSHEIGHT;
  result:=False;
  if ChangeDisplaySettings(DeviceMode,CDS_TEST or CDS_FULLSCREEN) <> DISP_CHANGE_SUCCESSFUL
  then Exit;
  Result:=ChangeDisplaySettings(DeviceMode,CDS_FULLSCREEN) = DISP_CHANGE_SUCCESSFUL;
 end;
end;
procedure RestoreDefaultMode;
var T : TDevMode absolute 0;
begin
 ChangeDisplaySettings(T,CDS_FULLSCREEN);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 if setFullScreenMode then begin
  sleep(7000);
  RestoreDefaultMode;
 end;
end;

Как поместить картинку из базы данных, например MsSQL, в компонент TIMAGE?

1) Предполагается, что поле BLOB (например, Pict)

2) в запросе Query.SQL пишется что-то вроде

'select Pict from sometable where somefield=somevalue'

3) запрос открывается

4) делается "присваивание":

Image1.Picture.Assing(TBlobField(Query.FieldByName('Pict'))

или, если известно, что эта картинка — Bitmap, то можно

Image1.Picture.Bitmap.Assing(TBlobField(Query.FieldByName('Pict'))

А можно воспользоваться компонентом TDBImage.

Извлечение иконки из Exe-файла и рисование ее в TImages

Каким образом извлечь иконку из EXE- и DLL-файлов (ExtractAssociatedIcon) и отобразить ее на компоненте Timage или небольшой области на форме?

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

uses ShellApi;
procedure TForm1.Button1Click(Sender: TObject);
var
 IconIndex : word;
 h : hIcon;
begin
 IconIndex := 0;
 h := ExtractAssociatedIcon(hInstance, 'C:\WINDOWS\NOTEPAD.EXE', IconINdex);
 DrawIcon(Form1.Canvas.Handle, 10, 10, h);
end;

Разное

Как получить горизонтальную прокрутку (scrollbar) в ListBox?

Так же как в случае с TMemo, здесь можно использовать сообщения. Например, сообщение может быть отослано в момент создания формы:

procedure TForm1.FormCreate(Sender: TObject);
begin
 ListBox1.Perform(LB_SETHORIZONTALEXTENT, 1000, Longint(0));
end;

Второй параметр в вызове — ширина прокрутки в точках.

Поиск строки в ListBox

Есть функция API Windows, что заставляет искать строку в ListBox с указанной позиции.

Например, поиск строки, что начинается на '1.' От текущей позиции курсора в ListBox. Т.о., нажимая на кнопку Button1, будут перебраны все строки начинающиеся на '1.'

procedure TForm1.Button1Click(Sender: TObject);
var S : string;
begin
 S:='1.';
 with ListBox1 do ItemIndex := Perform(LB_SELECTSTRING, ItemIndex, LongInt(S));
end;

Более подробную информацию о работе команды LB_SELECTSTRING можно узнать из Help-а Win32.

Пример получения позиции курсора из компоненты TMemo.

procedure TForm1.Memo1KeyUp(Sender: TObject; var Key: Word;  Shift: TShiftState);
begin
Memo1Click(Self);
end;
procedure TForm1.Memo1Click(Sender: TObject);
VAR
  LineNum : LongInt;
  CharNum : LongInt;
begin
  LineNum := Memo1.Perform(EM_LINEFROMCHAR, Memo1.SelStart, 0);
  CharNum := Memo1.Perform(EM_LINEINDEX, LineNum, 0);
  Label1.Caption := IntToStr(LineNum+1)+' : '+IntToStr((Memo1.SelStart-CharNum)+1);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
  Memo1Click(Self);
end;

Функция Undo в TMemo

В компоненте TMemo предусмотрена функция отмены последней правки (Undo). Ее можно вызвать следующим образом:

Memo1.Perform(EM_UNDO,0,0);

Узнать о том, возможна ли отмена (т.е. есть ли что отменять) можно следующим образом:

UndoEnabled:=(Memo1.Perform(EM_CAUNDO,0,0)<>0);

Как прокрутить текст в Tmemo или в TRichEdit

Я добавляю програмно несколько строк в конец поля Memo, а их не видно. Как прокрутить Memo, чтобы было видно последние строки ?

Примерно так:

SendMessage(Memo1.Handle, EM_LINESCROLL, 0, Memo1.Lines.Count-1);

Как определить работает ли уже данное приложение или это первая его копия?

Для Delphi 1. Каждый экземпляр программы имеет ссылку на свою предыдущую копию — hPrevInst: hWnd. Ее можно проверить перед созданием приложения и при необходимости отреагировать соответствующим образом. Если запущена только одна копия, то эта ссылка равна нулю.

Пример:

procedure TForm1.FormCreate(Sender: TObject);
begin
  {Проверяем есть ли указатель на предыдущую копию приложения}
  IF hPrevInst <> 0 THEN BEGIN
    {Если есть, то выдаем сообщение и выходим}
    MessageDlg('Программа уже запущена!', mtError, [mbOk], 0);
    Halt;
  END;
  {Иначе - ничего не делаем (не мешаем созданию формы)}
end;

P.S. Для выхода необходимо использовать Halt, а не Close, как хотелось бы, так как форма еще не создана и закрывать нечего.

Есть и другой способ — по списку загруженных приложений

procedure TForm1.FormCreate(Sender: TObject);
VAR
Wnd : hWnd;
buff : ARRAY[0.. 127] OF Char;
Begin
Wnd := GetWindow(Handle, gw_HWndFirst);
WHILE Wnd <> 0 DO BEGIN
  IF (Wnd <> Application.Handle) AND (GetWindow(Wnd, gw_Owner) = 0)
  THEN BEGIN
   GetWindowText (Wnd, buff, sizeof (buff ));
   IF StrPas (buff) = Application.Title THEN
   BEGIN
    MessageDlg('Приложение уже загружено', mtWarning, [mbOk], 0);
    Halt;
   END;
  END;
  Wnd := GetWindow (Wnd, gw_hWndNext);
 END;
End;

Еще один интересный способ для Win32. Дело в том, что можно в памяти создавать временные файлы. При перезагрузке они теряются, а так существуют. Кстати, этот метод можно использовать и для обмена информацией между вашими приложениями.