Initial
Исходный код версии 2.0
This commit is contained in:
239
sources/cdejecter_gui/data/__history/kernel.pas;55
Normal file
239
sources/cdejecter_gui/data/__history/kernel.pas;55
Normal file
@@ -0,0 +1,239 @@
|
||||
unit kernel;
|
||||
{$mode delphi}
|
||||
{$codepage UTF8}
|
||||
interface
|
||||
uses windows, shlobj, comobj, ActiveX, Classes, SysUtils, FileUtil, Forms, LazFileUtils, dynlibs, LazUTF8Classes,
|
||||
cde_types, Controls, ANBFormatString, cde_lang, ComCtrls, Menus, cde_disc_frame;
|
||||
{stdcall}
|
||||
procedure UpdateDL (var DL: TStringListUTF8); STDCALL;
|
||||
function GetDiscInfo (const ADisc: String): TDiscInfo; STDCALL;
|
||||
procedure CreateShortCut(ShortCutName, Parameters, FileName: String); STDCALL;
|
||||
procedure UpdateLanguage; stdcall;
|
||||
procedure CreateDriveRec (const ADiscIndex: Byte); STDCALL;
|
||||
function FormatStrUDI (const AStr: String; const ADiscInfo: TDiscInfo): String; STDCALL;
|
||||
procedure EjectDrive (const ADrive: WideChar); STDCALL;
|
||||
function GetFrame: Tcde_disc_frm; STDCALL;
|
||||
procedure ShowSettings (const APageIndx: Integer = 0); STDCALL;
|
||||
implementation
|
||||
uses cde_MainForm, cde_SettingsForm, cde_AboutForm;
|
||||
procedure UpdateDL (var DL: TStringListUTF8);
|
||||
var DLL: TLibHandle;
|
||||
GetCDDiscs: function: PChar;
|
||||
begin
|
||||
DL.Clear;
|
||||
DLL:= SafeLoadLibrary(CDELib);
|
||||
GetCDDiscs:= GetProcAddress(DLL, 'GetCDDiscs');
|
||||
DL.Delimiter:= ';';
|
||||
DL.DelimitedText:= GetCDDiscs;
|
||||
FreeLibrary(DLL);
|
||||
end;
|
||||
function GetDiscInfo (const ADisc: String): TDiscInfo;
|
||||
var DLL: TLibHandle;
|
||||
GetVolumeInfo: function (const ADisc: WideChar): TDiscInfo;
|
||||
begin
|
||||
DLL:= SafeLoadLibrary(CDELib);
|
||||
GetVolumeInfo:= GetProcAddress(DLL, 'GetVolumeInfo');
|
||||
Result:= GetVolumeInfo(WideChar(ADisc[1]));
|
||||
FreeLibrary(DLL);
|
||||
end;
|
||||
procedure CreateShortCut(ShortCutName, Parameters, FileName: String);
|
||||
var ShellObject: IUnknown;
|
||||
ShellLink: IShellLink;
|
||||
PersistFile: IPersistFile;
|
||||
FName: WideString;
|
||||
begin
|
||||
ShellObject:= CreateComObject(CLSID_ShellLink);
|
||||
ShellLink:= ShellObject as IShellLink;
|
||||
PersistFile:= ShellObject as IPersistFile;
|
||||
with ShellLink do
|
||||
begin
|
||||
SetArguments(PChar(Parameters));
|
||||
SetPath(PChar(FileName));
|
||||
SetWorkingDirectory(PChar(extractfilepath(FileName)));
|
||||
FName:= ShortCutName;
|
||||
PersistFile.Save(PWChar(FName), False);
|
||||
end;
|
||||
end;
|
||||
procedure UpdateLanguage;
|
||||
begin
|
||||
Application.Title:= GetLocalizedString(cdeg_app_title);
|
||||
with cde_Main do
|
||||
begin
|
||||
Caption:= Application.Title;
|
||||
NoDiscFound.Caption:= GetLocalizedString(cdeg_mainfrm_nodiscsfound);
|
||||
//DriveListLbl.Caption:= GetLocalStrA(1);
|
||||
//UpdateListBtn.Caption:= GetLocalStrA(2);
|
||||
//EjectNowBtn.Caption:= GetLocalStrA(3);
|
||||
//CreateLinkForEjectBtn.Caption:= GetLocalStrA(4);
|
||||
//LNGFile:= GetCDEPath + 'language\' + GetLanguage + '.lng';
|
||||
//LanguageNameLbl.Caption:= Format(GetLocalStrA(5), [INIReadString('lng_about', 'lng_name', 'default', LNGFile)]);
|
||||
//LanguageTranslatorLbl.Caption:= Format(GetLocalStrA(6), [INIReadString('lng_about', 'lng_author', 'Alexander Babaev', LNGFile)]);
|
||||
//LanguageVersionLbl.Caption:= Format(GetLocalStrA(7), [INIReadString('lng_about', 'lng_vers', '1.0', LNGFile)]);
|
||||
//ChangeLanguageBtn.Caption:= '&' + GetLocalStrA(8);
|
||||
//HomePageBtn.Caption:= GetLocalStrA(10);
|
||||
//LanguageBox.Caption:= GetLocalStrA(23);
|
||||
end;
|
||||
end;
|
||||
procedure CreateDriveRec (const ADiscIndex: Byte);
|
||||
var DiscFrame: Tcde_disc_frm;
|
||||
Tab: TTabSheet;
|
||||
MItem: TMenuItem;
|
||||
DI: TDiscInfo;
|
||||
VDrive: WideChar;
|
||||
begin
|
||||
VDrive:= cde_Main.DiscList[ADiscIndex][1];
|
||||
DI:= GetDiscInfo(VDrive);
|
||||
Tab:= cde_Main.DiscPages.AddTabSheet;
|
||||
Tab.Caption:= FormatStrUDI(GetLocalizedString(cdeg_mainfrm_discmenuitem), DI);
|
||||
Tab.Tag:= ADiscIndex;
|
||||
Tab.ImageIndex:= 4;
|
||||
MItem:= TMenuItem.Create(cde_Main.MainMenu);
|
||||
MItem.Caption:= FormatStrUDI(GetLocalizedString(cdeg_mainfrm_discmenuitem), DI);
|
||||
MItem.Tag:= ADiscIndex;
|
||||
MItem.OnClick:= cde_Main.DiscsMenuClick;
|
||||
MItem.ImageIndex:= 4;
|
||||
cde_Main.MainMenu.Items.Items[0].Add(MItem);
|
||||
DiscFrame:= Tcde_disc_frm.Create(cde_Main);
|
||||
with DiscFrame do
|
||||
begin
|
||||
Parent:= Tab;
|
||||
Align:= alClient;
|
||||
Drive:= VDrive;
|
||||
Tag:= ADiscIndex;
|
||||
Name:= 'di' + IntToStr(ADiscIndex);
|
||||
UpdateDriveInfo;
|
||||
end;
|
||||
end;
|
||||
function FormatStrUDI (const AStr: String; const ADiscInfo: TDiscInfo): String;
|
||||
begin
|
||||
Result:= FormatStr(AStr, [
|
||||
'$letter$',
|
||||
'$volumename$',
|
||||
'$filesystrem$',
|
||||
'$serial$'
|
||||
],
|
||||
[
|
||||
ADiscInfo.diDrive,
|
||||
ADiscInfo.diVolumeName,
|
||||
ADiscInfo.diFileSystem,
|
||||
IntToStr(ADiscInfo.diSerial)
|
||||
]
|
||||
);
|
||||
end;
|
||||
procedure EjectDrive (const ADrive: WideChar);
|
||||
var DLL: TLibHandle;
|
||||
EjectCD: function (const ADisc: WideChar): Boolean;
|
||||
begin
|
||||
DLL:= SafeLoadLibrary(CDELib);
|
||||
EjectCD:= GetProcAddress(DLL, 'EjectCD');
|
||||
EjectCD(ADrive);
|
||||
FreeLibrary(DLL);
|
||||
end;
|
||||
function GetFrame: Tcde_disc_frm;
|
||||
var Indx: Byte;
|
||||
Frame: Tcde_disc_frm;
|
||||
begin
|
||||
if not cde_Main.DiscPages.Visible then
|
||||
Abort;
|
||||
Indx:= cde_Main.DiscPages.ActivePage.Tag;
|
||||
Frame:= (cde_Main.FindComponent('di' + IntToStr(Indx))) as Tcde_disc_frm;
|
||||
Result:= Frame;
|
||||
end;
|
||||
procedure ShowSettings (const APageIndx: Integer = 0);
|
||||
var SettingsFrm: Tcde_Settings;
|
||||
Node: TTreeNode;
|
||||
begin
|
||||
SettingsFrm:= Tcde_Settings.Create(cde_Main);
|
||||
with SettingsFrm do
|
||||
begin
|
||||
Node:= SettingsTree.Items.Item[APageIndx];
|
||||
SettingsTree.Select([Node]);
|
||||
ShowModal;
|
||||
Free;
|
||||
end;
|
||||
end;
|
||||
function FormatAboutText (const AText: string): string;
|
||||
var LCLPlatformDisplayNames: array[TLCLPlatform] of string = ('gtk (deprecated)', 'gtk 2', 'gtk 3', 'win32/win64', 'wince', 'carbon', 'qt', 'fpGUI (alpha)', 'NoGUI', 'cocoa (alpha)', 'customdraw (alpha)');
|
||||
BuildLCLWidgetType: TLCLPlatform =
|
||||
{$IFDEF MSWindows}{$DEFINE WidgetSetDefined}
|
||||
lpWin32;
|
||||
{$ENDIF}
|
||||
{$IFDEF darwin}{$DEFINE WidgetSetDefined}
|
||||
lpCarbon;
|
||||
{$ENDIF}
|
||||
{$IFNDEF WidgetSetDefined}
|
||||
lpGtk2;
|
||||
{$ENDIF}
|
||||
Bits: String;
|
||||
function GetDefaultTargetOS: string;
|
||||
begin
|
||||
{$IFDEF FPC}
|
||||
Result:=lowerCase({$I %FPCTARGETOS%});
|
||||
{$ENDIF}
|
||||
end;
|
||||
function GetDefaultTargetCPU: string;
|
||||
begin
|
||||
{$IFDEF FPC}
|
||||
Result:=lowerCase({$I %FPCTARGETCPU%});
|
||||
{$ENDIF}
|
||||
end;
|
||||
function GetCompiler: string;
|
||||
begin
|
||||
{$IFDEF FPC}
|
||||
Result:= 'Lazarus';
|
||||
{$ELSE}
|
||||
Result:= 'Delphi';
|
||||
{$ENDIF}
|
||||
end;
|
||||
function GetCompilerVersion: string;
|
||||
begin
|
||||
{$IFDEF FPC}
|
||||
{$IF declared(lcl_version)}
|
||||
Result:= lcl_version;
|
||||
{$ELSE}
|
||||
Result:= '0.0.0.0';
|
||||
{$ENDIF}
|
||||
{$ELSE}
|
||||
Result:= FloatToStr(CompilerVersion);
|
||||
{$ENDIF}
|
||||
end;
|
||||
function GetDefaultLCLWidgetType: TLCLPlatform;
|
||||
begin
|
||||
{$IFDEF FPC}
|
||||
if (WidgetSet<>nil) and (WidgetSet.LCLPlatform<>lpNoGUI) then
|
||||
Result:= WidgetSet.LCLPlatform
|
||||
else
|
||||
Result:= BuildLCLWidgetType;
|
||||
{$ENDIF}
|
||||
end;
|
||||
begin
|
||||
case GetBuildPlatform of
|
||||
ospUnknown: Bits:= '?';
|
||||
ospWin32: Bits:= 'x32';
|
||||
ospWin64: Bits:= 'x64';
|
||||
end;
|
||||
Result:= FormatStr(
|
||||
AText,
|
||||
['$newline$', '$programname$', '$programversion$', '$copyright_anb$', '$copyright_a.babaev$', '$copyright_greex$', '$YEAR$', '$compiler$', '$compversion$', '$compparams$', '$platform$', '$builddate$'],
|
||||
[#13#10, GetLocalizedString(sfp_app_title_full), GetPreviewerVersionSTR, 'ANB Soft Team', 'Alexander Babaev', 'GreeX', '2017', GetCompiler, GetCompilerVersion, GetDefaultTargetCPU + '-' + GetDefaultTargetOS + '-' + LCLPlatformDisplayNames[GetDefaultLCLWidgetType], Bits, BuildAt]
|
||||
);
|
||||
end;
|
||||
procedure ShowAboutInfo;
|
||||
var AboutFrm: TAboutFrm;
|
||||
begin
|
||||
AboutFrm:= TAboutFrm.Create(MainFrm);
|
||||
with AboutFrm do
|
||||
begin
|
||||
Caption:= GetLocalizedString(sfp_about_title);
|
||||
VersionLbl.Caption:= FormatAboutText(GetLocalizedString(sfp_about_version));
|
||||
BuildDateLbl.Caption:= FormatAboutText(GetLocalizedString(sfp_about_buildat));
|
||||
PlatformLbl.Caption:= FormatAboutText(GetLocalizedString(sfp_about_platform));
|
||||
CopyrightsLbl.Caption:= FormatAboutText(GetLocalizedString(sfp_about_copyrights));
|
||||
LogoCopyLbl.Caption:= FormatAboutText(GetLocalizedString(sfp_about_logocopy));
|
||||
BuildAtLbl.Caption:= FormatAboutText(GetLocalizedString(sfp_about_compilerinfo));
|
||||
UsedTechnologyLbl.Caption:= FormatAboutText(GetLocalizedString(sfp_about_usedtechno));
|
||||
ShowModal;
|
||||
Free;
|
||||
end;
|
||||
end;
|
||||
end.
|
||||
Reference in New Issue
Block a user