TC_IA_ABLE)=TC_IA_ABLE then
FormDisplay.Memo1.Lines.Add('Поддержка Italics');
if (GetDeviceCaps(Canvas.Handle, TEXTCAPS) and
TC_UA_ABLE)=TC_UA_ABLE then
FormDisplay.Memo1.Lines.Add('Поддержка Underlines');
if (GetDeviceCaps(Canvas.Handle, TEXTCAPS) and
TC_SO_ABLE)=TC_SO_ABLE then
FormDisplay.Memo1.Lines.Add('Поддержка Strikeouts');
if (GetDeviceCaps(Canvas.Handle, TEXTCAPS) and
TC_RA_ABLE)=TC_RA_ABLE then
FormDisplay.Memo1.Lines.Add('Поддержка Raster Fonts');
if (GetDeviceCaps(Canvas.Handle, TEXTCAPS) and
TC_VA_ABLE)=TC_VA_ABLE then
FormDisplay.Memo1.Lines.Add('Поддержка Vector Fonts');
if (GetDeviceCaps(Canvas.Handle, TEXTCAPS) and
TC_SCROLLBLT)=TC_SCROLLBLT then
FormDisplay.Memo1.Lines.Add('Cannot Scroll Using Blts');
//Видеорежим
begin
i := 0;
while EnumDisplaySettings(nil, i, Modes[i]) do
begin
FormDisplay.Memo2.Lines.Add(IntToStr(Modes[i].dmBitsPerPel)+' '+IntToStr(Modes[i].dmPelsWidth)+' '+
IntToStr(Modes[i].dmPelsHeight)+' '+IntToStr(Modes[i].dmDisplayFrequency));
Inc(i);
end;
end;
Form1.Visible:=False;
FormDisplay.Visible:=True;
end;
procedure TForm1.Image8Click(Sender: TObject);
begin
Form1.Visible:=False;
FormDiski.Visible:=True;
end;
procedure TForm1.Image7Click(Sender: TObject);
var
lpDisplayDevice: TDisplayDevice;
dwFlags: DWORD;
cc: DWORD;
begin
lpDisplayDevice.cb := sizeof(lpDisplayDevice);
dwFlags := 0;
cc := 0;
while EnumDisplayDevices(nil, cc, lpDisplayDevice, dwFlags) do
begin
dec(cc);
FormVideo.Video1.Caption:=(lpDisplayDevice.DeviceString);
Form1.Visible:=False;
FormVideo.Visible:=True;
end;
end;
procedure TForm1.Image6Click(Sender: TObject);
begin
Form1.Visible:=False;
FormAbout.Visible:=True;
end;
end.
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls, TeEngine, Series, TeeProcs, Chart,
DbChart, jpeg, registry;
type
TFormCPUSpeed = class(TForm)
LabelCPUSpeed: TLabel;
BitBtnStart: TBitBtn;
BitBtnStop: TBitBtn;
Timer1: TTimer;
Chart1: TChart;
Label1: TLabel;
Image1: TImage;
Series1: TFastLineSeries;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
LabelCPUName: TLabel;
LabelCPUSpeedSR: TLabel;
LabelCPUStat: TLabel;
Label7: TLabel;
Label6: TLabel;
procedure BitBtnStartClick(Sender: TObject);
procedure BitBtnStopClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
{ Private declarations }
Stop: Boolean;
public
{ Public declarations }
end;
var
FormCPUSpeed: TFormCPUSpeed;
Flag:Integer;
implementation
uses Unit1;
{$R *.DFM}
function GetCPUSpeed: Double;
const
DelayTime = 500;
var
TimerHi, TimerLo: DWORD;
PriorityClass, Priority: Integer;
begin
PriorityClass := GetPriorityClass(GetCurrentProcess);
Priority := GetThreadPriority(GetCurrentThread);
SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);
Sleep(10);
asm
dw 310Fh
mov TimerLo, eax
mov TimerHi, edx
end;
Sleep(DelayTime);
asm
dw 310Fh
sub eax, TimerLo
sbb edx, TimerHi
mov TimerLo, eax
mov TimerHi, edx
end;
SetThreadPriority(GetCurrentThread, Priority);
SetPriorityClass(GetCurrentProcess, PriorityClass);
Result := TimerLo / (1000.0 * DelayTime);
end;
procedure TFormCPUSpeed.BitBtnStartClick(Sender: TObject);
begin
BitBtnStart.Enabled := False;
BitBtnStop.Enabled := True;
Stop := False;
while not Stop do
begin
LabelCPUSpeed.Caption := FloatToStr(GetCPUSpeed);
Application.ProcessMessages;
end;
BitBtnStart.Enabled := True;
BitBtnStop.Enabled := False;
end;
procedure TFormCPUSpeed.BitBtnStopClick(Sender: TObject);
begin
Stop := True;
FormCPUSpeed.Visible:=False;
Form1.Visible:=True;
end;
procedure TFormCPUSpeed.Timer1Timer(Sender: TObject);
var
i:Real;
begin
i:=StrToFloat(LabelCPUSpeed.Caption);
Series1.AddXY(Time,i,'',clNone);
if Series1.Count>20 then Series1.Delete(0);
LabelCPUSpeedSR.Caption:=FloatToStr(round(StrToFloat(LabelCPUSpeed.Caption)-(abs((Series1.FirstValueIndex-Series1.LastValueIndex))/2)));
if (StrToFloat(LabelCPUSpeedSR.Caption)>0)and(StrToFloat(LabelCPUSpeedSR.Caption)<=500)then begin LabelCPUStat.Caption:='1'; Label6.Caption:='-балл (Оченьслабый)'; end;
if (StrToFloat(LabelCPUSpeedSR.Caption)>500)and(StrToFloat(LabelCPUSpeedSR.Caption)<=1000)then begin LabelCPUStat.Caption:='2';Label6.Caption:='-балла (Слабый)';end;
if (StrToFloat(LabelCPUSpeedSR.Caption)>1000)and(StrToFloat(LabelCPUSpeedSR.Caption)<=1800)then begin LabelCPUStat.Caption:='3';Label6.Caption:='-балла (Средний)'; end;
if (StrToFloat(LabelCPUSpeedSR.Caption)>1800)and(StrToFloat(LabelCPUSpeedSR.Caption)<=2600)then begin LabelCPUStat.Caption:='4';Label6.Caption:='-балла (Хороший)'; end;
if (StrToFloat(LabelCPUSpeedSR.Caption)>2600)then begin LabelCPUStat.Caption:='5';Label6.Caption:='-баллов (Оченьхороший)';end;
end;
procedure TFormCPUSpeed.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
Application.Terminate;
end;
end.
unit Unit6;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, XPMan, FileCtrl, Buttons, jpeg, ExtCtrls;
type
TFormDiski = class(TForm)
VolumeSerial: TLabel;
FileSystemName: TLabel;
SectorsPerCluster: TLabel;
BytesPerSector: TLabel;
VolumeName: TLabel;
DriveComboBox1: TDriveComboBox;
Image1: TImage;
Image2: TImage;
BitBtn1: TBitBtn;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
procedure FormShow(Sender: TObject);
procedure DriveComboBox1Change(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
private
{ Private declarations }
procedure UpdateDisk;
public
{ Public declarations }
end;
var
FormDiski: TFormDiski;
implementation
uses Unit1;
{$R *.dfm}
procedure TFormDiski.FormShow(Sender: TObject);
begin
UpdateDisk;
end;
procedure TFormDiski.UpdateDisk;
var
lpRootPathName : PChar;
lpVolumeNameBuffer : PChar;
nVolumeNameSize : DWORD;
lpVolumeSerialNumber : DWORD;
lpMaximumComponentLength : DWORD;
lpFileSystemFlags : DWORD;
lpFileSystemNameBuffer : PChar;
nFileSystemNameSize : DWORD;
FSectorsPerCluster: DWORD;
FBytesPerSector : DWORD;
FFreeClusters : DWORD;
FTotalClusters : DWORD;
begin
lpVolumeNameBuffer := '';
lpVolumeSerialNumber := 0;
lpMaximumComponentLength:= 0;
lpFileSystemFlags := 0;
lpFileSystemNameBuffer := '';
try
GetMem(lpVolumeNameBuffer, MAX_PATH + 1);
GetMem(lpFileSystemNameBuffer, MAX_PATH + 1);
nVolumeNameSize := MAX_PATH + 1;
nFileSystemNameSize := MAX_PATH + 1;
lpRootPathName := PChar(FormDiski.DriveComboBox1.Drive+':\');
if GetVolumeInformation( lpRootPathName, lpVolumeNameBuffer,
nVolumeNameSize, @lpVolumeSerialNumber, lpMaximumComponentLength,
lpFileSystemFlags, lpFileSystemNameBuffer, nFileSystemNameSize )
then
begin
VolumeName.Caption := lpVolumeNameBuffer;
VolumeSerial.Caption := IntToHex(HIWord(lpVolumeSerialNumber), 4) + '-' + IntToHex(LOWord(lpVolumeSerialNumber), 4);
FileSystemName.Caption:= lpFileSystemNameBuffer;
GetDiskFreeSpace( PChar(DriveComboBox1.Drive+':\'), FSectorsPerCluster, FBytesPerSector, FFreeClusters, FTotalClusters);
end;
finally
FreeMem(lpVolumeNameBuffer);
FreeMem(lpFileSystemNameBuffer);
end;
SectorsPerCluster.Caption:=IntToStr(FSectorsPerCluster);
BytesPerSector.Caption:=IntToStr(FBytesPerSector);
end;
procedure TFormDiski.DriveComboBox1Change(Sender: TObject);
begin
UpdateDisk;
end;
procedure TFormDiski.BitBtn1Click(Sender: TObject);
begin
FormDiski.Visible:=False;
Form1.Visible:=True;
end;
end.
СПИСОК ИСПОЛЬЗУЕМОЙ ЛИТЕРАТУРЫ
1. Архангельский А.Я. Москва 2003 “Delphi 7.0”
2. Фаронов В.В. Санкт-Питербург “Питер” 2004 “Delphi программирование на языке высокого уровня”
3. http://delphimastak.ru
4. Лекции по “СПО”