This mite help some one.

This mite help some one.

A wile ago i posted a question about Notification Area that no body
gave me information about.
So i came to this https://www.codeproject.com/Questions/467637/NotifyIcon-always-show-icon
where - Rokas Gustys - had the same problem as mine.

I found this
https://hianz.wordpress.com/2012/07/13/modify-windows-7-notification-area/

So here is the source for Delphi 10... using BCHexEditor.
I did not change the registry only read it.

I tested it in window 7

program Tray_Notification;

uses
Vcl.Forms,
Main in 'Main.pas' {Form1};

{$R *.res}

begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

unit Main;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Grids, BCHexEditor,
BCHexEditorEx, Vcl.ExtCtrls, Vcl.ComCtrls, Vcl.Menus;

type

TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
Label2: TLabel;
BCHexEditorEx1: TBCHexEditorEx;
BCHexEditor1: TBCHexEditor;
Panel1: TPanel;
Label3: TLabel;
Panel2: TPanel;
ListView1: TListView;
Label4: TLabel;
Splitter1: TSplitter;
Button2: TButton;
Label5: TLabel;
Label6: TLabel;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
Buff: array of byte;
AList: array of array of byte;

implementation

{$R *.dfm}
uses Registry, Printers;
const
RegLocat =
'Software\Classes\Local Settings\Software\Microsoft\Windows\CurrentVersion\TrayNotify\';
valName = 'IconStreams';
//valName = 'PastIconsStream';

function Transform(S: string): string;
var
i: Integer;
begin
for I := 1 to Length(s) do
begin
if (s[i] >= 'a') and (s[i] <= 'z') then
begin
if s[i] > 'm' then
s[i] := Char(Ord(s[i]) - 13)
else
s[i] := Char(Ord(s[i]) + 13);
end;

if (s[i] >= 'A') and (s[i] <= 'Z') then
begin
if s[i] > 'M' then
s[i] := Char(Ord(s[i]) - 13)
else
s[i] := Char(Ord(s[i]) + 13);
end;
end;
Result := s;
end;

procedure fillBlocks(Stream: TMemoryStream; Count: integer);
var
i: Integer;

begin
Stream.Seek(0, soFromBeginning);
SetLength(AList, count);
for i := 0 to count - 1 do
begin
SetLength(AList[i], 1640);
Stream.Read(AList[i][0], 1640);
end;

end;

procedure TForm1.Button1Click(Sender: TObject);
var
reg: TRegistry;
vSize: integer;
// tmpStr: string;
count, i, j: integer;
Stream: TMemoryStream;
alldataString: string;
Itm: TListItem;
begin
ListView1.Clear;
reg := TRegistry.Create(KEY_READ);
reg.RootKey := HKEY_CURRENT_USER;
if (not reg.KeyExists(RegLocat)) then
begin
MessageDlg('Key not found! Created now.',
mtInformation, mbOKCancel, 0);
Exit;
end;
if Reg.OpenKey(RegLocat, false) then
begin
Stream := TMemoryStream.Create;
// Typ := reg.GetDataType(valName);
vSize := reg.GetDataSize(valName);
Label2.Caption := IntToStr(vSize);
if (vSize > 0) then
begin
count := (vSize - 20) div 1640;
SetLength(Buff, vSize);
reg.ReadBinaryData(valName, Buff[0], vSize);
Stream.WriteBuffer(Buff[0], 20);
Stream.Seek(0, soFromBeginning);
BCHexEditor1.LoadFromStream(Stream); //header
Stream.Clear;
Stream.WriteBuffer(Buff[20], VSize - 20);
Stream.Seek(0, soFromBeginning);
// Stream.Position:=0;
BCHexEditorEx1.LoadFromStream(Stream);
fillBlocks(Stream, count); // read aal blockes
Label6.Caption := IntToStr(count);
for i := 0 to count - 1 do
begin
alldataString := '';
for j := 0 to 1639 do
begin
if j < 520 then //528
begin
if AList[i][j] > 0 then
alldataString := alldataString + Char(AList[i][j]);
if j = 519 then //526
begin
Itm := ListView1.Items.Add;
Itm.Caption := IntToStr(AList[i][528]);
Itm.SubItems.Add(Transform(alldataString));
ListView1.Columns[0].Width := 2;
Break;
end;
end;
end;
end;
end;
Stream.Free;
end;

reg.Free;

end;

procedure TForm1.Button2Click(Sender: TObject);

var
LineHeight, i, Y: Integer;
begin
with Printer do
begin
BeginDoc;
LineHeight := Round(Canvas.TextHeight('H') * 1.2);
Canvas.TextOut(0, 0, 'Print Date: ' + DateTimeToStr(Now));
Y := LineHeight;
Canvas.TextOut(0, Y, '--------------------------------------------------');
Y := Y + LineHeight;
Y := Y + LineHeight;
for i := 0 to ListView1.Items.Count - 1 do
begin
if Y + LineHeight > PageHeight then
begin
NewPage;
Y := 0;
end;
Canvas.TextOut(0, Y, ListView1.Items[i].Caption + ' ' +
ListView1.Items[i].SubItems[0]);
Y := Y + LineHeight;
end;
EndDoc;
end;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Label2.Caption := '';
Label6.Caption := '';
end;

end.

object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 500
ClientWidth = 1129
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 120
TextHeight = 16
object Splitter1: TSplitter
Left = 235
Top = 65
Height = 311
Align = alRight
ExplicitLeft = 80
ExplicitTop = 144
ExplicitHeight = 100
end
object BCHexEditorEx1: TBCHexEditorEx
Left = 238
Top = 65
Width = 891
Height = 311
BackupExtension = '.bak'
PrintOptions.MarginLeft = 20
PrintOptions.MarginTop = 15
PrintOptions.MarginRight = 25
PrintOptions.MarginBottom = 25
PrintOptions.Flags = [pfSelectionBold, pfMonochrome]
PrintFont.Charset = DEFAULT_CHARSET
PrintFont.Color = clWindowText
PrintFont.Height = -18
PrintFont.Name = 'Courier New'
PrintFont.Style = []
Align = alRight
TabOrder = 0
ReadOnlyView = True
end
object Panel1: TPanel
Left = 0
Top = 376
Width = 1129
Height = 124
Align = alBottom
TabOrder = 1
object Label3: TLabel
Left = 1
Top = 1
Width = 1127
Height = 33
Align = alTop
Alignment = taCenter
Caption = 'Header'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -27
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
ExplicitWidth = 98
end
object BCHexEditor1: TBCHexEditor
Left = 1
Top = 34
Width = 1127
Height = 89
Align = alClient
TabOrder = 0
ReadOnlyView = True
end
end
object Panel2: TPanel
Left = 0
Top = 0
Width = 1129
Height = 65
Align = alTop
TabOrder = 2
object Label1: TLabel
Left = 216
Top = 4
Width = 90
Height = 16
Caption = 'Size of Buffer - '
end
object Label2: TLabel
Left = 312
Top = 4
Width = 37
Height = 16
Caption = 'Label2'
end
object Label4: TLabel
Left = 1
Top = 40
Width = 1127
Height = 24
Align = alBottom
Alignment = taCenter
Caption =
'settings: 2 = show icon and notifications 1 = hide icon and no' +
'tifications 0 = only show notifications'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -20
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
ExplicitWidth = 1028
end
object Label5: TLabel
Left = 384
Top = 4
Width = 55
Height = 16
Caption = 'Blockes - '
end
object Label6: TLabel
Left = 456
Top = 4
Width = 37
Height = 16
Caption = 'Label2'
end
object Button1: TButton
Left = 8
Top = 8
Width = 105
Height = 25
Caption = 'Get Notification'
TabOrder = 0
OnClick = Button1Click
end
object Button2: TButton
Left = 119
Top = 9
Width = 75
Height = 25
Caption = 'Print'
TabOrder = 1
OnClick = Button2Click
end
end
object ListView1: TListView
Left = 0
Top = 65
Width = 235
Height = 311
Align = alClient
Columns = <
item
Caption = 'not'
Width = 20
end
item
Caption = 'Program'
Width = 500
end>
ReadOnly = True
RowSelect = True
TabOrder = 3
ViewStyle = vsReport
end
end

and still investigating


https://hianz.wordpress.com/2012/07/13/modify-windows-7-notification-area/

Comments