Einzelnen Beitrag anzeigen

Fritzew

Registriert seit: 18. Nov 2015
Ort: Kehl
678 Beiträge
 
Delphi 11 Alexandria
 
#8

AW: Warum werden Regionen in meinem Programm nicht gezeichnet!

  Alt 7. Feb 2018, 08:27
Ich habe Dein Beispiel mal etwas überarbeitet.
Die ClipRegion gehört zum Fenster. Deshalb wird die Verschiebung des 0 Punktes dort
nicht berücksichtigt.

Vielleicht wird es etwas klarer:


Delphi-Quellcode:
program Project47;

{$APPTYPE GUI}

uses
  SysUtils,
  Windows,
  Messages,
  System.Math;

var
  wnd: HWND;
  msg: TMsg;
  wndclass: TWndClass;
  szAppName: PChar = 'Clover';


  hrgnClip: HRGN;
  cxClient: Integer;
  cyClient: Integer;


//Die Funktion hypot wird im C Originalprogramm verwendet. Die erzeugt die
//Hypotenuse von zwei gegebenen Dreiecksseiten. Habe ich von dieser Erklärung
//her zumindest so verstanden:
//C++ Reference:
//[URL="http://www.cplusplus.com/reference/cmath/hypot/"]http://www.cplusplus.com/reference/cmath/hypot/[/URL]

function hypot(a,b: double): double;
var h: double;
begin
  h := sqr(a) + sqr(b);
  Result := sqrt(h);
end;


function prepareRgn(const cxClient, cyClient : integer; const centerX, centery : integer) : HRGN;
 var lHrgn: array[0..5] of HRGN;
     lErrorRgn : integer;
     lTempRgn : HRGN;
     i : integer;
begin
  Result := 0;
  // Clear the Data
   fillchar(lHrgn, sizeof(lHrgn), 0);
 // Prepare the 4 Elliptic Regions
   lHrgn[0] := CreateEllipticRgn(0, cyClient div 3, cxClient div 2, 2*cyClient div 3);
   lHrgn[1] := CreateEllipticRgn(cxClient div 2, cyClient div 3, cxClient, 2*cyClient div 3);
   lHrgn[2] := CreateEllipticRgn(cxClient div 3, 0, 2*cxClient div 3, cyClient div 2);
   lHrgn[3] := CreateEllipticRgn(cxClient div 3, cyClient div 2, 2*cxClient div 3, cyClient);

   // Prepare 2 empty Regions;
   lHrgn[4] := CreateRectRgn(0,0,1,1);
   lHrgn[5] := CreateRectRgn(0,0,1,1);

  // Try to combine the Regions
  if (lHrgn[1] <> 0) and (lHrgn[0] <> 0) then
    lErrorRgn := CombineRgn(lHrgn[4], lHrgn[0], lHrgn[1], RGN_OR);
    if lErrorRgn in [SIMPLEREGION, COMPLEXREGION] then
    begin
       if (lHrgn[1] <> 0) and (lHrgn[0] <> 0) then
       lErrorRgn := CombineRgn(lHrgn[5], lHrgn[2], lHrgn[3], RGN_OR);
        if lErrorRgn in [SIMPLEREGION, COMPLEXREGION] then
        begin
          // Prepare the result
          lTempRgn := CreateRectRgn(0,0,1,1);
          lErrorRgn := CombineRgn(lTempRgn, lHrgn[4], lHrgn[5], RGN_OR);
           if lErrorRgn in [SIMPLEREGION, COMPLEXREGION] then
            begin
             // There is a valid result
              // Check for a Offset
              if (centerX <> 0) or (centery <> 0) then
              begin
                 lErrorRgn := OffsetRgn(lTempRgn, centerX, centery);
                  if lErrorRgn in [ERROR , NULLREGION] then
                  begin
                   DeleteObject(lTempRgn);
                   lTempRgn := 0;
                  end;
              end;
              result := lTempRgn;
            end
            // Delete the temprgn
            else DeleteObject(lTempRgn);
        end;
    end;

   if lErrorRgn in [ERROR , NULLREGION] then
    begin
     // Some Errorhandling here
    end;

  // Clean up used resources;
  for I := Low(lHrgn) to High(lHrgn) do
     if lHrgn[i] <> 0 then DeleteObject(lHrgn[i]);


end;




function WndProc(wnd: HWND; msg: UINT; w: WPARAM; l: LPARAM): LRESULT; stdcall;
var
  fAngle,fRadius: double;
  cursor: HCURSOR;
  dc: HDC;
  i: Integer;
  ps: TPaintStruct;
  pen,penold: HPEN;

begin
  case msg of
    WM_SIZE:
      begin
        cxClient := LOWORD(l);
        cyClient := HIWORD(l);
        cursor := SetCursor(LoadCursor(0, IDC_WAIT));
        ShowCursor(true);

        if hRgnClip <> 0 then DeleteObject(hRgnClip);

        // Create the RGN with a Offset from 100 from left top
        hRgnClip := prepareRgn(cxClient, cyClient, 100, 100);

        ShowCursor(false);
        SetCursor(cursor);

      end;
   
    WM_PAINT:
      begin
        dc := BeginPaint(wnd, ps);
         //SelectClipRgn(dc, hRgnClip);

        if hrgnClip <> 0 then
        begin
         FrameRgn(dc, hrgnClip, GetStockObject(LTGRAY_BRUSH), 2,2);
         SelectClipRgn(dc, hRgnClip);
        end;

         // Move the Drawing to the Center
        SetViewPortOrgEx(dc, cxClient div 2, cyClient div 2, nil);

        fRadius := hypot(cxClient / 2.0, cyClient / 2.0);

        //Hatte zuerst gedacht, ich brauchte einen Stift, um zeichnen zu
        //können, wie auch auf einem Blatt Papier
        pen := CreatePen(PS_SOLID,1,RGB(0,0,255));
        penold := SelectObject(dc, pen);

        fAngle := 0.0;
        for i := 0 to 359 do
        begin
          fangle := degToRad(i);
          MoveToEx(dc,0,0,nil);
          LineTo(dc,Round(fRadius*cos(fAngle)+0.5),Round(-fRadius*sin(fAngle)+0.5));
        end;

        // Restore old Pen and delete pen
        SelectObject(dc,penold);
        DeleteObject(pen);

        // Restore the Clip
        SelectClipRgn(dc, 0);
        EndPaint(wnd, ps);
      end;
    WM_DESTROY:
      begin
        DeleteObject(hRgnClip);
        PostQuitMessage(0);
      end;
  end;
  Result := DefWindowProc(wnd,msg,w,l);
end;

begin
  { TODO -oUser -cConsole Main : Insert code here }
  wndclass.style := CS_HREDRAW or CS_VREDRAW;
  wndclass.lpfnWndProc := @WndProc;
  wndclass.cbClsExtra := 0;
  wndclass.cbWndExtra := 0;
  wndclass.hInstance := hInstance; //Innerhalb Windows definiert!
  wndclass.hIcon := LoadIcon(hInstance,IDI_APPLICATION);
  wndclass.hCursor := LoadCursor(Longint(NIL), IDC_ARROW);
  wndclass.hbrBackground := HBRUSH(GetStockObject(WHITE_BRUSH));
  wndclass.lpszMenuName := NIL;
  wndclass.lpszClassName := szAppName;

  if not Boolean(RegisterClass(wndclass)) then
  begin
    MessageBox(0,'Dieses Programm erfordert Windows NT!', szAppName, MB_ICONERROR);
    Halt(1);
  end;

  wnd := CreateWindow(szAppName, 'Zeichne ein Kleeblatt',
               WS_OVERLAPPEDWINDOW,
               CW_USEDEFAULT, CW_USEDEFAULT,
               CW_USEDEFAULT, CW_USEDEFAULT,
               0, 0, hInstance, nil
          );

  ShowWindow(wnd, Sw_Shownormal);
  UpdateWindow(wnd);

  while GetMessage(msg,0,0,0) do
  begin
    TranslateMessage(msg);
    DispatchMessage(msg);
  end;

end.
Fritz Westermann
  Mit Zitat antworten Zitat