home *** CD-ROM | disk | FTP | other *** search
/ Chip 2005 November / CDVD1105.ISO / Software / Freeware / programare / graphics32 / GR32_System.pas < prev    next >
Pascal/Delphi Source File  |  2004-12-19  |  11KB  |  408 lines
  1. unit GR32_System;
  2.  
  3. (* ***** BEGIN LICENSE BLOCK *****
  4.  * Version: MPL 1.1
  5.  *
  6.  * The contents of this file are subject to the Mozilla Public License Version
  7.  * 1.1 (the "License"); you may not use this file except in compliance with
  8.  * the License. You may obtain a copy of the License at
  9.  * http://www.mozilla.org/MPL/
  10.  *
  11.  * Software distributed under the License is distributed on an "AS IS" basis,
  12.  * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
  13.  * for the specific language governing rights and limitations under the
  14.  * License.
  15.  *
  16.  * The Original Code is Graphics32
  17.  *
  18.  * The Initial Developer of the Original Code is
  19.  * Alex A. Denisov
  20.  *
  21.  * Portions created by the Initial Developer are Copyright (C) 2000-2004
  22.  * the Initial Developer. All Rights Reserved.
  23.  *
  24.  * Contributor(s):
  25.  * Andre Beckedorf
  26.  *
  27.  * ***** END LICENSE BLOCK ***** *)
  28.  
  29. interface
  30.  
  31. {$I GR32.inc}
  32.  
  33. uses
  34.   {$IFDEF CLX}
  35.   Qt, Types {$IFDEF LINUX}, Libc{$ENDIF}
  36.   {$ELSE}
  37.   Windows
  38.   {$ENDIF};
  39.  
  40. { HasMMX returns 'true' if CPU supports MMX instructions }
  41. function HasMMX: Boolean;
  42. { Has3DNow returns 'true' if CPU supports 3DNow! instructions }
  43. function Has3DNow: Boolean;
  44. { Has3DNowExt returns 'true' if CPU supports 3DNow! Extended instructions }
  45. function Has3DNowExt: Boolean;
  46. { HasSSE returns 'true' if CPU supports SSE instructions }
  47. function HasSSE: Boolean;
  48. { HasSSE2 returns 'true' if CPU supports SSE2 instructions }
  49. function HasSSE2: Boolean;
  50.  
  51. type
  52.   TCPUInstructionSet = (ciMMX, ciSSE, ciSSE2, ci3DNow, ci3DNowExt);
  53.  
  54. { General function that returns whether a particular instrucion set is
  55.   supported for the current CPU or not }
  56. function HasInstructionSet(const InstructionSet: TCPUInstructionSet): Boolean;
  57.  
  58. const
  59.   CPUISChecks: Array[TCPUInstructionSet] of Cardinal =
  60.     ($800000, $2000000, $4000000, $80000000, $40000000);
  61. //   ciMMX  , ciSSE   , ciSSE2  , ci3DNow , ci3DNowExt
  62.  
  63. {$IFNDEF CLX}
  64. { Internal support for Windows XP themes }
  65. var
  66.   USE_THEMES: Boolean = False;
  67.   SCROLLBAR_THEME: THandle = 0;
  68.   GLOBALS_THEME: THandle = 0;
  69.  
  70. const
  71.   THEMEMGR_VERSION                     = 1;
  72.   WM_THEMECHANGED                      = $031A;
  73.  
  74. { "Scrollbar" Parts & States }
  75.   { SCROLLBARPARTS }
  76.   SBP_ARROWBTN                         = 1;
  77.   SBP_THUMBBTNHORZ                     = 2;
  78.   SBP_THUMBBTNVERT                     = 3;
  79.   SBP_LOWERTRACKHORZ                   = 4;
  80.   SBP_UPPERTRACKHORZ                   = 5;
  81.   SBP_LOWERTRACKVERT                   = 6;
  82.   SBP_UPPERTRACKVERT                   = 7;
  83.   SBP_GRIPPERHORZ                      = 8;
  84.   SBP_GRIPPERVERT                      = 9;
  85.   SBP_SIZEBOX                          = 10;
  86.  
  87.   { ARROWBTNSTATES }
  88.   ABS_UPNORMAL                         = 1;
  89.   ABS_UPHOT                            = 2;
  90.   ABS_UPPRESSED                        = 3;
  91.   ABS_UPDISABLED                       = 4;
  92.   ABS_DOWNNORMAL                       = 5;
  93.   ABS_DOWNHOT                          = 6;
  94.   ABS_DOWNPRESSED                      = 7;
  95.   ABS_DOWNDISABLED                     = 8;
  96.   ABS_LEFTNORMAL                       = 9;
  97.   ABS_LEFTHOT                          = 10;
  98.   ABS_LEFTPRESSED                      = 11;
  99.   ABS_LEFTDISABLED                     = 12;
  100.   ABS_RIGHTNORMAL                      = 13;
  101.   ABS_RIGHTHOT                         = 14;
  102.   ABS_RIGHTPRESSED                     = 15;
  103.   ABS_RIGHTDISABLED                    = 16;
  104.  
  105.   { SCROLLBARSTATES }
  106.   SCRBS_NORMAL                         = 1;
  107.   SCRBS_HOT                            = 2;
  108.   SCRBS_PRESSED                        = 3;
  109.   SCRBS_DISABLED                       = 4;
  110.  
  111.   { SIZEBOXSTATES }
  112.   SZB_RIGHTALIGN                       = 1;
  113.   SZB_LEFTALIGN                        = 2;
  114.  
  115. { Access to uxtheme.dll }
  116.  
  117. type
  118.   HIMAGELIST = THandle;
  119.   HTHEME = THandle;
  120.   _MARGINS = record
  121.     cxLeftWidth: Integer;      // width of left border that retains its size
  122.     cxRightWidth: Integer;     // width of right border that retains its size
  123.     cyTopHeight: Integer;      // height of top border that retains its size
  124.     cyBottomHeight: Integer;   // height of bottom border that retains its size
  125.   end;
  126.   MARGINS = _MARGINS;
  127.   PMARGINS = ^MARGINS;
  128.   TMargins = MARGINS;
  129.  
  130. var
  131.   OpenThemeData: function(hwnd: HWND; pszClassList: LPCWSTR): HTHEME; stdcall;
  132.   CloseThemeData: function(hTheme: HTHEME): HRESULT; stdcall;
  133.   DrawThemeBackground: function(hTheme: HTHEME; hdc: HDC; iPartId, iStateId: Integer;
  134.     const Rect: TRect; pClipRect: PRect): HRESULT; stdcall;
  135.   DrawThemeEdge: function(hTheme: HTHEME; hdc: HDC; iPartId, iStateId: Integer; const pDestRect: TRect; uEdge,
  136.     uFlags: UINT; pContentRect: PRECT): HRESULT; stdcall;
  137.   GetThemeColor: function(hTheme: HTHEME; iPartId, iStateId, iPropId: Integer; var pColor: COLORREF): HRESULT; stdcall;
  138.   GetThemeMetric: function(hTheme: HTHEME; hdc: HDC; iPartId, iStateId, iPropId: Integer;
  139.     var piVal: Integer): HRESULT; stdcall;
  140.   GetThemeMargins: function(hTheme: HTHEME; hdc: HDC; iPartId, iStateId, iPropId: Integer; prc: PRECT;
  141.     var pMargins: MARGINS): HRESULT; stdcall;
  142.   SetWindowTheme: function(hwnd: HWND; pszSubAppName: LPCWSTR; pszSubIdList: LPCWSTR): HRESULT; stdcall;
  143.   IsThemeActive: function: BOOL; stdcall;
  144.   IsAppThemed: function: BOOL; stdcall;
  145.   EnableTheming: function(fEnable: BOOL): HRESULT; stdcall;
  146. {$ENDIF}
  147.  
  148. implementation
  149.  
  150. {$IFNDEF CLX}
  151. uses
  152.   Messages, Forms, Classes;
  153. {$ENDIF}
  154.  
  155. function CPUID_Available: Boolean;
  156. asm
  157.         MOV       EDX,False
  158.         PUSHFD
  159.         POP       EAX
  160.         MOV       ECX,EAX
  161.         XOR       EAX,$00200000
  162.         PUSH      EAX
  163.         POPFD
  164.         PUSHFD
  165.         POP       EAX
  166.         XOR       ECX,EAX
  167.         JZ        @1
  168.         MOV       EDX,True
  169. @1:     PUSH      EAX
  170.         POPFD
  171.         MOV       EAX,EDX
  172. end;
  173.  
  174. function CPU_Signature: Integer;
  175. asm
  176.         PUSH    EBX
  177.         MOV     EAX,1
  178.         DW      $A20F   // CPUID
  179.         POP     EBX
  180. end;
  181.  
  182. function CPU_Features: Integer;
  183. asm
  184.         PUSH    EBX
  185.         MOV     EAX,1
  186.         DW      $A20F   // CPUID
  187.         POP     EBX
  188.         MOV     EAX,EDX
  189. end;
  190.  
  191. function CPU_AMDExtensionsAvailable: Boolean;
  192. asm
  193.         PUSH    EBX
  194.         MOV     @Result, True
  195.         MOV     EAX, $80000000
  196.         DW      $A20F   // CPUID
  197.         CMP     EAX, $80000000
  198.         JBE     @NOEXTENSION
  199.         JMP     @EXIT
  200.       @NOEXTENSION:
  201.         MOV     @Result, False
  202.       @EXIT:
  203.         POP     EBX
  204. end;
  205.  
  206. function CPU_AMDExtFeatures: Integer;
  207. asm
  208.         PUSH    EBX
  209.         MOV     EAX, $80000001
  210.         DW      $A20F   // CPUID
  211.         POP     EBX
  212.         MOV     EAX,EDX
  213. end;
  214.  
  215. function HasInstructionSet(const InstructionSet: TCPUInstructionSet): Boolean;
  216. begin
  217.   Result := False;
  218.   if not CPUID_Available then Exit;                   // no CPUID available
  219.   if CPU_Signature shr 8 and $0F < 5 then Exit;       // not a Pentium class
  220.   if (InstructionSet = ci3DNow) or
  221.      (InstructionSet = ci3DNowExt) then
  222.   begin
  223.     if not CPU_AMDExtensionsAvailable or (CPU_AMDExtFeatures and CPUISChecks[InstructionSet] = 0) then
  224.       Exit;
  225.   end
  226.   else
  227.     if CPU_Features and CPUISChecks[InstructionSet] = 0 then
  228.       Exit; // no MMX
  229.  
  230.   Result := True;
  231. end;
  232.  
  233. function HasMMX: Boolean;
  234. begin
  235.   Result := HasInstructionSet(ciMMX);
  236. end;
  237.  
  238. function HasSSE: Boolean;
  239. begin
  240.   Result := HasInstructionSet(ciSSE);
  241. end;
  242.  
  243. function HasSSE2: Boolean;
  244. begin
  245.   Result := HasInstructionSet(ciSSE2);
  246. end;
  247.  
  248. function Has3DNow: Boolean;
  249. begin
  250.   Result := HasInstructionSet(ci3DNow);
  251. end;
  252.  
  253. function Has3DNowExt: Boolean;
  254. begin
  255.   Result := HasInstructionSet(ci3DNowExt);
  256. end;
  257.  
  258. {$IFNDEF CLX}
  259. const
  260.   UXTHEME_DLL = 'uxtheme.dll';
  261.  
  262. var
  263.   DllHandle: THandle;
  264.  
  265. procedure FreeXPThemes;
  266. begin
  267.   if DllHandle <> 0 then
  268.   begin
  269.     FreeLibrary(DllHandle);
  270.     DllHandle := 0;
  271.     OpenThemeData := nil;
  272.     CloseThemeData := nil;
  273.     DrawThemeBackground := nil;
  274.     DrawThemeEdge := nil;
  275.     GetThemeColor := nil;
  276.     GetThemeMetric := nil;
  277.     GetThemeMargins := nil;
  278.     SetWindowTheme := nil;
  279.     IsThemeActive := nil;
  280.     IsAppThemed := nil;
  281.     EnableTheming := nil;
  282.   end;
  283. end;
  284.  
  285. function InitXPThemes: Boolean;
  286. begin
  287.   if DllHandle = 0 then
  288.   begin
  289.     DllHandle := LoadLibrary(UXTHEME_DLL);
  290.     if DllHandle > 0 then
  291.     begin
  292.       OpenThemeData := GetProcAddress(DllHandle, 'OpenThemeData');
  293.       CloseThemeData := GetProcAddress(DllHandle, 'CloseThemeData');
  294.       DrawThemeBackground := GetProcAddress(DllHandle, 'DrawThemeBackground');
  295.       DrawThemeEdge := GetProcAddress(DllHandle, 'DrawThemeEdge');
  296.       GetThemeColor := GetProcAddress(DllHandle, 'GetThemeColor');
  297.       GetThemeMetric := GetProcAddress(DllHandle, 'GetThemeMetric');
  298.       GetThemeMargins := GetProcAddress(DllHandle, 'GetThemeMargins');
  299.       SetWindowTheme := GetProcAddress(DllHandle, 'SetWindowTheme');
  300.       IsThemeActive := GetProcAddress(DllHandle, 'IsThemeActive');
  301.       IsAppThemed := GetProcAddress(DllHandle, 'IsAppThemed');
  302.       EnableTheming := GetProcAddress(DllHandle, 'EnableTheming');
  303.       if (@OpenThemeData = nil) or (@CloseThemeData = nil) or (@IsThemeActive = nil) or
  304.         (@IsAppThemed = nil) or (@EnableTheming = nil) then FreeXPThemes;
  305.     end;
  306.   end;
  307.   Result := DllHandle > 0;
  308. end;
  309.  
  310. function UseXPThemes: Boolean;
  311. begin
  312.   Result := (DllHandle > 0) and IsAppThemed  and IsThemeActive;
  313. end;
  314.  
  315. type
  316.   TThemeNexus = class
  317.   private
  318.     FWindowHandle: HWND;
  319.   protected
  320.     procedure WndProc(var Message: TMessage);
  321.     procedure OpenVisualStyles;
  322.     procedure CloseVisualStyles;
  323.   public
  324.     constructor Create;
  325.     destructor Destroy; override;
  326.   end;
  327.  
  328. {$IFDEF XPTHEMES}
  329. var
  330.   ThemeNexus: TThemeNexus;
  331. {$ENDIF}
  332.  
  333. { TThemeNexus }
  334.  
  335. procedure TThemeNexus.CloseVisualStyles;
  336. begin
  337.   if UseXPThemes then
  338.   begin
  339.     if SCROLLBAR_THEME <> 0 then
  340.     begin
  341.       CloseThemeData(SCROLLBAR_THEME);
  342.       SCROLLBAR_THEME := 0;
  343.     end;
  344.     if GLOBALS_THEME <> 0 then
  345.     begin
  346.       CloseThemeData(GLOBALS_THEME);
  347.       GLOBALS_THEME := 0;
  348.     end;
  349.   end;
  350.   FreeXPThemes;
  351. end;
  352.  
  353. constructor TThemeNexus.Create;
  354. begin
  355.   FWindowHandle := {$IFDEF COMPILER6}Classes.{$ENDIF}AllocateHWnd(WndProc);
  356.   OpenVisualStyles;
  357. end;
  358.  
  359. destructor TThemeNexus.Destroy;
  360. begin
  361.   CloseVisualStyles;
  362.   {$IFDEF COMPILER6}Classes.{$ENDIF}DeallocateHWnd(FWindowHandle);
  363.   inherited;
  364. end;
  365.  
  366. procedure TThemeNexus.OpenVisualStyles;
  367. begin
  368.   USE_THEMES := False;
  369.   if InitXPThemes then
  370.   begin
  371.     USE_THEMES := UseXPThemes;
  372.     if USE_THEMES then
  373.     begin
  374.       SCROLLBAR_THEME := OpenThemeData(FWindowHandle, 'SCROLLBAR');
  375.       GLOBALS_THEME := OpenThemeData(FWindowHandle, 'GLOBALS');
  376.     end;
  377.   end;
  378. end;
  379.  
  380. procedure TThemeNexus.WndProc(var Message: TMessage);
  381. begin
  382.   case Message.Msg of
  383.     WM_THEMECHANGED:
  384.       begin
  385.         CloseVisualStyles;
  386.         OpenVisualStyles;
  387.       end;
  388.   end;
  389.   with Message do Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);
  390. end;
  391. {$ENDIF}
  392.  
  393. initialization
  394. {$IFNDEF CLX}
  395.   {$IFDEF XPTHEMES}
  396.   ThemeNexus := TThemeNexus.Create;
  397.   {$ENDIF}
  398. {$ENDIF}
  399.  
  400. finalization
  401. {$IFNDEF CLX}
  402.   {$IFDEF XPTHEMES}
  403.   ThemeNexus.Free;
  404.   {$ENDIF}
  405. {$ENDIF}
  406.  
  407. end.
  408.