Changeset 463 for branches/highdpi/Packages/CevoComponents/BaseWin.pas

Timestamp:

Nov 29, 2023, 2:35:44 PM (6 months ago)

Author:

chronos

Message:

• Modified: HighDpi branch updated to trunk version.

File:

• branches/highdpi/Packages/CevoComponents/BaseWin.pas (modified) (21 diffs)

branches/highdpi/Packages/CevoComponents/BaseWin.pas

@@ -8 +8 @@
 
 type
-  TShowNewContent = procedure (NewMode: Integer; HelpContext: string) of object;
+  TWindowMode = (wmNone, wmModal, wmPersistent, wmSubmodal);
+  TShowNewContent = procedure (NewMode: TWindowMode; HelpContext: string) of object;
 
   { TBufferedDrawDlg }
 
   TBufferedDrawDlg = class(TDrawDlg)
+  protected
+    FWindowMode: TWindowMode;
+    ModalFrameIndent: Integer;
+    HelpContext: string;
+    procedure ShowNewContent(NewMode: TWindowMode; ForceClose: Boolean = False);
+    procedure MarkUsedOffscreen(xMax, yMax: Integer);
+    procedure OffscreenPaint; virtual;
+    procedure VPaint; virtual;
   public
     UserLeft: Integer;
     UserTop: Integer;
+    UsedOffscreenWidth: Integer;
+    UsedOffscreenHeight: Integer;
+    Offscreen: TDpiBitmap;
+    OffscreenUser: TDpiForm;
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
@@ -22 +35 @@
     procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
     procedure FormDeactivate(Sender: TObject);
-    procedure SmartUpdateContent(ImmUpdate: Boolean = false);
+    procedure SmartUpdateContent(ImmUpdate: Boolean = False);
     procedure StayOnTop_Workaround;
-  protected
-    FWindowMode: Integer;
-    ModalFrameIndent: Integer;
-    HelpContext: string;
-    procedure ShowNewContent(NewMode: Integer; ForceClose: Boolean = False);
-    procedure MarkUsedOffscreen(xMax, yMax: Integer);
-    procedure OffscreenPaint; virtual;
-    procedure VPaint; virtual;
-  public
-    UsedOffscreenWidth: Integer;
-    UsedOffscreenHeight: Integer;
-    Offscreen: TDpiBitmap;
-    OffscreenUser: TDpiForm;
-    property WindowMode: integer read FWindowMode;
+    property WindowMode: TWindowMode read FWindowMode;
   end;
 
   TFramedDlg = class(TBufferedDrawDlg)
-  public
-    constructor Create(AOwner: TComponent); override;
-    procedure FormCreate(Sender: TObject);
-    procedure SmartInvalidate; override;
   protected
     CaptionLeft: Integer;
     CaptionRight: Integer;
     InnerWidth: Integer;
-    InnerHeight: integer;
+    InnerHeight: Integer;
     WideBottom: Boolean;
     FullCaption: Boolean;
@@ -57 +53 @@
     procedure VPaint; override;
     procedure FillOffscreen(Left, Top, Width, Height: Integer);
+  public
+    constructor Create(AOwner: TComponent); override;
+    procedure FormCreate(Sender: TObject);
+    procedure SmartInvalidate; override;
   end;
 
@@ -64 +64 @@
 
 const
-  // window modes
-  wmNone = 0;
-  wmModal = $1;
-  wmPersistent = $2;
-  wmSubmodal = $3;
-
   yUnused = 161;
   NarrowFrame = 11;
@@ -76 +70 @@
 
 procedure CreateOffscreen(var Offscreen: TDpiBitmap);
+function WindowModeMakePersistent(Mode: TWindowMode): TWindowMode;
 procedure Register;
 
@@ -83 +78 @@
 uses
   ButtonBase, Area;
+
+function WindowModeMakePersistent(Mode: TWindowMode): TWindowMode;
+begin
+  if Mode = wmModal then Result := wmSubmodal
+    else Result := wmPersistent;
+end;
 
 procedure Register;
@@ -118 +119 @@
     UserTop := Top;
   end;
-  if OffscreenUser = self then
+  if OffscreenUser = Self then
     OffscreenUser := nil;
 end;
@@ -124 +125 @@
 procedure TBufferedDrawDlg.FormPaint(Sender: TObject);
 begin
-  if OffscreenUser <> self then
+  if OffscreenUser <> Self then
     OffscreenPaint;
   VPaint;
@@ -142 +143 @@
   if Key = VK_F1 then begin
     if Assigned(ShowNewContentProc) then
-      ShowNewContentProc(FWindowMode or wmPersistent, HelpContext);
+      ShowNewContentProc(WindowModeMakePersistent(FWindowMode), HelpContext);
   end else
   if FWindowMode = wmPersistent then begin
@@ -165 +166 @@
 procedure TBufferedDrawDlg.VPaint;
 begin
-  DpiBitCanvas(Canvas, 0, 0, ClientWidth, ClientHeight, Offscreen.Canvas, 0, 0);
-end;
-
-procedure TBufferedDrawDlg.ShowNewContent(NewMode: Integer;
+  DpiBitBltCanvas(Canvas, 0, 0, ClientWidth, ClientHeight, Offscreen.Canvas, 0, 0);
+end;
+
+procedure TBufferedDrawDlg.ShowNewContent(NewMode: TWindowMode;
   ForceClose: Boolean);
 begin
@@ -178 +179 @@
       UserLeft := Left;
       UserTop := Top;
-      Visible := false;
+      Visible := False;
       FWindowMode := NewMode;
       ShowModal;
@@ -184 +185 @@
     else if forceclose then
     begin // make modal
-      Visible := false;
+      Visible := False;
       FWindowMode := NewMode;
       Left := UserLeft;
@@ -204 +205 @@
     Left := UserLeft;
     Top := UserTop;
-    if FWindowMode = wmModal then
-      ShowModal
+    if FWindowMode = wmModal then begin
+      Gtk2Fix;
+      ShowModal;
+    end
     else
       Show;
@@ -268 +271 @@
 procedure TFramedDlg.SmartInvalidate;
 var
-  i, BottomFrame: integer;
+  I, BottomFrame: Integer;
   r0, r1: HRgn;
 begin
@@ -277 +280 @@
   r0 := DpiCreateRectRgn(SideFrame, TitleHeight, ClientWidth - SideFrame,
     ClientHeight - BottomFrame);
-  for i := 0 to ControlCount - 1 do
-    if not(Controls[i] is TArea) and Controls[i].Visible then
+  for I := 0 to ControlCount - 1 do
+    if not(Controls[I] is TArea) and Controls[I].Visible then
     begin
-      with Controls[i].BoundsRect do
+      with Controls[I].BoundsRect do
         r1 := DpiCreateRectRgn(Left, Top, Right, Bottom);
       CombineRgn(r0, r0, r1, RGN_DIFF);
@@ -291 +294 @@
 procedure TFramedDlg.VPaint;
 
-  procedure CornerFrame(x0, y0, x1, y1: integer);
+  procedure CornerFrame(x0, y0, x1, y1: Integer);
   begin
     Frame(Canvas, x0 + 1, y0 + 1, x1 - 2, y1 - 2, MainTexture.ColorBevelLight,
@@ -304 +307 @@
 
 var
-  i, l, FrameTop, FrameBottom, InnerBottom, Cut, xTexOffset,
-    yTexOffset: integer;
+  I, L, FrameTop, FrameBottom, InnerBottom, Cut, xTexOffset,
+    yTexOffset: Integer;
   R: TRect;
 begin
@@ -317 +320 @@
   end;
   Canvas.Font.Assign(UniFont[ftCaption]);
-  l := BiColorTextWidth(Canvas, Caption);
-  Cut := (ClientWidth - l) div 2;
+  L := BiColorTextWidth(Canvas, Caption);
+  Cut := (ClientWidth - L) div 2;
   xTexOffset := (Maintexture.Width - ClientWidth) div 2;
   yTexOffset := (Maintexture.Height - ClientHeight) div 2;
@@ -442 +445 @@
   RisedTextOut(Canvas, Cut - 1, 7, Caption);
 
-  for i := 0 to ControlCount - 1 do
-    if Controls[i].Visible and (Controls[i] is TButtonBase) then
+  for I := 0 to ControlCount - 1 do
+    if Controls[I].Visible and (Controls[I] is TButtonBase) then
     begin
-      R := Controls[i].BoundsRect;
+      R := Controls[I].BoundsRect;
       if (R.Bottom <= TitleHeight) or (R.Top >= InnerBottom) then
         BtnFrame(Canvas, R, MainTexture);
     end;
 
-  DpiBitCanvas(Canvas, SideFrame, TitleHeight, ClientWidth - 2 * SideFrame,
+  DpiBitBltCanvas(Canvas, SideFrame, TitleHeight, ClientWidth - 2 * SideFrame,
     InnerBottom - TitleHeight, Offscreen.Canvas, 0, 0);
 end;
@@ -459 +462 @@
 begin
   if FullCaption then
-    exit;
+    Exit;
   r0 := DpiCreateRectRgn(0, 0, ClientWidth, ClientHeight);
   r1 := DpiCreateRectRgn(0, 0, CaptionLeft, TitleHeight - NarrowFrame);
@@ -509 +512 @@
 MainFormKeyDown := nil;
 
-finalization
-
 end.