|
p align="left"> FormDisplay.Memo1.Lines.Add('Вертискальная частота развёртки '+ IntToStr(GetDeviceCaps(Canvas.Handle, VREFRESH))); if (GetDeviceCaps(Canvas.Handle, RASTERCAPS) and RC_BANDING)=RC_BANDING then FormDisplay.Memo1.Lines.Add('Требуеться сегментация'); if (GetDeviceCaps(Canvas.Handle, RASTERCAPS) and RC_BITBLT)=RC_BITBLT then FormDisplay.Memo1.Lines.Add('Может передавать Bitmaps'); if (GetDeviceCaps(Canvas.Handle, RASTERCAPS) and RC_BITMAP64)=RC_BITMAP64 then FormDisplay.Memo1.Lines.Add('Поддержка Bitmaps > 64K'); if (GetDeviceCaps(Canvas.Handle, RASTERCAPS) and RC_DI_BITMAP)=RC_DI_BITMAP then FormDisplay.Memo1.Lines.Add('Поддержка SetDIBits and GetDIBits'); if (GetDeviceCaps(Canvas.Handle, RASTERCAPS) and RC_DIBTODEV)=RC_DIBTODEV then FormDisplay.Memo1.Lines.Add('Поддержка SetDIBitsToDevice'); if (GetDeviceCaps(Canvas.Handle, RASTERCAPS) and RC_FLOODFILL)=RC_FLOODFILL then FormDisplay.Memo1.Lines.Add('Can Perform Floodfills'); if (GetDeviceCaps(Canvas.Handle, RASTERCAPS) and RC_GDI20_OUTPUT)=RC_GDI20_OUTPUT then FormDisplay.Memo1.Lines.Add('Поддержка Windows 2.0 возможности'); if (GetDeviceCaps(Canvas.Handle, RASTERCAPS) and RC_PALETTE)=RC_PALETTE then FormDisplay.Memo1.Lines.Add('Основано на палитке'); if (GetDeviceCaps(Canvas.Handle, RASTERCAPS) and RC_SCALING)=RC_SCALING then FormDisplay.Memo1.Lines.Add('Поддержка масштабирования'); if (GetDeviceCaps(Canvas.Handle, RASTERCAPS) and RC_STRETCHBLT)=RC_STRETCHBLT then FormDisplay.Memo1.Lines.Add('Поддержка StretchBlt'); if (GetDeviceCaps(Canvas.Handle, RASTERCAPS) and RC_STRETCHDIB)=RC_STRETCHDIB then FormDisplay.Memo1.Lines.Add('Поддержка StretchDIBits'); if GetDeviceCaps(Canvas.Handle, CURVECAPS)=CC_NONE then FormDisplay.Memo1.Lines.Add('Устройство не поддерживает кривые') else begin if (GetDeviceCaps(Canvas.Handle, CURVECAPS) and CC_CIRCLES)=CC_CIRCLES then FormDisplay.Memo1.Lines.Add('Поддержка Cirles'); if (GetDeviceCaps(Canvas.Handle, CURVECAPS) and CC_PIE)=CC_PIE then FormDisplay.Memo1.Lines.Add('Поддержка Pie Wedges'); if (GetDeviceCaps(Canvas.Handle, CURVECAPS) and CC_CHORD)=CC_CHORD then FormDisplay.Memo1.Lines.Add('Поддержка Chords'); if (GetDeviceCaps(Canvas.Handle, CURVECAPS) and CC_ELLIPSES)=CC_ELLIPSES then FormDisplay.Memo1.Lines.Add('Поддержка Ellipses'); if (GetDeviceCaps(Canvas.Handle, CURVECAPS) and CC_WIDE)=CC_WIDE then FormDisplay.Memo1.Lines.Add('Поддержка Wide Borders'); if (GetDeviceCaps(Canvas.Handle, CURVECAPS) and CC_STYLED)=CC_STYLED then FormDisplay.Memo1.Lines.Add('Поддержка Styled Borders'); if (GetDeviceCaps(Canvas.Handle, CURVECAPS) and CC_WIDESTYLED)=CC_WIDESTYLED then FormDisplay.Memo1.Lines.Add('Поддержка Wide And Styled Borders'); if (GetDeviceCaps(Canvas.Handle, CURVECAPS) and CC_INTERIORS)=CC_INTERIORS then FormDisplay.Memo1.Lines.Add('Поддержка Interiors'); if (GetDeviceCaps(Canvas.Handle, CURVECAPS) and CC_ROUNDRECT)=CC_ROUNDRECT then FormDisplay.Memo1.Lines.Add('Поддержка Rounded Rectangles'); end; if GetDeviceCaps(Canvas.Handle, LINECAPS)=LC_NONE then FormDisplay.Memo1.Lines.Add('Device Does Not Support Lines') else begin if (GetDeviceCaps(Canvas.Handle, LINECAPS) and LC_POLYLINE)=LC_POLYLINE then FormDisplay.Memo1.Lines.Add('Поддержка Polylines'); if (GetDeviceCaps(Canvas.Handle, LINECAPS) and LC_MARKER)=LC_MARKER then FormDisplay.Memo1.Lines.Add('Поддержка Markers'); if (GetDeviceCaps(Canvas.Handle, LINECAPS) and LC_POLYMARKER)=LC_POLYMARKER then FormDisplay.Memo1.Lines.Add('Поддержка Multiple Markers'); if (GetDeviceCaps(Canvas.Handle, LINECAPS) and LC_WIDE)=LC_WIDE then FormDisplay.Memo1.Lines.Add('Поддержка Wide Lines'); if (GetDeviceCaps(Canvas.Handle, LINECAPS) and LC_STYLED)=LC_STYLED then FormDisplay.Memo1.Lines.Add('Поддержка Styled Lines'); if (GetDeviceCaps(Canvas.Handle, LINECAPS) and LC_WIDESTYLED)=LC_WIDESTYLED then FormDisplay.Memo1.Lines.Add('Поддержка Wide And Styled Lines'); if (GetDeviceCaps(Canvas.Handle, LINECAPS) and LC_INTERIORS)=LC_INTERIORS then FormDisplay.Memo1.Lines.Add('Поддержка Interiors'); end; if GetDeviceCaps(Canvas.Handle, POLYGONALCAPS)=PC_NONE then FormDisplay.Memo1.Lines.Add('Device Does Not Support Polygons') else begin if (GetDeviceCaps(Canvas.Handle, POLYGONALCAPS) and PC_POLYGON)=PC_POLYGON then FormDisplay.Memo1.Lines.Add('Поддержка Alternate Fill Polygons'); if (GetDeviceCaps(Canvas.Handle, POLYGONALCAPS) and PC_RECTANGLE)=PC_RECTANGLE then FormDisplay.Memo1.Lines.Add('Поддержка Rectangles'); if (GetDeviceCaps(Canvas.Handle, POLYGONALCAPS) and PC_WINDPOLYGON)=PC_WINDPOLYGON then FormDisplay.Memo1.Lines.Add('Поддержка Winding Fill Polygons'); if (GetDeviceCaps(Canvas.Handle, POLYGONALCAPS) and PC_SCANLINE)=PC_SCANLINE then FormDisplay.Memo1.Lines.Add('Поддержка Single Scanlines'); if (GetDeviceCaps(Canvas.Handle, POLYGONALCAPS) and PC_WIDE)=PC_WIDE then FormDisplay.Memo1.Lines.Add('Поддержка Wide Borders'); if (GetDeviceCaps(Canvas.Handle, POLYGONALCAPS) and PC_STYLED)=PC_STYLED then FormDisplay.Memo1.Lines.Add('Поддержка Styled Borders'); if (GetDeviceCaps(Canvas.Handle, POLYGONALCAPS) and PC_WIDESTYLED)=PC_WIDESTYLED then FormDisplay.Memo1.Lines.Add('Поддержка Wide And Styled Borders'); if (GetDeviceCaps(Canvas.Handle, POLYGONALCAPS) and PC_INTERIORS)=PC_INTERIORS then FormDisplay.Memo1.Lines.Add('Поддержка Interiors'); end; if (GetDeviceCaps(Canvas.Handle, TEXTCAPS) and TC_OP_CHARACTER)=TC_OP_CHARACTER then FormDisplay.Memo1.Lines.Add('Capable of Character Output Precision'); if (GetDeviceCaps(Canvas.Handle, TEXTCAPS) and TC_OP_STROKE)=TC_OP_STROKE then FormDisplay.Memo1.Lines.Add('Capable of Stroke Output Precision'); if (GetDeviceCaps(Canvas.Handle, TEXTCAPS) and TC_CP_STROKE)=TC_CP_STROKE then FormDisplay.Memo1.Lines.Add('Capable of Stroke Clip Precision'); if (GetDeviceCaps(Canvas.Handle, TEXTCAPS) and TC_CR_90)=TC_CR_90 then FormDisplay.Memo1.Lines.Add('Поддержка 90 Degree Character Rotation'); if (GetDeviceCaps(Canvas.Handle, TEXTCAPS) and TC_CR_ANY)=TC_CR_ANY then FormDisplay.Memo1.Lines.Add('Поддержка Character Rotation to Any Angle'); if (GetDeviceCaps(Canvas.Handle, TEXTCAPS) and TC_SF_X_YINDEP)=TC_SF_X_YINDEP then FormDisplay.Memo1.Lines.Add('X And Y Scale Independent'); if (GetDeviceCaps(Canvas.Handle, TEXTCAPS) and TC_SA_DOUBLE)=TC_SA_DOUBLE then FormDisplay.Memo1.Lines.Add('Поддержка Doubled Character Scaling'); if (GetDeviceCaps(Canvas.Handle, TEXTCAPS) and TC_SA_INTEGER)=TC_SA_INTEGER then FormDisplay.Memo1.Lines.Add('Поддержка Integer Multiples Only When Scaling'); if (GetDeviceCaps(Canvas.Handle, TEXTCAPS) and TC_SA_CONTIN)=TC_SA_CONTIN then FormDisplay.Memo1.Lines.Add('Поддержка Any Multiples For Exact Character Scaling'); if (GetDeviceCaps(Canvas.Handle, TEXTCAPS) and TC_EA_DOUBLE)=TC_EA_DOUBLE then FormDisplay.Memo1.Lines.Add('Поддержка Double Weight Characters'); if (GetDeviceCaps(Canvas.Handle, TEXTCAPS) and 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. Лекции по “СПО”
Страницы: 1, 2, 3
| 
