Einzelnen Beitrag anzeigen

Benutzerbild von markus5766h
markus5766h

Registriert seit: 5. Mär 2009
Ort: Hamburg
569 Beiträge
 
Delphi XE8 Professional
 
#7

AW: Delphi verlernt die Mathematik !!!???

  Alt 8. Aug 2015, 16:42
. . . im Private Bereich kann ich aber dann nicht von einem weiteren Formular auf die Variable zugreifen.

frmMain :
Code:
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.
frmConfig
Code:
unit uConfig;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, GlassButton, ComCtrls;

type
  TfrmConfig = class(TForm)
    rgMon: TRadioGroup;
    GroupBox1: TGroupBox;
    RadioButton2: TRadioButton;
    RadioButton1: TRadioButton;
    RadioButton3: TRadioButton;
    RadioButton0: TRadioButton;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Image1: TImage;
    imgIcon1: TImage;
    Label5: TLabel;
    Image2: TImage;
    GlassButton2: TGlassButton;
    GlassButton1: TGlassButton;
    Label6: TLabel;
    Label7: TLabel;
    Image3: TImage;
    Label8: TLabel;
    GlassButton3: TGlassButton;
    GroupBox2: TGroupBox;
    Label9: TLabel;
    Panel1: TPanel;
    UpDown1: TUpDown;
    lbUpDown1: TLabel;
    EditPath: TEdit;
    cbAutoStart: TCheckBox;
    rgStartType: TRadioGroup;
    btnSearch: TButton;
    OpenDialog1: TOpenDialog;
    procedure FormShow(Sender: TObject);
    procedure FormCreate(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 ChangePathSettings(Num : Integer);
    procedure btnSearchClick(Sender: TObject);
    procedure cbAutoStartClick(Sender: TObject);
    procedure UpDown1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);

  private
    { Private declarations }
    Btn : array of TGlassButton;
    Img : array of TImage;
    MoveObject : TObject;
    DownObject : TObject;
    NumBtn : Integer;
    procedure OnBtnMouseEnter;
    procedure OnBtnMouseLeave;
    procedure OnBtnMouseDown;
    procedure OnBtnMouseUp;

  public
    { Public declarations }
    rBtn : array[0..3] of TRadioButton;
  end;

var
  frmConfig: TfrmConfig;

implementation

{$R *.dfm}
uses uMain, ScreenHSV;

procedure TfrmConfig.FormShow(Sender: TObject);
var
  i : Integer;
begin
  for i := 1 to frmMain.MonCount do rgMon.Items.Add(IntToStr(i-1));
  rgMon.ItemIndex := frmMain.Mon_Position;
  for i := 1 to NumBtn do Btn[i].Caption := '';
  UpDown1.Min := 1;
  UpDown1.Max := frmMain.NumBtn - 2 ;
  UpDown1.Position := 1;
  ChangePathSettings(1);
  ShowMessage(IntToStr(frmMain.NumBtn));
  ShowMessage(IntToStr(UpDown1.Max));
end;

procedure TfrmConfig.FormCreate(Sender: TObject);
var
  i : Integer;
begin
  for i := 0 to 3 do rBtn[i] := FindComponent(Format('RadioButton%d', [i])) as TRadioButton;
  rBtn[frmMain.App_Position].Checked := True;

  NumBtn := 3;
  SetLength(Btn, NumBtn + 1);
  SetLength(Img, NumBtn + 1);
  // 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;
end;

procedure TfrmConfig.OnBtnMouseEnter;
var
  i : Integer;
begin
  for i := 1 to NumBtn do if MoveObject = Btn[i] then Img[i].Visible := True;
end;

procedure TfrmConfig.OnBtnMouseLeave;
var
  i : Integer;
begin
  for i := 1 to NumBtn do if MoveObject = Btn[i] then Img[i].Visible := False;
end;

procedure TfrmConfig.OnBtnMouseDown;
var
  i : Integer;
begin
  //
end;

procedure TfrmConfig.OnBtnMouseUp;                                             // Color Settings, Close
var
  i : Integer;
  P: TPoint;
begin
  for i := 1 to NumBtn do
    if DownObject = Btn[i] then
      begin
        case i of
          1 : frmHSV.Show; // Color Settings
          3 : frmConfig.Hide;
        end;
      end;
end;

procedure TfrmConfig.GlassButton1MouseEnter(Sender: TObject);
begin
  MoveObject := Sender;
  OnBtnMouseEnter;
end;

procedure TfrmConfig.GlassButton1MouseLeave(Sender: TObject);
begin
  MoveObject := Sender;
  OnBtnMouseLeave;
end;

procedure TfrmConfig.GlassButton1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  DownObject := Sender;
  //OnBtnMouseDown;
end;

procedure TfrmConfig.GlassButton1MouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  DownObject := Sender;
  OnBtnMouseUp;
end;

procedure TfrmConfig.ChangePathSettings(Num : Integer);                        // Einstellungen aktualisieren
begin
  lbUpDown1.Caption := IntToStr(Num);
  EditPath.Text := frmMain.btn_Dir[Num +2];
  rgStartType.ItemIndex := frmMain.Start_Type[Num +2] -1;
  cbAutoStart.Checked := frmMain.Auto_Start[Num +2];
end;



procedure TfrmConfig.btnSearchClick(Sender: TObject);                          // Anwendung suchen
var
  s : String;
begin
  if OpenDialog1.Execute then
    begin
      s := OpenDialog1.FileName;
      EditPath.Text := s;
      frmMain.btn_Dir[UpDown1.Position +2] := s;
    end;
end;

procedure TfrmConfig.cbAutoStartClick(Sender: TObject);
begin
  frmMain.Auto_Start[UpDown1.Position +2] := cbAutoStart.Checked;
end;

procedure TfrmConfig.UpDown1MouseUp(Sender: TObject; Button: TMouseButton;     // Button Nummer
  Shift: TShiftState; X, Y: Integer);
begin
  ChangePathSettings(UpDown1.Position);
end;

end.
das ist der Code, in dem mit NumBtn gearbeitet wird.
Markus H.
  Mit Zitat antworten Zitat