unit uMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Buttons, ComObj, ShellCtrls, ShellApi, ShlObj,
ActiveX, StdCtrls,
StrUtils, ExtCtrls, Menus, ComCtrls, IniFiles, JPEG, GlassButton, ImgList,
tlhelp32, PsApi;
type
TMonitor = Record
Num : Integer;
Primary : Boolean;
Left : Integer;
Top : Integer;
Width : Integer;
Height : Integer;
AreaLeft : Integer;
AreaRight : Integer;
AreaTop : Integer;
AreaBottom : Integer;
end;
type
TfrmMain = class(TForm)
BorderPanel: TPanel;
Label1: TLabel;
GlassButton1: TGlassButton;
Image1: TImage;
Image2: TImage;
Label2: TLabel;
GlassButton2: TGlassButton;
PopupMenu1: TPopupMenu;
Einstellungen: TMenuItem;
Image3: TImage;
GlassButton3: TGlassButton;
Image4: TImage;
GlassButton4: TGlassButton;
Image5: TImage;
GlassButton5: TGlassButton;
Image6: TImage;
GlassButton6: TGlassButton;
Image7: TImage;
GlassButton7: TGlassButton;
Image8: TImage;
GlassButton8: TGlassButton;
Image9: TImage;
GlassButton9: TGlassButton;
Image10: TImage;
GlassButton10: TGlassButton;
Image11: TImage;
GlassButton11: TGlassButton;
Image12: TImage;
GlassButton12: TGlassButton;
Image222: TImage;
Image234: TImage;
Image215: TImage;
Image216: TImage;
Image217: TImage;
Image218: TImage;
Image219: TImage;
Image220: TImage;
Image221: TImage;
Label3: TLabel;
Image13: TImage;
Image223: TImage;
GlassButton13: TGlassButton;
Label4: TLabel;
Label6: TLabel;
Label8: TLabel;
Image14: TImage;
Image225: TImage;
GlassButton14: TGlassButton;
img_B: TImage;
img_G: TImage;
img_Y: TImage;
img_R: TImage;
img_S: TImage;
Image15: TImage;
Image226: TImage;
GlassButton15: TGlassButton;
StartTimer: TTimer;
Image16: TImage;
GlassButton16: TGlassButton;
Image227: TImage;
procedure FormCreate(Sender: TObject);
procedure CreateAppBar(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure SaveIni;
procedure DeleteIni;
procedure GetMonitors(Sender: TObject);
procedure GlassButton1MouseEnter(Sender: TObject);
procedure GlassButton1MouseLeave(Sender: TObject);
procedure GlassButton1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure GlassButton1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure EinstellungenClick(Sender: TObject);
procedure ChangeBtnColor;
procedure StartTimerTimer(Sender: TObject);
procedure FormClick(Sender: TObject);
private
{ Private declarations }
fAppBarData: _AppBarData;
Btn : array of TGlassButton;
Img : array of TImage;
MoveObject : TObject;
DownObject : TObject;
FdownObject : TObject; // Sender-Object, OnDown
FmoveObject : TObject; // Sender-Object, OnMove
FenterObject : TObject; // Sender-Object, OnEnter
FleaveObject : TObject; // Sender-Object, OnLeave
FUpObject : TObject; // Sender-Object, OnUp
procedure Helligkeit(const Bitmap: TBitmap; const Faktor: Double);
procedure OnBtnMouseEnter;
procedure OnBtnMouseLeave;
procedure OnBtnMouseDown;
procedure OnBtnMouseUp;
public
{ Public declarations }
ProgDir, WinDir, SysDir : String; // System- und Programmverzeichnisse
AppDir, ComAppDir, LocAppDir : String; // Anwendungsdaten-Verzeichnisse
ImageDir : String; // Bild-Verzeichnis
FolderPicDir : String; // Bild-Verzeichnis für Order Bilder
IniStatus : Integer; // Ini-Datei-Status, vorhanden, Ort
IniFolder : String; // Verzeichnis für Ini-Datei
IniName : String; // name der Ini-Datei, festgelegt im Ereignis Form.OnCreate
fDelete : Boolean; // Status zum Löschen der Ini-Datei
Mon_Position : Integer; // auf [Mon_Position-]Monitor starten
MonCount : Integer; // NumBtn Monitore
Mon : array of TMonitor; // Array Monitore
pTime_1, pTime_2, pTime_3 : Integer; // konfigurierbare Werte für Delay
BarColor : TColor; // FarbWert für AppBar-HG
BarAlpha : Integer; // AlphaBlendValue
Bar_Size : Integer; // Width / Height der AppBar
App_Position : Integer; // Position der AppBar : 0= Rechts, 1= Oben, 2= Links, 3= Unten
Bar_R, Bar_G, Bar_B : Byte; // Farbwerte der AppBar
btn_Dir : array[3..31] of String; // Pfad-Array
Start_Type : array[3..31] of Integer; // Start-Typ der Anwendung
Auto_Start : array[3..31] of Boolean; // AutoStart Array
NumAutoStart : Integer; // NumBtn der AutoStart Dateien
NumBtn : Integer; // höchste Button-Zahl
StartCounter : Integer; // Counter für AutoStartFunktion
StartArray : array[3..31] of Integer; // StartArray
bg_Color : TColor; // Button-Color / Farbschema
procedure TColor2RGB(Color: TColor; var R, G, B: Byte);
procedure SetGlass(R, G, B, Alpha : Byte);
protected
{ Protected declarations }
end;
const
WM_APPBARMSG = WM_USER + 1; // Konstante, die als CallBack für die AppBar arbeitet
const
MB_TIMEDOUT = 500;
function MessageBoxTimeOut(hWnd: HWND; lpText: PChar; lpCaption: PChar;
uType: UINT; wLanguageId: WORD; dwMilliseconds: DWORD): Integer; stdcall;
function MessageBoxTimeOutA(hWnd: HWND; lpText: PChar; lpCaption: PChar;
uType: UINT; wLanguageId: WORD; dwMilliseconds: DWORD): Integer; stdcall;
function MessageBoxTimeOutW(hWnd: HWND; lpText: PWideChar; lpCaption: PWideChar;
uType: UINT; wLanguageId: WORD; dwMilliseconds: DWORD): Integer; stdcall;
function RunAPP(FName: String) : Boolean; // Function RunApplication
function RunControl(AppletFileName:string):Integer; // Run Control-Applet
function RunProcess(FileName: string; ShowCmd: DWORD; // Run Process
wait: Boolean; ProcID: PDWORD): Longword;
function EnumWindowsProc(hWnd: HWND; lParam: LPARAM): BOOL; stdcall; // EnumWinProc
function GetWndHandle(ProcessId: DWORD): HWND; // Get
Handle from Process ID
function ProcessList:TStringList; // ProcID's
var
frmMain: TfrmMain;
implementation
{$R *.dfm}
uses IniUnit, uConfig;
var ProcID : Cardinal;
WND : HWnd;
var
tmpList : TStringList;
function MessageBoxTimeOut; external user32 name 'MessageBoxTimeoutA';
function MessageBoxTimeOutA; external user32 name 'MessageBoxTimeoutA';
function MessageBoxTimeOutW; external user32 name 'MessageBoxTimeoutW';
function SetLayeredWindowAttributes(hwnd: THandle; crKey: COLORREF;
bAlpha: Byte; dwFlags: DWord): Bool; stdcall; external 'user32.dll';
function RGB2TColor(R, G, B: Byte): Integer;
begin
Result := R or (G shl 8) or (B shl 16);
end;
// Ini-Verzeichnisse auf Vorhandensein der Ini-Datei prüfen
function CheckIni(f1, f2, f3, f4, fi, FileName : String):Integer; // Function Check if any Ini-Files
begin
result := 0;
if FileExists(f1+'\'+FileName) then result := 1; // ProgDir
if FileExists(f2+'\'+fi+'\'+FileName) then result := 2; // AppDir
if FileExists(f3+'\'+fi+'\'+FileName) then result := 3; // Loc. AppDir
if FileExists(f4+'\'+fi+'\'+FileName) then result := 4; //
Com. AppDir
end;
function RunAPP(FName: String) : Boolean; // Function RunApplication
begin
Result := WinExec(PChar(FName), SW_SHOWNORMAL) > 31;
end;
function RunControl(AppletFileName:string):Integer; // Run Control-Applet
begin
Result:=WinExec(PChar('rundll32.exe shell32.dll,'+
'Control_RunDLL '+AppletFileName),SW_SHOWNORMAL);
end;
function RunProcess(FileName: string; ShowCmd: DWORD; // Run Process
wait: Boolean; ProcID: PDWORD): Longword;
var
StartupInfo: TStartupInfo;
ProcessInfo: TProcessInformation;
ExitInfo : PExitThreadDebugInfo;
begin
FillChar(StartupInfo, SizeOf(StartupInfo), #0);
StartupInfo.cb := SizeOf(StartupInfo);
StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_FORCEONFEEDBACK;
StartupInfo.wShowWindow := ShowCmd;
if not CreateProcess(nil,@Filename[1],nil,nil,False,CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS,nil,nil,StartupInfo,ProcessInfo) then
Result := WAIT_FAILED
else
begin
if wait = FALSE then
begin
if ProcID <> nil then ProcID^ := ProcessInfo.dwProcessId;
exit;
end;
WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
GetExitCodeProcess(ProcessInfo.hProcess, Result);
end;
if ProcessInfo.hProcess <> 0 then
CloseHandle(ProcessInfo.hProcess);
if ProcessInfo.hThread <> 0 then
CloseHandle(ProcessInfo.hThread);
end;
function EnumWindowsProc(hWnd: HWND; lParam: LPARAM): BOOL; stdcall; // EnumWinProc
begin //bei Win95/98 evt problematisch
TList(lParam).Add(Pointer(hWnd));
Result := True;
end;
function GetWndHandle(ProcessId: DWORD): HWND; // Get
Handle from Process ID
var
List: TList;
I: Integer;
PID: DWORD;
begin
Result := 0;
List := TList.Create;
try
EnumWindows(@EnumWindowsProc, LPARAM(List));
for I := 0 to List.Count - 1 do
if GetWindowThreadProcessId(HWND(List.Items[I]), @PID) <> 0 then
if PID = ProcessId then
begin
Result := HWND(List.Items[I]);
Break;
end;
finally
List.Free;
end;
end;
function GetSpecialFolder (aFolder: Integer): String; // Function GetSpecialFolderLocation
var //
Unit ShlObj.pas
pIdL: PItemIDList;
Path: Array [0..Max_Path] Of Char;
Allocator: IMalloc;
begin
SHGetSpecialFolderLocation (0, aFolder, pIdL); // ItemIdList für den Ordner holen
SHGetPathFromIDList (pIDL, Path); // ItemIdList in String umwandeln lassen
if Succeeded (SHGetMalloc (Allocator)) then
begin
Allocator.Free (pIdL);
{$IFDEF VER100}
Allocator.Release;
{$ENDIF}
end;
Result := Path;
end;
procedure Delay(Milliseconds: Integer);
var
Tick: DWord;
Event: THandle;
begin
Event := CreateEvent(nil, False, False, nil);
try
Tick := GetTickCount + DWord(Milliseconds);
while (Milliseconds > 0) and
(MsgWaitForMultipleObjects(1, Event, False, Milliseconds, QS_ALLINPUT) <> WAIT_TIMEOUT) do
begin
Application.ProcessMessages;
if Application.Terminated then Exit;
Milliseconds := Tick - GetTickcount;
end;
finally
CloseHandle(Event);
end;
end;
procedure TfrmMain.Helligkeit(const Bitmap: TBitmap; const Faktor: Double);
var
i,j: Integer;
r,g,b: Integer;
Reihe: ^TRGBTriple;
begin
for i:= 0 to Bitmap.Height-1 do
begin
Reihe:= Bitmap.Scanline[i];
for j:= 0 to Bitmap.Width-1 do
begin
r:=Round(Reihe^.rgbtred * faktor);
b:=Round(Reihe^.rgbtblue * faktor);
g:=Round(Reihe^.rgbtgreen * faktor);
if r>255 then r:=255;
if g>255 then g:=255;
if b>255 then b:=255;
Reihe^.rgbtred := r;
Reihe^.rgbtBlue := b;
Reihe^.rgbtgreen := g;
inc(Reihe);
end;
end;
bitmap.Assign(Bitmap);
end;
procedure TfrmMain.FormCreate(Sender: TObject);
var
P : array[0..511] of Char;
Ini : TIniFile;
i : Integer;
s : String;
begin
tmpList := TStringList.Create; // Liste für ProcID
// Btn ...
NumBtn := 15;
SetLength(Btn, NumBtn + 1);
SetLength(Img, NumBtn + 1);
// GET DIRs
IniFolder := 'app_bar';
IniName := 'pAppBar.ini';
ProgDir := ExtractFileDir(ParamStr(0));
GetSystemDirectory(P, 512); SysDir :=StrPas(P);
GetWindowsDirectory(P, 512); WinDir := StrPas(P);
AppDir := GetSpecialFolder(CSIDL_APPDATA);
ComAppDir := GetSpecialFolder(CSIDL_COMMON_APPDATA);
LocAppDir := GetSpecialFolder(CSIDL_LOCAL_APPDATA);
IniStatus := CheckIni(ProgDir, AppDir, LocAppDir, ComAppDir, IniFolder, IniName);
ImageDir := ProgDir+'\Images';
FolderPicDir := ProgDir+'\OrdnerPics';
ForceDirectories(ImageDir);
ForceDirectories(FolderPicDir);
ForceDirectories(ProgDir+'\Extended');
// arrays erzeugen und verwalten
for i := 1 to NumBtn do Btn[i] := FindComponent(Format('GlassButton%d', [i])) as TGlassButton;
for i := 1 to NumBtn do Img[i] := FindComponent(Format('Image%d', [i])) as TImage;
// Ini-Prozeduren
fDelete := False;
if (IniStatus > 0) and (IniStatus < 5) then
begin // Ini-Datei gefunden
case IniStatus of
1 : Ini := TIniFile.Create(ProgDir+'\'+IniName); // Programm-Verzeichnis
2 : Ini := TIniFile.Create(AppDir+'\'+IniFolder+'\'+IniName); // Verz. AppData
3 : Ini := TIniFile.Create(ComAppDir+'\'+IniFolder+'\'+IniName); // Verz. CommonAppData
4 : Ini := TIniFile.Create(LocAppDir+'\'+IniFolder+'\'+IniName); // Verz. LocalAppData
end; // end case of IniStatus
with Ini do
begin
Mon_Position := ReadInteger('Monitor', 'StartOnNum', 0); // Anzeige auf Monitor . . .
App_Position := ReadInteger('Monitor', 'App_Position', 2); // Position der AppBar
Bar_Size := ReadInteger('Monitor', 'Bar_Size', 32); // Size der AppBar
BarColor := TColor(ReadInteger('AppBar', 'Color', Integer(clWhite))); // Farbwert AppBar-HG
BarAlpha := ReadInteger('AppBar', 'AlphaBlend', 255); // Alpha-Blend Value
pTime_1 := ReadInteger('Delay', 'WindowsMessages', 200); // Delay zwischen Wind.Messages
pTime_2 := ReadInteger('Delay', 'Funktionsaufruf', 500); // Delay zwischen nachfolgenden Funktionsaufrufen
pTime_3 := ReadInteger('Delay', 'while..do', 25); // Delay while..do
Bar_R := ReadInteger('BarColor', 'Red', 255); // Farbwert AppBar, Rot
Bar_G := ReadInteger('BarColor', 'Green', 255); // Farbwert AppBar, Grün
Bar_B := ReadInteger('BarColor', 'Blue', 255); // Farbwert AppBar, Blau
for i := 3 to NumBtn do
begin
btn_Dir[i] := ReadString('App ' + IntToStr(i), 'Path', ''); // Start Pfad
Start_Type[i] := ReadInteger('App ' + IntToStr(i), 'Type', 0); // Start-Typ
Auto_Start[i] := ReadBool('App ' + IntToStr(i), 'AutoStart', False); // AutoStart
end;
bg_Color := ReadInteger('AppBar', 'Color_Btn', 1); // Button-Color, Farbschema
end; // end with INI
Ini.Free; // Ini wieder freigeben
end // end Ini-Datei gefunden
else
begin // Ini-Datei nicht vorhanden
Mon_Position := 0; // Anzeige auf Monitor . . .
Bar_Size := 62; // Size der App Bar
App_Position := 2; // Position der AppBar
BarColor := clWhite; // Farbwert AppBar-HG
BarAlpha := 255; // Alpha-Blend Value
pTime_1 := 200; // Delay zwischen Wind.Messages
pTime_2 := 500; // Delay zwischen nachfolgenden Funktionsaufrufen
pTime_3 := 25; // Delay while..do
Bar_R := 255; // Farbwert AppBar, Rot
Bar_G := 255; // Farbwert AppBar, Grün
Bar_B := 255; // Farbwert AppBar, Blau
for i := 3 to NumBtn do
begin
btn_Dir[i] := ''; // Start Pfad
Start_Type[i] := 0; // Start-Typ
Auto_Start[i] := False; // AutoStart
end;
bg_Color := 1;
end; // end Ini-Datei nicht vorhanden
NumAutoStart := 0;
for i := 3 to NumBtn do if Auto_Start[i] then Inc(NumAutoStart, 1);
end;
procedure TfrmMain.CreateAppBar(Sender: TObject);
var
iResult: integer;
fWidth, fHeight : Integer;
begin
frmMain.Color := BarColor;
frmMain.AlphaBlendValue := BarAlpha;
fAppBarData.cbSize := SizeOf(TAppBarData);
fAppBarData.hWnd := Self.Handle;
fAppBarData.uCallbackMessage := WM_APPBARMSG;
case App_Position of
0 : fAppBarData.uEdge := ABE_RIGHT;
1 : fAppBarData.uEdge := ABE_TOP;
2 : fAppBarData.uEdge := ABE_LEFT;
3 : fAppBarData.uEdge := ABE_BOTTOM;
end;
// Rect für den reservierten Platz, wo keine Anwendung "hin darf"
if fAppBarData.uEdge = ABE_TOP then
begin
fAppBarData.rc.Left := Mon[Mon_Position].AreaLeft;
fAppBarData.rc.Right := Mon[Mon_Position].AreaRight;
fAppBarData.rc.Top := 0;
fAppBarData.rc.Bottom := Bar_Size;
end;
if fAppBarData.uEdge = ABE_BOTTOM then
begin
fAppBarData.rc.Left := Mon[Mon_Position].AreaLeft;
fAppBarData.rc.Right := Mon[Mon_Position].AreaRight;
fAppBarData.rc.Top := Mon[Mon_Position].AreaBottom - Bar_Size;
fAppBarData.rc.Bottom := Mon[Mon_Position].AreaBottom;
end;
if fAppBarData.uEdge = ABE_LEFT then
begin
fAppBarData.rc.Left := Mon[Mon_Position].AreaLeft;
fAppBarData.rc.Right := Mon[Mon_Position].AreaLeft + Bar_Size;
fAppBarData.rc.Top := Mon[Mon_Position].AreaTop;
fAppBarData.rc.Bottom := Mon[Mon_Position].AreaBottom;
end;
if fAppBarData.uEdge = ABE_RIGHT then
begin
fAppBarData.rc.Left := Mon[Mon_Position].AreaRight - Bar_Size;
fAppBarData.rc.Right := Mon[Mon_Position].AreaRight;
fAppBarData.rc.Top := Mon[Mon_Position].AreaTop;
fAppBarData.rc.Bottom := Mon[Mon_Position].AreaBottom;
end;
iResult := SHAppBarMessage(ABM_NEW, fAppBarData);
if iResult = 0 then begin ShowMessage('AppBar konnte nicht erzeugt werden.'); Exit; end;
SHAppBarMessage(ABM_QUERYPOS, fAppBarData);
SHAppBarMessage(ABM_SETPOS, fAppBarData);
Application.ProcessMessages;
// Fenster an die gewünschte Position
if fAppBarData.uEdge = ABE_TOP then
begin
fWidth := fAppBarData.rc.Right - fAppBarData.rc.Left; if fWidth < 0 then fWidth := fWidth * -1;
fHeight := fAppBarData.rc.Bottom - fAppBarData.rc.Top; if fHeight < 0 then fHeight := fHeight * -1;
frmMain.Left := fAppBarData.rc.Left;
frmMain.Top := fAppBarData.Rc.Top;
frmMain.ClientWidth := fWidth;
frmMain.ClientHeight := fHeight;
BorderPanel.Left := 0;
BorderPanel.Width := fWidth;
BorderPanel.Height := 2;
BorderPanel.Top := fAppBarData.rc.Bottom - 2;
end;
if fAppBarData.uEdge = ABE_BOTTOM then
begin
fWidth := fAppBarData.rc.Right - fAppBarData.rc.Left; if fWidth < 0 then fWidth := fWidth * -1;
fHeight := fAppBarData.rc.Bottom - fAppBarData.rc.Top; if fHeight < 0 then fHeight := fHeight * -1;
frmMain.Left := fAppBarData.rc.Left;
frmMain.Top := fAppBarData.Rc.Top;
frmMain.ClientWidth := fWidth;
frmMain.ClientHeight := fHeight;
BorderPanel.Left := 0;
BorderPanel.Width := fWidth;
BorderPanel.Height := 2;
BorderPanel.Top := 0;
end;
if fAppBarData.uEdge = ABE_LEFT then
begin
fWidth := fAppBarData.rc.Right - fAppBarData.rc.Left; if fWidth < 0 then fWidth := fWidth * -1;
fHeight := fAppBarData.rc.Bottom - fAppBarData.rc.Top; if fHeight < 0 then fHeight := fHeight * -1;
frmMain.Left := fAppBarData.rc.Left;
frmMain.Top := fAppBarData.Rc.Top;
frmMain.ClientWidth := fWidth;
frmMain.ClientHeight := fHeight;
BorderPanel.Left := fWidth - 2;
BorderPanel.Width := 2;
BorderPanel.Height := fHeight;
BorderPanel.Top := 0;
end;
if fAppBarData.uEdge = ABE_RIGHT then
begin
fWidth := fAppBarData.rc.Right - fAppBarData.rc.Left; if fWidth < 0 then fWidth := fWidth * -1;
fHeight := fAppBarData.rc.Bottom - fAppBarData.rc.Top; if fHeight < 0 then fHeight := fHeight * -1;
frmMain.Left := fAppBarData.rc.Right - fWidth;
frmMain.Top := fAppBarData.Rc.Top;
frmMain.ClientWidth := fWidth;
frmMain.ClientHeight := fHeight;
BorderPanel.Left := 0;
BorderPanel.Width := 2;
BorderPanel.Height := fHeight;
BorderPanel.Top := 0;
end;
frmMain.Visible := True;
SetGlass(200, 255, 120, BarAlpha);
end;
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
SHAppBarMessage(ABM_REMOVE, fAppBarData);
end;
procedure TfrmMain.FormShow(Sender: TObject);
var
Owner : HWnd;
i : Integer;
e : Integer;
begin
Owner := GetWindow(
Handle, GW_OWNER);
ShowWindow(Owner, SW_Hide); // kein Eintrag in der Task-Leiste
fDelete := False;
GetMonitors(Self);
if (IniStatus = 0) or (IniStatus > 4) then frmIni.Show; // Form zum Speichern der Ini-datei anzeige
CreateAppBar(Self);
frmMain.Color := RGB2TColor(Bar_R, Bar_G, Bar_B);
for i := 1 to NumBtn do Btn[i].Caption := '';
ChangeBtnColor;
for i := 3 to 31 do StartArray[i] := -1;
e := 0;
for i := 3 to NumBtn do
begin
if Auto_Start[i] then
begin
Inc(e, 1);
StartArray[e] := i;
end;
end;
StartCounter := 0;
if NumAutoStart > 0 then StartTimer.Enabled := True;
end;
procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
var
i : Integer;
begin
if not fDelete then SaveIni;
for i := 0 to NumBtn do Btn[i].Free;
for i := 0 to NumBtn do Img[i].Free;
tmpList.Free;
end;
procedure TfrmMain.SaveIni; // Ini-daten speichern
var
Ini : TIniFile;
i : Integer;
begin
if (IniStatus > 0) and (IniStatus < 5) then
begin
case (IniStatus) of
1 : Ini := TIniFile.Create(frmMain.ProgDir+'\'+frmMain.IniName); // Programmverzeichnis
2 : Ini := TIniFile.Create(frmMain.AppDir+'\'+frmMain.IniFolder+'\'+frmMain.IniName); // AppData
3 : Ini := TIniFile.Create(frmMain.LocAppDir+'\'+frmMain.IniFolder+'\'+frmMain.IniName); // LocalAppData
4 : Ini := TIniFile.Create(frmMain.ComAppDir+'\'+frmMain.IniFolder+'\'+frmMain.IniName); // CommonAppData
end; // end case of
// ggf neue Werte zuweisen;
with Ini do // Werte in Ini-Datei schreiben
begin
WriteString ('Description', 'Program', 'pAppBar');
WriteInteger('Monitor', 'StartOnNum', Mon_Position); // Start auf Monitor . . .
WriteInteger('Monitor', 'App_Position', App_Position); // Position der AppBar
WriteInteger('Monitor', 'Bar_Size', Bar_Size); // Size der AppBar
for i := 0 to MonCount -1 do
with Mon[i] do
begin
WriteInteger('Monitors', 'Num', MonCount);
WriteBool('Monitor '+IntToStr(i), 'Primary', Primary);
WriteInteger('Monitor '+IntToStr(i), 'Left', Left);
WriteInteger('Monitor '+IntToStr(i), 'Top', Top);
WriteInteger('Monitor '+IntToStr(i), 'Width', Width);
WriteInteger('Monitor '+IntToStr(i), 'Height', Height);
WriteInteger('Monitor '+IntToStr(i), 'WA_Left', AreaLeft);
WriteInteger('Monitor '+IntToStr(i), 'WA_Right', AreaRight);
WriteInteger('Monitor '+IntToStr(i), 'WA_Top', AreaTop);
WriteInteger('Monitor '+IntToStr(i), 'WA_Bottom', AreaBottom);
end;
WriteInteger('AppBar', 'Color', Integer(BarColor)); // Farbwert AppBar-HG
WriteInteger('AppBar', 'AlphaBlend', BarAlpha); // Alpha-Blend Value
WriteInteger('Delay', 'WindowsMessages', pTime_1); // Delay zwischen Wind.Messages
WriteInteger('Delay', 'Funktionsaufruf', pTime_2); // Delay zwischen nachfolgenden Funktionsaufrufen
WriteInteger('Delay', 'while..do', pTime_3); // Delay while..do
WriteInteger('BarColor', 'Red', Bar_R); // Farbwert AppBar, Rot
WriteInteger('BarColor', 'Green', Bar_G); // Farbwert AppBar, Grün
WriteInteger('BarColor', 'Blue', Bar_B); // Farbwert AppBar, Blau
for i := 3 to NumBtn do
begin
WriteString('App ' + IntToStr(i), 'Path', btn_Dir[i]); // Start Pfad
WriteInteger('App ' + IntToStr(i), 'Type', Start_Type[i]); // Start-Typ
WriteBool('App ' + IntToStr(i), 'AutoStart', Auto_Start[i]); // AutoStart
end;
WriteInteger('AppBar', 'Color_Btn', bg_Color); // Button-Color, Farbschema
end;
end; // end if (selected)
Ini.Free;
end;
procedure TfrmMain.DeleteIni; // Ini-datei löschen
begin
fDelete := True; // Status setzen, damit bei
// OnClose die Ini-datei nicht
case IniStatus of // gespeichert wird
1 : begin
// Programmverzeichnis
DeleteFile(ProgDir+'\'+IniName);
end;
2 : begin
// AppData
DeleteFile(AppDir+'\'+IniFolder+'\'+IniName);
RemoveDir(AppDir+'\'+IniFolder);
end;
3 : begin
// LocalAppData
DeleteFile(LocAppDir+'\'+IniFolder+'\'+IniName);
RemoveDir(LocAppDir+'\'+IniFolder);
end;
4 : begin
// CommonAppData
DeleteFile(ComAppDir+'\'+IniFolder+'\'+IniName);
RemoveDir(ComAppDir+'\'+IniFolder);
end;
end; // end case of
end;
procedure TfrmMain.GetMonitors(Sender: TObject);
var
i, j : Integer;
n : Integer;
begin
MonCount := Screen.MonitorCount;
SetLength(Mon, MonCount);
for i := 0 to MonCount -1 do
begin
Mon[i].Primary := Screen.Monitors[i].Primary;
Mon[i].Left := Screen.Monitors[i].Left;
Mon[i].Top := Screen.Monitors[i].Top;
Mon[i].Width := Screen.Monitors[i].Width;
Mon[i].Height := Screen.Monitors[i].Height;
Mon[i].AreaLeft := Screen.Monitors[i].WorkAreaRect.Left;
Mon[i].AreaRight := Screen.Monitors[i].WorkAreaRect.Right;
Mon[i].AreaTop := Screen.Monitors[i].WorkareaRect.Top;
Mon[i].AreaBottom := Screen.Monitors[i].WorkareaRect.Bottom;
end;
end;
procedure TfrmMain.TColor2RGB(Color: TColor; var R, G, B: Byte);
begin
// convert hexa-decimal values to
RGB
if Color shr 24 = $FF then
Color := GetSysColor(Color and $FF)
else if Color shr 24 > $02 then
Color := 0;
R := Color;
G := (Color shr 8);
B := (Color shr 16);
end;
procedure TfrmMain.SetGlass(R, G, B, Alpha : Byte);
const
WS_EX_LAYERED = $00080000;
LWA_ALPHA = 2;
var
CurrHandle: THandle;
begin
CurrHandle := GetWindowLong(
Handle, GWL_EXSTYLE);
SetWindowLong(
Handle, GWL_EXSTYLE, CurrHandle or WS_EX_LAYERED);
SetLayeredWindowAttributes(
Handle,
RGB(R, G, B), Alpha, LWA_ALPHA);
Application.ProcessMessages;
end;
procedure TfrmMain.OnBtnMouseEnter;
var
i : Integer;
begin
for i := 1 to NumBtn do if MoveObject = Btn[i] then Img[i].Visible := True;
end;
procedure TfrmMain.OnBtnMouseLeave;
var
i : Integer;
begin
for i := 1 to NumBtn do if MoveObject = Btn[i] then Img[i].Visible := False;
end;
procedure TfrmMain.OnBtnMouseDown;
var
i : Integer;
begin
//
end;
procedure TfrmMain.OnBtnMouseUp;
var
i, n : Integer;
P: TPoint;
s : String;
begin
for i := 1 to NumBtn do
if DownObject = Btn[i] then
begin
case i of
1 : Close;
2 : begin
P := ClientToScreen(Point(Btn[i].Left + Btn[i].Width div 2, Btn[i].Top + Btn[i].Height div 2));
PopupMenu1.Popup(P.X, P.Y);
end;
3..15 : begin
s := btn_Dir[i];
case Start_Type[i] of
1..2 : begin
RunProcess(s, SW_SHOW, False, @ProcID);
repeat
WND := GetWndHandle(ProcID); //warten bis gestartet bzw gefunden über ProcID
Application.ProcessMessages;
Delay(250);
Sleep(0);
until (WND <> 0); //or Stop
if (WND <> 0) then
begin
//ShowMessage(IntToStr(ProcID));
//ShowMessage(IntToStr(WND));
end;
end; //1..2
3 : begin
ShellExecute(Application.Handle, 'open', PChar(s), nil, nil, SW_Normal);
end; //3
end; // case StartType of
end; // 3..15
end; // end case i of
end;
end;
procedure TfrmMain.GlassButton1MouseEnter(Sender: TObject);
begin
MoveObject := Sender;
OnBtnMouseEnter;
end;
procedure TfrmMain.GlassButton1MouseLeave(Sender: TObject);
begin
MoveObject := Sender;
OnBtnMouseLeave;
end;
procedure TfrmMain.GlassButton1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
DownObject := Sender;
//OnBtnMouseDown;
end;
procedure TfrmMain.GlassButton1MouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
DownObject := Sender;
OnBtnMouseUp;
end;
procedure TfrmMain.EinstellungenClick(Sender: TObject);
begin
frmConfig.Show;
end;
procedure TfrmMain.ChangeBtnColor; // Farbschema anwenden
var
i : Integer;
begin
for i := 3 to NumBtn do
begin
case bg_Color of
1 : begin Img[i].Picture.Bitmap.Assign(Img_S.Picture.Bitmap); Btn[i].Color := $00FFFFFF; end;
2 : begin Img[i].Picture.Bitmap.Assign(Img_B.Picture.Bitmap); Btn[i].Color := $00FEEA7A; end;
3 : begin Img[i].Picture.Bitmap.Assign(Img_G.Picture.Bitmap); Btn[i].Color := $0071FF71; end;
4 : begin Img[i].Picture.Bitmap.Assign(Img_Y.Picture.Bitmap); Btn[i].Color := $006FD8FF; end;
5 : begin Img[i].Picture.Bitmap.Assign(Img_R.Picture.Bitmap); Btn[i].Color := $003F58FE; end;
end; // case of Color
end; // for i
end;
procedure TfrmMain.StartTimerTimer(Sender: TObject);
var
s : String;
begin
if StartCounter < NumAutoStart then
begin
Inc(StartCounter, 1);
s := btn_Dir[StartArray[StartCounter]];
case Start_Type[StartArray[StartCounter]] of
1..2 : begin
RunProcess(s, SW_SHOW, False, @ProcID);
repeat
WND := GetWndHandle(ProcID);
Application.ProcessMessages;
Delay(250);
Sleep(0);
until (WND <> 0);
if (WND <> 0) then
begin
//ShowMessage(IntToStr(ProcID));
//ShowMessage(IntToStr(WND));
end;
end; //1..2
3 : begin
ShellExecute(Application.Handle, 'open', PChar(s), nil, nil, SW_Normal);
end; //3
end; // case StartType of
end
else
StartTimer.Enabled := False;
end;
procedure TfrmMain.FormClick(Sender: TObject);
begin
ShowMessage(IntToStr(NumBtn));
end;
end.