diff --git a/README.md b/README.md index 992110f..c23fa20 100644 --- a/README.md +++ b/README.md @@ -2,7 +2,7 @@ ![Delphi](https://img.shields.io/badge/Delphi-XE3-red.svg) -![Windows](https://img.shields.io/badge/Windiws-Vista--10-blue.svg) +![Windows](https://img.shields.io/badge/Windows-Vista--10-blue.svg) ![License](https://img.shields.io/badge/license-MIT-brightgreen.svg) diff --git a/components/ColorPicker/ColorPicker.dfm b/components/ColorPicker/ColorPicker.dfm index 6a8e894..d9acc7a 100644 --- a/components/ColorPicker/ColorPicker.dfm +++ b/components/ColorPicker/ColorPicker.dfm @@ -66,7 +66,7 @@ object frmColorPicker: TfrmColorPicker Left = 32 Top = 5 Width = 137 - Height = 21 + Height = 24 Alignment = taCenter CharCase = ecUpperCase MaxLength = 8 diff --git a/components/ColorPicker/ColorPicker.pas b/components/ColorPicker/ColorPicker.pas index 374371b..acad9ea 100644 --- a/components/ColorPicker/ColorPicker.pas +++ b/components/ColorPicker/ColorPicker.pas @@ -1,12 +1,14 @@ {*******************************************************} { Linkbar - Windows desktop toolbar } -{ Copyright (c) 2010-2017 Asaq } +{ Copyright (c) 2010-2018 Asaq } {*******************************************************} unit ColorPicker; interface +{$R-} + uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, ImgList, StdCtrls, Math, Buttons; @@ -205,9 +207,6 @@ procedure TfrmColorPicker.PaintColorPnl; PaintAlphaColor; - imgColor.Canvas.Pen.Color := clBlack; - imgColor.Canvas.Brush.Style := bsClear; - if not TextEnter then editColor.Text := IntToHex(Cardinal(NewColor), 8); end; @@ -253,12 +252,7 @@ procedure TfrmColorPicker.L10n; end; procedure TfrmColorPicker.FormCreate(Sender: TObject); -const - Colors: array[0..15] of TColor = (clBlack, clWhite, clGray, clSilver, - clMaroon, clRed, clGreen, clLime, clOlive, clYellow, clNavy, clBlue, - clPurple, clFuchsia, clTeal, clAqua); -var - i: Integer; +var i: Integer; begin L10n; @@ -449,7 +443,8 @@ procedure TfrmColorPicker.imgColorMouseDown(Sender: TObject; procedure TfrmColorPicker.PaintColorHue; var Row: PRGBArray; - slMain, slSize, slPtr: Integer; + slMain, slPtr: UIntPtr; + slSize: IntPtr; x, y, w, h: Integer; m1, q1, q2, q3, s1, s2: Integer; r, g, b: Byte; @@ -466,8 +461,8 @@ procedure TfrmColorPicker.PaintColorHue; SetLength(LUT, w + 1); for x := 0 to w do LUT[x] := MulDiv(255, x, w); - slMain := Integer(HBoxBmp.ScanLine[0]); - slSize := Integer(HBoxBmp.ScanLine[1]) - slMain; + slMain := UIntPtr(HBoxBmp.ScanLine[0]); + slSize := UIntPtr(HBoxBmp.ScanLine[1]) - slMain; slPtr := slMain; for y := 0 to h do begin @@ -511,7 +506,7 @@ procedure TfrmColorPicker.PaintHueBar; procedure TfrmColorPicker.PaintAlphaColor; var Row: PRGBArray; - RowOff: Integer; + RowOff: IntPtr; x, y, a: Integer; bool: Boolean; c1, c2, c3: TRGB; @@ -523,7 +518,7 @@ procedure TfrmColorPicker.PaintAlphaColor; c2.G := 255; c2.B := 255; Row := PRGBArray(ColorBmp.ScanLine[0]); - RowOff := Integer(ColorBmp.ScanLine[1]) - Integer(ColorBmp.ScanLine[0]); + RowOff := UIntPtr(ColorBmp.ScanLine[1]) - UIntPtr(Row); a := 255 - OldColor.A; c3.b := OldColor.B; c3.g := OldColor.G; @@ -538,9 +533,9 @@ procedure TfrmColorPicker.PaintAlphaColor; c3.g := NewColor.G; c3.b := NewColor.B; end; - c1.R := a * (0 - c3.r) shr 8 + c3.r; - c1.G := a * (0 - c3.g) shr 8 + c3.g; - c1.B := a * (0 - c3.b) shr 8 + c3.b; + c1.R := a * (164 - c3.r) shr 8 + c3.r; + c1.G := a * (164 - c3.g) shr 8 + c3.g; + c1.B := a * (164 - c3.b) shr 8 + c3.b; c2.R := a * (255 - c3.r) shr 8 + c3.r; c2.G := a * (255 - c3.g) shr 8 + c3.g; c2.B := a * (255 - c3.b) shr 8 + c3.b; @@ -553,7 +548,7 @@ procedure TfrmColorPicker.PaintAlphaColor; else Row[x] := c2; end; - Row := PRGBArray(Integer(Row) + RowOff); + Row := PRGBArray(UIntPtr(Row) + RowOff); end; imgColor.Canvas.StretchDraw(Rect(0, 0, imgColor.Width, imgColor.Height), ColorBmp); @@ -562,7 +557,7 @@ procedure TfrmColorPicker.PaintAlphaColor; procedure TfrmColorPicker.PaintAlphaBar; var Row: PRGBArray; - RowOff: Integer; + RowOff: IntPtr; x, y, a: Integer; bool: Boolean; c1, c2: TRGB; @@ -574,14 +569,14 @@ procedure TfrmColorPicker.PaintAlphaBar; c2.G := 255; c2.B := 255; Row := PRGBArray(ABarBmp.ScanLine[0]); - RowOff := Integer(ABarBmp.ScanLine[1]) - Integer(ABarBmp.ScanLine[0]); + RowOff := UIntPtr(ABarBmp.ScanLine[1]) - UIntPtr(Row); for y := 0 to ABarBmp.Height - 1 do begin bool := (y and 4 = 0); a := 255 - MulDiv(255, y, AlpBarHeight); - c1.R := a * (0 - NewColor.R) shr 8 + NewColor.r; - c1.G := a * (0 - NewColor.G) shr 8 + NewColor.g; - c1.B := a * (0 - NewColor.B) shr 8 + NewColor.b; + c1.R := a * (164 - NewColor.R) shr 8 + NewColor.r; + c1.G := a * (164 - NewColor.G) shr 8 + NewColor.g; + c1.B := a * (164 - NewColor.B) shr 8 + NewColor.b; c2.R := a * (255 - NewColor.r) shr 8 + NewColor.r; c2.G := a * (255 - NewColor.g) shr 8 + NewColor.g; c2.B := a * (255 - NewColor.b) shr 8 + NewColor.b; @@ -594,7 +589,7 @@ procedure TfrmColorPicker.PaintAlphaBar; else Row[x] := c2; end; - Row := PRGBArray(Integer(Row) + RowOff); + Row := PRGBArray(UIntPtr(Row) + RowOff); end; imgAlpha.Canvas.StretchDraw(Rect(0, 0, imgAlpha.Width, imgAlpha.Height), ABarBmp); diff --git a/components/ColorPicker/ColorUtils.pas b/components/ColorPicker/ColorUtils.pas index e60115d..9d2a7e8 100644 --- a/components/ColorPicker/ColorUtils.pas +++ b/components/ColorPicker/ColorUtils.pas @@ -1,6 +1,6 @@ {*******************************************************} { Linkbar - Windows desktop toolbar } -{ Copyright (c) 2010-2017 Asaq } +{ Copyright (c) 2010-2018 Asaq } {*******************************************************} unit ColorUtils; @@ -8,72 +8,81 @@ interface uses - Graphics; + Vcl.Graphics; - procedure RGBtoHSB (const cRed, cGreen, cBlue: Byte; var H,S,B: Word); - procedure HSBtoRGB (const H,S,B: Word; var cRed, cGreen, cBlue : Byte); + procedure RGBtoHSB(const cRed, cGreen, cBlue: Byte; var H,S,B: Word); + procedure HSBtoRGB(const H,S,B: Word; var cRed, cGreen, cBlue : Byte); implementation procedure MinMax(const i,j,k: Byte; var min: Integer; var max: Word); Inline; begin - if i > j then begin + if i > j + then begin if i > k then max := i else max := k; if j < k then min := j else min := k - end else begin + end + else begin if j > k then max := j else max := k; if i < k then min := i else min := k end; end; -procedure RGBtoHSB (const cRed, cGreen, cBlue: Byte; var H, S, B: Word); -var - Delta, MinValue, tmpH: Integer; +procedure RGBtoHSB(const cRed, cGreen, cBlue: Byte; var H, S, B: Word); +var Delta, MinValue, tmpH: Integer; begin tmpH:= 0; MinMax(cRed, cGreen, cBlue, MinValue, B); Delta := B - MinValue; - if B = 0 then S := 0 else S := (255 * Delta) div B; - if S = 0 then tmpH := 0 + if (B = 0) + then S := 0 + else S := (255 * Delta) div B; + if (S = 0) + then tmpH := 0 else begin - if cRed = B then tmpH := (60 * (cGreen - cBlue)) div Delta - else - if cGreen = B then tmpH := 120 + (60 * (cBlue - cRed)) div Delta - else - if cBlue = B then tmpH := 240 + (60 * (cRed - cGreen)) div Delta; - if tmpH < 0 then tmpH := tmpH + 360; + if (cRed = B) + then tmpH := (60 * (cGreen - cBlue)) div Delta + else if (cGreen = B) + then tmpH := 120 + (60 * (cBlue - cRed)) div Delta + else if (cBlue = B) + then tmpH := 240 + (60 * (cRed - cGreen)) div Delta; + + if (tmpH < 0) + then tmpH := tmpH + 360; end; H := tmpH; end; -procedure HSBtoRGB (const H, S, B: Word; var cRed, cGreen, cBlue : Byte); -const - divisor: Integer = 255*60; -var - f : Integer; - hTemp: Integer; - p,q,t: Integer; - VS : Integer; +procedure HSBtoRGB(const H, S, B: Word; var cRed, cGreen, cBlue : Byte); +const divisor: Integer = 255*60; +var f: Integer; + hTemp: Integer; + p, q, t: Integer; + VS: Integer; begin - if s = 0 then begin + if (s = 0) + then begin cRed:= B; cGreen:= B; cBlue:= B; - end else begin - if H = 360 then hTemp:= 0 else hTemp:= H; - f:= hTemp mod 60; - VS:= B*S; - p:= B - VS div 255; - q:= B - (VS*f) div divisor; - t:= B - (VS*(60 - f)) div divisor; - hTemp:= hTemp div 60; + end + else begin + if (H = 360) + then hTemp := 0 + else hTemp := H; + f := hTemp mod 60; + VS := B * S; + p := B - VS div 255; + q := B - (VS * f) div divisor; + t := B - (VS * (60 - f)) div divisor; + hTemp := hTemp div 60; case hTemp of - 0: begin cRed := B; cGreen := t; cBlue := p end; - 1: begin cRed := q; cGreen := B; cBlue := p end; - 2: begin cRed := p; cGreen := B; cBlue := t end; - 3: begin cRed := p; cGreen := q; cBlue := B end; - 4: begin cRed := t; cGreen := p; cBlue := B end; - 5: begin cRed := B; cGreen := p; cBlue := q end; + 0: begin cRed := B; cGreen := t; cBlue := p end; + 1: begin cRed := q; cGreen := B; cBlue := p end; + 2: begin cRed := p; cGreen := B; cBlue := t end; + 3: begin cRed := p; cGreen := q; cBlue := B end; + 4: begin cRed := t; cGreen := p; cBlue := B end; + 5: begin cRed := B; cGreen := p; cBlue := q end; end; end; end; diff --git a/components/DirWatch/Cromis.DirectoryWatch.pas b/components/DirWatch/Cromis.DirectoryWatch.pas index 64f186d..69f3d17 100644 --- a/components/DirWatch/Cromis.DirectoryWatch.pas +++ b/components/DirWatch/Cromis.DirectoryWatch.pas @@ -79,7 +79,7 @@ interface const cShutdownTimeout = 3000; cFileWaitTimeout = 0; - + type // the filters that control when the watch is triggered TWatchOption = (woFileName, woDirName, woAttributes, woSize, woLastWrite, @@ -217,8 +217,8 @@ procedure WaitForFileReady(const FileName: string; const Timeout: Cardinal); function ErrorCodeToMessage(AErrorCode: Cardinal): string; inline; begin - //Result := SysErrorMessage(AErrorCode); - Result := ':('; + Result := SysErrorMessage(AErrorCode); + //Result := ':('; end; procedure TDirWatchThread.Execute; @@ -366,9 +366,9 @@ destructor TDirWatchThread.Destroy; CancelIo(FDirHandle); - if FDirHandle <> INVALID_HANDLE_VALUE + if FDirHandle <> INVALID_HANDLE_VALUE then CloseHandle(FDirHandle); - if Assigned(FIOResult) + if Assigned(FIOResult) then FreeMemory(FIOResult); inherited Destroy; diff --git a/components/HotKey/HotKey.dfm b/components/HotKey/HotKey.dfm index b7863eb..44fc002 100644 --- a/components/HotKey/HotKey.dfm +++ b/components/HotKey/HotKey.dfm @@ -1,69 +1,122 @@ object HotkeyEdit: THotkeyEdit Left = 0 Top = 0 - Width = 353 + Width = 251 Height = 22 TabOrder = 0 OnResize = FrameResize object Bevel1: TBevel - Left = 227 + Left = 197 Top = 0 - Width = 126 + Width = 54 Height = 22 - Align = alClient + Align = alRight Shape = bsSpacer - ExplicitLeft = 228 - ExplicitWidth = 86 - end - object chbWin: TCheckBox - Left = 172 - Top = 0 - Width = 55 - Height = 22 - Align = alLeft - Caption = 'WIN +' - TabOrder = 3 - OnClick = Changed - end - object chbAlt: TCheckBox - Left = 121 - Top = 0 - Width = 51 - Height = 22 - Align = alLeft - Caption = 'ALT +' - TabOrder = 2 - OnClick = Changed - end - object chbCtrl: TCheckBox - Left = 63 - Top = 0 - Width = 58 - Height = 22 - Align = alLeft - Caption = 'CTRL +' - TabOrder = 1 - OnClick = Changed - end - object chbShift: TCheckBox - Left = 0 - Top = 0 - Width = 63 - Height = 22 - Align = alLeft - Caption = 'SHIFT +' - TabOrder = 0 - OnClick = Changed + ExplicitLeft = 349 end object htkKey: THotKey - Left = 255 + Left = 210 Top = 1 - Width = 86 + Width = 29 Height = 21 AutoSize = False HotKey = 112 Modifiers = [] - TabOrder = 4 + TabOrder = 0 OnChange = Changed end + object pnlButtons: TPanel + Left = 4 + Top = 0 + Width = 193 + Height = 22 + Align = alRight + BevelOuter = bvNone + ShowCaption = False + TabOrder = 1 + object Bevel2: TBevel + Left = 169 + Top = 0 + Width = 3 + Height = 22 + Align = alLeft + Shape = bsSpacer + end + object Bevel3: TBevel + Left = 126 + Top = 0 + Width = 3 + Height = 22 + Align = alLeft + Shape = bsSpacer + end + object Bevel4: TBevel + Left = 83 + Top = 0 + Width = 3 + Height = 22 + Align = alLeft + Shape = bsSpacer + end + object Bevel5: TBevel + Left = 40 + Top = 0 + Width = 3 + Height = 22 + Align = alLeft + Shape = bsSpacer + end + object btnAlt: TSpeedButton + Left = 86 + Top = 0 + Width = 40 + Height = 22 + Align = alLeft + AllowAllUp = True + GroupIndex = 3 + Caption = 'Alt' + Flat = True + OnClick = btnShiftClick + ExplicitLeft = 56 + end + object btnCtrl: TSpeedButton + Left = 43 + Top = 0 + Width = 40 + Height = 22 + Align = alLeft + AllowAllUp = True + GroupIndex = 2 + Caption = 'Ctrl' + Flat = True + OnClick = btnShiftClick + ExplicitLeft = 16 + end + object btnShift: TSpeedButton + Left = 0 + Top = 0 + Width = 40 + Height = 22 + Align = alLeft + AllowAllUp = True + GroupIndex = 1 + Caption = 'Shift' + Flat = True + OnClick = btnShiftClick + ExplicitLeft = 35 + end + object btnWin: TSpeedButton + Left = 129 + Top = 0 + Width = 40 + Height = 22 + Align = alLeft + AllowAllUp = True + GroupIndex = 4 + Caption = 'Win' + Flat = True + OnClick = btnShiftClick + ExplicitLeft = 182 + end + end end diff --git a/components/HotKey/HotKey.pas b/components/HotKey/HotKey.pas index 3814b6b..abd187f 100644 --- a/components/HotKey/HotKey.pas +++ b/components/HotKey/HotKey.pas @@ -1,6 +1,6 @@ {*******************************************************} { Linkbar - Windows desktop toolbar } -{ Copyright (c) 2010-2017 Asaq } +{ Copyright (c) 2010-2018 Asaq } {*******************************************************} unit HotKey; @@ -8,9 +8,8 @@ interface uses - Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, - Vcl.Controls, Vcl.Forms, Vcl.ExtCtrls, Vcl.ComCtrls, Vcl.StdCtrls, - Vcl.Dialogs, Vcl.Menus; + System.SysUtils, System.Classes, Winapi.Windows, Winapi.Messages, + Vcl.Controls, Vcl.Forms, Vcl.ExtCtrls, Vcl.ComCtrls, Vcl.Dialogs, Vcl.Menus, Vcl.Buttons; const LB_HOTKEY_ID = 1; @@ -26,28 +25,35 @@ THotkeyInfo = record public Modifiers: Word; // Winapi.Windows.MOD_... KeyCode: Word; // Virtual Key Code - constructor Create(const AInteger: Integer); overload; - constructor Create(const AString: String); overload; class operator NotEqual(const Lhs, Rhs: THotkeyInfo): Boolean; - class operator Implicit(A: THotkeyInfo): string; - class operator Implicit(A: THotkeyInfo): Integer; + class operator Implicit(const A: THotkeyInfo): string; + class operator Implicit(const A: THotkeyInfo): Integer; + class operator Implicit(const A: string): THotkeyInfo; + class operator Implicit(const A: Integer): THotkeyInfo; function ToUserString: string; end; THotkeyEdit = class(TFrame) htkKey: THotKey; - chbWin: TCheckBox; - chbAlt: TCheckBox; - chbCtrl: TCheckBox; - chbShift: TCheckBox; Bevel1: TBevel; + btnShift: TSpeedButton; + btnWin: TSpeedButton; + btnAlt: TSpeedButton; + btnCtrl: TSpeedButton; + Bevel2: TBevel; + Bevel3: TBevel; + Bevel4: TBevel; + Bevel5: TBevel; + pnlButtons: TPanel; procedure Changed(Sender: TObject); procedure FrameResize(Sender: TObject); + procedure btnShiftClick(Sender: TObject); private FOnChange: TNotifyEvent; procedure SetHotkeyInfo(AHotKeyInfo: THotkeyInfo); function GetHotkeyInfo: THotkeyInfo; procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED; + procedure UpdatePixelsPerInch; public constructor Create(AOwner: TComponent); override; property HotkeyInfo: THotkeyInfo read GetHotkeyInfo write SetHotkeyInfo; @@ -60,9 +66,10 @@ TMyTaskDialog = class(TCustomTaskDialog) lParam: LPARAM; lpRefData: LONG_PTR): HResult; override; end; - function RegisterHotkeyNotify(AWnd: HWND; AHotkeyInfo: THotkeyInfo; AWarnings: Boolean = True): Boolean; + function RegisterHotkeyNotify(AWnd: HWND; AHotkeyInfo: THotkeyInfo; AWarnings: + Boolean = True): Boolean; function UnregisterHotkeyNotify(AWnd: HWND): Boolean; - function CheckHotkey(AWnd: HWND; AHotkeyInfo: THotkeyInfo): Boolean; + function CheckHotkey(AWnd: HWND; const AHotkeyInfo: THotkeyInfo): Boolean; implementation @@ -72,25 +79,25 @@ implementation { THotKeyInfo } -constructor THotkeyInfo.Create(const AInteger: Integer); +class operator THotkeyInfo.Implicit(const A: THotkeyInfo): string; begin - Self.KeyCode := Word(AInteger); - Self.Modifiers := HiWord(AInteger); + Result := HexDisplayPrefix + IntToHex(Integer(A), 8); end; -constructor THotkeyInfo.Create(const AString: String); +class operator THotkeyInfo.Implicit(const A: THotkeyInfo): Integer; begin - Create( StrToIntDef(AString, 0) ); + Result := (A.Modifiers shl 16) or A.KeyCode; end; -class operator THotkeyInfo.Implicit(A: THotkeyInfo): string; +class operator THotkeyInfo.Implicit(const A: string): THotkeyInfo; begin - Result := HexDisplayPrefix + IntToHex(A, 8); + Result := StrToIntDef(A, 0); end; -class operator THotkeyInfo.Implicit(A: THotkeyInfo): Integer; +class operator THotkeyInfo.Implicit(const A: Integer): THotkeyInfo; begin - Result := (A.Modifiers shl 16) or A.KeyCode; + Result.KeyCode := Word(A); + Result.Modifiers := HiWord(A); end; class operator THotkeyInfo.NotEqual(const Lhs, Rhs: THotkeyInfo): Boolean; @@ -118,39 +125,72 @@ constructor THotkeyEdit.Create(AOwner: TComponent); htkKey.InvalidKeys := [hcNone, hcShift, hcCtrl, hcAlt, hcShiftCtrl, hcShiftAlt, hcCtrlAlt, hcShiftCtrlAlt]; htkKey.Modifiers := []; htkKey.HotKey := 0; + + UpdatePixelsPerInch; +end; + +procedure THotkeyEdit.UpdatePixelsPerInch; +var ppi: Integer; + + function ScaleDimension(const X: Integer): Integer; + begin + Result := MulDiv(X, ppi, 96); + end; + +begin + ppi := Screen.PixelsPerInch; + Bevel1.Width := ScaleDimension(Bevel1.Width); + Bevel2.Width := ScaleDimension(Bevel2.Width); + btnWin.Width := ScaleDimension(btnWin.Width); + Bevel3.Width := ScaleDimension(Bevel3.Width); + btnAlt.Width := ScaleDimension(btnAlt.Width); + Bevel4.Width := ScaleDimension(Bevel4.Width); + btnCtrl.Width := ScaleDimension(btnCtrl.Width); + Bevel5.Width := ScaleDimension(Bevel5.Width); + btnShift.Width := ScaleDimension(btnShift.Width); + pnlButtons.Width := 4 * Bevel2.Width + 4 * btnWin.Width; + pnlButtons.Left := Bevel1.Left - pnlButtons.Width; end; procedure THotkeyEdit.FrameResize(Sender: TObject); +var r: TRect; begin - htkKey.BoundsRect := Bevel1.BoundsRect; + r := Bevel1.BoundsRect; + r.Inflate(-2, -1); + htkKey.BoundsRect := r; end; procedure THotkeyEdit.CMEnabledChanged(var Message: TMessage); begin - chbShift.Enabled := Enabled; - chbCtrl.Enabled := Enabled; - chbAlt.Enabled := Enabled; - chbWin.Enabled := Enabled; + btnShift.Enabled := Enabled; + btnCtrl.Enabled := Enabled; + btnAlt.Enabled := Enabled; + btnWin.Enabled := Enabled; htkKey.Enabled := Enabled; end; procedure THotkeyEdit.SetHotkeyInfo(AHotKeyInfo: THotKeyInfo); begin htkKey.HotKey := AHotKeyInfo.KeyCode; - chbShift.Checked := (AHotKeyInfo.Modifiers and MOD_SHIFT) > 0; - chbCtrl.Checked := (AHotKeyInfo.Modifiers and MOD_CONTROL) > 0; - chbAlt.Checked := (AHotKeyInfo.Modifiers and MOD_ALT) > 0; - chbWin.Checked := (AHotKeyInfo.Modifiers and MOD_WIN) > 0; + btnShift.Down := (AHotKeyInfo.Modifiers and MOD_SHIFT) > 0; + btnCtrl.Down := (AHotKeyInfo.Modifiers and MOD_CONTROL) > 0; + btnAlt.Down := (AHotKeyInfo.Modifiers and MOD_ALT) > 0; + btnWin.Down := (AHotKeyInfo.Modifiers and MOD_WIN) > 0; end; function THotkeyEdit.GetHotkeyInfo: THotkeyInfo; begin Result.KeyCode := htkKey.HotKey; Result.Modifiers := 0; - if (chbShift.Checked) then Inc(Result.Modifiers, MOD_SHIFT); - if (chbCtrl.Checked) then Inc(Result.Modifiers, MOD_CONTROL); - if (chbAlt.Checked) then Inc(Result.Modifiers, MOD_ALT); - if (chbWin.Checked) then Inc(Result.Modifiers, MOD_WIN); + if (btnShift.Down) then Inc(Result.Modifiers, MOD_SHIFT); + if (btnCtrl.Down) then Inc(Result.Modifiers, MOD_CONTROL); + if (btnAlt.Down) then Inc(Result.Modifiers, MOD_ALT); + if (btnWin.Down) then Inc(Result.Modifiers, MOD_WIN); +end; + +procedure THotkeyEdit.btnShiftClick(Sender: TObject); +begin + Changed(Self); end; procedure THotkeyEdit.Changed(Sender: TObject); @@ -159,6 +199,8 @@ procedure THotkeyEdit.Changed(Sender: TObject); then FOnChange(Self); end; +{ ... } + function RegisterHotkeyNotify(AWnd: HWND; AHotkeyInfo: THotkeyInfo; AWarnings: Boolean = True): Boolean; var err: string; @@ -200,7 +242,7 @@ function UnregisterHotkeyNotify(AWnd: HWND): Boolean; Result := UnregisterHotKey(AWnd, LB_HOTKEY_ID); end; -function CheckHotkey(AWnd: HWND; AHotkeyInfo: THotkeyInfo): Boolean; +function CheckHotkey(AWnd: HWND; const AHotkeyInfo: THotkeyInfo): Boolean; begin Result := RegisterHotkeyNotify(AWnd, AHotkeyInfo); UnregisterHotkeyNotify(AWnd); diff --git a/components/Jumplist/JumpLists.Api.pas b/components/Jumplist/JumpLists.Api.Deprecated.pas similarity index 91% rename from components/Jumplist/JumpLists.Api.pas rename to components/Jumplist/JumpLists.Api.Deprecated.pas index bcb2084..d952518 100644 --- a/components/Jumplist/JumpLists.Api.pas +++ b/components/Jumplist/JumpLists.Api.Deprecated.pas @@ -1,9 +1,9 @@ {*******************************************************} { Linkbar - Windows desktop toolbar } -{ Copyright (c) 2010-2017 Asaq } +{ Copyright (c) 2010-2018 Asaq } {*******************************************************} -// Port JumpLists.h and JumpLists.cpp from the Classic Shell http://www.classicshell.net +// Port JumpLists.h and JumpLists.cpp from the Classic Shell 3.6.8 http://www.classicshell.net // The sources for Linkbar are distributed under the MIT open source license unit Jumplists.Api; @@ -82,8 +82,6 @@ TJumplist = class function CalcFNVHash(const AData; ALength: integer; AHash: Cardinal = 2166136261): Cardinal; overload; function CalcFNVHash(const AData: PChar; AHash: Cardinal = 2166136261): Cardinal; overload; - function GetJumplistMaxCount: Integer; - implementation uses Winapi.PropSys, Winapi.PropKey, Winapi.KnownFolders, Winapi.ShLwApi, @@ -215,40 +213,6 @@ destructor TJumplist.Destroy; inherited; end; -//////////////////////////////////////////////////////////////////////////////// - -function GetJumplistMaxCount: Integer; -const - JL_REG_PATH_1 = '\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced'; - JL_REG_KEY_1 = 'Start_JumpListItems'; - JL_REG_PATH_2 = '\Software\Microsoft\Windows\CurrentVersion\Explorer\ApplicationDestinations'; - JL_REG_KEY_2 = 'MaxEntries'; -var res: Integer; - reg: TRegistry; -begin - // get jumplist items max count - res := 0; - reg := TRegistry.Create; - try - reg.RootKey := HKEY_CURRENT_USER; - - if reg.OpenKeyReadOnly(JL_REG_PATH_1) - and (reg.GetDataType(JL_REG_KEY_1) = rdInteger) - then res := reg.ReadInteger(JL_REG_KEY_1) - else - if reg.OpenKeyReadOnly(JL_REG_PATH_2) - and (reg.GetDataType(JL_REG_KEY_2) = rdInteger) - then res := reg.ReadInteger(JL_REG_KEY_2); - finally - reg.Free; - end; - - if (res > LB_JUMLIST_MAX_COUNT) - then res := LB_JUMLIST_MAX_COUNT; - - Result := res; -end; - // Creates the app id resolver object procedure CreateAppResolver; var t: Cardinal; @@ -548,7 +512,7 @@ function CalcLinkStreamHash(AStorage: IStorage; AStream: Integer): Cardinal; CoTaskMemFree(pName); end; CoTaskMemFree(pidl); - + pLink.QueryInterface(IPropertyStore, pStore); if Assigned(pStore) then begin @@ -583,6 +547,13 @@ procedure GetKnownCategory(const AAppId: PChar; AGroup: TJumpGroup; end; end; +function StreamRead(const AStream: IStream; const AData: Pointer; const ASize: Longint): Boolean; +var read: Longint; +begin + read := 0; + Result := (AStream.Read(AData, ASize, @read) = S_OK) and (ASize = read); +end; + function GetJumplist(const AAppId: PChar; AList: TJumplist; AMaxCount: Integer): Boolean; var id: array[0..MAX_PATH] of Char; crc: UInt64; @@ -603,7 +574,7 @@ function GetJumplist(const AAppId: PChar; AList: TJumplist; AMaxCount: Integer): destheader: TJumplistDestListHeader; pinStreams: TIntegerDynArray; itemheader: TJumplistDestListItemHeader; - seek, newpos: TLbStorageSeek; + seek, dummy: TLbStorageSeek; streamName: string; bReplaced: Boolean; hash: Cardinal; @@ -630,7 +601,8 @@ function GetJumplist(const AAppId: PChar; AList: TJumplist; AMaxCount: Integer): if Succeeded( SHCreateStreamOnFile(PChar(path1), STGM_READ, pStream) ) then begin {$REGION ' Read custom destinations '} - if Failed( pStream.Read(@customheader, SizeOf(customheader), nil) ) + //if Failed( pStream.Read(@customheader, SizeOf(customheader), nil) ) + if not StreamRead(pStream, @customheader, SizeOf(customheader)) then Exit; AList.reserved := customheader.iReserved; AList.Groups.Capacity := customheader.iGroupCount + 1; @@ -642,14 +614,16 @@ function GetJumplist(const AAppId: PChar; AList: TJumplist; AMaxCount: Integer): groupIdx := 1; while groupIdx <= customheader.iGroupCount do begin - if Failed( pStream.Read(@iType, 4, nil) ) + //if Failed( pStream.Read(@iType, 4, nil) ) + if not StreamRead(pStream, @iType, 4) then Exit; oGroup := AList.Groups[groupIdx]; if (iType = 1) then begin // known category - if Failed( pStream.Read(@iType, 4, nil) ) + //if Failed( pStream.Read(@iType, 4, nil) ) + if not StreamRead(pStream, @iType, 4) then Exit; if (iType = 1) then begin @@ -667,8 +641,10 @@ function GetJumplist(const AAppId: PChar; AList: TJumplist; AMaxCount: Integer): else begin if (iType = 0) then begin - if Failed( pStream.Read(@len, 2, nil) ) - or Failed( pStream.Read(@str[0], len*2, nil) ) + //if Failed( pStream.Read(@len, 2, nil) ) + // or Failed( pStream.Read(@str[0], len*2, nil) ) + if (not StreamRead(pStream, @len, 2)) + or (not StreamRead(pStream, @str[0], len*2)) then Exit; str[len] := #0; oGroup.Name0 := str; @@ -688,12 +664,14 @@ function GetJumplist(const AAppId: PChar; AList: TJumplist; AMaxCount: Integer): oGroup.eType := jgTasks; end; - if Failed( pStream.Read(@count, 4, nil) ) + //if Failed( pStream.Read(@count, 4, nil) ) + if not StreamRead(pStream, @count, 4) then Exit; for i := 0 to count-1 do begin - if Failed( pStream.Read(@clsid, SizeOf(clsid), nil) ) + //if Failed( pStream.Read(@clsid, SizeOf(clsid), nil) ) + if not StreamRead(pStream, @clsid, SizeOf(clsid)) then Exit; pPersist := CreateComObject(clsid) as IPersistStream; if not Assigned(pPersist) or Failed( pPersist.Load(pStream) ) @@ -702,7 +680,8 @@ function GetJumplist(const AAppId: PChar; AList: TJumplist; AMaxCount: Integer): end; end; oGroup.Hidden := False; - if Failed( pStream.Read(@cookie, 4, nil) ) or (cookie <> $BABFFBAB) + //if Failed( pStream.Read(@cookie, 4, nil) ) or (cookie <> $BABFFBAB) + if (not StreamRead(pStream, @cookie, 4)) or (cookie <> $BABFFBAB) then Exit; Inc(groupIdx); @@ -733,7 +712,7 @@ function GetJumplist(const AAppId: PChar; AList: TJumplist; AMaxCount: Integer): then begin if Succeeded( pStorage.OpenStream('DestList', nil, STGM_READ or STGM_SHARE_EXCLUSIVE, 0, pStream) ) then begin - if Succeeded( pStream.Read(@destheader, SizeOf(destheader), nil) ) + if StreamRead(pStream, @destheader, SizeOf(destheader)) then begin SetLength(pinStreams, destheader.pinCount); for i := 0 to High(pinStreams) do @@ -741,7 +720,8 @@ function GetJumplist(const AAppId: PChar; AList: TJumplist; AMaxCount: Integer): for i := 0 to destheader.count-1 do begin - if Failed( pStream.Read(@itemheader, SizeOf(itemheader), nil) ) + //if Failed( pStream.Read(@itemheader, SizeOf(itemheader), nil) ) + if not StreamRead(pStream, @itemheader, SizeOf(itemheader)) then Break; crc := itemheader.crc; itemheader.crc := 0; @@ -751,18 +731,18 @@ function GetJumplist(const AAppId: PChar; AList: TJumplist; AMaxCount: Integer): if IsWindows10 then begin seek := 16; - if Failed( pStream.Seek(seek, STREAM_SEEK_CUR, newpos) ) + if Failed( pStream.Seek(seek, STREAM_SEEK_CUR, dummy) ) then Break; end; - if Failed( pStream.Read(@len, 2, nil) ) + //if Failed( pStream.Read(@len, 2, nil) ) + if not StreamRead(pStream, @len, 2) then Break; seek := len*2; if IsWindows10 then seek := seek + 4; - newpos := 0; - if Failed( pStream.Seek(seek, STREAM_SEEK_CUR, newpos) ) + if Failed( pStream.Seek(seek, STREAM_SEEK_CUR, dummy) ) then Break; if (itemheader.pinIdx >= 0) and (itemheader.pinIdx < destheader.pinCount) then pinStreams[itemheader.pinIdx] := itemheader.stream; @@ -1213,12 +1193,14 @@ procedure PinJumpItem(const AAppId: PChar; const AList: TJumplist; const AGroupI pinCount := 0; if Succeeded( pStorage.OpenStream('DestList', nil, STGM_READ or STGM_SHARE_EXCLUSIVE, 0, pStream) ) then begin - if Failed( pStream.Read(@autoheader, SizeOf(autoheader), nil) ) + //if Failed( pStream.Read(@autoheader, SizeOf(autoheader), nil) ) + if not StreamRead(pStream, @autoheader, SizeOf(autoheader)) then Exit; for i := 0 to autoheader.count-1 do begin - if Failed( pStream.Read(@(item.header), SizeOf(item.header), nil) ) + //if Failed( pStream.Read(@(item.header), SizeOf(item.header), nil) ) + if not StreamRead(pStream, @item.header, SizeOf(item.header)) then Exit; if IsWindows10 @@ -1228,11 +1210,13 @@ procedure PinJumpItem(const AAppId: PChar; const AList: TJumplist; const AGroupI then Break; end; - if Failed( pStream.Read(@len, 2, nil) ) + //if Failed( pStream.Read(@len, 2, nil) ) + if not StreamRead(pStream, @len, 2) then Exit; if (len >= Length(name)) then Exit; - if Failed( pStream.Read(@name[0], len*2, nil) ) + //if Failed( pStream.Read(@name[0], len*2, nil) ) + if not StreamRead(pStream, @name[0], len*2) then Exit; name[len] := #0; item.name := name; @@ -1405,11 +1389,8 @@ procedure PinJumpItem(const AAppId: PChar; const AList: TJumplist; const AGroupI try reg.RootKey := HKEY_CURRENT_USER; if reg.OpenKeyReadOnly('Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced') - // and reg.ValueExists('Start_TrackDocs') - //then bUsed := reg.ReadInteger('Start_TrackDocs') > 0; - then bUsed := ( not reg.ValueExists('Start_TrackDocs') ) - or ( reg.GetDataType('Start_TrackDocs') <> rdInteger ) - or ( reg.ReadInteger('Start_TrackDocs') > 0 ); + then bUsed := (reg.GetDataType('Start_TrackDocs') <> rdInteger) + or (reg.ReadInteger('Start_TrackDocs') > 0); finally reg.Free; end; diff --git a/components/Jumplist/JumpLists.Api_2.pas b/components/Jumplist/JumpLists.Api_2.pas new file mode 100644 index 0000000..796a411 --- /dev/null +++ b/components/Jumplist/JumpLists.Api_2.pas @@ -0,0 +1,925 @@ +{*******************************************************} +{ Linkbar - Windows desktop toolbar } +{ Copyright (c) 2010-2018 Asaq } +{*******************************************************} + +// Port JumpLists.h and JumpLists.cpp from the Classic Shell 4.3.1 http://www.classicshell.net +// The sources for Linkbar are distributed under the MIT open source license + +unit JumpLists.Api_2; + +{$i linkbar.inc} + +interface + +uses + Winapi.Windows, System.Types, Winapi.ShlObj, System.Generics.Collections; + +const + FNV_HASH0 = 2166136261; + +type + TJumpItemType = (jiUnknown, jiItem, jiLink, jiSeparator); + + TJumpItem = record + eType: TJumpItemType; + Hash: Cardinal; + Hidden: Boolean; + HasArguments: Boolean; + Name: string; + Item: IUnknown; + end; + + TJumpItemList = TList; + + TJumpGroupeType = (jgRecent, jgFrequent, jgTasks, jgCustom, jgPinned); + + TJumpGroup = class + public + eType: TJumpGroupeType; + Hidden: Boolean; + Name: string; + Items: TJumpItemList; + public + constructor Create; + destructor Destroy; override; + end; + + TJumpGroupList = TObjectList; + + TJumplist = class + public + Groups: TJumpGroupList; + public + constructor Create; + destructor Destroy; override; + procedure Clear; + end; + + // Returns the App ID for then APidl. AAppid must be MAX_PATH characters + function GetAppInfoForLink(const APidl: PItemIDList; AAppId: PChar): Boolean; + // Returns true if the given app has a non-empty jumplist + function HasJumplist(const AAppId: PChar): Boolean; + // Returns the jumplist for the given shortcut + function GetJumplist(const AAppId: PChar; AList: TJumplist; AMaxCount{, AMaxHeight, ASepHeight, AItemHeight}: Integer): Boolean; + // Executes the given item using the correct application + function ExecuteJumpItem(const AItem: TJumpItem; const AWnd: HWND): Boolean; + // Removes the given item from the jumplist + procedure RemoveJumpItem(const AAppId: PChar; const AList: TJumplist; const AGroupIdx, AItemIdx: Integer); + // Pins or unpins the given item from the jumplist + procedure PinJumpItem(const AAppId: PChar; const AList: TJumplist; const AGroupIdx, AItemIdx: Integer; const APin: Boolean; const APinIndex: Integer); + // FNV hash algorithm as described here: http://www.isthe.com/chongo/tech/comp/fnv/index.html + // Calculate FNV hash for a memory buffer + function CalcFNVHash(const AData; ALength: integer; AHash: Cardinal = FNV_HASH0): Cardinal; overload; + // Calculate FNV hash for a string + function CalcFNVHash(const AData: PChar; AHash: Cardinal = FNV_HASH0): Cardinal; overload; + +implementation + +uses + System.SysUtils, System.Win.ComObj, Winapi.ActiveX, Winapi.ObjectArray, + Winapi.ShellAPI, Winapi.PropKey, Winapi.PropSys, Linkbar.OS, Linkbar.L10n; + +const + { Jumplist list type } + JL_LT_PINNED = 0; + JL_LT_RECENT = 1; + JL_LT_FREQUENT = 2; + { Jumplist category type } + JL_CT_CUSTOM = 0; + JL_CT_NORMAL = 1; + JL_CT_TASKS = 2; + + // In Delphi XE3 the following constants are not defined + // Name: System.AppUserModel.PreventPinning -- PKEY_AppUserModel_PreventPinning + // Type: Boolean -- VT_BOOL + // FormatID: {9F4C2855-9F79-4B39-A8D0-E1D42DE1D5F3}, 9 + PKEY_AppUserModel_PreventPinning: TPropertyKey = (fmtid: '{9F4C2855-9F79-4B39-A8D0-E1D42DE1D5F3}'; pid: 9); + + CLSID_ApplicationResolver: TGUID = '{660B90C8-73A9-4B58-8CAE-355B7F55341B}'; + // different IIDs for Win7 and Win8: http://a-whiter.livejournal.com/1266.html + IID_IApplicationResolverW7: TGUID = '{46A6EEFF-908E-4DC6-92A6-64BE9177B41C}'; + IID_IApplicationResolverW8: TGUID = '{DE25675A-72DE-44B4-9373-05170450C140}'; + + IID_IDestinationList: TGUID = '{03f1eed2-8676-430b-abe1-765c1d8fe147}'; + IID_IDestinationList10a: TGUID = '{febd543d-1f7b-4b38-940b-5933bd2cb21b}'; // 10240 + IID_IDestinationList10b: TGUID = '{507101cd-f6ad-46c8-8e20-eeb9e6bac47f}'; // 10547 + + CLSID_AutomaticDestinationList: TGUID = '{f0ae1542-f497-484b-a175-a20db09144ba}'; + IID_IAutomaticDestinationList: TGUID = '{bc10dce3-62f2-4bc6-af37-db46ed7873c4}'; + IID_IAutomaticDestinationList10b: TGUID = '{e9c5ef8d-fd41-4f72-ba87-eb03bad5817c}'; // 10547 + +type + // http://a-whiter.livejournal.com/1266.html + IApplicationResolver = interface(IUnknown) + function GetAppIDForShortcut(psi: IShellItem; var AppID: LPWSTR): HResult; stdcall; + { ... } + end; + + APPDESTCATEGORY = record + eType: NativeInt; + union: packed record + case Integer of + 0: (name: PChar); + 1: (subType: NativeInt); + end; + count: NativeInt; + pad: array[0..9] of Integer; // just in case + end; + TAppDestCategory = APPDESTCATEGORY; + + IDestinationList = interface(IUnknown) + function SetMinItems(): HRESULT; stdcall; + function SetApplicationID(appUserModelId: LPCWSTR): HRESULT; stdcall; + function GetSlotCount(): HRESULT; stdcall; + function GetCategoryCount(var pCount: UINT): HRESULT; stdcall; + function GetCategory(index: UINT; getCatFlags: Integer; var pCategory: TAppDestCategory): HRESULT; stdcall; + function DeleteCategory(): HRESULT; stdcall; + function EnumerateCategoryDestinations(index: UINT; const riid: {REFIID}TIID; var ppvObjectT: Pointer): HRESULT; stdcall; + function RemoveDestination(pItem: IUnknown): HRESULT; stdcall; + function ResolveDestination(): HRESULT; stdcall; + end; + + IAutomaticDestinationList = interface(IUnknown) + function Initialize(appUserModelId: LPCWSTR; lnkPath: LPCWSTR; u: LPCWSTR): HRESULT; stdcall; + function HasList(var pHasList: BOOL): HRESULT; stdcall; + function GetList(listType: Integer; maxCount: Integer{Cardinal}; const riid: {REFIID}TIID; var ppvObject: Pointer): HRESULT; stdcall; + function AddUsagePoint(): HRESULT; stdcall; + function PinItem(pItem: IUnknown; pinIndex: Integer): HRESULT; stdcall; // -1 - pin, -2 - unpin + function IsPinned(): HRESULT; stdcall; + function RemoveDestination(pItem: IUnknown): HRESULT; stdcall; + function SetUsageData(): HRESULT; stdcall; + function GetUsageData(): HRESULT; stdcall; + function ResolveDestination(): HRESULT; stdcall; + function ClearList(listType: Integer): HRESULT; stdcall; + end; + + // Difference in GetList() new argument - flags + IAutomaticDestinationList10b = interface(IUnknown) + function Initialize(appUserModelId: LPCWSTR; lnkPath: LPCWSTR; u: LPCWSTR): HRESULT; stdcall; + function HasList(var pHasList: BOOL): HRESULT; stdcall; + function GetList(listType: Integer; maxCount: Cardinal; flags: Cardinal; const riid: {REFIID}TIID; var ppvObject: Pointer): HRESULT; stdcall; + function AddUsagePoint(): HRESULT; stdcall; + function PinItem(pItem: IUnknown; pinIndex: Integer): HRESULT; stdcall; // -1 - pin, -2 - unpin + function IsPinned(): HRESULT; stdcall; + function RemoveDestination(pItem: IUnknown): HRESULT; stdcall; + function SetUsageData(): HRESULT; stdcall; + function GetUsageData(): HRESULT; stdcall; + function ResolveDestination(): HRESULT; stdcall; + function ClearList(listType: Integer): HRESULT; stdcall; + end; + + TAutomaticList = class + private + m_pAutoList: IAutomaticDestinationList; + m_pAutoList10b: IAutomaticDestinationList10b; + public + constructor Create(const appid: PWideChar); + function HasList(): Boolean; + function GetList(listType: Integer; maxCount: Cardinal): IObjectCollection; + procedure PinItem(pItem: IUnknown; pinIndex: Integer); + function RemoveDestination(pItem: IUnknown): Boolean; + end; + + TShellItemList = TList; + TcardinalList = TList; + +// In Delphi XE3 the following functions are not defined + +function SHLoadIndirectString(pszSource, pszOutBuf: PWideChar; cchOutBuf: UINT; ppvReserved: Pointer): HResult; + stdcall; external 'shlwapi.dll' name 'SHLoadIndirectString' delayed; + +{ TAutomaticList } + +constructor TAutomaticList.Create(const appid: PWideChar); +var pAutoListUnk: IUnknown; + hr: HRESULT; +begin + pAutoListUnk := CreateComObject(CLSID_AutomaticDestinationList); + if Assigned(pAutoListUnk) + then begin + pAutoListUnk.QueryInterface(IID_IAutomaticDestinationList, m_pAutoList); + if Assigned(m_pAutoList) + then begin + hr := m_pAutoList.Initialize(appid, nil, nil); + if Failed(hr) + then m_pAutoList := nil; + end + else if IsWindows10OrAbove + then begin + pAutoListUnk.QueryInterface(IID_IAutomaticDestinationList10b, m_pAutoList10b); + if Assigned(m_pAutoList10b) + then begin + hr := m_pAutoList10b.Initialize(appid, nil, nil); + if Failed(hr) + then m_pAutoList10b := nil; + end; + end; + end; +end; + +function TAutomaticList.HasList(): Boolean; +var hasList: BOOL; + pCollection: IObjectCollection; + count: Cardinal; + // + hr: HRESULT; +begin + if Assigned(m_pAutoList) + then begin + hr := m_pAutoList.HasList(hasList); + if Failed(hr) + or (not hasList) + then Exit(False); + end + else if Assigned(m_pAutoList10b) + then begin + hr := m_pAutoList10b.HasList(hasList); + if Failed(hr) + or (not hasList) + then Exit(False); + end + else Exit(False); + + pCollection := GetList(JL_LT_RECENT, 1); + if Assigned(pCollection) + and Succeeded(pCollection.GetCount(count)) + and (count > 0) + then Exit(True); + + pCollection := GetList(JL_LT_PINNED, 1); + if Assigned(pCollection) + and Succeeded(pCollection.GetCount(count)) + and (count > 0) + then Exit(True); + + Result := False; +end; + +function TAutomaticList.GetList(listType: Integer; maxCount: Cardinal): IObjectCollection; +var pCollection: IObjectCollection; +begin + if Assigned(m_pAutoList) + then m_pAutoList.GetList(listType, maxCount, IID_IObjectCollection, Pointer(pCollection)) + else if Assigned(m_pAutoList10b) + then m_pAutoList10b.GetList(listType, maxCount, 1, IID_IObjectCollection, Pointer(pCollection)); + Result := pCollection; +end; + +procedure TAutomaticList.PinItem(pItem: IUnknown; pinIndex: Integer); +begin + if Assigned(m_pAutoList) + then m_pAutoList.PinItem(pItem, pinIndex) + else if Assigned(m_pAutoList10b) + then m_pAutoList10b.PinItem(pItem, pinIndex); +end; + +function TAutomaticList.RemoveDestination(pItem: IUnknown): Boolean; +begin + Result := False; + if Assigned(m_pAutoList) + then Result := Succeeded(m_pAutoList.RemoveDestination(pItem)) + else if Assigned(m_pAutoList10b) + then Result := Succeeded(m_pAutoList10b.RemoveDestination(pItem)); +end; + +{ TJumpGroup } + +constructor TJumpGroup.Create; +begin + inherited; + eType := jgRecent; + Hidden := False; + Items := TJumpItemList.Create; +end; + +destructor TJumpGroup.Destroy; +begin + Items.Free; + inherited; +end; + +{ TJumpList } + +constructor TJumpList.Create; +begin + inherited; + Groups := TJumpGroupList.Create; +end; + +destructor TJumpList.Destroy; +begin + Groups.Free; + inherited; +end; + +procedure TJumpList.Clear; +begin + Groups.Clear; +end; + +{ --- } + +function GetCustomList(const AAppId: PChar): IDestinationList; +var pCustomListUnk: IUnknown; + pCustomList: IDestinationList; +begin + pCustomListUnk := CreateComObject(CLSID_DestinationList); + if Assigned(pCustomListUnk) + then begin + if IsWindows10OrAbove + then begin + if Failed(pCustomListUnk.QueryInterface(IID_IDestinationList10a, Pointer(pCustomList))) + then pCustomListUnk.QueryInterface(IID_IDestinationList10b, Pointer(pCustomList)) + end + else pCustomListUnk.QueryInterface(IID_IDestinationList, Pointer(pCustomList)); + + if Assigned(pCustomList) + and Succeeded(pCustomList.SetApplicationID(AAppId)) + then Exit(pCustomList) + end; + Result := nil; +end; + +function HasJumplist(const AAppId: PChar): Boolean; +var pCustomList: IDestinationList; + count: UINT; + autoList: TAutomaticList; + // + hr: HRESULT; +begin + pCustomList := GetCustomList(AAppId); + if Assigned(pCustomList) + then begin + hr := pCustomList.GetCategoryCount(count); + if Succeeded(hr) + and (count > 0) + then Exit(True); + end; + + autoList := TAutomaticList.Create(AAppId); + Result := autoList.HasList(); + autoList.Free; +end; + +function GetPropertyStoreString(AStore: IPropertyStore; AKey: TPropertyKey): string; +var val: TPropVariant; +begin + Result := ''; + PropVariantInit(val); + if Succeeded(AStore.GetValue(AKey, val)) + then begin + if val.vt in [VT_LPWSTR, VT_BSTR] + then Result := val.pwszVal + else if (val.vt = VT_LPSTR) + then Result := String(val.pszVal); + end; + PropVariantClear(val); +end; + +// FNV hash algorithm as described here: http://www.isthe.com/chongo/tech/comp/fnv/index.html +// Calculate FNV hash for a memory buffer +function CalcFNVHash(const AData; ALength: integer; AHash: Cardinal = FNV_HASH0): Cardinal; overload; +var pData: PByte; + i: Integer; +begin + pData := PByte(@AData); + for i := 1 to ALength do + begin + AHash := (AHash xor pData^) * 16777619; + Inc(pData); + end; + Result := AHash; +end; + +// Calculate FNV hash for a string +function CalcFNVHash(const AData: PChar; AHash: Cardinal = FNV_HASH0): Cardinal; overload; +begin + Result := CalcFNVHash(AData^, StrLen(AData)*SizeOf(Char), AHash); +end; + +function CalcLinkHash(pLink: IShellLink): Cardinal; +var pidl: PItemIDList; + hash: Cardinal; + pName: LPWSTR; + pStore: IPropertyStore; + args: string; +begin + if Failed(pLink.GetIDList(pidl)) + then Exit(0); + + hash := FNV_HASH0; + if Succeeded(SHGetNameFromIDList(pidl, Integer(SIGDN_DESKTOPABSOLUTEPARSING), pName)) + then begin + CharUpper(pName); + hash := CalcFNVHash(pName); + end; + + pLink.QueryInterface(IID_IPropertyStore, pStore); + if Assigned(pStore) + then begin + args := GetPropertyStoreString(pStore, PKEY_Link_Arguments); + if (args <> '') + then hash := CalcFNVHash(PChar(args), hash); + end; + + Result := hash; +end; + +procedure AddJumpItem(const AGroup: TJumpGroup; const AUnknown: IUnknown; const AIgnoreItems: TShellItemList; const AIgnoreLinks: TcardinalList); +var item: TJumpItem; + pItem: IShellItem; + pLink: IShellLink; + i: Integer; + order: Integer; + pName: LPWSTR; + hash: Cardinal; + pStore: IPropertyStore; + val: TPropVariant; + str, args: string; + name: array[0..255] of Char; + pidl: PItemIDList; +begin + item.eType := jiUnknown; + item.Item := AUnknown; + item.Hash := 0; + item.Hidden := False; + item.HasArguments := False; + + AUnknown.QueryInterface(IID_IShellItem, pItem); + if Assigned(pItem) + then begin + for i := 0 to AIgnoreItems.Count-1 do + begin + if Succeeded(pItem.Compare(AIgnoreItems[i], SICHINT_CANONICAL or SICHINT_TEST_FILESYSPATH_IF_NOT_EQUAL, order)) + and (order = 0) + then Exit; + end; + + item.eType := jiItem; + // SIGDN_NORMALDISPLAY used in original code of ClassicShell; + // SIGDN_PARENTRELATIVE retur drive name as "Drivename (D:)". Problems - (???) non localized names; + if Failed(pItem.GetDisplayName(SIGDN_NORMALDISPLAY, pName)) + then Exit; + item.Name := pName; + CoTaskMemFree(pName); + if Succeeded(pItem.GetDisplayName(SIGDN_DESKTOPABSOLUTEPARSING, pName)) + then begin + CharUpper(pName); + item.Hash := CalcFNVHash(pName); + CoTaskMemFree(pName); + end; + AGroup.Items.Add(item); + Exit; + end; + + AUnknown.QueryInterface(IID_IShellLink, pLink); + if Assigned(pLink) + then begin + hash := CalcLinkHash(pLink); + for i := 0 to AIgnoreLinks.Count-1 do + begin + if (hash = AIgnoreLinks[i]) + then Exit; + end; + + item.eType := jiLink; + pLink.QueryInterface(IID_IPropertyStore, pStore); + if Assigned(pStore) + then begin + PropVariantInit(val); + if (AGroup.eType = jgTasks) + and Succeeded(pStore.GetValue(PKEY_AppUserModel_IsDestListSeparator, val)) + and (val.vt = VT_BOOL) + and (val.boolVal) + then begin + item.eType := jiSeparator; + PropVariantClear(val); + end + else begin + str := GetPropertyStoreString(pStore, PKEY_Title); + if (str <> '') + then begin + SHLoadIndirectString(PChar(str), name, 256, nil); + item.Name := name; + end; + end; + end; + + if Succeeded(pLink.GetIDList(pidl)) + and (pidl <> nil) + then begin + if (item.Name = '') + and Succeeded(SHGetNameFromIDList(pidl, SIGDN_NORMALDISPLAY, pName)) + then begin + item.Name := pName; + CoTaskMemFree(pName); + end; + if Succeeded(SHGetNameFromIDList(pidl, Integer(SIGDN_DESKTOPABSOLUTEPARSING), pName)) + then begin + CharUpper(pName); + item.Hash := CalcFNVHash(pName); + CoTaskMemFree(pName); + end; + CoTaskMemFree(pidl); + + //pLink.QueryInterface(IID_IPropertyStore, pStore); retrieved above + if Assigned(pStore) + then begin + args := GetPropertyStoreString(pStore, PKEY_Link_Arguments); + if (args <> '') + then begin + item.Hash := CalcFNVHash(PChar(args), item.Hash); + item.HasArguments := True; + end; + end; + end; + + if (item.Name <> '') + then AGroup.Items.Add(item); + + Exit; + end; +end; + +procedure AddJumpCollection(const AGroup: TJumpGroup; const ACollection: IObjectCollection; + const AIgnoreItems: TShellItemList; const AIgnoreLinks: TcardinalList); +var count: UINT; + i: Integer; + pUnknown: IUnknown; +begin + if Succeeded(ACollection.GetCount(count)) + then begin + for i := 0 to Integer(count-1) do + if Succeeded(ACollection.GetAt(i, IUnknown, Pointer(pUnknown))) + and Assigned(pUnknown) + then AddJumpItem(AGroup, pUnknown, AIgnoreItems, AIgnoreLinks); + end; +end; + +function GetJumplist(const AAppId: PChar; AList: TJumplist; AMaxCount{, AMaxHeight, ASepHeight, AItemHeight}: Integer): Boolean; +var pCustomList: IDestinationList; + categoryCount: UINT; + autoList: TAutomaticList; + ignoreItems: TShellItemList; + ignoreLinks: TCardinalList; + pCollection: IObjectCollection; + i, j, taskIndex, catIndex: Integer; + group: TJumpGroup; + item: TJumpItem; + pShellItem: IShellItem; + pLink: IShellLink; + hash: Cardinal; + category: TAppDestcategory; + name: array[0..255] of Char; + // + hr: HRESULT; + maxcount: Integer; +begin + AList.Clear; + + pCustomList := GetCustomList(AAppId); + if (not Assigned(pCustomList)) + or Failed(pCustomList.GetCategoryCount(categoryCount)) + then categoryCount := 0; + + AList.Groups.Capacity := categoryCount + 2; + + ignoreItems := TShellItemList.Create; + ignoreLinks := TCardinalList.Create; + autoList := TAutomaticList.Create(AAppId); + // Add Pinned + pCollection := autoList.GetList(JL_LT_PINNED, {AMaxCount}30); + if Assigned(pCollection) + then begin + group := TJumpGroup.Create; + AList.Groups.Add(group); + group.eType := jgPinned; + group.Name := L10NFind('Jumplist.Pinned', 'Pinned'); + AddJumpCollection(group, pCollection, ignoreItems, ignoreLinks); + for i := 0 to group.Items.Count-1 do + begin + item := group.Items[i]; + item.Item.QueryInterface(IID_IShellItem, pShellItem); + if Assigned(pShellItem) + then ignoreItems.Add(pShellItem) + else begin + item.Item.QueryInterface(IID_IShellLink, pLink); + if Assigned(pLink) + then begin + hash := CalcLinkHash(pLink); + if (hash <> 0) + then ignoreLinks.Add(hash); + end; + end; + end; + end; + + maxcount := AMaxCount + ignoreItems.Count + ignoreLinks.Count; + + // Add Custom, Recent, Frequent + taskIndex := -1; + for catIndex := 0 to Integer(categoryCount-1) do + begin + FillChar(category, SizeOf(category), 0); + hr := pCustomList.GetCategory(catIndex, 1, category); + if Succeeded(hr) + then begin + if (AMaxCount > 0) + and (category.eType = JL_CT_CUSTOM) + then begin + // custom group + if (category.union.name <> nil) + and (category.union.name <> '') + then begin + SHLoadIndirectString(category.union.name, name, 256, nil); + CoTaskMemFree(category.union.name); + if Succeeded(pCustomList.EnumerateCategoryDestinations(catIndex, IID_IObjectCollection, Pointer(pCollection))) + and Assigned(pCollection) + then begin + group := TJumpGroup.Create; + AList.Groups.Add(group); + group.eType := jgCustom; + group.Name := name; + AddJumpCollection(group, pCollection, ignoreItems, ignoreLinks); + end; + end; + end + else if (category.eType = JL_CT_NORMAL) + then begin + // standard group + if (AMaxCount > 0) + and (category.union.subType in [JL_LT_RECENT, JL_LT_FREQUENT]) + then begin + pCollection := autoList.GetList(3 - category.union.subType, maxcount); + if Assigned(pCollection) + then begin + group := TJumpGroup.Create; + AList.Groups.Add(group); + if (category.union.subType = 1) + then begin + group.eType := jgFrequent; + group.Name := L10NFind('Jumplist.Frequent', 'Frequent'); + end + else begin + group.eType := jgRecent; + group.Name := L10NFind('Jumplist.Recent', 'Recent'); + end; + AddJumpCollection(group, pCollection, ignoreItems, ignoreLinks); + end; + end; + end + else if (category.eType = JL_CT_TASKS) + and (taskIndex = -1) + then begin + taskIndex := catIndex; + end; + end; + end; + + // Add Tasks + if (taskIndex <> -1) + and Succeeded(pCustomList.EnumerateCategoryDestinations(taskIndex, IID_IObjectCollection, Pointer(pCollection))) + and Assigned(pCollection) + then begin + group := TJumpGroup.Create; + AList.Groups.Add(group); + group.eType := jgTasks; + group.Name := L10NFind('Jumplist.Tasks', 'Tasks'); + AddJumpCollection(group, pCollection, ignoreItems, ignoreLinks); + end; + + if (categoryCount = 0) + and (AMaxCount > 0) + then begin + // Add Recent + pCollection := autoList.GetList(1, maxcount); + if Assigned(pCollection) + then begin + group := TJumpGroup.Create; + AList.Groups.Add(group); + group.eType := jgRecent; + group.Name := L10NFind('Jumplist.Recent', 'Recent'); + AddJumpCollection(group, pCollection, ignoreItems, ignoreLinks); + end; + end; + + ignoreItems.Free; + ignoreLinks.Free; + autoList.Free; + + for i := 0 to AList.Groups.Count-1 do + begin + group := AList.Groups[i]; + if not (group.eType in [jgTasks, jgPinned]) + then for j := 0 to group.Items.Count-1 do + begin + item := group.Items[j]; + item.Hidden := (j >= AMaxCount); + group.Items[j] := item; + end; + end; + + // Hide empty groups + for i := 0 to AList.Groups.Count-1 do + begin + group := AList.Groups[i]; + group.Hidden := True; + for j := 0 to group.Items.Count-1 do + begin + if (not group.Items[j].Hidden) + then begin + group.Hidden := False; + Break; + end; + end; + end; + + Result := True; +end; + +function ExecuteJumpItem(const AItem: TJumpItem; const AWnd: HWND): Boolean; +var pItem: IShellItem; + execute: TShellExecuteInfo; + pidl: PItemIDList; + pMenu: IContextMenu; + Menu: HMENU; + Id: UINT; + Info: TCMInvokeCommandInfo; +begin + Result := False; + + if not Assigned(AItem.Item) + then Exit(False); + + if (AItem.eType = jiItem) + then begin + {$REGION 'Execute ShellItem'} + AItem.Item.QueryInterface(IID_IShellItem, pItem); + if not Assigned(pItem) + then Exit(False); + + // couldn't find a handler, execute the old way + FillChar(execute, SizeOf(execute), 0); + execute.cbSize := SizeOf(execute); + execute.fMask := SEE_MASK_IDLIST or SEE_MASK_FLAG_LOG_USAGE; + execute.nShow := SW_NORMAL; + if Succeeded(SHGetIDListFromObject(pItem, pidl)) + then begin + execute.lpIDList := pidl; + ShellExecuteEx(@execute); + CoTaskMemFree(pidl); + end; + + Exit(True); + {$ENDREGION} + end; + + if (AItem.eType = jiLink) + then begin + {$REGION 'Execute ShellLink'} + // invoke the link through its context menu + AItem.Item.QueryInterface(IID_IContextMenu, pMenu); + if Assigned(pMenu) + then try + Menu := CreatePopupMenu; + if (Menu <> 0) + then try + if Succeeded(pMenu.QueryContextMenu(Menu, 0, FCIDM_SHVIEWFIRST, FCIDM_SHVIEWLAST, CMF_DEFAULTONLY)) + then begin + Id := GetMenuDefaultItem(Menu, 0, 0); + if ( Id <> UINT(-1) ) + then begin + FillChar(Info, SizeOf(Info), 0); + Info.cbSize := SizeOf(Info); + Info.fMask := CMIC_MASK_FLAG_LOG_USAGE; + Info.hwnd := AWnd{HWND_DESKTOP}; + Info.nShow := SW_NORMAL; + Info.lpVerb := MakeIntResourceA(Id - FCIDM_SHVIEWFIRST); + pMenu.InvokeCommand(Info); + end; + end; + finally + DestroyMenu(Menu); + end; + finally + pMenu := nil; + end; + Exit(True); + {$ENDREGION} + end; +end; + +procedure RemoveJumpItem(const AAppId: PChar; const AList: TJumplist; const AGroupIdx, AItemIdx: Integer); +var group: TJumpGroup; + pCustomList: IDestinationList; + autoList: TAutomaticList; + // + hr: HRESULT; +begin + group := AList.Groups[AGroupIdx]; + if group.eType in [jgFrequent, jgRecent] + then begin + autoList := TAutomaticList.Create(AAppId); + if autoList.RemoveDestination(group.Items[AItemIdx].Item) + then group.Items.Delete(AItemIdx); + autoList.Free; + end + else begin + pCustomList := GetCustomList(AAppId); + if Assigned(pCustomList) + then begin + hr := pCustomList.RemoveDestination(group.Items[AItemIdx].Item); + if Succeeded(hr) + then group.Items.Delete(AItemIdx); + end; + end; +end; + +procedure PinJumpItem(const AAppId: PChar; const AList: TJumplist; const AGroupIdx, AItemIdx: Integer; const APin: Boolean; const APinIndex: Integer); +var item: TJumpItem; + index: Integer; + autoList: TAutomaticList; +begin + item := AList.Groups[AGroupIdx].Items[AItemIdx]; + if (APin) + then index := APinIndex + else index := -2; + autoList := TAutomaticList.Create(AAppId); + autoList.PinItem(item.Item, index); + autoList.Free; +end; + +var + g_pAppResolver: IApplicationResolver = nil; + g_AppResolverTime: Cardinal = 0; + +// Creates the app id resolver object +procedure CreateAppResolver; +var t: Cardinal; +begin + t := GetTickCount; + if not Assigned(g_pAppResolver) + or ( Abs(t-g_AppResolverTime) > 60000 ) + then begin + // recreate the app resolver at most once per minute, as it may need to read lots of data from disk + g_AppResolverTime := t; + g_pAppResolver := nil; + if IsWindows8OrAbove + then CoCreateInstance(CLSID_ApplicationResolver, nil, CLSCTX_ALL, IID_IApplicationResolverW8, g_pAppResolver) + else CoCreateInstance(CLSID_ApplicationResolver, nil, CLSCTX_ALL, IID_IApplicationResolverW7, g_pAppResolver); + end; +end; + +function GetAppInfoForLink(const APidl: PItemIDList; AAppId: PChar): Boolean; +var pFolder: IShellFolder; + child: PItemIDList; + pLink: IShellLink; + pStore: IPropertyStore; + val: TPropVariant; + str: string; + pItem: IShellItem; + pwc: LPWSTR; +begin + Result := False; + + if Failed(SHBindToParent(APidl, IID_IShellFolder, Pointer(pFolder), child)) + or Failed(pFolder.GetUIObjectOf(HWND_DESKTOP, 1, child, IID_IShellLink, nil, pLink)) + then Exit; + + pLink.QueryInterface(IPropertyStore, pStore); + if Assigned(pStore) + then begin + // handle explicit appid + PropVariantInit(val); + if Succeeded(pStore.GetValue(PKEY_AppUserModel_PreventPinning, val)) + and (val.vt = VT_BOOL) + and (val.boolVal) + then begin + PropVariantClear(val); + Exit; + end; + PropVariantClear(val); + + str := GetPropertyStoreString(pStore, PKEY_AppUserModel_ID); + if (str <> '') + then begin + StrPLCopy(AAppId, str, MAX_PATH); + Result := True; + Exit; + end; + end; + + if Failed(SHCreateItemFromIDList(APidl, IID_IShellItem, pItem)) + then Exit; + + CreateAppResolver; + if Failed(g_pAppResolver.GetAppIDForShortcut(pItem, pwc)) + then Exit; + + StrPLCopy(AAppId, pwc, MAX_PATH); + CoTaskMemFree(pwc); + Result := True; +end; + +end. diff --git a/components/Jumplist/Jumplists.Form.pas b/components/Jumplist/Jumplists.Form.pas index ffeb484..05edc72 100644 --- a/components/Jumplist/Jumplists.Form.pas +++ b/components/Jumplist/Jumplists.Form.pas @@ -1,6 +1,6 @@ {*******************************************************} { Linkbar - Windows desktop toolbar } -{ Copyright (c) 2010-2017 Asaq } +{ Copyright (c) 2010-2018 Asaq } {*******************************************************} unit Jumplists.Form; @@ -10,61 +10,59 @@ interface uses - Windows, System.SysUtils, System.Types, System.Classes, Vcl.Graphics, + Windows, System.SysUtils, System.Types, System.Classes, Graphics, Vcl.Controls, Vcl.Forms, Vcl.Menus, System.Generics.Collections, System.UITypes, - Winapi.Messages, Winapi.ShlObj, Winapi.CommCtrl, JumpLists.Api; + Winapi.Messages, Winapi.ShlObj, Winapi.CommCtrl, JumpLists.Api_2, + Linkbar.Consts, Linkbar.Graphics; type - TVtItemStyle = (vtItem, vtGroup, vtSeparator, vtEmpty, vtFooter); - - TVtItem = record - Style: TVtItemStyle; - Group: Integer; - Item: Integer; - Rect: TRect; - Icon: Integer; - IsLatesPinned: Boolean; - Pinnable: Boolean; - Caption: string; - function IsSelectable: Boolean; - function IsHeader: Boolean; - end; - - TVtList = TList; - - TJumplistAlign = (jaLeft = 0, jaTop = 1, jaRight = 2, jaBottom = 3); + TFormJumpList = class(TForm) + private + type + TVtItemStyle = (vtItem, vtGroup, vtSeparator, vtEmpty, vtFooter); + + TVtItem = record + Style: TVtItemStyle; + Group: Integer; + Item: Integer; + Rect: TRect; + Icon: Integer; + IsLatesPinned: Boolean; + Pinnable: Boolean; + Caption: string; + function IsSelectable: Boolean; + function IsHeader: Boolean; + end; - TIconCache = TDictionary; + TVtList = TList; - TFormJumpList = class(TForm) + TIconCache = TDictionary; private FJumpList: TJumpList; FAppId: String; FAppExe: PItemIDList; FWnd: HWND; FMaxCount: Integer; - FJumpItemIndex: DWORD; FPopupMenu: TPopupMenu; FIconSize: Integer; FX, FY: Integer; - FAlign: TJumplistAlign; + FAlign: TScreenAlign; FVtList: TVtList; FPopupMenuVisible: Boolean; FHotSelectedByMouse: Boolean; - oBgBmp: TBitmap; + oBgBmp: THBitmap; + oFont: TFont; oIconCache: TIconCache; RectBody: TRect; RectFooter: TRect; procedure OnFormClick(Sender: TObject); procedure OnFormClose(Sender: TObject; var Action: TCloseAction); - procedure OnFormContextPopup(Sender: TObject; MousePos: TPoint; - var Handled: Boolean); + procedure OnFormContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean); procedure OnFormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure CMDialogKey(var AMsg: TCMDialogKey); message CM_DIALOGKEY; procedure OnFormMouseLeave(Sender: TObject); procedure OnFormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); - procedure OnFormMouseDown(Sender: TObject; Button: TMouseButton; - Shift: TShiftState; X, Y: Integer); + procedure OnFormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); function GetItemIndexAt(AX, AY: Integer): Integer; procedure JumpListPopupMenuPopup(const X, Y: Integer); procedure OnJumpListPin(Sender: TObject); @@ -80,16 +78,16 @@ TFormJumpList = class(TForm) AIconSize: Integer): Integer; overload; function GetIcon(AFolder: IShellFolder; AChild: PItemIDList; AIconSize: Integer): Integer; overload; - function UpdateJumpList: Boolean; + function UpdateJumpList(const AUpdateList: Boolean = True): Boolean; private hLvTheme: HTHEME; procedure PrepareBackground(const AWidth, AHeight: Integer); - procedure DrawJumplistItem(const AIndex: Integer; ASelected, - APinActive: Boolean; ADrawBackground: Boolean = True); - procedure PaintForm; + procedure DrawJumplistItem(const ADc: HDC; const AIndex: Integer; + const ASelected, APinActive: Boolean; ADrawBackground: Boolean = True); + procedure PaintForm(ASrcDc: HDC); private LastPinUnpinHash: Cardinal; - _FHotIndex: Integer; + FHotIndex: Integer; procedure SetHotIndex(AValue: integer); procedure AlphaBlendAndClose; function PinSelected: boolean; inline; @@ -107,20 +105,36 @@ TFormJumpList = class(TForm) function GetDescription(const AItem: TVtItem; const AText: PChar; ASize: Integer): Boolean; procedure WMTimer(var Message: TMessage); message WM_TIMER; private + ListWidth: Integer; + ItemWidth: Integer; + ItemHeight: Integer; + ItemSpacing: Integer; + ItemPadding: Integer; + ItemMargin: Integer; + TextOffset: Integer; + TextGroupOffset: Integer; + PinButtonWidth: Integer; + FormOffset: Integer; + TextColorGroup: TColor; + TextColorItem: TColor; + TextColorItemSelected: TColor; + TextColorItemNew: TColor; TempX, TempY: Integer; + property HotIndex: Integer read FHotIndex write SetHotIndex; protected procedure CreateParams(var Params: TCreateParams); override; procedure PaintWindow(DC: HDC); override; procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST; procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS; + procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND; public constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0); override; destructor Destroy; override; - function Popup(AWnd: HWND; AX, AY: Integer; AAlign: TJumplistAlign; - const AAppId: String; AAppExe: PItemIDList; AMaxCount: Integer): Boolean; - property HotIndex: Integer read _FHotIndex write SetHotIndex; + function Popup(AWnd: HWND; APt: TPoint; AAlign: TScreenAlign): Boolean; end; + function TryCreateJumplist(AOwner: TComponent; const APidl: PItemIDList; + const AMaxRecentCount: Integer): TFormJumpList; procedure JumpListClose; implementation @@ -146,35 +160,58 @@ implementation var _JumpList: TFormJumpList = nil; - ListWidth: Integer = 0; - ItemWidth: Integer = 0; - ItemHeight: Integer = 0; - ItemSpacing: Integer = 0; - ItemPadding: Integer = 0; - ItemMargin: Integer = 0; - TextOffset: Integer = 0; - TextGroupOffset: Integer = 0; - PinButtonWidth: Integer = 0; - FormOffset: Integer = 0; - - TextColorGroup: TColor; - TextColorItem: TColor; - TextColorItemSelected: TColor; - TextColorItemNew: TColor; - -{ TVtItem } - -function TVtItem.IsSelectable: Boolean; +function TryCreateJumplist(AOwner: TComponent; const APidl: PItemIDList; + const AMaxRecentCount: Integer): TFormJumpList; +var appid: array[0..MAX_PATH] of Char; + list: TJumplist; + g, i, count: Integer; + jg: TJumpGroup; + ji: TJumpItem; + form: TFormJumpList; begin - Result := Style in [vtItem, vtFooter]; -end; + Result := nil; + appid[0] := #0; + if GetAppInfoForLink(APidl, appid) + and (appid[0] <> #0) + and HasJumplist(appid) + then begin + list := TJumplist.Create; + if GetJumplist(appid, list, AMaxRecentCount) + then begin + // Ñalculation of useful items + // Skip hidden group/item and separator + count := 0; + for g := 0 to list.Groups.Count-1 do + begin + jg := list.Groups[g]; + if jg.Hidden + then Continue; -function TVtItem.IsHeader: Boolean; -begin - Result := not IsSelectable; + for i := 0 to jg.Items.Count-1 do + begin + ji := jg.Items[i]; + if ji.Hidden + or (ji.eType = jiSeparator) + then Continue; + Inc(count); + end; + end; + if (count > 0) + then begin + // Create Jumplist form + form := TFormJumpList.CreateNew(AOwner); + form.FAppId := string(appid); + form.FAppExe := APidl; + form.FMaxCount := AMaxRecentCount; + form.FJumpList := list; + Exit(form); + end; + end; + list.Free; + end; end; -// Macros from windowsx.h: +// Macros from windowsx.h: // Important Do not use the LOWORD or HIWORD macros to extract the x- and y- // coordinates of the cursor position because these macros return incorrect results // on systems with multiple monitors. Systems with multiple monitors can have @@ -233,18 +270,33 @@ function AnimationTaskbarEnabled: Boolean; then begin // check "Taskbar animation" Result := reg.OpenKeyReadOnly(ATB_KEY_1) - and (reg.GetDataType(ATB_PROP_1) = rdInteger) - and (reg.ReadInteger(ATB_PROP_1) <> 0); + and (reg.GetDataType(ATB_PROP_1) = rdInteger) + and (reg.ReadInteger(ATB_PROP_1) <> 0); end; finally reg.Free; end; end; +//////////////////////////////////////////////////////////////////////////////// +// TVtItem +//////////////////////////////////////////////////////////////////////////////// + +function TFormJumpList.TVtItem.IsSelectable: Boolean; +begin + Result := Style in [vtItem, vtFooter]; +end; + +function TFormJumpList.TVtItem.IsHeader: Boolean; +begin + Result := not IsSelectable; +end; + //////////////////////////////////////////////////////////////////////////////// // TFormJumpList //////////////////////////////////////////////////////////////////////////////// +{$REGION ' GetCursorHeightMargin '} { GetCursorHeightMargin from Vcl.Forms.pas Return number of scanlines between the scanline containing cursor hotspot and the last scanline included in the cursor mask. } @@ -329,6 +381,7 @@ function GetCursorHeightMargin: Integer; if IconInfo.hbmMask <> 0 then DeleteObject(IconInfo.hbmMask); end; end; +{$ENDREGION} function TFormJumpList.ScaleDimension(const X: Integer): Integer; begin @@ -346,9 +399,8 @@ constructor TFormJumpList.CreateNew(AOwner: TComponent; Dummy: Integer = 0); _JumpList := Self; FormStyle := fsStayOnTop; KeyPreview := True; - Color := clRed; - _FHotIndex := INDEX_NONE; + FHotIndex := INDEX_NONE; OnClick := OnFormClick; OnClose := OnFormClose; @@ -364,7 +416,7 @@ constructor TFormJumpList.CreateNew(AOwner: TComponent; Dummy: Integer = 0); ListWidth := ScaleDimension(269); - if (IsWindows10) + if IsWindows10 then begin ItemMargin := 0; ItemPadding := ScaleDimension(6); @@ -401,7 +453,7 @@ constructor TFormJumpList.CreateNew(AOwner: TComponent; Dummy: Integer = 0); ImageList_AddIcon(hImageList, info.hIcon); DestroyIcon(info.hIcon); end; - // Add pin ans unpin icons + // Add pin and unpin icons h := LoadLibraryEx(PChar('imageres.dll'), 0, LOAD_LIBRARY_AS_DATAFILE); if (h <> 0) then begin @@ -428,10 +480,10 @@ constructor TFormJumpList.CreateNew(AOwner: TComponent; Dummy: Integer = 0); TextColorItemSelected := clHighlightText; TextColorItemNew := clInfoText; - if (IsWindows10) + if IsWindows10 then begin // For Windows 10 - TextColorGroup := clWhite; + TextColorGroup := clSilver; TextColorItem := clWhite; TextColorItemSelected := clWhite; TextColorItemNew := clBlack; @@ -444,14 +496,14 @@ constructor TFormJumpList.CreateNew(AOwner: TComponent; Dummy: Integer = 0); if (hLvTheme <> 0) then begin hr := GetThemeColor(hLvTheme, LVP_GROUPHEADER, LVGH_OPEN, TMT_HEADING1TEXTCOLOR, color); - if ( hr = S_OK ) + if (hr = S_OK) then TextColorGroup := TColorRef(color); end; TextColorItem := clMenuText; if HighContrastEnabled - then TextColorItemSelected := clHighlightText + then TextColorItemSelected := clWindowText else TextColorItemSelected := clMenuText; TextColorItemNew := TextColorItem; @@ -473,15 +525,14 @@ constructor TFormJumpList.CreateNew(AOwner: TComponent; Dummy: Integer = 0); LastPinUnpinHash := 0; TipHwnd := 0; - FJumpList := TJumpList.Create; - FVtList := TVtList.Create; FVtList.Capacity := 16; - oBgBmp := TBitmap.Create; - oBgBmp.PixelFormat := pf24bit; + oBgBmp := THBitmap.Create(24); + oFont := TFont.Create; + oFont.Assign(Screen.IconFont); - oIconCache := TIconCache.Create(16); + oIconCache := TIconCache.Create(8 + FMaxCount); end; procedure TFormJumpList.CreateParams(var Params: TCreateParams); @@ -489,7 +540,7 @@ procedure TFormJumpList.CreateParams(var Params: TCreateParams); inherited CreateParams(Params); Params.Style := WS_POPUP or WS_BORDER; if (IsWindows7 and DwmCompositionEnabled) - or (IsWindows8And8Dot1) + or IsWindows8And8Dot1 then Params.Style := Params.Style or WS_THICKFRAME; Params.ExStyle := (Params.ExStyle or WS_EX_TOOLWINDOW) and not WS_EX_APPWINDOW; @@ -503,6 +554,7 @@ destructor TFormJumpList.Destroy; FJumpList.Free; FVtList.Free; oBgBmp.Free; + oFont.Free; oIconCache.Free; CloseThemeData(hLvTheme); ThemeJlDeinit; @@ -511,14 +563,14 @@ destructor TFormJumpList.Destroy; function TFormJumpList.PinSelected: boolean; begin - Result := (_FHotIndex and INDEX_PIN) <> 0; + Result := (FHotIndex and INDEX_PIN) <> 0; end; function TFormJumpList.Index: Integer; begin - if (_FHotIndex = INDEX_NONE) - then Result := _FHotIndex - else Result := _FHotIndex and MASK_PIN; + if (FHotIndex = INDEX_NONE) + then Result := FHotIndex + else Result := FHotIndex and MASK_PIN; end; function TFormJumpList.GetIcon(APath: PChar; AIndex: Integer; AIconSize: Integer): Integer; @@ -528,7 +580,7 @@ function TFormJumpList.GetIcon(APath: PChar; AIndex: Integer; AIconSize: Integer begin //CharUpper(APath); see comment in overloaded GetIcon (below) key := CalcFNVHash( APath, CalcFNVHash(AIndex, 4) ); - if not oIconCache.TryGetValue(key, res) + if (not oIconCache.TryGetValue(key, res)) then begin icon := SHExtractIcon(APath, AIndex, AIconSize); if (icon <> 0) @@ -574,7 +626,7 @@ function TFormJumpList.GetIcon(AFolder: IShellFolder; AChild: PItemIDList; if oIconCache.TryGetValue(key, res) then Exit(res); - if ( flags and GIL_NOTFILENAME = GIL_NOTFILENAME ) + if (flags and GIL_NOTFILENAME = GIL_NOTFILENAME) then begin icon2 := 0; hr := pExtract.Extract(location, index, icon2, icon, MakeLong(AIconSize, AIconSize)); @@ -607,7 +659,7 @@ function TFormJumpList.GetIcon(AFolder: IShellFolder; AChild: PItemIDList; bUseFactory := True; end; end; - if ( flags and GIL_NOTFILENAME = 0 ) + if (flags and GIL_NOTFILENAME = 0) then begin // the IExtractIcon object didn't do anything - use ShExtractIcon instead if (index = -1) @@ -617,12 +669,12 @@ function TFormJumpList.GetIcon(AFolder: IShellFolder; AChild: PItemIDList; end; res := ICI_DEFAULT; - if (bUseFactory) + if bUseFactory then begin - if Succeeded( SHCreateItemWithParent(nil, AFolder, AChild, IShellItemImageFactory, pFactory) ) + if Succeeded(SHCreateItemWithParent(nil, AFolder, AChild, IShellItemImageFactory, pFactory)) and Assigned(pFactory) then begin - if Succeeded( pFactory.GetImage(TSize.Create(AIconSize, AIconSize), SIIGBF_ICONONLY, hbmp) ) + if Succeeded(pFactory.GetImage(TSize.Create(AIconSize, AIconSize), SIIGBF_ICONONLY, hbmp)) then begin res := ImageList_AddMasked(hImageList, hbmp, CLR_NONE); DeleteObject(hbmp); @@ -666,7 +718,8 @@ function TFormJumpList.ExtractIcon(AItem: IUnknown; AItemType: TJumpItemType): I pLink.GetIDList(pidl); location[0] := #0; hr := pLink.GetIconLocation(location, MAX_PATH, index); - if Succeeded(hr) and (location[0] <> #0) + if Succeeded(hr) + and (location[0] <> #0) then begin if (index = -1) then index := 0; @@ -686,21 +739,20 @@ function TFormJumpList.ExtractIcon(AItem: IUnknown; AItemType: TJumpItemType): I then begin child := nil; hr := SHBindToFolderIDListParent(nil, pidl, IShellFolder, Pointer(pFolder), child); - if Succeeded( hr ) + if Succeeded(hr) then begin { next code extract preview from images (and ?) } // do some pidl laundering. sometimes the pidls from the jumplists may // contain weird hidden data, which affects the icon so do a round-trip // convertion of the pidl to a display name hr := pFolder.GetDisplayNameOf(child, SHGDN_FORPARSING, str); - if Succeeded( hr ) + if Succeeded(hr) then begin - //name := StrRetToString(child, str); StrRetToStr(@str, child, name); child2 := nil; test := PathFindFileName(name); hr := pFolder.ParseDisplayName(0, nil, test, PULONG(nil)^, child2, PULONG(nil)^); - if Succeeded( hr ) + if Succeeded(hr) then begin // make sure child2 points to the same item in the folder if ILIsChild(child2) @@ -729,15 +781,13 @@ procedure TFormJumpList.OnFormClick(Sender: TObject); vi := FVtList[Index]; if (vi.Style = vtItem) then begin - FJumpItemIndex := MakeLong(vi.Item, vi.Group); - jg := FJumpList.Groups[vi.Group].eType; if vi.Pinnable then begin if PinSelected then begin - if ( jg = jgPinned ) + if (jg = jgPinned) then OnJumpListUnPin(nil) else OnJumpListPin(nil); end @@ -780,7 +830,6 @@ procedure TFormJumpList.OnFormContextPopup(Sender: TObject; MousePos: TPoint; if (vi.Style = vtItem) then begin - FJumpItemIndex := MakeLong(vi.Item, vi.Group); MapWindowPoints(Handle, HWND_DESKTOP, pt, 1); JumpListPopupMenuPopup(pt.X, pt.Y); Exit; @@ -799,14 +848,10 @@ procedure TFormJumpList.OnFormContextPopup(Sender: TObject; MousePos: TPoint; end; end; -procedure TFormJumpList.OnFormKeyDown(Sender: TObject; var Key: Word; - Shift: TShiftState); -begin - KeyboardControl(Key); -end; - procedure TFormJumpList.KeyboardControl(const AKeyCode: Word); +// TODO: save? pin selected state var i: Integer; + //pin: Integer; begin if (FVtList.Count = 0) then Exit; @@ -822,25 +867,45 @@ procedure TFormJumpList.KeyboardControl(const AKeyCode: Word); begin Click; end; + VK_DELETE: + begin + // Unpin pinned; Remove recent, frequent, custom; Nothing for task + i := Index; + if (i <> INDEX_NONE) + then begin + case FJumpList.Groups[FVtList.Items[i].Group].eType of + jgPinned: OnJumpListUnPin(Self); + jgRecent, jgFrequent, jgCustom: OnJumpListRemove(Self); + end; + end; + end; VK_UP: // Select prev non-header item begin i := Index; + //if (i <> INDEX_NONE) + //then pin := HotIndex and INDEX_PIN + //else pin := 0; + Dec(i); if (i < 1) then i := FVtList.Count-1; if (not FVtList[i].IsSelectable) then Dec(i); - HotIndex := i; + HotIndex := i;// or pin; end; VK_DOWN: // Select next non-header item begin i := Index; + //if (Index <> INDEX_NONE) + //then pin := HotIndex and INDEX_PIN + //else pin := 0; + Inc(i); if (i >= FVtList.Count) then i := 1; if (not FVtList[i].IsSelectable) then Inc(i); - HotIndex := i; + HotIndex := i;// or pin; end; VK_LEFT: // Unselect Pin begin @@ -858,11 +923,14 @@ procedure TFormJumpList.KeyboardControl(const AKeyCode: Word); VK_TAB: // Select first item for next group or footer item begin i := Index; + //if (Index <> INDEX_NONE) + //then pin := HotIndex and INDEX_PIN + //else pin := 0; + if (i < 1) or (i = FVtList.Count-1) - then - i := 1 - else + then i := 1 + else begin while (i < FVtList.Count) do begin Inc(i); @@ -870,11 +938,17 @@ procedure TFormJumpList.KeyboardControl(const AKeyCode: Word); or (FVtList[i-1].IsHeader) then Break; end; - HotIndex := i; + end; + HotIndex := i;// or pin; end; end; end; +procedure TFormJumpList.OnFormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); +begin + KeyboardControl(Key); +end; + procedure TFormJumpList.CMDialogKey(var AMsg: TCMDialogKey); begin if (AMsg.CharCode = VK_TAB) @@ -911,7 +985,9 @@ procedure TFormJumpList.OnFormMouseMove(Sender: TObject; Shift: TShiftState; X, var idx: Integer; vi: TVtItem; begin - if (TempX = X) and (TempY = Y) then Exit; + if (TempX = X) + and (TempY = Y) + then Exit; TempX := X; TempY := Y; idx := GetItemIndexAt(X, Y); @@ -921,7 +997,8 @@ procedure TFormJumpList.OnFormMouseMove(Sender: TObject; Shift: TShiftState; X, vi := FVtList[idx]; if (vi.Style in [vtItem, vtFooter]) then begin - if (vi.Pinnable) and (X >= (vi.Rect.Right - PinButtonWidth)) + if (vi.Pinnable) + and (X >= (vi.Rect.Right - PinButtonWidth)) then idx := idx or INDEX_PIN; end else idx := INDEX_NONE; @@ -960,19 +1037,26 @@ procedure TFormJumpList.WMNCHitTest(var Message: TWMNCHitTest); Message.Result := HTCLIENT; end; -procedure TFormJumpList.DrawJumplistItem(const AIndex: Integer; - ASelected, APinActive: Boolean; ADrawBackground: Boolean = True); +procedure TFormJumpList.WMEraseBkgnd(var Message: TWMEraseBkgnd); +begin + Message.Result := 1; +end; + +procedure TFormJumpList.DrawJumplistItem(const ADc: HDC; const AIndex: Integer; + const ASelected, APinActive: Boolean; ADrawBackground: Boolean = True); var vi: TVtItem; itemrect, pinrect: TRect; text: string; state, index: Integer; jlgt: TJumpGroupeType; color: TColor; + fnt0: HFONT; + clr0: COLORREF; + bck0: Integer; begin - if (AIndex < 0) - or (AIndex >= FVtList.Count) - then Assert(False); - +{$IFDEF DEBUG} + Assert( (AIndex >= 0) and (AIndex < FVtList.Count) ); +{$ENDIF} vi := FVtList[AIndex]; if not (vi.Style in [vtItem, vtFooter]) @@ -983,8 +1067,8 @@ procedure TFormJumpList.DrawJumplistItem(const AIndex: Integer; if (ADrawBackground) then begin if (vi.Style = vtFooter) - then ThemeJlDrawBackground(oBgBmp.Canvas.Handle, LBJL_BGPID_FOOTER, RectFooter, itemrect) - else ThemeJlDrawBackground(oBgBmp.Canvas.Handle, LBJL_BGPID_BODY, RectBody, itemrect); + then ThemeJlDrawBackground(ADc, LB_JLP_FOOTER, RectFooter,itemrect) + else ThemeJlDrawBackground(ADc, LB_JLP_BODY, RectBody, itemrect); end; jlgt := FJumpList.Groups[vi.Group].eType; @@ -996,8 +1080,8 @@ procedure TFormJumpList.DrawJumplistItem(const AIndex: Integer; then begin // Main button if (vi.Style = vtFooter) - then ThemeJlDrawButton(oBgBmp.Canvas.Handle, LBJL_ITPID_FOOT, LBJL_ITSID_SELECTED, itemrect) - else ThemeJlDrawButton(oBgBmp.Canvas.Handle, LBJL_ITPID_BTN, LBJL_ITSID_SELECTED, itemrect); + then ThemeJlDrawButton(ADc, LB_JLP_FOOTER_BUTTON, LB_JLS_SELECTED, itemrect) + else ThemeJlDrawButton(ADc, LB_JLP_BUTTON, LB_JLS_SELECTED, itemrect); // Pin button not needed end else begin @@ -1005,52 +1089,58 @@ procedure TFormJumpList.DrawJumplistItem(const AIndex: Integer; // Pin button pinrect := Bounds(itemrect.Right, itemrect.Top, PinButtonWidth, itemrect.Height); if (APinActive) - then state := LBJL_ITSID_SELECTED - else state := LBJL_ITSID_HOT; - ThemeJlDrawButton(oBgBmp.Canvas.Handle, LBJL_ITPID_PIN, state, pinrect); + then state := LB_JLS_SELECTED + else state := LB_JLS_HOT; + ThemeJlDrawButton(ADc, LB_JLP_PIN_BUTTON, state, pinrect); // Pin button icon if (jlgt = jgPinned) then index := ICI_UNPIN else index := ICI_PIN; - ImageList_Draw(hImageList, index, oBgBmp.Canvas.Handle, + ImageList_Draw(hImageList, index, ADc, pinrect.Left + (PinButtonWidth - FIconSize) div 2, pinrect.Top + ItemPadding, ILD_IMAGE); // Main button - if (APinActive) - then state := LBJL_ITSID_HOT - else state := LBJL_ITSID_SELECTED; - ThemeJlDrawButton(oBgBmp.Canvas.Handle, LBJL_ITPID_BTN_LFT, state, itemrect); + if APinActive + then state := LB_JLS_HOT + else state := LB_JLS_SELECTED; + ThemeJlDrawButton(ADc, LB_JLP_BUTTON_LEFT, state, itemrect); end; end else begin // Check and draw justnow pin/unpin item - if (vi.IsLatesPinned) - then ThemeJlDrawButton(oBgBmp.Canvas.Handle, LBJL_ITPID_BTN, LBJL_ITSID_NEW, itemrect); + if vi.IsLatesPinned + then ThemeJlDrawButton(ADc, LB_JLP_BUTTON, LB_JLS_NEW, itemrect); end; // Draw icon - ImageList_Draw(hImageList, vi.Icon, oBgBmp.Canvas.Handle, + ImageList_Draw(hImageList, vi.Icon, ADc, itemrect.Left + ItemPadding, itemrect.Top + ItemPadding, ILD_IMAGE); // Draw caption - if vi.Style = vtFooter + if (vi.Style = vtFooter) then text := vi.Caption else text := FJumpList.Groups[vi.Group].Items[vi.Item].Name; if ASelected then color := TextColorItemSelected else begin - if (vi.IsLatesPinned) + if vi.IsLatesPinned then color := TextColorItemNew else color := TextColorItem; end; + + fnt0 := SelectObject(ADc, oFont.Handle); + clr0 := SetTextColor(ADc, ColorToRGB(color)); + bck0 := SetBkMode(ADc, TRANSPARENT); - oBgBmp.Canvas.Font.Color := color; - oBgBmp.Canvas.Brush.Style := bsClear; itemrect.Left := itemrect.Left + TextOffset; itemrect.Right := itemrect.Right - 1; - DrawText(oBgBmp.Canvas.Handle, text, -1, itemrect, + DrawText(ADc, text, -1, itemrect, DT_SINGLELINE or DT_VCENTER or DT_END_ELLIPSIS or DT_WORD_ELLIPSIS); + + SelectObject(ADc, fnt0); + SetTextColor(ADc, clr0); + SetBkMode(ADc, bck0); end; procedure TFormJumpList.PrepareBackground(const AWidth, AHeight: Integer); @@ -1059,32 +1149,34 @@ procedure TFormJumpList.PrepareBackground(const AWidth, AHeight: Integer); tr, lr: TRect; text: string; fs: TFontStyles; - brush: HBRUSH; - // hcinfo: THighContrast; + dc: HDC; + brh0: HBRUSH; + fnt0: HFONT; + clr0: COLORREF; + bck0: Integer; begin oBgBmp.SetSize(AWidth, AHeight); - oBgBmp.Canvas.Font := Screen.IconFont; + dc := oBgBmp.Dc; { Draw body & footer backgrounds } if (FVtList.Last.Style = vtFooter) - then ThemeJlDrawBackground(oBgBmp.Canvas.Handle, LBJL_BGPID_FOOTER, RectFooter, RectFooter); - ThemeJlDrawBackground(oBgBmp.Canvas.Handle, LBJL_BGPID_BODY, RectBody, RectBody); + then ThemeJlDrawBackground(dc, LB_JLP_FOOTER, RectFooter, RectFooter); + ThemeJlDrawBackground(dc, LB_JLP_BODY, RectBody, RectBody); { Draw body-footer divider if Styles disabled } - if not StyleServices.Enabled + if (not StyleServices.Enabled) then begin hcinfo.cbSize := SizeOf(hcinfo); SystemParametersInfo(SPI_GETHIGHCONTRAST, hcinfo.cbSize, @hcinfo, 0); - if ( (hcinfo.dwFlags and HCF_HIGHCONTRASTON) <> 0 ) + if ((hcinfo.dwFlags and HCF_HIGHCONTRASTON) <> 0) then begin lr := Rect(ItemMargin, RectBody.Bottom, RectBody.Right-ItemMargin, RectBody.Bottom + 1); - brush := GetSysColorBrush(COLOR_WINDOWTEXT); - FillRect(oBgBmp.Canvas.Handle, lr, brush); + FillRect(dc, lr, GetSysColorBrush(COLOR_WINDOWTEXT)); end else begin lr := Rect(ItemMargin, RectBody.Bottom, RectBody.Right-ItemMargin, RectBody.Bottom + 2{3}); - DrawEdge(oBgBmp.Canvas.Handle, lr, BDR_RAISEDINNER, BF_RECT); + DrawEdge(dc, lr, BDR_RAISEDINNER, BF_RECT); end; end; {} @@ -1100,59 +1192,72 @@ procedure TFormJumpList.PrepareBackground(const AWidth, AHeight: Integer); vtItem, vtFooter: begin // Draw Item - DrawJumplistItem(i, False, False, False); + DrawJumplistItem(dc, i, False, False, False); end; //----------------------------------------------------------------------- vtGroup: begin // Draw Group + fs := oFont.Style; + if (not StyleServices.Enabled) + then oFont.Style := [fsBold]; + fnt0 := SelectObject(dc, oFont.Handle); + + // draw group header line text := FJumpList.Groups[vi.Group].Name; - if (IsWindows10) + if IsWindows10 then begin lr := Rect(vi.Rect.Left + ItemPadding, vi.Rect.Bottom-ScaleDimension(1), vi.Rect.Right - ItemPadding, vi.Rect.Bottom); - brush := CreateSolidBrush($555555); - FillRect(oBgBmp.Canvas.Handle, lr, brush); - DeleteObject(brush); + brh0 := SelectObject(dc, GetStockObject(DC_BRUSH)); + clr0 := SetDCBrushColor(dc, $555555); + FillRect(dc, lr, GetStockObject(DC_BRUSH)); + SetDCBrushColor(dc, clr0); + SelectObject(dc, brh0); end else begin // calc text rect tr := vi.Rect; - DrawText(oBgBmp.Canvas.Handle, text, -1, tr, + DrawText(dc, text, -1, tr, DT_CALCRECT or DT_SINGLELINE or DT_VCENTER); // calc and darw group header line lr := Rect(tr.Right + ItemSpacing*2, vi.Rect.CenterPoint.Y, vi.Rect.Right, vi.Rect.CenterPoint.Y+1); - DrawThemeBackground(hLvTheme, oBgBmp.Canvas.Handle, LVP_GROUPHEADERLINE, + DrawThemeBackground(hLvTheme, dc, LVP_GROUPHEADERLINE, LVGHL_OPEN, lr, @lr); end; - // darw caption - oBgBmp.Canvas.Brush.Style := bsClear; - oBgBmp.Canvas.Font.Color := TextColorGroup; - fs := oBgBmp.Canvas.Font.Style; - if not StyleServices.Enabled - then oBgBmp.Canvas.Font.Style := [fsBold]; + // draw group caption + clr0 := SetTextColor(dc, ColorToRGB(TextColorGroup)); + bck0 := SetBkMode(dc, TRANSPARENT); + tr := vi.Rect; tr.Left := tr.Left + TextGroupOffset; - DrawText(oBgBmp.Canvas.Handle, text, -1, tr, + DrawText(dc, text, -1, tr, DT_SINGLELINE or DT_VCENTER or DT_END_ELLIPSIS or DT_WORD_ELLIPSIS); - oBgBmp.Canvas.Font.Style := fs; + + SetTextColor(dc, clr0); + SetBkMode(dc, bck0); + + SelectObject(dc, fnt0); + oFont.Style := fs; end; //----------------------------------------------------------------------- vtSeparator: begin - if (IsWindows10) + if IsWindows10 then begin lr := Bounds(vi.Rect.Left + ItemPadding, vi.Rect.CenterPoint.Y, vi.Rect.Width - ItemPadding*2, ScaleDimension(1)); - brush := CreateSolidBrush($555555); - FillRect(oBgBmp.Canvas.Handle, lr, brush); - DeleteObject(brush); + brh0 := SelectObject(dc, GetStockObject(DC_BRUSH)); + clr0 := SetDCBrushColor(dc, $555555); + FillRect(dc, lr, GetStockObject(DC_BRUSH)); + SetDCBrushColor(dc, clr0); + SelectObject(dc, brh0); end else begin // calc and darw separator line lr := Bounds(vi.Rect.Left, vi.Rect.CenterPoint.Y-1, vi.Rect.Width, ScaleDimension(1)); - DrawThemeBackground(hLvTheme, oBgBmp.Canvas.Handle, LVP_GROUPHEADERLINE, + DrawThemeBackground(hLvTheme, dc, LVP_GROUPHEADERLINE, LVGHL_OPEN, lr, @lr); end; end; @@ -1163,12 +1268,15 @@ procedure TFormJumpList.PrepareBackground(const AWidth, AHeight: Integer); function CheckFileDrive(const FileName: string): Boolean; begin - if (FileName.Length >= 2) and (FileName.Chars[1] = DriveDelim) + if (FileName.Length >= 2) + and (FileName.Chars[1] = DriveDelim) then Exit(True) - else if (FileName.Length >= 2) - and (FileName.Chars[0] = PathDelim) - and (FileName.Chars[1] = PathDelim) - then Exit(True); + else begin + if (FileName.Length >= 2) + and (FileName.Chars[0] = PathDelim) + and (FileName.Chars[1] = PathDelim) + then Exit(True); + end; Result := False; end; @@ -1183,7 +1291,7 @@ procedure GetShellDescription(APidl: PItemIDList; AText: PChar; ASize: Integer); if Succeeded(pFolder.GetUIObjectOf(0, 1, child, IQueryInfo, nil, pQueryInfo)) then begin pTip := nil; - if Succeeded( pQueryInfo.GetInfoTip(QITIPF_DEFAULT, pTip) ) + if Succeeded(pQueryInfo.GetInfoTip(QITIPF_DEFAULT, pTip)) and (pTip <> nil) then begin StrPLCopy(AText, pTip, ASize); @@ -1220,7 +1328,7 @@ function TFormJumpList.GetDescription(const AItem: TVtItem; const AText: PChar; ji.Item.QueryInterface(IID_IShellItem, pItem); if Assigned(pItem) then begin - if Succeeded( pItem.GetDisplayName(SIGDN_DESKTOPABSOLUTEEDITING, pTip) ) + if Succeeded(pItem.GetDisplayName(SIGDN_DESKTOPABSOLUTEEDITING, pTip)) then begin { tip: FILENAME } fn := pTip; CoTaskMemFree(pTip); @@ -1235,10 +1343,10 @@ function TFormJumpList.GetDescription(const AItem: TVtItem; const AText: PChar; end; { get queryinfo default tip } - if Succeeded( pItem.BindToHandler(nil, BHID_SFUIObject, IQueryInfo, pQueryInfo) ) + if Succeeded(pItem.BindToHandler(nil, BHID_SFUIObject, IQueryInfo, pQueryInfo)) then begin pTip := nil; - if Failed( pQueryInfo.GetInfoTip(QITIPF_DEFAULT, pTip) ) + if Failed(pQueryInfo.GetInfoTip(QITIPF_DEFAULT, pTip)) or (pTip = nil) then Exit(False); StrPLCopy(AText, pTip, ASize); @@ -1256,12 +1364,12 @@ function TFormJumpList.GetDescription(const AItem: TVtItem; const AText: PChar; if Assigned(pLink) then begin AText[0] := #0; - if Succeeded( pLink.GetDescription(AText, ASize) ) + if Succeeded(pLink.GetDescription(AText, ASize)) and (AText[0] <> #0) then Exit(True); { get arguments } args[0] := #0; - if Succeeded( pLink.GetArguments(args, MAX_PATH) ) + if Succeeded(pLink.GetArguments(args, MAX_PATH)) and (args[0] <> #0) then begin { don't use default tip for items with arguments @@ -1311,7 +1419,7 @@ procedure TFormJumpList.PrepareTooltips; SendMessage(TipHwnd, TTM_SETMAXTIPWIDTH, 0 , 400); // Windows 7, classic themes, jumplist, tooltip have non-default margins (4,4,4,4) and font - if not StyleServices.Enabled + if (not StyleServices.Enabled) then begin m := ScaleDimension(4); margin := Rect(m,m,m,m); @@ -1362,7 +1470,8 @@ procedure TFormJumpList.WMTimer(var Message: TMessage); then Exit; i := Index; - if (i = INDEX_NONE) or (i >= FVtList.Count) + if (i = INDEX_NONE) + or (i >= FVtList.Count) then Exit; vi := FVtList[i]; @@ -1376,7 +1485,7 @@ procedure TFormJumpList.WMTimer(var Message: TMessage); or (not PinSelected) then begin tip[0] := #0; - if not GetDescription(vi, tip, Length(tip)) + if (not GetDescription(vi, tip, Length(tip))) then Exit; TipToolInfo.lpszText := tip; end @@ -1394,7 +1503,7 @@ procedure TFormJumpList.WMTimer(var Message: TMessage); pt.Offset(TipPosOffset) end else begin - if (vi.Pinnable) + if vi.Pinnable and PinSelected then pt := Point(vi.Rect.Right - PinButtonWidth, vi.Rect.Bottom) else pt := Point(vi.Rect.Left + ItemPadding + FIconSize, vi.Rect.Bottom); @@ -1423,7 +1532,7 @@ procedure TFormJumpList.WMTimer(var Message: TMessage); end; end; -function TFormJumpList.UpdateJumpList: Boolean; +function TFormJumpList.UpdateJumpList(const AUpdateList: Boolean = True): Boolean; var NeedUninitialize: Boolean; g, i: Integer; jg: TJumpGroup; @@ -1437,230 +1546,236 @@ function TFormJumpList.UpdateJumpList: Boolean; ppszName: PChar; begin Result := False; - if GetJumplist(PChar(FAppId), FJumpList, FMaxCount) + + // Get Jumplist + if AUpdateList + and not GetJumplist(PChar(FAppId), FJumpList, FMaxCount) then begin - FVtList.Clear; - vr := TRect.Empty; - // CoInitializeEx used for GetIcon - NeedUninitialize := SUCCEEDED(CoInitializeEx(nil, COINIT_APARTMENTTHREADED or COINIT_DISABLE_OLE1DDE)); - try - for g := 0 to FJumpList.Groups.Count-1 do + Close; + Exit; + end; + + // Prepare visual items / load icons + FVtList.Clear; + vr := TRect.Empty; + // CoInitializeEx used for GetIcon + NeedUninitialize := Succeeded(CoInitializeEx(nil, COINIT_APARTMENTTHREADED or COINIT_DISABLE_OLE1DDE)); + try + for g := 0 to FJumpList.Groups.Count-1 do + begin + jg := FJumpList.Groups[g]; + if jg.Hidden + then Continue; + // Add group + vi.Style := vtGroup; + vi.Group := g; + if vr.IsEmpty + then vr := Bounds(ItemMargin, ItemSpacing, ItemWidth, ItemHeight) + else vr.Offset(0, ItemHeight + ItemSpacing); + vi.Rect := vr; + FVtList.Add(vi); + + for i := 0 to jg.Items.Count-1 do begin - jg := FJumpList.Groups[g]; - if jg.Hidden + ji := jg.Items[i]; + if ji.Hidden then Continue; - // Add group - vi.Style := vtGroup; - vi.Group := g; - if vr.IsEmpty - then vr := Bounds(ItemMargin, ItemSpacing, ItemWidth, ItemHeight) - else vr.Offset(0, ItemHeight + ItemSpacing); - vi.Rect := vr; - FVtList.Add(vi); - - for i := 0 to jg.Items.Count-1 do - begin - ji := jg.Items[i]; - if ji.Hidden - then Continue; - // Add separator - if ji.eType = jiSeparator - then begin - vi.Style := vtSeparator; - vr.Offset(0, ItemHeight + ItemSpacing); - vi.Rect := vr; - FVtList.Add(vi); - Continue; - end; - // Add item - vi.Style := vtItem; - vi.Group := g; - vi.Item := i; - vi.Icon := ExtractIcon(ji.Item, ji.eType); + // Add separator + if ji.eType = jiSeparator + then begin + vi.Style := vtSeparator; vr.Offset(0, ItemHeight + ItemSpacing); vi.Rect := vr; - vi.IsLatesPinned := (LastPinUnpinHash = ji.Hash); - vi.Pinnable := jg.eType <> jgTasks; FVtList.Add(vi); + Continue; end; + // Add item + vi.Style := vtItem; + vi.Group := g; + vi.Item := i; + vi.Icon := ExtractIcon(ji.Item, ji.eType); + vr.Offset(0, ItemHeight + ItemSpacing); + vi.Rect := vr; + vi.IsLatesPinned := (LastPinUnpinHash = ji.Hash); + vi.Pinnable := jg.eType <> jgTasks; + FVtList.Add(vi); end; + end; - { Add footer items } - if (FVtList.Count > 0) + { Add footer items } + if (FVtList.Count > 0) + then begin + RectBody := Bounds(0, 0, ListWidth, vr.Bottom + ItemMargin); + RectFooter := Bounds(0, RectBody.Bottom, ListWidth, + ItemSpacing + ItemMargin + + 1*ItemHeight + 0*ItemSpacing + + ItemMargin{ + 1}); + + { Add parent shortcut item } + vr.Location := Point(ItemMargin, RectFooter.Top + ItemSpacing + ItemMargin{ + 1}); + FillChar(vi, SizeOf(vi), 0); + vi.Style := vtFooter; + vi.Rect := vr; + vi.Icon := ICI_DEFAULT; + vi.Caption := '???'; + // name & icon + if Succeeded(SHCreateItemFromIDList(FAppExe, IShellItem, pItem)) then begin - RectBody := Bounds(0, 0, ListWidth, vr.Bottom + ItemMargin); - RectFooter := Bounds(0, RectBody.Bottom, ListWidth, - ItemSpacing + ItemMargin - + 1*ItemHeight + 0*ItemSpacing - + ItemMargin{ + 1}); - - { Add parent shortcut item } - vr.Location := Point(ItemMargin, RectFooter.Top + ItemSpacing + ItemMargin{ + 1}); - FillChar(vi, SizeOf(vi), 0); - vi.Style := vtFooter; - vi.Rect := vr; - vi.Icon := ICI_DEFAULT; - vi.Caption := '???'; - // name & icon - if Succeeded( SHCreateItemFromIDList(FAppExe, IShellItem, pItem) ) + vi.Icon := ExtractIcon(pItem, jiItem); + if Succeeded(pItem.GetDisplayName(SIGDN_PARENTRELATIVEEDITING, ppszName)) then begin - vi.Icon := ExtractIcon(pItem, jiItem); - if Succeeded(pItem.GetDisplayName(SIGDN_PARENTRELATIVEEDITING, ppszName)) - then begin - vi.Caption := ppszName; - CoTaskMemFree(ppszName); - end; + vi.Caption := ppszName; + CoTaskMemFree(ppszName); end; - FVtList.Add(vi); end; - - finally - if NeedUninitialize - then CoUninitialize; + FVtList.Add(vi); end; - if (FVtList.Count > 0) - then begin - _FHotIndex := INDEX_NONE; + finally + if NeedUninitialize + then CoUninitialize; + end; - r := Rect(0, 0, ListWidth, RectFooter.Bottom); + if (FVtList.Count > 0) + then begin + FHotIndex := INDEX_NONE; - PrepareBackground(r.Width, r.Height); + r := Rect(0, 0, ListWidth, RectFooter.Bottom); - PrepareTooltips; + PrepareBackground(r.Width, r.Height); - AdjustWindowRectEx(r, GetWindowLong(Handle, GWL_STYLE), False, - GetWindowLong(Handle, GWL_EXSTYLE)); + PrepareTooltips; - L := 0; - T := 0; - W := r.Width; - H := r.Height; + AdjustWindowRectEx(r, DWORD(GetWindowLong(Handle, GWL_STYLE)), False, + DWORD(GetWindowLong(Handle, GWL_EXSTYLE))); - case FAlign of - jaLeft: begin - L := FX + FormOffset; - T := FY - H; - end; - jaTop: begin - L := FX - (W div 2); - T := FY + FormOffset; - end; - jaRight: begin - L := FX - W - FormOffset; - T := FY - H; - end; - jaBottom: begin - L := FX - (W div 2); - T := FY - H - FormOffset; - end; + L := 0; + T := 0; + W := r.Width; + H := r.Height; + + case FAlign of + saLeft: begin + L := FX + FormOffset; + T := FY - H; end; - monrect := Screen.MonitorFromPoint( Point(FX, FY) ).BoundsRect; - // correct lefttop - if (L + W) > (monrect.Right) - then L := monrect.Right - W; - L := Max(L, monrect.Left); - - if (T + H) > (monrect.Bottom) - then T := monrect.Bottom - H; - T := Max(T, monrect.Top); - SelfBoundsRect := Bounds(L, T, W, H); - - PaintForm; - - { Check window animation } - if (not IsWindowVisible(Handle)) - and AnimationTaskbarEnabled - then begin - // show with blend animation - SetWindowPos(Handle, 0, L, T, W, H, SWP_HIDEWINDOW); - AnimateWindow(Handle, 100, AW_BLEND); - end - else begin - // show - SetWindowPos(Handle, 0, L, T, W, H, SWP_SHOWWINDOW); + saTop: begin + L := FX - (W div 2); + T := FY + FormOffset; + end; + saRight: begin + L := FX - W - FormOffset; + T := FY - H; end; - Invalidate; - Result := True; + saBottom: begin + L := FX - (W div 2); + T := FY - H - FormOffset; + end; + end; + monrect := Screen.MonitorFromPoint( Point(FX, FY) ).BoundsRect; + // correct lefttop + if (L + W) > (monrect.Right) + then L := monrect.Right - W; + L := Max(L, monrect.Left); + + if (T + H) > (monrect.Bottom) + then T := monrect.Bottom - H; + T := Max(T, monrect.Top); + SelfBoundsRect := Bounds(L, T, W, H); + + PaintForm(oBgBmp.Dc); + + { Check window animation } + if (not IsWindowVisible(Handle)) + and AnimationTaskbarEnabled + then begin + // show with blend animation + SetWindowPos(Handle, 0, L, T, W, H, SWP_HIDEWINDOW); + AnimateWindow(Handle, 100, AW_BLEND); end - else Close; + else begin + // show + SetWindowPos(Handle, 0, L, T, W, H, SWP_SHOWWINDOW); + end; + Invalidate; + + Exit(True); end; + + Close; end; procedure TFormJumpList.PaintWindow(DC: HDC); begin - BitBlt(DC, 0, 0, oBgBmp.Width, oBgBmp.Height, - oBgBmp.Canvas.Handle, 0, 0, SRCCOPY); + BitBlt(DC, 0, 0, oBgBmp.Width, oBgBmp.Height, oBgBmp.Dc, 0, 0, SRCCOPY); end; -procedure TFormJumpList.PaintForm; +procedure TFormJumpList.PaintForm(ASrcDc: HDC); begin - BitBlt(Canvas.Handle, 0, 0, oBgBmp.Width, oBgBmp.Height, - oBgBmp.Canvas.Handle, 0, 0, SRCCOPY); + BitBlt(Canvas.Handle, 0, 0, oBgBmp.Width, oBgBmp.Height, ASrcDc, 0, 0, SRCCOPY); end; procedure TFormJumpList.SetHotIndex(AValue: integer); +var dc: HDC; begin - if (_FHotIndex = AValue) + if (FHotIndex = AValue) then Exit; SendMessage(TipHwnd, TTM_TRACKACTIVATE, WParam(False), LParam(@TipToolInfo)); + dc := oBgBmp.Dc; + // Clear previous hot item - if (_FHotIndex <> INDEX_NONE) - then DrawJumplistItem(Index, False, False); + if (FHotIndex <> INDEX_NONE) + then DrawJumplistItem(dc, Index, False, False); - _FHotIndex := AValue; + FHotIndex := AValue; - if (_FHotIndex <> INDEX_NONE) + if (FHotIndex <> INDEX_NONE) then begin - DrawJumplistItem(Index, True, PinSelected); + DrawJumplistItem(dc, Index, True, PinSelected); SetTimer(Handle, TIMER_TOOLTIP_SHOW, TipShowTime, nil); end; - PaintForm; + PaintForm(dc); end; -function TFormJumpList.Popup(AWnd: HWND; AX, AY: Integer; AAlign: TJumplistAlign; - const AAppId: String; AAppExe: PItemIDList; AMaxCount: Integer): Boolean; +function TFormJumpList.Popup(AWnd: HWND; APt: TPoint; AAlign: TScreenAlign): Boolean; begin - FAppId := AAppId; - FAppExe := AAppExe; - FMaxCount := AMaxCount; - FX := AX; - FY := AY; - FAlign := AAlign; FWnd := AWnd; - Result := UpdateJumpList; + FX := APt.X; + FY := APt.Y; + FAlign := AAlign; + Result := UpdateJumpList(False); // Get current monitor rect - TipMonitorRect := Screen.MonitorFromPoint(Point(AX, AY)).BoundsRect; + TipMonitorRect := Screen.MonitorFromPoint(APt).BoundsRect; end; procedure TFormJumpList.OnJumpListPin(Sender: TObject); var g, i: Integer; begin - g := HiWord(FJumpItemIndex); - i := WORD(FJumpItemIndex); + g := FVtList[Index].Group; + i := FVtList[Index].Item; LastPinUnpinHash := FJumpList.Groups[g].Items[i].Hash; - PinJumpItem(PChar(FAppId), FJumpList, g, i, True); + PinJumpItem(PChar(FAppId), FJumpList, g, i, True, -1); // -1 - pin to the end UpdateJumpList; end; procedure TFormJumpList.OnJumpListUnPin(Sender: TObject); var g, i: Integer; begin - g := HiWord(FJumpItemIndex); - i := WORD(FJumpItemIndex); + g := FVtList[Index].Group; + i := FVtList[Index].Item; LastPinUnpinHash := FJumpList.Groups[g].Items[i].Hash; - PinJumpItem(PChar(FAppId), FJumpList, g, i, False); + PinJumpItem(PChar(FAppId), FJumpList, g, i, False, 0); // 0 - unused parameter UpdateJumpList; end; procedure TFormJumpList.OnJumpListRemove(Sender: TObject); var g, i: Integer; begin - g := HiWord(FJumpItemIndex); - i := WORD(FJumpItemIndex); + g := FVtList[Index].Group; + i := FVtList[Index].Item; RemoveJumpItem(PChar(FAppId), FJumpList, g, i); UpdateJumpList; end; @@ -1668,12 +1783,12 @@ procedure TFormJumpList.OnJumpListRemove(Sender: TObject); procedure TFormJumpList.OnJumpListExecute(Sender: TObject); var g, i: Integer; begin - g := HiWord(FJumpItemIndex); - i := WORD(FJumpItemIndex); + g := FVtList[Index].Group; + i := FVtList[Index].Item; // Some Execute close inactive windows (e.g. Steam client) // and our window did not receive the message WM_KILLFOCUS AlphaBlendAndClose; - ExecuteJumpItem(PChar(FAppId), FAppExe, FJumpList.Groups[g].Items[i]{, FWnd}); + ExecuteJumpItem(FJumpList.Groups[g].Items[i], Handle); end; procedure TFormJumpList.JumpListPopupMenuPopup(const X, Y: Integer); @@ -1696,7 +1811,7 @@ procedure TFormJumpList.JumpListPopupMenuPopup(const X, Y: Integer); mi.Caption := cLineCaption; FPopupMenu.Items.Add(mi); - g := HiWord(FJumpItemIndex); + g := FVtList.Items[Index].Group; case FJumpList.Groups[g].eType of jgPinned: begin @@ -1721,6 +1836,7 @@ procedure TFormJumpList.JumpListPopupMenuPopup(const X, Y: Integer); end; else; end; + FPopupMenu.Items.RethinkHotkeys; FPopupMenuVisible := True; FPopupMenu.Popup(X, Y); diff --git a/components/Jumplist/Jumplists.Themes.pas b/components/Jumplist/Jumplists.Themes.pas index 05c8ef3..66e5486 100644 --- a/components/Jumplist/Jumplists.Themes.pas +++ b/components/Jumplist/Jumplists.Themes.pas @@ -1,6 +1,6 @@ {*******************************************************} { Linkbar - Windows desktop toolbar } -{ Copyright (c) 2010-2017 Asaq } +{ Copyright (c) 2010-2018 Asaq } {*******************************************************} unit Jumplists.Themes; @@ -10,94 +10,145 @@ interface uses - Windows, Vcl.Graphics, System.Classes; + Winapi.Windows; const - { Linkbar jumplist background part id } - LBJL_BGPID_BODY = 0; - LBJL_BGPID_FOOTER = 1; - - { Linkbar jumplist item part id } - LBJL_ITPID_BTN = 0; - LBJL_ITPID_BTN_LFT = 1; - LBJL_ITPID_PIN = 2; - LBJL_ITPID_FOOT = 3; - - { Linkbar jumplist item state id } - LBJL_ITSID_NORMAL = 0; - LBJL_ITSID_HOT = 1; - LBJL_ITSID_SELECTED = 2; - LBJL_ITSID_NEW = 3; + { Linkbar Jumplist PartId } + LB_JLP_BODY = 0; // Body background + LB_JLP_FOOTER = 1; // Footer background + LB_JLP_BUTTON_LEFT = 2; // Left part of split button + LB_JLP_BUTTON = 3; // Full Button +//LB_JLP_BUTTON_CENTER = 4; // Middle part of split button + LB_JLP_BUTTON_RIGHT = 4; // Right part of split button + LB_JLP_FOOTER_BUTTON = 5; // Footer button (equal Full Button) + LB_JLP_COUNT = 6; + + LB_JLP_PIN_BUTTON = LB_JLP_BUTTON_RIGHT; // Pin button + + { Linkbar Jumplist PartId } +//LB_JLS_NORMAL = 0; + LB_JLS_HOT = 0; + LB_JLS_PRESSED = 1; + LB_JLS_SELECTED = 2; + LB_JLS_NEW = 3; + LB_JLS_COUNT = 4; procedure ThemeJlInit; procedure ThemeJlDeinit; - - procedure ThemeJlDrawBackground(const AHdc: HDC; const APart: Integer; - const AFullRect, AClipRect: TRect); - - procedure ThemeJlDrawButton(const AHdc: HDC; const APart, AState: Integer; - const ABtnRect: TRect); - + procedure ThemeJlDrawBackground(const AHdc: HDC; const APart: Integer; const AFullRect, AClipRect: TRect); + procedure ThemeJlDrawButton(const AHdc: HDC; const APart, AState: Integer; const ABtnRect: TRect); implementation -uses Vcl.Themes, Winapi.UxTheme, Winapi.ShlObj, Linkbar.OS; +uses Vcl.Themes, Winapi.UxTheme, Linkbar.OS; const - { Jumplists background PartId } - JLP_JUMPLIST_BODY = 12; { Body } - JLP_JUMPLIST_FOOTER = 13; { Footer } - - { Jumplists splitbutton PartId for Windows 7 } - JLBP_W7_JUMPLIST_SPLITBUTTON_LEFT = 28; { Left } - JLBP_W7_JUMPLIST_BUTTON = 29; { Button } - JLBP_W7_JUMPLIST_SPLITBUTTON_CENTER = 30; { Center } - JLBP_W7_JUMPLIST_SPLITBUTTON_RIGHT = 31; { Right } - - { Jumplists splitbutton PartId for Windows 8, 8.1 } - JLBP_W8_JUMPLIST_SPLITBUTTON_LEFT = 32; { Left } - JLBP_W8_JUMPLIST_BUTTON = 33; { Button } - JLBP_W8_JUMPLIST_SPLITBUTTON_CENTER = 34; { Center } - JLBP_W8_JUMPLIST_SPLITBUTTON_RIGHT = 35; { Right } - - { Jumplists splitbutton StateId for Windows 7, 8, 8.1 } - JLBS_HOT = 0; { Hot } - JLBS_UNK1 = 1; { Unknown_1 } - JLBS_PRESSED = 2; { Pressed } - JLBS_SELECTED = 3; { Selected } - JLBS_NEW = 4; { New } - JLBS_UNK2 = 5; { Unknown_2 } - - { Jumplists colors for Windows 10 } - JLIC_W10_NORMAL : Cardinal = $2b2b2b; + { OS type } + LB_OST_W7 = 0; + LB_OST_W8 = 1; + LB_OST_W81 = 2; + LB_OST_COUNT = 3; + + { Jumplist parts (different for 7/8/8.1) } + // Windows 7 + JLP7_BODY = 12; + JLP7_FOOTER = 13; + JLP7_BUTTON_LEFT = 28; + JLP7_BUTTON = 29; + JLP7_BUTTON_CENTER = 30; + JLP7_BUTTON_RIGHT = 31; + // Windows8 + JLP8_BODY = 12; + JLP8_FOOTER = 13; + JLP8_BUTTON_LEFT = 32; + JLP8_BUTTON = 33; + JLP8_BUTTON_CENTER = 34; + JLP8_BUTTON_RIGHT = 35; + // Windows 8.1 + JLP81_BODY = 3; + JLP81_FOOTER = 4; + JLP81_BUTTON_LEFT = 10; + JLP81_BUTTON = 11; + JLP81_BUTTON_CENTER = 11; + JLP81_BUTTON_RIGHT = 12; + + { Jumplist states } + JLS_NORMAL = 0; + JLS_HOT = 1; + JLS_PRESSED = 2; + JLS_SELECTED = 3; + JLS_NEW = 4; + + { Jumplist HTHEME PartId } + JL_HTHEME_PID: array[0..LB_OST_COUNT-1, 0..LB_JLP_COUNT-1] of Integer = ( + // Windows 7 + (JLP7_BODY, JLP7_FOOTER, JLP7_BUTTON_LEFT, JLP7_BUTTON, {JLP7_BUTTON_CENTER,} JLP7_BUTTON_RIGHT, JLP7_BUTTON), + // Windows 8 + (JLP8_BODY, JLP8_FOOTER, JLP8_BUTTON_LEFT, JLP8_BUTTON, {JLP8_BUTTON_CENTER,} JLP8_BUTTON_RIGHT, JLP8_BUTTON), + // Windows 8.1 + (JLP81_BODY, JLP81_FOOTER, JLP81_BUTTON_LEFT, JLP81_BUTTON, {JLP81_BUTTON_CENTER,} JLP81_BUTTON_RIGHT, JLP81_BUTTON) ); + + { Jumplist HTHEME StateId for Buttons } + JL_HTHEME_SID: array[0..LB_JLS_COUNT-1] of Integer = + ({-1, }JLS_NORMAL, JLS_PRESSED, JLS_SELECTED, JLS_NEW); + + { Jumplist colors for Windows 10 } + // Style 1 + JLIC_W10_NORMAL : Cardinal = $1b1b1b;//$2b2b2b; JLIC_W10_HOT : Cardinal = $404040; JLIC_W10_SELECTED : Cardinal = $535353; JLIC_W10_NEW : Cardinal = $83e2fe; + { Style 2 + JLIC_W10_BODY : Cardinal = $000000; + JLIC_W10_FOOTER : Cardinal = $2b2b2b; + JLIC_W10_BTN_HOT : Cardinal = $191919; + JLIC_W10_PIN_HOT : Cardinal = $2b2b2b; + JLIC_W10_FOT_HOT : Cardinal = $404040; + JLIC_W10_NEW : Cardinal = $83e2fe; {} var hJlTheme: HTHEME; + osIndex: Integer; //////////////////////////////////////////////////////////////////////////////// // Draw background //////////////////////////////////////////////////////////////////////////////// +{ Style 1 } procedure Win10_DrawJlBackground(const AHdc: HDC; const APart: Integer; const AFullRect, AClipRect: TRect); var color: COLORREF; - brush: HBRUSH; + brh0: HBRUSH; begin - if (APart = LBJL_BGPID_BODY) + if (APart = LB_JLP_BODY) then color := JLIC_W10_NORMAL else color := JLIC_W10_HOT; - brush := CreateSolidBrush(color); - FillRect(AHdc, AClipRect, brush); - DeleteObject(brush); -end; + + brh0 := SelectObject(AHdc, GetStockObject(DC_BRUSH)); + SetDCBrushColor(AHdc, color); + FillRect(AHdc, AClipRect, GetStockObject(DC_BRUSH)); + SelectObject(AHdc, brh0); +end; {} + +{$REGION ' Win10_DrawJlBackground #2 '} +{ Style 2 +procedure Win10_DrawJlBackground(const AHdc: HDC; const APart: Integer; + const AFullRect, AClipRect: TRect); +var color: COLORREF; +begin + if (APart = LB_JLP_BODY) + then color := JLIC_W10_BODY + else color := JLIC_W10_FOOTER; + brh0 := SelectObject(AHdc, GetStockObject(DC_BRUSH)); + SetDCBrushColor(AHdc, color); + FillRect(AHdc, AClipRect, GetStockObject(DC_BRUSH)); + SelectObject(AHdc, brh0); +end; {} +{$ENDREGION} procedure Win78_DrawJlBackground(const AHdc: HDC; const APart: Integer; const AFullRect, AClipRect: TRect); var cr: TRect; - brush: HBRUSH; begin if (StyleServices.Enabled) then begin @@ -108,15 +159,11 @@ procedure Win78_DrawJlBackground(const AHdc: HDC; const APart: Integer; then begin // For Windows 7 (Aero), 8, 8.1 cr := AClipRect; - if (APart = LBJL_BGPID_BODY) - then DrawThemeBackground(hJlTheme, AHdc, JLP_JUMPLIST_BODY, 0, AFullRect, @cr) - else DrawThemeBackground(hJlTheme, AHdc, JLP_JUMPLIST_FOOTER, 0, AFullRect, @cr); + DrawThemeBackground(hJlTheme, AHdc, JL_HTHEME_PID[osIndex, APart], 0, AFullRect, @cr) end else begin // For Windows 7 (98) - brush := GetSysColorBrush(COLOR_MENU); - FillRect(AHdc, AClipRect, brush); - // DeleteObject(brush); System color brushes are owned by the system + FillRect(AHdc, AClipRect, GetSysColorBrush(COLOR_MENU)); end; end; @@ -132,6 +179,43 @@ procedure ThemeJlDrawBackground(const AHdc: HDC; const APart: Integer; // Draw button //////////////////////////////////////////////////////////////////////////////// +{ Style 1 } +procedure Win10_DrawJlButton(const AHdc: HDC; const APart, AState: Integer; + const ABtnRect: TRect); +var color: COLORREF; + brh0: HBRUSH; +begin + case APart of + LB_JLP_BUTTON, LB_JLP_BUTTON_LEFT: + begin + case AState of + //LB_JLS_NORMAL: color := JLIC_W10_NORMAL; + LB_JLS_HOT: color := JLIC_W10_HOT; + LB_JLS_SELECTED: color := JLIC_W10_HOT; + LB_JLS_NEW: color := JLIC_W10_NEW; + else Exit; + end; + end; + LB_JLP_PIN_BUTTON, LB_JLP_FOOTER_BUTTON: + begin + case AState of + //LB_JLS_NORMAL: color := JLIC_W10_NORMAL; + LB_JLS_HOT: color := JLIC_W10_HOT; + LB_JLS_SELECTED: color := JLIC_W10_SELECTED; + else Exit; + end; + end; + else Exit; + end; + + brh0 := SelectObject(AHdc, GetStockObject(DC_BRUSH)); + SetDCBrushColor(AHdc, color); + FillRect(AHdc, ABtnRect, GetStockObject(DC_BRUSH)); + SelectObject(AHdc, brh0); +end; {} + +{$REGION ' Win10_DrawJlButton #2 '} +{ Style 2 procedure Win10_DrawJlButton(const AHdc: HDC; const APart, AState: Integer; const ABtnRect: TRect); var color: COLORREF; @@ -141,19 +225,27 @@ procedure Win10_DrawJlButton(const AHdc: HDC; const APart, AState: Integer; LBJL_ITPID_BTN, LBJL_ITPID_BTN_LFT: begin case AState of - LBJL_ITSID_NORMAL: color := JLIC_W10_NORMAL; - LBJL_ITSID_HOT: color := JLIC_W10_HOT; - LBJL_ITSID_SELECTED: color := JLIC_W10_HOT; + LBJL_ITSID_NORMAL: color := JLIC_W10_BODY; + LBJL_ITSID_HOT: color := JLIC_W10_BTN_HOT; + LBJL_ITSID_SELECTED: color := JLIC_W10_BTN_HOT; LBJL_ITSID_NEW: color := JLIC_W10_NEW; else Exit; end; end; - LBJL_ITPID_PIN, LBJL_ITPID_FOOT: + LBJL_ITPID_FOOT: begin case AState of - LBJL_ITSID_NORMAL: color := JLIC_W10_NORMAL; - LBJL_ITSID_HOT: color := JLIC_W10_HOT; - LBJL_ITSID_SELECTED: color := JLIC_W10_SELECTED; + LBJL_ITSID_NORMAL: color := JLIC_W10_FOOTER; + LBJL_ITSID_SELECTED: color := JLIC_W10_FOT_HOT; + else Exit; + end; + end; + LBJL_ITPID_PIN: + begin + case AState of + LBJL_ITSID_NORMAL: color := JLIC_W10_BODY; + LBJL_ITSID_HOT: color := JLIC_W10_BTN_HOT; + LBJL_ITSID_SELECTED: color := JLIC_W10_PIN_HOT; else Exit; end; end; @@ -163,64 +255,52 @@ procedure Win10_DrawJlButton(const AHdc: HDC; const APart, AState: Integer; brush := CreateSolidBrush(color); FillRect(AHdc, ABtnRect, brush); DeleteObject(brush); -end; +end; {} +{$ENDREGION} procedure Win78_DrawJlButton(const AHdc: HDC; const APart, AState: Integer; const ABtnRect: TRect); var part, state: Integer; - pen: HPEN; + pen0: HPEN; + brh0: HBRUSH; begin if (StyleServices.Enabled) then begin - case APart of - LBJL_ITPID_BTN, LBJL_ITPID_FOOT: - if (IsWindows7) - then part := JLBP_W7_JUMPLIST_BUTTON - else part := JLBP_W8_JUMPLIST_BUTTON; - LBJL_ITPID_BTN_LFT: - if (IsWindows7) - then part := JLBP_W7_JUMPLIST_SPLITBUTTON_LEFT - else part := JLBP_W8_JUMPLIST_SPLITBUTTON_LEFT; - LBJL_ITPID_PIN: - if (IsWindows7) - then part := JLBP_W7_JUMPLIST_SPLITBUTTON_RIGHT - else part := JLBP_W8_JUMPLIST_SPLITBUTTON_RIGHT; - else Exit; - end; - - case AState of - LBJL_ITSID_NORMAL: Exit; // normal state empty - LBJL_ITSID_HOT: state := JLBS_HOT; - LBJL_ITSID_SELECTED: state := JLBS_SELECTED; - LBJL_ITSID_NEW: state := JLBS_NEW; - else Exit; - end; + //if (AState = LB_JLS_NORMAL) + //then Exit; // normal state empty - // Pin button always draw in selected state - if (APart = LBJL_ITPID_PIN) then state := JLBS_SELECTED; + part := JL_HTHEME_PID[osIndex, APart]; + if (APart = LB_JLP_PIN_BUTTON) + then state := JL_HTHEME_SID[LB_JLS_SELECTED] + else state := JL_HTHEME_SID[AState]; DrawThemeBackground(hJlTheme, AHdc, part, state, ABtnRect, nil); end else begin case APart of - LBJL_ITPID_BTN, LBJL_ITPID_BTN_LFT, LBJL_ITPID_FOOT: + LB_JLP_BUTTON, LB_JLP_BUTTON_LEFT, LB_JLP_FOOTER_BUTTON: begin case AState of - LBJL_ITSID_HOT, LBJL_ITSID_SELECTED: - FillRect(AHdc, ABtnRect, GetSysColorBrush(COLOR_MENUHILIGHT)); - LBJL_ITSID_NEW: + LB_JLS_HOT, LB_JLS_SELECTED: + FillRect(AHdc, ABtnRect, GetSysColorBrush(COLOR_HIGHLIGHT)); + LB_JLS_NEW: FillRect(AHdc, ABtnRect, GetSysColorBrush(COLOR_INFOBK)); else Exit; end; end; - LBJL_ITPID_PIN: + LB_JLP_PIN_BUTTON: begin - if (AState in [LBJL_ITSID_HOT, LBJL_ITSID_SELECTED]) + if (AState in [LB_JLS_HOT, LB_JLS_SELECTED]) then begin - FillRect(AHdc, ABtnRect, GetSysColorBrush(COLOR_MENUHILIGHT)); - pen := CreatePen(PS_SOLID, 1, GetSysColor(COLOR_WINDOWFRAME)); - SelectObject(AHdc, pen); + pen0 := SelectObject(AHdc, GetStockObject(DC_PEN)); + brh0 := SelectObject(AHdc, GetStockObject(DC_BRUSH)); + + SetDCPenColor(AHdc, GetSysColor(COLOR_WINDOWFRAME)); + SetDCBrushColor(AHdc, GetSysColor(COLOR_HIGHLIGHT)); Rectangle(AHdc, ABtnRect.Left, ABtnRect.Top, ABtnRect.Right, ABtnRect.Bottom); + + SelectObject(AHdc, brh0); + SelectObject(AHdc, pen0); end; end else Exit; @@ -229,7 +309,7 @@ procedure Win78_DrawJlButton(const AHdc: HDC; const APart, AState: Integer; end; procedure ThemeJlDrawButton(const AHdc: HDC; const APart, AState: Integer; - const ABtnRect: TRect); + const ABtnRect: TRect); begin if (IsWindows10) then Win10_DrawJlButton(AHdc, APart, AState, ABtnRect) @@ -240,8 +320,18 @@ procedure ThemeJlDrawButton(const AHdc: HDC; const APart, AState: Integer; // Theme init/deinit //////////////////////////////////////////////////////////////////////////////// +function GetOsIndex(): Integer; inline; // [0 - Windows7, 1 - Windows8, 2 - Windows8.1] +begin + if IsWindows7 + then Result := LB_OST_W7 + else if IsWindows8 + then Result := LB_OST_W8 + else Result := LB_OST_W81; +end; + procedure ThemeJlInit; begin + osIndex := GetOsIndex(); end; procedure ThemeJlDeinit; diff --git a/components/L10n/Linkbar.L10n.pas b/components/L10n/Linkbar.L10n.pas index eb15d23..39b0e65 100644 --- a/components/L10n/Linkbar.L10n.pas +++ b/components/L10n/Linkbar.L10n.pas @@ -1,6 +1,6 @@ {*******************************************************} { Linkbar - Windows desktop toolbar } -{ Copyright (c) 2010-2017 Asaq } +{ Copyright (c) 2010-2018 Asaq } {*******************************************************} unit Linkbar.L10n; @@ -18,7 +18,7 @@ interface // New shortcut file name // shell32.dll.mui - String table - ? LB_FN_NEWSHORTCUT = 'shell32.dll'; - LB_RS_NSC_FILENAME = 30397; + LB_RS_NSC_FILENAME = 30397; // Autohide fail message // explorerframe.dll.mui @@ -35,8 +35,9 @@ interface LB_FN_NEEDFILENAME = 'shell32.dll'; LB_RS_NFN_CUE = 4123; - procedure L10nLoad(const APath: string; AForcedLocale: string = ''); - function L10NFind(const AName: string; ADefault: string = ''): string; + + procedure L10nLoad(const APath: string; const AForcedLocale: string = ''); + function L10NFind(const AName: string; const ADefault: string = ''): string; function L10nMui(const AModuleName: String; const AStringID: Cardinal): String; overload; function L10nMui(const AModule: HINST; const AStringID: Cardinal): String; overload; procedure L10nControl(AControl: TForm; const AName: String); overload; @@ -49,12 +50,11 @@ interface procedure L10nControl(AControl: TComboBox; const ANames: array of String); overload; var - LbLongLang: Boolean = True deprecated; Locale: string = ''; implementation -uses + uses System.SysUtils, System.Types, System.StrUtils, System.Generics.Collections; type @@ -77,7 +77,8 @@ TTranslations = class function L10nMui(const AModule: HINST; const AStringID: Cardinal): String; var p: PChar; begin - if (AModule <> 0) and (AStringID < 65536) + if (AModule <> 0) + and (AStringID < 65536) then SetString(Result, p, LoadString(AModule, AStringID, @p, 0)) else Result := 'resource_string_not_found'; end; @@ -143,9 +144,8 @@ procedure L10nControl(AControl: TComboBox; const ANames: array of String); overl function Translations: TTranslations; begin - if FTranslations = nil then - FTranslations := TTranslations.Create; - + if (FTranslations = nil) + then FTranslations := TTranslations.Create; Result := FTranslations; end; @@ -200,7 +200,8 @@ procedure TTranslations.LoadFromFile(const AFileName, ALocaleName: string); then begin key := LowerCase( Trim( Copy(s, 1, j - 1) ) ); value := TrimLeft( Copy(s, j + 1, Length(s)) ); - if (key <> '') and (value <> '') + if (key <> '') + and (value <> '') then tr.AddOrSetValue(key, value); end; end; @@ -249,7 +250,7 @@ function GetLocaleNameFromLocaleID(ID: TLocaleID): string; then Result := Languages.LocaleName[i]; end; -procedure L10nLoad(const APath: string; AForcedLocale: string = ''); +procedure L10nLoad(const APath: string; const AForcedLocale: string = ''); var languages: string; localeId: Integer; begin @@ -269,9 +270,13 @@ procedure L10nLoad(const APath: string; AForcedLocale: string = ''); Translations.LoadFromPath(APath, languages); end; -function L10NFind(const AName: string; ADefault: string = ''): string; +function L10NFind(const AName: string; const ADefault: string = ''): string; begin Result := Translations.Find(AName, ADefault); + // Prevent exception in Format() + if (Pos('%s', ADefault) > 0) + and (Pos('%s', AnsiLowerCase(Result)) = 0) + then Result := ADefault; end; end. \ No newline at end of file diff --git a/components/RenameDialog/RenameDialog.pas b/components/RenameDialog/RenameDialog.pas index 845b1a1..5ed0182 100644 --- a/components/RenameDialog/RenameDialog.pas +++ b/components/RenameDialog/RenameDialog.pas @@ -1,6 +1,6 @@ {*******************************************************} { Linkbar - Windows desktop toolbar } -{ Copyright (c) 2010-2017 Asaq } +{ Copyright (c) 2010-2018 Asaq } {*******************************************************} unit RenameDialog; @@ -10,8 +10,9 @@ interface uses - Winapi.Windows, System.SysUtils, System.Classes, Vcl.Controls, Vcl.Forms, - Vcl.StdCtrls, Winapi.CommCtrl, WinApi.Messages, Winapi.ShlObj, Winapi.ActiveX; + System.SysUtils, System.Classes, + Winapi.Windows, WinApi.Messages, Winapi.CommCtrl, Winapi.ShlObj, Winapi.ActiveX, + Vcl.Controls, Vcl.Forms, Vcl.StdCtrls; type TRenamingWCl = class(TForm) @@ -32,6 +33,7 @@ TRenamingWCl = class(TForm) procedure CreateParams(var Params: TCreateParams); override; procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST; public + destructor Destroy; override; property Pidl: PItemIDList write SetPidl; end; @@ -39,7 +41,7 @@ implementation {$R *.dfm} -uses Vcl.Clipbrd, Linkbar.Shell, Linkbar.Common, Linkbar.L10n; +uses Vcl.Clipbrd, Linkbar.Shell, Linkbar.Common, Linkbar.L10n, Linkbar.Consts; var FInvalidFileNameChars: TCharArray; @@ -54,10 +56,20 @@ procedure TRenamingWCl.CreateParams(var Params: TCreateParams); Params.ExStyle := Params.ExStyle or WS_EX_APPWINDOW; end; +destructor TRenamingWCl.Destroy; +begin +{$IFDEF DEBUG} + Assert(TWinControl(Owner) <> nil); +{$ENDIF} + PostMessage(TWinControl(Owner).Handle, LM_DOAUTOHIDE, 0, 0); + inherited; +end; + procedure TRenamingWCl.FormCreate(Sender: TObject); var cue: String; begin Font.Name := Screen.IconFont.Name; + L10n; ReduceSysMenu(Handle); @@ -65,8 +77,7 @@ procedure TRenamingWCl.FormCreate(Sender: TObject); edtFileName.MaxLength := MAX_PATH; FInvalidFileNameChars := TCharArray.Create('"', '*', '/', ':', '<', '>', '?', '\', '|'); - FInvalidFileNameCharsHintText := - L10nMui(GetModuleHandle(LB_FN_INVALIDFILENAMECHARS), LB_RS_IFNC_HINT); + FInvalidFileNameCharsHintText := L10nMui(GetModuleHandle(LB_FN_INVALIDFILENAMECHARS), LB_RS_IFNC_HINT); cue := L10nMui(GetModuleHandle(LB_FN_NEEDFILENAME), LB_RS_NFN_CUE); f_Edit_SetCueBannerText(edtFileName.Handle, PChar(cue)); @@ -106,18 +117,20 @@ function IsCharInOrderedArray(const AChar: Char; const AnArray: TCharArray): Boo // use divide-et-impera to search AChar in AnArray LeftIdx := 0; RightIdx := Length(AnArray) - 1; - if (RightIdx >= 0) and (AnArray[LeftIdx] <= AChar) and (AChar <= AnArray[RightIdx]) then - repeat - MidIdx := LeftIdx + (RightIdx - LeftIdx) div 2; - MidChar := AnArray[MidIdx]; - if AChar < MidChar then - RightIdx := MidIdx - 1 - else - if AChar > MidChar then - LeftIdx := MidIdx + 1 - else - Result := True; - until (Result) or (LeftIdx > RightIdx); + if (RightIdx >= 0) + and (AnArray[LeftIdx] <= AChar) + and (AChar <= AnArray[RightIdx]) + then repeat + MidIdx := LeftIdx + (RightIdx - LeftIdx) div 2; + MidChar := AnArray[MidIdx]; + if AChar < MidChar + then RightIdx := MidIdx - 1 + else begin + if AChar > MidChar + then LeftIdx := MidIdx + 1 + else Result := True; + end; + until (Result) or (LeftIdx > RightIdx); end; function IsValidFileNameChar(const AChar: Char): Boolean; @@ -132,12 +145,13 @@ function HasInvalidFileNameCharsFix(var AFileName: string): Boolean; pname := PChar(AFileName); len := Length(AFileName); j := 0; - for i := 0 to len-1 do + for i := 0 to len - 1 do begin pname[j] := pname[i]; if IsValidFileNameChar(pname[i]) then Inc(j); end; + //Assert( (j >= 0) and (j <= len) ); SetLength(AFileName, j); Result := j <> len; end; @@ -154,7 +168,7 @@ procedure TRenamingWCl.btnOkClick(Sender: TObject); procedure TRenamingWCl.edtFileNameChange(Sender: TObject); begin - btnOk.Enabled := (Trim(edtFileName.Text) <> ''); + btnOk.Enabled := Trim(edtFileName.Text) <> ''; end; procedure TRenamingWCl.edtFileNameKeyPress(Sender: TObject; var Key: Char); @@ -170,7 +184,6 @@ procedure TRenamingWCl.edtFileNameKeyPress(Sender: TObject; var Key: Char); edtFileName.SetSelText(str); Exit; end; - // Other Keys if not IsValidFileNameChar(Key) then begin @@ -179,6 +192,46 @@ procedure TRenamingWCl.edtFileNameKeyPress(Sender: TObject; var Key: Char); end; end; +{ Original + +function HasValidFileNameChars(const FileName: string): Boolean; +var + PFileName: PChar; + FileNameLen: Integer; + Ch: Char; + I: Integer; +begin + // Result will become True if an invalid file name char is found + I := 0; + PFileName := PChar(FileName); + FileNameLen := Length(FileName); + Result := False; + while (not Result) and (I < FileNameLen) do + begin + Ch := PFileName[I]; + if not IsValidFileNameChar(Ch) + then Result := True + else Inc(I); + end; + Result := not Result; +end; + +procedure TRenamingWCl.edtFileNameKeyPress(Sender: TObject; var Key: Char); +begin + if (Key = #$16) + then begin + if Clipboard.HasFormat(CF_TEXT) + and HasValidFileNameChars(Clipboard.AsText) + then Exit; + end + else begin + if IsValidFileNameChar(Key) + then Exit; + end; + Key := #0; + ShowBalloonTip(FInvalidFileNameCharsHintText); +end; } + procedure TRenamingWCl.ShowBalloonTip(const AText: String); var ebt: TEditBalloonTip; begin @@ -191,8 +244,8 @@ procedure TRenamingWCl.ShowBalloonTip(const AText: String); MessageBeep(0); end; +{ Prevent window resizing } procedure TRenamingWCl.WMNCHitTest(var Message: TWMNCHitTest); -// Disable window resize begin inherited; PreventSizing(Message.Result); diff --git a/components/SpinEdit/NewSpin.pas b/components/SpinEdit/NewSpin.pas index 6ddf1ea..e4c2ecc 100644 --- a/components/SpinEdit/NewSpin.pas +++ b/components/SpinEdit/NewSpin.pas @@ -1,15 +1,15 @@ {*******************************************************} { Linkbar - Windows desktop toolbar } -{ Copyright (c) 2010-2017 Asaq } +{ Copyright (c) 2010-2018 Asaq } {*******************************************************} unit NewSpin; interface -uses - Windows, Classes, StdCtrls, ExtCtrls, Controls, Messages, SysUtils, - Forms, Graphics, Menus, Buttons, ComCtrls; +uses + Windows, SysUtils, Classes, Controls, StdCtrls, ExtCtrls, Messages, + Buttons, ComCtrls; type @@ -28,7 +28,7 @@ TSpinButton = class (TWinControl) procedure BtnMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure AdjustSize (var W, H: Integer); reintroduce; - procedure WMSize(var Message: TWMSize); message WM_SIZE; + procedure WMSize(var Message: TWMSize); message WM_SIZE; procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE; protected procedure Loaded; override; @@ -73,7 +73,6 @@ TnSpinEdit = class(TCustomEdit) private FMinValue: LongInt; FMaxValue: LongInt; - FIncrement: LongInt; FButton: TSpinButton; FEditorEnabled: Boolean; function GetValue: LongInt; @@ -82,11 +81,13 @@ TnSpinEdit = class(TCustomEdit) procedure SetMinValue (NewMinValue: LongInt); procedure SetMaxValue (NewMaxValue: LongInt); procedure SetEditRect; + function GetIncrement: LongInt; + procedure SetIncrement(NewValue: LongInt); procedure WMSize(var Message: TWMSize); message WM_SIZE; procedure CMEnter(var Message: TCMGotFocus); message CM_ENTER; - procedure CMExit(var Message: TCMExit); message CM_EXIT; - procedure WMPaste(var Message: TWMPaste); message WM_PASTE; - procedure WMCut(var Message: TWMCut); message WM_CUT; + procedure CMExit(var Message: TCMExit); message CM_EXIT; + procedure WMPaste(var Message: TWMPaste); message WM_PASTE; + procedure WMCut(var Message: TWMCut); message WM_CUT; protected function IsValidChar(Key: Char): Boolean; virtual; procedure UpClick (Sender: TObject); virtual; @@ -113,7 +114,7 @@ TnSpinEdit = class(TCustomEdit) property EditorEnabled: Boolean read FEditorEnabled write FEditorEnabled default True; property Enabled; property Font; - property Increment: LongInt read FIncrement write FIncrement default 1; + property Increment: LongInt read GetIncrement write SetIncrement default 1; property MaxLength; property MaxValue: LongInt read FMaxValue write SetMaxValue; property MinValue: LongInt read FMinValue write SetMinValue; @@ -155,10 +156,8 @@ TTimerSpeedButton = class(TUpDown) FTimeBtnState: TTimeBtnState; procedure TimerExpired(Sender: TObject); protected - procedure MouseDown(Button: TMouseButton; Shift: TShiftState; - X, Y: Integer); override; - procedure MouseUp(Button: TMouseButton; Shift: TShiftState; - X, Y: Integer); override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; public destructor Destroy; override; property TimeBtnState: TTimeBtnState read FTimeBtnState write FTimeBtnState; @@ -169,7 +168,7 @@ TTimerSpeedButton = class(TUpDown) implementation uses Themes; - + const InitRepeatPause = 400; { pause before repeat timer (ms) } RepeatPause = 100; { pause before hint window displays (ms)} @@ -186,7 +185,7 @@ constructor TSpinButton.Create(AOwner: TComponent); inherited Create(AOwner); ControlStyle := ControlStyle - [csAcceptsControls, csSetCaption] + [csFramed, csOpaque]; { Frames don't look good around the buttons when themes are on } - if StyleServices.Enabled + if StyleServices.Enabled then ControlStyle := ControlStyle - [csFramed]; FUpDownButton := CreateButton; Width := 15; @@ -208,20 +207,23 @@ procedure TSpinButton.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(AComponent, Operation); - if (Operation = opRemove) and (AComponent = FFocusControl) then - FFocusControl := nil; + if (Operation = opRemove) + and (AComponent = FFocusControl) + then FFocusControl := nil; end; procedure TSpinButton.AdjustSize(var W, H: Integer); begin - if (FUpDownButton = nil) or (csLoading in ComponentState) then Exit; - if W < 15 then W := 15; + if (FUpDownButton = nil) + or (csLoading in ComponentState) + then Exit; + if (W < 15) + then W := 15; FUpDownButton.SetBounds(0, 0, W, H); end; procedure TSpinButton.SetBounds(ALeft, ATop, AWidth, AHeight: Integer); -var - W, H: Integer; +var W, H: Integer; begin W := AWidth; H := AHeight; @@ -230,8 +232,7 @@ procedure TSpinButton.SetBounds(ALeft, ATop, AWidth, AHeight: Integer); end; procedure TSpinButton.WMSize(var Message: TWMSize); -var - W, H: Integer; +var W, H: Integer; begin inherited; { check for minimum size } @@ -255,24 +256,29 @@ procedure TSpinButton.KeyDown(var Key: Word; Shift: TShiftState); procedure TSpinButton.BtnMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin - if Button = mbLeft then - begin - if (FFocusControl <> nil) and FFocusControl.TabStop and - FFocusControl.CanFocus and (GetFocus <> FFocusControl.Handle) then - FFocusControl.SetFocus - else if TabStop and (GetFocus <> Handle) and CanFocus then - SetFocus; + if (Button = mbLeft) + then begin + if (FFocusControl <> nil) + and FFocusControl.TabStop + and FFocusControl.CanFocus + and (GetFocus <> FFocusControl.Handle) + then FFocusControl.SetFocus + else if TabStop + and (GetFocus <> Handle) + and CanFocus + then SetFocus; end; end; procedure TSpinButton.BtnClick(Sender: TObject; Button: TUDBtnType); begin - if Button = btNext then - begin - if Assigned(FOnUpClick) then FOnUpClick(Self); + if (Button = btNext) + then begin + if Assigned(FOnUpClick) + then FOnUpClick(Self); end - else - if Assigned(FOnDownClick) then FOnDownClick(Self); + else if Assigned(FOnDownClick) + then FOnDownClick(Self); end; procedure TSpinButton.WMGetDlgCode(var Message: TWMGetDlgCode); @@ -281,15 +287,15 @@ procedure TSpinButton.WMGetDlgCode(var Message: TWMGetDlgCode); end; procedure TSpinButton.Loaded; -var - W, H: Integer; +var W, H: Integer; begin inherited Loaded; W := Width; H := Height; AdjustSize (W, H); - if (W <> Width) or (H <> Height) then - inherited SetBounds (Left, Top, W, H); + if (W <> Width) + or (H <> Height) + then inherited SetBounds (Left, Top, W, H); end; { TnSpinEdit } @@ -307,7 +313,6 @@ constructor TnSpinEdit.Create(AOwner: TComponent); FButton.OnDownClick := DownClick; Text := '0'; ControlStyle := ControlStyle - [csSetCaption]; - FIncrement := 1; FEditorEnabled := True; ParentBackground := False; end; @@ -324,34 +329,40 @@ procedure TnSpinEdit.GetChildren(Proc: TGetChildProc; Root: TComponent); procedure TnSpinEdit.KeyDown(var Key: Word; Shift: TShiftState); begin - if Key = VK_UP then UpClick (Self) - else if Key = VK_DOWN then DownClick (Self); + if (Key = VK_UP) + then UpClick(Self) + else if (Key = VK_DOWN) + then DownClick (Self); inherited KeyDown(Key, Shift); end; procedure TnSpinEdit.KeyPress(var Key: Char); begin - if (Key = Chr(VK_RETURN)) then - begin - if Assigned(OnKeyPress) then OnKeyPress(Self, Key); + if (Key = Chr(VK_RETURN)) + then begin + if Assigned(OnKeyPress) + then OnKeyPress(Self, Key); Key := #0; Exit; end; - if not IsValidChar(Key) then - begin + if not IsValidChar(Key) + then begin Key := #0; MessageBeep(0) end; - if Key <> #0 then inherited KeyPress(Key); + if (Key <> #0) + then inherited KeyPress(Key); end; function TnSpinEdit.IsValidChar(Key: Char): Boolean; begin - Result := CharInSet(Key, [FormatSettings.DecimalSeparator, '+', '-', '0'..'9']) or - ((Key < #32) and (Key <> Chr(VK_RETURN))); - if not FEditorEnabled and Result and ((Key >= #32) or - (Key = Char(VK_BACK)) or (Key = Char(VK_DELETE))) then - Result := False; + Result := CharInSet(Key, [FormatSettings.DecimalSeparator, '+', '-', '0'..'9']) + or ((Key < #32) and (Key <> Chr(VK_RETURN))); + + if (not FEditorEnabled) + and Result + and ((Key >= #32) or (Key = Chr(VK_BACK)) or (Key = Chr(VK_DELETE))) + then Result := False; end; procedure TnSpinEdit.CreateParams(var Params: TCreateParams); @@ -373,18 +384,19 @@ procedure TnSpinEdit.SetEditRect; SendMessage(Handle, EM_GETRECT, 0, LongInt(@Loc)); Loc.Bottom := ClientHeight + 1; {+1 is workaround for windows paint bug} Loc.Right := ClientWidth - FButton.Width - 2; - Loc.Top := 0; - Loc.Left := 0; + Loc.Top := 0; + Loc.Left := 0; SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@Loc)); end; procedure TnSpinEdit.WMSize(var Message: TWMSize); begin inherited; - if FButton <> nil then - begin - if NewStyleControls and Ctl3D then - FButton.SetBounds(Width - FButton.Width - 3, -1, FButton.Width, Height - 2) + if (FButton <> nil) + then begin + if NewStyleControls + and Ctl3D + then FButton.SetBounds(Width - FButton.Width - 3, -1, FButton.Width, Height - 2) else FButton.SetBounds (Width - FButton.Width, 1, FButton.Width, Height - 3); SetEditRect; end; @@ -392,33 +404,39 @@ procedure TnSpinEdit.WMSize(var Message: TWMSize); procedure TnSpinEdit.UpClick (Sender: TObject); begin - if ReadOnly then MessageBeep(0) - else Value := Value + FIncrement; + if ReadOnly + then MessageBeep(0) + else Value := Value + Increment; end; procedure TnSpinEdit.DownClick (Sender: TObject); begin - if ReadOnly then MessageBeep(0) - else Value := Value - FIncrement; + if ReadOnly + then MessageBeep(0) + else Value := Value - Increment; end; -procedure TnSpinEdit.WMPaste(var Message: TWMPaste); +procedure TnSpinEdit.WMPaste(var Message: TWMPaste); begin - if not FEditorEnabled or ReadOnly then Exit; + if (not FEditorEnabled) + or ReadOnly + then Exit; inherited; end; -procedure TnSpinEdit.WMCut(var Message: TWMPaste); +procedure TnSpinEdit.WMCut(var Message: TWMPaste); begin - if not FEditorEnabled or ReadOnly then Exit; + if (not FEditorEnabled) + or ReadOnly + then Exit; inherited; end; procedure TnSpinEdit.CMExit(var Message: TCMExit); begin inherited; - if CheckValue (Value) <> Value then - SetValue (Value); + if (CheckValue(Value) <> Value) + then SetValue(Value); end; function TnSpinEdit.GetValue: LongInt; @@ -432,18 +450,18 @@ function TnSpinEdit.GetValue: LongInt; procedure TnSpinEdit.SetValue (NewValue: LongInt); begin - Text := IntToStr (CheckValue (NewValue)); + Text := IntToStr(CheckValue (NewValue)); end; function TnSpinEdit.CheckValue (NewValue: LongInt): LongInt; begin Result := NewValue; - if (FMaxValue <> FMinValue) then - begin - if NewValue < FMinValue then - Result := FMinValue - else if NewValue > FMaxValue then - Result := FMaxValue; + if (FMaxValue <> FMinValue) + then begin + if (NewValue < FMinValue) + then Result := FMinValue + else if (NewValue > FMaxValue) + then Result := FMaxValue; end; FButton.FUpDownButton.Position := Result; end; @@ -462,41 +480,49 @@ procedure TnSpinEdit.SetMaxValue (NewMaxValue: LongInt); procedure TnSpinEdit.CMEnter(var Message: TCMGotFocus); begin - if AutoSelect and not (csLButtonDown in ControlState) then - SelectAll; + if AutoSelect + and (not (csLButtonDown in ControlState)) + then SelectAll; inherited; end; +function TnSpinEdit.GetIncrement: LongInt; +begin + Result := FButton.FUpDownButton.Increment; +end; + +procedure TnSpinEdit.SetIncrement(NewValue: LongInt); +begin + FButton.FUpDownButton.Increment := NewValue; +end; + {TTimerSpeedButton} destructor TTimerSpeedButton.Destroy; begin - if FRepeatTimer <> nil then - FRepeatTimer.Free; + if (FRepeatTimer <> nil) + then FRepeatTimer.Free; inherited Destroy; end; -procedure TTimerSpeedButton.MouseDown(Button: TMouseButton; Shift: TShiftState; - X, Y: Integer); +procedure TTimerSpeedButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin - inherited MouseDown (Button, Shift, X, Y); - if tbAllowTimer in FTimeBtnState then - begin - if FRepeatTimer = nil then - FRepeatTimer := TTimer.Create(Self); - + inherited MouseDown(Button, Shift, X, Y); + if (tbAllowTimer in FTimeBtnState) + then begin + if (FRepeatTimer = nil) + then FRepeatTimer := TTimer.Create(Self); FRepeatTimer.OnTimer := TimerExpired; FRepeatTimer.Interval := InitRepeatPause; FRepeatTimer.Enabled := True; end; end; -procedure TTimerSpeedButton.MouseUp(Button: TMouseButton; Shift: TShiftState; - X, Y: Integer); +procedure TTimerSpeedButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin - inherited MouseUp (Button, Shift, X, Y); - if FRepeatTimer <> nil then - FRepeatTimer.Enabled := False; + inherited MouseUp(Button, Shift, X, Y); + if (FRepeatTimer <> nil) + then FRepeatTimer.Enabled := False; end; procedure TTimerSpeedButton.TimerExpired(Sender: TObject); diff --git a/components/SpinEdit/SpinEdit.dpk b/components/SpinEdit/SpinEdit.dpk new file mode 100644 index 0000000..6618e73 --- /dev/null +++ b/components/SpinEdit/SpinEdit.dpk @@ -0,0 +1,37 @@ +package SpinEdit; + +{$R *.res} +{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION OFF} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES ON} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DEFINE DEBUG} +{$ENDIF IMPLICITBUILDING} +{$IMPLICITBUILD ON} + +requires + rtl, + vcl; + +contains + NewSpin in 'NewSpin.pas'; + +end. diff --git a/exe/CMD.txt b/exe/CMD.txt index 8ea5361..1612cc5 100644 --- a/exe/CMD.txt +++ b/exe/CMD.txt @@ -1,7 +1,7 @@ -d[param] Set startup delay [param] = time in milliseconds - + -l[param] Set UI language [param] = 1033 or en-US (English) @@ -13,10 +13,11 @@ Set UI language 1049 or ru-RU (Russian) 2052 or zh-CN (Chinese-Simplified) 1042 or ko-KR (Korean) - + 1034 or es-ES (Spanish) + -f[param] Set path to configuration file [param] = path to *.lbr - + -n Open "New Linkbar" dialog \ No newline at end of file diff --git a/exe/Locales/de-DE.ini b/exe/Locales/de-DE.ini index 1940a01..08ee83c 100644 --- a/exe/Locales/de-DE.ini +++ b/exe/Locales/de-DE.ini @@ -9,10 +9,10 @@ New.Cancel = Abbrechen Menu.Shortcut = Neue Verknüpfung Menu.Open = Offene Arbeitsverzeichnis Menu.Create = Erstellen Linkbar... -Menu.Delete = Löschen Sie das Linkbar +Menu.Delete = Löschen Sie das Linkbar... Menu.Lock = Linkbar fixieren Menu.Sort = Alphabetisch sortieren -Menu.Properties = Eigenschaften +Menu.Properties = &Einstellungen Menu.Close = Schließen Menu.CloseAll = Schließen Sie alle Jumplist.Recent = Zuletzt verwendet @@ -64,15 +64,22 @@ Properties.MouseHover = Mausbewegung Properties.MouseLC = Maus Linksklick Properties.MouseRC = Maus Rechtsklick Properties.Delay = Verzögerung, ms: +Properties.CornerTransWidth = Ecken Transparenzbreite: Properties.HotKey = Tastenkombination: -Properties.Transparent = Transparent wenn Ausblenden +Properties.AutoHideTransparency = Transparent wenn Ausblenden Properties.Additional = Ansicht Properties.Jumplists = Sprunglisten +Properties.JumplistRecentMaxItems = Anzahl der zuletzt verwendeten, in Sprunglisten anzuzeigenden Elemente: Properties.No = Nein Properties.ForW7 = Für Windows 7: Properties.Style1 = Verwenden Sie Stil wie Taskleiste mit kombinierten Tasten Properties.ForW8 = Für Windows 8/8.1: Properties.AeroGlass = AeroGlass-Unterstützung aktivieren (separat installiert) +Properties.ForW10 = Für Windows 10 +Properties.Look = Stil: +Properties.Opaque = Undurchsichtig +Properties.Transparent = Transparent +Properties.Glass = Glas Properties.About = Ãœber Properties.Version = Version: %s Properties.SystemInfo = Systeminformationen: diff --git a/exe/Locales/el-GR.ini b/exe/Locales/el-GR.ini index 2a3b63e..a48f140 100644 --- a/exe/Locales/el-GR.ini +++ b/exe/Locales/el-GR.ini @@ -9,17 +9,17 @@ New.Cancel = ΆκυÏο Menu.Shortcut = Îέα συντόμευση Menu.Open = Άνοιγμα φακέλου εÏγασίας Menu.Create = ΔημιουÏγία γÏαμμής σÏνδεσης... -Menu.Delete = ΔιαγÏαφή της γÏαμμής σÏνδεσης +Menu.Delete = ΔιαγÏαφή της γÏαμμής σÏνδεσης... Menu.Lock = Κλείδωμα της γÏαμμής σÏνδεσης Menu.Sort = Ταξινόμηση αλφαβητικά -Menu.Properties = Ιδιότητες +Menu.Properties = Ρυ&θμίσεις Menu.Close = Κλείσιμο Menu.CloseAll = Κλείσιμο όλων Jumplist.Recent = ΠÏόσφατα Jumplist.Frequent = Στοιχεία που επιλέγονται συχνότεÏα Jumplist.Tasks = ΕÏγασίες Jumplist.Pinned = ΚαÏφιτσωμένα -Jumplist.Open = Άν&οιγμα +Jumplist.Open = Άν&οιγμα Jumplist.Pin = &ΚαÏφίτσωμα σε αυτήν τη λίστα Jumplist.Unpin = &ΞεκαÏφίτσωμα από αυτήν τη λίστα Jumplist.Remove = Κατά&Ïγηση από τη λίστα @@ -65,9 +65,10 @@ Properties.MouseLC = ΑÏιστεÏÏŒ κλικ Ï€Î¿Î½Ï„Î¹ÎºÎ¹Î¿Ï Properties.MouseRC = Δεξί κλικ Ï€Î¿Î½Ï„Î¹ÎºÎ¹Î¿Ï Properties.Delay = ΚαθυστέÏηση (ms): Properties.HotKey = Συνδυασμός κλειδιών: -Properties.Transparent = Διαφανές όταν είναι κÏυμμένο +Properties.AutoHideTransparency = Διαφανές όταν είναι κÏυμμένο Properties.Additional = ΠÏόσθετα -Properties.Jumplists = Οι λίστες συντομεÏσεων +Properties.Jumplists = Λίστες συντομεÏσεων +Properties.JumplistRecentMaxItems = ΑÏιθμόϛ Ï€Ïόσφατων στοιχείων για εμφάνιση στη Λίστα συντομεÏσεων: Properties.No = Οχι Properties.ForW7 = Για Windows 7 Properties.Style1 = ΧÏήση στυλ, όπως της γÏαμμής εÏγασιών με συνδυασμό κουμπιών diff --git a/exe/Locales/en-US.ini b/exe/Locales/en-US.ini index 4d152ce..bc1097f 100644 --- a/exe/Locales/en-US.ini +++ b/exe/Locales/en-US.ini @@ -9,17 +9,17 @@ New.Cancel = Cancel Menu.Shortcut = New shortcut Menu.Open = Open working directory Menu.Create = Create linkbar... -Menu.Delete = Delete the linkbar +Menu.Delete = Delete the linkbar... Menu.Lock = Lock the linkbar Menu.Sort = Sort alphabetically -Menu.Properties = Properties +Menu.Properties = &Settings Menu.Close = Close Menu.CloseAll = Close all -Jumplist.Recent = Recent +Jumplist.Recent = Recent Jumplist.Frequent = Frequent Jumplist.Tasks = Tasks Jumplist.Pinned = Pinned -Jumplist.Open = &Open +Jumplist.Open = &Open Jumplist.Pin = P&in to this list Jumplist.Unpin = &Unpin from this list Jumplist.Remove = Remove &from this list @@ -64,15 +64,22 @@ Properties.MouseHover = Mouse hover Properties.MouseLC = Mouse left-click Properties.MouseRC = Mouse right-click Properties.Delay = Delay, ms: +Properties.CornerTransWidth = Corners transparency width: Properties.HotKey = Keyboard shortcut: -Properties.Transparent = Transparent when hidden +Properties.AutoHideTransparency = Transparent when hidden Properties.Additional = Additional -Properties.Jumplists = Jumplists +Properties.Jumplists = Jump Lists +Properties.JumplistRecentMaxItems = Number of recent items to display in Jump Lists: Properties.No = No Properties.ForW7 = For Windows 7 Properties.Style1 = Use style like taskbar with combined buttons Properties.ForW8 = For Windows 8/8.1 Properties.AeroGlass = Enable AeroGlass support (installed separately) +Properties.ForW10 = For Windows 10 +Properties.Look = Look: +Properties.Opaque = Opaque +Properties.Transparent = Transparent +Properties.Glass = Glass Properties.About = About Properties.Version = Version: %s Properties.SystemInfo = System info: diff --git a/exe/Locales/es-ES.ini b/exe/Locales/es-ES.ini new file mode 100644 index 0000000..926550b --- /dev/null +++ b/exe/Locales/es-ES.ini @@ -0,0 +1,89 @@ +[es-ES] - Spanish (Spain) +New.Caption = Nueva barra de vínculos +New.ToWhom = Crear una barra de vínculos: +New.ForAll = Para todos los usuarios del ordenador +New.ForMe = Solo para mi (%s) +New.Folder = Elegir una carpeta: +New.Create = Crear +New.Cancel = Cancelar +Menu.Shortcut = Nuevo acceso directo +Menu.Open = Abrir el directorio del trabajo +Menu.Create = Crear la barra de vínculos... +Menu.Delete = Borrar la barra de vínculos... +Menu.Lock = Bloquear la barra de vínculos +Menu.Sort = Ordenar por nombre +Menu.Properties = Con&figuración +Menu.Close = Cerrar +Menu.CloseAll = Cerrar todo +JumpList.Recent = Reciente +JumpList.Frequent = Frecuente +JumpList.Tasks = Tareas +JumpList.Pinned = Anclado +Jumplist.Open = &Abrir +JumpList.Pin = &Anclar a esta lista +JumpList.Unpin = &Desanclar de esta lista +JumpList.Remove = &Quitar de esta lista +JumpList.PinTip = Anclar a esta lista +JumpList.UnpinTip = Desanclar de esta lista +Rename.Caption = Renombrar +Rename.OK = Aceptar +Rename.Cancel = Cancelar +Color.Caption = Color +Color.OK = Aceptar +Color.Cancel = Cancelar +Delete.Title = Está eliminando la barra "%s" +Delete.Text = El directorio del trabajo: %s +Delete.Verification = Eliminar el directorio del trabajo +Message.FileNotFound = El archivo no existe +Message.DeleteShortcut = ¿Eliminar el acceso directo? +Properties.View = Ver +Properties.Appearance = Personalización +Properties.Position = Ubicación en pantalla: +Properties.Left = Izquierda +Properties.Top = Superior +Properties.Right = Derecha +Properties.Bottom = Inferior +Properties.IconSize = El tamaño del ícono: +Properties.BgColor = El color del fondo: +Properties.Margins = Márgenes (horizontales/verticales): +Properties.Order = El orden de accesos directos: +Properties.LtR = De izquierda hacia derecha +Properties.UtD = De arriba hacia abajo +Properties.TextPos = La posición del texto: +Properties.Without = Without text +Properties.TextWidth = Ancho / sangría del texto: +Properties.TextColor = Color del texto: +Properties.GlowSize = Tamaño de brillo: +Properties.AlwaysOnTop = Poner la barra de vínculos sobre otras ventanas +Properties.PageAutoHide = AutoOcultación +Properties.AutoHide = Configurar AutoOcultación +Properties.Hide = Ocultar: +Properties.Automatically = Automaticamente +Properties.Show = Mostrar: +Properties.MouseHover = Al colocar el puntero +Properties.MouseLC = Botón izquierdo del ratón +Properties.MouseRC = Botón derecho del ratón +Properties.Delay = Retraso, ms: +Properties.CornerTransWidth = El ancho de los rincones transparentes: +Properties.HotKey = Tecla de acceso directo: +Properties.AutoHideTransparency = Transparente cuando esté oculta +Properties.Additional = Adicional +Properties.Jumplists = La Jump Lists +Properties.JumplistRecentMaxItems = Número de elementos recientes para mostrar en Jump Lists: +Properties.No = No +Properties.ForW7 = Para Windows 7 +Properties.Style1 = Usar el estilo de la barra de tareas con botones combinados +Properties.ForW8 = Para Windows 8/8.1 +Properties.AeroGlass = Activar el soporte de AeroGlass (se instala por separado) +Properties.ForW10 = Para Windows 10 +Properties.Look = Ver: +Properties.Opaque = Opaco +Properties.Transparent = Transparente +Properties.Glass = Cristal +Properties.About = Acerca de Linkbar +Properties.Version = Versión: %s +Properties.SystemInfo = Información del sistema: +Properties.Localizer = localizador: Gohar +Properties.OK = Aceptar +Properties.Cancel = Cancelar +Properties.Apply = Aplicar \ No newline at end of file diff --git a/exe/Locales/fr-FR.ini b/exe/Locales/fr-FR.ini index b7a6208..b8a1b08 100644 --- a/exe/Locales/fr-FR.ini +++ b/exe/Locales/fr-FR.ini @@ -9,10 +9,10 @@ New.Cancel = Annuler Menu.Shortcut = Nouveau raccourci Menu.Open = Ouvrir le répertoire de travail Menu.Create = Créer une linkbar... -Menu.Delete = Supprimer la linkbar +Menu.Delete = Supprimer la linkbar... Menu.Lock = Verrouiller la linkbar Menu.Sort = Classer par ordre alphabétique -Menu.Properties = Propriétés +Menu.Properties = &Paramètres Menu.Close = Fermer Menu.CloseAll = Fermer tout Jumplist.Recent = Récent @@ -65,9 +65,10 @@ Properties.MouseLC = Clic-gauche Properties.MouseRC = Clic-droit Properties.Delay = Retard (ms): Properties.HotKey = Combinaison de clés: -Properties.Transparent = Transparente quand masquée +Properties.AutoHideTransparency = Transparente quand masquée Properties.Additional = En outre -Properties.Jumplists = Les listes de raccourcis +Properties.Jumplists = Les listes de raccourcis +Properties.JumplistRecentMaxItems = Nombre d’éléments récents à afficher dans les Listes de raccourcis: Properties.No = Non Properties.ForW7 = Pour Windows 7 Properties.Style1 = Utilizer le style comme la barre des tâches avec les boutons combinés diff --git a/exe/Locales/ja-JP.ini b/exe/Locales/ja-JP.ini index 57a8543..58c53d7 100644 --- a/exe/Locales/ja-JP.ini +++ b/exe/Locales/ja-JP.ini @@ -9,10 +9,10 @@ New.Cancel = キャンセル Menu.Shortcut = æ–°ã—ã„ショートカット Menu.Open = 作業ディレクトリを開ã Menu.Create = リンクãƒãƒ¼ã‚’作æˆ... -Menu.Delete = リンクãƒãƒ¼ã‚’削除 +Menu.Delete = リンクãƒãƒ¼ã‚’削除... Menu.Lock = リンクãƒãƒ¼ã‚’固定 Menu.Sort = アルファベット順ã«ã‚½ãƒ¼ãƒˆ -Menu.Properties = プロパティ +Menu.Properties = 設定(&S) Menu.Close = é–‰ã˜ã‚‹ Menu.CloseAll = ã™ã¹ã¦é–‰ã˜ã‚‹ Jumplist.Recent = 最近使ã£ãŸã‚‚ã® @@ -65,9 +65,10 @@ Properties.MouseLC = マウス 左クリック Properties.MouseRC = マウス å³ã‚¯ãƒªãƒƒã‚¯ Properties.Delay = é…延 (ミリ秒)： Properties.HotKey = キーã®çµ„ã¿åˆã‚ã›ï¼š -Properties.Transparent = éžè¡¨ç¤ºæ™‚ã«é€æ˜ŽåŒ– +Properties.AutoHideTransparency = éžè¡¨ç¤ºæ™‚ã«é€æ˜ŽåŒ– Properties.Additional = 拡張設定 -Properties.Jumplists = ジャンプ リスト +Properties.Jumplists = ジャンプリスト +Properties.JumplistRecentMaxItems = ジャンプリストã«è¡¨ç¤ºã™ã‚‹æœ€è¿‘使ã£ãŸé …ç›®ã®æ•°ï¼š Properties.No = ã„ã„㈠Properties.ForW7 = Windows 7 Properties.Style1 = 標準ã®ã‚¿ã‚¹ã‚¯ãƒãƒ¼ã¨åŒä¸€ã®ã‚¹ã‚¿ã‚¤ãƒ«ã‚’利用 diff --git a/exe/Locales/ko-KR.ini b/exe/Locales/ko-KR.ini index 3d8cfc3..b818476 100644 --- a/exe/Locales/ko-KR.ini +++ b/exe/Locales/ko-KR.ini @@ -9,17 +9,17 @@ New.Cancel = 취소 Menu.Shortcut = 바로 가기 만들기 Menu.Open = ëŒ€ìƒ í´ë” 열기 Menu.Create = 툴바 새로 만들기... -Menu.Delete = 툴바 ì‚­ì œ +Menu.Delete = 툴바 ì‚­ì œ... Menu.Lock = 툴바 잠금 Menu.Sort = 알파벳순으로 ì •ë ¬ -Menu.Properties = 환경 설정 +Menu.Properties = 설정(&S) Menu.Close = 종료 Menu.CloseAll = ëª¨ë‘ ì¢…ë£Œ Jumplist.Recent = 최근 항목 Jumplist.Frequent = ìžì£¼ 사용하는 항목 Jumplist.Tasks = ìž‘ì—… Jumplist.Pinned = ê³ ì •ë¨ -Jumplist.Open = 열기(&O) +Jumplist.Open = 열기(&O) Jumplist.Pin = ì´ ëª©ë¡ì— ê³ ì •(&I) Jumplist.Unpin = ì´ ëª©ë¡ì—ì„œ 제거(&U) Jumplist.Remove = ì´ ëª©ë¡ì—ì„œ 제거(&F) @@ -38,7 +38,7 @@ Message.FileNotFound = 파ì¼ì´ 존재하지 않습니다. Message.DeleteShortcut = 바로 가기 ì‚­ì œ? Properties.View = 보기 Properties.Appearance = 모양 구성 -Properties.Position = 화면ìƒì˜ 위치 : +Properties.Position = 화면ìƒì˜ 위치: Properties.Left = 왼쪽 Properties.Top = 위 Properties.Right = 오른쪽 @@ -65,13 +65,14 @@ Properties.MouseLC = 툴바를 마우스로 í´ë¦­í•  ë•Œ Properties.MouseRC = 툴바를 마우스로 ìš°í´ë¦­í•  ë•Œ Properties.Delay = 지연 시간: Properties.HotKey = 단축키: -Properties.Transparent = 숨겨진 ìƒíƒœì‹œ 투명화 +Properties.AutoHideTransparency = 숨겨진 ìƒíƒœì‹œ 투명화 Properties.Additional = 추가 기능 Properties.Jumplists = ì í”„ 목ë¡ì€ +Properties.JumplistRecentMaxItems = ì í”„ 목ë¡ì— 표시할 최근 항목 수: Properties.No = 아니 Properties.ForW7 = 윈ë„ìš° 7 Properties.Style1 = ìž‘ì—… 표시 줄과 ê°™ì€ ìŠ¤íƒ€ì¼ ì‚¬ìš© -Properties.ForW8 = 윈ë„ìš° 7 8/8.1 +Properties.ForW8 = 윈ë„ìš° 8/8.1 Properties.AeroGlass = AeroGlass ì§€ì› ì‚¬ìš© (ë³„ë„ ì„¤ì¹˜) Properties.About = ì •ë³´ Properties.Version = 번역: %s diff --git a/exe/Locales/pl-PL.ini b/exe/Locales/pl-PL.ini index 2e74ed1..72b0163 100644 --- a/exe/Locales/pl-PL.ini +++ b/exe/Locales/pl-PL.ini @@ -9,10 +9,10 @@ New.Cancel = Anuluj Menu.Shortcut = Nowy skrót Menu.Open = Otwórz katalog roboczy Menu.Create = Utwórz pasek Å‚Ä…czy... -Menu.Delete = UsuÅ„ pasek Å‚Ä…czy +Menu.Delete = UsuÅ„ pasek Å‚Ä…czy... Menu.Lock = Zablokuj pasek Å‚Ä…czy Menu.Sort = Sortuj alfabetycznie -Menu.Properties = WÅ‚aÅ›ciwoÅ›ci +Menu.Properties = &Ustawienia Menu.Close = Zamknij Menu.CloseAll = Zamknij wszystkie Jumplist.Recent = Najnowsze @@ -65,9 +65,10 @@ Properties.MouseLC = Lewy klik myszy Properties.MouseRC = Prawy klik myszy Properties.Delay = Opóźnienie, ms: Properties.HotKey = Skrót klawiszowy: -Properties.Transparent = Przezroczysty, kiedy ukryty +Properties.AutoHideTransparency = Przezroczysty, kiedy ukryty Properties.Additional = Dodatkowo Properties.Jumplists = Listy szybkiego dostÄ™pu +Properties.JumplistRecentMaxItems = Liczba niedawno używanych elementów do wyÅ›wietlenia na listach szybkiego dostÄ™pu: Properties.No = Nie Properties.ForW7 = Dla Windows 7 Properties.Style1 = Użyj stylu jak w pasku zadaÅ„ z poÅ‚Ä…czonymi przyciskami diff --git a/exe/Locales/ru-RU.ini b/exe/Locales/ru-RU.ini index 9e521a1..7f8a493 100644 --- a/exe/Locales/ru-RU.ini +++ b/exe/Locales/ru-RU.ini @@ -9,10 +9,10 @@ New.Cancel = Отмена Menu.Shortcut = Ðовый Ñрлык Menu.Open = Открыть рабочий каталог Menu.Create = Создать панельку... -Menu.Delete = Удалить панельку +Menu.Delete = Удалить панельку... Menu.Lock = Закрепить панельку Menu.Sort = Сортировать по алфавиту -Menu.Properties = СвойÑтва +Menu.Properties = Ð&аÑтройка Menu.Close = Закрыть Menu.CloseAll = Закрыть вÑе Jumplist.Recent = ПоÑледние @@ -64,15 +64,22 @@ Properties.MouseHover = При наведении Properties.MouseLC = По левому клику Properties.MouseRC = По правому клику Properties.Delay = Задержка (мÑ): +Properties.CornerTransWidth = Ширина прозрачных углов: Properties.HotKey = Сочетание клавиш: -Properties.Transparent = ÐŸÑ€Ð¾Ð·Ñ€Ð°Ñ‡Ð½Ð°Ñ ÐºÐ¾Ð³Ð´Ð° Ñкрыта +Properties.AutoHideTransparency = ÐŸÑ€Ð¾Ð·Ñ€Ð°Ñ‡Ð½Ð°Ñ ÐºÐ¾Ð³Ð´Ð° Ñкрыта Properties.Additional = Дополнительно Properties.Jumplists = СпиÑки переходов +Properties.JumplistRecentMaxItems = Отображать в ÑпиÑке перехода недавно иÑпользовавшиеÑÑ Ñлементы в количеÑтве: Properties.No = Ðет Properties.ForW7 = Ð”Ð»Ñ Windows 7 Properties.Style1 = ИÑпользовать Ñтиль панели задач Ñ Ð³Ñ€ÑƒÐ¿Ð¿Ð¸Ñ€Ð¾Ð²ÐºÐ¾Ð¹ Properties.ForW8 = Ð”Ð»Ñ Windows 8/8.1 Properties.AeroGlass = Включить поддержку AeroGlass (уÑтанавливаетÑÑ Ð¾Ñ‚Ð´ÐµÐ»ÑŒÐ½Ð¾) +Properties.ForW10 = Ð”Ð»Ñ Windows 10 +Properties.Look = Вид: +Properties.Opaque = ÐÐµÐ¿Ñ€Ð¾Ð·Ñ€Ð°Ñ‡Ð½Ð°Ñ +Properties.Transparent = ÐŸÑ€Ð¾Ð·Ñ€Ð°Ñ‡Ð½Ð°Ñ +Properties.Glass = Стекло Properties.About = О программе Properties.Version = ВерÑиÑ: %s Properties.SystemInfo = Ð˜Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸Ñ Ð¾ ÑиÑтеме: diff --git a/exe/Locales/zh-CN.ini b/exe/Locales/zh-CN.ini index dfbd020..17a1aae 100644 --- a/exe/Locales/zh-CN.ini +++ b/exe/Locales/zh-CN.ini @@ -9,10 +9,10 @@ New.Cancel = å–消 Menu.Shortcut = 添加 å¿«æ·æ–¹å¼ Menu.Open = 打开工作目录 Menu.Create = 新建 Linkbar... -Menu.Delete = 删除 Linkbar +Menu.Delete = 删除 Linkbar... Menu.Lock = é”定 Linkbar Menu.Sort = 按 A-Z 顺åºæŽ’列 -Menu.Properties = å好设置 +Menu.Properties = 设置(&S) Menu.Close = 关闭 Menu.CloseAll = 关闭所有 JumpList.Recent = 最近 @@ -65,13 +65,14 @@ Properties.MouseLC = 鼠标左键 Properties.MouseRC = é¼ æ ‡å³é”® Properties.Delay = 延迟，毫秒： Properties.HotKey = 键盘快æ·é”®ï¼š -Properties.Transparent = éšè—æ—¶é€æ˜Žæ˜¾ç¤º +Properties.AutoHideTransparency = éšè—æ—¶é€æ˜Žæ˜¾ç¤º Properties.Additional = 附加设置 Properties.Jumplists = 跳转列表 +Properties.JumplistRecentMaxItems = è¦æ˜¾ç¤ºåœ¨è·³è½¬åˆ—表中的最近使用的项目数： Properties.No = 没有 -Properties.ForW7 = 针对 Windows7 +Properties.ForW7 = 针对 Windows 7 Properties.Style1 = 使用纽扣å¼é£Žæ ¼ä»»åŠ¡æ  -Properties.ForW8 = 针对 Windows8/8.1 +Properties.ForW8 = 针对 Windows 8/8.1 Properties.AeroGlass = å¼€å¯æ¯›çŽ»ç’ƒç‰¹æ•ˆæ”¯æŒï¼ˆéœ€å¦è¡Œå®‰è£…） Properties.About = 关于 Properties.Version = 版本å·ï¼š%s diff --git a/exe/README.txt b/exe/README.txt index 339ba24..7367d37 100644 --- a/exe/README.txt +++ b/exe/README.txt @@ -8,11 +8,11 @@ Note: 1) Linkbar support Windows Vista and above 2) Linkbar work with .lnk, .url and .website files -Version: 1.6.7 +Version: 1.6.8 License type: Freeware OS: Windows Vista/7/8/8.1/10 -Languages: English (default), Chinese-Simplified, French, German, Greek, Japanese, Korean, Polish, Russian, localization support -Email: linkbar@yandex.ru +Languages: English (default), Сhinese-Simplified, French, German, Greek, Japanese, Korean, Polish, Russian, Spanish, localization support +Email: linkbar@yandex.ru (use English or Russian) =============================================================================== @@ -55,6 +55,25 @@ Email: linkbar@yandex.ru == History =============================================================================== +== Version 1.6.8 general release (Mar, 2018): + +add: Spanish localization (Gohar) +add: Improved Autohide behaviour +add: Used more actual API for processing Jumplists +add: For Windows 10 improved obtaining the taskbar color +add: For Windows 10 option "Look" +add: Option "Number of recent items to display in Jumplists" +add: Option "Corners transparency width" to prevent show autohidden Linkbar +add: Prevents hide Linkbar by Win+D when the option "Keep the Linkbar on top of other windows" disabled +add: Saving the settings by clicking the "OK"/"Apply" button in the settings window instead of closing the application +add: Some settings are hidden if your OS does not support them +fix: Access violation read/write while autostart (often with 125% UI scaling) +fix: Error "Argument out of range" while remove last item +fix: Losed some graphics in Jumplists on Windows 8 +fix: In the settings, mouse wheel change a spinedit value on more than 1 step + +=============================================================================== + == Version 1.6.7 general release (Dec, 2017): add: New localization system. Simple and clear diff --git a/src/AccessBar.pas b/src/AccessBar.pas index c330a9d..1ade2b8 100644 --- a/src/AccessBar.pas +++ b/src/AccessBar.pas @@ -1,6 +1,6 @@ {*******************************************************} { Linkbar - Windows desktop toolbar } -{ Copyright (c) 2010-2017 Asaq } +{ Copyright (c) 2010-2018 Asaq } {*******************************************************} unit AccessBar; @@ -50,9 +50,10 @@ TAccessBar = class(TComponent) FStayOnTop: Boolean; // special form for autohide ahform: THiddenForm; - FTaskbarCreated: UINT; - procedure SetAutoHide(const AValue: boolean); - procedure SetSide(const AValue: TScreenAlign); + FTaskbarCreated: DWORD; + procedure SetAutoHide(AValue: boolean); + procedure SetSide(AValue: TScreenAlign); + procedure SetStayOnTop(AValue: Boolean); procedure AppBWndProc(var Msg: TMessage); function GetIsVertical: boolean; protected @@ -71,7 +72,7 @@ TAccessBar = class(TComponent) procedure AppBarPosChanged; procedure AppBarFullScreenApp(AEnabled: Boolean); published - property StayOnTop: Boolean read FStayOnTop write FStayOnTop; + property StayOnTop: Boolean read FStayOnTop write SetStayOnTop; property AutoHide: boolean read FAutoHide write SetAutoHide; property Side: TScreenAlign read FSide write SetSide default saTop; property QuerySizing: TQuerySizingEvent read FQuerySizing write FQuerySizing; @@ -87,9 +88,9 @@ implementation uses Types, Math, Linkbar.L10n; const - APPBAR_CALLBACK = WM_USER + 1; - APPBAR_FULLSCREENAPP = WM_USER + 2; - APPBAR_TASKBARSTARTED = WM_USER + 3; + LM_AB_CALLBACK = WM_USER + 1; + LM_AB_FULLSCREENAPP = WM_USER + 2; + LM_AB_TASKBARSTARTED = WM_USER + 3; // Multi Monitor support, introduced in Windows 8 ABM_GETAUTOHIDEBAREX = $0000000b; @@ -98,6 +99,18 @@ implementation procedure ChangeWindowMessageFilterEx(const AWnd: HWND; const AMessage: UINT); const MSGFLT_ALLOW = 1; type +{$REGION ' Original from msdn '} +(* BOOL WINAPI ChangeWindowMessageFilterEx( + _In_ HWND hWnd, + _In_ UINT message, + _In_ DWORD action, + _Inout_opt_ PCHANGEFILTERSTRUCT pChangeFilterStruct +); +typedef struct tagCHANGEFILTERSTRUCT { + DWORD cbSize; + DWORD ExtStatus; +} CHANGEFILTERSTRUCT, *PCHANGEFILTERSTRUCT; *) +{$ENDREGION} CHANGEFILTERSTRUCT = packed record cbSize: DWORD; ExtStatus: DWORD; @@ -158,7 +171,7 @@ constructor THiddenForm.CreateNew(AOwner: TComponent; Dummy: Integer = 0); FillChar(rabd, SizeOf(rabd), 0); rabd.cbSize := SizeOf(rabd); rabd.hWnd := Self.Handle; - rabd.uCallbackMessage := APPBAR_CALLBACK; + rabd.uCallbackMessage := LM_AB_CALLBACK; FAccessHandle := 0; if SHAppBarMessage(ABM_NEW, rabd) = 0 then raise Exception.Create(SysErrorMessage(GetLastError())); @@ -203,10 +216,10 @@ procedure THiddenForm.SetMonitor(const AMonitorNum: Integer); procedure THiddenForm.WndProc(var Msg: TMessage); begin - if Msg.Msg = APPBAR_CALLBACK + if Msg.Msg = LM_AB_CALLBACK then begin if (Msg.wParam = ABN_FULLSCREENAPP) and IsWindow(FAccessHandle) - then SendMessage(FAccessHandle, APPBAR_FULLSCREENAPP, 0, Msg.lParam); + then SendMessage(FAccessHandle, LM_AB_FULLSCREENAPP, 0, Msg.lParam); end else inherited WndProc(Msg); end; @@ -221,10 +234,15 @@ procedure TAccessBar.RegisterAppBar; begin if gABRegistered then exit; + // make sure we get the notification messages + // NOTE: moved to constructor + //FOwnerOriginalWndProc := TWinControl(Owner).WindowProc; + //TWinControl(Owner).WindowProc := AppBWndProc; + FillChar(rabd, SizeOf(rabd), 0); rabd.cbSize:= SizeOf(rabd); rabd.hWnd := FHandle; - rabd.uCallbackMessage:= APPBAR_CALLBACK; + rabd.uCallbackMessage:= LM_AB_CALLBACK; // register the application bar within the system if SHAppBarMessage(ABM_NEW, rabd) = 0 then raise Exception.Create(SysErrorMessage(GetLastError())); @@ -237,6 +255,11 @@ procedure TAccessBar.UnregisterAppBar; begin if not gABRegistered then exit; + // check if the form is not being destroyed + // NOTE: moved to destructor + //if not (csDestroying in ComponentState) + //then TWinControl(Owner).WindowProc := FOwnerOriginalWndProc; + FillChar(rabd, SizeOf(rabd), 0); rabd.cbSize:= SizeOf(rabd); rabd.hWnd := FHandle; @@ -320,6 +343,8 @@ procedure TAccessBar.AppBarQuerySetPos; iHeight, iWidth: Integer; rabd: TAppBarData; begin + //if (csDesigning in ComponentState) then Exit; + if not InRange(MonitorNum, 0, Screen.MonitorCount-1) then MonitorNum := Screen.PrimaryMonitor.MonitorNum; @@ -374,7 +399,7 @@ procedure TAccessBar.AppBarQuerySetPos; then ahform.SetMonitor(MonitorNum); end; -procedure TAccessBar.SetSide(const AValue: TScreenAlign); +procedure TAccessBar.SetSide(AValue: TScreenAlign); var rabd: TAppBarData; hr: Cardinal; begin @@ -393,7 +418,7 @@ procedure TAccessBar.SetSide(const AValue: TScreenAlign); hr := SHAppBarMessage(ABM_SETAUTOHIDEBAREX, rabd); end else begin - hr := SHAppBarMessage(ABM_SETAUTOHIDEBAR, rabd); + hr := SHAppBarMessage(ABM_SETAUTOHIDEBAR, rabd); end; if hr = 0 then raise Exception.Create(SysErrorMessage(GetLastError())); @@ -406,12 +431,24 @@ procedure TAccessBar.SetSide(const AValue: TScreenAlign); else AppBarQuerySetPos; end; -procedure TAccessBar.SetAutoHide(const AValue: boolean); +procedure TAccessBar.SetAutoHide(AValue: boolean); begin if FAutoHide = AValue then exit; AppBarSetAutoHide(AValue); end; +procedure TAccessBar.SetStayOnTop(AValue: Boolean); +var desktop: HWND; +begin + FStayOnTop := AValue; + // Set Desktop window as Parent for prevent hide Linkbar by "Show desktop" + // if "Always on Top" disabled + if (FStayOnTop) + then desktop := 0 + else desktop := FindWindowEx(FindWindow('Progman', 'Program Manager'), 0, 'SHELLDLL_DefView', ''); + SetWindowLong(FHandle, GWL_HWNDPARENT, desktop); +end; + function TAccessBar.GetIsVertical: boolean; begin Result := IsVertical(FSide); @@ -421,9 +458,8 @@ procedure TAccessBar.AppBWndProc(var Msg: TMessage); var rabd: TAppBarData; begin case Msg.Msg of - APPBAR_TASKBARSTARTED: + LM_AB_TASKBARSTARTED: begin - // TODO: Check logic if (AutoHide) then SetSide(FSide) @@ -431,19 +467,23 @@ procedure TAccessBar.AppBWndProc(var Msg: TMessage); UnregisterAppBar; RegisterAppBar; end; + StayOnTop := FStayOnTop; + Exit; end; - APPBAR_FULLSCREENAPP: + LM_AB_FULLSCREENAPP: begin Self.AppBarFullScreenApp(Msg.LParam <> 0); + Exit; end; - APPBAR_CALLBACK: + LM_AB_CALLBACK: begin case Msg.wParam of ABN_STATECHANGE, ABN_POSCHANGED: AppBarQuerySetPos; end; + Exit; end; - WM_WINDOWPOSCHANGED : + WM_WINDOWPOSCHANGED: begin FillChar(rabd, SizeOf(rabd), 0); rabd.cbSize := SizeOf(rabd); @@ -456,11 +496,14 @@ procedure TAccessBar.AppBWndProc(var Msg: TMessage); rabd.cbSize := SizeOf(rabd); rabd.hWnd := FHandle; SHAppBarMessage(ABM_ACTIVATE, rabd); - inherited; + //inherited; end; else begin if (Msg.Msg = FTaskbarCreated) - then PostMessage(FHandle, APPBAR_TASKBARSTARTED, 0, 0); + then begin + PostMessage(FHandle, LM_AB_TASKBARSTARTED, 0, 0); + Exit; + end; end; end; // call the original WndProc @@ -473,6 +516,8 @@ procedure TAccessBar.AppBarSetAutoHide(AEnabled: Boolean); rabd: TAppBarData; hr: Cardinal; begin + //if (csDesigning in ComponentState) then Exit; + FillChar(rabd, SizeOf(rabd), 0); rabd.cbSize := SizeOf(rabd); rabd.hWnd := FHandle; @@ -487,9 +532,9 @@ procedure TAccessBar.AppBarSetAutoHide(AEnabled: Boolean); hr := SHAppBarMessage(ABM_SETAUTOHIDEBAREX, rabd); end else begin - hr := SHAppBarMessage(ABM_SETAUTOHIDEBAR, rabd); + hr := SHAppBarMessage(ABM_SETAUTOHIDEBAR, rabd); end; - + if AEnabled and (hr <> 0) then begin FAutoHide := TRUE; diff --git a/src/DDForms.pas b/src/DDForms.pas index 2f22acf..eb6f14e 100644 --- a/src/DDForms.pas +++ b/src/DDForms.pas @@ -1,6 +1,6 @@ {*******************************************************} { Linkbar - Windows desktop toolbar } -{ Copyright (c) 2010-2017 Asaq } +{ Copyright (c) 2010-2018 Asaq } {*******************************************************} unit DDForms; @@ -10,11 +10,11 @@ interface uses - Windows, SysUtils, Classes, Graphics, Forms, ActiveX, ShlObj, CommCtrl, + Windows, SysUtils, Classes, Linkbar.Graphics, Forms, ActiveX, ShlObj, CommCtrl, Messages, Cromis.DirectoryWatch; const - WM_STOPDIRWATCH = WM_USER + 33; + LM_STOPDIRWATCH = WM_USER + 33; type @@ -49,7 +49,7 @@ TLinkbarCustomFrom = class abstract (TForm, IDropTarget) procedure DoDragLeave; virtual; abstract; procedure DoDrop(const pt: TPoint); virtual; abstract; // Drag Source - procedure QueryDragImage(out ABitmap: TBitmap; out AOffset: TPoint); virtual; abstract; + procedure QueryDragImage(out ABitmap: THBitmap; out AOffset: TPoint); virtual; abstract; protected procedure DirWatchChange(const Sender: TObject; const AAction: TWatchAction; const AFileName: string); virtual; @@ -74,7 +74,7 @@ TLinkbarCustomFrom = class abstract (TForm, IDropTarget) implementation uses - ComObj, Generics.Collections, Linkbar.Consts, Linkbar.Shell; + ComObj, Linkbar.Shell; //////////////////////////////////////////////////////////////////////////////// // TLinkbarCustomFrom @@ -300,7 +300,7 @@ function TLinkbarCustomFrom.Drop(const dataObj: IDataObject; grfKeyState: Intege function TLinkbarCustomFrom.CreateDragImage(out ASdi: TShDragImage): Boolean; var - bmp: TBitmap; + bmp: THBitmap; pt: TPoint; DC: HDC; hbmPrev: HBITMAP; @@ -322,7 +322,7 @@ function TLinkbarCustomFrom.CreateDragImage(out ASdi: TShDragImage): Boolean; DC := CreateCompatibleDC(HWND_DESKTOP); hbmPrev := SelectObject(DC, ASdi.hbmpDragImage); BitBlt(DC, 0, 0, ASdi.sizeDragImage.cx, ASdi.sizeDragImage.cy, - bmp.Canvas.Handle, 0, 0, SRCCOPY); + bmp.Dc, 0, 0, SRCCOPY); SelectObject(DC, hbmPrev); DeleteDC(DC); end; diff --git a/src/ExplorerMenu.pas b/src/ExplorerMenu.pas index 8baa152..31fd1dd 100644 --- a/src/ExplorerMenu.pas +++ b/src/ExplorerMenu.pas @@ -1,6 +1,6 @@ {*******************************************************} { Linkbar - Windows desktop toolbar } -{ Copyright (c) 2010-2017 Asaq } +{ Copyright (c) 2010-2018 Asaq } {*******************************************************} unit ExplorerMenu; @@ -10,12 +10,14 @@ interface uses - Windows, Messages, SysUtils, Classes, ShlObj, ActiveX, Graphics, Linkbar.Shell, Linkbar.Consts; + System.SysUtils, System.Classes, + Winapi.Windows, Winapi.Messages, Winapi.ShlObj, Winapi.ActiveX, + Linkbar.Shell; const - SCMI_LB_ITEMS = WM_USER + 11; - SCMI_SH_RENAME = WM_USER + 12; - SCMI_LB_INVOKE = WM_USER + 13; + LM_CM_ITEMS = WM_USER + 11; + LM_CM_RENAME = WM_USER + 12; + LM_CM_INVOKE = WM_USER + 13; procedure ExplorerMenuPopup(const AWnd: HWND; const APidl: PItemIDList; const AScrPt: TPoint; const AShift: Boolean; const ASubMenu: HMENU); @@ -24,8 +26,6 @@ interface implementation -uses Winapi.CommCtrl; - const SCRATCH_QCM_FIRST = 20; SCRATCH_QCM_LAST = FCIDM_SHVIEWLAST; @@ -34,18 +34,16 @@ implementation g_cm2: IContextMenu2; g_cm3: IContextMenu3; -function MenuCallback(Wnd: HWND; Msg: UINT; WParam: WPARAM; - LParam: LPARAM): LRESULT; stdcall; +function MenuCallback(Wnd: HWND; Msg: UINT; WParam: WPARAM; LParam: LPARAM): LRESULT; stdcall; begin if Assigned(g_cm3) then begin - if Succeeded( g_cm3.HandleMenuMsg2(Msg, WParam, LParam, Result) ) + if Succeeded(g_cm3.HandleMenuMsg2(Msg, WParam, LParam, Result)) then Exit; end - else - if Assigned(g_cm2) + else if Assigned(g_cm2) then begin - if Succeeded( g_cm2.HandleMenuMsg(Msg, WParam, LParam) ) + if Succeeded(g_cm2.HandleMenuMsg(Msg, WParam, LParam)) then begin Result := 0; Exit; @@ -57,26 +55,24 @@ function MenuCallback(Wnd: HWND; Msg: UINT; WParam: WPARAM; function CreateMenuCallbackWnd: HWND; const IcmCallbackWnd = 'ICMCALLBACKWND'; -var - WndClass: TWndClass; +var WndClass: TWndClass; begin FillChar(WndClass, SizeOf(WndClass), 0); WndClass.lpszClassName := PChar(IcmCallbackWnd); WndClass.lpfnWndProc := @MenuCallback; WndClass.hInstance := HInstance; - Windows.RegisterClass(WndClass); + Winapi.Windows.RegisterClass(WndClass); Result := CreateWindow(IcmCallbackWnd, '', 0, 0, 0, 0, 0, HWND_MESSAGE, 0, 0, nil); end; // Converts an icon to a bitmap function BitmapFromIcon(AIcon: HICON; ASize: integer): HBITMAP; -var - bi: TBitmapInfo; - rc: TRect; - dc: HDC; - bits: Pointer; - bmp: HBITMAP; - bmp0: HGDIOBJ; +var bi: TBitmapInfo; + rc: TRect; + dc: HDC; + bits: Pointer; + bmp: HBITMAP; + bmp0: HGDIOBJ; begin FillChar(bi, SizeOf(bi), 0); bi.bmiHeader.biSize := SizeOf(TBitmapInfoHeader); @@ -124,7 +120,7 @@ procedure ExplorerMenuPopup(const AWnd: HWND; const APidl: PItemIDList; end; var - CoInit: HRESULT; + NeedUninitialize: Boolean; Menu: HMenu; ICMenu: IContextMenu; uFlags: UINT; @@ -140,24 +136,23 @@ procedure ExplorerMenuPopup(const AWnd: HWND; const APidl: PItemIDList; hbmp: HBITMAP; iconsize: Integer; begin - CoInit := CoInitializeEx(nil, COINIT_MULTITHREADED); + NeedUninitialize := Succeeded(CoInitializeEx(nil, COINIT_MULTITHREADED)); try - if Succeeded( GetUIObjectOfPidl(AWnd, APidl, IID_IContextMenu, ICMenu) ) + if Succeeded(GetUIObjectOfPidl(AWnd, APidl, IID_IContextMenu, ICMenu)) then try CallbackWindow := 0; hbmp := 0; Menu := CreatePopupMenu; - if Menu <> 0 + if (Menu <> 0) then try uFlags := CMF_NORMAL or CMF_CANRENAME; if AShift then uFlags := uFlags or CMF_EXTENDEDVERBS; - if Succeeded( ICMenu.QueryContextMenu(Menu, 0, - SCRATCH_QCM_FIRST, SCRATCH_QCM_LAST, uFlags) ) + if Succeeded(ICMenu.QueryContextMenu(Menu, 0, SCRATCH_QCM_FIRST, SCRATCH_QCM_LAST, uFlags)) then begin if (ASubMenu <> 0) then begin - // Get position for insert Linkbar menu + // Get position for insert Linkbar menu - before "Properties" insertBefore := -1; n := GetMenuItemCount(Menu); for i := 0 to n-1 do @@ -166,8 +161,8 @@ procedure ExplorerMenuPopup(const AWnd: HWND; const APidl: PItemIDList; id := GetMenuItemID(Menu, i); if (id >= SCRATCH_QCM_FIRST) and (id <= SCRATCH_QCM_LAST) - and Succeeded( ICMenu.GetCommandString(id-SCRATCH_QCM_FIRST, GCS_VERBA, nil, - verbcmd, Length(verbcmd)) ) + and Succeeded(ICMenu.GetCommandString(id-SCRATCH_QCM_FIRST, GCS_VERBA, nil, + verbcmd, Length(verbcmd))) and SameStr(String(verbcmd), 'properties') then begin insertBefore := i; @@ -180,7 +175,8 @@ procedure ExplorerMenuPopup(const AWnd: HWND; const APidl: PItemIDList; miinfo.fMask := MIIM_TYPE; miinfo.fType := MFT_SEPARATOR; InsertMenuItem(Menu, insertBefore, True, miinfo); - // Linkbar submenu + + // Linkbar submenu item FillChar(miinfo, SizeOf(miinfo), 0); miinfo.cbSize := SizeOf(miinfo); miinfo.fMask := MIIM_SUBMENU or MIIM_STRING; @@ -190,10 +186,11 @@ procedure ExplorerMenuPopup(const AWnd: HWND; const APidl: PItemIDList; // Icon for Linkbar submenu item iconsize := GetSystemMetrics(SM_CXSMICON); - hIco := LoadImage(HInstance, MakeIntResource('MAINICON'), IMAGE_ICON, iconsize, iconsize, LR_DEFAULTCOLOR); + hIco := LoadImage(HInstance, MakeIntResource('MAINICON'), IMAGE_ICON, + iconsize, iconsize, LR_DEFAULTCOLOR); if (hIco <> 0) then begin - hbmp := BitmapFromIcon(hIco, GetSystemMetrics(SM_CXSMICON)); + hbmp := BitmapFromIcon(hIco, iconsize); DestroyIcon(hIco); FillChar(miinfo, SizeOf(miinfo), 0); miinfo.cbSize := SizeOf(miinfo); @@ -202,7 +199,8 @@ procedure ExplorerMenuPopup(const AWnd: HWND; const APidl: PItemIDList; SetMenuItemInfo(Menu, insertBefore, True, miinfo); end; - // Sometimes menus have multiple separators e.g. for html shortcut. In Explorer.exe there is no such + // Sometimes menus have multiple separators e.g. for html shortcut + // In Explorer.exe there is no such RemoveMultipleSeparators(Menu); end; @@ -216,22 +214,21 @@ procedure ExplorerMenuPopup(const AWnd: HWND; const APidl: PItemIDList; finally g_cm2 := nil; g_cm3 := nil; - if (hbmp <> 0) then DeleteObject(hbmp); + if (hbmp <> 0) + then DeleteObject(hbmp); end; - if (Command) + if (Command) then begin iCmd := LongInt(Command); if (iCmd < SCRATCH_QCM_FIRST) - then - PostMessage(AWnd, SCMI_LB_ITEMS, 0, iCmd) + then PostMessage(AWnd, LM_CM_ITEMS, 0, iCmd) else begin iCmd := iCmd - SCRATCH_QCM_FIRST; verbcmd[0] := #0; - if Succeeded( ICMenu.GetCommandString(iCmd, GCS_VERBA, nil, - verbcmd, SizeOf(verbcmd)) ) + if Succeeded(ICMenu.GetCommandString(iCmd, GCS_VERBA, nil,verbcmd, SizeOf(verbcmd))) and SameStr(String(verbcmd), 'rename') - then PostMessage(AWnd, SCMI_SH_RENAME, 0, 0) + then PostMessage(AWnd, LM_CM_RENAME, 0, 0) else begin FillChar(Info, SizeOf(Info), 0); Info.cbSize := SizeOf(Info); @@ -239,18 +236,18 @@ procedure ExplorerMenuPopup(const AWnd: HWND; const APidl: PItemIDList; or CMIC_MASK_PTINVOKE or CMIC_MASK_FLAG_LOG_USAGE or CMIC_MASK_NOASYNC; - if ( GetKeyState(VK_CONTROL) < 0 ) + if (GetKeyState(VK_CONTROL) < 0) then Info.fMask := Info.fMask or CMIC_MASK_CONTROL_DOWN; - if ( GetKeyState(VK_SHIFT) < 0 ) + if (GetKeyState(VK_SHIFT) < 0) then Info.fMask := Info.fMask or CMIC_MASK_SHIFT_DOWN; Info.hwnd := AWnd; Info.nShow := SW_SHOWNORMAL; Info.lpVerb := MakeIntResourceA(iCmd); Info.lpVerbW := MakeIntResourceW(iCmd); Info.ptInvoke := AScrPt; - PostMessage(AWnd, SCMI_LB_INVOKE, 0, iCmd); + PostMessage(AWnd, LM_CM_INVOKE, 0, iCmd); EnableWindow(AWnd, False); - ICMenu.InvokeCommand( PCMInvokeCommandInfo(@Info)^ ); + ICMenu.InvokeCommand(PCMInvokeCommandInfo(@Info)^); EnableWindow(AWnd, True); end; end; @@ -258,14 +255,14 @@ procedure ExplorerMenuPopup(const AWnd: HWND; const APidl: PItemIDList; end; finally DestroyMenu(Menu); - if CallbackWindow <> 0 + if (CallbackWindow <> 0) then DestroyWindow(CallbackWindow); end; finally ICMenu := nil; end; finally - if CoInit = S_OK + if NeedUninitialize then CoUninitialize; end; end; @@ -277,16 +274,16 @@ procedure OpenByDefaultVerb(const AWnd: HWND; const APidl: PItemIDList); id: UINT; Info: TCMInvokeCommandInfo; begin - if Succeeded( GetUIObjectOfPidl(AWnd, APidl, IID_IContextMenu, pMenu) ) + if Succeeded(GetUIObjectOfPidl(AWnd, APidl, IID_IContextMenu, pMenu)) then try Menu := CreatePopupMenu; if (Menu <> 0) then try - if Succeeded( pMenu.QueryContextMenu(Menu, 0, FCIDM_SHVIEWFIRST, - FCIDM_SHVIEWLAST, CMF_DEFAULTONLY) ) + if Succeeded(pMenu.QueryContextMenu(Menu, 0, FCIDM_SHVIEWFIRST, + FCIDM_SHVIEWLAST, CMF_DEFAULTONLY)) then begin id := GetMenuDefaultItem(Menu, 0, 0); - if ( id <> UINT(-1) ) + if (id <> UINT(-1)) then begin FillChar(Info, SizeOf(Info), 0); Info.cbSize := SizeOf(Info); diff --git a/src/LBToolbar.pas b/src/LBToolbar.pas index c6977b6..94cb12e 100644 --- a/src/LBToolbar.pas +++ b/src/LBToolbar.pas @@ -1,17 +1,17 @@ {*******************************************************} { Linkbar - Windows desktop toolbar } -{ Copyright (c) 2010-2017 Asaq } +{ Copyright (c) 2010-2018 Asaq } {*******************************************************} unit LBToolbar; {$i linkbar.inc} -{;$define CHACE_BB_ICON} // chache Bit Bucket icon. However, if the user changes the icon of the Bit Bucket, this is incorrect. - +{;$define CHACE_BB_ICON} // Ñhache Bit Bucket icon. + // However, if the user changes the icon of the Bit Bucket, this is incorrect. interface -uses Windows, SysUtils, ShlObj, Winapi.CommCtrl, Generics.Collections, Vcl.Graphics; +uses System.SysUtils, Winapi.Windows, Winapi.ShlObj, Vcl.Graphics, Generics.Collections; type TLbItem = class @@ -57,11 +57,10 @@ TLBItemList = class(TObjectList) implementation -uses Winapi.ActiveX, Winapi.ShellAPI, System.Win.ComObj, Winapi.KnownFolders, - Linkbar.OS, Linkbar.Consts, Linkbar.Shell; +uses System.Win.ComObj, Winapi.ActiveX, Winapi.ShellAPI, Winapi.KnownFolders, + Linkbar.OS, Linkbar.Shell; -var - FKnownFolderManager: IKnownFolderManager; +var FKnownFolderManager: IKnownFolderManager; function CalcFNVHashFromString(const AData: string; AHash: Cardinal = 2166136261): Cardinal; inline; var pData: PByte; @@ -90,7 +89,7 @@ function CheckShield(const APidl: PItemIDList): Boolean; location: array[0..MAX_PATH] of Char; begin Result := False; - if Succeeded( GetUIObjectOfPidl(0, APidl, IExtractIcon, Pointer(pExtract)) ) + if Succeeded(GetUIObjectOfPidl(0, APidl, IExtractIcon, Pointer(pExtract))) then begin index := 0; flags := 0; @@ -116,7 +115,7 @@ function CheckBitBucket(const APidl: PItemIDList): Boolean; pidl := APidl; // resolve link - if Succeeded( GetUIObjectOfPidl(0, APidl, IShellLink, Pointer(pLink)) ) + if Succeeded(GetUIObjectOfPidl(0, APidl, IShellLink, Pointer(pLink))) then pLink.GetIDList(pidl); pLink := nil; @@ -128,7 +127,7 @@ function CheckBitBucket(const APidl: PItemIDList): Boolean; Result := Succeeded(hr) and Assigned(pKnownFolder) - and Succeeded( pKnownFolder.GetId(id) ) + and Succeeded(pKnownFolder.GetId(id)) and (id = FOLDERID_RecycleBinFolder); end; @@ -170,7 +169,7 @@ function TLbItem.LoadFromFile(AFileName: string): Boolean; FileName := AFileName; Hash := StrToHash(ExtractFileName(FileName)); - if Succeeded( SHGetNameFromIDList(Pidl, SIGDN_NORMALDISPLAY, ppszName) ) + if Succeeded(SHGetNameFromIDList(Pidl, SIGDN_NORMALDISPLAY, ppszName)) then begin Caption := String(ppszName); CoTaskMemFree(ppszName); @@ -269,16 +268,16 @@ function LoadIconFromPidl(APidl: PItemIDList; AIconSize: Integer): HBITMAP; var hbmp: HBITMAP; hr: HRESULT; fileShellItemImage: IShellItemImageFactory; - NeedUninitialize: Boolean; + needUninitialize: Boolean; begin Result := 0; - NeedUninitialize := SUCCEEDED(CoInitializeEx(nil, COINIT_APARTMENTTHREADED or COINIT_DISABLE_OLE1DDE)); + needUninitialize := Succeeded(CoInitializeEx(nil, COINIT_APARTMENTTHREADED or COINIT_DISABLE_OLE1DDE)); try hr := SHCreateItemFromIDList(APidl, IShellItemImageFactory, fileShellItemImage); - if Succeeded(hr) then - begin + if Succeeded(hr) + then begin hr := fileShellItemImage.GetImage(TSize.Create(AIconSize, AIconSize), - SIIGBF_ICONONLY, hbmp); + SIIGBF_ICONONLY or SIIGBF_BIGGERSIZEOK, hbmp); if Succeeded(hr) then begin // Bitmaps for Windows 8.1/10 require premultiply @@ -289,7 +288,7 @@ function LoadIconFromPidl(APidl: PItemIDList; AIconSize: Integer): HBITMAP; fileShellItemImage := nil; end; finally - if NeedUninitialize + if needUninitialize then CoUninitialize; end; end; @@ -344,8 +343,10 @@ procedure TLBItemList.BitBucketUpdateIcon; var item: TLbItem; begin for item in Self do + begin if item.BitBucket then LoadIcon(item); + end; end; {$endif} @@ -354,7 +355,8 @@ procedure TLBItemList.SetIconSize(AValue: Integer); sii: TSHStockIconInfo; item: TLbItem; begin - if (FIconSize = AValue) then Exit; + if (FIconSize = AValue) + then Exit; FIconSize := AValue; { Add shield overlay icon } @@ -403,18 +405,19 @@ procedure TLBItemList.Draw(AHdc: HDC; AIndex, AX, AY: Integer); bmp0 := SelectObject(dc, item.HBmp); // Draw icon - Windows.AlphaBlend(AHdc, AX, AY, FIconSize, FIconSize, dc, + Winapi.Windows.AlphaBlend(AHdc, AX, AY, FIconSize, FIconSize, dc, 0, 0, FIconSize, FIconSize, bf); + SelectObject(dc, bmp0); // Draw shield if (item.Shield) then begin - SelectObject(dc, HBmpShield); - Windows.AlphaBlend(AHdc, AX, AY, FIconSize, FIconSize, dc, + bmp0 := SelectObject(dc, HBmpShield); + Winapi.Windows.AlphaBlend(AHdc, AX, AY, FIconSize, FIconSize, dc, 0, 0, FIconSize, FIconSize, bf); + SelectObject(dc, bmp0); end; - SelectObject(dc, bmp0); DeleteDC(dc); end; @@ -437,19 +440,20 @@ procedure TLBItemList.QuickSort(L, R: Integer); repeat while SortCompareLogical(Self, I, P) < 0 do Inc(I); while SortCompareLogical(Self, J, P) > 0 do Dec(J); - if I <= J then - begin - if I <> J then - Self.Exchange(I, J); - if P = I then - P := J - else if P = J then - P := I; + if (I <= J) + then begin + if (I <> J) + then Self.Exchange(I, J); + if (P = I) + then P := J + else if (P = J) + then P := I; Inc(I); Dec(J); end; until I > J; - if L < J then QuickSort(L, J); + if (L < J) + then QuickSort(L, J); L := I; until I >= R; end; diff --git a/src/Linkbar.Common.pas b/src/Linkbar.Common.pas index 2910d05..42ccd78 100644 --- a/src/Linkbar.Common.pas +++ b/src/Linkbar.Common.pas @@ -1,6 +1,6 @@ {*******************************************************} { Linkbar - Windows desktop toolbar } -{ Copyright (c) 2010-2017 Asaq } +{ Copyright (c) 2010-2018 Asaq } {*******************************************************} unit Linkbar.Common; diff --git a/src/Linkbar.Consts.pas b/src/Linkbar.Consts.pas index a35a32a..1e3aa54 100644 --- a/src/Linkbar.Consts.pas +++ b/src/Linkbar.Consts.pas @@ -1,6 +1,6 @@ {*******************************************************} { Linkbar - Windows desktop toolbar } -{ Copyright (c) 2010-2017 Asaq } +{ Copyright (c) 2010-2018 Asaq } {*******************************************************} unit Linkbar.Consts; @@ -9,7 +9,7 @@ interface -uses Windows, Controls; +uses Windows, Controls, Winapi.Messages; type TItemOrder = (ioLeftToRight = 0, ioUpToDown = 1); @@ -22,18 +22,20 @@ interface TJumplistShowMode = (jsmDisabled = 0, jsmMouseClickRight = 1); + TLookMode = (lmOpaque = 0, lmTransparent = 1, lmGlass = 2, lmDisabled = 3); + const + LM_DOAUTOHIDE = WM_USER + 66; + APP_NAME_LINKBAR = 'Linkbar'; URL_WEB = 'https://sourceforge.net/projects/linkbar/'; URL_EMAIL = 'linkbar@yandex.ru'; - + URL_GITHUB = 'https://github.com/ATGH15102AFMLD/Linkbar'; URL_WINDOWS_HOTKEY = 'https://support.microsoft.com/en-ie/help/12445/windows-keyboard-shortcuts'; // Supported extentions ES_ARRAY: array[0..2] of string = ('.lnk', '.url', '.website'); - FN_LOCALIZATION = 'Linkbar.lc3'; - CLK_LANG = 'l'; CLK_FILE = 'f'; CLK_NEW = 'n'; @@ -41,7 +43,7 @@ interface DN_SHARED_BARS = 'Shared bars\'; DN_USER_BARS = 'User bars\'; - DN_LOCALES = 'Locales/'; + DN_LOCALES = 'Locales\'; EXT_LBR = '.lbr'; MASK_LBR = '*' + EXT_LBR; @@ -62,79 +64,91 @@ interface GLOW_SIZE_MIN = 0; GLOW_SIZE_MAX = 16; + JUMPLIST_RECENTMAX_MIN = 0; + JUMPLIST_RECENTMAX_MAX = 60; + + CORNER_GAP_WIDTH_MIN = 0; + CORNER_GAP_WIDTH_MAX = 512; + GRIP_SIZE = 12; TOOLTIP_OFFSET = 8; - TEXT_BORDER = 3; // border need for Classic theme, see mUnit.pas/DrawThemedText DROP_INDICATOR_SIZE = 4; DROP_INDICATOR_PADDING_DIV = 8; TEXTALIGN: array[TTextLayout] of Cardinal = (0, DT_RIGHT, DT_CENTER, DT_LEFT, DT_CENTER); - MOUSE_THRESHOLD: Double = 5.0; + PANEL_DRAG_THRESHOLD: Double = 5.0; ITEM_NONE = -1; ITEM_ALL = -1; TIMER_AUTO_HIDE_DELAY = 300; - DEF_AUTOHIDE = False; - DEF_AUTOHIDE_TRANSPARENCY = False; - DEF_AUTOHIDE_SHOWMODE = Integer(Low(TAutoShowMode)); - DEF_AUTOHIDE_HOTKEY = '$0007004C'; // Shift+Ctrl+Alt+L - DEF_DIR_LINKS = '.\links'; - DEF_EDGE = Integer(saTop); - DEF_HINT_SHOW = True; - DEF_ICON_SIZE = 32; - DEF_ISLIGHT = False; - DEF_ITEM_ORDER = Integer(Low(TItemOrder)); - DEF_LOCK_BAR = False; - DEF_MARGINX = 4; - DEF_MARGINY = 4; - DEF_TEXT_LAYOUT = Integer(Low(TTextlayout)); - DEF_TEXT_OFFSET = 4; - DEF_TEXT_WIDTH = 64; - DEF_AUTOSHOW_DELAY = 0; - DEF_SORT_AB = False; - DEF_BKGCOLOR = $00000000; - DEF_TXTCOLOR = $00000000; - DEF_USECOLOR = False; - DEF_GLOWSIZE = 12; - DEF_ENABLE_AG = False; - DEF_JUMPLISTSHOWMODE = Integer(jsmMouseClickRight); - DEF_STAYONTOP = True; + DEF_AUTOHIDE = False; + DEF_AUTOHIDE_TRANSPARENCY = False; + DEF_AUTOHIDE_SHOWMODE = Integer(Low(TAutoShowMode)); + DEF_AUTOHIDE_HOTKEY = '$0007004C'; // Shift+Ctrl+Alt+L //((MOD_SHIFT or MOD_CONTROL or MOD_ALT) shl 16) or Ord('L'); + DEF_DIR_LINKS = '.\links'; + DEF_EDGE = Integer(saTop); + DEF_HINT_SHOW = True; + DEF_ICON_SIZE = 32; + DEF_ISLIGHT = False; + DEF_ITEM_ORDER = Integer(Low(TItemOrder)); + DEF_LOCK_BAR = False; + DEF_MARGINX = 4; + DEF_MARGINY = 4; + DEF_TEXT_LAYOUT = Integer(Low(TTextlayout)); + DEF_TEXT_OFFSET = 4; + DEF_TEXT_WIDTH = 64; + DEF_AUTOSHOW_DELAY = 0; + DEF_SORT_AB = False; + DEF_BKGCOLOR = $00000000; + DEF_TXTCOLOR = $00000000; + DEF_USEBKGCOLOR = False; + DEF_USETXTCOLOR = True; + DEF_GLOWSIZE = 12; + DEF_ENABLE_AG = False; + DEF_JUMPLIST_SHOWMODE = Integer(jsmMouseClickRight); + DEF_JUMPLIST_RECENTMAX = 16; + DEF_STAYONTOP = True; + DEF_LOOKMODE = Integer(lmGlass); + DEF_CORNERGAP_WIDTH = 0; // INI sections - INI_SECTION_MAIN = 'Main'; { Main } - INI_SECTION_DEV = 'Dev'; { Developer } + INI_SECTION_MAIN = 'Main'; { Main } + INI_SECTION_DEV = 'Dev'; { Developer } // INI fields - INI_AUTOHIDE = 'autohide'; - INI_AUTOHIDE_TRANSPARENCY = 'autohidetransparency'; - INI_AUTOHIDE_SHOWMODE = 'autohideshowmode'; - INI_AUTOHIDE_HOTKEY = 'autohidehotkey'; - INI_DIR_LINKS = 'dirlinks'; - INI_EDGE = 'edge'; - INI_HINT_SHOW = 'hintshow'; - INI_ICON_SIZE = 'iconsize'; - INI_ISLIGHT = 'usestylecombined'; - INI_ITEM_ORDER = 'itemorder'; - INI_LOCK_BAR = 'lockbar'; - INI_MARGINX = 'marginx'; - INI_MARGINY = 'marginy'; - INI_MONITORNUM = 'monitornum'; - INI_TEXT_LAYOUT = 'textlayout'; - INI_TEXT_OFFSET = 'textoffset'; - INI_TEXT_WIDTH = 'textwidth'; - INI_AUTOSHOW_DELAY = 'autoshowdelay'; - INI_SORT_AB = 'sortab'; - INI_USEBKGCOLOR = 'usebgcolor'; - INI_BKGCOLOR = 'bgcolor'; { Background color } - INI_USETXTCOLOR = 'usetxtcolor'; - INI_TXTCOLOR = 'txtcolor'; { Text color } - INI_GLOWSIZE = 'glowsize'; - INI_JUMPLISTSHOWMODE = 'jumplistshowmode'; - INI_STAYONTOP = 'stayontop'; - - INI_ENABLE_AG = 'enableaeroglass'; + INI_AUTOHIDE = 'autohide'; + INI_AUTOHIDE_TRANSPARENCY = 'autohidetransparency'; + INI_AUTOHIDE_SHOWMODE = 'autohideshowmode'; + INI_AUTOHIDE_HOTKEY = 'autohidehotkey'; + INI_DIR_LINKS = 'dirlinks'; + INI_EDGE = 'Edge'; + INI_HINT_SHOW = 'hintshow'; + INI_ICON_SIZE = 'iconsize'; + INI_ISLIGHT = 'usestylecombined'; + INI_ITEM_ORDER = 'itemorder'; + INI_LOCK_BAR = 'lockbar'; + INI_MARGINX = 'marginx'; + INI_MARGINY = 'marginy'; + INI_MONITORNUM = 'monitornum'; + INI_TEXT_LAYOUT = 'textlayout'; + INI_TEXT_OFFSET = 'textoffset'; + INI_TEXT_WIDTH = 'textwidth'; + INI_AUTOSHOW_DELAY = 'autoshowdelay'; + INI_SORT_AB = 'sortab'; + INI_USEBKGCOLOR = 'usebgcolor'; + INI_BKGCOLOR = 'bgcolor'; { Background color } + INI_USETXTCOLOR = 'usetxtcolor'; + INI_TXTCOLOR = 'txtcolor'; { Text color } + INI_GLOWSIZE = 'glowsize'; + INI_JUMPLIST_SHOWMODE = 'jumplistshowmode'; + INI_JUMPLIST_RECENTMAX = 'jumplistrecentmaxitems'; + INI_STAYONTOP = 'stayontop'; + INI_LOOKMODE = 'look'; + INI_ENABLE_AG = 'enableaeroglass'; + INI_CORNER1GAP_WIDTH = 'corner1gapwidth'; + INI_CORNER2GAP_WIDTH = 'corner2gapwidth'; LINKSLIST_FILE_NAME = 'list'; diff --git a/src/Linkbar.Graphics.pas b/src/Linkbar.Graphics.pas new file mode 100644 index 0000000..ef965e6 --- /dev/null +++ b/src/Linkbar.Graphics.pas @@ -0,0 +1,232 @@ +{*******************************************************} +{ Linkbar - Windows desktop toolbar } +{ Copyright (c) 2010-2018 Asaq } +{*******************************************************} + +// Using raw bitmap reduces the size of the executable file + +unit Linkbar.Graphics; + +interface + +uses Windows; + +type + THBitmap = class + private + FHandle: HBITMAP; + FWidth: Integer; + FHeight: Integer; + FBpp: Integer; + FBmp0: HGDIOBJ; + FDc: HDC; + FBits: Pointer; + FPitch: Integer; + procedure NeedDc; + procedure NeedHandle; + procedure DeleteDc; + procedure DeleteHandle; + function GetDc: HDC; + function GetBound: TRect; + public + constructor Create(ABpp: Integer); + destructor Destroy; override; + procedure SetSize(AWidth, AHeight: Integer); + function Clone: THBitmap; + procedure Clear; + procedure Opaque; + procedure OpaqueRect(ARect: TRect); + property Handle: HBITMAP read FHandle; + property Dc: HDC read GetDc; + property Width: Integer read FWidth; + property Height: Integer read FHeight; + property Bound: TRect read GetBound; + end; + +implementation + +uses System.Classes; + +function BitmapPitch(Width, Bpp: Integer; Align: Integer = 32): Integer; +begin + Dec(Align); + Result := (Width * Bpp + Align) and not Align; + Result := Result div 8; +end; + +{ THBitmap } + +constructor THBitmap.Create(ABpp: Integer); +begin + FHandle := 0; + FDc := 0; + FBmp0 := 0; + FWidth := 0; + FHeight := 0; + FPitch := 0; + FBits := nil; + FBpp := ABpp; +end; + +destructor THBitmap.Destroy; +begin + DeleteDc; + DeleteHandle; + inherited; +end; + +function THBitmap.Clone: THBitmap; +begin + Result := THBitmap.Create(FBpp); + Result.SetSize(FWidth, FHeight); + BitBlt(Result.GetDc, 0, 0, FWidth, FHeight, Dc, 0, 0, SRCCOPY); +end; + +procedure THBitmap.DeleteDc; +begin + if (FDc <> 0) + then begin + SelectObject(FDc, FBmp0); + Windows.DeleteDC(FDc); + FDc := 0; + FBmp0 := 0; + end; +end; + +procedure THBitmap.DeleteHandle; +begin + if (FHandle <> 0) + then begin + DeleteObject(FHandle); + FHandle := 0; + FBits := nil; + end; +end; + +procedure THBitmap.NeedHandle; +var bi: TBitmapInfo; + dc: HDC; +begin + DeleteDc; + DeleteHandle; + + if (FWidth = 0) + or (FHeight = 0) + or (FBpp = 0) + then Exit; + + FillChar(bi, SizeOf(bi), 0); + bi.bmiHeader.biSize := sizeof(TBitmapInfoHeader); + bi.bmiHeader.biWidth := FWidth; + bi.bmiHeader.biHeight := -FHeight; + bi.bmiHeader.biPlanes := 1; + bi.bmiHeader.biBitCount := FBpp; + dc := CreateCompatibleDC(0); + FHandle := CreateDIBSection(dc, bi, DIB_RGB_COLORS, FBits, 0, 0); + Windows.DeleteDC(dc); + + if (FHandle = 0) + then FBits := nil; + + FPitch := BitmapPitch(FWidth, FBpp); +end; + +function THBitmap.GetBound: TRect; +begin + Result := Rect(0, 0, FWidth, FHeight); +end; + +procedure THBitmap.NeedDc; +begin + if (FHandle = 0) + then Exit; + + DeleteDc; + + FDc := CreateCompatibleDC(0); + FBmp0 := SelectObject(FDc, FHandle); +end; + +procedure THBitmap.SetSize(AWidth, AHeight: Integer); +begin + if (FWidth <> AWidth) + or (FHeight <> AHeight) + then begin + FWidth := AWidth; + FHeight := AHeight; + NeedHandle; + end; +end; + +function THBitmap.GetDc: HDC; +begin + NeedDc; + Result := FDc; +end; + +procedure THBitmap.Clear; +begin + if (FBits = nil) + then Exit; + ZeroMemory(FBits, FPitch * FHeight); +end; + +{ Set all pixel opaque. Only for 32-bit bitmap } +procedure THBitmap.Opaque; +var color: PCardinal; + i: Cardinal; +begin + if (FBits = nil) + or (FBpp <> 32) + then Exit; + + if (FDc <> 0) + then SelectObject(FDc, FBmp0); + + color := PCardinal(FBits); + for i := 1 to (FWidth * FHeight) do + begin + color^ := $FF000000 or (color^ and $FFFFFF); + Inc(color); + end; + + if (FDc <> 0) + then FBmp0 := SelectObject(FDc, FHandle); +end; + +{ Set all pixel opaque within ARect. Only for 32-bit bitmap } +procedure THBitmap.OpaqueRect(ARect: TRect); +var color: PCardinal; + x, y, w: Integer; +begin +{$IFDEF DEBUG} + Assert( (ARect.Left >= 0) + and (ARect.Top >= 0) + and (ARect.Right <= FWidth) + and (ARect.Bottom <= Height) ); +{$ENDIF} + + if (FBits = nil) + or (FBpp <> 32) + then Exit; + + if (FDc <> 0) + then SelectObject(FDc, FBmp0); + + w := ARect.Width; + for y := 0 to ARect.Height-1 do + begin + color := PCardinal(FBits); + Inc(color, (ARect.Top + y) * FWidth + ARect.Left); + for x := 1 to w do + begin + color^ := $FF000000 or (color^ and $FFFFFF); + Inc(color); + end; + end; + + if (FDc <> 0) + then FBmp0 := SelectObject(FDc, FHandle); +end; + +end. diff --git a/src/Linkbar.Hint.pas b/src/Linkbar.Hint.pas index 3e0efcd..e7b1810 100644 --- a/src/Linkbar.Hint.pas +++ b/src/Linkbar.Hint.pas @@ -1,6 +1,6 @@ {*******************************************************} { Linkbar - Windows desktop toolbar } -{ Copyright (c) 2010-2017 Asaq } +{ Copyright (c) 2010-2018 Asaq } {*******************************************************} unit Linkbar.Hint; @@ -95,7 +95,7 @@ function FitTipRect(const r1, r2: TRect): TPoint; Result := tr.TopLeft; end; -{} + procedure TTooltip32.Activate(const APos: TPoint; const AText: string; const AHorzAlign: TAlignment; const AVertAlign: TVerticalAlignment); var wr: TRect; diff --git a/src/Linkbar.OS.pas b/src/Linkbar.OS.pas index 8d60b57..10e11b5 100644 --- a/src/Linkbar.OS.pas +++ b/src/Linkbar.OS.pas @@ -1,6 +1,6 @@ {*******************************************************} { Linkbar - Windows desktop toolbar } -{ Copyright (c) 2010-2017 Asaq } +{ Copyright (c) 2010-2018 Asaq } {*******************************************************} unit Linkbar.OS; @@ -11,9 +11,6 @@ interface uses Windows, SysUtils; - procedure InitOS; - function VersionToString: string; - var IsWindowsXP, IsWindowsVista, IsWindows7, IsWindows8, IsWindows8dot1, IsWindows8And8Dot1, IsWindows10: Boolean; @@ -22,49 +19,67 @@ interface IsMinimumSupportedOS: Boolean; IsJumplistAvailable: Boolean; + VersionToString: string; + implementation { TMyVersion } -function VersionToString: string; -var - iBufferSize: DWORD; - iDummy: DWORD; - pBuffer: Pointer; - FName: string; - pFileInfo: PVSFixedFileInfo; - Major, Minor, Release: Word; +function GetVersionString: string; +var resInfo: HRSRC; + resDate: HGLOBAL; + sz: DWORD; + res, resCopy: Pointer; + fileInfo: PVSFixedFileInfo; + dummy: DWORD; + major, minor, release: Word; begin - FName := GetModuleName(HInstance); - iBufferSize := GetFileVersionInfoSize(PChar(FName), iDummy); - if (iBufferSize > 0) then - begin - GetMem(pBuffer, iBufferSize); - try - // get fixed file info (language independent) - GetFileVersionInfo(PChar(FName), 0, iBufferSize, pBuffer); - VerQueryValue(pBuffer, '\', Pointer(pFileInfo), iDummy); - // read version blocks - Major := HiWord(pFileInfo^.dwFileVersionMS); - Minor := LoWord(pFileInfo^.dwFileVersionMS); - Release := HiWord(pFileInfo^.dwFileVersionLS); - Result := Format('%d.%d.%d', [Major, Minor, Release]); - if (pFileInfo^.dwFileFlags and VS_FF_SPECIALBUILD) <> 0 + Result := 'Unknown'; + resInfo := FindResource(HInstance, MakeIntResource(VS_VERSION_INFO), RT_VERSION); + if (resInfo = 0) + then Exit; + sz := SizeofResource(HInstance, resInfo); + if (sz = 0) + then Exit; + resCopy := GetMemory(sz); + try + resDate := LoadResource(HInstance, resInfo); + if (resDate = 0) + then Exit; + res := LockResource(resDate); + if (res <> nil) + then CopyMemory(resCopy, res, sz); + + //FreeResource(resDate); not needed + + if VerQueryValue(resCopy, '\', Pointer(fileInfo), dummy) + and (dummy > 0) + then begin + major := HiWord(fileInfo^.dwFileVersionMS); + minor := LoWord(fileInfo^.dwFileVersionMS); + release := HiWord(fileInfo^.dwFileVersionLS); + Result := Format('%d.%d.%d', [major, minor, release]); + if (fileInfo^.dwFileFlags and VS_FF_SPECIALBUILD) <> 0 then Result := Result + '/Experimental'; - if ((pFileInfo^.dwFileFlags and VS_FF_DEBUG) <> 0) + if ((fileInfo^.dwFileFlags and VS_FF_DEBUG) <> 0) then Result := Result + '/Debug'; - if (pFileInfo^.dwFileFlags and VS_FF_PRERELEASE) <> 0 + if (fileInfo^.dwFileFlags and VS_FF_PRERELEASE) <> 0 then Result := Result + '/Prerelease'; - if (pFileInfo^.dwFileFlags and VS_FF_PRIVATEBUILD) <> 0 - then Result := Result + ' Beta 1'; - finally - FreeMem(pBuffer); + if (fileInfo^.dwFileFlags and VS_FF_PRIVATEBUILD) <> 0 + then Result := Result + ' Beta 4'; end; + + finally + FreeMemory(resCopy); end; end; procedure InitOS; begin + VersionToString := GetVersionString; + + IsWindowsXPOrAbove := TOSVersion.Check(5, 1); + IsWindowsXPOrAbove := CheckWin32Version( 5, 1); IsWindowsVistaOrAbove := CheckWin32Version( 6, 0); IsWindows7OrAbove := CheckWin32Version( 6, 1); @@ -85,4 +100,7 @@ procedure InitOS; IsJumplistAvailable := (IsWindows7 or IsWindows8 or IsWindows8Dot1 or IsWindows10); end; +initialization + InitOS; + end. diff --git a/src/Linkbar.Settings.dfm b/src/Linkbar.SettingsForm.dfm similarity index 77% rename from src/Linkbar.Settings.dfm rename to src/Linkbar.SettingsForm.dfm index df791a5..520cdfe 100644 --- a/src/Linkbar.Settings.dfm +++ b/src/Linkbar.SettingsForm.dfm @@ -1,12 +1,11 @@ object FrmProperties: TFrmProperties - Left = 600 - Top = 263 - ActiveControl = chbLightStyle + Left = 206 + Top = 169 BiDiMode = bdLeftToRight BorderIcons = [biSystemMenu] BorderWidth = 4 - ClientHeight = 517 - ClientWidth = 383 + ClientHeight = 409 + ClientWidth = 408 Color = clBtnFace DefaultMonitor = dmMainForm Font.Charset = DEFAULT_CHARSET @@ -17,7 +16,7 @@ object FrmProperties: TFrmProperties FormStyle = fsStayOnTop OldCreateOrder = False ParentBiDiMode = False - Position = poDesigned + Position = poScreenCenter OnClose = FormClose OnDestroy = FormDestroy OnMouseWheel = FormMouseWheel @@ -31,7 +30,7 @@ object FrmProperties: TFrmProperties Top = 6 Width = 399 Height = 361 - ActivePage = tsView + ActivePage = tsAbout Align = alCustom Anchors = [akLeft, akTop, akRight] TabOrder = 0 @@ -57,7 +56,7 @@ object FrmProperties: TFrmProperties BevelOuter = bvNone ShowCaption = False TabOrder = 7 - object chbUseTxtColor: TCheckBox + object chbUseTextColor: TCheckBox Left = 0 Top = 0 Width = 185 @@ -79,7 +78,7 @@ object FrmProperties: TFrmProperties Selected = clWhite Style = [cbStandardColors, cbCustomColor, cbPrettyNames, cbCustomColors] TabOrder = 1 - OnChange = edtColorBgChange + OnChange = edtBkgndColorChange end end object pnlDummy1: TPanel @@ -89,7 +88,6 @@ object FrmProperties: TFrmProperties Height = 22 Anchors = [akLeft, akTop, akRight] BevelOuter = bvNone - Color = clRed ShowCaption = False TabOrder = 0 object lblScreenEdge: TLabel @@ -244,7 +242,7 @@ object FrmProperties: TFrmProperties BevelOuter = bvNone ShowCaption = False TabOrder = 5 - object Label1: TLabel + object lblTextPosition: TLabel Left = 0 Top = 0 Width = 76 @@ -280,7 +278,7 @@ object FrmProperties: TFrmProperties BevelOuter = bvNone ShowCaption = False TabOrder = 6 - object Label6: TLabel + object lblTextWidthIdent: TLabel Left = 0 Top = 0 Width = 105 @@ -332,7 +330,7 @@ object FrmProperties: TFrmProperties BevelOuter = bvNone ShowCaption = False TabOrder = 2 - object btnBgColorShowHide: TSpeedButton + object btnBkgndColorEdit: TSpeedButton Left = 348 Top = 0 Width = 23 @@ -341,7 +339,7 @@ object FrmProperties: TFrmProperties Caption = '...' OnClick = btnBgColorClick end - object edtColorBg: TEdit + object edtBkgndColor: TEdit Tag = 3 Left = 208 Top = 0 @@ -353,10 +351,10 @@ object FrmProperties: TFrmProperties MaxLength = 8 TabOrder = 1 Text = 'FFFFFFFF' - OnChange = edtColorBgChange - OnKeyPress = edtColorBgKeyPress + OnChange = edtBkgndColorChange + OnKeyPress = edtBkgndColorKeyPress end - object chbUseBkgColor: TCheckBox + object chbUseBkgndColor: TCheckBox Left = 0 Top = 0 Width = 185 @@ -418,7 +416,6 @@ object FrmProperties: TFrmProperties Caption = 'Always on top' TabOrder = 0 OnClick = Changed - ExplicitWidth = 348 end end end @@ -438,7 +435,7 @@ object FrmProperties: TFrmProperties end object chbAutoHideTransparency: TCheckBox Left = 8 - Top = 183 + Top = 255 Width = 370 Height = 17 Anchors = [akLeft, akTop, akRight] @@ -472,6 +469,7 @@ object FrmProperties: TFrmProperties Width = 163 Height = 22 Align = alRight + Increment = 50 MaxValue = 60000 MinValue = 0 TabOrder = 0 @@ -546,14 +544,13 @@ object FrmProperties: TFrmProperties end object pnlHotkey: TPanel Left = 8 - Top = 108 + Top = 139 Width = 371 Height = 22 Anchors = [akLeft, akTop, akRight] BevelOuter = bvNone - ParentColor = True ShowCaption = False - TabOrder = 3 + TabOrder = 4 object lblHotKey: TLabel Left = 0 Top = 0 @@ -561,20 +558,64 @@ object FrmProperties: TFrmProperties Height = 22 Align = alLeft Caption = 'Keyboard shortcut:' + Transparent = True Layout = tlCenter ExplicitHeight = 14 end end - object pnlHotkeyEdit: TPanel + object pnlCornerGapWidth: TPanel Left = 8 - Top = 136 + Top = 111 Width = 371 Height = 22 Anchors = [akLeft, akTop, akRight] BevelOuter = bvNone - ParentColor = True ShowCaption = False - TabOrder = 4 + TabOrder = 3 + object lblCornerGapWidth: TLabel + Left = 0 + Top = 0 + Width = 104 + Height = 22 + Align = alLeft + Caption = 'Corner gaps width:' + Layout = tlCenter + ExplicitHeight = 14 + end + object Bevel2: TBevel + Left = 287 + Top = 0 + Width = 5 + Height = 22 + Align = alRight + Shape = bsSpacer + end + object nseCorner1GapWidth: TnSpinEdit + Left = 208 + Top = 0 + Width = 79 + Height = 22 + Align = alRight + Increment = 20 + MaxValue = 0 + MinValue = 0 + TabOrder = 0 + Value = 0 + OnChange = Changed + end + object nseCorner2GapWidth: TnSpinEdit + Left = 292 + Top = 0 + Width = 79 + Height = 22 + Align = alRight + Increment = 20 + MaxValue = 0 + MinValue = 0 + TabOrder = 1 + Value = 0 + OnChange = Changed + end end end object tsAdditionally: TTabSheet @@ -583,23 +624,15 @@ object FrmProperties: TFrmProperties DesignSize = ( 391 332) - object lblSectionWin7: TLabel + object lblSectionAdditional: TLabel Left = 8 - Top = 98 - Width = 82 - Height = 14 - Caption = 'For Windows 7' - Transparent = True - end - object lblSectionWin8: TLabel - Left = 8 - Top = 149 - Width = 105 + Top = 110 + Width = 53 Height = 14 - Caption = 'For Windows 8/8.1' + Caption = 'Additional' Transparent = True end - object lblJumplist: TLabel + object lblSectionJumplist: TLabel Left = 8 Top = 8 Width = 48 @@ -609,14 +642,14 @@ object FrmProperties: TFrmProperties end object pnlLightStyle: TPanel Left = 8 - Top = 110 + Top = 122 Width = 371 Height = 34 Anchors = [akLeft, akTop, akRight] BevelOuter = bvNone ParentColor = True ShowCaption = False - TabOrder = 1 + TabOrder = 2 object chbLightStyle: TCheckBox Left = 0 Top = 0 @@ -631,24 +664,24 @@ object FrmProperties: TFrmProperties end object chbAeroGlass: TCheckBox Left = 8 - Top = 185 + Top = 155 Width = 368 - Height = 17 + Height = 22 Align = alCustom Anchors = [akLeft, akTop, akRight] Caption = 'Enable AeroGlass support (installed separately)' - TabOrder = 2 + TabOrder = 3 WordWrap = True OnClick = Changed end object chbShowHints: TCheckBox - Left = 8 - Top = 216 + Left = 3 + Top = 300 Width = 367 Height = 17 Align = alCustom Caption = 'Show hints' - TabOrder = 3 + TabOrder = 5 Visible = False OnClick = Changed end @@ -659,7 +692,6 @@ object FrmProperties: TFrmProperties Height = 22 Anchors = [akLeft, akTop, akRight] BevelOuter = bvNone - Color = clRed ShowCaption = False TabOrder = 0 object lblJumplistShowMode: TLabel @@ -686,6 +718,93 @@ object FrmProperties: TFrmProperties 'Mouse right-click') end end + object pnlJumplistRecentMax: TPanel + Left = 8 + Top = 61 + Width = 371 + Height = 33 + Anchors = [akLeft, akTop, akRight] + BevelOuter = bvNone + ShowCaption = False + TabOrder = 1 + object lblJumplistRecentMax: TLabel + Left = 0 + Top = 0 + Width = 291 + Height = 33 + Align = alClient + Caption = 'Max items:' + Layout = tlCenter + WordWrap = True + ExplicitWidth = 58 + ExplicitHeight = 14 + end + object Bevel1: TBevel + Left = 291 + Top = 0 + Width = 32 + Height = 33 + Align = alRight + Shape = bsSpacer + end + object pnlDummy21: TPanel + Left = 323 + Top = 0 + Width = 48 + Height = 33 + Align = alRight + BevelOuter = bvNone + Caption = 'pnlDummy21' + ShowCaption = False + TabOrder = 0 + object nseJumplistRecentMax: TnSpinEdit + Left = 0 + Top = 0 + Width = 48 + Height = 22 + Align = alCustom + MaxValue = 99 + MinValue = 1 + TabOrder = 0 + Value = 1 + OnChange = Changed + end + end + end + object pnlLook: TPanel + Left = 8 + Top = 193 + Width = 371 + Height = 22 + Anchors = [akLeft, akTop, akRight] + BevelOuter = bvNone + ShowCaption = False + TabOrder = 4 + object lblLook: TLabel + Left = 0 + Top = 0 + Width = 26 + Height = 22 + Align = alLeft + Caption = 'Look' + Layout = tlCenter + ExplicitHeight = 14 + end + object cbbLook: TComboBox + Left = 208 + Top = 0 + Width = 163 + Height = 22 + Align = alRight + Style = csDropDownList + TabOrder = 0 + OnChange = Changed + Items.Strings = ( + 'Opaque' + 'Transparent' + 'Glass') + end + end end object tsAbout: TTabSheet Caption = 'About' @@ -718,21 +837,21 @@ object FrmProperties: TFrmProperties end object Label2: TLabel Left = 8 - Top = 115 + Top = 132 Width = 68 Height = 14 Caption = 'System info:' end object lblLocalizer: TLabel Left = 8 - Top = 76 + Top = 96 Width = 75 Height = 14 Caption = 'localizer: Asaq' end object lblSysInfo: TLabel Left = 8 - Top = 135 + Top = 152 Width = 372 Height = 70 Anchors = [akLeft, akTop, akRight] @@ -741,6 +860,13 @@ object FrmProperties: TFrmProperties PopupMenu = pmSysInfo WordWrap = True end + object lblGithub: TLabel + Left = 8 + Top = 76 + Width = 41 + Height = 14 + Caption = 'GitHub:' + end object linkEmail: TLinkLabel Left = 46 Top = 36 @@ -761,6 +887,16 @@ object FrmProperties: TFrmProperties TabStop = True OnLinkClick = linkWebLinkClick end + object linkGithub: TLinkLabel + Left = 52 + Top = 76 + Width = 77 + Height = 18 + Caption = 'linkbar github' + TabOrder = 2 + TabStop = True + OnLinkClick = linkWebLinkClick + end end end object btnApply: TButton @@ -785,8 +921,8 @@ object FrmProperties: TFrmProperties OnClick = btnCancelClick end object btnOk: TButton - Left = 130 - Top = 488 + Left = 156 + Top = 374 Width = 80 Height = 25 Anchors = [akTop, akRight] diff --git a/src/Linkbar.Settings.pas b/src/Linkbar.SettingsForm.pas similarity index 69% rename from src/Linkbar.Settings.pas rename to src/Linkbar.SettingsForm.pas index f9e292f..15836fd 100644 --- a/src/Linkbar.Settings.pas +++ b/src/Linkbar.SettingsForm.pas @@ -1,18 +1,19 @@ {*******************************************************} { Linkbar - Windows desktop toolbar } -{ Copyright (c) 2010-2017 Asaq } +{ Copyright (c) 2010-2018 Asaq } {*******************************************************} -unit Linkbar.Settings; +unit Linkbar.SettingsForm; {$i linkbar.inc} interface uses - Windows, SysUtils, Classes, Forms, StdCtrls, NewSpin, ExtCtrls, Controls, mUnit, - Vcl.ComCtrls, Winapi.Messages, Vcl.Buttons, ColorPicker, VCLTee.TeCanvas, - Vcl.Menus, HotKey; + System.SysUtils, System.Classes, + Winapi.Windows, Winapi.Messages, + Vcl.Forms, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Buttons, Vcl.Controls, Vcl.ComCtrls, Vcl.Menus, + NewSpin, mUnit, ColorPicker, HotKey; type TFrmProperties = class(TForm) @@ -23,8 +24,8 @@ TFrmProperties = class(TForm) lblIconSize: TLabel; lblMargin: TLabel; lblOrder: TLabel; - Label6: TLabel; - Label1: TLabel; + lblTextWidthIdent: TLabel; + lblTextPosition: TLabel; cbbTextLayout: TComboBox; chbAutoHide: TCheckBox; lblVer: TLabel; @@ -58,22 +59,17 @@ TFrmProperties = class(TForm) pnlDummy7: TPanel; lbl2: TLabel; tsAdditionally: TTabSheet; - lblSectionWin8: TLabel; - lblSectionWin7: TLabel; lblLocalizer: TLabel; - chbShowHints: TCheckBox; - chbLightStyle: TCheckBox; - chbAeroGlass: TCheckBox; lblSysInfo: TLabel; pnlDelay: TPanel; lblDelay: TLabel; nseAutoShowDelay: TnSpinEdit; pnlDummy10: TPanel; - btnBgColorShowHide: TSpeedButton; + btnBkgndColorEdit: TSpeedButton; pnlDummy11: TPanel; - edtColorBg: TEdit; - chbUseBkgColor: TCheckBox; - chbUseTxtColor: TCheckBox; + edtBkgndColor: TEdit; + chbUseBkgndColor: TCheckBox; + chbUseTextColor: TCheckBox; bvlSpacer2: TBevel; bvlSpacer3: TBevel; pnlDummy12: TPanel; @@ -83,16 +79,34 @@ TFrmProperties = class(TForm) pmSysInfo: TPopupMenu; imCopy: TMenuItem; pnlLightStyle: TPanel; + chbLightStyle: TCheckBox; + lblSectionAdditional: TLabel; + chbAeroGlass: TCheckBox; + chbShowHints: TCheckBox; pnlHotkey: TPanel; lblHotKey: TLabel; - pnlHotkeyEdit: TPanel; tsAutohide: TTabSheet; pnlJumplistShowMode: TPanel; lblJumplistShowMode: TLabel; cbbJumplistShowMode: TComboBox; - lblJumplist: TLabel; + lblSectionJumplist: TLabel; pnlDummy13: TPanel; chbStayOnTop: TCheckBox; + pnlJumplistRecentMax: TPanel; + lblJumplistRecentMax: TLabel; + nseJumplistRecentMax: TnSpinEdit; + pnlDummy21: TPanel; + Bevel1: TBevel; + pnlLook: TPanel; + lblLook: TLabel; + cbbLook: TComboBox; + pnlCornerGapWidth: TPanel; + lblCornerGapWidth: TLabel; + Bevel2: TBevel; + nseCorner1GapWidth: TnSpinEdit; + nseCorner2GapWidth: TnSpinEdit; + lblGithub: TLabel; + linkGithub: TLinkLabel; procedure FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); procedure linkEmailLinkClick(Sender: TObject; const Link: string; @@ -106,8 +120,8 @@ TFrmProperties = class(TForm) procedure btnCancelClick(Sender: TObject); procedure btnBgColorClick(Sender: TObject); procedure SpeedButton2Click(Sender: TObject); - procedure edtColorBgKeyPress(Sender: TObject; var Key: Char); - procedure edtColorBgChange(Sender: TObject); + procedure edtBkgndColorKeyPress(Sender: TObject; var Key: Char); + procedure edtBkgndColorChange(Sender: TObject); procedure imCopyClick(Sender: TObject); protected procedure CreateParams(var Params: TCreateParams); override; @@ -137,8 +151,8 @@ implementation {$R *.dfm} uses - Math, Graphics, Linkbar.Consts, Linkbar.OS, Linkbar.Shell, Linkbar.Themes, - Linkbar.L10n, Linkbar.Common, Vcl.Clipbrd; + Math, Graphics, Vcl.Clipbrd, + Linkbar.Consts, Linkbar.OS, Linkbar.Shell, Linkbar.Themes, Linkbar.L10n, Linkbar.Common; function TFrmProperties.ScaleDimension(const X: Integer): Integer; begin @@ -150,8 +164,8 @@ procedure TFrmProperties.SpeedButton2Click(Sender: TObject); nseIconSize.Value := StrToIntDef(TSpeedButton(Sender).Caption, nseIconSize.Value); end; +{ Prevent window resizing } procedure TFrmProperties.WMNCHitTest(var Message: TWMNCHitTest); -// Disable window resize begin inherited; PreventSizing(Message.Result); @@ -164,9 +178,8 @@ procedure TFrmProperties.CreateParams(var Params: TCreateParams); end; constructor TFrmProperties.Create(AOwner: TLinkbarWcl); -var - maxlabelwidth, ctrlwidth, y1: integer; - VO1, VO2, VO3: Integer; +var maxlabelwidth, ctrlwidth, y1: integer; + VO1, VO2, VO3: Integer; begin FCanChanged := False; @@ -176,8 +189,8 @@ constructor TFrmProperties.Create(AOwner: TLinkbarWcl); Font.Name := Screen.MenuFont.Name; // Create editors - edtHotKey := THotKeyEdit.Create(pnlHotkeyEdit); - edtHotKey.Parent := pnlHotkeyEdit; + edtHotKey := THotKeyEdit.Create(pnlHotkey); + edtHotKey.Parent := pnlHotkey; edtHotKey.Align := alClient; edtHotKey.OnChange := Changed; FColorPicker := TfrmColorPicker.Create(Self); @@ -198,10 +211,11 @@ constructor TFrmProperties.Create(AOwner: TLinkbarWcl); maxlabelwidth := Max(maxlabelwidth, lblIconSize.Width); maxlabelwidth := Max(maxlabelwidth, lblMargin.Width); maxlabelwidth := Max(maxlabelwidth, lblOrder.Width); - maxlabelwidth := Max(maxlabelwidth, Label1.Width); - maxlabelwidth := Max(maxlabelwidth, Label6.Width); + maxlabelwidth := Max(maxlabelwidth, lblTextPosition.Width); + maxlabelwidth := Max(maxlabelwidth, lblTextWidthIdent.Width); + maxlabelwidth := Max(maxlabelwidth, lblCornerGapWidth.Width); maxlabelwidth := Max(maxlabelwidth, ScaleDimension(180)); - maxlabelwidth := maxlabelwidth + ScaleDimension(10); + maxlabelwidth := maxlabelwidth + ScaleDimension(16); ctrlwidth := cbbScreenPosition.Width; GetTitleFont(lblSection1.Font); @@ -275,8 +289,6 @@ constructor TFrmProperties.Create(AOwner: TLinkbarWcl); // Page AutoHide // --------------------------------------------------------------------------- - //lblSection2.Top := pnlDummy12.BoundsRect.Bottom + VO1*2; - pnlDummy7.Top := lblSection2.BoundsRect.Bottom + VO1; pnlDummy7.Height := pnlDummy1.Height; @@ -286,26 +298,44 @@ constructor TFrmProperties.Create(AOwner: TLinkbarWcl); pnlDelay.Top := pnlDummy8.BoundsRect.Bottom + VO1; pnlDelay.Height := pnlDummy1.Height; - pnlHotkey.Top := pnlDelay.BoundsRect.Bottom + VO1; - pnlHotkey.Height := pnlDummy1.Height; + pnlCornerGapWidth.Top := pnlDelay.BoundsRect.Bottom + VO1; + pnlCornerGapWidth.Height := pnlDummy1.Height; + nseCorner1GapWidth.MinValue := CORNER_GAP_WIDTH_MIN; + nseCorner1GapWidth.MaxValue := CORNER_GAP_WIDTH_MAX; + nseCorner2GapWidth.MinValue := CORNER_GAP_WIDTH_MIN; + nseCorner2GapWidth.MaxValue := CORNER_GAP_WIDTH_MAX; - pnlHotkeyEdit.Top := pnlHotkey.BoundsRect.Bottom + VO1; - pnlHotkeyEdit.Height := pnlDummy1.Height; + pnlHotkey.Top := pnlCornerGapWidth.BoundsRect.Bottom + VO1; + pnlHotkey.Height := pnlDummy1.Height; - chbAutoHideTransparency.Top := pnlHotkeyEdit.BoundsRect.Bottom + VO3; + chbAutoHideTransparency.Top := pnlHotkey.BoundsRect.Bottom + VO3; // --------------------------------------------------------------------------- // Page Additionally // --------------------------------------------------------------------------- - lblJumplist.Font := lblSection1.Font; - pnlJumplistShowMode.Top := lblJumplist.BoundsRect.Bottom + VO1; + lblSectionJumplist.Font := lblSection1.Font; + pnlJumplistShowMode.Top := lblSectionJumplist.BoundsRect.Bottom + VO1; pnlJumplistShowMode.Height := pnlDummy1.Height; - lblSectionWin7.Font := lblSection1.Font; - lblSectionWin7.Top := pnlJumplistShowMode.BoundsRect.Bottom + VO1*2; - pnlLightStyle.Top := lblSectionWin7.BoundsRect.Bottom + VO1; - lblSectionWin8.Font := lblSection1.Font; - lblSectionWin8.Top := pnlLightStyle.BoundsRect.Bottom + VO1*2; - chbAeroGlass.Top := lblSectionWin8.BoundsRect.Bottom + VO1; + pnlJumplistRecentMax.Top := pnlJumplistShowMode.BoundsRect.Bottom + VO1; + pnlJumplistRecentMax.Height := (pnlDummy1.Height * 3) div 2; + nseJumplistRecentMax.Top := (pnlDummy21.Height - nseJumplistRecentMax.Height) div 2; + nseJumplistRecentMax.MinValue := JUMPLIST_RECENTMAX_MIN; + nseJumplistRecentMax.MaxValue := JUMPLIST_RECENTMAX_MAX; + + { OS-dependent options } + lblSectionAdditional.Font := lblSection1.Font; + lblSectionAdditional.Top := pnlJumplistRecentMax.BoundsRect.Bottom + VO1*2; + // Windows 7 + pnlLightStyle.Visible := IsWindows7; + pnlLightStyle.Top := lblSectionAdditional.BoundsRect.Bottom + VO1; + pnlLightStyle.Height := (pnlDummy1.Height * 3) div 2; + // Windows 8/8.1 + chbAeroGlass.Visible := IsWindows8And8Dot1; + chbAeroGlass.Top := lblSectionAdditional.BoundsRect.Bottom + VO1; + // Windows 10s + pnlLook.Visible := IsWindows10; + pnlLook.Top := lblSectionAdditional.BoundsRect.Bottom + VO1; + pnlLook.Height := pnlDummy1.Height; pgc1.Height := tsView.Top + pnlDummy13.BoundsRect.Bottom + VO2 + tsView.Left; @@ -321,6 +351,7 @@ constructor TFrmProperties.Create(AOwner: TLinkbarWcl); linkWeb.Left := lblWeb.BoundsRect.Right + ScaleDimension(8); linkEmail.Left := lblEmail.BoundsRect.Right + ScaleDimension(8); + linkGithub.Left := lblGithub.BoundsRect.Right + ScaleDimension(8); // Set values cbbScreenPosition.ItemIndex := Ord(FLinkbar.ScreenAlign); @@ -331,29 +362,26 @@ constructor TFrmProperties.Create(AOwner: TLinkbarWcl); cbbAutoShowMode.ItemIndex := Ord(FLinkbar.AutoShowMode); nseAutoShowDelay.Value := FLinkbar.AutoShowDelay; chbLightStyle.Checked := FLinkbar.IsLightStyle; - chbUseBkgColor.Checked := FLinkbar.UseBkgColor; - chbUseTxtColor.Checked := FLinkbar.UseTxtColor; + chbUseBkgndColor.Checked := FLinkbar.UseBkgndColor; + chbUseTextColor.Checked := FLinkbar.UseTextColor; cbbJumplistShowMode.ItemIndex := Ord(FLinkbar.JumplistShowMode); + nseJumplistRecentMax.Value := FLinkbar.JumplistRecentMax; chbStayOnTop.Checked := FLinkbar.StayOnTop; + cbbLook.ItemIndex := Ord(FLinkbar.LookMode); + nseCorner1GapWidth.Value := FLinkbar.Corner1GapWidth; + nseCorner2GapWidth.Value := FLinkbar.Corner2GapWidth; edtHotKey.HotkeyInfo := FLinkbar.HotkeyInfo; - BackgroundColor := FLinkbar.BkgColor; - TextColor := FLinkbar.TxtColor; + BackgroundColor := FLinkbar.BackgroundColor; + TextColor := FLinkbar.TextColor; chbAeroGlass.Checked := FLinkbar.EnableAeroGlass; - { Disable OS-dependent options } - // Windows 7 - lblSectionWin7.Enabled := IsWindows7; - chbLightStyle.Enabled := IsWindows7; - // Windows 8, 8.1 - lblSectionWin8.Enabled := IsWindows8And8Dot1; - chbAeroGlass.Enabled := IsWindows8And8Dot1; - - lblVer.Caption := Format(lblVer.Caption, [VersionToString]); - linkWeb.Caption := '' + URL_WEB + ''; - linkEmail.Caption := '' + URL_EMAIL + ''; + lblVer.Caption := Format(lblVer.Caption, [VersionToString]); + linkWeb.Caption := '' + URL_WEB + ''; + linkEmail.Caption := '' + URL_EMAIL + ''; + linkGithub.Caption := '' + URL_GITHUB + ''; lblSysInfo.Caption := TOSVersion.ToString + ' ' + Languages.LocaleName[Languages.IndexOf(Languages.UserDefaultLocale)] @@ -378,14 +406,14 @@ procedure TFrmProperties.L10n; L10nControl(lblScreenEdge, 'Properties.Position'); L10nControl(cbbScreenPosition, ['Properties.Left', 'Properties.Top', 'Properties.Right', 'Properties.Bottom']); L10nControl(lblIconSize, 'Properties.IconSize'); - L10nControl(chbUseBkgColor, 'Properties.BgColor'); + L10nControl(chbUseBkgndColor, 'Properties.BgColor'); L10nControl(lblMargin, 'Properties.Margins'); L10nControl(lblOrder, 'Properties.Order'); L10nControl(cbbItemOrder, ['Properties.LtR', 'Properties.UtD']); - L10nControl(Label1, 'Properties.TextPos'); + L10nControl(lblTextPosition, 'Properties.TextPos'); L10nControl(cbbTextLayout, ['Properties.Without' , 'Properties.Left', 'Properties.Top', 'Properties.Right', 'Properties.Bottom']); - L10nControl(Label6, 'Properties.TextWidth'); - L10nControl(chbUseTxtColor, 'Properties.TextColor'); + L10nControl(lblTextWidthIdent, 'Properties.TextWidth'); + L10nControl(chbUseTextColor, 'Properties.TextColor'); L10nControl(lblGlowSize, 'Properties.GlowSize'); L10nControl(chbStayOnTop, 'Properties.AlwaysOnTop'); // Autohide @@ -395,16 +423,21 @@ procedure TFrmProperties.L10n; L10nControl(lblShow, 'Properties.Show'); L10nControl(cbbAutoShowMode, ['Properties.MouseHover', 'Properties.MouseLC', 'Properties.MouseRC']); L10nControl(lblDelay, 'Properties.Delay'); + L10nControl(lblCornerGapWidth, 'Properties.CornerTransWidth'); L10nControl(lblHotKey, 'Properties.HotKey'); - L10nControl(chbAutoHideTransparency, 'Properties.Transparent'); + L10nControl(chbAutoHideTransparency, 'Properties.AutoHideTransparency'); // Additional - L10nControl(lblJumplist, 'Properties.Jumplists'); + L10nControl(lblSectionJumplist, 'Properties.Jumplists'); L10nControl(lblJumplistShowMode, 'Properties.Show'); L10nControl(cbbJumplistShowMode, ['Properties.No', 'Properties.MouseRC']); - L10nControl(lblSectionWin7, 'Properties.ForW7'); + L10nControl(lblJumplistRecentMax, 'Properties.JumplistRecentMaxItems'); + L10nControl(lblSectionAdditional, 'Properties.Additional'); L10nControl(chbLightStyle, 'Properties.Style1'); - L10nControl(lblSectionWin8, 'Properties.ForW8'); + //L10nControl(lblSectionWin8, 'Properties.ForW8'); L10nControl(chbAeroGlass, 'Properties.AeroGlass'); + //L10nControl(lblSectionWin10, 'Properties.ForW10'); + L10nControl(lblLook, 'Properties.Look'); + L10nControl(cbbLook, ['Properties.Opaque', 'Properties.Transparent', 'Properties.Glass']); // About L10nControl(lblVer, 'Properties.Version'); L10nControl(lblLocalizer, 'Properties.Localizer'); @@ -424,7 +457,7 @@ procedure TFrmProperties.FormDestroy(Sender: TObject); begin FrmProperties := nil; FColorPicker.Free; - FLinkbar.PropertiesFormDestroyed; + PostMessage(FLinkbar.Handle, LM_DOAUTOHIDE, 0, 0); end; procedure TFrmProperties.FormMouseWheel(Sender: TObject; Shift: TShiftState; @@ -433,13 +466,10 @@ procedure TFrmProperties.FormMouseWheel(Sender: TObject; Shift: TShiftState; begin if Assigned(ActiveControl) and (ActiveControl.ClassType = TnSpinedit) - then spin := TnSpinedit(ActiveControl) - else spin := nil; - - if Assigned(spin) then - begin - if wheeldelta > 0 then spin.Value := spin.Value + spin.Increment; - if wheeldelta < 0 then spin.Value := spin.Value - spin.Increment; + then begin + spin := TnSpinedit(ActiveControl); + spin.Value := spin.Value + Sign(WheelDelta) * spin.Increment; + Handled := True; end; end; @@ -466,6 +496,7 @@ procedure TFrmProperties.linkWebLinkClick(Sender: TObject; const Link: string; end; procedure TFrmProperties.Changed(Sender: TObject); +var ah: Boolean; begin if (not FCanChanged) then Exit; @@ -473,32 +504,30 @@ procedure TFrmProperties.Changed(Sender: TObject); btnApply.Enabled := True; // Color additional options - edtColorBg.Enabled := chbUseBkgColor.Checked; - btnBgColorShowHide.Enabled := chbUseBkgColor.Checked; - clbTextColor.Enabled := chbUseTxtColor.Checked; + edtBkgndColor.Enabled := chbUseBkgndColor.Checked; + btnBkgndColorEdit.Enabled := chbUseBkgndColor.Checked; + clbTextColor.Enabled := chbUseTextColor.Checked; // Autohide additional options - cbbAutoShowMode.Enabled := chbAutoHide.Checked; - chbAutoHideTransparency.Enabled := chbAutoHide.Checked; - lblShow.Enabled := chbAutoHide.Checked; + ah := chbAutoHide.Checked; + cbbAutoShowMode.Enabled := ah; + chbAutoHideTransparency.Enabled := ah; + lblShow.Enabled := ah; // Mouse-Hover Delay - lblDelay.Enabled := chbAutoHide.Checked; + lblDelay.Enabled := ah; nseAutoShowDelay.Enabled := lblDelay.Enabled; // Hotkey - lblHotKey.Enabled := chbAutoHide.Checked; + lblHotKey.Enabled := ah; edtHotKey.Enabled := lblHotKey.Enabled; + lblCornerGapWidth.Enabled := ah; + nseCorner1GapWidth.Enabled := ah; + nseCorner2GapWidth.Enabled := ah; + // Text additional options - Label6.Enabled := cbbTextLayout.ItemIndex > 0; + lblTextWidthIdent.Enabled := cbbTextLayout.ItemIndex > 0; nseTextWidth.Enabled := cbbTextLayout.ItemIndex > 0; nseTextOffset.Enabled := cbbTextLayout.ItemIndex > 0; - - // Check Hotkey - if ((Sender = edtHotKey) and (FLinkbar.HotkeyInfo <> edtHotKey.HotkeyInfo)) - or - ((Sender = chbAutoHide) and chbAutoHide.Checked) - then CheckHotkey(Handle, edtHotKey.HotkeyInfo); - end; procedure TFrmProperties.btnCancelClick(Sender: TObject); @@ -525,10 +554,10 @@ procedure TFrmProperties.DialogButtonClick(Sender: TObject); FLinkbar.AutoShowDelay := nseAutoShowDelay.Value; - FLinkbar.UseBkgColor := chbUseBkgColor.Checked; - FLinkbar.BkgColor := FBackgroundColor; - FLinkbar.UseTxtColor := chbUseTxtColor.Checked; - FLinkbar.TxtColor := RGB(GetBValue(FTextColor), GetGValue(FTextColor), GetRValue(FTextColor)); + FLinkbar.BackgroundColor := FBackgroundColor; + FLinkbar.TextColor := FTextColor; + FLinkbar.UseBkgndColor := chbUseBkgndColor.Checked; + FLinkbar.UseTextColor := chbUseTextColor.Checked; FLinkbar.GlowSize := nseGlowSize.Value; @@ -545,7 +574,11 @@ procedure TFrmProperties.DialogButtonClick(Sender: TObject); ); FLinkbar.AutoHideTransparency := chbAutoHideTransparency.Checked; FLinkbar.JumplistShowMode := TJumplistShowMode(cbbJumplistShowMode.ItemIndex); + FLinkbar.JumplistRecentMax := nseJumplistRecentMax.Value; FLinkbar.StayOnTop := chbStayOnTop.Checked; + FLinkbar.LookMode := TLookMode(cbbLook.ItemIndex); + FLinkbar.Corner1GapWidth := nseCorner1GapWidth.Value; + FLinkbar.Corner2GapWidth := nseCorner2GapWidth.Value; FLinkbar.UpdateItemSizes; @@ -557,29 +590,31 @@ procedure TFrmProperties.DialogButtonClick(Sender: TObject); FLinkbar.HotkeyInfo := edtHotKey.HotkeyInfo; + FLinkbar.SaveSettings; + if (Sender = btnOk) then begin Close; Exit; end; - btnApply.Enabled := False; - ActiveControl := btnOk; chbAutoHide.Checked := FLinkbar.AutoHide; + btnApply.Enabled := False; + ActiveControl := btnOk; end; -procedure TFrmProperties.edtColorBgChange(Sender: TObject); +procedure TFrmProperties.edtBkgndColorChange(Sender: TObject); begin - if (Sender = edtColorBg) - then FBackgroundColor := StrToIntDef(HexDisplayPrefix + edtColorBg.Text, 0); - + if (Sender = edtBkgndColor) + then FBackgroundColor := Cardinal(StrToIntDef(HexDisplayPrefix + edtBkgndColor.Text, 0)); + if (Sender = clbTextColor) - then FTextColor := clbTextColor.Selected; - + then FTextColor := Cardinal(clbTextColor.Selected); + Changed(Sender); end; -procedure TFrmProperties.edtColorBgKeyPress(Sender: TObject; var Key: Char); +procedure TFrmProperties.edtBkgndColorKeyPress(Sender: TObject; var Key: Char); begin if (Key = #8) then Exit; @@ -590,7 +625,7 @@ procedure TFrmProperties.edtColorBgKeyPress(Sender: TObject; var Key: Char); procedure TFrmProperties.btnBgColorClick(Sender: TObject); begin - if (Sender = btnBgColorShowHide) + if (Sender = btnBkgndColorEdit) then begin FColorPicker.Color := BackgroundColor; if (FColorPicker.ShowModal = mrOk) @@ -601,13 +636,13 @@ procedure TFrmProperties.btnBgColorClick(Sender: TObject); procedure TFrmProperties.SetBackgroundColor(AValue: Cardinal); begin FBackgroundColor := AValue; - edtColorBg.Text := IntToHex(FBackgroundColor, 8); + edtBkgndColor.Text := IntToHex(FBackgroundColor, 8); end; procedure TFrmProperties.SetTextColor(AValue: Cardinal); begin FTextColor := AValue and $ffffff; - clbTextColor.Selected := RGB(GetBValue(FTextColor), GetGValue(FTextColor), GetRValue(FTextColor)); + clbTextColor.Selected := FTextColor; end; end. diff --git a/src/Linkbar.Shell.pas b/src/Linkbar.Shell.pas index 9f129d4..90a36cc 100644 --- a/src/Linkbar.Shell.pas +++ b/src/Linkbar.Shell.pas @@ -1,6 +1,6 @@ {*******************************************************} { Linkbar - Windows desktop toolbar } -{ Copyright (c) 2010-2017 Asaq } +{ Copyright (c) 2010-2018 Asaq } {*******************************************************} unit Linkbar.Shell; @@ -17,7 +17,7 @@ interface function GetUIObjectOfPidl(AWnd: HWND; const APidl: PItemIDList; const ARiid: TIID; out ppv): HRESULT; - + function GetUIObjectOfFile(AWnd: HWND; const AFileName: String; const ARiid: TIID; out ppv): HRESULT; @@ -43,11 +43,11 @@ interface function SendShellEmail(AWnd: HWND; ARecipientEmail, ASubject, ABody: string): boolean; function RegisterBitBucketNotify(AWnd: HWND; AMessage: Cardinal): Cardinal; - procedure DeregisterBitBucketNotify(ANotify: Cardinal); + procedure UnregisterBitBucketNotify(ANotify: Cardinal); implementation -uses StrUtils, Graphics, Linkbar.OS, Linkbar.Consts, Linkbar.L10n; +uses StrUtils, Graphics, Linkbar.L10n; type TSHExtractIconsW = function(pszFileName: LPCWSTR; nIconIndex: Integer; cxIcon, @@ -99,7 +99,7 @@ procedure SHRenameOp(AWnd: HWND; AFromName, AToName: string); lpFileOp.wFunc := FO_RENAME; lpFileOp.pFrom := PChar(AFromName + #0); lpFileOp.pTo := PChar(AToName + #0); - lpFileOp.fFlags := FOF_RENAMEONCOLLISION or FOF_NO_UI or FOF_ALLOWUNDO; + lpFileOp.fFlags := FOF_ALLOWUNDO; SHFileOperation(lpFileOp); end; @@ -349,7 +349,7 @@ function RegisterBitBucketNotify(AWnd: HWND; AMessage: Cardinal): Cardinal; else Result := 0; end; -procedure DeregisterBitBucketNotify(ANotify: Cardinal); +procedure UnregisterBitBucketNotify(ANotify: Cardinal); begin SHChangeNotifyDeregister(ANotify); end; diff --git a/src/Linkbar.Taskbar.pas b/src/Linkbar.Taskbar.pas index 939738f..93c2f42 100644 --- a/src/Linkbar.Taskbar.pas +++ b/src/Linkbar.Taskbar.pas @@ -1,6 +1,6 @@ {*******************************************************} { Linkbar - Windows desktop toolbar } -{ Copyright (c) 2010-2017 Asaq } +{ Copyright (c) 2010-2018 Asaq } {*******************************************************} unit Linkbar.Taskbar; diff --git a/src/Linkbar.Themes.pas b/src/Linkbar.Themes.pas index 6e4e255..ea4049c 100644 --- a/src/Linkbar.Themes.pas +++ b/src/Linkbar.Themes.pas @@ -1,6 +1,6 @@ {*******************************************************} { Linkbar - Windows desktop toolbar } -{ Copyright (c) 2010-2017 Asaq } +{ Copyright (c) 2010-2018 Asaq } {*******************************************************} unit Linkbar.Themes; @@ -10,40 +10,55 @@ interface uses - GdiPlus, GdiPlusHelpers, - Windows, SysUtils, Classes, Graphics, Controls, Forms, - Winapi.UxTheme, Vcl.Themes, Winapi.Dwmapi, - Linkbar.Consts; + GdiPlus, + System.Classes, System.Math, Vcl.Graphics, Vcl.Themes, + Winapi.Windows, Winapi.UxTheme, Winapi.Dwmapi, + Linkbar.Consts, Linkbar.Graphics; type PDrawBackgroundParams = ^TDrawBackgroundParams; TDrawBackgroundParams = record - Bitmap: TBitmap; + Bitmap: THBitmap; Align: TScreenAlign; ClipRect: TRect; IsLight: Boolean; BgColor: Cardinal; end; - procedure ThemeDrawButton(const ABitmap: TBitmap; const ARect: TRect; + procedure ThemeDrawButton(const ABitmap: THBitmap; const ARect: TRect; APressed: Boolean); - procedure ThemeDrawHover(const ABitmap: TBitmap; const AAlign: TScreenAlign; + procedure ThemeDrawHover(const ABitmap: THBitmap; const AAlign: TScreenAlign; const ARect: TRect); procedure ThemeDrawBackground(PParams: PDrawBackgroundParams); - procedure ThemeDrawGlow(const ABitmap: TBitmap; const ARect: TRect; const AColor: Cardinal); - procedure ThemeUpdateBlur(const AWnd: HWND; AEnabled: Boolean); + procedure ThemeUpdateBlur(const AWnd: HWND; const AEnabled: Boolean); procedure ThemeInitData(const AWnd: HWND; AIsLight: Boolean); procedure ThemeCloseData; - procedure ThemeSetWindowAttribute(AWnd: HWND); + procedure ThemeGetTaskbarColor(out AColor: Cardinal; const ALook: TLookMode); + procedure ThemeSetWindowAttribute78(const AWnd: HWND); + procedure ThemeSetWindowAttribute10(const AWnd: HWND; const ALookMode: TLookMode; const AColor: Cardinal); + procedure ThemeSetWindowAccentPolicy10(const AWnd: HWND; const ALookMode: TLookMode; const AColor: Cardinal); procedure GetTitleFont(AFont: TFont); var - ExpAeroGlassEnabled: Boolean = False; + ExpAeroGlassEnabled: Boolean; + ThemeButtonNormalTextColor, ThemeButtonSelectedTextColor, ThemeButtonPressedTextColor: TColor; implementation uses - Math, Linkbar.OS, Linkbar.Undoc; + Linkbar.OS, Linkbar.Undoc; + +const + LB_TBP_BUTTON_WV = 1; + LB_TBP_BUTTON_W7 = 5; + + LB_TBS_BUTTON_NORMAL_WV = 0; + LB_TBS_BUTTON_PRESSED_WV = 3; + LB_TBS_BUTTON_SELECTED_WV = 3; + + LB_TBS_BUTTON_NORMAL_W7 = 3; + LB_TBS_BUTTON_PRESSED_W7 = 5; + LB_TBS_BUTTON_SELECTED_W7 = 9; var hBackground: HTHEME = 0; @@ -55,122 +70,199 @@ implementation // DWM //////////////////////////////////////////////////////////////////////////////// -procedure ThemeSetWindowAttribute(AWnd: HWND); -var - bAttr, bPolicy1, bPolicy2: BOOL; - iAttr: Integer; - wcad: TWcaData; - AccentPolicy: TWcaAccentPolicy; +{ Sets Color Alpha to 1 if it is 0 } +function FixAlpha(const AColor: Cardinal): Cardinal; inline; begin - if not IsWindow(AWnd) - then Exit; + Result := (Max(1, AColor shr 24) shl 24) or (AColor and $00FFFFFF); +end; - // Exclude from Aero Peek - bAttr := True; - DwmSetWindowAttribute(AWnd, DWMWA_EXCLUDED_FROM_PEEK, @bAttr, SizeOf(bAttr)); - // Exclude from Flip3D and display it above the Flip3D rendering - iAttr := DWMFLIP3D_EXCLUDEBELOW; - DwmSetWindowAttribute(AWnd, DWMWA_FLIP3D_POLICY, @iAttr, SizeOf(iAttr)); +{ Swap Red and Blue channel } +function SwapRedBlue(const AColor: Cardinal): Cardinal; inline; +begin + Result := (AColor and $FF00FF00) or ((AColor and 255) shl 16) or ((AColor shr 16) and 255); +end; - if IsWindowsVista or IsWindows7 - or (IsWindows8And8Dot1 and ExpAeroGlassEnabled) +function GetTaskbarColor8(): Cardinal; +var cp: TColorizationParams; + r, g, b, gray, alpha: Cardinal; +begin + Result := 0; + if Assigned(UDwmGetColorizationParametersProc) + then begin + UDwmGetColorizationParametersProc(cp); + r := (cp.Color shr 16) and 255; + g := (cp.Color shr 8) and 255; + b := (cp.Color) and 255; + gray := 217 * (100 - cp.ColorBalance) + 50; + r := (r * cp.ColorBalance + gray) div 100; + g := (g * cp.ColorBalance + gray) div 100; + b := (b * cp.ColorBalance + gray) div 100; + alpha := (cp.Color shr 24) and 255; + alpha := alpha * 65 div 100; + Result := (r shl 16) or (g shl 8) or b or (alpha shl 24); + end; +end; + +function GetTaskbarColor10(const ALook: TLookMode): Cardinal; +var atype, aset: Integer; + transparent: Boolean; +begin + Result := 0; + transparent := ALook <> lmOpaque; + if Assigned(UGetImmersiveUserColorSetPreferenceProc) then begin - // http://a-whiter.livejournal.com/1385.html - // http://a-whiter.livejournal.com/2495.html - // Set non-client rendering policy - bPolicy1 := True; - DwmSetWindowAttribute(AWnd, DWMWA_NCRENDERING_POLICY, @bPolicy1, SizeOf(bPolicy1)); - // Set client rendering policy - if Assigned(UDwmSetWindowCompositionAttributeProc) + if (transparent) + then atype := UGetImmersiveColorTypeFromNameProc('ImmersiveSystemAccentDark3') + else atype := UGetImmersiveColorTypeFromNameProc('ImmersiveSystemAccentDark2'); + if (atype >= 0) then begin - if IsWindows8OrAbove - then wcad.dwAttribute := U_WCA_CLIENTRENDERING_POLICY_WIN8 - else wcad.dwAttribute := U_WCA_CLIENTRENDERING_POLICY_WIN7; - bPolicy2 := True; - wcad.pvAttribute := @bPolicy2; - wcad.cbAttribute := SizeOf(bPolicy2); - UDwmSetWindowCompositionAttributeProc(AWnd, @wcad); + aset := UGetImmersiveUserColorSetPreferenceProc(False, False); + Result := UGetImmersiveColorFromColorSetExProc(aset, atype, True, 0); + Result := SwapRedBlue(Result); + if (transparent) + then Result := (Result and $FFFFFF) or (Cardinal(217) shl 24); // Default taskbar opacity 85% end; end; +end; - if IsWindows10 +procedure ThemeGetTaskbarColor(out AColor: Cardinal; const ALook: TLookMode); +begin + if IsWindows7 then AColor := 0 + else if IsWindows8dot1 then AColor := GetTaskbarColor8() + else if IsWindows10 then AColor := GetTaskbarColor10(ALook); +end; + +procedure ThemeSetWindowAccentPolicy10(const AWnd: HWND; const ALookMode: TLookMode;{ const AUseColor: Boolean;} const AColor: Cardinal); +const WCA_ACCENT_STATE: array[TLookMode] of Integer = (U_WCA_ACCENT_STATE_ENABLE_GRADIENT, + U_WCA_ACCENT_STATE_ENABLE_TRANSPARENTGRADIENT, + U_WCA_ACCENT_STATE_ENABLE_BLURBEHIND, + U_WCA_ACCENT_STATE_DISABLED); +var wcad: TWcaData; + AccentPolicy: TWcaAccentPolicy; +begin + // Set window accent policy + // https://withinrafael.com/2015/07/08/adding-the-aero-glass-blur-to-your-windows-10-apps/ + if Assigned(UDwmSetWindowCompositionAttributeProc) then begin - // Set window accent policy - // https://withinrafael.com/2015/07/08/adding-the-aero-glass-blur-to-your-windows-10-apps/ - if Assigned(UDwmSetWindowCompositionAttributeProc) + wcad.dwAttribute := U_WCA_ACCENT_POLICY; + wcad.cbAttribute := SizeOf(AccentPolicy); + wcad.pvAttribute := @AccentPolicy; + + if (ALookMode = lmOpaque) then begin - AccentPolicy.AccentState := U_WCA_ACCENT_STATE_ENABLE_BLURBEHIND; - AccentPolicy.AccentFlags := U_WCA_ACCENT_FLAG_DEFAULT; - AccentPolicy.GradientColor := 0; - AccentPolicy.AnimationId := 0; - wcad.dwAttribute := U_WCA_ACCENT_POLICY; - wcad.cbAttribute := SizeOf(AccentPolicy); - wcad.pvAttribute := @AccentPolicy; + // When AccentState changed from Transparent to Opaque then under the window + // there is a "transparent ghost". It does not change its size with the Linkbar window + // Taskbar have similar bug. Reported this to the MS Feedback Hud + FillChar(AccentPolicy, SizeOf(AccentPolicy), 0); + AccentPolicy.AccentState := U_WCA_ACCENT_STATE_DISABLED; UDwmSetWindowCompositionAttributeProc(AWnd, @wcad); end; + + AccentPolicy.AccentState := WCA_ACCENT_STATE[ALookMode]; + AccentPolicy.AccentFlags := U_WCA_ACCENT_FLAG_DRAW_ALL; + AccentPolicy.GradientColor := SwapRedBlue(AColor); + AccentPolicy.AnimationId := 0; + UDwmSetWindowCompositionAttributeProc(AWnd, @wcad); + end; +end; + +procedure ThemeSetWindowAttribute10(const AWnd: HWND; const ALookMode: TLookMode; {const AUseColor: Boolean;} const AColor: Cardinal); +var bAttr: Boolean; + iAttr: Integer; +begin + // Exclude from Aero Peek + bAttr := True; + DwmSetWindowAttribute(AWnd, DWMWA_EXCLUDED_FROM_PEEK, @bAttr, SizeOf(bAttr)); + // Exclude from Flip3D and display it above the Flip3D rendering + iAttr := DWMFLIP3D_EXCLUDEABOVE; + DwmSetWindowAttribute(AWnd, DWMWA_FLIP3D_POLICY, @iAttr, SizeOf(iAttr)); + // Set accent policy + ThemeSetWindowAccentPolicy10(AWnd, ALookMode, AColor); +end; + +procedure ThemeSetWindowAttribute78(const AWnd: HWND); +var bAttr, bPolicy1, bPolicy2: BOOL; + iAttr: Integer; + wcad: TWcaData; +begin + // Exclude from Aero Peek + bAttr := True; + DwmSetWindowAttribute(AWnd, DWMWA_EXCLUDED_FROM_PEEK, @bAttr, SizeOf(bAttr)); + + // Exclude from Flip3D and display it below the Flip3D rendering + iAttr := DWMFLIP3D_EXCLUDEBELOW; + DwmSetWindowAttribute(AWnd, DWMWA_FLIP3D_POLICY, @iAttr, SizeOf(iAttr)); + + if (IsWindows8And8Dot1 and not ExpAeroGlassEnabled) + then Exit; + + // http://a-whiter.livejournal.com/1385.html + // http://a-whiter.livejournal.com/2495.html + // Set non-client rendering policy + bPolicy1 := True; + DwmSetWindowAttribute(AWnd, DWMWA_NCRENDERING_POLICY, @bPolicy1, SizeOf(bPolicy1)); + // Set client rendering policy + if Assigned(UDwmSetWindowCompositionAttributeProc) + then begin + if IsWindows8OrAbove + then wcad.dwAttribute := U_WCA_CLIENTRENDERING_POLICY_WIN8 + else wcad.dwAttribute := U_WCA_CLIENTRENDERING_POLICY_WIN7; + bPolicy2 := True; + wcad.pvAttribute := @bPolicy2; + wcad.cbAttribute := SizeOf(bPolicy2); + UDwmSetWindowCompositionAttributeProc(AWnd, @wcad); end; end; -procedure ThemeUpdateBlur(const AWnd: HWND; AEnabled: Boolean); +procedure ThemeUpdateBlur(const AWnd: HWND; const AEnabled: Boolean); var BlurBehind: TDwmBlurBehind; r: TRect; begin - if (not IsWindowsVistaOrAbove or IsWindows10OrAbove) then Exit; - - if (IsWindows8And8Dot1 and not ExpAeroGlassEnabled) - then AEnabled := False; + if IsWindows10OrAbove + or (not DwmCompositionEnabled) + then Exit; - if DwmCompositionEnabled + FillChar(BlurBehind, SizeOf(BlurBehind), 0); + BlurBehind.dwFlags := DWM_BB_ENABLE; + BlurBehind.fEnable := AEnabled; + if AEnabled then begin - FillChar(BlurBehind, SizeOf(BlurBehind), 0); - BlurBehind.dwFlags := DWM_BB_ENABLE; - BlurBehind.fEnable := AEnabled; - if AEnabled + if GetWindowRect(AWnd, r) then begin - if GetWindowRect(AWnd, r) - then begin - BlurBehind.dwFlags := BlurBehind.dwFlags or DWM_BB_BLURREGION; - BlurBehind.hRgnBlur := CreateRectRgnIndirect( Rect(0, 0, r.width, r.height) ); - end; - if (IsWindowsVista) - then begin - BlurBehind.dwFlags := BlurBehind.dwFlags or DWM_BB_TRANSITIONONMAXIMIZED; - BlurBehind.fTransitionOnMaximized := True; - end; + BlurBehind.dwFlags := BlurBehind.dwFlags or DWM_BB_BLURREGION; + BlurBehind.hRgnBlur := CreateRectRgnIndirect( Rect(0, 0, r.width, r.height) ); + end; + if (IsWindowsVista) + then begin + BlurBehind.dwFlags := BlurBehind.dwFlags or DWM_BB_TRANSITIONONMAXIMIZED; + BlurBehind.fTransitionOnMaximized := True; end; - DwmEnableBlurBehindWindow(AWnd, BlurBehind); - if (BlurBehind.hRgnBlur <> 0) - then DeleteObject(BlurBehind.hRgnBlur); end; + DwmEnableBlurBehindWindow(AWnd, BlurBehind); + if (BlurBehind.hRgnBlur <> 0) + then DeleteObject(BlurBehind.hRgnBlur); end; //////////////////////////////////////////////////////////////////////////////// // Draw Themes Button //////////////////////////////////////////////////////////////////////////////// -procedure WinXP_DrawThemedButton(const ABitmap: TBitmap; const ARect: TRect; +procedure WinXP_DrawThemedButton(const ABitmap: THBitmap; const ARect: TRect; APressed: Boolean); var DrawFlags: Cardinal; - drawer: IGPGraphics; - bmp: TBitmap; begin - bmp := TBitmap.Create; - bmp.PixelFormat := pf24bit; - bmp.SetSize(ARect.Width, ARect.Height); { Draw as button } DrawFlags := DFCS_BUTTONPUSH; if APressed then DrawFlags := DrawFlags or DFCS_PUSHED else DrawFlags := DrawFlags or DFCS_HOT; - DrawFrameControl(bmp.Canvas.Handle, Rect(0, 0, ARect.Width, ARect.Height), DFC_BUTTON, DrawFlags); {} - drawer := ABitmap.ToGPGraphics; - drawer.DrawImage(bmp.ToGPBitmap, ARect.Left, ARect.Top); - bmp.Free; + DrawFrameControl(ABitmap.Dc, ARect, DFC_BUTTON, DrawFlags); {} + ABitmap.OpaqueRect(ARect); end; -procedure Win7_DrawThemedButton(const ABitmap: TBitmap; const ARect: TRect; +procedure Win7_DrawThemedButton(const ABitmap: THBitmap; const ARect: TRect; APressed: Boolean); var PaintRect: TRect; @@ -179,22 +271,22 @@ procedure Win7_DrawThemedButton(const ABitmap: TBitmap; const ARect: TRect; begin if IsWindowsVista then begin - Part := 1; + Part := LB_TBP_BUTTON_WV; if APressed - then State := 3 - else State := 0; + then State := LB_TBS_BUTTON_PRESSED_WV + else State := LB_TBS_BUTTON_NORMAL_WV; end else begin - Part := 5; + Part := LB_TBP_BUTTON_W7; if APressed - then State := 5 - else State := 3; + then State := LB_TBS_BUTTON_PRESSED_W7 + else State := LB_TBS_BUTTON_NORMAL_W7; end; PaintRect := ARect; - DrawThemeBackground(hButton, ABitmap.Canvas.Handle, Part, State, PaintRect, @PaintRect); + DrawThemeBackground(hButton, ABitmap.Dc, Part, State, PaintRect, @PaintRect); end; -procedure ThemeDrawButton(const ABitmap: TBitmap; const ARect: TRect; +procedure ThemeDrawButton(const ABitmap: THBitmap; const ARect: TRect; APressed: Boolean); begin if StyleServices.Enabled @@ -206,12 +298,12 @@ procedure ThemeDrawButton(const ABitmap: TBitmap; const ARect: TRect; // Draw Themes Drag&Drop hovered item //////////////////////////////////////////////////////////////////////////////// -procedure WinXP_DrawThemedHover(const ABitmap: TBitmap; const ARect: TRect); +procedure WinXP_DrawThemedHover(const ABitmap: THBitmap; const ARect: TRect); begin WinXP_DrawThemedButton(ABitmap, ARect, False); end; -procedure Win7_DrawThemedHover(const ABitmap: TBitmap; const AAlign: TScreenAlign; +procedure Win7_DrawThemedHover(const ABitmap: THBitmap; const AAlign: TScreenAlign; const ARect: TRect); var PaintRect: TRect; @@ -221,22 +313,22 @@ procedure Win7_DrawThemedHover(const ABitmap: TBitmap; const AAlign: TScreenAlig begin if IsWindowsVista then begin - Part := 1; - State := 3; + Part := LB_TBP_BUTTON_WV; + State := LB_TBS_BUTTON_SELECTED_WV; th := hButton; end else begin - Part := 5; - State := 9; + Part := LB_TBP_BUTTON_W7; + State := LB_TBS_BUTTON_SELECTED_W7; if (AAlign = saLeft) or (AAlign = saRight) then th := hButtonVertical else th := hButton; end; PaintRect := ARect; - DrawThemeBackground(th, ABitmap.Canvas.Handle, Part, State, PaintRect, @PaintRect); + DrawThemeBackground(th, ABitmap.Dc, Part, State, PaintRect, @PaintRect); end; -procedure ThemeDrawHover(const ABitmap: TBitmap; const AAlign: TScreenAlign; +procedure ThemeDrawHover(const ABitmap: THBitmap; const AAlign: TScreenAlign; const ARect: TRect); begin if StyleServices.Enabled @@ -256,72 +348,38 @@ procedure ThemeDrawHover(const ABitmap: TBitmap; const AAlign: TScreenAlign; (TBP_BACKGROUNDBOTTOM, 1) ); -{ used in draw bg for Windows 8/8.1/10 } -function BlendColor_Old(AColor1, AColor2: TGPColor; ABalance: Cardinal): TGPColor; - - function BlendAlphaValue(a, b: Byte; t: Byte): Byte; - var c: Single; - begin - c := a + (b - a) * t / 100.0; - Result := Min(Round(c), 255); - end; - - function BlendColorValue(a, b: Byte; t: Single): Byte; - var c: Single; - begin - c := Sqrt(a * a + (b * b - a * a) * t / 100.0); - Result := Min(Round(c), 255); - end; - -begin - ABalance := Min(100, Max(0, ABalance)); - Result := TGPColor.MakeARGB( - BlendAlphaValue(AColor1.A, AColor2.A, ABalance), - BlendColorValue(AColor1.R, AColor2.R, ABalance), - BlendColorValue(AColor1.G, AColor2.G, ABalance), - BlendColorValue(AColor1.B, AColor2.B, ABalance) - ); -end; - {$REGION ' BG for Windows XP '} procedure WinXP_DrawThemedBackground(PParams: PDrawBackgroundParams); const BF_FLAGS: array[TScreenAlign] of UINT = (BF_RIGHT, BF_BOTTOM, BF_LEFT, BF_TOP); var - drawer: IGPGraphics; - bmp: TBitmap; + dc: HDC; r: TRect; begin - bmp := TBitmap.Create; - bmp.Canvas.Brush.Color := clBtnFace; - bmp.SetSize(PParams.ClipRect.Width, PParams.ClipRect.Height); - r := PParams.ClipRect; - DrawEdge(bmp.Canvas.Handle, r, BDR_RAISED, BF_FLAGS[PParams.Align]); - - drawer := PParams.Bitmap.ToGPGraphics; - drawer.DrawImage(bmp.ToGPBitmap, PParams.ClipRect.Left, PParams.ClipRect.Top); - bmp.Free; + dc := PParams.Bitmap.Dc; + FillRect(dc, r, GetSysColorBrush(COLOR_3DFACE)); + DrawEdge(dc, r, BDR_RAISED, BF_FLAGS[PParams.Align]); + PParams.Bitmap.OpaqueRect(PParams.ClipRect); end; {$ENDREGION} {$REGION ' BG for Windows Vista '} - procedure WinVista_DrawThemedBackground(PParams: PDrawBackgroundParams); var + dc: HDC; gpDrawer: IGPGraphics; part: Integer; begin if not StyleServices.Enabled then WinXP_DrawThemedBackground(PParams) else begin - gpDrawer := PParams.Bitmap.ToGPGraphics; + dc := PParams.Bitmap.Dc; + gpDrawer := TGPGraphics.Create(dc); gpDrawer.SetClip( TGPRect.Create(PParams.ClipRect) ); gpDrawer.Clear( TGPColor.Create($01000000) ); part := LB_PARTID[PParams.Align, False]; - - DrawThemeBackground(hBackground, PParams.Bitmap.Canvas.Handle, part, - 0, Rect(0,0,PParams.Bitmap.Width,PParams.Bitmap.Height), @PParams.ClipRect); + DrawThemeBackground(hBackground, dc, part, 0, PParams.Bitmap.Bound, @PParams.ClipRect); end; end; {$ENDREGION} @@ -329,42 +387,38 @@ procedure WinVista_DrawThemedBackground(PParams: PDrawBackgroundParams); {$REGION ' BG for Windows 7 '} procedure Win7Pure_DrawThemedBackground(PParams: PDrawBackgroundParams); var + dc: HDC; gpDrawer: IGPGraphics; part: Integer; begin - gpDrawer := PParams.Bitmap.ToGPGraphics; + dc := PParams.Bitmap.Dc; + gpDrawer := TGPGraphics.Create(dc); gpDrawer.SetClip( TGPRect.Create(PParams.ClipRect) ); gpDrawer.Clear( TGPColor.Create($01000000) ); part := LB_PARTID[PParams.Align, PParams.IsLight]; - - DrawThemeBackground(hBackground, PParams.Bitmap.Canvas.Handle, part, - 0, Rect(0,0,PParams.Bitmap.Width,PParams.Bitmap.Height), @PParams.ClipRect); + DrawThemeBackground(hBackground, dc, part, 0, PParams.Bitmap.Bound, @PParams.ClipRect); end; procedure Win7Aero_DrawThemedBackground(PParams: PDrawBackgroundParams); var + dc: HDC; gpDrawer: IGPGraphics; part: Integer; th: HTHEME; - color: TGPColor; begin - gpDrawer := PParams.Bitmap.ToGPGraphics; + dc := PParams.Bitmap.Dc; + gpDrawer := TGPGraphics.Create(dc); gpDrawer.SetClip( TGPRect.Create(PParams.ClipRect) ); - - color.Initialize(PParams.BgColor); - color.Alpha := Max(color.Alpha, 1); - - gpDrawer.Clear(color); + gpDrawer.Clear( FixAlpha(PParams.BgColor) ); part := LB_PARTID[PParams.Align, PParams.IsLight]; - if (PParams.Align = saLeft) or (PParams.Align = saRight) + if PParams.Align in [saLeft, saRight] then th := hBackgroundVertical else th := hBackground; - DrawThemeBackground(th, PParams.Bitmap.Canvas.Handle, part, - 0, Rect(0,0,PParams.Bitmap.Width,PParams.Bitmap.Height), @PParams.ClipRect); + DrawThemeBackground(th, dc, part, 0, PParams.Bitmap.Bound, @PParams.ClipRect); end; procedure Win7_DrawThemedBackground(PParams: PDrawBackgroundParams); @@ -385,53 +439,32 @@ procedure Win7_DrawThemedBackground(PParams: PDrawBackgroundParams); procedure Win8Def_DrawThemedBackground(PParams: PDrawBackgroundParams); var + dc: HDC; gpDrawer: IGPGraphics; - color1, color2: TGPColor; - cp: TColorizationParams; part: integer; begin - gpDrawer := PParams.Bitmap.ToGPGraphics; + dc := PParams.Bitmap.Dc; + gpDrawer := TGPGraphics.Create(dc); gpDrawer.SetClip( TGPRect.Create(PParams.ClipRect) ); - - if (PParams.BgColor > 0) - then begin - color1.Initialize(PParams.BgColor); - end - else begin - if Assigned(UDwmGetColorizationParametersProc) - then begin - UDwmGetColorizationParametersProc(cp); - color1 := TGPColor.Create(cp.clrColor); - color2 := TGPColor.Create($bad9d9d9); - color1.Alpha := color2.Alpha; - color1 := BlendColor_Old(color2, color1, cp.nIntensity); - end; - end; - - color1.Alpha := Max(color1.Alpha, 1); - gpDrawer.Clear(color1); + gpDrawer.Clear( FixAlpha(PParams.BgColor) ); part := LB_PARTID[PParams.Align, False]; - DrawThemeBackground(hBackground, PParams.Bitmap.Canvas.Handle, part, - 0, Rect(0,0,PParams.Bitmap.Width,PParams.Bitmap.Height), @PParams.ClipRect); + DrawThemeBackground(hBackground, dc, part, 0, PParams.Bitmap.Bound, @PParams.ClipRect); end; procedure Win8AG_DrawThemedBackground(PParams: PDrawBackgroundParams); var + dc: HDC; gpDrawer: IGPGraphics; part: integer; - color: TGPColor; begin - gpDrawer := PParams.Bitmap.ToGPGraphics; + dc := PParams.Bitmap.Dc; + gpDrawer := TGPGraphics.Create(dc); gpDrawer.SetClip( TGPRect.Create(PParams.ClipRect) ); - - color.Initialize(PParams.BgColor); - color.Alpha := Max(color.Alpha, 1); - gpDrawer.Clear(color); + gpDrawer.Clear( FixAlpha(PParams.BgColor) ); part := LB_PARTID[PParams.Align, False]; - DrawThemeBackground(hBackground, PParams.Bitmap.Canvas.Handle, part, - 0, Rect(0,0,PParams.Bitmap.Width,PParams.Bitmap.Height), @PParams.ClipRect); + DrawThemeBackground(hBackground, dc, part, 0, PParams.Bitmap.Bound, @PParams.ClipRect); end; procedure Win8_DrawThemedBackground(PParams: PDrawBackgroundParams); @@ -444,34 +477,11 @@ procedure Win8_DrawThemedBackground(PParams: PDrawBackgroundParams); {$REGION ' BG for Windows 10 '} procedure Win10_DrawThemedBackground(PParams: PDrawBackgroundParams); -const WIN10BASECOLOR = $ffd9d9d9; // from internet -var - gpDrawer: IGPGraphics; - color: TGPColor; - cp: TColorizationParams; +var gpDrawer: IGPGraphics; begin - gpDrawer := PParams.Bitmap.ToGPGraphics; + gpDrawer := TGPGraphics.Create(PParams.Bitmap.Dc); gpDrawer.SetClip( TGPRect.Create(PParams.ClipRect) ); - - if (PParams.BgColor > 0) - then begin - color.Initialize(PParams.BgColor); - end - else begin - if Assigned(UDwmGetColorizationParametersProc) - then begin - UDwmGetColorizationParametersProc(cp); - color := TGPColor.Create(cp.clrColor); - color.A := $e0; - color.R := Round(color.R * 0.6); - color.G := Round(color.G * 0.6); - color.B := Round(color.B * 0.6); - end; - end; - - color.Alpha := Max(color.Alpha, 1); - gpDrawer.Clear(color); - + gpDrawer.Clear($01000000); end; {$ENDREGION} @@ -493,22 +503,12 @@ procedure ThemeDrawBackground(PParams: PDrawBackgroundParams); then WinXP_DrawThemedBackground(PParams); end; -procedure ThemeDrawGlow(const ABitmap: TBitmap; const ARect: TRect; - const AColor: Cardinal); -var - gpDrawer: IGPGraphics; - gpBrush: IGPSolidBrush; -begin - gpDrawer := ABitmap.ToGPGraphics; - gpBrush := TGPSolidBrush.Create(AColor); - gpDrawer.FillRectangle(gpBrush, TGPRect.Create(ARect)); -end; - //////////////////////////////////////////////////////////////////////////////// // Open/Close HTHEME's //////////////////////////////////////////////////////////////////////////////// procedure ThemeInitData(const AWnd: HWND; AIsLight: Boolean); +var color: COLORREF; begin if (not IsMinimumSupportedOS) or (AWnd = 0) then Exit; @@ -529,9 +529,15 @@ procedure ThemeInitData(const AWnd: HWND; AIsLight: Boolean); hBackground := OpenThemeData(AWnd, 'TaskBar::TaskBar'); hButton := OpenThemeData(AWnd, 'TaskBand::Toolbar'); end; + ThemeButtonNormalTextColor := clWhite; + ThemeButtonSelectedTextColor := clWhite; + ThemeButtonPressedTextColor := clWhite; Exit; end; + if IsWindows8OrAbove + then AIsLight := False; + // for Windows 7/8/8.1/10 if DwmCompositionEnabled then begin @@ -557,6 +563,22 @@ procedure ThemeInitData(const AWnd: HWND; AIsLight: Boolean); hButton := OpenThemeData(AWnd, 'TaskBand2::TaskBand2'); hButtonVertical := OpenThemeData(AWnd, 'TaskBand2Vertical::TaskBand2'); end; + + // Get button text colors + // NOTE: Normal and Selected StateId are confused or I do not understand + // This work on Windows 8/8.1 with Default and HighContrast themes + // Normal + if GetThemeColor(hButton, LB_TBP_BUTTON_W7, LB_TBS_BUTTON_SELECTED_W7, TMT_TEXTCOLOR, color) = S_OK + then ThemeButtonNormalTextColor := color + else ThemeButtonNormalTextColor := clBlack; + // Selected + if GetThemeColor(hButton, LB_TBP_BUTTON_W7, LB_TBS_BUTTON_NORMAL_W7, TMT_TEXTCOLOR, color) = S_OK + then ThemeButtonSelectedTextColor := color + else ThemeButtonSelectedTextColor := clBlack; + // Pressed + if GetThemeColor(hButton, LB_TBP_BUTTON_W7, LB_TBS_BUTTON_PRESSED_W7, TMT_TEXTCOLOR, color) = S_OK + then ThemeButtonPressedTextColor := color + else ThemeButtonPressedTextColor := clBlack; end; procedure ThemeCloseData; diff --git a/src/Linkbar.Undoc.pas b/src/Linkbar.Undoc.pas index 0c6d2c9..3f05612 100644 --- a/src/Linkbar.Undoc.pas +++ b/src/Linkbar.Undoc.pas @@ -1,6 +1,6 @@ {*******************************************************} { Linkbar - Windows desktop toolbar } -{ Copyright (c) 2010-2017 Asaq } +{ Copyright (c) 2010-2018 Asaq } {*******************************************************} unit Linkbar.Undoc; @@ -10,11 +10,11 @@ interface uses - Windows, SysUtils; + Winapi.Windows, System.SysUtils; const - U_WCA_CLIENTRENDERING_POLICY_WIN7 = 16; - U_WCA_CLIENTRENDERING_POLICY_WIN8 = 15; + U_WCA_CLIENTRENDERING_POLICY_WIN7 = 16; + U_WCA_CLIENTRENDERING_POLICY_WIN8 = 15; // Windows 10 AeroGlass U_WCA_ACCENT_POLICY = 19; @@ -26,6 +26,7 @@ interface U_WCA_ACCENT_STATE_INVALID_STATE = 4; U_WCA_ACCENT_FLAG_DEFAULT = 0; + U_WCA_ACCENT_FLAG_DRAW_ALL = $13; U_WCA_ACCENT_FLAG_DRAW_LEFT_BORDER = $20; U_WCA_ACCENT_FLAG_DRAW_TOP_BORDER = $40; U_WCA_ACCENT_FLAG_DRAW_RIGHT_BORDER = $80; @@ -33,18 +34,19 @@ interface type tagCOLORIZATIONPARAMS = record - clrColor : COLORREF; //ColorizationColor - clrAftGlow : COLORREF; //ColorizationAfterglow - nIntensity : UINT; //ColorizationColorBalance -> 0-100 - clrAftGlowBal : UINT; //ColorizationAfterglowBalance - clrBlurBal : UINT; //ColorizationBlurBalance - clrGlassReflInt : UINT; //ColorizationGlassReflectionIntensity - fOpaque : BOOL; + Color: COLORREF; + Afterglow: COLORREF; + ColorBalance: UINT; + AfterglowBalance: UINT; + BlurBalance: UINT; + GlassReflectionIntensity: UINT; + OpaqueBlend: DWORD; // BOOL + Extra: DWORD; // Win8 has extra parameter end; TColorizationParams = tagCOLORIZATIONPARAMS; PColorizationParams = ^TColorizationParams; - TDwmGetColorizationParameters = procedure(out parameters: TColorizationParams); stdcall; + TDwmGetColorizationParameters = function(out parameters: TColorizationParams): HRESULT; stdcall; // http://a-whiter.livejournal.com/1385.html // http://undoc.airesoft.co.uk/user32.dll/SetWindowCompositionAttribute.php @@ -56,56 +58,67 @@ tagCOLORIZATIONPARAMS = record TWcaData = tagWCADATA; PWcaData = ^TWcaData; - tagACCENTPOLICY = packed record AccentState: Integer; AccentFlags: Integer; - GradientColor: Integer; + GradientColor: COLORREF; AnimationId: Integer; end; TWcaAccentPolicy = tagACCENTPOLICY; PWcaAccentPolicy = ^TWcaAccentPolicy; - TDwmSetWindowCompositionAttribute = function(hwnd: HWND; - pAttrData: PWcaData): BOOL; stdcall; + TDwmSetWindowCompositionAttribute = function(hwnd: HWND; pAttrData: PWcaData): BOOL; stdcall; + + // Get Metro Colors + TGetImmersiveUserColorSetPreference = function(bForceCheckRegistry: BOOL; bSkipCheckOnFail: BOOL): Integer; stdcall; + TGetImmersiveColorTypeFromName = function(const pName: PChar): Integer; stdcall; + TGetImmersiveColorFromColorSetEx = function(dwImmersiveColorSet: UINT; dwImmersiveColorType: UINT; bIgnoreHighContrast: BOOL; dwHighContrastCacheMode: UINT): COLORREF; stdcall; var UDwmGetColorizationParametersProc: TDwmGetColorizationParameters = nil; UDwmSetWindowCompositionAttributeProc: TDwmSetWindowCompositionAttribute = nil; + // + UGetImmersiveUserColorSetPreferenceProc: TGetImmersiveUserColorSetPreference = nil; + UGetImmersiveColorTypeFromNameProc: TGetImmersiveColorTypeFromName = nil; + UGetImmersiveColorFromColorSetExProc: TGetImmersiveColorFromColorSetEx = nil; implementation -const - lnDwmApi = 'DWMAPI.DLL'; - NameDwmGetColorizationParameters = 127; - - lnUser32 = 'USER32.DLL'; - NameSetWindowCompositionAttribute = 'SetWindowCompositionAttribute'; - NameUpdateLayeredWindowIndirect = 'UpdateLayeredWindowIndirect'; +uses Linkbar.OS; function LoadUndocFunctions: boolean; -var - hDwmApi: THandle; - hUser32: THandle; +var hlib: THandle; begin // dwmapi.dll - hDwmApi := GetModuleHandle(lnDwmApi); - if (hDwmApi >= 32) + hlib := GetModuleHandle('DWMAPI.DLL'); + if (hlib <> 0) then begin - @UDwmGetColorizationParametersProc := GetProcAddress( hDwmApi, - LPCSTR(NameDwmGetColorizationParameters) ); + @UDwmGetColorizationParametersProc := GetProcAddress(hlib, LPCSTR(127)); end; // user32.dll - hUser32 := GetModuleHandle(lnUser32); - if (hUser32 >= 32) + hlib := GetModuleHandle('USER32.DLL'); + if (hlib <> 0) + then begin + @UDwmSetWindowCompositionAttributeProc := GetProcAddress(hlib, LPCSTR('SetWindowCompositionAttribute')); + end; + + // uxtheme.dll + if IsWindows10OrAbove then begin - @UDwmSetWindowCompositionAttributeProc := GetProcAddress( hUser32, - LPCSTR(NameSetWindowCompositionAttribute) ); + hlib := GetModuleHandle('UXTHEME.DLL'); + if (hlib <> 0) + //and (GetModuleVersion(hlib) >= $6020000) + then begin + @UGetImmersiveColorFromColorSetExProc := GetProcAddress(hlib, LPCSTR(95)); + @UGetImmersiveColorTypeFromNameProc := GetProcAddress(hlib, LPCSTR(96)); + if Assigned(UGetImmersiveColorFromColorSetExProc) + and Assigned(UGetImmersiveColorTypeFromNameProc) + then @UGetImmersiveUserColorSetPreferenceProc := GetProcAddress(hlib, LPCSTR(98)); + end; end; - Result := Assigned(UDwmGetColorizationParametersProc) - and Assigned(UDwmSetWindowCompositionAttributeProc); + Result := True; end; initialization diff --git a/src/Linkbar.dpr b/src/Linkbar.dpr index 0095e01..689e8e5 100644 --- a/src/Linkbar.dpr +++ b/src/Linkbar.dpr @@ -23,7 +23,10 @@ uses Linkbar.Newbar, Linkbar.Shell, Linkbar.L10n, - Linkbar.Settings in 'Linkbar.Settings.pas' {FrmProperties}; + Linkbar.SettingsForm in 'Linkbar.SettingsForm.pas' {FrmProperties}, + Linkbar.Graphics in 'Linkbar.Graphics.pas', + Linkbar.Themes in 'Linkbar.Themes.pas', + Linkbar.Settings in 'Linkbar.Settings.pas'; {$R *.res} @@ -45,10 +48,7 @@ begin ReportMemoryLeaksOnShutdown := True; {$ENDIF} - InitOS; - //----------------------- - // Check supported OS - //----------------------- + { Check supported OS } if not IsMinimumSupportedOS then begin MessageDlg('Sorry :(' @@ -60,32 +60,32 @@ begin Exit; end; - { Delay start } + { Check CMD Delay start } delay := 0; if FindCmdLineSwitch(CLK_DELAY, cmd, True) and TryStrToInt(cmd, delay) - and (delay > 0) {and (delay < INFINITE)} + and (delay > 0) then Sleep(delay); - //----------------------- - // Apply localization - //----------------------- + + { Check CMD Language } FindCmdLineSwitch(CLK_LANG, cmd, True); L10nLoad(ExtractFilePath(ParamStr(0)) + DN_LOCALES, cmd); + { Check CMD New Linkbar } if FindCmdLineSwitch(CLK_NEW, True) then begin RunAsNewLinkbar; Exit; end; - if FindCmdLineSwitch(CLK_FILE, FPreferencesFileName, True) - and SameText(ExtractFileExt(FPreferencesFileName), EXT_LBR) - and TFile.Exists(FPreferencesFileName) + if FindCmdLineSwitch(CLK_FILE, FSettingsFileName, True) + and SameText(ExtractFileExt(FSettingsFileName), EXT_LBR) + and TFile.Exists(FSettingsFileName) then begin // delete profile if working directory invalid - if not IsValidPreferenceFile(FPreferencesFileName) + if not TSettings.IsValid(FSettingsFileName) then begin - TFile.Delete(FPreferencesFileName); + TFile.Delete(FSettingsFileName); Exit; end; OleInitialize(nil); @@ -120,7 +120,7 @@ begin for i := 0 to sl.Count-1 do begin // delete profile if working directory invalid - if not IsValidPreferenceFile(sl[i]) + if not TSettings.IsValid(sl[i]) then begin TFile.Delete(sl[i]); Continue; diff --git a/src/mUnit.dfm b/src/mUnit.dfm index f8b3158..71700da 100644 --- a/src/mUnit.dfm +++ b/src/mUnit.dfm @@ -4,7 +4,6 @@ object LinkbarWcl: TLinkbarWcl ClientHeight = 68 ClientWidth = 365 Color = clBtnFace - DefaultMonitor = dmMainForm Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -13 @@ -21,6 +20,7 @@ object LinkbarWcl: TLinkbarWcl OnMouseLeave = FormMouseLeave OnMouseMove = FormMouseMove OnMouseUp = FormMouseUp + OnResize = FormResize PixelsPerInch = 96 TextHeight = 16 object pMenu: TPopupMenu @@ -35,7 +35,7 @@ object LinkbarWcl: TLinkbarWcl GroupIndex = 2 OnClick = imOpenWorkdirClick end - object N1: TMenuItem + object N2: TMenuItem Caption = '-' GroupIndex = 2 end @@ -45,11 +45,11 @@ object LinkbarWcl: TLinkbarWcl OnClick = imAddBarClick end object imRemoveBar: TMenuItem - Caption = 'Delete the linkbar' + Caption = 'Delete the linkbar...' GroupIndex = 2 OnClick = imRemoveBarClick end - object N2: TMenuItem + object N1: TMenuItem Caption = '-' GroupIndex = 2 end @@ -65,7 +65,7 @@ object LinkbarWcl: TLinkbarWcl OnClick = imSortAlphabetClick end object imProperties: TMenuItem - Caption = 'Properties' + Caption = 'Settings...' GroupIndex = 2 OnClick = imPropertiesClick end diff --git a/src/mUnit.pas b/src/mUnit.pas index e0012bd..b9bcbf3 100644 --- a/src/mUnit.pas +++ b/src/mUnit.pas @@ -1,6 +1,6 @@ {*******************************************************} { Linkbar - Windows desktop toolbar } -{ Copyright (c) 2010-2017 Asaq } +{ Copyright (c) 2010-2018 Asaq } {*******************************************************} unit mUnit; @@ -10,14 +10,14 @@ interface uses - GdiPlus, GdiPlusHelpers, + GdiPlus, Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, - System.UITypes, IniFiles, Menus, Vcl.ExtCtrls, Winapi.ShlObj, + System.UITypes, Menus, Vcl.ExtCtrls, Winapi.ShlObj, DDForms, Cromis.DirectoryWatch, - AccessBar, LBToolbar, Linkbar.Consts, Linkbar.Hint, Linkbar.Taskbar, HotKey; + AccessBar, LBToolbar, Linkbar.Consts, Linkbar.Hint, Linkbar.Taskbar, HotKey, + Linkbar.Graphics; type - TLinkbarWcl = class(TLinkbarCustomFrom) pMenu: TPopupMenu; imClose: TMenuItem; @@ -55,16 +55,18 @@ TLinkbarWcl = class(TLinkbarCustomFrom) var Handled: Boolean); procedure imSortAlphabetClick(Sender: TObject); procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); + procedure FormResize(Sender: TObject); private - CBmpSelectedItem: TBitmap; - CBmpDropPosition: TBitmap; - BmpBtn: TBitmap; - BmpMain: TBitmap; + CBmpSelectedItem: THBitmap; + CBmpDropPosition: THBitmap; + BmpBtn: THBitmap; + BmpMain: THBitmap; Items: TLBItemList; oAppBar : TAccessBar; oHint: TTooltip32; + FCreated: Boolean; FHotIndex: Integer; - FItemPressed: Integer; + FPressedIndex: Integer; FMousePosDown: TPoint; FMousePosUp: TPoint; FMouseLeftDown: Boolean; @@ -77,29 +79,32 @@ TLinkbarWcl = class(TLinkbarCustomFrom) FAutoShowMode: TAutoShowMode; FButtonSize: TSize; FButtonCenter: TPoint; + FEnableAeroGlass: Boolean; FGripSize: Integer; FHintShow: Boolean; FHotkeyInfo: THotkeyInfo; - FHotkeyPressed: Boolean; FItemMargin: TSize; FIconSize: Integer; FIsLightStyle: Boolean; FItemOrder: TItemOrder; FJumplistShowMode: TJumplistShowMode; + FJumplistRecentMax: Integer; + FLookMode: TLookMode; FLockLinkbar: Boolean; FLockHotIndex: Boolean; + FCorner1GapWidth, FCorner2GapWidth: Integer; FSortAlphabetically: Boolean; FStayOnTop: Boolean; - FBkgColor: Cardinal; - FTxtColor: Cardinal; - FUseBkgColor: Boolean; - FUseTxtColor: Boolean; + FBackgroundColor: Cardinal; + FSysBackgroundColor: Cardinal; + FTextColor: Cardinal; + FUseBkgndColor: Boolean; + FUseTextColor: Boolean; FGlowSize: Integer; FScreenEdge: TScreenAlign; FTextWidth: Integer; FTextOffset: Integer; FTextLayout: TTextLayout; - FTextHeight: Integer; FIconOffset: TPoint; FTextRect: TRect; IconsInLine, IconLinesCount: integer; @@ -107,6 +112,7 @@ TLinkbarWcl = class(TLinkbarCustomFrom) procedure UpdateWindowSize; procedure SetScreenAlign(AValue: TScreenAlign); procedure SetAutoHide(AValue: Boolean); + procedure SetEnableAeroGlass(AValue: Boolean); procedure SetItemOrder(AValue: TItemOrder); procedure SetPressedIndex(AValue: integer); procedure SetHotIndex(AValue: integer); @@ -120,30 +126,36 @@ TLinkbarWcl = class(TLinkbarCustomFrom) procedure SetTextWidth(AValue: Integer); procedure SetSortAlphabetically(AValue: Boolean); procedure SetStayOnTop(AValue: Boolean); + procedure SetLookMode(AValue: TLookMode); + procedure SetUseBkgndColor(AValue: Boolean); function GetScreenAlign: TScreenAlign; - procedure DrawBackground(const ABitmap: TBitmap; const AClipRect: TRect); - procedure DrawCaption(const ABitmap: TBitmap; const AIndex: Integer; + procedure DrawBackground(const ABitmap: THBitmap; const AClipRect: TRect); + procedure DrawCaption(const ABitmap: THBitmap; const AIndex: Integer; const ADrawForDrag: Boolean = False); - procedure DrawItem(ABitmap: TBitmap; AIndex: integer; ASelected, + procedure DrawItem(ABitmap: THBitmap; AIndex: integer; ASelected, APressed: Boolean; ADrawBg: Boolean = True; ADrawForDrag: Boolean = False); procedure DrawItems; procedure RecreateMainBitmap(const AWidth, AHeight: integer); procedure RecreateButtonBitmap(const AWidth, AHeight: integer); procedure UpdateWindow(const AWnd: HWND; const ABounds: TRect; - const AScreenEdge: TScreenAlign; const ABitmap: TBitmap); + const AScreenEdge: TScreenAlign; const ABitmap: THBitmap); procedure UpdateBlur; + procedure UpdateBackgroundColor; + function GetBackgroundColor: Cardinal; function ItemIndexByPoint(const APt: TPoint; const ALastIndex: integer = ITEM_NONE): Integer; function CheckItem(AIndex: Integer): Boolean; + procedure DeleteItem(const AIndex: Integer); function ScaleDimension(const X: Integer): Integer; inline; private procedure L10n; - procedure LoadProperties(const AFileName: string); - procedure SaveProperties; + procedure LoadSettings; + procedure SaveLinks; private BitBucketNotify: Cardinal; procedure UpdateBitBuckets; private + FRemoved: boolean; FDragScreenEdge: TScreenAlign; FMonitorNum: Integer; FDragMonitorNum: Integer; @@ -153,6 +165,7 @@ TLinkbarWcl = class(TLinkbarCustomFrom) procedure DoExecuteItem(const AIndex: Integer); procedure DoClickItem(X, Y: Integer); procedure DoRenameItem(AIndex: Integer); + procedure DoPopupMenuItemExecute(const ACmd: Integer); procedure DoDragLinkbar(X, Y: Integer); procedure DoPopupMenu(APt: TPoint; AShift: Boolean); procedure DoPopupJumplist(APt: TPoint; AShift: Boolean); @@ -163,9 +176,7 @@ TLinkbarWcl = class(TLinkbarCustomFrom) procedure QuerySizedEvent(Sender: TObject; const AX, AY, AWidth, AHeight: Integer); procedure QueryHideEvent(Sender: TObject; AEnabled: boolean); function IsItemIndex(const AIndex: Integer): Boolean; - private - FRemoved: boolean; - procedure DoPopupMenuItemExecute(const ACmd: Integer); + procedure CreateBitmaps; protected // Drag&Drop functions FItemDropPosition: Integer; @@ -175,7 +186,7 @@ TLinkbarWcl = class(TLinkbarCustomFrom) procedure DoDragOver(const pt: TPoint; var ppidl: PItemIDList); override; procedure DoDragLeave; override; procedure DoDrop(const pt: TPoint); override; - procedure QueryDragImage(out ABitmap: TBitmap; out AOffset: TPoint); override; + procedure QueryDragImage(out ABitmap: THBitmap; out AOffset: TPoint); override; protected // Dir watch procedure DirWatchChange(const Sender: TObject; const AAction: TWatchAction; @@ -198,83 +209,66 @@ TLinkbarWcl = class(TLinkbarCustomFrom) procedure DoAutoHide; procedure DoAutoShow; procedure DoDelayedAutoShow; + procedure DoDelayedAutoHide(const ADelay: Cardinal); procedure OnFormJumplistDestroy(Sender: TObject); public + procedure SaveSettings; procedure UpdateItemSizes; - procedure PropertiesFormDestroyed; property AutoHide: Boolean read FAutoHide write SetAutoHide; property AutoHideTransparency: Boolean read FAutoHideTransparency write FAutoHideTransparency; + property AutoShowDelay: Integer read FAutoShowDelay write FAutoShowDelay; property AutoShowMode: TAutoShowMode read FAutoShowMode write FAutoShowMode; + property BackgroundColor: Cardinal read GetBackgroundColor write FBackgroundColor; property ButtonSize: TSize read FButtonSize write SetButtonSize; + property EnableAeroGlass: Boolean read FEnableAeroGlass write SetEnableAeroGlass; + property GlowSize: Integer read FGlowSize write FGlowSize; + property HintShow: Boolean read FHintShow write FHintShow; + property HotIndex: Integer read FHotIndex write SetHotIndex; property HotkeyInfo: THotkeyInfo read FHotkeyInfo write SetHotkeyInfo; - property ItemMargin: TSize read FItemMargin write SetItemMargin; property IconSize: Integer read FIconSize write SetIconSize; property IsLightStyle: Boolean read FIsLightStyle write SetIsLightStyle; + property ItemMargin: TSize read FItemMargin write SetItemMargin; property ItemOrder: TItemOrder read FItemOrder write SetItemOrder; property JumplistShowMode: TJumplistShowMode read FJumplistShowMode write FJumplistShowMode; + property JumplistRecentMax: Integer read FJumplistRecentMax write FJumplistRecentMax; + property LookMode: TLookMode read FLookMode write SetLookMode; + property PressedIndex: Integer read FPressedIndex write SetPressedIndex; + property ScreenAlign: TScreenAlign read GetScreenAlign write SetScreenAlign; + property SortAlphabetically: Boolean read FSortAlphabetically write SetSortAlphabetically; + property StayOnTop: Boolean read FStayOnTop write SetStayOnTop default True; property TextLayout: TTextLayout read FTextLayout write SetTextLayout; property TextOffset: Integer read FTextOffset write SetTextOffset; property TextWidth: Integer read FTextWidth write SetTextWidth; - property HintShow: Boolean read FHintShow write FHintShow; - property AutoShowDelay: Integer read FAutoShowDelay write FAutoShowDelay; - property PressedIndex: Integer read FItemPressed write SetPressedIndex; - property HotIndex: Integer read FHotIndex write SetHotIndex; - property ScreenAlign: TScreenAlign read GetScreenAlign write SetScreenAlign; - property SortAlphabetically: Boolean read FSortAlphabetically write SetSortAlphabetically; - property BkgColor: Cardinal read FBkgColor write FBkgColor; - property TxtColor: Cardinal read FTxtColor write FTxtColor; - property UseBkgColor: Boolean read FUseBkgColor write FUseBkgColor; - property UseTxtColor: Boolean read FUseTxtColor write FUseTxtColor; - property GlowSize: Integer read FGlowSize write FGlowSize; - property StayOnTop: Boolean read FStayOnTop write SetStayOnTop; - private - FEnableAeroGlass: Boolean; - procedure SetEnableAeroGlass(AValue: Boolean); - public - property EnableAeroGlass: Boolean read FEnableAeroGlass write SetEnableAeroGlass; + property TextColor: Cardinal read FTextColor write FTextColor; + property UseBkgndColor: Boolean read FUseBkgndColor write SetUseBkgndColor; + property UseTextColor: Boolean read FUseTextColor write FUseTextColor; + // + property Corner1GapWidth: Integer read FCorner1GapWidth write FCorner1GapWidth; + property Corner2GapWidth: Integer read FCorner2GapWidth write FCorner2GapWidth; end; - function IsValidPreferenceFile(const AFileName: string): Boolean; - var LinkbarWcl: TLinkbarWcl; - FPreferencesFileName: string; + FSettingsFileName: string; implementation {$R *.dfm} -uses Types, Math, Dialogs, StrUtils, - ExplorerMenu, Linkbar.Settings, Linkbar.Shell, Linkbar.Themes, - Linkbar.OS, JumpLists.Api, JumpLists.Form, - Linkbar.L10n, RenameDialog, - Themes; +uses + Types, Math, Dialogs, StrUtils, Themes, + ExplorerMenu, Linkbar.Shell, Linkbar.Themes, + Linkbar.OS, Linkbar.L10n, JumpLists.Form, RenameDialog, + Linkbar.SettingsForm, Linkbar.Settings; const bf: TBlendFunction = (BlendOp: AC_SRC_OVER; BlendFlags: 0; SourceConstantAlpha: $FF; AlphaFormat: AC_SRC_ALPHA); - WM_LB_SHELLNOTIFY = WM_USER + 88; + LM_SHELLNOTIFY = WM_USER + 88; TIMER_AUTO_SHOW = 15; TIMER_AUTO_HIDE = 16; -function IsValidPreferenceFile(const AFileName: string): Boolean; -var ini: TMemIniFile; - wd: string; -begin - wd := ''; - if FileExists(AFileName) - then begin - ini := TMemIniFile.Create(AFileName); - try - wd := ini.ReadString(INI_SECTION_MAIN, INI_DIR_LINKS, DEF_DIR_LINKS); - finally - ini.Free; - end; - end; - Result := DirectoryExists(wd); -end; - function FindinSL(sl: TStringList; s: String; var index: integer): boolean; var i: integer; begin @@ -308,7 +302,6 @@ procedure TLinkbarWcl.GetOrCreateFilesList(filename: string); templist := TStringList.Create; templist.CaseSensitive := False; - //templist.Duplicates := dupIgnore; templist.Sorted := False; // Find supperted files in working directory @@ -375,13 +368,23 @@ function TLinkbarWcl.CheckItem(AIndex: Integer): Boolean; L10NFind('Message.DeleteShortcut', 'Delete shortcut?'), mtConfirmation, [mbOK, mbCancel], 0, mbCancel) = mrOk then begin - Items.Delete(AIndex); + DeleteItem(AIndex); UpdateWindowSize; end; end; end; -procedure TLinkbarWcl.DrawBackground(const ABitmap: TBitmap; +procedure TLinkbarWcl.DeleteItem(const AIndex: Integer); +begin + Items.Delete(AIndex); + // Clear FHotIndex/FPressedIndex if Hot/Pressed item deleted + if (FHotIndex = AIndex) + then FHotIndex := ITEM_NONE; + if (FPressedIndex = AIndex) + then FPressedIndex := ITEM_NONE; +end; + +procedure TLinkbarWcl.DrawBackground(const ABitmap: THBitmap; const AClipRect: TRect); var params: TDrawBackgroundParams; begin @@ -389,138 +392,146 @@ procedure TLinkbarWcl.DrawBackground(const ABitmap: TBitmap; params.Align := ScreenAlign; params.ClipRect := AClipRect; params.IsLight := IsLightStyle; - - if (UseBkgColor) - then params.BgColor := FBkgColor - else params.BgColor := 0; - + params.BgColor := BackgroundColor; ThemeDrawBackground(@params); end; -procedure TLinkbarWcl.DrawCaption(const ABitmap: TBitmap; const AIndex: Integer; - const ADrawForDrag: Boolean = False); -var - bmp: TBitmap; // buffer bitmap - i: Integer; - LText: string; - LTextRect: TRect; - LTextFlags: Cardinal; - LGlowSize: Integer; - LPosBounds, LTxtBounds: TRect; // buffer bitmap position and size - LFromItem, LToItem: Integer; - LTextColor: TColor; - drawer: IGPGraphics; +function CreateHBitmap(const ADc: HDC; const AWidth, AHeight: Integer; const ABbp: Word): HBITMAP; +var bi: TBitmapInfo; + bits: Pointer; begin - // Optimization Hell ! + FillChar(bi, SizeOf(bi), 0); + bi.bmiHeader.biSize := sizeof(BITMAPINFOHEADER); + bi.bmiHeader.biWidth := AWidth; + bi.bmiHeader.biHeight := AHeight; + bi.bmiHeader.biPlanes := 1; + bi.bmiHeader.biBitCount := ABbp; + Result := CreateDIBSection(ADc, bi, DIB_RGB_COLORS, bits, 0, 0); +end; +procedure TLinkbarWcl.DrawCaption(const ABitmap: THBitmap; const AIndex: Integer; + const ADrawForDrag: Boolean = False); +var i: Integer; + LTextRect: TRect; + LTextFlags: Cardinal; + LTextColor: TColor; + item: TLbItem; + dc, dc2: HDC; + fnt0: HGDIOBJ; + bmp: THBitmap; +begin if (TextLayout = tlNone) then Exit; - if AIndex = ITEM_ALL then - begin // all items - LFromItem := 0; - LToItem := Items.Count-1; - LPosBounds := Rect(0, 0, ABitmap.Width, ABitmap.Height); - end - else begin // AIndex item - LFromItem := AIndex; - LToItem := AIndex; - LPosBounds := Items[AIndex].Rect; - if ADrawForDrag - then LPosBounds.Location := Point(0,0); - - LTxtBounds := FTextRect; - if AIndex = PressedIndex - then LTxtBounds.Offset(1,1); - end; - LTextFlags := TEXTALIGN[TextLayout] or DT_END_ELLIPSIS or DT_SINGLELINE or DT_NOPREFIX or DT_NOCLIP; - if StyleServices.Enabled - then begin // use DrawGlassText - bmp := TBitmap.Create; - bmp.PixelFormat := pf32bit; - bmp.Canvas.Brush.Style := bsClear; - bmp.SetSize(LPosBounds.Width, -LPosBounds.Height); // '-' need for DrawGlassText - bmp.Canvas.Font := Screen.IconFont; - - if (UseTxtColor) - then LTextColor := TGPColor.Create(FTxtColor).ColorRef + if (StyleServices.Enabled) + then begin + // Aero theme. Use DrawGlassText + if (FUseTextColor) + then begin + LTextColor := FTextColor; + end else begin - // Automatic text color - if (StyleServices.Enabled) + if (AIndex = ITEM_ALL) then begin - if (IsWindowsVista) - then LTextColor := clWhite - else if (IsWindows8OrAbove) - then LTextColor := clWhite - else LTextColor := clBtnText; + LTextColor := ThemeButtonNormalTextColor; end - else LTextColor := clBtnText; + else begin + if (AIndex = PressedIndex) + then LTextColor := ThemeButtonPressedTextColor + else if (AIndex = HotIndex) + then LTextColor := ThemeButtonSelectedTextColor + else LTextColor := ThemeButtonNormalTextColor; + end; end; - LGlowSize := FGlowSize; + dc := ABitmap.Dc; - for i := LFromItem to LToItem do - begin - LText := Items[i].Caption; + if (AIndex = ITEM_ALL) + then begin + fnt0 := SelectObject(dc, Screen.IconFont.Handle); + for i := 0 to Items.Count-1 do + begin + item := Items[i]; + LTextRect := FTextRect; + LTextRect.Offset(item.Rect.Left, item.Rect.Top); + DrawGlassText(dc, item.Caption, LTextRect, LTextFlags, FGlowSize, LTextColor); + end; + SelectObject(dc, fnt0); + end + else begin + item := Items[AIndex]; - if AIndex = ITEM_ALL + if ADrawForDrag then begin LTextRect := FTextRect; - LTextRect.Offset(Items[i].Rect.Left, Items[i].Rect.Top) + fnt0 := SelectObject(dc, Screen.IconFont.Handle); + DrawGlassText(dc, item.Caption, LTextRect, LTextFlags, FGlowSize, LTextColor); + SelectObject(dc, fnt0); end - else LTextRect := LTxtBounds; + else begin + // The shadow extends beyond the button, creating artifacts + // Draw on separate bitmap with button size + bmp := THBitmap.Create(32); + bmp.SetSize(BmpBtn.Width, BmpBtn.Height); + dc2 := bmp.Dc; + + LTextRect := FTextRect; + if (AIndex = PressedIndex) + then LTextRect.Offset(1,1); - LTextRect.Inflate(-TEXT_BORDER, -TEXT_BORDER, -TEXT_BORDER, -TEXT_BORDER); + fnt0 := SelectObject(dc2, Screen.IconFont.Handle); + DrawGlassText(dc2, item.Caption, LTextRect, LTextFlags, FGlowSize, LTextColor); + SelectObject(dc2, fnt0); - DrawGlassText(bmp.Canvas.Handle, LText, LTextRect, LTextFlags, - LGlowSize, LTextColor); - end; + Windows.AlphaBlend(dc, + item.Rect.Left, item.Rect.Top, bmp.Width, bmp.Height, + dc2, 0, 0, bmp.Width, bmp.Height, bf); - Windows.AlphaBlend(ABitmap.Canvas.Handle, - LPosBounds.Left, LPosBounds.Top, LPosBounds.Width, LPosBounds.Height, - bmp.Canvas.Handle, - 0, 0, bmp.Width, bmp.Height, - bf); - bmp.Free; + bmp.Free; + end; + end; end - else begin // DrawThemeText/DrawThemeTextEx not work in Classic theme - bmp := TBitmap.Create; - bmp.PixelFormat := pf24bit; - bmp.Canvas.Brush.Color := clBtnFace; - bmp.SetSize(LPosBounds.Width, LPosBounds.Height); - bmp.Canvas.Font := Screen.IconFont; - bmp.Canvas.Font.Color := clBtnText; - - for i := LFromItem to LToItem do - begin - LText := Items[i].Caption; + else begin + // Classic theme + // NOTE: DrawThemeText/DrawThemeTextEx not work in Classic theme - if AIndex = ITEM_ALL - then begin - LTextRect := FTextRect; - LTextRect.Offset(Items[i].Rect.Left, Items[i].Rect.Top) - end - else LTextRect := LTxtBounds; + Assert(not ADrawForDrag); // Classic Theme don't have Drag Image - LTextRect.Inflate(-TEXT_BORDER, -TEXT_BORDER, -TEXT_BORDER, -TEXT_BORDER); - DrawText(bmp.Canvas.Handle, LText, -1, LTextRect, LTextFlags); - end; + LTextColor := clBtnText; - drawer := ABitmap.ToGPGraphics; - drawer.DrawImage(bmp.ToGPBitmap, - LPosBounds.Left+TEXT_BORDER, LPosBounds.Top+TEXT_BORDER, - TEXT_BORDER, TEXT_BORDER, - LPosBounds.Width-2*TEXT_BORDER, LPosBounds.Height-2*TEXT_BORDER, - UnitPixel); - drawer := nil; + dc := ABitmap.Dc; + fnt0 := SelectObject(dc, Screen.IconFont.Handle); + SetTextColor(dc, ColorToRGB(LTextColor)); + SetBkColor(dc, ColorToRGB(clBtnFace)); + + if (AIndex = ITEM_ALL) + then begin + for i := 0 to Items.Count-1 do + begin + item := Items[i]; + LTextRect := FTextRect; + LTextRect.Offset(item.Rect.Left, item.Rect.Top); + DrawText(dc, item.Caption, -1, LTextRect, LTextFlags); + end; + ABitmap.Opaque; + end + else begin + item := Items[AIndex]; + LTextRect := FTextRect; + LTextRect.Offset(item.Rect.Left, item.Rect.Top); + if (AIndex = PressedIndex) + then LTextRect.Offset(1,1); + DrawText(dc, item.Caption, -1, LTextRect, LTextFlags); + ABitmap.OpaqueRect(item.Rect); + end; - bmp.Free; + SelectObject(dc, fnt0); end; end; -procedure TLinkbarWcl.DrawItem(ABitmap: TBitmap; AIndex: integer; ASelected, +procedure TLinkbarWcl.DrawItem(ABitmap: THBitmap; AIndex: integer; ASelected, APressed: Boolean; ADrawBg: Boolean; ADrawForDrag: Boolean); var r: TRect; d: Integer; @@ -542,19 +553,19 @@ procedure TLinkbarWcl.DrawItem(ABitmap: TBitmap; AIndex: integer; ASelected, then ThemeDrawButton(ABitmap, r, True) else if ASelected then begin - Windows.AlphaBlend(ABitmap.Canvas.Handle, r.Left, r.Top, r.Width, r.Height, - BmpBtn.Canvas.Handle, 0, 0, r.Width, r.Height, bf); + Windows.AlphaBlend(ABitmap.Dc, r.Left, r.Top, r.Width, r.Height, + BmpBtn.Dc, 0, 0, r.Width, r.Height, bf); end; if APressed then d := 1 else d := 0; - // draw text + // Draw text DrawCaption(ABitmap, AIndex, ADrawForDrag); - Items.Draw(ABitmap.Canvas.Handle, AIndex, - r.Left + FIconOffset.X + d, r.Top + FIconOffset.Y + d); + // Draw icon + Items.Draw(ABitmap.Dc, AIndex, r.Left + FIconOffset.X + d, r.Top + FIconOffset.Y + d); end; procedure TLinkbarWcl.DrawItems; @@ -604,21 +615,17 @@ procedure TLinkbarWcl.DrawItems; // Draw icons for i := 0 to Items.Count - 1 do begin - Items.Draw(BmpMain.Canvas.Handle, i, + Items.Draw(BmpMain.Dc, i, Items[i].Rect.Left + FIconOffset.X, Items[i].Rect.Top + FIconOffset.Y); end; end; procedure TLinkbarWcl.RecreateMainBitmap(const AWidth, AHeight: integer); begin - if Assigned(BmpMain) then BmpMain.Free; - // Create clear bitmap - BmpMain := TBitmap.Create; - BmpMain.PixelFormat := pf32bit; - BmpMain.Canvas.Brush.Style := bsClear; BmpMain.SetSize(AWidth, AHeight); + BmpMain.Clear; // Draw background - DrawBackground(BmpMain, BmpMain.Canvas.ClipRect); + DrawBackground(BmpMain, Rect(0, 0, AWidth, AHeight)); // Draw items DrawItems; end; @@ -626,198 +633,193 @@ procedure TLinkbarWcl.RecreateMainBitmap(const AWidth, AHeight: integer); procedure TLinkbarWcl.RecreateButtonBitmap(const AWidth, AHeight: integer); begin // Create clear bitmap - if Assigned(BmpBtn) then BmpBtn.Free; - BmpBtn := TBitMap.Create; - BmpBtn.PixelFormat := pf32bit; - BmpBtn.Canvas.Brush.Style := bsClear; BmpBtn.SetSize(AWidth, AHeight); - - // test hover texture - ThemeDrawButton(BmpBtn, Rect(0, 0, AWidth, AHeight), False); - + BmpBtn.Clear; + ThemeDrawButton(BmpBtn, BmpBtn.Bound, False); // Buffer for selections - if not Assigned(CBmpSelectedItem) - then begin - CBmpSelectedItem := TBitmap.Create; - CBmpSelectedItem.PixelFormat := pf32bit; - end; CBmpSelectedItem.SetSize(AWidth, AHeight); - // Buffer for drop - if not Assigned(CBmpDropPosition) - then begin - CBmpDropPosition := TBitmap.Create; - CBmpDropPosition.PixelFormat := pf32bit; - end; CBmpDropPosition.SetSize(AWidth, AHeight); end; procedure TLinkbarWcl.UpdateWindow(const AWnd: HWND; const ABounds: TRect; - const AScreenEdge: TScreenAlign; const ABitmap: TBitmap); -var - Pt1, Pt2: TPoint; - Sz: TSize; - bmp: TBitmap; - gpDrawer: IGPGraphics; -begin - // NOTE: we can't set TBlendFunction.SourceConstantAlpha = $01 because after - // combined with any per-pixel alpha values in the hdcSrc we can get fully - // transparent pixels - // Insted use new bitmap filled black color with alpha $01 - if (FAutoHiden and FAutoHideTransparency) + const AScreenEdge: TScreenAlign; const ABitmap: THBitmap); +var w, h, c1gw, c2gw, wh: Integer; + Pt1, Pt2: TPoint; + Sz: TSize; + drawer: IGPGraphics; + r: TGPRect; + bmp: THBitmap; + dc: HDC; + p: Pointer; +begin + w := ABounds.Width; + h := ABounds.Height; + + // Draw + if (FAutoHiden) then begin - Pt1 := ABounds.Location; - Pt2 := Point(0,0); + // Hidden - bmp := TBitmap.Create; - bmp.PixelFormat := pf32bit; - bmp.Canvas.Brush.Style := bsClear; - bmp.SetSize(ABounds.Width, ABounds.Height); - gpDrawer := bmp.ToGPGraphics; - gpDrawer.Clear( $01000000 ); + // Check corner gaps width + c1gw := FCorner1GapWidth; + c2gw := FCorner2GapWidth; + if (c1gw > 0) or (c2gw > 0) + then begin + if ScreenAlign in [saLeft, saRight] + then wh := h + else wh := w; + if (c1gw > wh - c2gw) + then begin + c1gw := 0; + c2gw := 0; + end; + end; - Sz := TSize.Create(ABounds.Width, ABounds.Height); + if (FAutoHideTransparency) + then begin + // and Transparency + Pt1 := ABounds.TopLeft; + Sz := TSize.Create(w, h); + Pt2 := Point(0,0); - UpdateLayeredWindow(AWnd, 0, @Pt1, @Sz, - bmp.Canvas.Handle, @Pt2, 0, @bf, ULW_ALPHA); + bmp := THBitmap.Create(32); + bmp.SetSize(w, h); + dc := bmp.Dc; - bmp.Free; + drawer := TGPGraphics.FromHDC(dc); + if (c1gw > 0) or (c2gw > 0) + then begin + if ScreenAlign in [saLeft, saRight] + then r := TGPRect.Create(0, c1gw, w, h - c1gw - c2gw) + else r := TGPRect.Create(c1gw, 0, w - c1gw - c2gw, h); + drawer.SetClip(r); + end; + drawer.Clear($01000000); + + UpdateLayeredWindow(AWnd, 0, @Pt1, @Sz, dc, @Pt2, 0, @bf, ULW_ALPHA); + bmp.Free; + end + else begin + // and Opaque + if (c1gw > 0) or (c2gw > 0) + then begin + // w/ gaps + Pt1 := ABounds.TopLeft; + Sz := TSize.Create(w, h); + case AScreenEdge of + saLeft: Pt2 := Point(ABitmap.Width - w, 0); + saTop: Pt2 := Point(0, ABitmap.Height - h); + saRight: Pt2 := Point(0, 0); + saBottom: Pt2 := Point(0, 0); + end; + + bmp := THBitmap.Create(32); + bmp.SetSize(w, h); + dc := bmp.Dc; + + if ScreenAlign in [saLeft, saRight] + then BitBlt(dc, 0, c1gw, w, h - c1gw - c2gw, ABitmap.Dc, Pt2.X, c1gw, SRCCOPY) + else BitBlt(dc, c1gw, 0, w - c1gw - c2gw, h, ABitmap.Dc, c1gw, Pt2.Y, SRCCOPY); + + Pt2 := Point(0,0); + UpdateLayeredWindow(AWnd, 0, @Pt1, @Sz, dc, @Pt2, 0, @bf, ULW_ALPHA); + bmp.Free; + end + else begin + // w/o gaps + Pt1 := ABounds.TopLeft; + Sz := TSize.Create(w, h); + case AScreenEdge of + saLeft: Pt2 := Point(ABitmap.Width - w, 0); + saTop: Pt2 := Point(0, ABitmap.Height - h); + saRight: Pt2 := Point(0, 0); + saBottom: Pt2 := Point(0, 0); + end; + UpdateLayeredWindow(AWnd, 0, @Pt1, @Sz, ABitmap.Dc, @Pt2, 0, @bf, ULW_ALPHA); + end; + end; end else begin - Pt1 := ABounds.Location; - + // Not Hidden + if (ABounds = BoundsRect) + then p := nil + else p := @ABounds.TopLeft; + Sz := TSize.Create(w, h); case AScreenEdge of - saLeft: Pt2 := Point(ABitmap.Width - ABounds.Width, 0); - saTop: Pt2 := Point(0, ABitmap.Height - ABounds.Height); + saLeft: Pt2 := Point(ABitmap.Width - w, 0); + saTop: Pt2 := Point(0, ABitmap.Height - h); saRight: Pt2 := Point(0, 0); saBottom: Pt2 := Point(0, 0); end; - Sz := TSize.Create(ABounds.Width, ABounds.Height); - - UpdateLayeredWindow(AWnd, 0, @Pt1, @Sz, - ABitmap.Canvas.Handle, @Pt2, 0, @bf, ULW_ALPHA); {} + UpdateLayeredWindow(AWnd, 0, p, @Sz, ABitmap.Dc, @Pt2, 0, @bf, ULW_ALPHA); end; end; procedure TLinkbarWcl.UpdateBlur; +var blurEnabled: Boolean; begin - ThemeUpdateBlur(Handle, not (FAutoHiden and FAutoHideTransparency) ); -end; - -procedure TLinkbarWcl.LoadProperties(const AFileName: string); -var IniFile: TMemIniFile; -begin - if FileExists(AFileName) then - begin // Load values - IniFile := TMemIniFile.Create(AFileName); - try - WorkDir := IniFile.ReadString(INI_SECTION_MAIN, INI_DIR_LINKS, DEF_DIR_LINKS); - - FMonitorNum := IniFile.ReadInteger(INI_SECTION_MAIN, INI_MONITORNUM, -1); - FScreenEdge := TScreenAlign(IniFile.ReadInteger(INI_SECTION_MAIN, INI_EDGE, DEF_EDGE)); - FAutoHide := IniFile.ReadBool(INI_SECTION_MAIN, INI_AUTOHIDE, DEF_AUTOHIDE); - FAutoHideTransparency := IniFile.ReadBool(INI_SECTION_MAIN, INI_AUTOHIDE_TRANSPARENCY, - DEF_AUTOHIDE_TRANSPARENCY); - FAutoShowMode := TAutoShowMode(IniFile.ReadInteger(INI_SECTION_MAIN, INI_AUTOHIDE_SHOWMODE, - DEF_AUTOHIDE_SHOWMODE)); - FHotkeyInfo.Create( IniFile.ReadString(INI_SECTION_MAIN, INI_AUTOHIDE_HOTKEY, DEF_AUTOHIDE_HOTKEY) ); - FIconSize := IniFile.ReadInteger(INI_SECTION_MAIN, INI_ICON_SIZE, DEF_ICON_SIZE); - FItemMargin.cx := IniFile.ReadInteger(INI_SECTION_MAIN, INI_MARGINX, DEF_MARGINX); - FItemMargin.cy := IniFile.ReadInteger(INI_SECTION_MAIN, INI_MARGINY, DEF_MARGINY); - - FTextLayout := TTextLayout(IniFile.ReadInteger(INI_SECTION_MAIN, INI_TEXT_LAYOUT, DEF_TEXT_LAYOUT)); - FTextOffset := IniFile.ReadInteger(INI_SECTION_MAIN, INI_TEXT_OFFSET, DEF_TEXT_OFFSET); - FTextWidth := IniFile.ReadInteger(INI_SECTION_MAIN, INI_TEXT_WIDTH, DEF_TEXT_WIDTH); - - FItemOrder := TItemOrder(IniFile.ReadInteger(INI_SECTION_MAIN, INI_ITEM_ORDER, DEF_ITEM_ORDER)); - FLockLinkbar := IniFile.ReadBool(INI_SECTION_MAIN, INI_LOCK_BAR, DEF_LOCK_BAR); - - FIsLightStyle := IniFile.ReadBool(INI_SECTION_MAIN, INI_ISLIGHT, DEF_ISLIGHT); - FEnableAeroGlass := IniFile.ReadBool(INI_SECTION_MAIN, INI_ENABLE_AG, DEF_ENABLE_AG); - - FAutoShowDelay := IniFile.ReadInteger(INI_SECTION_MAIN, INI_AUTOSHOW_DELAY, DEF_AUTOSHOW_DELAY); - FSortAlphabetically := IniFile.ReadBool(INI_SECTION_MAIN, INI_SORT_AB, DEF_SORT_AB); - - FUseBkgColor := IniFile.ReadBool(INI_SECTION_MAIN, INI_USEBKGCOLOR, DEF_USECOLOR); - FBkgColor := IniFile.ReadInteger(INI_SECTION_MAIN, INI_BKGCOLOR, DEF_BKGCOLOR); - FUseTxtColor := IniFile.ReadBool(INI_SECTION_MAIN, INI_USETXTCOLOR, DEF_USECOLOR); - FTxtColor := IniFile.ReadInteger(INI_SECTION_MAIN, INI_TXTCOLOR, DEF_TXTCOLOR); - - FGlowSize := IniFile.ReadInteger(INI_SECTION_MAIN, INI_GLOWSIZE, DEF_GLOWSIZE); - - FHintShow := IniFile.ReadBool(INI_SECTION_DEV, INI_HINT_SHOW, DEF_HINT_SHOW); - StayOnTop := IniFile.ReadBool(INI_SECTION_MAIN, INI_STAYONTOP, DEF_STAYONTOP); - FJumplistShowMode := TJumplistShowMode(IniFile.ReadInteger(INI_SECTION_MAIN, INI_JUMPLISTSHOWMODE, DEF_JUMPLISTSHOWMODE)); - finally - IniFile.Free; - end; + if IsWindows10 + then begin + if (FAutoHiden and FAutoHideTransparency) + then ThemeSetWindowAccentPolicy10(Handle, lmDisabled, 0) + else ThemeSetWindowAccentPolicy10(Handle, FLookMode, BackgroundColor); end - else begin // Default values - FMonitorNum := Screen.PrimaryMonitor.MonitorNum; - FScreenEdge := TScreenAlign(DEF_EDGE); - FAutoHide := DEF_AUTOHIDE; - FAutoHideTransparency := DEF_AUTOHIDE_TRANSPARENCY; - FAutoShowMode := TAutoShowMode(DEF_AUTOHIDE_SHOWMODE); - FHotkeyInfo.Create(DEF_AUTOHIDE_HOTKEY); - FIconSize := DEF_ICON_SIZE; - FItemMargin := TSize.Create(DEF_MARGINX, DEF_MARGINY); - - FTextLayout := TTextLayout(DEF_TEXT_LAYOUT); - FTextOffset := DEF_TEXT_OFFSET; - FTextWidth := DEF_TEXT_WIDTH; - - FItemOrder := TItemOrder(DEF_ITEM_ORDER); - FLockLinkbar := DEF_LOCK_BAR; - - FIsLightStyle := DEF_ISLIGHT; - FEnableAeroGlass := DEF_ENABLE_AG; - - FGlowSize := DEF_GLOWSIZE; - - FHintShow := DEF_HINT_SHOW; - - FAutoShowDelay := DEF_AUTOSHOW_DELAY; - FSortAlphabetically := DEF_SORT_AB; - StayOnTop := DEF_STAYONTOP; - FJumplistShowMode := TJumplistShowMode(DEF_JUMPLISTSHOWMODE); + else begin + blurEnabled := not (FAutoHiden and FAutoHideTransparency); + if (IsWindows8And8Dot1 and not FEnableAeroGlass) + then blurEnabled := False; + ThemeUpdateBlur(Handle, blurEnabled); end; +end; - { Check values } - // Autohide mode - if ( FAutoShowMode < Low(TAutoShowMode) ) or ( FAutoShowMode > High(TAutoShowMode) ) - then FAutoShowMode := TAutoShowMode(DEF_AUTOHIDE_SHOWMODE); - // Monitor number - if not InRange(FMonitorNum, 0, Screen.MonitorCount-1) - then FMonitorNum := Screen.PrimaryMonitor.MonitorNum; - // Screen edge - if ( FScreenEdge < Low(TScreenAlign) ) or ( FScreenEdge > High(TScreenAlign) ) - then FScreenEdge := TScreenAlign(DEF_EDGE); - // Jumplists - if ( FJumplistShowMode < Low(TJumplistShowMode) ) or ( FJumplistShowMode > High(TJumplistShowMode) ) - then FJumplistShowMode := TJumplistShowMode(DEF_JUMPLISTSHOWMODE); - - FIconSize := EnsureRange(FIconSize, ICON_SIZE_MIN, ICON_SIZE_MAX); - FItemMargin.cx := EnsureRange(FItemMargin.cx, MARGIN_MIN, MARGIN_MAX); - FItemMargin.cy := EnsureRange(FItemMargin.cy, MARGIN_MIN, MARGIN_MAX); - // Text layout - if ( FTextLayout < Low(TTextLayout) ) or ( FTextLayout > High(TTextLayout) ) - then FTextLayout := TTextLayout(DEF_TEXT_LAYOUT); - - FTextOffset := EnsureRange(FTextOffset, TEXT_OFFSET_MIN, TEXT_OFFSET_MAX); - FTextWidth := EnsureRange(FTextWidth, TEXT_WIDTH_MIN, TEXT_WIDTH_MAX); - - if ( FItemOrder < Low(TItemOrder) ) or ( FItemOrder > High(TItemOrder) ) - then FItemOrder := TItemOrder(DEF_ITEM_ORDER); - - if (FAutoShowDelay < 0) then FAutoShowDelay := 0; - - FGlowSize := EnsureRange(FGlowSize, GLOW_SIZE_MIN, GLOW_SIZE_MAX); - - { Set other values } +{ Load settings from file } +procedure TLinkbarWcl.LoadSettings; +var settings: TSettings; + hki: THotkeyInfo; +begin + settings.Open(FSettingsFileName); + // Read + WorkDir := settings.Read(INI_DIR_LINKS, DEF_DIR_LINKS); + FAutoHide := settings.Read(INI_AUTOHIDE, DEF_AUTOHIDE); + FAutoHideTransparency := settings.Read(INI_AUTOHIDE_TRANSPARENCY, DEF_AUTOHIDE_TRANSPARENCY); + FAutoShowDelay := settings.Read(INI_AUTOSHOW_DELAY, DEF_AUTOSHOW_DELAY, 0, 60000); + FAutoShowMode := settings.Read(INI_AUTOHIDE_SHOWMODE, DEF_AUTOHIDE_SHOWMODE); + FBackgroundColor := Cardinal(settings.Read(INI_BKGCOLOR, DEF_BKGCOLOR)); + FCorner1GapWidth := settings.Read(INI_CORNER1GAP_WIDTH, DEF_CORNERGAP_WIDTH); + FCorner2GapWidth := settings.Read(INI_CORNER2GAP_WIDTH, DEF_CORNERGAP_WIDTH); + FEnableAeroGlass := settings.Read(INI_ENABLE_AG, DEF_ENABLE_AG); + FGlowSize := settings.Read(INI_GLOWSIZE, DEF_GLOWSIZE, GLOW_SIZE_MIN, GLOW_SIZE_MAX); + FHintShow := True; + hki := settings.Read(INI_AUTOHIDE_HOTKEY, DEF_AUTOHIDE_HOTKEY); + FIconSize := settings.Read(INI_ICON_SIZE, DEF_ICON_SIZE, ICON_SIZE_MIN, ICON_SIZE_MAX); + FIsLightStyle := settings.Read(INI_ISLIGHT, DEF_ISLIGHT); + FItemMargin.cx := settings.Read(INI_MARGINX, DEF_MARGINX, MARGIN_MIN, MARGIN_MAX); + FItemMargin.cy := settings.Read(INI_MARGINY, DEF_MARGINY, MARGIN_MIN, MARGIN_MAX); + FItemOrder := settings.Read(INI_ITEM_ORDER, DEF_ITEM_ORDER); + FJumplistRecentMax := settings.Read(INI_JUMPLIST_RECENTMAX, DEF_JUMPLIST_RECENTMAX, JUMPLIST_RECENTMAX_MIN, JUMPLIST_RECENTMAX_MAX); + FJumplistShowMode := settings.Read(INI_JUMPLIST_SHOWMODE, DEF_JUMPLIST_SHOWMODE); + FLockLinkbar := settings.Read(INI_LOCK_BAR, DEF_LOCK_BAR); + FLookMode := settings.Read(INI_LOOKMODE, DEF_LOOKMODE); + FMonitorNum := settings.Read(INI_MONITORNUM, Screen.PrimaryMonitor.MonitorNum, 0, Screen.MonitorCount-1); + FScreenEdge := settings.Read(INI_EDGE, DEF_EDGE); + FSortAlphabetically := settings.Read(INI_SORT_AB, DEF_SORT_AB); + FTextColor := Cardinal(settings.Read(INI_TXTCOLOR, DEF_TXTCOLOR) and $ffffff); + FTextLayout := settings.Read(INI_TEXT_LAYOUT, DEF_TEXT_LAYOUT); + FTextOffset := settings.Read(INI_TEXT_OFFSET, DEF_TEXT_OFFSET, TEXT_OFFSET_MIN, TEXT_OFFSET_MAX); + FTextWidth := settings.Read(INI_TEXT_WIDTH, DEF_TEXT_WIDTH, TEXT_WIDTH_MIN, TEXT_WIDTH_MAX); + FUseBkgndColor := settings.Read(INI_USEBKGCOLOR, DEF_USEBKGCOLOR); + FUseTextColor := settings.Read(INI_USETXTCOLOR, DEF_USETXTCOLOR); + FStayOnTop := FormStyle = fsStayOnTop; + StayOnTop := settings.Read(INI_STAYONTOP, DEF_STAYONTOP); + // + settings.Close; + + // Set other values FGripSize := GRIP_SIZE; FHotIndex := ITEM_NONE; - FItemPressed := ITEM_NONE; + FPressedIndex := ITEM_NONE; FItemDropPosition := ITEM_NONE; FItemPopup := ITEM_NONE; FDragIndex := ITEM_NONE; @@ -829,86 +831,69 @@ procedure TLinkbarWcl.LoadProperties(const AFileName: string); ExpAeroGlassEnabled := FEnableAeroGlass; // Register Hotkey - if (AutoHide) - then RegisterHotkeyNotify(Handle, FHotkeyInfo); + HotkeyInfo := hki; end; -procedure TLinkbarWcl.SaveProperties; -var IniFile: TMemIniFile; - sl: TStringList; +procedure TLinkbarWcl.SaveLinks; +var sl: TStringList; i: integer; - sv: Boolean; begin - try - if DirectoryExists(WorkDir) - then sv := True - else sv := ForceDirectories(WorkDir); - - if sv - then begin - sl := TStringList.Create; - try - for i := 0 to Items.Count-1 do - sl.Add( ExtractFileName(Items[i].FileName) ); - sl.SaveToFile(WorkDir + LINKSLIST_FILE_NAME, TEncoding.UTF8); - finally - sl.Free; - end; + if DirectoryExists(WorkDir) + or ForceDirectories(WorkDir) + then begin + sl := TStringList.Create; + try + for i := 0 to Items.Count-1 do + sl.Add( ExtractFileName(Items[i].FileName) ); + sl.SaveToFile(WorkDir + LINKSLIST_FILE_NAME, TEncoding.UTF8); + finally + sl.Free; end; + end; +end; - if DirectoryExists(ExtractFilePath(FPreferencesFileName)) - then sv := True - else sv := ForceDirectories(ExtractFilePath(FPreferencesFileName)); - - if sv - then begin - IniFile := TMemIniFile.Create(FPreferencesFileName); - try - IniFile.WriteInteger(INI_SECTION_MAIN, INI_MONITORNUM, FMonitorNum); - i := Integer(ScreenAlign); - IniFile.WriteInteger(INI_SECTION_MAIN, INI_EDGE, i); - IniFile.WriteBool(INI_SECTION_MAIN, INI_AUTOHIDE, AutoHide); - IniFile.WriteBool(INI_SECTION_MAIN, INI_AUTOHIDE_TRANSPARENCY, FAutoHideTransparency); - IniFile.WriteInteger(INI_SECTION_MAIN, INI_AUTOHIDE_SHOWMODE, Integer(AutoShowMode)); - IniFile.WriteString(INI_SECTION_MAIN, INI_AUTOHIDE_HOTKEY, HotkeyInfo); - - IniFile.WriteInteger(INI_SECTION_MAIN, INI_ICON_SIZE, IconSize); - IniFile.WriteInteger(INI_SECTION_MAIN, INI_MARGINX, ItemMargin.cx); - IniFile.WriteInteger(INI_SECTION_MAIN, INI_MARGINY, ItemMargin.cy); - - IniFile.WriteInteger(INI_SECTION_MAIN, INI_TEXT_LAYOUT, Integer(TextLayout)); - IniFile.WriteInteger(INI_SECTION_MAIN, INI_TEXT_OFFSET, TextOffset); - IniFile.WriteInteger(INI_SECTION_MAIN, INI_TEXT_WIDTH, TextWidth); - - IniFile.WriteInteger(INI_SECTION_MAIN, INI_ITEM_ORDER, Integer(ItemOrder)); - IniFile.WriteBool(INI_SECTION_MAIN, INI_LOCK_BAR, FLockLinkbar); - - IniFile.WriteBool(INI_SECTION_MAIN, INI_ISLIGHT, FIsLightStyle); - IniFile.WriteBool(INI_SECTION_MAIN, INI_ENABLE_AG, FEnableAeroGlass); - // Dev don't save - //IniFile.WriteBool(INI_DEV, INI_HINT_SHOW, HintShow); - - IniFile.WriteInteger(INI_SECTION_MAIN, INI_AUTOSHOW_DELAY, FAutoShowDelay); - IniFile.WriteBool(INI_SECTION_MAIN, INI_SORT_AB, FSortAlphabetically); - - // Custom background and text colors - IniFile.WriteBool(INI_SECTION_MAIN, INI_USEBKGCOLOR, FUseBkgColor); - IniFile.WriteString(INI_SECTION_MAIN, INI_BKGCOLOR, HexDisplayPrefix + IntToHex(FBkgColor, 8)); - IniFile.WriteBool(INI_SECTION_MAIN, INI_USETXTCOLOR, FUseTxtColor); - IniFile.WriteString(INI_SECTION_MAIN, INI_TXTCOLOR, HexDisplayPrefix + IntToHex(FTxtColor, 6)); - - IniFile.WriteInteger(INI_SECTION_MAIN, INI_GLOWSIZE, FGlowSize); - - IniFile.WriteBool(INI_SECTION_MAIN, INI_STAYONTOP, FStayOnTop); - // Jumplists - IniFile.WriteInteger(INI_SECTION_MAIN, INI_JUMPLISTSHOWMODE, Integer(JumplistShowMode)); - - IniFile.UpdateFile; - finally - IniFile.Free; - end; - end; - except +procedure TLinkbarWcl.SaveSettings; +var path: string; + settings: TSettings; +begin + path := ExtractFilePath(FSettingsFileName); + if DirectoryExists(path) + or ForceDirectories(path) + then begin + settings.Open(FSettingsFileName); + // Write + settings.Write(INI_MONITORNUM, FMonitorNum); + settings.Write(INI_EDGE, Integer(ScreenAlign)); + settings.Write(INI_AUTOHIDE, AutoHide); + settings.Write(INI_AUTOHIDE_TRANSPARENCY, FAutoHideTransparency); + settings.Write(INI_AUTOHIDE_SHOWMODE, Integer(AutoShowMode)); + settings.Write(INI_AUTOHIDE_HOTKEY, String(HotkeyInfo)); + settings.Write(INI_ICON_SIZE, IconSize); + settings.Write(INI_MARGINX, ItemMargin.cx); + settings.Write(INI_MARGINY, ItemMargin.cy); + settings.Write(INI_TEXT_LAYOUT, Integer(TextLayout)); + settings.Write(INI_TEXT_OFFSET, TextOffset); + settings.Write(INI_TEXT_WIDTH, TextWidth); + settings.Write(INI_ITEM_ORDER, Integer(ItemOrder)); + settings.Write(INI_LOCK_BAR, FLockLinkbar); + settings.Write(INI_ISLIGHT, FIsLightStyle); + settings.Write(INI_ENABLE_AG, FEnableAeroGlass); + settings.Write(INI_AUTOSHOW_DELAY, FAutoShowDelay); + settings.Write(INI_SORT_AB, FSortAlphabetically); + settings.Write(INI_USEBKGCOLOR, FUseBkgndColor); + settings.Write(INI_BKGCOLOR, HexDisplayPrefix + IntToHex(BackgroundColor, 8)); + settings.Write(INI_USETXTCOLOR, FUseTextColor); + settings.Write(INI_TXTCOLOR, HexDisplayPrefix + IntToHex(FTextColor, 6)); + settings.Write(INI_GLOWSIZE, FGlowSize); + settings.Write(INI_STAYONTOP, FStayOnTop); + settings.Write(INI_JUMPLIST_SHOWMODE, Integer(JumplistShowMode)); + settings.Write(INI_JUMPLIST_RECENTMAX, JumplistRecentMax); + settings.Write(INI_LOOKMODE, Integer(FLookMode)); + settings.Write(INI_CORNER1GAP_WIDTH, FCorner1GapWidth); + settings.Write(INI_CORNER2GAP_WIDTH, FCorner2GapWidth); + // Save + settings.Update; + settings.Close; end; end; @@ -929,20 +914,29 @@ procedure TLinkbarWcl.CreateWnd; procedure TLinkbarWcl.FormCreate(Sender: TObject); begin + FCreated := False; + CreateBitmaps; + + Self.DesktopFont := True; + L10n; + oHint := TTooltip32.Create(Handle); pMenu.Items.RethinkHotkeys; Color := 0; - FrmProperties := nil; FLockAutoHide := False; FCanAutoHide := True; - LoadProperties(FPreferencesFileName); + LoadSettings; - ThemeSetWindowAttribute(Handle); + UpdateBackgroundColor; + + if IsWindows10 + then ThemeSetWindowAttribute10(Handle, FLookMode, BackgroundColor) + else ThemeSetWindowAttribute78(Handle); ThemeInitData(Handle, FIsLightStyle); @@ -960,7 +954,13 @@ procedure TLinkbarWcl.FormCreate(Sender: TObject); if not AutoHide then oAppBar.Loaded else AutoHide := TRUE; - BitBucketNotify := RegisterBitBucketNotify(Handle, WM_LB_SHELLNOTIFY); + BitBucketNotify := RegisterBitBucketNotify(Handle, LM_SHELLNOTIFY); + + FCreated := True; + + UpdateBlur; + + DoDelayedAutoHide(1000); end; procedure TLinkbarWcl.L10n; @@ -978,7 +978,7 @@ procedure TLinkbarWcl.L10n; procedure TLinkbarWcl.FormDestroy(Sender: TObject); begin - DeregisterBitBucketNotify(BitBucketNotify); + UnregisterBitBucketNotify(BitBucketNotify); UnregisterHotkeyNotify(Handle); if Assigned(FrmProperties) @@ -988,7 +988,7 @@ procedure TLinkbarWcl.FormDestroy(Sender: TObject); StopDirWatch; if (not FRemoved) - then SaveProperties; + then SaveLinks; ThemeCloseData; @@ -1000,6 +1000,14 @@ procedure TLinkbarWcl.FormDestroy(Sender: TObject); if Assigned(Items) then Items.Free; end; +procedure TLinkbarWcl.CreateBitmaps; +begin + CBmpSelectedItem := THBitmap.Create(32); + CBmpDropPosition := THBitmap.Create(32); + BmpBtn := THBitmap.Create(32); + BmpMain := THBitmap.Create(32); +end; + function TLinkbarWcl.IsItemIndex(const AIndex: Integer): Boolean; begin Result := (AIndex >= 0) and (AIndex < Items.Count); @@ -1007,9 +1015,12 @@ function TLinkbarWcl.IsItemIndex(const AIndex: Integer): Boolean; procedure TLinkbarWcl.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin -{$IFNDEF DEBUG} - //if (Shift <> []) then Exit; -{$ENDIF} + if AutoHide + and FAutoHiden + then begin + Key := 0; + Exit; + end; if (Items.Count = 0) then Exit; @@ -1025,7 +1036,12 @@ procedure TLinkbarWcl.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftS end; VK_ESCAPE: // Deselect begin - HotIndex := ITEM_NONE; + if (HotIndex = ITEM_NONE) + then begin + FCanAutoHide := True; + DoAutoHide; + end + else HotIndex := ITEM_NONE; Exit; end; VK_F2: // Rename @@ -1046,6 +1062,11 @@ procedure TLinkbarWcl.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftS end; Exit; end; + VK_TAB: + begin + HotIndex := HotIndex + 1; + Exit; + end; // Arrows VK_LEFT, VK_RIGHT, VK_DOWN, VK_UP: begin @@ -1122,12 +1143,10 @@ procedure TLinkbarWcl.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftS procedure TLinkbarWcl.CMDialogKey(var Msg: TCMDialogKey); begin + // If you do not return 0 then VK_TAB will not pass into FormKeyDown if (Msg.CharCode = VK_TAB) - then begin - HotIndex := HotIndex + 1; - Exit; - end; - inherited; + then Msg.Result := 0 + else inherited; end; function TLinkbarWcl.ItemIndexByPoint(const APt: TPoint; @@ -1164,6 +1183,7 @@ procedure TLinkbarWcl.FormMouseDown(Sender: TObject; Button: TMouseButton; mbLeft: begin FMouseLeftDown := True; + FLockHotIndex := False; PressedIndex := ItemIndexByPoint( Point(X, Y) ); end else Exit; @@ -1204,9 +1224,9 @@ procedure TLinkbarWcl.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: I end else if (not FLockLinkbar) then begin - if (FItemPressed = ITEM_NONE) + if (FPressedIndex = ITEM_NONE) then begin - if ( TPoint.Create(X,Y).Distance(FMousePosDown) > MOUSE_THRESHOLD ) + if ( TPoint.Create(X,Y).Distance(FMousePosDown) > PANEL_DRAG_THRESHOLD ) then begin FMouseDragLinkbar := True; FMouseDragItem := False; @@ -1218,13 +1238,12 @@ procedure TLinkbarWcl.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: I else begin // If cursor leave item rect then start DragItem // This is done by MS for TaskBand items - if ( not PtInRect(Items[FItemPressed].Rect, TPoint.Create(X, Y)) ) + if ( not PtInRect(Items[FPressedIndex].Rect, TPoint.Create(X, Y)) ) then begin FMouseDragItem := True; FMouseDragLinkbar := False; end; end; - end; end; end; @@ -1238,13 +1257,16 @@ procedure TLinkbarWcl.FormMouseUp(Sender: TObject; Button: TMouseButton; or ( (AutoShowMode = smMouseClickRight) and (Button = mbRight) ) then begin - if PtInRect(Rect(0,0,Width,Height), Point(X, Y)) - then DoAutoShow; + then begin + FCanAutoHide := False; + DoAutoShow; + end; end; Exit; end; + FCanAutoHide := False; FMousePosUp := Point(X, Y); case Button of mbLeft: @@ -1256,6 +1278,7 @@ procedure TLinkbarWcl.FormMouseUp(Sender: TObject; Button: TMouseButton; FMouseDragLinkbar := False; FMonitorNum := FDragMonitorNum; ScreenAlign := FDragScreenEdge; + TSettings.Write(FSettingsFileName, INI_EDGE, Integer(FScreenEdge)); end else if FMouseDragItem then begin // drag item end @@ -1391,6 +1414,17 @@ procedure TLinkbarWcl.DoDragLinkbar(X, Y: Integer); QuerySizedEvent(nil, r.Left, r.Top, r.Width, r.Height); end; +// Macros from windowsx.h: +// Important Do not use the LOWORD or HIWORD macros to extract the x- and y- +// coordinates of the cursor position because these macros return incorrect results +// on systems with multiple monitors. Systems with multiple monitors can have +// negative x- and y- coordinates, and LOWORD and HIWORD treat the coordinates +// as unsigned quantities. +function MakePoint(const L: DWORD): TPoint; inline; +Begin + Result := TPoint.Create(SmallInt(L and $FFFF), SmallInt(L shr 16)); +End; + procedure TLinkbarWcl.DoPopupMenu(APt: TPoint; AShift: Boolean); var FPopupMenu: HMENU; @@ -1450,7 +1484,7 @@ procedure TLinkbarWcl.DoPopupMenu(APt: TPoint; AShift: Boolean); then SetMenuItemInfo(FPopupMenu, imCloseAll.Command, False, mii) else SetMenuItemInfo(FPopupMenu, imClose.Command, False, mii); - { Set icon for "New shortcut" menu item } + // Set icon for "New shortcut" menu item iconsize := GetSystemMetrics(SM_CXSMICON); hIco := LoadImage(GetModuleHandle('shell32.dll'), MakeIntResource(16769), IMAGE_ICON, iconsize, iconsize, LR_DEFAULTCOLOR); @@ -1461,7 +1495,6 @@ procedure TLinkbarWcl.DoPopupMenu(APt: TPoint; AShift: Boolean); mii.fMask := MIIM_BITMAP; mii.hbmpItem := hBmp; SetMenuItemInfo(FPopupMenu, imNewShortcut.Command, False, mii); - {} FillChar(mi, SizeOf(mi), 0); mi.cbSize := SizeOf(mi); @@ -1482,7 +1515,7 @@ procedure TLinkbarWcl.DoPopupMenu(APt: TPoint; AShift: Boolean); or TPM_NONOTIFY, APt.X, APt.Y, Handle, nil); DestroyMenu(FPopupMenu); if (command) - then PostMessage(Handle, SCMI_LB_ITEMS, 0, Integer(command)); + then PostMessage(Handle, LM_CM_ITEMS, 0, Integer(command)); end else begin // Execute Shell context menu + Linkbar context menu as submenu @@ -1491,8 +1524,11 @@ procedure TLinkbarWcl.DoPopupMenu(APt: TPoint; AShift: Boolean); end; finally FLockHotIndex := False; + if (WindowFromPoint(MakePoint(GetMessagePos)) <> Handle) + then begin + HotIndex := ITEM_NONE; + end; FLockAutoHide := False; - HotIndex := ITEM_NONE; end; DeleteObject(hBmp); @@ -1500,32 +1536,31 @@ procedure TLinkbarWcl.DoPopupMenu(APt: TPoint; AShift: Boolean); procedure TLinkbarWcl.OnFormJumplistDestroy(Sender: TObject); begin - FLockHotIndex := False; - HotIndex := ITEM_NONE; - FLockAutoHide := False; - DoAutoHide; + if (not (csDestroying in Self.ComponentState)) + then begin + FLockHotIndex := False; + if (WindowFromPoint(MakePoint(GetMessagePos)) <> Handle) + then begin + HotIndex := ITEM_NONE; + end; + FLockAutoHide := False; + FCanAutoHide := True; + DoAutoHide; + end; end; procedure TLinkbarWcl.DoPopupJumplist(APt: TPoint; AShift: Boolean); -const JUMPLIST_ALIGN: array[TScreenAlign] of TJumplistAlign = (jaLeft, jaTop, jaRight, jaBottom); var item: TLbItem; - appid: array[0..MAX_PATH] of Char; pt: TPoint; r: TRect; - fjl: TFormJumpList; - maxcount: Integer; + form: TFormJumpList; begin if (FJumplistShowMode <> jsmDisabled) then begin item := Items[FItemPopup]; - - { Check and show Jumplist } - maxcount := GetJumpListMaxCount; - if (maxcount > 0) - and GetAppInfoForLink(item.Pidl, appid) - and HasJumpList(appid) + form := TryCreateJumplist(Self, item.Pidl, FJumplistRecentMax); + if Assigned(form) then begin - oHint.Cancel; r := item.Rect; case ScreenAlign of saLeft: pt := Point(r.Right, r.Bottom); @@ -1534,11 +1569,11 @@ procedure TLinkbarWcl.DoPopupJumplist(APt: TPoint; AShift: Boolean); saBottom: pt := Point(r.CenterPoint.X, r.Top); end; MapWindowPoints(Handle, 0, pt, 1); - fjl := TFormJumpList.CreateNew(Self); - fjl.OnDestroy := OnFormJumplistDestroy; - if fjl.Popup(Handle, pt.X, pt.Y, JUMPLIST_ALIGN[ScreenAlign], appid, - item.Pidl, maxcount) + + if form.Popup(Handle, pt, ScreenAlign) then begin + oHint.Cancel; + form.OnDestroy := OnFormJumplistDestroy; FLockHotIndex := True; FLockAutoHide := True; Exit; @@ -1571,6 +1606,8 @@ procedure TLinkbarWcl.FormContextPopup(Sender: TObject; MousePos: TPoint; else FItemPopup := ItemIndexByPoint(pt); + HotIndex := FItemPopup; + shift := GetKeyState(VK_SHIFT) < 0; if (FItemPopup = ITEM_NONE) @@ -1597,12 +1634,13 @@ procedure TLinkbarWcl.UpdateItemSizes; var r: TRect; w, h: Integer; + textHeight: Integer; begin // Calc text height + Canvas.Font := Screen.IconFont; if TextLayout = tlNone - then FTextHeight := 0 - else FTextHeight := DrawText(Canvas.Handle, 'Wp', 2, r, DT_SINGLELINE or DT_NOCLIP or DT_CALCRECT); - Inc(FTextHeight, 2*TEXT_BORDER); + then textHeight := 0 + else textHeight := DrawText(Canvas.Handle, 'Wp', 2, r, DT_SINGLELINE or DT_NOCLIP or DT_CALCRECT); // Calc margin, icon offset & button size case TextLayout of @@ -1610,7 +1648,7 @@ procedure TLinkbarWcl.UpdateItemSizes; begin // button size w := FItemMargin.cx + FIconSize + FTextOffset + FTextWidth + FItemMargin.cx; - h := FItemMargin.cy + Max(FIconSize, FTextHeight) + FItemMargin.cy; + h := FItemMargin.cy + Max(FIconSize, textHeight) + FItemMargin.cy; // icon offset if TextLayout = tlRight then FIconOffset.X := FItemMargin.cx @@ -1619,26 +1657,26 @@ procedure TLinkbarWcl.UpdateItemSizes; // text rect if TextLayout = tlRight then FTextRect := Bounds( FItemMargin.cx + FIconSize + FTextOffset, - (h - FTextHeight) div 2, FTextWidth, FTextHeight ) - else FTextRect := Bounds( FItemMargin.cx, (h - FTextHeight) div 2, - FTextWidth, FTextHeight ); + (h - textHeight) div 2, FTextWidth, textHeight ) + else FTextRect := Bounds( FItemMargin.cx, (h - textHeight) div 2, + FTextWidth, textHeight ); end; tlTop, tlBottom: begin // button size w := FItemMargin.cx + Max(FIconSize, FTextWidth) + FItemMargin.cx; - h := FItemMargin.cy + FIconSize + FTextOffset + FTextHeight + FItemMargin.cy; + h := FItemMargin.cy + FIconSize + FTextOffset + textHeight + FItemMargin.cy; // icon offset FIconOffset.X := (w - FIconSize) div 2; if textlayout = tlBottom then FIconOffset.Y := FItemMargin.cy - else FIconOffset.Y := FItemMargin.cy + FTextHeight + FTextOffset; + else FIconOffset.Y := FItemMargin.cy + textHeight + FTextOffset; // text rect if textlayout = tlBottom then FTextRect := Bounds( FTextOffset, FItemMargin.cy + FIconSize + FTextOffset, - w - 2*FTextOffset, FTextHeight ) + w - 2*FTextOffset, textHeight ) else FTextRect := Bounds( FTextOffset, FItemMargin.cy, - w - 2*FTextOffset, FTextHeight ); + w - 2*FTextOffset, textHeight ); end; else begin @@ -1662,7 +1700,6 @@ procedure TLinkbarWcl.SetIsLightStyle(AValue: Boolean); begin if AValue = FIsLightStyle then Exit; FIsLightStyle := AValue; - if IsWindows8OrAbove then FIsLightStyle := False; ThemeInitData(Handle, FIsLightStyle); end; @@ -1698,15 +1735,19 @@ procedure TLinkbarWcl.SetItemOrder(AValue: TItemOrder); procedure TLinkbarWcl.SetPressedIndex(AValue: integer); begin - if AValue = FItemPressed then Exit; + if AValue = FPressedIndex then Exit; oHint.Cancel; - FItemPressed := AValue; - DrawItem(BmpMain, FHotIndex, True, FItemPressed <> ITEM_NONE); + FPressedIndex := AValue; + + if (FPressedIndex <> FHotIndex) + then HotIndex := FPressedIndex; + + DrawItem(BmpMain, FHotIndex, True, FPressedIndex <> ITEM_NONE); UpdateWindow(Handle, BoundsRect, ScreenAlign, BmpMain); end; procedure TLinkbarWcl.SetHotIndex(AValue: integer); -var +var r: TRect; Pt: TPoint; HA: TAlignment; @@ -1722,15 +1763,15 @@ procedure TLinkbarWcl.SetHotIndex(AValue: integer); if FHotIndex >= 0 then begin // restore pred selected item r := Items[FHotIndex].Rect; - BitBlt(BmpMain.Canvas.Handle, r.Left, r.Top, r.Width, r.Height, - CBmpSelectedItem.Canvas.Handle, 0, 0, SRCCOPY); + BitBlt(BmpMain.Dc, r.Left, r.Top, r.Width, r.Height, + CBmpSelectedItem.Dc, 0, 0, SRCCOPY); end; FHotIndex := AValue; if FHotIndex >= 0 then begin // store current item r := Items[FHotIndex].Rect; - BitBlt(CBmpSelectedItem.Canvas.Handle, 0, 0, r.Width, r.Height, - BmpMain.Canvas.Handle, r.Left, r.Top, SRCCOPY); + BitBlt(CBmpSelectedItem.Dc, 0, 0, r.Width, r.Height, + BmpMain.Dc, r.Left, r.Top, SRCCOPY); end; DrawItem(BmpMain, FHotIndex, True, False); // draw current selected item @@ -1753,7 +1794,7 @@ procedure TLinkbarWcl.SetHotIndex(AValue: integer); Pt.X := Items[FHotIndex].Rect.CenterPoint.X; Pt.Y := Items[FHotIndex].Rect.Bottom + TOOLTIP_OFFSET; VA := taAlignBottom; - HA := taCenter; + HA := taCenter; end; saRight: begin @@ -1767,7 +1808,7 @@ procedure TLinkbarWcl.SetHotIndex(AValue: integer); Pt.X := Items[FHotIndex].Rect.CenterPoint.X; Pt.Y := Items[FHotIndex].Rect.Top - TOOLTIP_OFFSET; VA := taAlignTop; - HA := taCenter; + HA := taCenter; end else begin HA := taLeftJustify; @@ -1786,7 +1827,6 @@ procedure TLinkbarWcl.SetHotkeyInfo(AValue: THotkeyInfo); begin FHotkeyInfo := AValue; if (AutoHide) - // (AutoShowMode = smHotKey) then RegisterHotkeyNotify(Handle, FHotkeyInfo) else UnregisterHotkeyNotify(Handle); end; @@ -1801,18 +1841,27 @@ procedure TLinkbarWcl.SetScreenAlign(AValue: TScreenAlign); procedure TLinkbarWcl.SetSortAlphabetically(AValue: Boolean); begin + if (FSortAlphabetically = AValue) + then Exit; + FSortAlphabetically := AValue; + // Save setting + TSettings.Write(FSettingsFileName, INI_SORT_AB, FSortAlphabetically); + if FSortAlphabetically then begin Items.Sort; - oAppBar.AppBarPosChanged; + RecreateMainBitmap(BmpMain.Width, BmpMain.Height); + UpdateWindow(Handle, BoundsRect, ScreenAlign, BmpMain); end; end; procedure TLinkbarWcl.SetStayOnTop(AValue: Boolean); const FORM_STYLE: array[Boolean] of TFormStyle = (fsNormal, fsStayOnTop); begin - if FStayOnTop = AValue then Exit; + if (FStayOnTop = AValue) + then Exit; + FStayOnTop := AValue; Self.FormStyle := FORM_STYLE[FStayOnTop]; @@ -1843,7 +1892,7 @@ procedure TLinkbarWcl.QuerySizedEvent(Sender: TObject; const AX, AY, AWidth, FBeforeAutoHideBound := Bounds(AX, AY, AWidth, AHeight); RecreateMainBitmap(AWidth, AHeight); - if AutoHide and FAutoHiden + if (AutoHide and FAutoHiden) then r := FAfterAutoHideBound else r := FBeforeAutoHideBound; @@ -1856,6 +1905,18 @@ procedure TLinkbarWcl.QueryHideEvent(Sender: TObject; AEnabled: boolean); FAutoHide := AEnabled; end; +procedure TLinkbarWcl.UpdateBackgroundColor; +begin + ThemeGetTaskbarColor(FSysBackgroundColor, FLookMode); +end; + +function TLinkbarWcl.GetBackgroundColor: Cardinal; +begin + if (FUseBkgndColor) + then Result := FBackgroundColor + else Result := FSysBackgroundColor; +end; + procedure TLinkbarWcl.UpdateWindowSize; var iT, iL, iW, iH: Integer; begin @@ -1905,138 +1966,184 @@ function GET_Y_LPARAM(const uLParam: LPARAM): integer; Result := Integer((uLParam shr 16) and $FFFF); end; +procedure TLinkbarWcl.FormResize(Sender: TObject); +begin + if not FCreated + then Exit; + UpdateBlur; +end; + procedure TLinkbarWcl.WndProc(var Msg: TMessage); -var i: Integer; begin case Msg.Msg of - // DWM Messaages WM_THEMECHANGED: begin + inherited; Msg.Result := 0; + if not FCreated then Exit; ThemeInitData(Handle, IsLightStyle); + Exit; + end; + WM_SETTINGCHANGE: + begin + inherited; + if (not FCreated) + //or (Msg.WParam <> SPI_GETICONTITLELOGFONT) + then Exit; + UpdateItemSizes; + RecreateMainBitmap(BmpMain.Width, BmpMain.Height); + UpdateWindow(Handle, BoundsRect, ScreenAlign, BmpMain); + Exit; + end; + CM_FONTCHANGED: + begin + inherited; + if not FCreated then Exit; UpdateItemSizes; + RecreateMainBitmap(BmpMain.Width, BmpMain.Height); + UpdateWindow(Handle, BoundsRect, ScreenAlign, BmpMain); + Exit; end; - WM_DWMCOLORIZATIONCOLORCHANGED, WM_SYSCOLORCHANGE: + WM_SYSCOLORCHANGE: + begin + inherited; + if not FCreated then Exit; + HotIndex := ITEM_NONE; + RecreateMainBitmap(BmpMain.Width, BmpMain.Height); + RecreateButtonBitmap(FButtonSize.Width, FButtonSize.Height); + UpdateWindow(Handle, BoundsRect, ScreenAlign, BmpMain); + Exit; + end; + WM_DWMCOLORIZATIONCOLORCHANGED: begin Msg.Result := 0; + if not FCreated then Exit; + + UpdateBackgroundColor; + + if IsWindows10 + then ThemeSetWindowAccentPolicy10(Handle, FLookMode, BackgroundColor); + // In Windows 8+ theme color may changed smoothly - i := HotIndex; - FHotIndex := ITEM_NONE; - RecreateMainBitmap(BmpMain.Width, BmpMain.Height); - RecreateButtonBitmap(ButtonSize.Width, ButtonSize.Height); - if i = ITEM_NONE - then UpdateWindow(Handle, BoundsRect, ScreenAlign, BmpMain) - else HotIndex := i; + HotIndex := ITEM_NONE; + RecreateMainBitmap(BmpMain.Width, BmpMain.Height); // <== THIS + RecreateButtonBitmap(FButtonSize.Width, FButtonSize.Height); + UpdateWindow(Handle, BoundsRect, ScreenAlign, BmpMain); end; WM_DWMCOMPOSITIONCHANGED: // NOTE: As of Windows 8, DWM composition is always enabled, so this message is // not sent regardless of video mode changes. begin + inherited; Msg.Result := 0; + if not FCreated then Exit; ThemeInitData(Handle, IsLightStyle); UpdateItemSizes; UpdateBlur; end; - { TODO: Provide this message for Windows Vista - WM_DWMWINDOWMAXIMIZE: {} - WM_SIZE: + WM_ACTIVATE: begin - Msg.Result := 0; - UpdateBlur; - end; - WM_SETFOCUS: - begin - Msg.Result := 0; - FCanAutoHide := False; + //Msg.Result := 0; end; WM_KILLFOCUS: begin - Msg.Result := 0; + inherited; + //Msg.Result := 0; if (csDestroying in ComponentState) then Exit; FCanAutoHide := not Assigned(FrmProperties); DoAutoHide; + Exit; end; { Display stste changed (count/size/rotate) } WM_DISPLAYCHANGE: - begin - Msg.Result := 0; - // force update Screen - FMonitorNum := Self.Monitor.MonitorNum; // or Screen.MonitorFromWindow(0, mdNull); - oAppBar.MonitorNum := FMonitorNum; - oAppBar.AppBarPosChanged; - end; + begin + inherited; + Msg.Result := 0; + if not FCreated then Exit; + // force update Screen + FMonitorNum := Self.Monitor.MonitorNum; // or Screen.MonitorFromWindow(0, mdNull); + oAppBar.MonitorNum := FMonitorNum; + oAppBar.AppBarPosChanged; + Exit; + end; + { Delayed auto show (timer) } + WM_TIMER: + begin + case Msg.WParam of + TIMER_AUTO_SHOW: + begin + KillTimer(Handle, TIMER_AUTO_SHOW); + DoAutoShow; + Exit; + end; + TIMER_AUTO_HIDE: + begin + KillTimer(Handle, TIMER_AUTO_HIDE); + DoAutoHide; + Exit; + end; + end; + end; { Messages from ShellContextMenu } - SCMI_SH_RENAME: + LM_CM_RENAME: begin DoRenameItem(FItemPopup); Exit; end; - SCMI_LB_ITEMS: + LM_CM_ITEMS: begin DoPopupMenuItemExecute(Msg.LParam); Exit; end; - SCMI_LB_INVOKE: + LM_CM_INVOKE: begin JumpListClose; Exit; end; { WatchDir stop } - WM_STOPDIRWATCH: + LM_STOPDIRWATCH: begin StopDirWatch; Exit; end; { Bit Bucket image changed } - WM_LB_SHELLNOTIFY: - begin - UpdateBitBuckets; - Exit; - end; - { Delayed auto show (timer) } - WM_TIMER: - begin - case Msg.WParam of - TIMER_AUTO_SHOW: - begin - KillTimer(Handle, TIMER_AUTO_SHOW); - DoAutoShow; - Exit; - end; - TIMER_AUTO_HIDE: - begin - KillTimer(Handle, TIMER_AUTO_HIDE); - DoAutoHide; - Exit; - end; + LM_SHELLNOTIFY: + begin + UpdateBitBuckets; + Exit; + end; + { Settings/Rename dialog destroyed } + LM_DOAUTOHIDE: + begin + FCanAutoHide := not Focused; + DoAutoHide; + Exit; end; - end - else - inherited WndProc(Msg); end; + + inherited WndProc(Msg); end; function SetForegroundWindowInternal(AWnd: HWND): HWND; var ip: TInput; // This structure will be used to create the keyboard input event. begin - Result := 0; - if not IsWindow(AWnd) - then Exit; + then Exit(0); Result := GetForegroundWindow; + // First try plain SetForegroundWindow + SetForegroundWindow(AWnd); + if (AWnd = GetForegroundWindow) + then Exit; + // Set up a generic keyboard event. FillChar(ip, SizeOf(ip), 0); ip.Itype := INPUT_KEYBOARD; - ip.ki.wScan := 0; // hardware scan code for key - ip.ki.time := 0; - ip.ki.dwExtraInfo := 0; - // Press the "Alt" key ip.ki.wVk := VK_MENU; // virtual-key code for the "Alt" key - ip.ki.dwFlags := 0; // 0 for key press + ip.ki.dwFlags := 0; // 0 for key press SendInput(1, ip, SizeOf(ip)); //Sleep(100); //Sometimes SetForegroundWindow will fail and the window will flash instead of it being show. Sleeping for a bit seems to help. @@ -2056,20 +2163,18 @@ procedure TLinkbarWcl.WmHotKey(var Msg: TMessage); and (Msg.LParamHi = FHotkeyInfo.KeyCode) and (Msg.LParamLo = FHotkeyInfo.Modifiers) and AutoHide - //and (FAutoShowMode = smHotkey) then begin - FHotkeyPressed := True; if (FAutoHiden) then begin - DoAutoShow; FPrevForegroundWnd := SetForegroundWindowInternal(Handle); + FCanAutoHide := False; + DoAutoShow; end else begin - SetForegroundWindowInternal(FPrevForegroundWnd); + //SetForegroundWindow(FPrevForegroundWnd); // Linkbar will be hidden when it loses Focus //DoAutoHide; end; - FHotkeyPressed := False; Exit; end; @@ -2095,11 +2200,6 @@ procedure TLinkbarWcl.DoPopupMenuItemExecute(const ACmd: Integer); then mi.Click; end; -procedure TLinkbarWcl.PropertiesFormDestroyed; -begin - DoAutoHide; -end; - procedure TLinkbarWcl.imPropertiesClick(Sender: TObject); begin if Assigned(FrmProperties) @@ -2118,7 +2218,7 @@ function EnumWindowProcStopDirWatch(wnd: HWND; lParam: LPARAM): BOOL; stdcall; Result := True; if ( GetClassName(wnd, buf, Length(buf)) > 0 ) and (buf = TLinkbarWcl.ClassName) - then PostMessage(wnd, WM_STOPDIRWATCH, 0, 0); + then PostMessage(wnd, LM_STOPDIRWATCH, 0, 0); end; function EnumWindowProcClose(wnd: HWND; lParam: LPARAM): BOOL; stdcall; @@ -2145,6 +2245,7 @@ procedure TLinkbarWcl.imCloseClick(Sender: TObject); procedure TLinkbarWcl.imLockBarClick(Sender: TObject); begin FLockLinkbar := not FLockLinkbar; + TSettings.Write(FSettingsFileName, INI_LOCK_BAR, FLockLinkbar); end; procedure TLinkbarWcl.imAddBarClick(Sender: TObject); @@ -2184,7 +2285,7 @@ procedure TLinkbarWcl.imRemoveBarClick(Sender: TObject); and (td.ModalResult = mrOk) then begin FRemoved := True; - DeleteFile(FPreferencesFileName); + DeleteFile(FSettingsFileName); if (tfVerificationFlagChecked in td.Flags) then begin StopDirWatch; @@ -2212,17 +2313,6 @@ function TLinkbarWcl.ScaleDimension(const X: Integer): Integer; Result := MulDiv(X, Self.PixelsPerInch, 96); end; -// Macros from windowsx.h: -// Important Do not use the LOWORD or HIWORD macros to extract the x- and y- -// coordinates of the cursor position because these macros return incorrect results -// on systems with multiple monitors. Systems with multiple monitors can have -// negative x- and y- coordinates, and LOWORD and HIWORD treat the coordinates -// as unsigned quantities. -function MakePoint(const L: DWORD): TPoint; inline; -Begin - Result := TPoint.Create(SmallInt(L and $FFFF), SmallInt(L shr 16)); -End; - procedure TLinkbarWcl.DoAutoHide; var r: TRect; begin @@ -2234,6 +2324,7 @@ procedure TLinkbarWcl.DoAutoHide; if FCanAutoHide and not FAutoHiden then begin FAutoHiden := True; + HotIndex := ITEM_NONE; r := FBeforeAutoHideBound; case ScreenAlign of saTop: r.Bottom := r.Top + ScaleDimension(AUTOHIDE_SIZE); @@ -2254,17 +2345,26 @@ procedure TLinkbarWcl.DoAutoShow; pt := MakePoint(GetMessagePos); if (AutoHide) and (FAutoHiden) - and (FHotkeyPressed or (WindowFromPoint(pt) = Handle)) - //(FAutoShowMode <> smHotKey) + and ((not FCanAutoHide) or (WindowFromPoint(pt) = Handle)) then begin FAutoHiden := False; MoveWindow(Handle, FBeforeAutoHideBound.Left, FBeforeAutoHideBound.Top, FBeforeAutoHideBound.Width, FBeforeAutoHideBound.Height, False); UpdateWindow(Handle, FBeforeAutoHideBound, ScreenAlign, BmpMain); - Self.OnContextPopup := FormContextPopup; + Self.OnContextPopup := FormContextPopup; end; end; +procedure TLinkbarWcl.DoDelayedAutoHide(const ADelay: Cardinal); +begin + if (not AutoHide) + then Exit; + + if (ADelay = 0) + then DoAutoHide + else SetTimer(Handle, TIMER_AUTO_HIDE, ADelay, nil); +end; + procedure TLinkbarWcl.DoDelayedAutoShow; begin if (not AutoHide) @@ -2287,7 +2387,7 @@ procedure TLinkbarWcl.FormMouseLeave(Sender: TObject); begin HotIndex := -1; if (FAutoShowMode = smMouseHover) or FCanAutoHide - then SetTimer(Handle, TIMER_AUTO_HIDE, TIMER_AUTO_HIDE_DELAY, nil);// DoAutoHide; + then DoDelayedAutoHide(TIMER_AUTO_HIDE_DELAY); end; //////////////////////////////////////////////////////////////////////////////// @@ -2358,19 +2458,20 @@ procedure TLinkbarWcl.SetDropPosition(AValue: TPoint); pd := ButtonSize.cy div 6; if ( AValue.Y < (r.Top+pd) ) then part := -1 - else if ( AValue.Y > (r.Bottom-pd) ) - then part := 1 - else part := 0; + else if ( AValue.Y > (r.Bottom-pd) ) + then part := 1 + else part := 0; end else begin pd := ButtonSize.cx div 6; if ( AValue.X < (r.Left+pd) ) then part := -1 - else if ( AValue.X > (r.Right-pd) ) - then part := 1 - else part := 0; + else if ( AValue.X > (r.Right-pd) ) + then part := 1 + else part := 0; end; - if (part = 1) and (index <> FDragIndex) + if (part = 1) + and (index <> FDragIndex) then begin index := index + 1; part := -1; end; if index > (Items.Count-1) then index := ITEM_NONE; @@ -2386,8 +2487,8 @@ procedure TLinkbarWcl.SetDropPosition(AValue: TPoint); if (FItemDropPosition <> ITEM_NONE) then begin r := _FLastDropRect; - BitBlt(BmpMain.Canvas.Handle, r.Left, r.Top, r.Width, r.Height, - CBmpDropPosition.Canvas.Handle, 0, 0, SRCCOPY); + BitBlt(BmpMain.Dc, r.Left, r.Top, r.Width, r.Height, + CBmpDropPosition.Dc, 0, 0, SRCCOPY); end; FItemDropPosition := index; @@ -2397,8 +2498,8 @@ procedure TLinkbarWcl.SetDropPosition(AValue: TPoint); r := GetItemDropRect(FItemDropPosition, part); _FLastDropRect := r; - BitBlt(CBmpDropPosition.Canvas.Handle, 0, 0, r.Width, r.Height, - BmpMain.Canvas.Handle, r.Left, r.Top, SRCCOPY); + BitBlt(CBmpDropPosition.Dc, 0, 0, r.Width, r.Height, + BmpMain.Dc, r.Left, r.Top, SRCCOPY); if (part = 0) then begin @@ -2407,7 +2508,7 @@ procedure TLinkbarWcl.SetDropPosition(AValue: TPoint); DrawItem(BmpMain, FItemDropPosition, False, False, False); end else begin - gpDrawer := BmpMain.ToGPGraphics; + gpDrawer := TGpGraphics.Create(BmpMain.Dc);//BmpMain.ToGPGraphics; gpBrush := TGPSolidBrush.Create(TGPColor.Create($ff000000)); gpDrawer.FillRectangle(gpBrush, TGPRect.Create(r)); gpBrush.Color := TGPColor.Create($ffffffff); @@ -2457,7 +2558,7 @@ procedure TLinkbarWcl.DoDrop(const pt: TPoint); if FDragingItem then begin - FSortAlphabetically := False; + SortAlphabetically := False; if FItemDropPosition = ITEM_NONE then Items.Move(FDragIndex, Items.Count-1) else Items.Move(FDragIndex, FItemDropPosition); @@ -2467,11 +2568,12 @@ procedure TLinkbarWcl.DoDrop(const pt: TPoint); else tmrUpdate.Enabled := True; end; -procedure TLinkbarWcl.QueryDragImage(out ABitmap: TBitmap; out AOffset: TPoint); +procedure TLinkbarWcl.QueryDragImage(out ABitmap: THBitmap; out AOffset: TPoint); begin - ABitmap := TBitmap.Create; - ABitmap.PixelFormat := pf32bit; - ABitmap.Canvas.Brush.Style := bsClear; + if not StyleServices.Enabled + then Exit; + + ABitmap := THBitmap.Create(32); ABitmap.SetSize(ButtonSize.cx, ButtonSize.cy); DrawItem(ABitmap, FDragIndex, False, True, False, True); @@ -2523,7 +2625,7 @@ procedure TLinkbarWcl.DirWatchChange(const Sender: TObject; begin i := FindItemByHash(StrToHash(AFileName)); if (i <> ITEM_NONE) - then Items.Delete(i); + then DeleteItem(i); end; waModified: begin @@ -2562,20 +2664,15 @@ procedure TLinkbarWcl.tmrUpdateTimer(Sender: TObject); begin tmrUpdate.Enabled := False; - i := 0; - while (i < Items.Count) do + for i := Items.Count-1 downto 0 do begin item := Items[i]; if item.NeedLoad then begin if item.LoadFromFile(item.FileName) - then begin - Items.LoadIcon(item); - Inc(i); - end - else Items.Delete(i); + then Items.LoadIcon(item) + else DeleteItem(i); end - else Inc(i); end; if FSortAlphabetically @@ -2598,7 +2695,7 @@ procedure TLinkbarWcl.DirWatchError(const Sender: TObject; if not DirectoryExists(WorkDir) then begin FRemoved := True; - DeleteFile(FPreferencesFileName); + DeleteFile(FSettingsFileName); Close; end; end; @@ -2606,15 +2703,31 @@ procedure TLinkbarWcl.DirWatchError(const Sender: TObject; procedure TLinkbarWcl.SetEnableAeroGlass(AValue: Boolean); begin - if not IsWindows8And8Dot1 + if (not IsWindows8And8Dot1) + or (AValue = FEnableAeroGlass) then Exit; - if (AValue = FEnableAeroGlass) - then Exit; FEnableAeroGlass := AValue; ExpAeroGlassEnabled := FEnableAeroGlass; - ThemeSetWindowAttribute(Handle); + ThemeSetWindowAttribute78(Handle); UpdateBlur; end; +procedure TLinkbarWcl.SetLookMode(AValue: TLookMode); +begin + if (not IsWindows10) + then Exit; + FLookMode := AValue; + UpdateBackgroundColor; + ThemeSetWindowAccentPolicy10(Handle, FLookMode, BackgroundColor); +end; + +procedure TLinkbarWcl.SetUseBkgndColor(AValue: Boolean); +begin + if (AValue = FUseBkgndColor) + then Exit; + FUseBkgndColor := AValue; + UpdateBackgroundColor; +end; + end.