| Эта
статья пpедставляет кpаткий спpавочник
для пpогpаммистов, |
| здесь
собраны множественные примеры с
интернета и некоторые написаны мною...
|
| Как
в 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; |
|
|