24 совета по программированию в Delphi (Дельфи) часть 2 - Delphi, Pascal, ObjectPascal - Программирование
Навигация по сайту
Сайт:

Дополнительно:

Файловый архив:

Каталог статей:

Форум:


Категории раздела
Delphi, Pascal, ObjectPascal [18]
Программирование на Delphi, Pascal, ObjectPascal
C, C++, C# [7]
Программирование на C, C++, C#
ПХП (PHP) [6]
Все что связано с программированием на PHP.
DirectX [0]
Программирование с использованием графического API DirectX
OpenGL [0]
Программирование с использованием графического API OpenGL
Работа с базами данных (БД) [0]
Работа с базами данных MySQL и т.д. Разработка, теории, алгоритмы.
Сетевое программирование [0]
Сетевое программирование, организация сетей.
Программирование игр [0]
Все что связано с программированием игр, организацией их разработки.
Работа с мультимедиа данными [0]
Загрузка, обработка, воспроизведение и все что связано со звуком и видео.
Работа с устройсвами ввода и вывода [0]
Программирование устройств ввода и вывода. Работа с геймпадом, рулем и многим другим.
Программирование HTML 5 игр [0]
Программирование HTML 5 игр, html верстка, JS (JavaScript)
Остальное [0]
Все остальное, что не попадает ни под одну категорию.

Мини-Опрос
Вы следите за обновлениями конструкторо игр, движков?
Всего ответов: 304

Партнеры сайта
....

 Главная » Статьи » Программирование » Delphi, Pascal, ObjectPascal » 24 совета по программированию в Delphi (Дельфи) часть 2

24 совета по программированию в Delphi (Дельфи) часть 2

00:49
1. Коды всех виртуальных клавиш
2. Как мне подсчитать занимаемое директорией место?
3. Сохранение параметров шрифта в файле.
4. Изменение шрифта у всплывающих подсказок
5. Как проверить готовность диска a:\
6. Перекодировка текста
7. Открытие и закрытие привода CD-ROM
8. Как подавить реакцию на Ctrl+Alt+Del?
9. Как изменить изображение на кнопке ПУСК?
10. Как изменить обои на рабочем столе?
11. Как узнать имя пользователя версию Windows и т.д.
12. Как скопировать экран в TCanvas?
13. Как извлечь иконку из EXE или DLL?
14. 64 битное кодирование/декодирование
15. Реестр. Свое расширение
16. Преобразование BMP в ICO
17. Преобразование ICO в BMP
18. Как программным путем включить Num Lock?
19. Drag & Drop с TImage
20. Быстрое копирование файлов
21. Вращение изображения
22. Добавление события OnMouseLeave
23. Завершение всех работающих приложений
24. Использование анимированных курсоров

1. Коды всех виртуальных клавиш
vk_LButton = $01;
vk_RButton = $02;
vk_Cancel = $03;
vk_MButton = $04; { генерятся только системой вместе с L & RBUTTON }
vk_Back = $08;
vk_Tab = $09;
vk_Clear = $0C;
vk_Return = $0D;
vk_Shift = $10;
vk_Control = $11;
vk_Menu = $12;
vk_Pause = $13;
vk_Capital = $14;
vk_Escape = $1B;
vk_Space = $20;
vk_Prior = $21;
vk_Next = $22;

vk_End = $23;
vk_Home = $24;
vk_Left = $25;
vk_Up = $26;
vk_Right = $27;
vk_Down = $28;
vk_Select = $29;
vk_Print = $2A;
vk_Execute = $2B;
vk_SnapShot = $2C;
{ vk_Copy = $2C не используется клавиатурой }

vk_Insert = $2D;
vk_Delete = $2E;
vk_Help = $2F;
{ vk_A - vk_Z такие же, как и их ASCII-эквиваленты: 'A' - 'Z' }
{ vk_0 - vk_9 такие же, как и их ASCII-эквиваленты: '0' - '9' }

vk_NumPad0 = $60;
vk_NumPad1 = $61;
vk_NumPad2 = $62;
vk_NumPad3 = $63;
vk_NumPad4 = $64;
vk_NumPad5 = $65;
vk_NumPad6 = $66;
vk_NumPad7 = $67;
vk_NumPad8 = $68;
vk_NumPad9 = $69;
vk_Multiply = $6A;
vk_Add = $6B;
vk_Separator = $6C;
vk_Subtract = $6D;
vk_Decimal = $6E;
vk_Divide = $6F;
vk_F1 = $70;
vk_F2 = $71;
vk_F3 = $72;
vk_F4 = $73;
vk_F5 = $74;

vk_F6 = $75;
vk_F7 = $76;
vk_F8 = $77;
vk_F9 = $78;
vk_F10 = $79;
vk_F11 = $7A;
vk_F12 = $7B;
vk_F13 = $7C;
vk_F14 = $7D;
vk_F15 = $7E;
vk_F16 = $7F;
vk_F17 = $80;
vk_F18 = $81;
vk_F19 = $82;
vk_F20 = $83;
vk_F21 = $84;
vk_F22 = $85;
vk_F23 = $86;
vk_F24 = $87;
vk_NumLock = $90;
vk_Scroll = $91;

2. Как подсчитать занимаемое директорией место. Возвращаемая размерность - байты.):
var
DirBytes : integer;

function TFileBrowser.DirSize(Dir:string):integer;
var
SearchRec : TSearchRec;
Separator : string;
begin
if Copy(Dir,Length(Dir),1)='\' then
Separator := ''
else
Separator := '\';
if FindFirst(Dir+Separator+'*.*',faAnyFile,SearchRec) = 0 then begin
if FileExists(Dir+Separator+SearchRec.Name) then begin
DirBytes := DirBytes + SearchRec.Size;
{Memo1.Lines.Add(Dir+Separator+SearchRec.Name);}
end else if DirectoryExists(Dir+Separator+SearchRec.Name) then begin
if (SearchRec.Name<>'.') and (SearchRec.Name<>'..') then begin
DirSize(Dir+Separator+SearchRec.Name);
end;
end;
while FindNext(SearchRec) = 0 do begin
if FileExists(Dir+Separator+SearchRec.Name) then begin
DirBytes := DirBytes + SearchRec.Size;
{Memo1.Lines.Add(Dir+Separator+SearchRec.Name);}
end else if DirectoryExists(Dir+Separator+SearchRec.Name) then
begin
if (SearchRec.Name<>'.') and (SearchRec.Name<>'..') then begin
DirSize(Dir+Separator+SearchRec.Name);
end;
end;
end;
end;
FindClose(SearchRec);
end;

3. Сохранение параметров шрифта в файле.
function FontToStr(font: TFont): string;
procedure yes(var str:string);
begin
str := str + 'y';
end;
procedure no(var str:string);
begin
str := str + 'n';
end;
begin
{кодируем все атрибуты TFont в строку}
Result := '';
Result := Result + IntToStr(font.Color) + '|';
Result := Result + IntToStr(font.Height) + '|';
Result := Result + font.Name + '|';
Result := Result + IntToStr(Ord(font.Pitch)) + '|';
Result := Result + IntToStr(font.PixelsPerInch) + '|';
Result := Result + IntToStr(font.size) + '|';
if fsBold in font.style then yes(Result) else no(Result);
if fsItalic in font.style then yes(Result) else no(Result);
if fsUnderline in font.style then yes(Result) else no(Result);
if fsStrikeout in font.style then yes(Result) else no(Result);
end;

procedure StrToFont(str: string; font: TFont);
begin
if str = '' then Exit;
font.Color := StrToInt(tok('|', str));
font.Height := StrToInt(tok('|', str));
font.Name := tok('|', str);
font.Pitch := TFontPitch(StrToInt(tok('|', str)));
font.PixelsPerInch := StrToInt(tok('|', str));
font.Size := StrToInt(tok('|', str));
font.Style := [];
if str[0] = 'y' then font.Style := font.Style + [fsBold];
if str[1] = 'y' then font.Style := font.Style + [fsItalic];
if str[2] = 'y' then font.Style := font.Style + [fsUnderline];
if str[3] = 'y' then font.Style := font.Style + [fsStrikeout];
end;

function tok(sep: string; var s: string): string;
function isoneof(c, s: string): Boolean;
var
iTmp: integer;
begin
Result := False;
for iTmp := 1 to Length(s) do
begin
if c = Copy(s, iTmp, 1) then
begin
Result := True;
Exit;
end;
end;
end;
var
c, t: string;
begin
if s = '' then
begin
Result := s;
Exit;
end;
c := Copy(s, 1, 1);
while isoneof(c, sep) do
begin
s := Copy(s, 2, Length(s) - 1);
c := Copy(s, 1, 1);
end;
t := '';
while (not isoneof(c, sep)) and (s <> '') do
begin
t := t + c;
s := Copy(s, 2, length(s)-1);
c := Copy(s, 1, 1);
end;
Result := t;
end;

4. Изменение шрифта у всплывающих подсказок
unit Unit1;

interface

uses
SysUtils, WinTypes, WinProcs, Messages, 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;

implementation

{$R *.DFM}

Type
TMyHintWindow = Class (THintWindow)
Constructor Create (AOwner: TComponent); override;
end;

Constructor TMyHintWindow.Create (AOwner: TComponent);
Begin
Inherited Create (Aowner);
Canvas.Font.Name := 'Times New Roman';
Canvas.Font.Size := 14;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Application.ShowHint := False;
HintWindowClass := TMyHintWindow;
Application.ShowHint := True;
end;

end.

5. Как проверить готовность диска a:\
function DiskInDrive(const Drive: char): Boolean;
var
DrvNum: byte;
EMode: Word;
begin
result := true; // было false
DrvNum := ord(Drive);
if DrvNum >= ord('a') then dec(DrvNum,$20);
EMode := SetErrorMode(SEM_FAILCRITICALERRORS);
try
while DiskSize(DrvNum-$40) = -1 do begin // при неудаче выводим
диалог
if (Application.MessageBox('Диск не готов...'+chr(13)+chr(10)+
'Повторить?',PChar('Диск '+UpperCase(Drive)),mb_OKCANCEL+
mb_iconexclamation{IconQuestion})=idcancel) then begin
Result:=false;
Break;
end;
end;
finally
SetErrorMode(EMode);
end;
end;

6. Перекодировка текста
procedure WinToDos;
var Src, Str:PChar;//Src-строка для перевода Str-конечная
begin
Src := Memo1.Lines.GetText; //Берем текст из TMemo как тип PChar
CharToOem(Src, Str); //API функция для перевода текста
Memo2.Lines.Text := StrPas(Str);//Записываем назад
end;

procedure DosToWin;
var Src, Str:PChar;
begin
Src := Memo1.Lines.GetText; //Берем текст из TMemo как тип PChar
OemToChar(Src, Str); //API функция для перевода текста
Memo2.Lines.Text := StrPas(Str);//Записываем назад
end;

7. Открытие и закрытие привода CD-ROM
unit DriveTools;
interface
uses
Windows, SysUtils, MMSystem;
function CloseCD(Drive : Char) : Boolean;
function OpenCD(Drive : Char) : Boolean;
implementation
function OpenCD(Drive : Char) : Boolean;
Var
Res MciError;
OpenParm: TMCI_Open_Parms;
Flags : DWord;
S : String;
DeviceID : Word;
begin
Result:=false;
S:=Drive+':';
Flags:=mci_Open_Type or mci_Open_Element;
With OpenParm do begin
dwCallback := 0;
lpstrDeviceType := 'CDAudio';
lpstrElementName := PChar(S);
end;
Res := mciSendCommand(0, mci_Open, Flags, Longint(@OpenParm));
IF Res<>0 Then exit;
DeviceID:=OpenParm.wDeviceID;
try
Res:=mciSendCommand(DeviceID, MCI_SET, MCI_SET_DOOR_OPEN, 0);
IF Res=0 Then exit;
Result:=True;
finally
mciSendCommand(DeviceID, mci_Close, Flags, Longint(@OpenParm));
end;
end;
function CloseCD(Drive : Char) : Boolean;
Var
Res : MciError;
OpenParm: TMCI_Open_Parms;
Flags : DWord;
S : String;
DeviceID : Word;
begin
Result:=false;
S:=Drive+':';
Flags:=mci_Open_Type or mci_Open_Element;
With OpenParm do begin
dwCallback := 0;
lpstrDeviceType := 'CDAudio';
lpstrElementName := PChar(S);
end;
Res := mciSendCommand(0, mci_Open, Flags, Longint(@OpenParm));
IF Res<>0 Then exit;
DeviceID:=OpenParm.wDeviceID;
try
Res:=mciSendCommand(DeviceID, MCI_SET, MCI_SET_DOOR_CLOSED, 0);
IF Res=0 Then exit;
Result:=True;
finally
mciSendCommand(DeviceID, mci_Close, Flags, Longint(@OpenParm));
end;
end;
end.

8. Как подавить реакцию на Ctrl+Alt+Del?
В некоторых случаях (например, при работе в полноэкранном режиме, показе своей презентации или экранной заставки ...) бывает полезно заблокировать перечисленные комбинации клавиш. Они блокируются при работе системы в режиме "экранная заставка" , который в свою очередь несложно включить и выключить:
// Включение режима
SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, 0, 0);
// Выключение режима
SystemParametersInfo(SPI_SCREENSAVERRUNNING, 0, 0, 0);
Кстати, SystemParametersInfo имеет еще кучу полезных ключей SPI_****, подробности см. в win32.hlp

9. Как изменить изображение на кнопке ПУСК?
{ объявляем глобальные переменные }
var
Form1: TForm1;
StartButton: hWnd;
OldBitmap: THandle;
NewImage: TPicture;
{ добавляем следующий код в событие формы OnCreate }
procedure TForm1.FormCreate(Sender: TObject);
begin
NewImage := TPicture.create;
NewImage.LoadFromFile('C:\Windows\Circles.BMP');
StartButton := FindWindowEx
(FindWindow('Shell_TrayWnd',nil),0,'Button', nil);
OldBitmap := SendMessage(StartButton,
BM_SetImage, 0,
NewImage.Bitmap.Handle);
end;
{ Событие OnDestroy }
procedure TForm1.FormDestroy(Sender: TObject);
begin
SendMessage(StartButton,BM_SetImage,0,OldBitmap);
NewImage.Free;
end;

10. Как изменить обои на рабочем столе?
program wallpapr;
uses Registry, WinProcs;
procedure SetWallpaper(sWallpaperBMPPath:String;bTile:boolean);
var
reg : TRegIniFile;
begin
// Изменяем ключи реестра
// HKEY_CURRENT_USER
// Control Panel\Desktop
// TileWallpaper (REG_SZ)
// Wallpaper (REG_SZ)
reg := TRegIniFile.Create('Control Panel\Desktop' );
with reg do begin
WriteString( '', 'Wallpaper',
sWallpaperBMPPath );
if( bTile )then
begin
WriteString('', 'TileWallpaper', '1' );
end else begin
WriteString('', 'TileWallpaper', '0' );
end;
end;
reg.Free;
// Оповещаем всех о том, что мы изменили системные настройки
SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, Nil,
{Эта строка - продолжение предыдущей}SPIF_SENDWININICHANGE );
end;
// пример установки WallPaper по центру рабочего стола
SetWallpaper('c:\winnt\winnt.bmp', False );
//Эту строчку надо написать где-то в программе.

11. Как узнать имя пользователя, версию Windows и т.д.
В uses пpописываешь модуль Registry и дальше так:
var
R:TRegistry;
No:String;
begin
R:=TRegistry.Create;
R.RootKey:=HKEY_LOCAL_MACHINE;
R.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion', False) {если false то пытается откpыть не создавая}
No:=R.ReadString('VersionNumber');
if No=..... then ...... else ......
end;
Кроме того, обязательно посмотрите на список функций WinAPI, имена которых начинаются с Get.... Например, GetComputerName, GetVersionEx, GetSystemInfo, SystemParametersInfo.

12. Как скопировать экран в TCanvas?
var
bmp: TBitmap;
DC: HDC;
begin
bmp:=TBitmap.Create;
bmp.Height:=Screen.Height;
bmp.Width:=Screen.Width;
DC:=GetDC(0); //Дескpиптоp экpана
bitblt(bmp.Canvas.Handle, 0, 0, Screen.Width, Screen.Height,
DC, 0, 0, SRCCOPY);
bmp.SaveToFile('Screen.bmp');
ReleaseDC(0, DC);
end;

13. Как извлечь иконку из EXE или DLL
Процесс получения иконок из .EXE, .DLL или .ICO файлов полностью идентичен.
Различие только в том, что в .ICO файле может храниться только одна иконка, а в
.EXE и .DLL несколько. Для получения иконок из файлов, в модуле ShellAPI, есть
функция:
function ExtractIcon(Inst: THandle; FileName: PChar; IconIndex: Word): HIcon;
где
Inst - указатель на приложение вызвавшее функцию, FileName - имя файла
из которого необходимо получить иконку, IconIndex - номер необходимой иконки.
Если функция возвращает значение не равное нулю, то в файле есть следующая иконка.
В данном примере в компонент Image1 выводится иконка запущенного файла.
USES ShellAPI;
procedure TForm1.FormCreate(Sender: TObject);
VAR A: ARRAY [0..78] OF Char;
begin

{Получение имени запущенного файла}
StrPCopy(A, ParamStr(0));
{Вывод на экран нулевой иконки из файла}
Image1.Picture.Icon.Handle := ExtractIcon(HInstance, A, 0);
end;

14. 64-битное кодирование/декодирование
Const
Base64Table='ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';

function Base64Decode(cStr:string):string;
var ResStr:string;
DecStr:string;
RecodeLine : array [1..76] of byte;
f1,f2 : word;
l:integer;
begin
l :=length(cStr);
ResStr:='';
for f1:=1 to l do
if cStr[f1]='=' then RecodeLine[f1]:=0
else RecodeLine[f1]:=pos(cStr[f1],Base64Table)-1;
f1:=1;
while f1 begin
DecStr:=chr(byte(RecodeLine[f1] shl 2)+RecodeLine[f1+1] shr 4)+
chr(byte(RecodeLine[f1+1] shl 4)+RecodeLine[f1+2] shr 2)+
chr(byte(RecodeLine[f1+2] shl 6)+RecodeLine[f1+3]);
ResStr:=ResStr+DecStr;
inc(f1,4);
end;
Base64Decode:=ResStr;
end;

15. Реестр. Свое расширение
//Use the registry to register your own filetype. uses registry;

procedure TForm1.RegisterFileType(prefix:String; exepfad:String);
var reg:TRegistry;
begin
reg:=TRegistry.Create;
reg.RootKey:=HKEY_CLASSES_ROOT;
//create a new key --> .pci
reg.OpenKey('.'+prefix,True);
//create a new value for this key --> pcifile
reg.WriteString('',prefix+'file');
reg.CloseKey; //create a new key --> pcifile
reg.CreateKey(prefix+'file');
//create a new key pcifile\DefaultIcon
reg.OpenKey(prefix+'file\DefaultIcon',True);
//and create a value where the icon is stored --> c:\project1.exe,0 reg.WriteString('',exepfad+',0');
reg.CloseKey;
reg.OpenKey(prefix+'file\shell\open\command',True);
//create value where exefile is stored --> c:\project1.exe "%1"
reg.WriteString('',exepfad+' "%1"'); reg.CloseKey;
reg.Free;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
RegisterFileType('pci','c:\project1.exe');
end;

16. Как преобразовать BMP (32x32) в ICO?
unit main;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
Image2: TImage;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var winDC, srcdc, destdc : HDC;
oldBitmap : HBitmap;
iinfo : TICONINFO;
begin
GetIconInfo(Image1.Picture.Icon.Handle, iinfo);

WinDC := getDC(handle);
srcDC := CreateCompatibleDC(WinDC);
destDC := CreateCompatibleDC(WinDC);
oldBitmap := SelectObject(destDC, iinfo.hbmColor);
oldBitmap := SelectObject(srcDC, iinfo.hbmMask);

BitBlt(destdc, 0, 0, Image1.picture.icon.width,
Image1.picture.icon.height,
srcdc, 0, 0, SRCPAINT);
Image2.picture.bitmap.handle := SelectObject(destDC, oldBitmap);
DeleteDC(destDC);
DeleteDC(srcDC);
DeleteDC(WinDC);

image2.Picture.Bitmap.savetofile(ExtractFilePath(Application.ExeName)
+ 'myfile.bmp');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
image1.picture.icon.loadfromfile('c:\myicon.ico');
end;

end.

17. Как преобразовать ICO в BMP?
var
Icon : TIcon;
Bitmap : TBitmap;
begin
Icon := TIcon.Create;
Bitmap := TBitmap.Create;
Icon.LoadFromFile('c:\picture.ico');
Bitmap.Width := Icon.Width;
Bitmap.Height := Icon.Height;
Bitmap.Canvas.Draw(0, 0, Icon );
Bitmap.SaveToFile('c:\picture.bmp');
Icon.Free;
Bitmap.Free;
end;

18. Как программным путем включить Num Lock?
procedure TMyForm.Button1Click(Sender: TObject);
Var
KeyState : TKeyboardState;
begin
GetKeyboardState(KeyState);
if (KeyState[VK_NUMLOCK] = 0) then
KeyState[VK_NUMLOCK] := 1
else
KeyState[VK_NUMLOCK] := 0;
SetKeyboardState(KeyState);
end;
Для Caps Lock замените VK_NUMLOCK на VK_CAPITAL.

19. Drag & Drop с TImage
procedure TForm1.Panel1DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
WITH Source AS TImage DO
BEGIN
Left := X;
Top := Y;
END;
end;
procedure TForm1.Panel1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
Accept := Source IS TImage;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
WITH TImage.Create(Self) DO
BEGIN
Parent := Panel1;
AutoSize := True;
Picture.LoadFromFile('...');
DragMode := dmAutomatic;
OnDragOver := Panel1DragOver;
OnDragDrop := Panel1DragDrop;
END;
end;

20. Быстрое копирование файлов
procedure CopyFile( Source, Dest : string );
var
SrcFile : Integer;
DestFile : Integer;
S : string;
RetCode : Longint;
OpenFileBuf : TOFStruct;
FName : array[ 0..255 ] of Char;
begin
StrPCopy( FName, Source );
SrcFile := LZOpenFile( FName, OpenFileBuf, of_Read );
StrPCopy( FName, Dest );
DestFile := LZOpenFile( FName, OpenFileBuf, of_Create );

RetCode := LZCopy( SrcFile, DestFile );
if RetCode >= 0 then
begin
LZClose( SrcFile );
LZClose( DestFile );
end
else
begin
Str( RetCode, S );
MessageDlg( 'Не могу скопировать ' + Source + ' в ' +
Dest + #13 + 'Код ошибки = ' + S, mtError, [mbOk], 0 );
end;
end;

21. Вращение изображения
procedure RotateRight(BitMap : tImage);
var FirstC, LastC, c, r : integer;

procedure FixPixels(c,r : integer);
var SavePix, SavePix2 : tColor;
i, NewC, NewR : integer;
begin
SavePix := Bitmap.Canvas.Pixels[c,r];
for i := 1 to 4 do begin
newc := BitMap.Height-r+1;
newr := c;
SavePix2 := BitMap.Canvas.Pixels[newc,newr];
Bitmap.Canvas.Pixels[newc,newr] := SavePix;
SavePix := SavePix2;
c := Newc;
r := NewR;
end;
end;

begin
if BitMap.Width <> BitMap.Height then exit;
BitMap.Visible := false;
with Bitmap.Canvas do begin
firstc := 0;
lastc := BitMap.Width;
for r := 0 to BitMap.Height div 2 do begin
for c := firstc to lastc do begin
FixPixels(c,r);
end;
inc(FirstC);
Dec(LastC);
end;
end;
BitMap.Visible := true;
end;

22. Добавление события OnMouseLeave
unit BS_Label;

interface

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

type
TBS_Label = class(TLabel)
private
{ Private declarations }
FOnMouseLeave: TNotifyEvent;
FOnMouseEnter: TNotifyEvent;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
protected
{ Protected declarations }
public
{ Public declarations }
published
{ Published declarations }
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Custom', [TBS_Label]);
end;

{ TBS_Label }

procedure TBS_Label.CMMouseEnter(var Message: TMessage);
begin
if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
end;

procedure TBS_Label.CMMouseLeave(var Message: TMessage);
begin
if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
end;

end.

23. Завершение всех работающий приложений
Ниже приведен код, который поможет вам завершить ВСЕ задачи без всяких уведомлений о необходимости сохранения данных.
Поэтому, прежде чем запустить этот код, убедитесь в наличии сохраненных данных и в том, что пользователь осведомлен об этой операции.
procedure TForm1.ButtonKillAllClick(Sender: TObject);
var
pTask : PTaskEntry;
Task : Bool;
ThisTask: THANDLE;
begin
GetMem (pTask, SizeOf (TTaskEntry));
pTask^.dwSize := SizeOf (TTaskEntry);

Task := TaskFirst (pTask);
while Task do
begin
if pTask^.hInst = hInstance then
ThisTask := pTask^.hTask
else
TerminateApp (pTask^.hTask, NO_UAE_BOX);
Task := TaskNext (pTask);
end;
TerminateApp (ThisTask, NO_UAE_BOX);
end;

24. Использование анимированных курсоров
const crMyCursor = 1;

procedure TForm1.FormCreate(Sender: TObject);
begin
// Загружаем курсор. Единственный способ для этого
Screen.Cursors[crMyCursor] :=
LoadCursorFromFile('c:\mystuff\mycursor.ani');
// Используем курсор на форме
Cursor := crMyCursor;
end;


Категория: Delphi, Pascal, ObjectPascal | Просмотров: 1727 | Добавил: ДядяВолк (11.08.2010) | Рейтинг: 0.0/0
Источник: http://quadrathell.cn.ua/ | Автор: Михаил Христосенко |
HTML ссылка на материал:
BB ссылка на материал:
Похожие материалы :
Возможно вам будет интересно:
Создание наземного врага в платформере (2)
статьи по Yogurt3D (0)
Создание многопользовательской(online) игры на Game Maker. (часть 1) (0)
Создание многопользовательской(online) игры на Game Maker. (часть 2) (0)
Blitz 3D - полезная дипломная работа (часть 1) (0)
Создание Платформенной Игры Copyright 2001 by Mark Overmars (0)
Что с чем едят - 3d Rad (0)
3d Rad - Про конструктор (0)
Пингуем (Ping) под Delphi (1)
AI часть 1 (0)
PHP - Базовые понятия (0)
Создаем анимацию игрока (0)
Урок по PaintNET (1)
Как рисовать спрайты в DXDraw DelphiX (0)
Создаем вертолет (2)
Всего комментариев: 0
Добавлять комментарии могут только зарегистрированные пользователи.
[ Регистрация | Вход ]
Мы в социальных сетях

Поиск
Поиск по всему сайту:
Поиск по разделу:

Панель пользователя
Здравствуйте, Гость


Ник:
Пароль:
Запомнить :

Ваш IP: 54.211.207.116

Случайные конструкторы

Случайные движки

Случайные статьи

Статистика
Онлайн всего: 4
Гостей: 4
Пользователей: 0

На сайте были:
ZiP

При полном или частичном копировании материалов сайта ссылка на Make-Games.ru обязательна. Make-Games.ru © 2008 - 2016 Хостинг от uWeb
Топ Разработка игр Рейтинг@Mail.ru