📄 pubfuns.pas
字号:
HeightToWidthRate := Bitmap.Height / Bitmap.Width;
WidthToHeightRate := Bitmap.Width / Bitmap.Height;
case FitType of
ftFitWidth: begin
Width := ParentControl.Width - ImageMarginWidth;
if ((WidthToHeightRate > 1) and (Bitmap.Height >= Bitmap.Width)) or
((WidthToHeightRate < 1) and (Bitmap.Width > Bitmap.Height))then
Height := Round(Width * WidthToHeightRate)
else
Height := Round(Width / WidthToHeightRate);
end;
ftFitHeight: begin
Height := ParentControl.Height - ImageMarginWidth;
if ((HeightToWidthRate > 1) and (Bitmap.Height >= Bitmap.Width)) or
((HeightToWidthRate < 1) and (Bitmap.Width > Bitmap.Height))then
Width := Round(Height / HeightToWidthRate)
else
Width := Round(Height * HeightToWidthRate);
end;
ftAutoFit: begin
if WidthRate > HeightRate then
begin
Width := ParentControl.Width - ImageMarginWidth;
if ((WidthToHeightRate > 1) and (Bitmap.Height >= Bitmap.Width)) or
((WidthToHeightRate < 1) and (Bitmap.Width > Bitmap.Height))then
Height := Round(Width * WidthToHeightRate)
else
Height := Round(Width / WidthToHeightRate);
end
else
begin
Height := ParentControl.Height - ImageMarginWidth;
if ((HeightToWidthRate > 1) and (Bitmap.Height >= Bitmap.Width)) or
((HeightToWidthRate < 1) and (Bitmap.Width > Bitmap.Height))then
Width := Round(Height / HeightToWidthRate)
else
Width := Round(Height * HeightToWidthRate);
end;
end;
end;
AlignCenter(ParentControl, AImage);
ScaleMode := smStretch;
end;
end;
{-----------------------------------------------------------------------------
Procedure: DrawFile
Purpose: DrawFile
Arguments: ParentControl: TPanel;
AImage: TImage32;
FolderImage: TImage;
pListItemObj: PListItemObj
Result: None
Author: Cyclone
History: 2004-7-21 23:34:58
-----------------------------------------------------------------------------}
function DrawFile(ParentControl: TPanel; AImage: TImage32; FolderImage, WarningImage: TImage;
pListItemObj: PListItemObj): Boolean;
var
IconHandle: HICON;
TempFileName,
FullFileName,
GraphicFileExts: String;
DrawText: String;
OriginalCursor: TCursor;
begin
Result := True;
AImage.Visible := False;
if pListItemObj^.ItemType = itCategory then
begin
ClearImage(ParentControl, AImage);
AImage.Bitmap.Canvas.Draw(16, 16, FolderImage.Picture.Graphic);
AImage.Bitmap.Canvas.Brush.Color := ParentControl.Color;
AImage.Bitmap.Canvas.Font.Color := clWindowText;
AImage.Bitmap.Canvas.TextOut(16, 48, 'Category');
end
else if pListItemObj^.ItemType = itDocument then
begin
FullFileName := pRootPath + pListItemObj^.FileName;
if not FileExists(FullFileName) then
begin
ClearImage(ParentControl, AImage);
AImage.Bitmap.Canvas.Draw(16, 16, WarningImage.Picture.Graphic);
AImage.Bitmap.Canvas.Brush.Color := ParentControl.Color;
AImage.Bitmap.Canvas.Font.Color := clRed;
AImage.Bitmap.Canvas.TextOut(16, 48, 'File Lost');
Result := False;
end
else
begin
OriginalCursor := Screen.Cursor;
Screen.Cursor := crHourGlass;
try
TempFileName := GetSystemTempFileName(GetSystemTempPath, 'Cyc', 10);
TempFileName := ChangeFileExt(TempFileName, pListItemObj^.OriginalExtName);
GraphicFileExts := GraphicFilter(TGraphic);
if Pos(UpperCase(pListItemObj^.OriginalExtName), UpperCase(GraphicFileExts)) > 0 then
begin
DecryptFile(FullFileName, TempFileName, PubFuns.PasswordKey);
try
AImage.Bitmap.LoadFromFile(TempFileName);
AImage.Width := AImage.Bitmap.Width;
AImage.Height := AImage.Bitmap.Height;
AlignCenter(ParentControl, AImage);
finally
DeleteFile(TempFileName);
end;
end
else
begin
CopyFile(PChar(FullFileName), PChar(TempFileName), False);
try
IconHandle := GetFileIcon(TempFileName, False);
finally
DeleteFile(TempFileName);
end;
ClearImage(ParentControl, AImage);
DrawIcon(AImage.Bitmap.Canvas.Handle, 16, 16, IconHandle);
DrawText := UpperCase(pListItemObj^.OriginalExtName);
DrawText := Copy(DrawText, 2, Length(DrawText)) + ' Files';
AImage.Bitmap.Canvas.Brush.Color := ParentControl.Color;
AImage.Bitmap.Canvas.Font.Color := clWindowText;
AImage.Bitmap.Canvas.TextOut(10, 48, DrawText);
end;
finally
Screen.Cursor := OriginalCursor;
end;
end;
end;
AImage.Visible := True;
end;
{-----------------------------------------------------------------------------
Procedure: DrawItem
Purpose: DrawItem
Arguments: ListView: TCustomListView; const ARect: TRect; pListItemObj: PListItemObj
Result: None
Author: Cyclone
Date: 2005-3-11 13:08:48
-----------------------------------------------------------------------------}
procedure DrawItem(ListView: TCustomListView; const ARect: TRect; pListItemObj: PListItemObj);
var
AImage: TImage;
IconHandle: HICON;
TempFileName,
FullFileName,
GraphicFileExts: String;
OriginalCursor: TCursor;
begin
if pListItemObj^.ItemType = itDocument then
begin
FullFileName := pRootPath + pListItemObj^.FileName;
if not FileExists(FullFileName) then
begin
ShowError('Cannot find file: ' + FullFileName + PubFuns.CRLF);
Exit;
end;
OriginalCursor := Screen.Cursor;
Screen.Cursor := crHourGlass;
AImage := TImage.Create(nil);
try
TempFileName := GetSystemTempFileName(GetSystemTempPath, 'Cyc', 10);
TempFileName := ChangeFileExt(TempFileName, pListItemObj^.OriginalExtName);
GraphicFileExts := GraphicFilter(TGraphic);
if Pos(UpperCase(pListItemObj^.OriginalExtName), UpperCase(GraphicFileExts)) > 0 then
begin
DecryptFile(FullFileName, TempFileName, PubFuns.PasswordKey);
try
AImage.Picture.LoadFromFile(TempFileName);
finally
DeleteFile(TempFileName);
end;
end
else
begin
CopyFile(PChar(FullFileName), PChar(TempFileName), False);
try
IconHandle := GetFileIcon(TempFileName, False);
AImage.Picture.Icon.Handle := IconHandle;
finally
DeleteFile(TempFileName);
end;
end;
ListView.Canvas.StretchDraw(ARect, AImage.Picture.Graphic);
finally
AImage.Free;
Screen.Cursor := OriginalCursor;
end;
end;
end;
{-----------------------------------------------------------------------------
Procedure: IsImage
Purpose: Check A List Item Is A Image
Arguments: const AListItem: TListItem
Result: Boolean
Author: Cyclone
History: 2004-11-28 22:55:58
-----------------------------------------------------------------------------}
function IsImage(const AListItem: TListItem): Boolean;
begin
Result := Pos(UpperCase(PListItemObj(AListItem.Data)^.OriginalExtName), UpperCase(GraphicFilter(TGraphic))) > 0;
end;
{-----------------------------------------------------------------------------
Procedure: DeleteHistoryFiles
Purpose: Delete History Files
Arguments: FileList: TStringList
Result: None
Author: Cyclone
History: 2004-11-29 22:12:38
-----------------------------------------------------------------------------}
procedure DeleteHistoryFiles(FileList: TStringList);
var
i: Integer;
begin
if FileList = nil then
Exit;
with FileList do
begin
for i := Count - 1 downto 0 do
begin
if FileExists(FileList.Strings[i]) then
begin
if DeleteFile(FileList.Strings[i]) then
Delete(i);
end;
end;
end;
end;
{-----------------------------------------------------------------------------
Procedure: IsDirectory
Purpose: Is Directory
Arguments: SearchRec: TSearchRec
Result: Boolean
Author: Cyclone
History: 2004-12-1 22:09:40
-----------------------------------------------------------------------------}
function IsDirectory(SearchRec: TSearchRec): Boolean;
begin
Result := (SearchRec.Attr and faDirectory = faDirectory) and (SearchRec.Name<>'.') and (SearchRec.Name<>'..');
end;
{-----------------------------------------------------------------------------
Procedure: SearchFiles
Purpose: Search Files
Arguments: Directory,
Wildcard: String;
FileList: TStringList;
IncludeSubDirectory: Boolean
Result: None
Author: Cyclone
History: 2004-12-1 22:09:56
-----------------------------------------------------------------------------}
procedure SearchFiles(const Directory, Wildcard: String; var FileList: TStringList;
const IncludeSubDirectory: Boolean = False);
var
sCurrentDirectory: String;
SearchRecord: TSearchRec;
SubDirectory: TStrings;
i: Integer;
iStatus: Integer;
begin
sCurrentDirectory := Trim(Directory);
if Copy(sCurrentDirectory, Length(sCurrentDirectory), 1) <> '\' then
sCurrentDirectory := sCurrentDirectory + '\';
iStatus := FindFirst(sCurrentDirectory + Wildcard, faAnyFile - faHidden - faSysFile, SearchRecord);
try
while iStatus = 0 do
begin
if (SearchRecord.Attr and faDirectory <> faDirectory) then
FileList.Add(sCurrentDirectory + SearchRecord.Name);
iStatus := FindNext(SearchRecord);
end;
finally
FindClose(SearchRecord);
end;
if IncludeSubDirectory then
begin
SubDirectory := TStringList.Create;
try
iStatus := FindFirst(sCurrentDirectory + '*.*', faDirectory, SearchRecord);
try
while iStatus = 0 do
begin
if IsDirectory(SearchRecord) then
SubDirectory.Add(SearchRecord.Name);
iStatus := FindNext(SearchRecord);
end;
finally
FindClose(SearchRecord);
end;
for i := 0 to SubDirectory.Count - 1 do
begin
SearchFiles(sCurrentDirectory + SubDirectory.Strings[i], Wildcard, FileList, IncludeSubDirectory);
end;
finally
SubDirectory.Free;
end;
end;
end;
{-----------------------------------------------------------------------------
Procedure: GetFileExtension
Purpose: Get File Extension
Arguments: FileName: String
Result: String
Author: Cyclone
History: 2004-12-7 22:11:38
-----------------------------------------------------------------------------}
function GetFileExtension(FileName: String): String;
begin
Result := UpperCase(ExtractFileExt(Trim(FileName)));
end;
{-----------------------------------------------------------------------------
Procedure: ConvertToCYCFile
Purpose: ConvertToCYCFile
Arguments: const srcFileName, DestFileName: String
Result: Boolean
Author: Cyclone
History: 2004-12-7 22:27:23
-----------------------------------------------------------------------------}
function ConvertToCYCFile(const srcFileName, DestFileName: String): Boolean;
begin
Result := False;
if not FileExists(srcFileName) then
begin
ShowError('Source file: ' + srcFileName + ' not exists!');
Exit;
end;
if GetFileExtension(DestFileName) <> '.CYC' then
begin
ShowError('The extension of destination file must be ''.CYC''!');
Exit;
end;
if GetFileExtension(srcFileName) = '.CYC' then
CopyFile(PChar(srcFileName), PChar(DestFileName), False)
else
EncryptFile(srcFileName, DestFileName, PasswordKey);
if not FileExists(DestFileName) then
begin
ShowError('Convert file: ' + DestFileName + ' error!');
Exit;
end;
Result := True;
end;
{-----------------------------------------------------------------------------
Procedure: AutoStartWhenOsStart
Purpose: AutoStartWhenOsStart
Arguments: const KeyName: String;
const IsAutoStart: Boolean
Result: None
Author: Cyclone
History: 2004-12-23 21:51:02
-----------------------------------------------------------------------------}
procedure AutoStartWhenOsStart(const KeyName: String; const IsAutoStart: Boolean);
var
Reg: TRegistry;
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_CURRENT_USER;
if Reg.OpenKey('\Software\Microsoft\Windows\CurrentVersion\RunOnce', True) then
begin
if IsAutoStart then
Reg.WriteString(KeyName, ParamStr(0))
else
Reg.DeleteValue(KeyName);
end;
finally
Reg.CloseKey;
Reg.Free;
end;
end;
{-----------------------------------------------------------------------------
Procedure: PadLeft
Purpose: Pad Left
Arguments: const SouceStr, PadStr: String; const Length: Integer
Result: String
Author: Cyclone
History: 2004-12-23 22:18:48
-----------------------------------------------------------------------------}
function PadLeft(const SouceStr, PadStr: String; const Length: Integer): String;
begin
Result := SouceStr;
while System.Length(Result) < Length do
Result := PadStr + Result;
end;
{-----------------------------------------------------------------------------
Procedure: PadRight
Purpose: PadRight
Arguments: const SouceStr, PadStr: String; const Length: Integer
Result: String
Author: Cyclone
History: 2004-12-23 23:45:17
-----------------------------------------------------------------------------}
function PadRight(const SouceStr, PadStr: String; const Length: Integer): String;
begin
Result := SouceStr;
while System.Length(Result) < Length do
Result := Result + PadStr;
end;
{-----------------------------------------------------------------------------
Procedure: ReadConnectionInformation
Purpose: Read Connection Information
Arguments: None
Result: None
Author: Cyclone
Date: 2005-3-19 16:43:58
-----------------------------------------------------------------------------}
procedure ReadConnectionInformation;
var
ConfigFile: TIniFile;
begin
if not FileExists(pIniFileName) then
begin
ConfigFile := TIniFile.Create(pIniFileName);
try
ConfigFile.WriteInteger('Connection', 'DatabaseType', Ord(pDatabaseType));
ConfigFile.WriteString('Connection', 'DBServerName', pDBServerName);
ConfigFile.WriteString('Connection', 'DBName', pDBName);
ConfigFile.WriteString('Connection', 'DBUserName', pDBUserName);
ConfigFile.WriteString('Connection', 'DBPassword', pDBPassword);
ConfigFile.WriteString('Connection', 'AccessFileName', pAccessFileName);
finally
ConfigFile.Free;
end;
end;
ConfigFile := TIniFile.Create(pIniFileName);
try
pDatabaseType := TDatabaseType(ConfigFile.ReadInteger('Connection', 'DatabaseType', Ord(dtAccess)));
pDBServerName := ConfigFile.ReadString('Connection', 'DBServerName', '');
pDBName := ConfigFile.ReadString('Connection', 'DBName', '');
pDBUserName := ConfigFile.ReadString('Connection', 'DBUserName', '');
pDBPassword := ConfigFile.ReadString('Connection', 'DBPassword', '');
pAccessFileName := ConfigFile.ReadString('Connection', 'AccessFileName', pAccessFileName);
finally
ConfigFile.Free;
end;
end;
initialization
pSystemName := 'ePdm System';
pSystemVersion := 'V1.0.0.0';
pCompanyWebSite := 'http://Constructing...';
pCompanyEmail := 'cyclonehuang@126.com';
pSysUserId := 'TESTUSER';
pIniFileName := ExtractFileDir(ParamStr(0)) + '\Config.INI';
pAccessFileName := ExtractFileDir(ParamStr(0)) + '\ePdm.mdb';
Application.Title := pSystemName + ' ' + pSystemVersion;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -