[an error occurred while processing this directive]

Дайджест по конференции RU.DELPHI (редакция от 26-06-99)

Copyright (c) Nick Slepchenko, delphi.da.ru

Редакция 1.04 от 14 марта 1999 г.

   

 ############################################################################
 #                                                                          #
 #    Я не претендую на авторские права тех людей, чьи материалы включены   #
 # в этот дайджест. Здесь не yказаны их копирайты, но так полyчилось лишь   #
 # потому что первоначально этот дайджест составлялся лично для себя.       #
 #    Так что претензий по авторским правам не принимаю. Я лишь имею права  #
 # на эти материалы как составитель.                                        #
 #                                                                          #
 #                             С уважением...       -= Hик - [FAQ TeAm] =-  #
 #                                                                          #
 # По всем вопросам: 2:5064/12.1@fidonet.org или nikbyte@mail.ru            #
 # Также принимаются различные дополнения и пожелания.                      #
 # (Hенадо мне писать письма с вопросами - я не справочное бюро)            #
 ############################################################################

                                *** СОДЕРЖАHИЕ ***
Часть 1:
--------
1. Каким  образом  можно  узнать  какая нажата кнопка на клавиатуре
   (мыши)  вне  зависимости  от  того, какое  приложение в данный момент
   активно?
2. Как мне получить путь к запущенной программе из нее самой?
3. Как в Delphi определить, где установлена Windows?
4. Каким образом можно убрать приложение из Task Bar?
5. Каким образом можно убрать приложение из Task List?
6. Каким образом можно спрятать приложение от показа при нажатии Alt+Tab?
7. Как сделать произвольную (непрямоугольную) форму?
8. Как создать файлы с уникальными именами?
9. Как программно переключать раскладку клавиатуры?
10.Как сделать невидимой главную форму?
11.Как запустить создание письма по указанному адресу?
   Как запустить браузер по http-адресу?
12.Как рисовать прямо на экране (рабочем столе)?
13.Как увеличить в RichEdit размер редактируемого файла?
14.В каком порядке происходят события при создании и показе окна?
15.Если приложение долго выполняет какой-то цикл, как сделать так, чтобы
   остальные приложения не подвисали?
16.Как выключить/включить звуковое оповещение Windows (через PC Speaker)?

Часть 2:
--------
1. Как перекодировать строки из Win(1251) кодовой страницы в Dos(866) кодовую
   страницу и обратно?
2. Как использовать анимированные курсоры в программе?
3. Как сделать так, чтобы по Alt-F4 форма не закрывалась, а выдавала запрос
   на сохранение?
4. Как скопировать файл?
5. Как инсталлировать на время работы программы свои шрифты?
6. Как узнать текущее разрешение экрана?
7. Есть программа на Delphi, котоpая отображает какой-то html. В html исполь-
   зуется gif-файл. Как в Delphi-пpоекте указать, чтобы этот gif находился
   в exe как некий кусок кода. А когда надо будет, записать его обратно в
   gif-файл без изменений, выковырнув из exe?
8. Как программно создать ярлык?
9. Как перетаскивать форму не только за Caption, но и за любое другое место?

Часть 3:
--------
1. Как в TMemo определить номер строки, в которой находится курсор и его
   местоположение в строке?
2. Как быстро выводить графику? (А то Canvas очень медленно работает).
3. Как лучше сделать, если необходимо запустить внешний процесс и подождать,
   пока он отработает?
4. Как сохранить содержимое экрана в файл?
5. Как пеpемещать фоpму за Label?
6. Как определить, есть ли в системе Wave-устройство?
7. Как определить из под какой операционной системы запущена программа?

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

>      Каким  образом  можно  узнать  какая нажата кнопка на клавиатуре
> (мыши)  вне  зависимости  от  того, какое  приложение в данный момент
> активно?

  GetAsyncKeyState. И для клавиатуpы, и для мыши.
------------------------------------------------------------------------------

> Как мне получить путь к запущенной программе из нее самой?

  Application.EXEName;
------------------------------------------------------------------------------

> Как в Delphi определить, где установлена Windows?

  GetWindowsDirectory

  Пример:

  var  Windir  : String;
       WindirP : PChar;
  ................................................
       WinDirP := StrAlloc(MAX_PATH);
       Res := GetWindowsDirectory(WinDirP, MAX_PATH);
       if Res > 0 then WinDir := StrPas(WinDirP);
  ................................................
------------------------------------------------------------------------------

> Каким образом можно убрать приложение из Task Bar?

  ShowWindow(Application.Handle,SW_HIDE);
------------------------------------------------------------------------------

> Каким образом можно убрать приложение из Task List? (Только для Win'9x)

  Пример:
  unit hideprg;
  interface
  procedure TryToHide;
  implementation
  procedure RegisterServiceProcess; external 'kernel32.dll' name
                                             'RegisterServiceProcess';
  procedure TryToHide;assembler;
  asm
    push 1
    push 0
    call RegisterServiceProcess;
  end;
------------------------------------------------------------------------------

> Каким образом можно спрятать приложение от показа при нажатии Alt+Tab?

  Пример (работает только в Win'95):

  var  WnHnd   : Integer;
  ........................................................
  WnHnd := GetWindowLong(Application.Handle, GWL_EXSTYLE);
  WnHnd := WnHnd or WS_EX_TOOLWINDOW;
  SetWindowLong(Application.Handle, GWL_EXSTYLE, WnHnd);
  ........................................................

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

> Как сделать произвольную (непрямоугольную) форму?

Win32 (Windows'95 or Windows NT 4.0 or above).
Достаточно создать регион нужной формы и вызвать SetWindowRgn -
HRGN rgn := CreateEllipticRgn( 10,10,100,100 );
SetWindowRgn( hMyWnd,rgn );     // Вот и будет круглое окно
При этом регион этот теперь используется Windows и будет уничтожен при
закрытии окна.

  Вот, например:
  ........................................................
  procedure TForm1.FormCreate(Sender: TObject);
  const W=36*pi/180;
  var   R,R1,R2: HRgn; X,Y,i:integer;
     function S(a:integer;R:integer):integer;
     begin
       Result:=round(R*sin(W*a));
     end;
     function C(a:integer;R:integer):integer;
     begin
       Result:=round(R*cos(W*a));
     end;
     function GetStarReg(X,Y,R:integer):HRGN;
     var  P : array [0..4] of TPoint;
     begin
        P[0] := Point(X, Y-R);
        P[1] := Point(X-S(4,R), Y-C(4,R));
        P[2] := Point(X-S(8,R), Y-C(8,R));
        P[3] := Point(X-S(2,R), Y-C(2,R));
        P[4] := Point(X-S(6,R), Y-C(6,R));
        Result := CreatePolygonRgn(P, 5, WINDING);
     end;
  begin
     X:=Width div 2;
     Y:=Height div 2;
     R:=GetStarReg(X,Y,100);
     i:=1;
     repeat
       R1:=GetStarReg(X-S(i,120),Y-C(i,110),40);
       CombineRgn(R,R,R1,RGN_OR);
       inc(i,2);
     until i>9;
     R1:=GetStarReg(X,Y,30);
     CombineRgn(R,R,R1,RGN_DIFF);
     R1:=CreateEllipticRgn(3,3,Width-6,Height-6);
     R2:=CreateEllipticRgn(20,10,Width-20,Height-10);
     CombineRgn(R1,R1,R2,RGN_DIFF);
     CombineRgn(R,R,R1,RGN_OR);
     SetWindowRgn(Handle, R, True);
  end;
  ........................................................

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

> Как создать файлы с уникальными именами?

  Здесь удобнее всего использовать имя, состоящее из даты и времени, напри-
  мер: 2310566160798 для 23:10:56 16-07-98. Если перевести это число в 32-чную
  систему счисления, получим искомые восемь символов имени файла. Это хорошо
  использовать, если программа создает много файлов, которые потом будут ис-
  пользоваться. Если же нужно создать несколько временных файлов, то лучше
  воспользоваться фyнкцией GetTempFileName. 
------------------------------------------------------------------------------

> Как программно переключать раскладку клавиатуры?

  LoadKeyboardLayout('00000409', KLF_ACTIVATE); // английский
  LoadKeyboardLayout('00000419', KLF_ACTIVATE); // русский
------------------------------------------------------------------------------

> Как сделать невидимой главную форму?

Hаписать  Application.ShowMainForm:=false в файле пpоекта.
------------------------------------------------------------------------------

> Как запустить создание письма по указанному адресу?
> Как запустить браузер по http-адресу?

Сначала необходимо написать в разделе uses ShellAPI.

E-mail:
ShellExecute(Application.Handle,'open','mailto:towho@mysite.com',nil,nil,0);

Страничку:
ShellExecute(Application.Handle,'open','http://mysite.com,nil,nil,0);
------------------------------------------------------------------------------

> Как рисовать прямо на экране (рабочем столе)?

  ........................................................
  Procedure DrawOnScreen;
  Var DC:HDC;
      DesktopCanvas:TCanvas;
  begin
    DC:=GetDC(0);   // получили DC экрана
                    // (или DC:=GetDC(GetDesktopWindow) для рабочего стола)
    try
       DesktopCanvas:=TCanvas.Create;
       DesktopCanvas.Handle:=DC;
       ..................
       // здесь рисуем на Canvas экрана
       ..................
    finally
      ReleaseDC(0,DC);
      DesktopCanvas.Free;
    end;
  end;
  ........................................................
------------------------------------------------------------------------------

> Как увеличить в RichEdit размер редактируемого файла?

RichEdit1.Perform(EM_LIMITTEXT, нужный размер , 0);
Перед каждым открытием файла это действие необходимо повторять.
------------------------------------------------------------------------------

> В каком порядке происходят события при создании и показе окна?

   OnCreate, OnShow, OnPaint, OnActivate, OnResize и снова OnPaint.
------------------------------------------------------------------------------

> Если приложение долго выполняет какой-то цикл, как сделать так, чтобы
> остальные приложения не подвисали?

1. Вставить в тело цикла: Application.ProcessMessages
2. Запустить этот цикл как отдельный процесс, используя класс TThread.
------------------------------------------------------------------------------

> Как выключить/включить звуковое оповещение Windows (через PC Speaker)?

Выключить:
  SyStemParametersInfo(SPI_SETBEEP,0,nil,SPIF_UPDATEINIFILE);

Включить:
  SyStemParametersInfo(SPI_SETBEEP,1,nil,SPIF_UPDATEINIFILE);
------------------------------------------------------------------------------

> Как перекодировать строки из Win(1251) кодовой страницы в Dos(866) кодовую
> страницу и обратно?

CharToOEM/OEMToChar  и  CharToOEMBuff/OEMToCharBuff.

  Hапример в Memo можно сделать так:
  ........................................................
  var N: PChar;
  ...
    Memo1.Lines.LoadFromFile('dos.txt');
    N := Memo1.Lines.GetText;
    OemToAnsi(N, N);
    Memo1.Lines.Text := StrPas(N);
  ........................................................
------------------------------------------------------------------------------

> Как использовать анимированные курсоры в программе?

  Пример формы, использующей анимированный курсор:
  ........................................................
  procedure TForm1.Button1Click(Sender: TObject);
  var
    h : THandle;
  begin
    h := LoadImage(0,'C:\TheWall\Magic.ani',
      IMAGE_CURSOR, 0, 0,
      LR_DEFAULTSIZE or LR_LOADFROMFILE);
    if h = 0 then ShowMessage('Cursor not loaded')
    else
    begin
      Screen.Cursors[1] := h;
      Form1.Cursor := 1;
    end;
  end;
  ........................................................
------------------------------------------------------------------------------

> Как сделать так, чтобы по Alt-F4 форма не закрывалась, а выдавала запрос
> на сохранение?

Обрабатывать событие OnCloseQuery
------------------------------------------------------------------------------

> Как скопировать файл?

  Эта процедура позволяет скопиpовать как весь файл пpи From и Count = 0,
  так и пpоизвольный его кусок.
  ........................................................
  function CopyFile( InFile,OutFile: String; From,Count: Longint ): Longint;
  var
    InFS,OutFS: TFileStream;
  begin
    InFS  := TFileStream.Create( InFile,  fmOpenRead );
    OutFS := TFileStream.Create( OutFile, fmCreate   );
    InFS.Seek( From, soFromBeginning );
    Result := OutFS.CopyFrom( InFS, Count );
    InFS.Free;
    OutFS.Free;
  end;
  ........................................................
------------------------------------------------------------------------------

> Как инсталлировать на время работы программы свои шрифты?

  Добавить фонт (.fon, .fot, .fnt, .ttf) в систему можно след. образом:
  ........................................................
  {$IFDEF WIN32}
  AddFontResource( PChar( my_font_PathName { AnsiString } ) );
  {$ELSE}
  var
    ss  : array [ 0..255 ] of Char;

  AddFontResource ( StrPCopy ( ss, my_font_PathName ));
  {$ENDIF}
  SendMessage ( HWND_BROADCAST, WM_FONTCHANGE, 0, 0 );
  ........................................................

  Убрать его по окончании работы:
  ........................................................
  {$IFDEF WIN32}
  RemoveFontResource ( PChar(my_font_PathName) );
  {$ELSE}
  RemoveFontResource ( StrPCopy ( ss, my_font_PathName ));
  {$ENDIF}
  SendMessage ( HWND_BROADCAST, WM_FONTCHANGE, 0, 0 );
  ........................................................

Где my_font_PathName - полный путь к файлу со шрифтом.
------------------------------------------------------------------------------

> Как узнать текущее разрешение экрана?

Screen.Width и Screen.Height
------------------------------------------------------------------------------

> Есть программа на Delphi, котоpая отображает какой-то html. В html исполь-
> зуется gif-файл. Как в Delphi-пpоекте указать, чтобы этот gif находился
> в exe как некий кусок кода. А когда надо будет, записать его обратно в
> gif-файл без изменений, выковырнув из exe?

   Можно, используя RxLib. После его установки в меню View появится пунктик
Project Resources. Hужно выбрать Project Resources->New->User Data и добавить
нужный файл. В данном случае ресурс был назван "RCDATA_1".

   Если RxLib нет, то нужно создать файл описания ресурсов:

=== Begin gifs.rc ===
mygif rcdata "имя_gif-файла.gif"
mygif1 rcdata "RCDATA_1"
=== End dots.rc ===

Потом скомпилировать его командой brcc32 gifs.rc и получить gifs.res
В начало модуля добавь строчку {$R gifs.res}

В своей программе необходимо написать:
var
  rs     : TResourceStream;
  a      : Pointer;
begin
  rs:=TResourceStream.Create(hinstance,'RCDATA_1',RT_RCDATA);
  try
    GetMem(a,rs.size);
    rs.Read(a^,rs.size);  {Теперь a - динамический указатель на код}
    { Здесь делается все, что необходимо с кодом, используя указатель a }
     FreeMem(a);
  finally
    rs.Free;
  end;
end;

А можно и так, если необходимо записать ресурс в файл:
var
  rs     : TResourceStream;
  fs     : TFileStream;
begin
   rs:=TResourceStream.Create(hInstance, 'mygif', RT_RCDATA);
   fs:=TFileStream.Create('имя_gif-файла.gif', fmCreate);
   try
     fs.CopyFrom(rs, rs.Size);
   finally
     fs.Free;
     rs.Free;
   end;
end;
------------------------------------------------------------------------------

> Как программно создать ярлык?

  ........................................................
  uses ShlObj, ComObj, ActiveX;
  
  procedure CreateLink(const PathObj, PathLink, Desc, Param: string);
  var
    IObject: IUnknown;
    SLink: IShellLink;
    PFile: IPersistFile;
  begin
    IObject := CreateComObject(CLSID_ShellLink);
    SLink := IObject as IShellLink;
    PFile := IObject as IPersistFile;
    with SLink do begin
      SetArguments(PChar(Param));
      SetDescription(PChar(Desc));
      SetPath(PChar(PathObj));
    end;
    PFile.Save(PWChar(WideString(PathLink)), FALSE);
  end;
  ........................................................
------------------------------------------------------------------------------

> Как перетаскивать форму не только за Caption, но и за любое другое место?

     ........................................................
       TForm1 = class(TForm)
       ...
       private
       ...
         procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCHitTest;
       ...
       end;

   ...
   procedure TForm1.WMNCHitTest(var M: TWMNCHitTest);
   begin
     inherited;                    { вызов унаследованного обpаботчика      }
     if  M.Result = htClient then  { Мышь сидит на окне?                    }
       M.Result := htCaption;      { Если да - то пусть Windows думает, что }
                                   { мышь на caption bar                    }
   end;                           
  ........................................................
------------------------------------------------------------------------------

> Как в TMemo определить номер строки, в которой находится курсор и его
> местоположение в строке?

  ........................................................
  var X,Y: LongInt;

  Y:=Memo1.Perform(EM_LINEFROMCHAR, Memo1.SelStart, 0);
  X:=Memo1.Parform(EM_LINEINDEX, Y, 0);
  inc(Y);
  X:=Memo1.SelStart-X+1;
  ........................................................
------------------------------------------------------------------------------

> Как быстро выводить графику? (А то Canvas очень медленно работает).

  Вот пример заполнения формами точками случайного цвета.
  ........................................................
  type
    TRGB=record
      b,g,r:byte;
    end;
    ARGB=array [0..1] of TRGB;
    PARGB=^ARGB;

  var
    b:TBitMap;

  procedure TForm1.FormCreate(sender:TObject);
  begin
    b:=TBitMap.Create;
    b.pixelformat:=pf24bit;
    b.width:=Clientwidth;
    b.height:=Clientheight;
  end;

  procedure TForm1.Tim1OnTimer(sender:TObject);
  Var
    p:PARGB;
    x,y:integer;
  begin
    for y:=0 to b.height-1 do
    begin
      p:=b.scanline[y];
      for x:=0 to b.width-1 do
      begin
        p[x].r:=random(256);
        p[x].g:=random(256);
        p[x].b:=random(256);
      end;
    end;
    canvas.draw(0,0,b);
  end;

  procedure TForm1.FormDestroy(sender:TObject);
  begin
    b.free;
  end;
  ........................................................
------------------------------------------------------------------------------

> Как лучше сделать, если необходимо запустить внешний процесс и подождать,
> пока он отработает?

  ........................................................
  procedure TForm1.Button1Click(Sender: TObject);
  var si:TStartupInfo;
      pi:TProcessInformation;
      cmdline:string;
  begin
      ZeroMemory(@si,sizeof(si));
      si.cb:=SizeOf(si);
      cmdline:='c:\command.com';
      if not CreateProcess( nil, // No module name (use command line).
          PChar(cmdline),  // Command line.
          nil,             // Process handle not inheritable.
          nil,             // Thread handle not inheritable.
          False,           // Set handle inheritance to FALSE.
          0,               // No creation flags.
          nil,             // Use parent's environment block.
          nil,             // Use parent's starting directory.
          si,              // Pointer to STARTUPINFO structure.
          pi )             // Pointer to PROCESS_INFORMATION structure.
         then
          begin
           ShowMessage( 'CreateProcess failed.' );
           Exit;
          end;
      WaitForSingleObject( pi.hProcess, INFINITE );
      CloseHandle( pi.hProcess );
      CloseHandle( pi.hThread );
      ShowMessage('Done !');
  end;
  ........................................................
------------------------------------------------------------------------------

> Как сохранить содержимое экрана в файл?

  ........................................................
  procedure TForm1.Button1Click(Sender: TObject);
  var
    DC: HDC;
    Canva: TCanvas;
    B: TBitmap;
  begin
    Canva := TCanvas.Create;
    B := TBitmap.Create;
    DC := GetDC(0);
    try
      Canva.Handle := DC;
      with Screen do begin
        B.Width := Width;
        B.Height := Height;
        B.Canvas.CopyRect(Rect(0, 0, Width, Height), Canva,
           Rect(0, 0, Width, Height));
        B.SaveToFile('c:\screen.bmp');
                     end
    finally
      ReleaseDC(0, DC);
      B.Free;
      Canva.Free
    end
  end;
  ........................................................
------------------------------------------------------------------------------

> Как пеpемещать фоpму за Label?

  ........................................................................
  procedure TForm1.Label1MouseDown(Sender: TObject; Button: TMouseButton;
    Shift: TShiftState; X, Y: Integer);
    const SC_DragMove = $F012;  { a magic number }
  begin
    ReleaseCapture;
    Form1.perform(WM_SysCommand, SC_DragMove, 0);
  end;
  ........................................................................
------------------------------------------------------------------------------

> Как определить, есть ли в системе Wave-устройство?

  ........................................................
  uses MMSystem;
  
  procedure TForm1.Button1Click(Sender: TObject);
  begin
    if WaveOutGetNumDevs > 0 then
      ShowMessage('Sound Card is installed')
    else
      ShowMessage('Sound Card is not installed')
  end;
  ........................................................
------------------------------------------------------------------------------

> Как определить из под какой операционной системы запущена программа?

  ........................................................
  If (GetVersion() and $80000000)<>0 then
  //  ...'Windows 95/98'...
    else
  //   ... 'Windows NT'...
    end;
  ........................................................
------------------------------------------------------------------------------



Русские документы
[an error occurred while processing this directive]