FAQ
Домой Мои программы FAQ Сайты Гостевая книга Форум Поиск

 
Эта статья пpедставляет кpаткий спpавочник для пpогpаммистов,
здесь собраны множественные примеры с интернета и некоторые написаны мною...

 

Как в Delphi изменить иконку у директории.
Получить информацию о WAV файле
Запуск внешней программы
Как управлять спикером под 9х из Delphi ?

Как выяснить запущен ли Delphi / C++ Builder?

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

Как определение нажатия определенной клавиши во время загрузки приложения? 

Как спрятать и отключить кнопку "Пуск"?

Форматирование диска в Win32 

Как программно выключить монитор? 

Можно ли из Delphi рисовать в любой части экрана или в чужом окне? 

Добавляем пункты в системное меню Windows 
Как писать программы для полноэкранного режима (когда кнопки "Пуск" не видно и т.п.)? 
Щелчёк по заголовку формы 
Как быстро зашыфровать текст 
Свернуть все окна 
Прозрачные окна 
Открытие формы с анимацией 
Как поместить TMenuItem справа у формы?
К началу страницы

 

 

Как в Delphi изменить иконку у директории
Компилятор: Delphi 4.x, 5.x

Обычно, для изменения вида папок в Проводнике используется файл desktop.ini.

Сперва необходимо создать файл Desktop.ini и поместить в ту директорию, иконку которой мы хотим изменить. В программе для этого можно воспользоваться классом TIniFile и передать в него путь директории.

Теперь нам необходимо записать в .ini файл пары <key>=<value>. В Desktop.ini эти пары выглядят следующим образом (самое главное, это указать иконку и её индекс):

[.ShellCLassInfo]
IconFile=C:LocationofFolder.ico
IconIndex=0
InfoTip=Delphi is the coolest IDE ever!


Значение IconFile это путь к .dll, .ico, или .exe. В Delphi это выглядит так:

with iniFile do
begin
//Следующие строки меняют иконку
WriteString('.ShellClassInfo', 'IconFile', editIconPath.Text);
WriteString('.ShellClassInfo', 'IconIndex', editIconIndex.Text);
WriteString('.ShellClassInfo', 'InfoTip', 'Use Delphi because it 
rocks!');
UpdateFile; 
end;

Теперь, когда файл Desktop.ini создан, необходимо изменить атрибуты папки и добавить системный флаг. Чтобы иконка отображалась правильно, желательно установить системный флажёк как для папки, так и для её родителя. Для установки атрибутов воспользуемся функцией SetFileAttribue():

//Устанавливаем системные атрибуты для папки и её родителя
SetFileAttributes(PChar(edFolderPath.Text), FILE_ATTRIBUTE_SYSTEM);
if Length(edFolderPath.Text) > 3 then //Если директория не корневая...
begin
//функция LastChar возвращает индекс последнего вхождения символа
//в строку. Этот способ позволяет быстро получить путь родительской
//директориии, если, конечно, директория не является корневой на диске..
tempDir := Copy( edFolderPath.Text, 1,LastChar(edFolderPath.Text, '')-1);
SetFileAttributes(PChar(tempDir), FILE_ATTRIBUTE_SYSTEM); 
end;

Теперь можно открыть Проводник и посмотреть в левой панели на значёк директории.
К началу страницы

 

Получить информацию о WAV файле
unit W32Waves; 
{ Unit for accessing Windows PCM wave file informations 
  By Ulli Conrad <uconrad@gmx.net> } 
interface 
uses SysUtils, Windows, MMSystem, Dialogs; 
type 
  PWaveInformation = ^tWaveInformation; 
  TWaveInformation = record 
    WaveFormat: Word;         { Wave format identifier } 
    Channels: Word;         { Mono=1, Stereo=2 } 
    SampleRate: Longint;      { Sample rate in Hertz } 
    BitsPerSample: Word;         { Resolution, e.g. 8 or 16 Bit } 
    SamplesNumber: Longint;      { Number of samples } 
    Length: Extended;     { Sample length in seconds } 
    ValidWave: bool;         { Specifies if the file could be read } 
  end; 
const                            { Constants for wave format identifier } 
  WAVE_FORMAT_PCM = $0001;   { Windows PCM } 
  WAVE_FORMAT_G723_ADPCM = $0014;   { Antex ADPCM } 
  WAVE_FORMAT_ANTEX_ADPCME = $0033;   { Antex ADPCME } 
  WAVE_FORMAT_G721_ADPCM = $0040;   { Antex ADPCM } 
  WAVE_FORMAT_APTX = $0025;   { Audio Processing Technology } 
  WAVE_FORMAT_AUDIOFILE_AF36 = $0024;   { Audiofile, Inc. } 
  WAVE_FORMAT_AUDIOFILE_AF10 = $0026;   { Audiofile, Inc. } 
  WAVE_FORMAT_CONTROL_RES_VQLPC = $0034;   { Control Resources Limited } 
  WAVE_FORMAT_CONTROL_RES_CR10 = $0037;   { Control Resources Limited } 
  WAVE_FORMAT_CREATIVE_ADPCM = $0200;   { Creative ADPCM } 
  WAVE_FORMAT_DOLBY_AC2 = $0030;   { Dolby Laboratories } 
  WAVE_FORMAT_DSPGROUP_TRUESPEECH = $0022;   { DSP Group, Inc } 
  WAVE_FORMAT_DIGISTD = $0015;   { DSP Solutions, Inc. } 
  WAVE_FORMAT_DIGIFIX = $0016;   { DSP Solutions, Inc. } 
  WAVE_FORMAT_DIGIREAL = $0035;   { DSP Solutions, Inc. } 
  WAVE_FORMAT_DIGIADPCM = $0036;   { DSP Solutions ADPCM } 
  WAVE_FORMAT_ECHOSC1 = $0023;   { Echo Speech Corporation } 
  WAVE_FORMAT_FM_TOWNS_SND = $0300;   { Fujitsu Corp. } 
  WAVE_FORMAT_IBM_CVSD = $0005;   { IBM Corporation } 
  WAVE_FORMAT_OLIGSM = $1000;   { Ing C. Olivetti & C., S.p.A. } 
  WAVE_FORMAT_OLIADPCM = $1001;   { Ing C. Olivetti & C., S.p.A. } 
  WAVE_FORMAT_OLICELP = $1002;   { Ing C. Olivetti & C., S.p.A. } 
  WAVE_FORMAT_OLISBC = $1003;   { Ing C. Olivetti & C., S.p.A. } 
  WAVE_FORMAT_OLIOPR = $1004;   { Ing C. Olivetti & C., S.p.A. } 
  WAVE_FORMAT_IMA_ADPCM = $0011;   { Intel ADPCM } 
  WAVE_FORMAT_DVI_ADPCM = $0011;   { Intel ADPCM } 
  WAVE_FORMAT_UNKNOWN = $0000; 
  WAVE_FORMAT_ADPCM = $0002;   { Microsoft ADPCM } 
  WAVE_FORMAT_ALAW = $0006;   { Microsoft Corporation } 
  WAVE_FORMAT_MULAW = $0007;   { Microsoft Corporation } 
  WAVE_FORMAT_GSM610 = $0031;   { Microsoft Corporation } 
  WAVE_FORMAT_MPEG = $0050;   { Microsoft Corporation } 
  WAVE_FORMAT_NMS_VBXADPCM = $0038;   { Natural MicroSystems ADPCM } 
  WAVE_FORMAT_OKI_ADPCM = $0010;   { OKI ADPCM } 
  WAVE_FORMAT_SIERRA_ADPCM = $0013;   { Sierra ADPCM } 
  WAVE_FORMAT_SONARC = $0021;   { Speech Compression } 
  WAVE_FORMAT_MEDIASPACE_ADPCM = $0012;   { Videologic ADPCM } 
  WAVE_FORMAT_YAMAHA_ADPCM = $0020;   { Yamaha ADPCM } 
function GetWaveInformationFromFile(FileName: string; Info: pWaveInformation): bool; 
implementation 
type 
  TCommWaveFmtHeader = record 
    wFormatTag: Word;                  { Fixed, must be 1 } 
    nChannels: Word;                  { Mono=1, Stereo=2 } 
    nSamplesPerSec: Longint;               { SampleRate in Hertz } 
    nAvgBytesPerSec: Longint; 
    nBlockAlign: Word; 
    nBitsPerSample: Word;                  { Resolution, e.g. 8 or 16 } 
    cbSize: Longint;               { Size of extra information in the extended fmt Header } 
  end; 

function GetWaveInformationFromFile(FileName: string; Info: pWaveInformation): bool; 
var 
  hdmmio: HMMIO; 
  mmckinfoParent: TMMCKInfo; 
  mmckinfoSubchunk: TMMCKInfo; 
  Fmt: TCommWaveFmtHeader; 
  Samples: Longint; 
begin 
  Result := False; 
  FillChar(Info^, SizeOf(TWaveInformation), #0); { Initialize first } 
  hdmmio := mmioOpen(PChar(FileName), nil, MMIO_READ); 
  if (hdmmio = 0) then 
    Exit; 
      {* Locate a 'RIFF' chunk with a 'WAVE' form type 
       * to make sure it's a WAVE file. 
       *} 
  mmckinfoParent.fccType := mmioStringToFOURCC('WAVE', MMIO_TOUPPER); 
  if (mmioDescend(hdmmio, PMMCKINFO(@mmckinfoParent), nil, MMIO_FINDRIFF) <> 0) then 
    Exit; 
      {* Now, find the format chunk (form type 'fmt '). It should be 
       * a subchunk of the 'RIFF' parent chunk. 
       *} 
  mmckinfoSubchunk.ckid := mmioStringToFOURCC('fmt ', 0); 
  if (mmioDescend(hdmmio, @mmckinfoSubchunk, @mmckinfoParent, MMIO_FINDCHUNK) <> 0) then 
    Exit; 
  // Read the format chunk. 
  if (mmioRead(hdmmio, PChar(@fmt), Longint(SizeOf(TCommWaveFmtHeader))) <> 
    Longint(SizeOf(TCommWaveFmtHeader))) then 
    Exit; 
  Info^.WaveFormat    := fmt.wFormatTag; 
  Info^.Channels      := fmt.nChannels; 
  Info^.SampleRate    := fmt.nSamplesPerSec; 
  Info^.BitsPerSample := fmt.nBitsPerSample; 
  mmioAscend(hdmmio, @mmckinfoSubchunk, 0); // Ascend out of the format subchunk. 
  mmckinfoSubchunk.ckid := mmioStringToFOURCC('data', 0); // Find the data subchunk. 
  if (mmioDescend(hdmmio, @mmckinfoSubchunk, @mmckinfoParent, MMIO_FINDCHUNK) <> 0) then 
    Exit; 
  Info^.SamplesNumber := mmckinfoSubchunk.cksize; // Get the size of the data subchunk. 
  Samples      := (Info^.SamplesNumber * 8 * Info^.Channels) div Info^.BitsPerSample; 
  Info^.Length := Samples / Info^.Samplerate; 
  mmioClose(hdmmio, 0); // We're done with the file, close it. 
  Info^.ValidWave := True; 
  Result          := True; 
end; 

end.
К началу страницы

 

Запуск внешней программы
procedure TForm1.Button1Click(Sender: TObject);
var
w1: Word;
p1, p2: array[0..100] of Char;
begin
StrPcopy(p1, 'CALC');
if GetModuleHandle(p1) = 0 then
 begin
  StrPcopy(p2, 'C:\windows\Calc.exe');
  w1 := WinExec(p2, SW_Restore);
 end;
end;

К началу страницы

 

Как управлять спикером под 9х из Delphi ?

Под WinNT/2000/XP вы можете использовать Beep(Tone, Duration) (задавать тон и продолжительность звучания). А под 9.x/Me эта функция не реализована, но можно командовать железом через порты, и сделать универсальную: 


unit BeepUnit;
// универсальная - версию виндовса проверяет
procedure Beep(Tone, Duration: Word);
procedure Sound(Freq : Word);
procedure NoSound;
procedure SetPort(address, Value:Word);
function GetPort(address:word):word;
implementation


procedure SetPort(address, Value:Word);
var
bValue: byte;
begin
bValue := trunc(Value and 255);
asm
mov dx, address
mov al, bValue
out dx, al
end;
end;


function GetPort(address:word):word;
var
bValue: byte;
begin
asm
mov dx, address
in al, dx
mov bValue, al
end;
GetPort := bValue;
end;


procedure Sound(Freq : Word);
var
B : Byte;
begin
if Freq > 18 then
 begin
  Freq := Word(1193181 div LongInt(Freq));
  B := Byte(GetPort($61));
  if (B and 3) = 0 then
   begin
    SetPort($61, Word(B or 3));
    SetPort($43, $B6);
   end;
 SetPort($42, Freq);
 SetPort($42, Freq shr 8);
end;
end;


procedure NoSound;
var
Value: Word;
begin
Value := GetPort($61) and $FC;
SetPort($61, Value);
end;


procedure Beep(Tone, Duration: Word);
begin
if SysUtils.Win32Platform = VER_PLATFORM_WIN32_NT then
 Windows.Beep(Tone, Duration)
else
 begin
  Sound(Tone);
  Windows.Sleep(Duration);
  NoSound;
 end;
end


end.

К началу страницы

 

Как выяснить запущен ли Delphi / C++ Builder?

Используйте функцию FindWindow. (Класс главного окна Delphi / C++ Builder - TAppBuilder)

 

if FindWindow('TAppBuilder', Nil) <> 0 Then 
  ShowMessage('Delphi and or C++ Builder is running'); 

 

К началу страницы

 

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

 

procedure Delay(ms : longint); {$IFNDEF WIN32} 

var TheTime : LongInt; {$ENDIF} 

begin 

 

{$IFDEF WIN32} Sleep(ms); 

{$ELSE} TheTime := GetTickCount + ms; 

while GetTickCount < TheTime do Application.ProcessMessages; 

 

{$ENDIF} end

 

procedure TForm1.Button1Click(Sender: TObject); 

begin 

 

MessageBeep(word(-1)); 

Delay(200); 

MessageBeep(word(-1)); 

Delay(200); 

MessageBeep(word(-1)); 

 

end;

К началу страницы

 

Как определение нажатия определенной клавиши во время загрузки приложения?

 

program Project1; 

 

uses Windows, Forms, Unit1 in 'Unit1.pas' {Form1}; 

 

{$R *.RES} 

 

begin 

 

if GetKeyState(vk_F8) < 1 then 

MessageBox(0, 'F8 was pressed during startup', 'MyApp', mb_ok); 

Application.Initialize; 

Application.CreateForm(TForm1, Form1); 

Application.Run; 

 

end.

 

К началу страницы

 

Как спрятать и отключить кнопку "Пуск"?

 

procedure TForm1.Button1Click(Sender: TObject); 

var Rgn : hRgn; 

begin 

{Cпрятать кнопку "Пуск"} Rgn := CreateRectRgn(0, 0, 0, 0); SetWindowRgn(FindWindowEx(FindWindow('Shell_TrayWnd', nil), 0, 'Button', nil), Rgn, true); 

end;

 

procedure TForm1.Button2Click(Sender: TObject); 

begin 

{Показать кнопку "Пуск"} 

SetWindowRgn(FindWindowEx(FindWindow('Shell_TrayWnd', nil), 0, 'Button', nil), 0, true); 

end

 

procedure TForm1.Button3Click(Sender: TObject); 

begin 

{Запретить кнопку "Пуск"} 

EnableWindow(FindWindowEx(FindWindow('Shell_TrayWnd', nil), 0, 'Button', nil), false); 

end

 

procedure TForm1.Button4Click(Sender: TObject); 

begin 

{Разрешить кнопку "Пуск"} 

EnableWindow(FindWindowEx(FindWindow('Shell_TrayWnd', nil), 0, 'Button', nil), true); 

end.

 

К началу страницы

 

Форматирование диска в Win32

 

ShellAPI функция ShFormatDrive().
Пример:

 const SHFMT_DRV_A = 0; 
 const SHFMT_DRV_B = 1; 
 
 const SHFMT_ID_DEFAULT = $FFFF; 
 
 const SHFMT_OPT_QUICKFORMAT = 0; 
 const SHFMT_OPT_FULLFORMAT = 1; 
 const SHFMT_OPT_SYSONLY = 2; 
 
 const SHFMT_ERROR = -1; 
 const SHFMT_CANCEL = -2; 
 const SHFMT_NOFORMAT = -3; 
 
 function SHFormatDrive(hWnd : HWND;Drive : Word; fmtID : Word; Options : Word) : Longint 
			stdcall; external 'Shell32.dll' name 'SHFormatDrive'; 
 
 procedure TForm1.Button1Click(Sender: TObject); 
 var 
   FmtRes : longint; 
 begin 
   try 
     FmtRes:= ShFormatDrive(Handle, SHFMT_DRV_A, SHFMT_ID_DEFAULT, SHFMT_OPT_QUICKFORMAT); 
     case FmtRes  of 
      SHFMT_ERROR : ShowMessage('Error formatting the drive'); 
      SHFMT_CANCEL :  
        ShowMessage('User canceled formatting the drive'); 
      SHFMT_NOFORMAT : ShowMessage('No Format') 
     else 
      ShowMessage('Disk has been formatted'); 
     end; 
   except 
   end; 
 
 end; 

 

К началу страницы

 

Как программно выключить монитор?

 

Программно можно отключить монитор совместимый со стандартом EnergyStar.

Отправьте сообщение wm_SysCommand с параметром WParam = SC_MonitorPower

   и LParam = 0 для отключения монитора 
     LParam = 1 для включения монитора
 
К началу страницы

 

Можно ли из Delphi рисовать в любой части экрана или в чужом окне?

 

PROCEDURE DrawOnScreen; 

VAR ScreenDC: hDC; 

BEGIN ScreenDC := GetDC(0); {получить контекст экрана} 

Ellipse(ScreenDC, 0, 0, 200, 200); {нарисовать} 

ReleaseDC(0,ScreenDC); {освободить контекст} 

END;

 

К началу страницы

 

Добавляем пункты в системное меню Windows
 

Unit OhYeah;
Interface
Uses
    SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, Menus;
Type
   TForm1 = Class (TForm)
      Procedure FormCreate (Sender : TObject);
   Private {Private declarations}
   Public  {Public declarations}
      Procedure WinMsg (Var Msg : TMsg; Var Handled : Boolean);
      Procedure DoWhatEever;
End;
Var
   Form1 : TForm1;

Implementation

{$R *.DFM}

Const

     ItemID = 99; // ID номер для пункта меню. Может быть любым

Procedure Tform1.WinMsg (Var Msg : TMsg; Var Handled : Boolean);
Begin
     If Msg.Message = WM_SYSCOMMAND Then
        If Msg.WParam = ItemID Then DoWhatEver;
End;

Procedure TForm1.FormCreate (Sender : TObject);
Begin
     Application.OnMessage := WinMsg;
     AppendMenu (GetSystemMenu (Form1.Handle, False), MF_SEPARATOR, 0, '');
     AppendMenu (GetSystemMenu (Form1.Handle, False), MF_BYPOSITION, ItemID, '&My menu');
     AppendMenu (GetSystemMenu (Application.Handle, False), MF_SEPARATOR, 0, '');
     AppendMenu (GetSystemMenu (Application.Handle, False), MF_BYPOSITION, ItemID,'&My menu minimized');
End;

Procedure TForm1.DoWhatEver;
Begin
     Exit;    // Вы можете добавить здесь всё, что угодно
End;

End.

 

 

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

unit Unit1;
interface
uses
Windows, Buttons, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs;
type
TForm1 = class(TForm)
procedure FormResize(Sender: TObject);
private
CaptionBtn : TRect;
procedure DrawCaptButton;
procedure WMNCPaint(var Msg : TWMNCPaint); message WM_NCPaint;
procedure WMNCActivate(var Msg : TWMNCActivate); message
WM_NCACTIVATE;
procedure WMSetText(var Msg : TWMSetText); message WM_SETTEXT;
procedure WMNCHitTest(var Msg : TWMNCHitTest); message WM_NCHITTEST;
procedure WMNCLButtonDown(var Msg : TWMNCLButtonDown); message
WM_NCLBUTTONDOWN;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation

const
htCaptionBtn = htSizeLast + 1;
{$R *.DFM}

procedure TForm1.DrawCaptButton;
var
xFrame, yFrame, xSize, ySize : Integer;
R : TRect;
begin
//Dimensions of Sizeable Frame
xFrame := GetSystemMetrics(SM_CXFRAME);
yFrame := GetSystemMetrics(SM_CYFRAME);
//Dimensions of Caption Buttons
xSize := GetSystemMetrics(SM_CXSIZE);
ySize := GetSystemMetrics(SM_CYSIZE);
//Define the placement of the new caption button
CaptionBtn := Bounds(Width - xFrame - 4*xSize + 2,
yFrame + 2, xSize - 2, ySize - 4);
//Get the handle to canvas using Form's device context
Canvas.Handle := GetWindowDC(Self.Handle);
Canvas.Font.Name := 'Symbol';
Canvas.Font.Color := clBlue;
Canvas.Font.Style := [fsBold];
Canvas.Pen.Color := clYellow;
Canvas.Brush.Color := clBtnFace;
try
DrawButtonFace(Canvas, CaptionBtn, 1, bsAutoDetect, False, False,
False);
//Define a smaller drawing rectangle within the button
R := Bounds(Width - xFrame - 4 * xSize + 2,
yFrame + 3, xSize - 6, ySize - 7);
with CaptionBtn do
Canvas.TextRect(R, R.Left + 2, R.Top - 1, 'W');
finally
ReleaseDC(Self.Handle, Canvas.Handle);
Canvas.Handle := 0;
end;
end;

procedure TForm1.WMNCPaint(var Msg : TWMNCPaint);
begin
inherited;
DrawCaptButton;
end;

procedure TForm1.WMNCActivate(var Msg : TWMNCActivate);
begin
inherited;
DrawCaptButton;
end;

procedure TForm1.WMSetText(var Msg : TWMSetText);
begin
inherited;
DrawCaptButton;
end;

procedure TForm1.WMNCHitTest(var Msg : TWMNCHitTest);
begin
inherited;
with Msg do
if PtInRect(CaptionBtn, Point(XPos - Left, YPos - Top)) then
Result := htCaptionBtn;
end;

procedure TForm1.WMNCLButtonDown(var Msg : TWMNCLButtonDown);
begin
inherited;
if (Msg.HitTest = htCaptionBtn) then
ShowMessage('You hit the button on the caption bar');
end;

procedure TForm1.FormResize(Sender: TObject);
begin
//Force a redraw of caption bar if form is resized
Perform(WM_NCACTIVATE, Word(Active), 0);
end;

end.

К началу страницы

 

Как писать программы для полноэкранного режима (когда кнопки "Пуск" не видно и т.п.)?
 

Попpобуй установить BorderStyle=bsNone; WindowState=wsMaximized
(можно добавить FormStyle=fsStayOnTop. дабы нельзя было выключиться с формы и даже обработку OnDeactivate для других StayOnTop приложений)

К началу страницы

 

Щелчёк по заголовку формы
 

{...}
  private
     procedure WMNCRBUTTONDOWN(var Message: TMessage); message WM_NCRBUTTONDOWN;
     procedure WMNCLBUTTONDOWN(var Message: TMessage); message WM_NCLBUTTONDOWN;

{...}
implementation
{...}

procedure TForm1.WMNCRBUTTONDOWN(var Message: TMessage);
begin
 if Message.wParam= HTCAPTION then Caption:= 'Right Click!';
 // Message.Result := 0;
end;

procedure TForm1.WMNCLBUTTONDOWN(var Message: TMessage);
begin
 inherited;
 if Message.wParam= HTCAPTION then Caption:= 'Left Click!';
 // Message.Result := 0;
end;

К началу страницы

 

Как быстро зашыфровать текст
 

procedure TForm1.Button1Click(Sender:TObject);
var
  s : string[255];
  c : array[0..255] of Byte absolute s;
  i:Integer;
begin
  {encode}

  s:='siro_com developers';
  For i:=1 to ord(s[0]) do c[i] := 23 XOr c[i];
  Label1.Caption:=s;

  {Decode}

  s:=Label1.Caption;
  For i:=1 to Length(s) do s[i] := char(23 Xor ord([i]));
  Label2.Caption:=s;
end;

К началу страницы

 

Свернуть все окна
 

procedure TForm1.Button1Click(Sender: TObject);
var
  h:HWnd;
begin
  h:=handle;
  while h > 0 do
  begin
  if isWindowVisible(h) then
    postmessage(h,WM_SYSCOMMAND,SC_MINIMIZE,0);
    h:=getnextwindow(h,GW_HWNDNEXT);
  end;
end;


К началу страницы

 

Прозрачные окна 
 

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

//Описываю недокументированную функцию SetLayeredWindowAttributes
function SetLayeredWindowAttributes(hwnd: longint; crey: byte; bAlpha: byte;
          dwFlags: longint): longint; stdcall; external 'USER32.DLL';

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var old: longint;
begin
  old:=GetWindowLongA(Handle,GWL_EXSTYLE);
  SetWindowLongA(Handle,GWL_EXSTYLE,old or $80000);
  SetLayeredWindowAttributes(handle, 0, 150, $2);
end;

end.

К началу страницы

 

Открытие формы с анимацией 
procedure TForm1.Button1Click(Sender: TObject);

procedure delay(msec:longint);
var
  start,stop:longint;
begin
  start := gettickcount;
repeat
  stop := gettickcount;
  application.processmessages;
until (stop - start ) >= msec;
end;

var maxx,maxy:integer;

begin
  maxx:=form2.width;
  maxy:=form2.height;
  form2.width:=112;
  form2.height:=27;
  form2.Left:=(screen.Width-form2.Width) div 2;
  form2.Top:=(screen.Height-form2.Height) div 2;
  form2.show;

  repeat
    if form2.height+(maxy div 5)>=maxy then
    begin
      form2.height:=maxy
    end
    else
    begin
      form2.height:=form2.Height+(maxy div 5);
    end;

    if form2.Width+(maxx div 5)>=maxx then
    begin
      form2.width:=maxx
    end
    else
    begin
     form2.width:=form2.Width+(maxx div 5);
    end;
    form2.Left:=(screen.Width-form2.Width) div 2;
    form2.Top:=(screen.Height-form2.Height) div 2;
    delay(30);
  until (form2.width=maxx) and (form2.height=maxy);
end;
К началу страницы

 

Как поместить TMenuItem справа у формы
Допустим, у Вас есть TMainMenu MainMenu1 и HelpMenuItem в конце панели меню (Menubar). Если Вызвать следующий обработчик события OnCreate, то HelpMenuItem сместится вправо.

uses
  Windows;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ModifyMenu(MainMenu1.Handle, 0, mf_ByPosition or mf_Popup or mf_Help, HelpMenuItem1.Handle,      '&Help');
end;
 

К началу страницы

 

Copyright 2003 
Разработчик Бордюг Антон
Моё мыло: KILLER-ABV@YANDEX.RU.
Обновлено: 01 декабря, 2003.