Changeset 3 for trunk/Forms

Timestamp:

Sep 15, 2014, 11:13:21 PM (10 years ago)

Author:

chronos

Message:

• Modified: Specific TGColor implementation moved to ColorFormats directory.
• Added: Function to clear image with background color.
• Modified: Drawing project image to off screen bitmap to speed up drawing.

Location:

trunk/Forms

Files:

• UFormMain.lfm (modified) (1 diff)
• UFormMain.pas (modified) (2 diffs)

trunk/Forms/UFormMain.lfm

@@ -23 +23 @@
     object MenuItem1: TMenuItem
       Caption = 'Soubor'
+      object MenuItem3: TMenuItem
+        Action = Core.AProjectNew
+      end
       object MenuItem2: TMenuItem
-        Action = Core.AProjectNew
+        Action = Core.AExit
+      end
+    end
+    object MenuItem4: TMenuItem
+      Caption = 'Image'
+      object MenuItem5: TMenuItem
+        Action = Core.AImageClear
       end
     end
   end
+  object Timer1: TTimer
+    Enabled = False
+    Interval = 50
+    OnTimer = Timer1Timer
+    left = 195
+    top = 206
+  end
 end

trunk/Forms/UFormMain.pas

@@ -17 +17 @@
     MenuItem1: TMenuItem;
     MenuItem2: TMenuItem;
+    MenuItem3: TMenuItem;
+    MenuItem4: TMenuItem;
+    MenuItem5: TMenuItem;
     PaintBox1: TPaintBox;
+    Timer1: TTimer;
     procedure PaintBox1Paint(Sender: TObject);
     procedure PaintBox1Resize(Sender: TObject);
+    procedure Timer1Timer(Sender: TObject);
   private
     { private declarations }
   public
-    { public declarations }
+    procedure Redraw;
   end;
 
@@ -43 +48 @@
 end;
 
+procedure TFormMain.Timer1Timer(Sender: TObject);
+var
+  Bitmap: TBitmap;
+begin
+  Timer1.Enabled := False;
+  try
+    Bitmap := TBitmap.Create;
+    Bitmap.SetSize(Core.Project.Bitmap.Size.X, Core.Project.Bitmap.Size.Y);
+    Bitmap.BeginUpdate(True);
+    Core.Project.Bitmap.PaintToCanvas(Bitmap.Canvas);
+    Bitmap.EndUpdate(False);
+    PaintBox1.Canvas.Draw(0, 0, Bitmap);
+  finally
+    Bitmap.Free;
+  end;
+end;
+
+procedure TFormMain.Redraw;
+begin
+  Timer1.Enabled := True;
+end;
+
 procedure TFormMain.PaintBox1Paint(Sender: TObject);
 begin
-  Core.Project.Bitmap.PaintToCanvas(PaintBox1.Canvas);
+  Redraw;
 end;