[UniSoft]

Just tried to run on a virtual machine VMWare with the Windows 7 x64, same issue.

[UniSoft]

No, I didn’t touch or recompile.
Windows 7

[UniSoft]

If you have source code
open file: acSBUtils.pas

find function:
function TacStaticWnd.PaintText(DoCalc: boolean): TRect;

fix:
Flags := DT_EDITCONTROL or DT_WORDBREAK or DT_NOCLIP or {DT_TABSTOP or} DT_VCENTER; // or MAKEWORD(0, 10);

@Support
For what here MAKEWORD(0, 10)?
it turns to be DT_NOPREFIX or DT_EXTERNALLEADING

PS: This bug presence since v16.18

• This reply was modified 4 years, 1 month ago by UniSoft.

[UniSoft]

that is a fixed code, with comments what was wrong

[UniSoft]

See update, there is a bug in x64

  PAbsoluteIndirectJmp = ^TAbsoluteIndirectJmp;
  TAbsoluteIndirectJmp = packed record
    OpCode: Word; // $FF25(Jmp, FF /4)
    Addr: Int32; //PPointer <-- here should be signed Int32 (4 bytes) not a pointer (8 bytes in x64!)
  end;

function acGetActualAddr(Proc: Pointer): Pointer;
var
  J: PAbsoluteIndirectJmp;
begin
  J := PAbsoluteIndirectJmp(Proc);
  if J.OpCode = $25FF then
{$IFDEF WIN64}
    Result := PPointer(PByte(Proc) + J.Addr + 6 {Instruction Size})^ // Int32(Proc) - Here You cuts 64-bit pointer to 32-bit in x64
{$ELSE}
    Result := PPointer(J.Addr)^
{$ENDIF}
  else
    Result := Proc;
end;

[UniSoft]

Stephane Senecal wrote:

In my humble opinion, I think it could be a good idea to have a TsPaintBox optimized to combine the application’s drawing with AlphaSkins’ painting in a non flickering maner.

Container (example TPanel) draws its background and then draws child controls (TPaintBox)
region of all windowed child controls excluded, and therefore there is no flicker,
but not TPaintBox! if exclude it’s region as well then you will have to draw background yourself,
but TPaintBox doesn’t have any drawing and therefore it is just transparent (if you don’t draw anything)
cause parent already take care of draw background.
That is the reason of flickering (it is a pause between draw parent background and draw PaintBox content).
You can’t easy avoid it.
So it is not the problem of AlphaControls.
With AlphaControls (active and skinned) there will not be any flicker, cause all drawing done
in shadow buffer (FCommonData.FCacheBmp).
So if to inherit it from TGraphicControl then there are nothing to change…
If inherit it from TWinControl then you will get almost the same what I did
(I just add some common function, like the draw caption and Marquee rect)

• This reply was modified 4 years, 7 months ago by UniSoft.

[UniSoft]

Support wrote:

Maybe we can just inherit TsPaintBox from the TsPanel?

Initially I inherit it from TCustomControl.
But when I write the code to draw the background
I found that the code will be too version dependent (latest uses styles etc..)
(while you keep compatibility with old versions of delphi).
Why I don’t inherit it from TsPanel?
Actually TsPanel is a container and therefore contains a lot of code to support/draw/update/repaint child controls,
what will slow down. Need to remove all code related to child controls.
I would also like to add frame highlighting (Glow?) on mouse hover, like on TsEdit.

Stephane Senecal wrote:

Your control seems to be way more complicated than a TPaintBox.

So that is the main Idea!
If need a simple there is standard TPaintBox,
if need advanced functionality use TsPaintBox (or what ever else, the name can be changed TsAdvPaintBox, TsDrawBox, …).

Stephane Senecal wrote:

And since your demo is based on a TsPanel, I don’t understand what benefit a TsPaintBox could bring you.

TsPanel is a container…
just advanced PaintBox, which can be used as a base to draw whatever you want, if you can’t find ready component.
Example, see screenshot…
I didn’t found ready controls as I want, so I draw it myself on TPaintBox,
cause I have few TPaintBox and all of them have the same features,
I subclass the class… (or how is it calling right?) (Sorry, I can be incorrect in terminology)
BTW: That is why it is not good if it will be TsPanel,
no need that added functionality affects all TsPanel(s) on the form.

type
  TPaintBox = class(Vcl.ExtCtrls.TPaintBox)
    // ...
  end;

  TMainForm = class(TForm)
    ...
    pboxOutVoltage: TPaintBox;
    pboxOutCurrent: TPaintBox;
    pboxOutCurrent: TPaintBox;
    ...
  end;

Now why TPaintBox is shit…
1. It does’t have a window,
2. extra flickering if place it on Panel/GroupBox/TabSheet/etc (when skinning disabled, even if AC not used at all), and to redraw need to call direct Paint(), but it cause some another crazy problems
(for example it can randomly disappear suddenly, just empty space…
Only DoubleBuffered=False helps to solve it, but it starts super extra flickering)
3. Cause I have some animation, repeat, delay I need a 4 timers, so what to do? create 4 TTimers?
Instead of 4 TTimer(s) I use FWindowHandle := AllocateHWnd(TimerWndProc);
And can use SetTimer/KillTimer
4. It doesn’t get mouse wheel messages, key press, etc…
5. Not fill background according to the selected skin
6. etc

Attachments:

You must be logged in to view attached files.

[UniSoft]

yes, TsPanel can be used…
but better if it will be another class.
I already made component myself (demo exe included),
take a look, maybe you can add it?

Attachments:

You must be logged in to view attached files.

[UniSoft]

Can I offer you a nice very compact hook engine MinHook.
https://github.com/TsudaKageyu/minhook
It is written in pure C…

I wrote a delphi unit, see attach
(in file sSkinManager.txt you can see all changes for sSkinManager.pas)
all what need is to add unit uMinHook to the project, and add to uses
also copy the folder with obj files
(alternatively you can compile sources yourself,
there is a source code of library and the C++Builder project)

The advantages:
+ supports x86 and x64
+ thread safe
+ small footprint
+ easy to use
+ correctly applies hooks (pause all threads)
+ supports the hotpatch (if available)
+ creates trampolines

Attachments:

You must be logged in to view attached files.

[UniSoft]

By the way, here is one more BUG
in WIN64 – Addr should be signed INT32 (or just Integer)

  PAbsoluteIndirectJmp = ^TAbsoluteIndirectJmp;
  TAbsoluteIndirectJmp = packed record
    OpCode: Word;   // $FF25(Jmp, FF /4)
    Addr: Cardinal;//PPointer;
  end;

[UniSoft]

I fix problems

1. Grip lose the background, after move the window
(if a window loses a focus or resize then it redraws normally)

When window get Activated…

procedure TacDialogWnd.Ac_WMNCActivate(var Message: TMessage);
...
    SkinData.BGChanged := True; /// <<<<<<< NOTE This
    InvalidateRect(CtrlHandle, nil, False);
    RedrawWindow(CtrlHandle, nil, 0, RDW_ALLCHILDREN or RDW_FRAME or RDW_INVALIDATE); // Repaint of child controls
...
end;

End here is the problem…

procedure InitBGInfo(const SkinData: TsCommonData; const PBGInfo: PacBGInfo; ...
begin
  with SkinData do
    if PBGInfo^.PleaseDraw then begin
      if BGChanged and (FOwnerControl <> nil) then // here FOwnerControl is nil
        FOwnerControl.Perform(SM_ALPHACMD, AC_PREPARECACHE_HI, 0);

      if not BGChanged then // <strong><<<<<<< The problem is HERE, I just commented this line</strong>
        with PBGInfo^ do
          BitBlt(DrawDC, R.Left, R.Top, WidthOf(R), HeightOf(R), FCacheBmp.Canvas.Handle, Offset.X, Offset.Y, SRCCOPY);
...
end;

2. Each time (for example when dialog gets the focus), popups tooltip,
even if the mouse cursor is in a different location
(on the screenshot you can see the second tooltip under cursor).

This is again the problem of AnVir 🙁
when AnVir active, then the ‘toolbarwindow32’ gets the message WM_SETFOCUS,
and when ‘toolbarwindow32’ gets that message it makes hot button with index 1 (that is why popup tooltip)
(also found that behavior from winxp source code).
If you want make it work with AnVir, you can just suppress that message,

procedure TacToolBarWnd.acWndProc(var Message: TMessage);
var
  R: TRect;
  P: TPoint;
begin
  case Message.Msg of
  WM_SETFOCUS:
    begin
      GetWindowRect(CtrlHandle, R);
      GetCursorPos(P);
      if not PtInRect(R, P) then
      begin
        Message.Result := 1;
        Exit;
      end;
    end;
  end;
  ...
end;

• This reply was modified 4 years, 8 months ago by UniSoft.
• This reply was modified 4 years, 8 months ago by UniSoft.

[UniSoft]

No need add 2, otherwise EDIT overlay the button
very good can see on AutumnSky skin

function TacComboBoxWnd.ButtonRect: TRect;
...
begin
  Style := GetWindowLong(CtrlHandle, GWL_STYLE);
  if not DlgMode or (Style and CBS_DROPDOWNLIST = CBS_DROPDOWNLIST) then
    w := GetComboBtnSize(Skindata.SkinManager, SkinData.CommonSkinData.PPI) // + 2 //UniSoft
  else

Attachments:

You must be logged in to view attached files.

[UniSoft]

Still have a few problems…
1. Grip lose the background, after move the window
(if a window loses a focus or resize then it redraws normally)
2. Each time (for example when dialog gets the focus), popups tooltip,
even if the mouse cursor is in a different location
(on the screenshot you can see the second tooltip under cursor).

Attachments:

You must be logged in to view attached files.

[UniSoft]

Hello!
I Checked v16.12
still have the same crash… 🙁

I can clearly see in the debugger what exactly is going on…
Look

1. AC sets the new Window Pointer

   InitializeACWnd
      OldProc := Pointer(GetWindowLong(CtrlHandle, GWL_WNDPROC));
      NewWndProcInstance := {$IFDEF DELPHI6UP}Classes.{$ENDIF}MakeObjectInstance(acWndProc);
      SetWindowLong(CtrlHandle, GWL_WNDPROC, LONG_PTR(NewWndProcInstance));

2. Now AnVir do the same (and saves OldProc which is actually already = NewWndProcInstance)
3. Closing Dialog
4. Get message WM_DESTROY (Notice! it doesn’t get WM_CLOSE, at least I don’t see it in WinSpy)
Now the AnVir first pass processing to the old wndProc (what is actually = NewWndProcInstance!)
on process of WM_DESTROY – AC restores original OldProc, after that AC deletes NewWndProcInstance
FreeObjectInstance(ListSW.NewWndProcInstance);

   procedure UninitializeACWnd(...
        if Assigned(ListSW.OldProc) then begin
          SetWindowLong(Handle, GWL_WNDPROC, LONG_PTR(ListSW.OldProc));
          ListSW.OldProc := nil;
          if Assigned(ListSW.NewWndProcInstance) then begin
            {$IFDEF DELPHI6UP}Classes.{$ENDIF}FreeObjectInstance(ListSW.NewWndProcInstance);
            ListSW.NewWndProcInstance := nil;
          end;
        end

5. process returns back to the AnVir, where this shit also thinking that restores old WndProc
SetWindowLong(Handle, GWLP_WNDPROC, PrevWndFunc);
BUT! it is a pointer to already deleted NewWndProcInstance
And follow send the messages

        SendMessageA(Handle, TB_DELETEBUTTON, btncount + 1, 0);
         SendMessageA(Handle, TB_DELETEBUTTON, btncount    , 0);

That is the actually reason!

—
BUG with StatusBar still not fixed as well 🙁
to see it:
1. Launch ASkinDemo.exe
2. Select skin: Standard theme
3. Move cursor over StatusBar
Fixed code is few posts up…

[UniSoft]

Up to you
If you need I can check it before release…

[UniSoft]

just some explain, what doing AnVir, now you can see why it cause crash

  case Msg of
  WM_DESTROY, WM_CLOSE: 
    begin
      // here is the problem!!! 
      // this call should be after clean up, not before
      CallWindowProc(PrevWndFunc, ...); // !!!

     // After called Destructor all bottom crap can cause an error
	  
      // this called on init time, then add custom buttons
      //  so btncount cotaint number of buttons in toolbat before add new buttons
      //btncount := SendMessageA(Handle, TB_BUTTONCOUNT, 0, 0); //
	  
      // restore previous WndProc
      SetWindowLong(Handle, GWLP_WNDPROC, PrevWndFunc);
	  
      // delete custom buttons
      SendMessageA(Handle, TB_DELETEBUTTON, btncount + 1, 0);
      SendMessageA(Handle, TB_DELETEBUTTON, btncount    , 0);
    end;
  end;

[UniSoft]

This helps to solve that crash
comment WM_DESTROY
What for need to process both WM_DESTROY and WM_NCDESTROY?
WM_NCDESTROY is the last one, so should be enough.

procedure TacDialogWnd.acWndProc(var Message: TMessage);
var
  PS: TPaintStruct;
  X, Y, i: integer;
  cR, rClient: TRect;
begin
  case Message.Msg of
    {WM_DESTROY,} WM_NCDESTROY: begin
      if SkinData.FCacheBmp <> nil then
        SkinData.FCacheBmp.Assign(nil);
  ...
    end;

[UniSoft]

I found problem…
“AnVir Task Manager” adds an icon to the tool bar of open/save dialog and it is the reason why it crash.
But anyway strange, if to disable skinning, then there is no crash.
BTW, message 1046 – probably TB_DELETEBUTTON
shit.. and I had this problem before, just forgot :(.

[UniSoft]

I tried to make demo, but it is crashed only under debugger
First I commented try..except
then compile release version…
if I run it from rad studio in debugger, then it crash…
If I open exe in any debugger (OllyDbg, x64dbg, …) they catch Access Violation…

function TacMainWnd.CallPrevWndProc(const Handle: hwnd; const Msg: longint; const WParam: WPARAM; var LParam: LPARAM): LRESULT;
var
  M: TMessage;
begin
  if Assigned(OldWndProc) then begin
    M.Msg := Msg;
    M.WParam := WParam;
    M.LParam := LParam;
    M.Result := 0;
    OldWndProc(M);
    Result := M.Result;
    LParam := M.LParam;
  end
  else
    if Assigned(OldProc) then
      //try
        Result := CallWindowProc(OldProc, Handle, Msg, WParam, LParam)
      //except
      //  Result := 0;
      //end
    else
      Result := 0;
end;

Alternate link to demo (with compiled exe)
__https__://mega.nz/file/xO5BiQpJ#MRE7uX5rWFFbe1gKJ8snE1Fruj8XJiXfuKUqxXNcP_g

Attachments:

You must be logged in to view attached files.

[UniSoft]

Windows 7
RAD 10.4 with last 2 updates

By the way, bug with GripPos is not fixed

function TsStatusBar.GripPos: TPoint;
begin
  if FCommonData.SkinManager <> nil then
    with FCommonData.SkinManager, SkinData.CommonSkinData do
      if IsValidImgIndex(GripRightBottom) then begin
        Result := Point(Width - ma[GripRightBottom].Width - BorderWidth, Height - ma[GripRightBottom].Height - BorderWidth);
        Exit;
      end;

  Result := Point(Width - GetSystemMetrics(SM_CXSIZEFRAME), Height - GetSystemMetrics(SM_CYSIZEFRAME));
end;

[Author]

Posts