|
Antwort |
Registriert seit: 5. Mär 2009 Ort: Hamburg 569 Beiträge Delphi XE8 Professional |
#1
Moin zusammen.
Ich steh' hier gerade vor einem großen Problem :
Code:
ich habe mir eine Variable namens NumBtn als Integer definiert,
private
{ Private declarations } Btn : array of TGlassButton; Img : array of TImage; public { Public declarations } . . NumBtn : Integer; // höchste Button-Zahl procedure TfrmMain.FormCreate(Sender: TObject); var P : array[0..511] of Char; . . begin . . . // Btn ... NumBtn := 15; SetLength(Btn, NumBtn + 1); SetLength(Img, NumBtn + 1); . . procedure TfrmMain.FormClick(Sender: TObject); begin ShowMessage(IntToStr(NumBtn)); <---- hier kommt 14 (!!!!!) heraus end; dieser wird im Ereignis OnCreate des Formulars der Wert 15 zugewiesen, nun möchte ich im laufenden Programm über diesen Integer-Wert Button-Arrays behandeln, nur leider ist NumBtn jetzt nur noch 14 !? weise ich im OnCreate den Wert 14 oder 12 oder 16 zu, ist das Ergebnis von ShowMessage identisch. Kennt jemand diesen kranken Sch...? Bin für jede Idee dankbar.
Markus H.
|
Zitat |
(Co-Admin)
Registriert seit: 30. Mai 2002 Ort: Hamburg 13.920 Beiträge Delphi 10.4 Sydney |
#2
Ohne Deinen Programmcode zu kennen bin ich sicher, dass Du diese Variable irgendwo noch veränderst.
Delphi kann man viel vorwerfen, doch der Inhalt von Int-Variablen ist nachweislich stabil.
Daniel R. Wolf
mit Grüßen aus Hamburg |
Zitat |
Registriert seit: 26. Nov 2003 Ort: Halle/Saale 4.343 Beiträge Delphi 11 Alexandria |
#3
weise ich im OnCreate den Wert 14 oder 12 oder 16 zu, ist das Ergebnis von ShowMessage identisch.
Probiere mal Projekt bereinigen und neu erzeugen. Ansonsten benenne mal Dein NumBtn um und schau, wo sie überall wirklich verwendet wird.
Stahli
http://www.StahliSoft.de --- "Jetzt muss ich seh´n, dass ich kein Denkfehler mach...!?" Dittsche (2004) |
Zitat |
Registriert seit: 5. Mär 2009 Ort: Hamburg 569 Beiträge Delphi XE8 Professional |
#4
jo, identisch heißt wie die Zuweisung,
und nein, NumBtn wird nach der Zuweisung nicht mehr geändert sondern nur gelesen, hauptsächlich in Anweisungen wie
Code:
oder
var
i : Integer; begin for i := 3 to NumBtn do . .
Code:
UpDownBtn.Min := 1;
UpDownBtn.Max := NumBtn;
Markus H.
|
Zitat |
Registriert seit: 26. Nov 2003 Ort: Halle/Saale 4.343 Beiträge Delphi 11 Alexandria |
#5
Das ist bestimmt etwas, das Du übersiehst...
Ändere mal die Variable in ein Property mit Setter. Im Setter kannst Du dann überwachen, wann der Wert geändert wird.
Stahli
http://www.StahliSoft.de --- "Jetzt muss ich seh´n, dass ich kein Denkfehler mach...!?" Dittsche (2004) |
Zitat |
Perlsau
(Gast)
n/a Beiträge |
#6
Tja, dann bist du geliefert ... es sei denn, du deklarierst sie im Private-Abschnitt, setzt sie in die überwachten Ausdrücke und stepst mal durch ... Hättest du da selber drauf kommen können? Nein, niemals |
Zitat |
Registriert seit: 5. Mär 2009 Ort: Hamburg 569 Beiträge Delphi XE8 Professional |
#7
. . . im Private Bereich kann ich aber dann nicht von einem weiteren Formular auf die Variable zugreifen.
frmMain :
Code:
frmConfig
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.
Code:
das ist der Code, in dem mit NumBtn gearbeitet wird.
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.
Markus H.
|
Zitat |
(Co-Admin)
Registriert seit: 30. Mai 2002 Ort: Hamburg 13.920 Beiträge Delphi 10.4 Sydney |
#8
Hier ist nichts Offensichtliches zu erkennen.
Übersetze Deinen Code mal mit aktivierter Bereichs- und Überlaufprüfung. Eventuell fuddelst Du versehentlich im Speicher herum und Deine geänderte Variable ist ein Kollateralschaden.
Daniel R. Wolf
mit Grüßen aus Hamburg |
Zitat |
Registriert seit: 5. Mär 2009 Ort: Hamburg 569 Beiträge Delphi XE8 Professional |
#9
@ Daniel : danke, das war's
Code:
der Fehler lag in StartArray[e] --> Bereich
e := 0;
ShowMessage(IntToStr(NumBtn)); // <-------- korrekt for i := 3 to NumBtn do begin if Auto_Start[i] then begin Inc(e, 1); StartArray[e] := i; end; end; ShowMessage(IntToStr(NumBtn)); // <-----------fehlerhaft "Range Checking" war ausgeschaltet, dachte, das wäre aktiviert gewesen
Markus H.
|
Zitat |
Registriert seit: 26. Nov 2003 Ort: Halle/Saale 4.343 Beiträge Delphi 11 Alexandria |
#10
Ja, das sollte man annehmen.
Als Standardeinstellung wäre das sinnvoll - gerade für Anfänger. Wer es dann ausschalten will kann das ja jederzeit tun.
Stahli
http://www.StahliSoft.de --- "Jetzt muss ich seh´n, dass ich kein Denkfehler mach...!?" Dittsche (2004) |
Zitat |
Ansicht |
Linear-Darstellung |
Zur Hybrid-Darstellung wechseln |
Zur Baum-Darstellung wechseln |
ForumregelnEs ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.
BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus. Trackbacks are an
Pingbacks are an
Refbacks are aus
|
|
Nützliche Links |
Heutige Beiträge |
Sitemap |
Suchen |
Code-Library |
Wer ist online |
Alle Foren als gelesen markieren |
Gehe zu... |
LinkBack |
LinkBack URL |
About LinkBacks |