-
Notifications
You must be signed in to change notification settings - Fork 3
/
Main.pas
132 lines (111 loc) · 3.48 KB
/
Main.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls, ComCtrls, Menus, ImgList,
CmdTabSheet;
type
TfrmCmdRunner = class(TForm)
pnlTop: TPanel;
PageControl1: TPageControl;
btnClose: TBitBtn;
StatusBar1: TStatusBar;
ImageList1: TImageList;
PopupMenu1: TPopupMenu;
Deneme1: TMenuItem;
MyDocuments1: TMenuItem;
btnOpen: TButton;
AppData1: TMenuItem;
Windows1: TMenuItem;
System1: TMenuItem;
N1: TMenuItem;
SelectFolder1: TMenuItem;
ProgramFles1: TMenuItem;
FileOpenDialog1: TFileOpenDialog;
clrBackground: TColorBox;
Label1: TLabel;
Label2: TLabel;
clrForeground: TColorBox;
procedure FormCreate(Sender: TObject);
procedure btnCloseClick(Sender: TObject);
procedure btnOpenClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure btnOpenMenuClick(Sender: TObject);
procedure SelectFolder1Click(Sender: TObject);
private
{ Private declarations }
procedure ShowBtnHint(Sender: TObject);
procedure WMExitSizeMove(var Msg: TMessage); message WM_EXITSIZEMOVE;
procedure WMSize(var Msg: TWMSize); message WM_SIZE;
public
{ Public declarations }
end;
var
frmCmdRunner: TfrmCmdRunner;
implementation
uses SHFolder;
{$R *.dfm}
function GetSpecialFolderPath(FolderId: Integer): string;
var
aPath: array[0..MAX_PATH] of Char;
begin
SHGetFolderPath(0, FolderId, 0, 0, aPath);
Result := aPath;
end;
procedure TfrmCmdRunner.FormCreate(Sender: TObject);
var
I: Integer;
begin
Application.OnHint := ShowBtnHint;
ShowHint := True;
for I := Low(COLORS) to High(COLORS) do
begin
clrBackground.AddItem('', TObject(StrToInt(COLORS[I][0])));
clrForeground.AddItem('', TObject(StrToInt(COLORS[I][0])));
end;
clrBackground.ItemIndex := Low(COLORS);
clrForeground.ItemIndex := High(COLORS);
end;
procedure TfrmCmdRunner.btnCloseClick(Sender: TObject);
begin
if PageControl1.ActivePage <> nil then
TCmdTabSheet(PageControl1.ActivePage).Destroy;
end;
procedure TfrmCmdRunner.btnOpenClick(Sender: TObject);
begin
TCmdTabSheet.Create(PageControl1, clrForeground.ItemIndex, clrBackground.ItemIndex);
end;
procedure TfrmCmdRunner.btnOpenMenuClick(Sender: TObject);
begin
TCmdTabSheet.Create(PageControl1, clrForeground.ItemIndex, clrBackground.ItemIndex, GetSpecialFolderPath(TMenuItem(Sender).Tag));
end;
procedure TfrmCmdRunner.FormClose(Sender: TObject; var Action: TCloseAction);
var
I: Integer;
begin
for I := PageControl1.PageCount-1 downto 0 do
TCmdTabSheet(PageControl1.Pages[I]).Destroy
end;
procedure TfrmCmdRunner.SelectFolder1Click(Sender: TObject);
begin
if FileOpenDialog1.Execute then
TCmdTabSheet.Create(PageControl1, clrForeground.ItemIndex, clrBackground.ItemIndex, FileOpenDialog1.FileName);
end;
procedure TfrmCmdRunner.ShowBtnHint(Sender: TObject);
begin
StatusBar1.SimpleText := Application.Hint;
end;
procedure TfrmCmdRunner.WMExitSizeMove(var Msg: TMessage);
begin
Inherited;
if PageControl1.ActivePage <> nil then
TCmdTabSheet(PageControl1.ActivePage).SetForegroundConsole;
end;
procedure TfrmCmdRunner.WMSize(var Msg: TWMSize);
begin
Inherited;
if (Msg.SizeType = SIZE_MAXIMIZED) {or (Msg.SizeType = SIZE_RESTORED)} then { TODO : RESTORED durumuna bir çözüm bulunmalý }
if (PageControl1 <> nil) and (PageControl1.ActivePage <> nil) then
TCmdTabSheet(PageControl1.ActivePage).SetForegroundConsole;
end;
end.