AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Projekte Windows 7 Support für Delphi [ALPHA 1]
Thema durchsuchen
Ansicht
Themen-Optionen

Windows 7 Support für Delphi [ALPHA 1]

Ein Thema von sakura · begonnen am 20. Jan 2009 · letzter Beitrag vom 19. Nov 2014
Antwort Antwort
Seite 6 von 6   « Erste     456   
Benutzerbild von DeddyH
DeddyH

Registriert seit: 17. Sep 2006
Ort: Barchfeld
27.656 Beiträge
 
Delphi 12 Athens
 
#1

AW: Windows 7 Support für Delphi [ALPHA 1]

  Alt 24. Mai 2011, 13:47
Ansonsten kann man sich die hier auch einmal ansehen: http://delphi.fsprolabs.com/
Detlef
"Ich habe Angst vor dem Tag, an dem die Technologie unsere menschlichen Interaktionen übertrumpft. Die Welt wird eine Generation von Idioten bekommen." (Albert Einstein)
Dieser Tag ist längst gekommen
  Mit Zitat antworten Zitat
NickelM

Registriert seit: 22. Jul 2007
Ort: Carlsberg
445 Beiträge
 
Delphi 2009 Professional
 
#2

AW: Windows 7 Support für Delphi [ALPHA 1]

  Alt 4. Aug 2011, 20:19
Hallo nochmal,

Mal ne frage...es ist doch möglich mit der Taskbar Unit, auch das für nonvcl zumachen oder?
Weil ich wollte das mit der Taskbarprogressbar in NonVCL verwenden.

EDIT:
Ich habe es soweit hinbekommen das er es mir anzeigt. Hingegen bekomm ich beim schliessen einen Zugriffsverletzung auf adresse 000000 (d.h. auf ein bereits freigegeben Pointer) Ich vermute es liegt am dem Form das früher freigegeben wird als die ProgressBar in der Taskleiste.
Nur wie gebe ich die davor frei bzw. wann? und wo?

Benutze Delphi2009/Delphi2010

Delphi-Quellcode:
program metroupdate;

uses SysUtils,messages, windows, classes, CommCtrl, xpman, ComObj;

type
  ULONGLONG = UInt64;

  TTipString = array[0..259] of WideChar;
  PTipString = ^TTipString;
  tagTHUMBBUTTON = packed record
    dwMask
      : DWORD;
    iId
    , iBitmap
      : UINT;
    hIcon
      : HICON;
    szTip
      : TTipString;
    dwFlags
      : DWORD;
  end;
  THUMBBUTTON = tagTHUMBBUTTON;
  THUMBBUTTONLIST = ^THUMBBUTTON;

  ITaskbarList = interface
    ['{56FDF342-FD6D-11D0-958A-006097C9A090}']
    procedure HrInit; safecall;
    procedure AddTab(hwnd: Cardinal); safecall;
    procedure DeleteTab(hwnd: Cardinal); safecall;
    procedure ActivateTab(hwnd: Cardinal); safecall;
    procedure SetActiveAlt(hwnd: Cardinal); safecall;
  end;

  ITaskbarList2 = interface(ITaskbarList)
    ['{602D4995-B13A-429B-A66E-1935E44F4317}']
  procedure MarkFullscreenWindow(hwnd: Cardinal; fFullscreen: Bool); safecall;
  end;

  ITaskbarList3 = interface(ITaskbarList2)
    ['{EA1AFB91-9E28-4B86-90E9-9E9F8A5EEFAF}']
    procedure SetProgressValue(hwnd: Cardinal; ullCompleted, ullTotal: ULONGLONG); safecall;
    procedure SetProgressState(hwnd: Cardinal; tbpFlags: DWORD); safecall;
    procedure RegisterTab(hwndTab: Cardinal; hwndMDI: Cardinal); safecall;
    procedure UnregisterTab(hwndTab: Cardinal); safecall;
    procedure SetTabOrder(hwndTab: Cardinal; hwndInsertBefore: Cardinal); safecall;
    procedure SetTabActive(hwndTab: Cardinal; hwndMDI: Cardinal; tbatFlags: DWORD); safecall;
    procedure ThumbBarAddButtons(hwnd: Cardinal; cButtons: UINT; Button: THUMBBUTTONLIST); safecall;
    procedure ThumbBarUpdateButtons(hwnd: Cardinal; cButtons: UINT; pButton: THUMBBUTTONLIST); safecall;
    procedure ThumbBarSetImageList(hwnd: Cardinal; himl: Cardinal); safecall;
    procedure SetOverlayIcon(hwnd: Cardinal; hIcon: HICON; pszDescription: LPCWSTR); safecall;
    procedure SetThumbnailTooltip(hwnd: Cardinal; pszTip: LPCWSTR); safecall;
    procedure SetThumbnailClip(hwnd: Cardinal; prcClip: PRect); safecall;
  end;

var hwndProgress : DWord;
    hWndFont : HFONT;
    FTaskbarList : ITaskbarList;
    FTaskbarList2 : ITaskbarList2;
    FTaskbarList3 : ITaskbarList3;
    FensterH : HWND;

function InitCommonControl(CC: Integer): Boolean;
var
  ICC: TInitCommonControlsEx;
begin
  ICC.dwSize := SizeOf(TInitCommonControlsEx);
  ICC.dwICC := CC;
  Result := InitCommonControlsEx(ICC);
  if not Result then InitCommonControls;
end;

function CompareMD5(A, B : TMD5Digest) : Boolean;
var I : Integer;
begin
Result := True;
for I := 0 to 16 - 1 do
if A[I] <> A[I] then
begin
Result := False;
Exit;
end;
end;

const
  CLSID_TaskbarList: TGUID = '{56FDF344-FD6D-11D0-958A-006097C9A090}';
  CLSID_TaskbarList2: TGUID = '{602D4995-B13A-429B-A66E-1935E44F4317}';
  CLSID_TaskbarList3: TGUID = '{EA1AFB91-9E28-4B86-90E9-9E9F8A5EEFAF}';

  //Warum das eigentlich?
  ICC_PROGRESS_CLASS = $00000020;

  //Brauch nur normal und keine xD
  TBPF_NOPROGRESS   = $00;
  TBPF_NORMAL    = $02;

  ClassName = 'TTest';
  Window1Name = 'Test';
  WindowWidth = 270;
  WindowHeight = 15;

function WndProc(hWnd: HWND; uMsg: UINT; wParam: wParam; lParam: LParam):
  lresult; stdcall;
var
  x, y,FormHeight,FormWidth : integer;
begin
  Result := 0;
  case uMsg of
    WM_CREATE:
      begin
        x := GetSystemMetrics(SM_CXSCREEN);
        y := GetSystemMetrics(SM_CYSCREEN);
        FormHeight := 10 + WindowHeight + (GetSystemMetrics(SM_CYCAPTION)) + (2 * GetSystemMetrics(SM_CYDLGFRAME)) + 10;
        FormWidth := 10 + WindowWidth + (2 * GetSystemMetrics(SM_CXDLGFRAME)) + 10;

        MoveWindow(hWnd, (x div 2) - (FormWidth div 2),
          (y div 2) - ((FormHeight) div 2),
          FormWidth, FormHeight, true);

        hwndProgress := CreateWindowEx(0,PROGRESS_CLASS,nil,
         WS_CHILD or WS_VISIBLE or PBS_SMOOTH,10,10,270,15,hwnd,
         0,hInstance,nil); //Brauch ich, da ich es im Fenster und in der Taskleiste haben will;
      end;
    WM_DESTROY:
      begin
        if CheckWin32Version(6, 1) and (FTaskbarList3 <> nil) then
        FTaskbarList3.SetProgressState(FensterH, TBPF_NOPROGRESS); //Sollte doch das Freigeben sein oder? Funkt aber net hier auch nicht bei WM_CLOSE
        PostQuitMessage(0);
      end;
  else
    Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
  end;
end;


var
  wc: TWndClassEx = (
    cbSize : SizeOf(TWndClassEx);
    Style : CS_HREDRAW or CS_VREDRAW;
    lpfnWndProc : @WndProc; //Fensterfunktion für Fenster 1
    cbClsExtra : 0;
    cbWndExtra : 0;
    lpszMenuName : nil;
    lpszClassName : ClassName; //Klassenname für Fenster 1
    hIconSm : 0;
  );
  msg: TMsg;

var
  Obj
    : IInterface;
begin
  wc.hInstance := hInstance;
  wc.hCursor := LoadCursor(0, IDC_ARROW);
  wc.hbrBackground := GetSysColorBrush(COLOR_BTNHIGHLIGHT);

  RegisterClassEx(wc);

  FensterH := CreateWindowEx(0, ClassName, Window1Name, WS_VISIBLE or WS_SYSMENU,
    Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), WindowWidth, WindowHeight, 0, 0, hInstance,
    nil);

  InitCommonControl(ICC_PROGRESS_CLASS); //Ist ja sowieso alles größer alls 32Bit xD Brauch ich das überhaupt?

  if CheckWin32Version(6, 1) then
  begin
    Obj := CreateComObject(CLSID_TaskbarList);
    if Obj = nil then
    FTaskbarList := nil
    else
    begin
      FTaskbarList := ITaskbarList(Obj);
      FTaskbarList.HrInit;

      FTaskbarList.QueryInterface(CLSID_TaskbarList2, FTaskbarList2);
      FTaskbarList.QueryInterface(CLSID_TaskbarList3, FTaskbarList3);
    end;
  end;

  if CheckWin32Version(6, 1) and (FTaskbarList3 <> nil) then
  begin
    FTaskbarList3.SetProgressState(FensterH, TBPF_NORMAL);
    FTaskbarList3.SetProgressValue(FensterH, 50, 100); //Testweise
  end;

  while GetMessage(msg,0,0,0) do
  begin
    TranslateMessage(msg);
    DispatchMessage(msg);
  end;

  ExitCode := msg.wParam;
end.
Nickel
"Lebe und denke nicht an morgen"
Zitat aus dem gleichnamigen Bollywoodfilm.

Geändert von NickelM ( 4. Aug 2011 um 23:06 Uhr)
  Mit Zitat antworten Zitat
EWeiss
(Gast)

n/a Beiträge
 
#3

AW: Windows 7 Support für Delphi [ALPHA 1]

  Alt 7. Aug 2011, 10:20
FTaskbarList3.SetProgressState(FensterH, TBPF_NOPROGRESS);
Du teilst hier TaskbarList3 lediglich mit das keine Progressbar angezeigt werden soll

Hat mit der freigabe nix zu tun.
Denke mal du solltest das Objekt TaskbarList3 Releasen oder?

Und für die Progressbar kannst du dir die CLSID_TaskbarList2 schenken.

PS:
Dann würde ich auch nicht jedesmal auf
CheckWin32Version(6, 1) prüfen sondern hier eine fixed variable deklarieren als BOOL oder was auch immer
Das reicht wenn man es einmal prüft bei Programmstart.

gruss

Geändert von EWeiss ( 7. Aug 2011 um 10:49 Uhr)
  Mit Zitat antworten Zitat
Redeemer

Registriert seit: 19. Jan 2009
Ort: Kirchlinteln (LK Verden)
1.114 Beiträge
 
Delphi 2009 Professional
 
#4

Patch für Sprunglisten-Separators (Trennleisten)

  Alt 19. Nov 2014, 22:54
Ich weiß, Totengräberei. Löscht meinen Post und steinigt mich, falls es falsch war, hier noch was zu posten. Ich habe mich aber jetzt anderthalb Stunden damit abgemüht, da irgendwie Ordnung in meine Sprunglisten zu bekommen, welche ich als Nutzer von Delphi 2009/XE2 offenbar nur mit diesen Komponenten erstellen kann. Leider gibt es beim Anlegen von Kategorien diese Zugriffsverletzungen (da die versteckt werden, sieht man sie nur beim Debuggen), obwohl ich Admin bin. Da diese Sprunglisten-Komponente auch nicht die Möglichkeit bietet, Trennleisten (Trennbalken, Separators) anzulegen, hat man nach wenigen Items totales Chaos im Startmenü. Daher habe ich mal geguckt, wie man Trennleisten einfügt. Damit Delphi-typisch Bindestriche in Trennleisten umgewandelt werden, ändert ihr in dwJumpLists.pas folgende Zeilen:

Alt
Delphi-Quellcode:
    K.fmtid := StringToGUID('{F29F85E0-4FF9-1068-AB91-08002B27B3D9}');
    K.pid := 2;
    P.vt := VT_LPWSTR;
    P.pwszVal := PWideChar(ObjectItem.ShellLink.FDisplayName);
Neu
Delphi-Quellcode:
    if ObjectItem.ShellLink.FDisplayName = '-then
    begin
      K.fmtid := StringToGUID('{9F4C2855-9F79-4B39-A8D0-E1D42DE1D5F3}');
      K.pid := 6;
      P.vt := VT_BOOL;
      P.boolVal := True;
    end
    else
    begin
      K.fmtid := StringToGUID('{F29F85E0-4FF9-1068-AB91-08002B27B3D9}');
      K.pid := 2;
      P.vt := VT_LPWSTR;
      P.pwszVal := PWideChar(ObjectItem.ShellLink.FDisplayName);
    end;
Ihr erstellt Trennleisten dann einfach mit durch Aufrufen von Tasks.AddShellLink('-', ''); bei eurer TdwJumpLists.

Ich hoffe, das hilft jemandem. Von mir noch ein großes Lob an die Ersteller und danke an mleyen fürs Wiederhochladen.
Miniaturansicht angehängter Grafiken
jumplists.png  
Janni
2005 PE, 2009 PA, XE2 PA
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 6 von 6   « Erste     456   


Forumregeln

Es 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

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 19:03 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz