Recent

Author Topic: GTK2 Shaped Topmost Form  (Read 461 times)

HuntingKashket

  • New Member
  • *
  • Posts: 33
  • I'm interested in upgrading everything
GTK2 Shaped Topmost Form
« on: June 04, 2019, 08:33:14 pm »
Hello everyone!
If someone knows how to deal with it, please reply, including if it's a few days after last message, so...
I have trouble with creating topmost and shaped form at once, maybe i've getting error because of fsStayOnTop style, maybe because it's actually MDI-like forms, which have a parent window.
The code can be found here -> https://github.com/Kashaket/sizectrl/tree/master/Demo/Src
or part of it, which i assume as problematic, you can see below:
Paiting/drawing:
Code: Pascal  [Select]
  1. //------------------------------------------------------------------------------
  2. // TSizeBtn methods
  3. //------------------------------------------------------------------------------
  4.  
  5. constructor TSizeBtn.Create(TargetObj: TTargetObj; BtnPos: TBtnPos);
  6. begin
  7.   inherited CreateNew(nil);
  8.   Loaded; //to prevent Delphi, and maybe Lazarus from multiple warnings
  9.   fTargetObj := TargetObj;
  10.   AutoSize := False;
  11.   Visible := False;//Changes when necessary
  12.   Position := poDesigned;
  13.   Width := fTargetObj.fSizeCtrl.BtnSize;
  14.   Height := fTargetObj.fSizeCtrl.BtnSize;
  15.   FormStyle := fsStayOnTop;
  16.   BorderIcons := [];
  17.   BorderStyle := bsNone;
  18.   fHover := false;
  19.   fHoverDown := false;
  20.   OnPaint := doPaint;
  21.   {
  22.    OnMouseEnter := mEnter;
  23.    OnMouseLeave := mLeave;
  24.   } //<--does not matter, just color changing
  25.   fPos := BtnPos;
  26.   UpdateBtnCursorAndColor;//Just procedure, which checking is it disabled or not, and then calling Repaint method
  27. end;        
  28.  
  29.  
  30. //------------------------------------------------------------------------------
  31.  
  32. procedure TSizeBtn.PaintAs(l,t:integer);
  33. {$IFDEF FPC}
  34. var b:Graphics.TBitmap;
  35.   {$ENDIF}
  36. begin
  37.   if Assigned(fImage.Graphic) and not(fImage.Graphic.Empty) then
  38.   begin
  39.     if fTargetObj.fSizeCtrl.StretchBtnImage then
  40.       Canvas.StretchDraw(Rect(l,t, width, height), fImage.Graphic)
  41.     else
  42.     begin
  43.       Canvas.Draw(l,t, fImage.Graphic);
  44.      {$IFDEF FPC}
  45.       Self.SetShape(fImage.Bitmap);
  46.      {$ENDIF}
  47.     end;
  48.   end
  49.   else
  50.   {$IFDEF FPC}
  51.   begin
  52.     b := Graphics.TBitmap.Create;
  53.     b.Width := Self.Width;
  54.     b.Height:= Self.Height;
  55.     b.Transparent:=True;
  56.     b.TransparentColor := clBlack;
  57.     b.Canvas.Brush.Assign(Self.Canvas.Brush);
  58.     b.Canvas.Pen.Assign(Self.Canvas.Pen);
  59.   {$ENDIF}
  60.   case fTargetObj.fSizeCtrl.BtnShape of
  61.      tszbSquare:
  62.      {$IFDEF FPC}b.{$ENDIF}
  63.       Canvas.Rectangle(l,t, l+Width, t+Height);
  64.      tszbTriangle:
  65.       DrawTriangle({$IFDEF FPC}b,{$ENDIF}l,t);
  66.      tszbCircle:
  67.      {$IFDEF FPC}b.{$ENDIF}
  68.       Canvas.Ellipse(l,t, l+Width, t+Height);
  69.      tszbMockTube:
  70.      begin
  71.      {$IFDEF FPC}b.{$ENDIF}
  72.       Canvas.Ellipse(l,t,l+Width,t+Height);
  73.       DrawTriangle({$IFDEF FPC}b,{$ENDIF}l,t);
  74.      end;
  75.      tszbRoundRect:
  76.      {$IFDEF FPC}b.{$ENDIF}
  77.       Canvas.RoundRect(l,t,l+Width,t+Height, (Width+Height) div 4,(Width+Height) div 4);
  78.      tszbRhombus:
  79.      {$IFDEF FPC}b.{$ENDIF}
  80.       Canvas.Polygon(
  81.       [Point(l,t+Ceil(Height/2)-1),
  82.       Point(l+Ceil(Width/2)-1, t),
  83.       Point(l+Width-1,t+Ceil(Height/2)-1),
  84.       Point(l+Ceil(Width/2)-1, t+Height-1)]);
  85.   end;
  86.   {$IFDEF FPC}
  87.   Canvas.Draw(0,0,b);
  88.   b.Monochrome:=True;//Crash is gone, but problems is not
  89.   Self.SetShape(b);//<--Causes crash
  90.   b.Free;
  91.   end;
  92.   {$ENDIF}
  93. end;                              
  94.  

Visible changing (positioning and showing):
Code: Pascal  [Select]
  1. //------------------------------------------------------------------------------
  2.  
  3. procedure TTargetObj.Update;
  4. var
  5.   i: TBtnPos;
  6.   {$IFNDEF FPC}
  7.   st: boolean;//Used for SeZOrder method, which is not present in FPC realization,so...
  8.   {$ENDIF}
  9.   parentForm: TCustomForm;
  10.   tl: TPoint;
  11.   bsDiv2: integer;
  12. begin
  13.     parentForm := fSizeCtrl.fParentForm;
  14.   if not assigned(parentForm) then
  15.     exit;
  16.   //get topleft of Target relative to parentForm ...
  17.   tl := GetBoundsAsScreenRect(fTarget).TopLeft;
  18.   //topleft := fTarget.BoundsRect.TopLeft;
  19.   tl := parentForm.ScreenToClient(tl);
  20.   bsDiv2 := (fSizeCtrl.BtnSize div 2);
  21.  
  22.   for i := bpLeft to fSizeCtrl.LastBtn do
  23.   begin
  24.   if fBtns[i].ParentWindow <> parentForm.Handle then
  25.   begin
  26.     fBtns[i].ParentWindow := parentForm.Handle; //ie keep btns separate !!!
  27.     //just to be sure, that our button will be displayed correctly
  28.     fBtns[i].Position := poDesigned;
  29.   end;
  30.     fBtns[i].Left := tl.X - bsDiv2;
  31.     case i of
  32.       bpTop, bpBottom:
  33.         fBtns[i].Left := fBtns[i].Left + (fTarget.Width div 2);
  34.       bpRight, bpTopRight, bpBottomRight:
  35.         fBtns[i].Left := fBtns[i].Left + fTarget.Width - 1;
  36.     end;
  37.     fBtns[i].Top := tl.Y - bsDiv2;
  38.     case i of
  39.       bpLeft, bpRight:
  40.         fBtns[i].Top := fBtns[i].Top + (fTarget.Height div 2);
  41.       bpBottomLeft, bpBottom, bpBottomRight:
  42.         fBtns[i].Top := fBtns[i].Top + fTarget.Height - 1;
  43.     end;
  44.     if not fBtns[i].Visible then
  45.     fBtns[i].Visible := True;//Show it
  46.     {$IFDEF FPC}
  47.     fBtns[i].Update;//reduce button flicker
  48.     {$ENDIF}
  49.   end;
  50. end;                                                              
  51.  
  52.  

Errors list:
https://ibb.co/HKKV0wf
https://ibb.co/KWfdyhV
https://ibb.co/YR9RSJQ

Final bug, caused by assertions fail (instead of setting TSizeBtn style, it changes style for the main form):
https://ibb.co/41sJ3WS

Widgetset and other:
Cross-compiler - Windows x86_64 -> linux + GTK2 (Lazarus 2.1, FPC 3.1)
OS, which is on the screens - Ubuntu 18.0.4, x64,  with GTK3/GTK2 widgets support
« Last Edit: June 04, 2019, 08:41:59 pm by HuntingKashket »
Leu Zenin
-------------------------------
Lazarus 2.1.0  with FPC 3.1
Windows 8.1 x64

HuntingKashket

  • New Member
  • *
  • Posts: 33
  • I'm interested in upgrading everything
Re: GTK2 Shaped Topmost Form
« Reply #1 on: June 05, 2019, 08:51:32 am »
This is GTK issue, so i cannot fix that in my program... Well, i try to find out why is it so
Leu Zenin
-------------------------------
Lazarus 2.1.0  with FPC 3.1
Windows 8.1 x64

zeljko

  • Hero Member
  • *****
  • Posts: 1087
    • http://wiki.lazarus.freepascal.org/User:Zeljan
Re: GTK2 Shaped Topmost Form
« Reply #2 on: June 05, 2019, 10:36:20 am »
For setShape() under Gtk2 handle MUST be allocated and that means that X11 window must be mapped, so Handle->Show->Now set shape.

HuntingKashket

  • New Member
  • *
  • Posts: 33
  • I'm interested in upgrading everything
Re: GTK2 Shaped Topmost Form
« Reply #3 on: June 05, 2019, 07:51:52 pm »
For setShape() under Gtk2 handle MUST be allocated and that means that X11 window must be mapped, so Handle->Show->Now set shape.
Flickering when main form loses its border is gone, but... it still loses the border when i'm trying to set the shape of other forms
Leu Zenin
-------------------------------
Lazarus 2.1.0  with FPC 3.1
Windows 8.1 x64