Made MWindow.Free/Unfreeze

git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@68 3f818213-9676-44b0-a9b4-5e4c4e03d09d

Units/MMLCore/window.pas

@@ -51,6 +51,8 @@ type
 
         private
               FreezeState: Boolean;
+              FrozenData : PRGB32;
+              FrozenSize : TPoint;
         public
               // Client
               Client: TObject;
@@ -129,7 +131,8 @@ begin
 
   Self.Client := Client;
 
-
+  Self.FrozenData:= nil;
+  Self.FrozenSize := Classes.Point(-1,-1);
   Self.FreezeState :=False;
 
   Self.ArrayPtr := nil;
@@ -167,7 +170,8 @@ end;
 
 destructor TMWindow.Destroy;
 begin
-
+  if FrozenData <> nil then
+    FreeMem(FrozenData);
   {$IFDEF LINUX}
   XCloseDisplay(Self.XDisplay);
   {$ENDIF}
@@ -185,8 +189,19 @@ var
    Old_Handler: TXErrorHandler;
 {$ENDIF}
    TmpData: PRGB32;
-
+   w,h : integer;
 begin
+  Self.GetDimensions(w,h);
+  if (xs < 0) or (xs + width > w) or (ys < 0) or (ys + height > h) then
+    raise Exception.CreateFMT('TMWindow.ReturnData: The parameters passed are wrong; xs,ys %d,%d width,height %d,%d',[xs,ys,width,height]);
+
+  if Self.Frozen then
+  begin;
+    TmpData := Self.FrozenData;
+    Inc(TmpData, ys * width + xs);
+    Result.Ptr:= tmpData;
+    Result.IncPtrWith:= Self.FrozenSize.x - width;
+  end else
   case Self.TargetMode of
     w_Window:
     begin
@@ -232,7 +247,7 @@ begin
 
       // Increase the pointer to the specified start of the data.
 
-      Inc(TmpData, ys * Height + xs);
+      Inc(TmpData, ys * width + xs);
       Result.Ptr := TmpData;
       Result.IncPtrWith:= Self.ArraySize.x - width;
 
@@ -276,15 +291,29 @@ end;
 // client?
 
 function TMWindow.Freeze: Boolean;
+var
+  w,h,x,y : integer;
+  PtrReturn : TRetData;
 begin
+  if Self.FreezeState then
+    raise Exception.CreateFMT('TMWindow.Freeze: The window is already frozen.',[]);
+  Result := true;
+  Self.GetDimensions(w,h);
+  Self.FrozenSize := Classes.Point(w,h);
+  PtrReturn := Self.ReturnData(0,0,w,h);
+  GetMem(Self.FrozenData, w * h * sizeof(TRGB32));
+  Move(PtrReturn.Ptr[0], FrozenData[0], w*h*sizeof(TRGB32));
   Self.FreezeState:=True;
-  raise Exception.createFMT('Freeze: Not yet implemented.', []);
 end;
 
 function TMWindow.Unfreeze: Boolean;
 begin
+  if Self.FreezeState = false then
+    raise Exception.CreateFMT('TMWindow.Unfreeze: The window is not frozen.',[]);
+  FreeMem(Self.FrozenData);
+  Self.FrozenData := nil;
+  Result := True;
   Self.FreezeState:=False;
-  raise Exception.createFMT('Unfreeze: Not yet implemented.', []);
 end;
 
 // Bugged. For params other than 0, 0, ClientWidth, ClientHeight
@@ -297,6 +326,8 @@ var
    ww, hh: Integer;
    Raw: TRawImage;
    Bmp: TBitmap;
+   y : integer;
+   TempData : PRGB32;
    {$IFDEF LINUX}
    Old_Handler: TXErrorHandler;
    Img: PXImage;
@@ -310,12 +341,17 @@ begin
   ww := xe-xs;
   hh := ye-ys;
   if(xs < 0) or (ys < 0) or (xe > W) or (ye > H) then
-  begin
+    Raise Exception.CreateFMT('CopyClientToBitmap TMWindow: Faulty coordinates (%d,%d)(%d,%d); Width/Height is (%d,%d)',[xs,ys,xe,ye,w,h]);
-    writeln('Faulty coordinates');
+  if Self.Frozen then
-    exit;
+  begin;
-  end;
+    TempData:= GetMem((ww + 1) * (hh + 1) * sizeof(TRGB32));
-
+    for y := ys to ye do
-
+      Move(Self.FrozenData[y*Self.FrozenSize.x],TempData[(y-ys) * (ww+1)],(ww+1) * SizeOf(TRGB32));
+    ArrDataToRawImage(TempData,Classes.Point(ww + 1,hh + 1),Raw);
+    Bmp := TBitmap.Create;
+    Bmp.LoadFromRawImage(Raw,true);
+    Result := bmp;
+  end else
   case Self.TargetMode Of
      w_Window:
      begin
@@ -361,18 +397,13 @@ begin
 
        // Basically, Copy the data slices from the array into a XImage,
        // where the data IS aligned.
-
+        TempData:= GetMem((ww + 1) * (hh + 1) * sizeof(trgb32));
-         raise Exception.createFMT('Array Data to Bitmap not yet fully ' +
+        for y := ys to ye do
-                                   'implemented', []);
+          Move(Self.ArrayPtr[y*Self.ArraySize.x],TempData[(y-ys) * (ww+1)],(ww+1) * SizeOf(TRGB32));
-         Result := nil;
+        ArrDataToRawImage(TempData,Classes.Point(ww+1,hh+1),Raw);
-         exit;
-
-
-         ArrDataToRawImage(Self.ArrayPtr, Self.ArraySize, Raw);
-
         Bmp := TBitmap.Create;
-         Bmp.LoadFromRawImage(Raw, False);
+        Bmp.LoadFromRawImage(Raw,true);
-         Result := Bmp;
+        Result := bmp;
      end;
   end;
 end;
@@ -418,6 +449,11 @@ var
   Rect : TRect;
 {$ENDIF}
 begin
+  if Frozen then
+  begin;
+    w := FrozenSize.x;
+    h := FrozenSize.y;
+  end else
   case TargetMode of
     w_Window:
     begin
@@ -460,6 +496,8 @@ function TMWindow.SetTarget(XWindow: x.TWindow): integer; overload;
 var
    Old_Handler: TXErrorHandler;
 begin
+  if Self.Frozen then
+    raise Exception.CreateFMT('You cannot set a target when Frozen',[]);
   Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
   Self.CurWindow := XWindow;
   Self.TargetMode:= w_XWindow;
@@ -469,11 +507,10 @@ end;
 
 function TMWindow.SetTarget(Window: THandle; NewType: TTargetWindowMode): integer; overload;
 begin
+  if Self.Frozen then
+    raise Exception.CreateFMT('You cannot set a target when Frozen',[]);
   if NewType in [ w_XWindow, w_ArrayPtr ] then
-  begin
     raise Exception.createFMT('SetTarget: Invalid new type.', []);
-    Exit;
-  end;
   case NewType of
     w_Window :
     begin;
@@ -500,6 +537,8 @@ end;
 }
 function TMWindow.SetTarget(ArrPtr: PRGB32; Size: TPoint): integer; overload;
 begin
+  if Self.Frozen then
+    raise Exception.CreateFMT('You cannot set a target when Frozen',[]);
   If Self.TargetMode = w_XWindow then
     Self.FreeReturnData;