Forum > LCL

Dimm Form Crossplatform

(1/8) > >>

KodeZwerg:
While I porting my native windows codelib to crosscompile variants used in freepascal I encountered a small problem with getting correct size of a form and its position on screen.
I came up with this solution but can just test on windows.
I've tested with several screen scale modes (100% - 150% - 175%) and all borderstyles, all worked okay here.

2 Questions:
Is it working on Linux/MacOS same as shown on my attached image?
Is there a better solution to dimm a form when needed?


--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---unit Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls; type   { TForm1 }   TForm1 = class(TForm)    Button1: TButton;    procedure Button1Click(Sender: TObject);    procedure FormCreate(Sender: TObject);  strict private    fDimmedForm: TForm;  private    procedure CreateDimmed(const AForm: TForm; const AColor: TColor = clBlack; const AAlphaBlendValue: Integer = 127);    procedure CloseDimmed;  public  end; var  Form1: TForm1; implementation {$R *.lfm} { TForm1 } procedure TForm1.CreateDimmed(const AForm: TForm; const AColor: TColor;  const AAlphaBlendValue: Integer);  function DetermineHeight(const AForm: TForm): Integer;  var    global_pos: TPoint;  begin    global_pos := AForm.ClientToScreen(Point(1, 1));    Result := Pred(global_pos.Y) - AForm.Top + AForm.ClientHeight;  end;  function DetermineFormLeft(const AForm: TForm): Integer;  var    global_pos: TPoint;  begin    global_pos := AForm.ClientToScreen(Point(1, 1));    Result := Screen.Monitors[Screen.MonitorFromWindow(Self.Handle, mdNearest).MonitorNum].Left + Pred(global_pos.X);  end;begin  if FDimmedForm <> nil then    CloseDimmed;  FDimmedForm := TForm.CreateNew(nil, 0);  FDimmedForm.AlphaBlend := True;  FDimmedForm.AlphaBlendValue := AAlphaBlendValue;  FDimmedForm.Color := AColor;  FDimmedForm.BorderIcons := [];  FDimmedForm.BorderStyle := bsNone;  FDimmedForm.Top := Succ(AForm.Top);  FDimmedForm.Left := DetermineFormLeft(AForm);  FDimmedForm.Width := AForm.Width;  FDimmedForm.Height := Pred(DetermineHeight(AForm));  FDimmedForm.Visible := True;end; procedure TForm1.CloseDimmed;begin  FDimmedForm.Free;  FDimmedForm := nil;end; procedure TForm1.Button1Click(Sender: TObject);begin  CreateDimmed(Self);  with TForm1.Create(nil) do    begin      try        Left := Random(High(Byte));        Top := Random(High(Byte));        ShowModal;      finally        Release;      end;    end;  CloseDimmed;end; procedure TForm1.FormCreate(Sender: TObject);begin  FDimmedForm := nil;end; end.

Handoko:
It doesn't seem to work on Ubuntu Mate using Lazarus 3.0. See the screenshot below.

Similar thing has been discussed here:
https://forum.lazarus.freepascal.org/index.php/topic,42107.msg293272.html#msg293272

KodeZwerg:

--- Quote from: Handoko on May 13, 2024, 03:56:16 am ---It doesn't seem to work on Ubuntu Mate using Lazarus 3.0. See the screenshot below.

Similar thing has been discussed here:
https://forum.lazarus.freepascal.org/index.php/topic,42107.msg293272.html#msg293272

--- End quote ---
I do appreciate your test and did read the thread you mentioned. From what I have read and saw, the caption there stay in color of OS and thats not what my aim is.
Also there is nothing mentioned whats the reason for that behave.
Could you be nice and test with this class again and show me the MessageBox please?
(added in a hurry a conditional compiler switch)

--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---unit kz.forms.dimm; (*project: dimmed form classauthor: KodeZwergcopyright: (c) 2024 by KodeZwerglicense: Royalty free, the unlicense*) {$Define Debug} {$mode ObjFPC}{$H+} interface uses  Classes, SysUtils, Forms, Graphics, Controls {$If Defined(Debug)}, Dialogs{$IfEnd}; type   { TkzDimmedForm }   TkzDimmedForm = class(TObject)    strict private      FDimmedForm: TForm;    strict private      function FormTop(const AForm: TForm): Integer;      function FormLeft(const AForm: TForm): Integer;      function FormHeight(const AForm: TForm): Integer;    public      constructor Create(const AForm: TForm; const AColor: TColor = clBlack; const AAlphaBlendValue: Integer = 127);      destructor Destroy; override;  end; implementation { TkzDimmedForm } constructor TkzDimmedForm.Create(const AForm: TForm; const AColor: TColor = clBlack; const AAlphaBlendValue: Integer = 127);begin  inherited Create;  FDimmedForm := nil;  if (not Assigned(AForm)) then    raise Exception.Create('TkzDimmedForm - Error, source form not assigned!');  FDimmedForm := TForm.CreateNew(nil, 0);  FDimmedForm.AlphaBlend := True;  FDimmedForm.AlphaBlendValue := AAlphaBlendValue;  FDimmedForm.Color := AColor;  FDimmedForm.BorderIcons := [];  FDimmedForm.BorderStyle := bsNone;  FDimmedForm.Top := FormTop(AForm);  FDimmedForm.Left := FormLeft(AForm);  FDimmedForm.Width := AForm.ClientRect.Width;  FDimmedForm.Height := FormHeight(AForm);  FDimmedForm.Visible := True;  {$If Defined(Debug)}  ShowMessage(Format('Top: %d Left: %d Width: %d Height: %d' + sLineBreak +                     'Top: %d Left: %d Width: %d Height: %d' ,                     [FDimmedForm.Top, FDimmedForm.Left, FDimmedForm.Width, FDimmedForm.Height,                     AForm.Top, AForm.Left, AForm.Width, AForm.Height]));  {$IfEnd}end; destructor TkzDimmedForm.Destroy;begin  if FDimmedForm <> nil then    begin      FDimmedForm.Free;      FDimmedForm := nil;    end;  inherited Destroy;end; function TkzDimmedForm.FormHeight(const AForm: TForm): Integer;var  global_pos: TPoint;begin  global_pos := AForm.ClientToScreen(Point(0, 0));  Result := global_pos.Y - Succ(AForm.Top) + AForm.ClientHeight;end; function TkzDimmedForm.FormTop(const AForm: TForm): Integer;var  global_pos: TPoint;begin  global_pos := AForm.ClientToScreen(Point(0, 0));  Result :=  Screen.Monitors[Screen.MonitorFromWindow(AForm.Handle, mdNearest).MonitorNum].Top + global_pos.Y - (Screen.Monitors[Screen.MonitorFromWindow(AForm.Handle, mdNearest).MonitorNum].Top + (FormHeight(AForm) - AForm.ClientRect.Height));end; function TkzDimmedForm.FormLeft(const AForm: TForm): Integer;var  global_pos: TPoint;begin  global_pos := AForm.ClientToScreen(Point(0, 0));  Result := Screen.Monitors[Screen.MonitorFromWindow(AForm.Handle, mdNearest).MonitorNum].Left + global_pos.X;end; end.example call (uses kz.forms.dimm):

--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---procedure TForm1.Button1Click(Sender: TObject);var  LDimmed: TkzDimmedForm;begin  try    LDimmed := TkzDimmedForm.Create(Self);    try      with TForm1.Create(nil) do        begin          try            Left := Random(High(Byte));            Top := Random(High(Byte));            ShowModal;          finally            Release;          end;        end;      finally        LDimmed.Free;      end;    except      on E: Exception do        ShowMessage('LDimmed: ' + E.Message);    end;end;

Handoko:
Tested using Lazarus 3.0 x86_64-linux-gtk2 on Ubuntu Mate 23.10. See the screenshot below.

If any interested to test, you can download the code below.


--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---unit Unit1; {$mode objfpc}{$H+} interface uses  Classes, Forms, Dialogs, StdCtrls, kz.forms.dimm; type   { TForm1 }   TForm1 = class(TForm)    Button1: TButton;    procedure Button1Click(Sender: TObject);  end; var  Form1: TForm1; implementation {$R *.lfm} { TForm1 } procedure TForm1.Button1Click(Sender: TObject);var  LDimmed: TkzDimmedForm;begin  try    LDimmed := TkzDimmedForm.Create(Self);    try      with TForm1.Create(nil) do        begin          try            Left := Random(High(Byte));            Top := Random(High(Byte));            ShowModal;          finally            Release;          end;        end;      finally        LDimmed.Free;      end;    except      ShowMessage('TkzDimmedForm: Error, source form not assigned!');    end;end; end.

KodeZwerg:

--- Quote from: Handoko on May 13, 2024, 06:15:51 am ---See the screenshot below.
--- End quote ---
Thank you very much again for this!
I am unsure how to interprete what I see.
First off all I am happy that my calculated locations does match!
Is now my class making the "original" form pure black?
If so, it is the alphablend feature what is not working on Ubuntu Mate 23.10.
If so, I am shocked and happy to not use Linux ;) (sarcasm) and at same time unable to do anything because I am missing information about Linux API how to test if Alphablending is supported.

Navigation

[0] Message Index

[#] Next page

Go to full version