Menu
▾
▴
[JVCL-Checkins] CVS: dev/JVCL3/run JvJCLUtils.pas,1.33,1.34 JvgExceptionHandler.pas,1.4,1.5 JvgExportComponents.pas,1.5,1.6 JvgFileUtils.pas,1.3,1.4 JvgJump.pas,1.2,1.3 JvgSysInf.pas,1.2,1.3 - style cleaning
|
From: Robert M. <mar...@us...> - 2003-11-28 11:37:42
|
Update of /cvsroot/jvcl/dev/JVCL3/run
In directory sc8-pr-cvs1:/tmp/cvs-serv22896/JVCL3/run
Modified Files:
JvJCLUtils.pas JvgExceptionHandler.pas JvgExportComponents.pas
JvgFileUtils.pas JvgJump.pas JvgSysInf.pas
Log Message:
style cleaning
Index: JvJCLUtils.pas
===================================================================
RCS file: /cvsroot/jvcl/dev/JVCL3/run/JvJCLUtils.pas,v
retrieving revision 1.33
retrieving revision 1.34
diff -C2 -d -r1.33 -r1.34
*** JvJCLUtils.pas 27 Nov 2003 18:17:43 -0000 1.33
--- JvJCLUtils.pas 28 Nov 2003 11:37:37 -0000 1.34
***************
*** 647,651 ****
{ begin JvFileUtil }
- function GetFileSize(const FileName: string): Int64;
function FileDateTime(const FileName: string): TDateTime;
{$IFDEF MSWINDOWS}
--- 647,650 ----
***************
*** 5733,5767 ****
Result := DirectoryExists(Name);
end;
-
- function GetFileSize(const FileName: string): Int64;
- {$IFDEF MSWINDOWS}
- var
- Handle: THandle;
- FindData: TWin32FindData;
- begin
- Handle := FindFirstFile(PChar(FileName), FindData);
- if Handle <> INVALID_HANDLE_VALUE then
- begin
- Windows.FindClose(Handle);
- if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
- begin
- Int64Rec(Result).Lo := FindData.nFileSizeLow;
- Int64Rec(Result).Hi := FindData.nFileSizeHigh;
- Exit;
- end;
- end;
- Result := -1;
- end;
- {$ENDIF}
- {$IFDEF LINUX}
- var
- st: TStatBuf;
- begin
- if stat(PChar(FileName), st) = 0 then
- Result := st.st_size
- else
- Result := -1;
- end;
- {$ENDIF}
function FileDateTime(const FileName: string): TDateTime;
--- 5732,5735 ----
Index: JvgExceptionHandler.pas
===================================================================
RCS file: /cvsroot/jvcl/dev/JVCL3/run/JvgExceptionHandler.pas,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** JvgExceptionHandler.pas 29 Jun 2003 14:04:12 -0000 1.4
--- JvgExceptionHandler.pas 28 Nov 2003 11:37:38 -0000 1.5
***************
*** 276,281 ****
LogPath := ExtractFilePath(ParamStr(0)) +
! DelFileExt(ExtractFileName(ParamStr(0))) + '\';
! ScreenShotName := DelFileExt(ExtractFileName(ParamStr(0)) + ' ' +
StringReplace(StringReplace(ID, '{', '', [rfReplaceAll]), '}', '',
[rfReplaceAll]))
--- 276,281 ----
LogPath := ExtractFilePath(ParamStr(0)) +
! DeleteFileExt(ExtractFileName(ParamStr(0))) + '\';
! ScreenShotName := DeleteFileExt(ExtractFileName(ParamStr(0)) + ' ' +
StringReplace(StringReplace(ID, '{', '', [rfReplaceAll]), '}', '',
[rfReplaceAll]))
Index: JvgExportComponents.pas
===================================================================
RCS file: /cvsroot/jvcl/dev/JVCL3/run/JvgExportComponents.pas,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** JvgExportComponents.pas 3 Oct 2003 23:10:53 -0000 1.5
--- JvgExportComponents.pas 28 Nov 2003 11:37:38 -0000 1.6
***************
*** 448,454 ****
if ExtractFileExt(FSaveToFileName) = '' then
! FSaveToFileName := DelFileExt(FSaveToFileName) + '.xls';
! if FileExists(FSaveToFileName) then
! DeleteFileEx(FSaveToFileName);
if FSaveToFileName <> '' then
--- 448,453 ----
if ExtractFileExt(FSaveToFileName) = '' then
! FSaveToFileName := ChangeFileExt(FSaveToFileName, '.xls');
! DeleteFileEx(FSaveToFileName);
if FSaveToFileName <> '' then
Index: JvgFileUtils.pas
===================================================================
RCS file: /cvsroot/jvcl/dev/JVCL3/run/JvgFileUtils.pas,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** JvgFileUtils.pas 25 Jun 2003 18:09:52 -0000 1.3
--- JvgFileUtils.pas 28 Nov 2003 11:37:38 -0000 1.4
***************
*** 32,108 ****
interface
! uses Windows, SysUtils, JvgTypes, shlobj, classes;
function GetOwnPath: string;
! function DelFileExt(FileName: string): string;
! function DeleteFileEx(const FileName: string): boolean;
function LoadTextFromFile(const FileName: string): string;
! procedure SaveTextToFile(const FileName, Text: string);
function GetFolder(Wnd: HWND; Title: string): string;
! function GetFileSize(const FileName: string): integer;
! procedure CopyFolder(const SourceFilePath, TargetFilePath: string; fOverwrite: boolean = true; fSubdirectories: boolean
! = false);
procedure RemoveDirectories(const FilePath: string);
implementation
! uses FileCtrl;
function GetOwnPath: string;
var
! i: word;
! p: string;
begin
! p := ParamStr(0);
! i := length(p);
! repeat dec(i);
! until p[i] = '\';
! Result := copy(p, 1, i);
end;
! function DelFileExt(FileName: string): string;
! var
! s: string;
! i: integer;
begin
! FileName := trim(FileName);
! s := ExtractFileExt(FileName);
! for i := 1 to length(s) do
! FileName[length(FileName) - length(s) + i] := chr(20);
! result := trim(FileName);
end;
! function DeleteFileEx(const FileName: string): boolean;
begin
! Result := false;
! if not FileExists(FileName) then exit;
! RenameFile(FileName, FileName + '_del');
! Result := not boolean(DeleteFile(PChar(FileName + '_del')));
end;
function LoadTextFromFile(const FileName: string): string;
- var
- sl: TStringList;
begin
Result := '';
! sl := TStringList.Create;
! try
! sl.LoadFromFile(FileName);
! Result := sl.Text;
! finally
! sl.Free;
! end;
end;
! procedure SaveTextToFile(const FileName, Text: string);
! var
! sl: TStringList;
begin
! sl := TStringList.Create;
! try
! sl.Text := Text;
! sl.SaveToFile(FileName);
! finally
! sl.Free;
! end;
end;
--- 32,109 ----
interface
!
! uses
! Windows, SysUtils, ShlObj, Classes,
! JvgTypes;
function GetOwnPath: string;
! function DeleteFileExt(const FileName: string): string;
! function DeleteFileEx(const FileName: string): Boolean;
function LoadTextFromFile(const FileName: string): string;
! procedure SaveTextToFile(const FileName, AText: string);
function GetFolder(Wnd: HWND; Title: string): string;
! procedure CopyFolder(const SourceFilePath, TargetFilePath: string;
! Overwrite: Boolean = True; SubDirectories: Boolean = False);
procedure RemoveDirectories(const FilePath: string);
implementation
!
! uses
! FileCtrl,
! JvJclUtils;
function GetOwnPath: string;
var
! Len: Word;
! S: string;
begin
! S := ParamStr(0);
! Len := Length(S);
! repeat
! Dec(Len);
! until S[Len] = PathDelim;
! Result := Copy(S, 1, Len);
end;
! function DeleteFileExt(const FileName: string): string;
begin
! Result := ChangeFileExt(Trim(FileName), '');
end;
! function DeleteFileEx(const FileName: string): Boolean;
! const
! cSuffix = '_del_';
begin
! if FileExists(FileName) then
! begin
! Result := RenameFile(FileName, FileName + cSuffix);
! if Result then
! Result := DeleteFile(FileName + cSuffix);
! end
! else
! Result := False;
end;
function LoadTextFromFile(const FileName: string): string;
begin
Result := '';
! with TStringList.Create do
! try
! LoadFromFile(FileName);
! Result := Text;
! finally
! Free;
! end;
end;
! procedure SaveTextToFile(const FileName, AText: string);
begin
! with TStringList.Create do
! try
! Text := AText;
! SaveToFile(FileName);
! finally
! Free;
! end;
end;
***************
*** 111,118 ****
lpItemID: PItemIDList;
BrowseInfo: TBrowseInfo;
! DisplayName: array[0..MAX_PATH] of Char;
begin
Result := '';
! if not SetForegroundWindow(Wnd) then Exit;
FillChar(BrowseInfo, SizeOf(TBrowseInfo), #0);
BrowseInfo.hwndOwner := 0;
--- 112,120 ----
lpItemID: PItemIDList;
BrowseInfo: TBrowseInfo;
! DisplayName: array [0..MAX_PATH] of Char;
begin
Result := '';
! if not SetForegroundWindow(Wnd) then
! Exit;
FillChar(BrowseInfo, SizeOf(TBrowseInfo), #0);
BrowseInfo.hwndOwner := 0;
***************
*** 123,148 ****
if lpItemId <> nil then
begin
! if SHGetPathFromIDList(lpItemId, DisplayName) then Result := DisplayName;
GlobalFreePtr(lpItemID);
end;
end;
! function GetFileSize(const FileName: string): integer;
! var
! f: file of Byte;
! begin
! if not FileExists(FileName) then
! begin
! Result := 0;
! exit;
! end;
! AssignFile(f, FileName);
! Reset(f);
! Result := FileSize(f);
! CloseFile(f);
! end;
!
! procedure CopyFolder(const SourceFilePath, TargetFilePath: string; fOverwrite: boolean = true; fSubdirectories: boolean
! = false);
var
sr: TSearchRec;
--- 125,137 ----
if lpItemId <> nil then
begin
! if SHGetPathFromIDList(lpItemId, DisplayName) then
! Result := DisplayName;
! // (rom) wrong
GlobalFreePtr(lpItemID);
end;
end;
! procedure CopyFolder(const SourceFilePath, TargetFilePath: string;
! Overwrite: Boolean; SubDirectories: Boolean);
var
sr: TSearchRec;
***************
*** 154,167 ****
Ext := ExtractFileExt(FileName);
! if (sr.Name = '.') or (sr.Name <> '..') then exit;
! if fSubdirectories and boolean(sr.Attr and faDirectory) then
! CopyFolder(SourceFilePath + sr.Name + '\', TargetFilePath + sr.Name + '\', fOverwrite, fSubdirectories)
else
! CopyFile(PChar(SourceFilePath + FileName), PChar(TargetFilePath + ExtractFileName(FileName)), not fOverwrite);
end;
begin
ForceDirectories(TargetFilePath);
! if FindFirst(SourceFilePath + '*.*', faAnyFile, sr) = 0 then
begin
ProcessFile(sr.Name);
--- 143,159 ----
Ext := ExtractFileExt(FileName);
! if (sr.Name = '.') or (sr.Name <> '..') then
! Exit;
! if SubDirectories and Boolean(sr.Attr and faDirectory) then
! CopyFolder(SourceFilePath + sr.Name + PathDelim,
! TargetFilePath + sr.Name + PathDelim, Overwrite, SubDirectories)
else
! CopyFile(PChar(SourceFilePath + FileName),
! PChar(TargetFilePath + ExtractFileName(FileName)), not Overwrite);
end;
begin
ForceDirectories(TargetFilePath);
! if FindFirst(SourceFilePath + AllFilesMask, faAnyFile, sr) = 0 then
begin
ProcessFile(sr.Name);
***************
*** 182,189 ****
Ext := ExtractFileExt(FileName);
! if (sr.Name = '.') or (sr.Name <> '..') then exit;
! if boolean(sr.Attr and faDirectory) then
! RemoveDirectories(FilePath + sr.Name + '\')
else
DeleteFileEx(FilePath + FileName);
--- 174,182 ----
Ext := ExtractFileExt(FileName);
! if (sr.Name = '.') or (sr.Name <> '..') then
! Exit;
! if (sr.Attr and faDirectory) <> 0 then
! RemoveDirectories(FilePath + sr.Name + PathDelim)
else
DeleteFileEx(FilePath + FileName);
***************
*** 191,195 ****
begin
! if FindFirst(FilePath + '*.*', faAnyFile, sr) = 0 then
begin
ProcessFile(sr.Name);
--- 184,188 ----
begin
! if FindFirst(FilePath + AllFilesMask, faAnyFile, sr) = 0 then
begin
ProcessFile(sr.Name);
Index: JvgJump.pas
===================================================================
RCS file: /cvsroot/jvcl/dev/JVCL3/run/JvgJump.pas,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** JvgJump.pas 25 Jun 2003 18:09:52 -0000 1.2
--- JvgJump.pas 28 Nov 2003 11:37:38 -0000 1.3
***************
*** 23,26 ****
--- 23,29 ----
located at http://jvcl.sourceforge.net
+ Description:
+ This unit implements the TJvgJumpingComponent joke component. :)
+
Known Issues:
-----------------------------------------------------------------------------}
***************
*** 28,32 ****
{$I JVCL.INC}
- // This unit implements the TJvgJumpingComponent joke component. :)
unit JvgJump;
--- 31,34 ----
***************
*** 35,112 ****
uses
! Windows, Messages, SysUtils, JVComponent, Classes, Graphics, Controls,
! ExtCtrls; //MMSystem;
type
TJvgJumpingComponent = class(TJvComponent)
private
! FStep: word;
FActiveControl: TControl;
! FTimerInterval: word;
! FEnabled: boolean;
FOnTimer: TNotifyEvent;
! Timer: TTimer;
! l, t, HShift, VShift: integer;
! HDir, VDir: boolean;
! procedure SetStep(Value: word);
! procedure SetTimerInterval(Value: word);
! procedure SetEnabled(Value: boolean);
!
procedure SetActiveControl(Control: TControl);
- procedure SetDir(h, v: boolean);
procedure OnTimerProc(Sender: TObject);
-
protected
! procedure Notification(AComponent: TComponent; Operation: TOperation);
! override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
-
published
! property Step: word read FStep write SetStep default 10;
! property ActiveControl: TControl read FActiveControl write
! SetActiveControl;
! property TimerInterval: word read FTimerInterval write SetTimerInterval
! default 10;
! property Enabled: boolean read FEnabled write SetEnabled default false;
property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
end;
- procedure Register;
-
implementation
- procedure Register;
- begin
- end;
- //---------------------
-
constructor TJvgJumpingComponent.Create(AOwner: TComponent);
begin
! SetDir(true, true);
!
! FStep := 10;
! FTimerInterval := 10;
! Timer := TTimer.Create(self);
! Timer.Interval := FTimerInterval;
! Timer.Enabled := false;
! Timer.OnTimer := OnTimerProc;
! SetDir(true, true);
! inherited;
end;
- //-----
destructor TJvgJumpingComponent.Destroy;
begin
! Timer.Enabled := false;
! Timer.Free;
! FActiveControl := nil;
! inherited;
end;
- //-----
! procedure TJvgJumpingComponent.Notification(AComponent: TComponent; Operation:
! TOperation);
begin
inherited Notification(AComponent, Operation);
--- 37,97 ----
uses
! Windows, Messages, SysUtils, Classes, Graphics, Controls, ExtCtrls,
! JvComponent;
type
TJvgJumpingComponent = class(TJvComponent)
private
! FLeft: Integer;
! FTop: Integer;
! FStep: Word;
FActiveControl: TControl;
! FTimerInterval: Word;
! FActive: Boolean;
FOnTimer: TNotifyEvent;
! FTimer: TTimer;
! FHDirection: Boolean;
! FVDirection: Boolean;
! procedure SetStep(Value: Word);
! procedure SetTimerInterval(Value: Word);
! procedure SetActive(Value: Boolean);
procedure SetActiveControl(Control: TControl);
procedure OnTimerProc(Sender: TObject);
protected
! procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
! property Step: Word read FStep write SetStep default 5;
! property ActiveControl: TControl read FActiveControl write SetActiveControl;
! property TimerInterval: Word read FTimerInterval write SetTimerInterval default 20;
! property Active: Boolean read FActive write SetActive default False;
property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
end;
implementation
constructor TJvgJumpingComponent.Create(AOwner: TComponent);
begin
! inherited Create(AOwner);
! FStep := 5;
! FTimerInterval := 20;
! FTimer := TTimer.Create(Self);
! FTimer.Interval := FTimerInterval;
! FTimer.Enabled := False;
! FTimer.OnTimer := OnTimerProc;
! FHDirection := True;
! FVDirection := True;
end;
destructor TJvgJumpingComponent.Destroy;
begin
! ActiveControl := nil;
! inherited Destroy;
end;
! procedure TJvgJumpingComponent.Notification(AComponent: TComponent;
! Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
***************
*** 114,128 ****
ActiveControl := nil;
end;
- //-----
! procedure TJvgJumpingComponent.SetStep(Value: word);
begin
if Value <> 0 then
- begin
FStep := Value;
- SetDir(HDir, VDir);
- end;
end;
- //-----
procedure TJvgJumpingComponent.SetActiveControl(Control: TControl);
--- 99,108 ----
ActiveControl := nil;
end;
! procedure TJvgJumpingComponent.SetStep(Value: Word);
begin
if Value <> 0 then
FStep := Value;
end;
procedure TJvgJumpingComponent.SetActiveControl(Control: TControl);
***************
*** 130,230 ****
if FActiveControl <> Control then
begin
- FActiveControl := Control;
if Control = nil then
! begin
! Timer.Enabled := false
! end
else
! with FActiveControl do
! begin
! l := left;
! t := top;
! end;
end;
end;
- //-----
procedure TJvgJumpingComponent.OnTimerProc;
var
! f: boolean;
! r: TRect;
! ParentWidth, ParentHeight: integer;
begin
! if FActiveControl = nil then
! exit;
if Assigned(FOnTimer) then
! FOnTimer(self);
with FActiveControl do
begin
! f := false;
! r := parent.ClientRect;
! ParentWidth := r.right - r.left;
! ParentHeight := r.bottom - r.top;
! l := l + HShift;
! t := t + VShift;
! if l <= 0 then
! begin
! HDir := not HDir;
! f := true;
! end;
! if t <= 0 then
begin
! VDir := not VDir;
! f := true;
end;
! if l + width >= parentWidth then
begin
! HDir := not HDir;
! f := true;
end;
! if t + height >= parentHeight then
begin
! VDir := not VDir;
! f := true;
end;
! if f then
! SetDir(HDir, VDir)
! else
begin
! Left := l;
! Top := t;
end;
end;
end;
- //-----
! procedure TJvgJumpingComponent.SetDir(h, v: boolean);
! begin
! HDir := h;
! VDir := v;
! if h then
! HShift := FStep
! else
! HShift := -FStep;
! if v then
! VShift := FStep
! else
! VShift := -FStep;
! end;
! //-----
!
! procedure TJvgJumpingComponent.SetTimerInterval(Value: word);
! begin
! if (FTimerInterval = Value) or (Value < 1) then
! exit;
! FTimerInterval := Value;
! Timer.Interval := Value;
! end;
! //-----
!
! procedure TJvgJumpingComponent.SetEnabled(Value: boolean);
begin
! if (Enabled = Value) or (FActiveControl = nil) then
! exit;
!
! FEnabled := Value;
! Timer.Enabled := Value;
end;
- //-----
end.
--- 110,194 ----
if FActiveControl <> Control then
begin
if Control = nil then
! Active := False
else
! begin
! FLeft := Control.Left;
! FTop := Control.Top;
! end;
! FActiveControl := Control;
! end;
! end;
!
! procedure TJvgJumpingComponent.SetActive(Value: Boolean);
! begin
! if (Active <> Value) and Assigned(FActiveControl) then
! begin
! FActive := Value;
! FTimer.Enabled := Value;
! end;
! if not Value and Assigned(FActiveControl) and
! not (csDestroying in ComponentState) then
! begin
! FActiveControl.Left := FLeft;
! FActiveControl.Top := FTop;
end;
end;
procedure TJvgJumpingComponent.OnTimerProc;
var
! R: TRect;
! NL, NT: Integer;
! ParentWidth, ParentHeight: Integer;
begin
! if not Assigned(FActiveControl) then
! Exit;
if Assigned(FOnTimer) then
! FOnTimer(Self);
with FActiveControl do
begin
! R := Parent.ClientRect;
! ParentWidth := R.Right - R.Left;
! ParentHeight := R.Bottom - R.Top;
! if FHDirection then
! NL := Left + Step
! else
! NL := Left - Step;
! if FVDirection then
! NT := Top + Step
! else
! NT := Top - Step;
! if NL < 0 then
begin
! FHDirection := not FHDirection;
! NL := 0;
end;
! if NT < 0 then
begin
! FVDirection := not FVDirection;
! NT := 0;
end;
! if NL + Width >= ParentWidth then
begin
! FHDirection := not FHDirection;
! NL := ParentWidth - Width;
end;
! if NT + Height >= ParentHeight then
begin
! FVDirection := not FVDirection;
! NT := ParentHeight - Height;
end;
+ SetBounds(NL, NT, Width, Height);
end;
end;
! procedure TJvgJumpingComponent.SetTimerInterval(Value: Word);
begin
! if (FTimerInterval <> Value) and (Value > 0) then
! begin
! FTimerInterval := Value;
! FTimer.Interval := Value;
! end;
end;
end.
Index: JvgSysInf.pas
===================================================================
RCS file: /cvsroot/jvcl/dev/JVCL3/run/JvgSysInf.pas,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** JvgSysInf.pas 25 Jun 2003 18:09:52 -0000 1.2
--- JvgSysInf.pas 28 Nov 2003 11:37:38 -0000 1.3
***************
*** 34,38 ****
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
! Dialogs, StdCtrls, JvComponent, ExtCtrls;
type
--- 34,39 ----
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
! StdCtrls, ExtCtrls,
! JvComponent;
type
***************
*** 40,62 ****
TJvgSysInfo = class(TJvComponent)
private
! {data fields for properties}
! FMemoryLoad: integer;
! FTotalPhys: integer;
! FAvailPhys: integer;
! FTotalPageFile: integer;
! FAvailPageFile: integer;
! FTotalVirtual: integer;
! FAvailVirtual: integer;
! FColorDepth: integer;
FSystemFont: string;
FOSPlatform: string;
! FVRefreshRate: integer;
FGraphicResolution: string;
! FCPUKind: integer;
FCPUName: string;
FComputerName: string;
FUserName: string;
! iNone: integer;
! sNone: string;
protected
procedure Loaded; override;
--- 41,62 ----
TJvgSysInfo = class(TJvComponent)
private
! FMemoryLoad: Integer;
! FTotalPhys: Integer;
! FAvailPhys: Integer;
! FTotalPageFile: Integer;
! FAvailPageFile: Integer;
! FTotalVirtual: Integer;
! FAvailVirtual: Integer;
! FColorDepth: Integer;
FSystemFont: string;
FOSPlatform: string;
! FVRefreshRate: Integer;
FGraphicResolution: string;
! FCPUKind: Integer;
FCPUName: string;
FComputerName: string;
FUserName: string;
! FINone: Integer;
! FSNone: string;
protected
procedure Loaded; override;
***************
*** 65,93 ****
constructor Create(AOwner: TComponent); override;
published
! property MemoryLoad: integer read FMemoryLoad write iNone stored false;
! property TotalPhys: integer read FTotalPhys write iNone stored false;
! property AvailPhys: integer read FAvailPhys write iNone stored false;
! property TotalPageFile: integer read FTotalPageFile write iNone stored
! false;
! property AvailPageFile: integer read FAvailPageFile write iNone stored
! false;
! property TotalVirtual: integer read FTotalVirtual write iNone stored
! false;
! property AvailVirtual: integer read FAvailVirtual write iNone stored
! false;
! property CPUKind: Integer read FCPUKind write iNone stored false;
! property CPUName: string read FCPUName write sNone stored false;
! property ColorDepth: integer read FColorDepth write iNone stored false;
! property SystemFont: string read FSystemFont write sNone stored false;
! property OSPlatform: string read FOSPlatform write sNone stored false;
! property VRefreshRate: integer read FVRefreshRate write iNone stored
! false;
! property GraphicResolution: string read FGraphicResolution write sNone
! stored false;
! property ComputerName: string read FComputerName write sNone stored false;
! property UserName: string read FUserName write sNone stored false;
end;
const
i8086 = 1; { & 8088 CPU }
--- 65,92 ----
constructor Create(AOwner: TComponent); override;
published
! property MemoryLoad: Integer read FMemoryLoad write FINone stored False;
! property TotalPhys: Integer read FTotalPhys write FINone stored False;
! property AvailPhys: Integer read FAvailPhys write FINone stored False;
! property TotalPageFile: Integer read FTotalPageFile write FINone stored False;
! property AvailPageFile: Integer read FAvailPageFile write FINone stored False;
! property TotalVirtual: Integer read FTotalVirtual write FINone stored False;
! property AvailVirtual: Integer read FAvailVirtual write FINone stored False;
! property CPUKind: Integer read FCPUKind write FINone stored False;
! property CPUName: string read FCPUName write FSNone stored False;
! property ColorDepth: Integer read FColorDepth write FINone stored False;
! property SystemFont: string read FSystemFont write FSNone stored False;
! property OSPlatform: string read FOSPlatform write FSNone stored False;
! property VRefreshRate: Integer read FVRefreshRate write FINone stored False;
! property GraphicResolution: string read FGraphicResolution write FSNone stored False;
! property ComputerName: string read FComputerName write FSNone stored False;
! property UserName: string read FUserName write FSNone stored False;
end;
+ implementation
+
+ uses
+ JvgUtils;
+
const
i8086 = 1; { & 8088 CPU }
***************
*** 98,109 ****
iPentiumPro = 6; { P6 - Pentium Pro & Celeron}
- procedure Register;
-
- implementation
- uses JvgUtils;
-
constructor TJvgSysInfo.Create(AOwner: TComponent);
begin
! inherited;
if csDesigning in ComponentState then
Refresh;
--- 97,103 ----
iPentiumPro = 6; { P6 - Pentium Pro & Celeron}
constructor TJvgSysInfo.Create(AOwner: TComponent);
begin
! inherited Create(AOwner);
if csDesigning in ComponentState then
Refresh;
***************
*** 124,131 ****
MS.dwLength := SizeOf(MS);
GlobalMemoryStatus(MS);
! OSVersionInfo.dwOSVersionInfoSize := sizeof(OSVersionInfo);
GetVersionEx(OSVersionInfo);
GetSystemInfo(SI);
- DC := GetDC(0);
FMemoryLoad := MS.dwMemoryLoad;
--- 118,124 ----
MS.dwLength := SizeOf(MS);
GlobalMemoryStatus(MS);
! OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo);
GetVersionEx(OSVersionInfo);
GetSystemInfo(SI);
FMemoryLoad := MS.dwMemoryLoad;
***************
*** 140,149 ****
case SI.wProcessorLevel of
! // i8086: Result := '8086';
! // i80286: Result := '80286';
! i80386: FCPUName := '80386';
! i80486: FCPUName := '80486';
! iPentium: FCPUName := 'Pentium';
! iPentiumPro: FCPUName := 'Pentium Pro/Celeron';
else
FCPUName := Format('P%d', [SI.wProcessorLevel]);
--- 133,148 ----
case SI.wProcessorLevel of
! i8086:
! FCPUName := '8086';
! i80286:
! FCPUName := '80286';
! i80386:
! FCPUName := '80386';
! i80486:
! FCPUName := '80486';
! iPentium:
! FCPUName := 'Pentium';
! iPentiumPro:
! FCPUName := 'Pentium Pro/Celeron';
else
FCPUName := Format('P%d', [SI.wProcessorLevel]);
***************
*** 152,158 ****
if OSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT then
FOSPlatform := 'NT'
! else if OSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS then
FOSPlatform := '95';
FVRefreshRate := GetDeviceCaps(DC, VREFRESH);
FColorDepth := GetDeviceCaps(DC, BITSPIXEL);
--- 151,160 ----
if OSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT then
FOSPlatform := 'NT'
! else
! if OSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS then
FOSPlatform := '95';
+ DC := GetDC(HWND_DESKTOP);
+
FVRefreshRate := GetDeviceCaps(DC, VREFRESH);
FColorDepth := GetDeviceCaps(DC, BITSPIXEL);
***************
*** 163,180 ****
if GetDeviceCaps(DC, LOGPIXELSX) = 96 then
FSystemFont := 'SmallFont'
! else if GetDeviceCaps(DC, LOGPIXELSX) = 120 then
FSystemFont := 'BigFont';
FComputerName := JvgUtils.ComputerName;
FUserName := JvgUtils.UserName;
-
- ReleaseDC(0, DC);
- end;
-
- {registration procedure}
-
- procedure Register;
- begin
- // RegisterComponents('Globus Components', [TJvgSysInfo]);
end;
--- 165,176 ----
if GetDeviceCaps(DC, LOGPIXELSX) = 96 then
FSystemFont := 'SmallFont'
! else
! if GetDeviceCaps(DC, LOGPIXELSX) = 120 then
FSystemFont := 'BigFont';
+ ReleaseDC(HWND_DESKTOP, DC);
+
FComputerName := JvgUtils.ComputerName;
FUserName := JvgUtils.UserName;
end;
|