Results 1 to 6 of 6

Thread: Verplaatbare vorm voor alle andere voorwerpen

  1. #1
    Senior Member
    Join Date
    Aug 2003
    Location
    Vlaardingen
    Posts
    106

    Verplaatbare vorm voor alle andere voorwerpen

    Click image for larger version. 

Name:	Verplaatbare rechthoek in front.jpg 
Views:	38 
Size:	13.8 KB 
ID:	8259

    In Delphi wil ik een rechthoek kunnen verplaatsen met een transparante binnenkant en hij moet helemaal vooraan komen.
    Als ik een TShape neem dan kan ik zo'n rechthoek makkelijk maken en als ik hem dan versleep dan verdwijnt hij achter de andere controls en dat wil ik niet, want hij moet ervoor.
    Dit komt omdat TShape geen TWincontrol is. BringToFront werkt dan niet.

    Het plaatje als bijlage komt uit Word. Als ik de witte rechthoek over de zwarte heen sleep dan zie ik het gestreepte vierkant erover heen en niet erachter en dat wil ik ook.
    Hoe krijg ik dit voor elkaar in Delphi.

  2. #2
    Senior Member
    Join Date
    Aug 2003
    Location
    Vlaardingen
    Posts
    106
    Op https://tips.delphidabbler.com/tips/74.html staat How to create components with a transparent background.

    Alleen de events moeten nog even gekoppeld worden.
    procedure TForm1.FormCreate(Sender: TObject); aan OnCreate
    procedure TForm1.swe3(Sender: TObject); aan OnPaint

    En dan werkt het!

  3. #3
    Senior Member
    Join Date
    Aug 2003
    Location
    Vlaardingen
    Posts
    106
    Na lang zwoegen heb ik een werkende versie. Alleen hij flikkert een beetje.


    Code:
    unit Unit1;
    
    interface
    
    uses
      Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
      System.Classes, Vcl.Graphics,
      Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.AppEvnts, Vcl.StdCtrls,
      Vcl.ExtCtrls, Vcl.Imaging.jpeg;
    
    type
      TForm1 = class(TForm)
        ApplicationEvents1: TApplicationEvents;
        TeVerplaatsenMetMuisWinControl: TGroupBox;
    
        //Overige willekeurige componten om overheen te hooveren
        GroupBox2: TGroupBox;
        Edit1: TEdit;
        Label1: TLabel;
        Button1: TButton;
        //
        procedure ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
        procedure FormCreate(Sender: TObject);
      private
        FMousePt: TPoint;
        FOldPt: TPoint;
        iStartX: Integer;
        iStartY: Integer;
        iGroupBoxX:Integer;
        iGroupBoxY:Integer;
    
        procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
      public
        { Public declarations }
      end;
    
    var
      Form1: TForm1;
    
    implementation
    
    {$R *.dfm}
    
    procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
      var Handled: Boolean);
    var
      R: TRect;
      Pt: TPoint;
      DC: HDC;
      Rgn: HRGN;
    begin
      if Msg.Message = WM_LBUTTONUP then
      begin
        TeVerplaatsenMetMuisWinControl.Visible := True;
        TeVerplaatsenMetMuisWinControl.BringToFront;
        iStartX := -1;
        iStartY := -1;
      end;
    
      if Msg.Message = WM_MOUSEMOVE then
      begin
        FMousePt := Point(-1, -1);
    
        if (FOldPt.X > 0) and (FOldPt.Y > 0) then
        begin
          R := TeVerplaatsenMetMuisWinControl.BoundsRect;
          InvalidateRect(Handle, @R, True);
          RedrawWindow(Handle, @R, 0, RDW_INVALIDATE or RDW_UPDATENOW or
            RDW_ALLCHILDREN);
        end;
    
        if Msg.hwnd = Handle then
        begin
          FMousePt := SmallPointToPoint(TSmallPoint(Msg.lParam));
        end
        else
        begin
          if GetAncestor(Msg.hwnd, GA_ROOT) = Handle then
          begin
            Pt := SmallPointToPoint(TSmallPoint(Msg.lParam));
            Winapi.Windows.ClientToScreen(Msg.hwnd, Pt);
            FMousePt := ScreenToClient(Pt);
    
            TeVerplaatsenMetMuisWinControl.Cursor := crSizeAll;
            if Msg.wParam = Msg.wParam or MK_LBUTTON then
            begin
              if (iStartX = -1) and (iStartY = -1) then
              begin
                iStartX := Pt.X;
                iStartY := Pt.Y;
                iGroupBoxX := TeVerplaatsenMetMuisWinControl.Left;
                iGroupBoxY := TeVerplaatsenMetMuisWinControl.Top;
              end;
    
              TeVerplaatsenMetMuisWinControl.Visible := False;
              TeVerplaatsenMetMuisWinControl.Left := iGroupBoxX + Pt.X -iStartX;
              TeVerplaatsenMetMuisWinControl.Top := iGroupboxY + Pt.Y - iStartY;
    
              if PtInRect(ClientRect, FMousePt) then
              begin
                R := TeVerplaatsenMetMuisWinControl.BoundsRect;
                FOldPt := FMousePt;
                DC := GetDCEx(Handle, 0, DCX_PARENTCLIP);
                Rgn := CreateRectRgn(ClientRect.Left, ClientRect.Top, ClientRect.Right,
                  ClientRect.Bottom);
                SelectClipRgn(DC, Rgn);
                DeleteObject(Rgn);
                SelectObject(DC, GetStockObject(NULL_BRUSH));
                Rectangle(DC, TeVerplaatsenMetMuisWinControl.BoundsRect.Left, TeVerplaatsenMetMuisWinControl.BoundsRect.Top,
                  TeVerplaatsenMetMuisWinControl.BoundsRect.Right, TeVerplaatsenMetMuisWinControl.BoundsRect.Bottom);
                ReleaseDC(Handle, DC);
              end;
            end
          end
        end;
    
    
      end;
    end;
    
    procedure TForm1.FormCreate(Sender: TObject);
    begin
      iStartX := -1;
      iStartY := -1;
      iGroupBoxX := TeVerplaatsenMetMuisWinControl.Left;
      iGroupBoxY := TeVerplaatsenMetMuisWinControl.Top;
    end;
    
    procedure TForm1.WMPaint(var Message: TWMPaint);
    begin
      inherited;
    end;
    
    end.
    En hier de dfm file

    Code:
    object Form1: TForm1
      Left = 0
      Top = 0
      Caption = 'Form1'
      ClientHeight = 411
      ClientWidth = 852
      Color = clBtnFace
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -11
      Font.Name = 'Tahoma'
      Font.Style = []
      OldCreateOrder = False
      OnCreate = FormCreate
      PixelsPerInch = 96
      TextHeight = 13
      object Label1: TLabel
        Left = 592
        Top = 264
        Width = 31
        Height = 13
        Caption = 'Label1'
      end
      object TeVerplaatsenMetMuisWinControl: TGroupBox
        Left = 80
        Top = 160
        Width = 201
        Height = 105
        Caption = 'Sleep deze control over de anderen'
        TabOrder = 0
      end
      object GroupBox2: TGroupBox
        Left = 592
        Top = 88
        Width = 185
        Height = 105
        Caption = 'GroupBox2'
        TabOrder = 1
      end
      object Edit1: TEdit
        Left = 592
        Top = 40
        Width = 121
        Height = 21
        TabOrder = 2
        Text = 'Edit1'
      end
      object Button1: TButton
        Left = 592
        Top = 216
        Width = 75
        Height = 25
        Caption = 'Button1'
        TabOrder = 3
      end
      object ApplicationEvents1: TApplicationEvents
        OnMessage = ApplicationEvents1Message
        Left = 136
        Top = 64
      end
    end

  4. #4
    Probeer eens om de property DoubleBuffered van je form op True te zetten.
    Dat zorgt dat je hele form eerst op een aparte bitmap wordt getekend die vervolgens in één keer op het scherm wordt getekend. In veel gevallen lost dat dit soort geknipper grotendeels op.
    1+1=b

  5. #5
    property DoubleBuffered Form werkt niet. Zie ik hier.
    Ik gebruik een afgeleide van TSplitter:
    RedrawWindow(Handle, nil, 0, RDW_ERASE or RDW_FRAME or RDW_INVALIDATE or RDW_ALLCHILDREN);
    zit wat anders in elkaar maar wie weet.
    Source van jou heb ik niet meer want moest even back-up terug van die irritante 11.2.

  6. #6
    Senior Member
    Join Date
    Aug 2003
    Location
    Vlaardingen
    Posts
    106
    Quote Originally Posted by DragonFly View Post
    property DoubleBuffered Form werkt niet. Zie ik hier.
    Ik gebruik een afgeleide van TSplitter:
    RedrawWindow(Handle, nil, 0, RDW_ERASE or RDW_FRAME or RDW_INVALIDATE or RDW_ALLCHILDREN);
    zit wat anders in elkaar maar wie weet.
    Source van jou heb ik niet meer want moest even back-up terug van die irritante 11.2.
    De oorspronkelijke versie die ik had, werkt toch net iets beter:

    Code:
    RedrawWindow(Handle, @R, 0, RDW_INVALIDATE or RDW_UPDATENOW or RDW_ALLCHILDREN);
    Ik heb ook jouw oplossing geprobeerd met @R (@R zorgt dat alleen de rect geredrawd wordt) zonder @R met nil knippert het hele scherm.

    Code:
    RedrawWindow(Handle, @R, 0, RDW_ERASE or RDW_FRAME or RDW_INVALIDATE or RDW_ALLCHILDREN);
    Tot mijn grote verbazing knippert zelfs bij Word de rechthoek (Inmiddels weet ik dat zo'n rechthoek een rubber band heet
    https://docs.microsoft.com/en-us/cpp...?view=msvc-170).

    Dus ik ben eigenlijk wel tevreden.

    Zelfs een TSplitter knippert behoorlijk als hij op rsPattern staat.

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •