Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   GUI-Design mit VCL / FireMonkey / Common Controls (https://www.delphipraxis.net/18-gui-design-mit-vcl-firemonkey-common-controls/)
-   -   TFramePanel, Panel mit "Loch" (https://www.delphipraxis.net/159798-tframepanel-panel-mit-loch.html)

Satty67 13. Apr 2011 10:26


TFramePanel, Panel mit "Loch"
 
Hallo,

ich brauchte einen Rahmen, der sich um ein TMemo legt und weitere Controls aufnehmen kann (Skalierungslineale, SizeButtons etc.) Hab' dafür ein Panel missbraucht und per Region hingebogen.
Ist nur eine Art Studie, aber vieleicht kann es jemand als Basis gebrauchen.

Delphi-Quellcode:
unit UFramePanel;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TFramePanel = class(TPanel)
  private
    FFrameWidth : Integer;
    procedure SetFrameWidth(const Value: Integer);
    procedure UpdateWindowRegion;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property FrameWidth : Integer read FFrameWidth write SetFrameWidth;
  end;

implementation

function GetFramedRegion(Width, Height, FrameWidth : Integer): HWnd;
const
  count = 11;
var
  points : array[0..(count-1)] of TPoint;
begin
  points[0].X := 0;
  points[0].Y := 0;
  points[1].X := FrameWidth;
  points[1].Y := FrameWidth;
  points[2].X := FrameWidth;
  points[2].Y := Height - FrameWidth;
  points[3].X := Width - FrameWidth;
  points[3].Y := Height - FrameWidth;
  points[4].X := Width - FrameWidth;
  points[4].Y := FrameWidth;
  points[5].X := FrameWidth;
  points[5].Y := FrameWidth;
  points[6].X := 0;
  points[6].Y := 0;
  points[7].X := Width;
  points[7].Y := 0;
  points[8].X := Width;
  points[8].Y := Height;
  points[9].X := 0;
  points[9].Y := Height;
  points[10].X := 0;
  points[10].Y := 0;
  Result := CreatePolygonRgn(points, count, ALTERNATE); { ALTERNATE, WINDING }
  //ShowMessage(SysErrorMessage(GetLastError));
end;

constructor TFramePanel.Create(AOwner: TComponent);
begin
  inherited;
  FFrameWidth := 0;
end;

procedure TFramePanel.UpdateWindowRegion;
var
  HRegion : HWnd;
begin
  if (Width > 2) and (Height > 2) then
  begin
    HRegion := GetFramedRegion(width, height, FFrameWidth);
    SetWindowRGN(Handle, HRegion, True);
  end;
end;

procedure TFramePanel.SetFrameWidth(const Value: Integer);
begin
  if Value <= 1 then
    FFrameWidth := 2
  else if (Value >= (width div 2)) then
    FFrameWidth := (width div 2) -1
  else
    FFrameWidth := Value;
  UpdateWindowRegion;
end;

end.
Delphi-Quellcode:
procedure TForm1.FormCreate(Sender: TObject);
var
  APanel : TFramePanel;
begin
  APanel := TFramePanel.Create(self);
  APanel.Parent := self;
  APanel.Width := 200;
  APanel.Height := 200;
  APanel.Top := 10;
  APanel.Left := 10;
  APanel.Color := clRed;
  APanel.FrameWidth := 20;
end;

uligerhardt 13. Apr 2011 10:30

AW: TFramePanel, Panel mit "Loch"
 
Warum nimmst du nicht einfach ein ganz normales Panel (ohne Löcher) und legst das Memo darauf?

Satty67 13. Apr 2011 11:05

AW: TFramePanel, Panel mit "Loch"
 
Ich wusste, das ich schon wieder zuviel geschrieben hatte ;)

Das ist nur eine Studie, den Anwendungszweck bitte ignorieren. Hab' auch Experimente mit TGraphicControl und Einzel-Elementen (Lineale, SizeControl) am laufen. Wie ich es letztlich umsetze ist noch völlig offen. (Parent der Memos sollte auf Ursprung bleiben, wenn die Hilfs-Elemente eingeblendet werden...)

Fand nur das Zwischenergebnis mit dem FramePanel so witzig, das ich es gleich gepostet habe.

uligerhardt 13. Apr 2011 11:13

AW: TFramePanel, Panel mit "Loch"
 
Zitat:

Zitat von Satty67 (Beitrag 1094816)
Ich wusste, das ich schon wieder zuviel geschrieben hatte ;)

:-) Jaja, der Spieltrieb.

stahli 16. Okt 2011 00:46

AW: TFramePanel, Panel mit "Loch"
 
Liste der Anhänge anzeigen (Anzahl: 2)
Als Spieltrieb würde ich das nicht abtun, mir hat es jetzt gut geholfen.
Danke an Satty67!

In meinem Fall wird das so eine Art Schieberegler, der über diversen anderen Controls sitzt.
Es ist nur ein erster Versuch bisher aber es scheint ein guter Weg.
Die zwei Controls sind nur ein Test, sie sind (natürlich) nur auf dem sichtbaren Bereich zu sehen.

Anbei mal zwei Screenshots mit den kompletten und den ausgestanzten Panels.

PS: Dynamische Arrays funktionieren offenbar nicht.

Bummi 16. Okt 2011 08:35

AW: TFramePanel, Panel mit "Loch"
 
Dynamische Array's funktionieren ebenfalls, das erste Element als Parameter verwenden (P[0]).
Wichtig wäre noch die Regions nach Verwendung mit DeleteObject freizugeben, sonnst gehen Windows ganz schnell die Handles aus.

stahli 16. Okt 2011 12:24

AW: TFramePanel, Panel mit "Loch"
 
Zitat:

Zitat von Bummi (Beitrag 1130677)
Dynamische Array's funktionieren ebenfalls, das erste Element als Parameter verwenden (P[0]).

Danke, funktioniert perfekt. :thumb:

Zitat:

Zitat von Bummi (Beitrag 1130677)
Wichtig wäre noch die Regions nach Verwendung mit DeleteObject freizugeben, sonnst gehen Windows ganz schnell die Handles aus.

Ich dachte, Windows kümmert sich darum... EurekaLog hat auch nix gemeckert.
In der Hilfe habe ich auch jetzt noch nichts entsprechendes gefunden.

Anbei nochmal der neue korrigierte Quelltext:

Delphi-Quellcode:
function TvSchedulePoint.GetFramedRegion(StyleBottom: Boolean): HWnd;
var
  Points: array of TPoint;
  W, H: Integer;
  BH, LL, LR, LW: Integer;
  C: Integer;

  procedure Add(X, Y: Integer);
  begin
    if StyleBottom then
      Y := H - Y;
    Inc(C);
    SetLength(Points, C);
    Points[Pred(C)].X := X;
    Points[Pred(C)].Y := Y;
  end;

begin
  C := 0;
  W := Width - 1;
  H := Height - 1;
  BH := 16;
  LW := 2;
  LL := (W div 2) - (LW div 2);
  LR := (W div 2) + (LW div 2);
  Add(0, BH);
  Add(LL, BH);
  Add(LL, H);
  Add(LR, H);
  Add(LR, BH);
  Add(W, BH);
  Add(W, 0);
  Add(0, 0);
  Result := CreatePolygonRgn(Points[0], C, ALTERNATE); // ALTERNATE, WINDING
end;

procedure TvSchedulePoint.UpdateWindowRegion;
var
  HRegion: HWnd;
begin
  HRegion := GetFramedRegion(True);
  SetWindowRGN(Handle, HRegion, True);
  DeleteObject(HRegion);
end;

Bummi 16. Okt 2011 13:21

AW: TFramePanel, Panel mit "Loch"
 
Zitat:

Ich dachte, Windows kümmert sich darum... EurekaLog hat auch nix gemeckert
hier wird ja kein Speicher angefordert sondern ein Handle, Du kannst ja mal ein Loop schreiben, irgendwann kommt die Meldung "out of handles", ich hatte mal so einen Schnitzer in einer Komponente, war eklig zu finden....
Die entsprechenden Hinweise findest Du bei den Regionfunktionen z.B.
http://msdn.microsoft.com/en-us/libr...(v=vs.85).aspx
http://msdn.microsoft.com/en-us/libr...(v=vs.85).aspx

Satty67 19. Nov 2011 15:30

AW: TFramePanel, Panel mit "Loch"
 
Zufällig durch einen Link in einem aktuellen Thread wieder auf diesen Thread gestossen:

Zum Freigeben der HRGN bzw. MSDN zu SetWindowRGN;

After a successful call to SetWindowRgn, the system owns the region specified by the region handle hRgn.
The system does not make a copy of the region. Thus, do not make further function calls with this region handle.
In particular, do not delete this region handle.
The system deletes the region handle when it no longer needed.


Man sollte also Stahli's Anpassung noch etwas verfeinern:
Delphi-Quellcode:
  if SetWindowRGN(Handle, HRegion, True) = 0 then
    DeleteObject(HRegion);
PS. Sieht man solche Handles eigentlich im Taskmanager als GDI Handle? Dann könnte man das prüfen...


Alle Zeitangaben in WEZ +1. Es ist jetzt 18:26 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz