Changeset 29 for trunk

Timestamp:

Dec 22, 2016, 9:46:17 PM (8 years ago)

Author:

chronos

Message:

• Modified: Load image data from file quickly using Bitmap RawImage.
• Modified: Remember last selected color format.

Location:

trunk

Files:

• Forms/UFormMain.pas (modified) (1 diff)
• Forms/UFormNew.pas (modified) (4 diffs)
• Packages/Common/Languages/UJobProgressView.cs.po (modified) (1 diff)
• Packages/FastGraphics/ColorFormats/UColorRGB8.pas (modified) (2 diffs)
• Packages/FastGraphics/UFGraphics.pas (modified) (4 diffs)
• Packages/FastGraphics/UGGraphics.pas (modified) (3 diffs)
• UCore.pas (modified) (7 diffs)

trunk/Forms/UFormMain.pas

@@ -129 +129 @@
     TempBitmap.SetSize(View.SrcRect.Right - View.SrcRect.Left,
       View.SrcRect.Bottom - View.SrcRect.Top);
-    TempBitmap.BeginUpdate(True);
+    //TempBitmap.BeginUpdate(True);
     TempBitmap.Canvas.Brush.Color := clBlack;
     TempBitmap.Canvas.FillRect(0, 0, TempBitmap.Width, TempBitmap.Height);
     View.DestRect := Bounds(0, 0, PaintBox1.Width, PaintBox1.Height);
-    Bitmap.PaintToCanvas(TempBitmap.Canvas, View.SrcRect);
+    //Bitmap.PaintToCanvas(TempBitmap.Canvas, View.SrcRect);
     //Bitmap.PaintToBitmap(TempBitmap, View.SrcRect);
-    TempBitmap.EndUpdate(False);
+    //TempBitmap.EndUpdate(False);
     PaintBox1.Canvas.StretchDraw(View.DestRect, TempBitmap);
     //PaintBox1.Canvas.Draw(0, 0, TempBitmap);

trunk/Forms/UFormNew.pas

@@ -7 +7 @@
 uses
   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Spin,
-  StdCtrls, ActnList, UFGraphics;
+  StdCtrls, ActnList, UFGraphics, URegistry;
 
 type
@@ -32 +32 @@
     { private declarations }
   public
-    { public declarations }
   end;
 
@@ -71 +70 @@
     ComboBoxColorFormat.ItemIndex := 0;
 
+  if ComboBoxColorFormat.Items.IndexOf(Core.LastColorFormat) <> -1 then
+    ComboBoxColorFormat.ItemIndex := ComboBoxColorFormat.Items.IndexOf(Core.LastColorFormat);
+
   // Default
   SpinEditWidth.Value := 200;
@@ -79 +81 @@
 procedure TFormNew.FormClose(Sender: TObject; var CloseAction: TCloseAction);
 begin
+  Core.LastColorFormat := ComboBoxColorFormat.Items[ComboBoxColorFormat.ItemIndex];
   Core.PersistentForm1.Save(Self);
 end;

trunk/Packages/Common/Languages/UJobProgressView.cs.po

@@ -39 +39 @@
 msgid "Total estimated time: %s"
 msgstr "CelkovÜ odhadovanÜ čas: %s"
+

trunk/Packages/FastGraphics/ColorFormats/UColorRGB8.pas

@@ -56 +56 @@
     procedure PaintToBitmap(Bitmap: TBitmap; Rect: TRect); override;
     procedure LoadFromCanvas(Canvas: TCanvas); override;
+    procedure LoadFromBitmap(Bitmap: TBitmap); override;
     function GetDataSize: Integer; override;
     constructor Create; override;
@@ -170 +171 @@
 end;
 
+procedure TBPixmapRGB8.LoadFromBitmap(Bitmap: TBitmap);
+begin
+  Pixmap.LoadFromBitmap(Bitmap, Pixmap.ColorToRGB8);
+end;
+
 function TBPixmapRGB8.GetDataSize: Integer;
 begin

trunk/Packages/FastGraphics/UFGraphics.pas

@@ -45 +45 @@
     procedure PaintToBitmap(Bitmap: TBitmap; Rect: TRect); virtual;
     procedure LoadFromCanvas(Canvas: TCanvas); virtual;
+    procedure LoadFromBitmap(Bitmap: TBitmap); virtual;
     function GetDataSize: Integer; virtual;
     constructor Create; virtual;
@@ -174 +175 @@
     procedure PaintToBitmap(Bitmap: TBitmap; Rect: TRect); overload;
     procedure LoadFromCanvas(Canvas: TCanvas);
+    procedure LoadFromBitmap(Bitmap: TBitmap);
     function GetDataSize: Integer;
     constructor Create(AOwner: TComponent); override;
@@ -383 +385 @@
 end;
 
+procedure TBImage.LoadFromBitmap(Bitmap: TBitmap);
+begin
+end;
+
 function TBImage.GetDataSize: Integer;
 begin
@@ -495 +501 @@
 begin
   Backend.LoadFromCanvas(Canvas);
+end;
+
+procedure TFPixmap.LoadFromBitmap(Bitmap: TBitmap);
+begin
+  Backend.LoadFromBitmap(Bitmap);
 end;
 

trunk/Packages/FastGraphics/UGGraphics.pas

@@ -68 +68 @@
     procedure PaintToBitmap(Bitmap: TBitmap; Rect: TRect; ColorConvertFunc: TGConvertColor);
     procedure LoadFromCanvas(Canvas: TCanvas; ColorConvertFunc: TGConvertFromColor); overload;
+    procedure LoadFromBitmap(Bitmap: TBitmap; ColorConvertFunc: TGConvertFromColor);
     procedure Fill(Color: TGColor); overload;
     procedure Fill(Func: TGGetColor); overload;
@@ -224 +225 @@
 end;
 
-procedure TGPixmap<TGColor>.LoadFromCanvas(Canvas: TCanvas; ColorConvertFunc: TGConvertFromColor); overload;
+procedure TGPixmap<TGColor>.LoadFromCanvas(Canvas: TCanvas; ColorConvertFunc: TGConvertFromColor);
 var
   X, Y: Integer;
@@ -236 +237 @@
   finally
     Canvas.Unlock;
+  end;
+end;
+
+procedure TGPixmap<TGColor>.LoadFromBitmap(Bitmap: TBitmap; ColorConvertFunc: TGConvertFromColor);
+var
+  X, Y: Integer;
+  PixelPtr: PInteger;
+  PixelPtrMax: PInteger;
+  PixelRowPtr: PInteger;
+  P: TPixelFormat;
+  RawImage: TRawImage;
+  BytePerPixel: Integer;
+begin
+  try
+    Bitmap.BeginUpdate(False);
+    RawImage := Bitmap.RawImage;
+    PixelRowPtr := PInteger(RawImage.Data);
+    BytePerPixel := RawImage.Description.BitsPerPixel div 8;
+    PixelPtrMax := PixelRowPtr + RawImage.Description.Width * RawImage.Description.Height * BytePerPixel;
+    for Y := 0 to FSize.Y - 1 do begin
+      PixelPtr := PixelRowPtr;
+      for X := 0 to FSize.X - 1 do begin
+        if (X >= 0) and (X < FSize.X) and (Y >= 0) and (Y < FSize.Y) and (PixelPtr < PixelPtrMax) then
+          Pixels[X, Y] := ColorConvertFunc(PixelPtr^);
+        Inc(PByte(PixelPtr), BytePerPixel);
+      end;
+      Inc(PByte(PixelRowPtr), RawImage.Description.BytesPerLine);
+    end;
+  finally
+    Bitmap.EndUpdate(False);
   end;
 end;

trunk/UCore.pas

@@ -7 +7 @@
 uses
   Classes, SysUtils, FileUtil, ActnList, UProject, UFGraphics, UPersistentForm,
-  Controls, Graphics, ExtDlgs, ExtCtrls, UREgistry, UApplicationInfo, Registry;
+  Controls, Graphics, ExtDlgs, ExtCtrls, URegistry, UApplicationInfo, Registry;
 
 const
@@ -62 +62 @@
   private
   public
+    LastColorFormat: string;
     Project: TProject;
+    RegistryContext: TRegistryContext;
     procedure ProjectOpen(FileName: string);
     procedure Init;
+    procedure LoadConfig;
+    procedure SaveConfig;
   end;
 
@@ -88 +92 @@
 procedure TCore.DataModuleCreate(Sender: TObject);
 begin
+  RegistryContext := RegContext(HKEY(ApplicationInfo1.RegistryRoot),
+    ApplicationInfo1.RegistryKey);
   Project := TProject.Create;
 end;
@@ -93 +99 @@
 procedure TCore.DataModuleDestroy(Sender: TObject);
 begin
-  Project.Free;
+  FreeAndNil(Project);
+  SaveConfig;
 end;
 
@@ -103 +110 @@
   Image := TImage.Create(nil);
   Image.Picture.LoadFromFile(FileName);
-  Image.Picture.Bitmap.BeginUpdate(True);
+  //Image.Picture.Bitmap.BeginUpdate(True);
   Project.Bitmap.Size := Point(Image.Picture.Bitmap.Width, Image.Picture.Bitmap.Height);
-  Project.Bitmap.LoadFromCanvas(Image.Picture.Bitmap.Canvas);
-  Image.Picture.Bitmap.EndUpdate;
+  //Project.Bitmap.LoadFromCanvas(Image.Picture.Bitmap.Canvas);
+  Project.Bitmap.LoadFromBitmap(Image.Picture.Bitmap);
+  //Image.Picture.Bitmap.EndUpdate;
   Image.Free;
   AZoomAll.Execute;
@@ -115 +123 @@
 procedure TCore.Init;
 begin
-  PersistentForm1.RegistryContext := RegContext(HKEY(ApplicationInfo1.RegistryRoot),
-    ApplicationInfo1.RegistryKey);
+  PersistentForm1.RegistryContext := RegistryContext;
+  LoadConfig;
 
   // Set default
@@ -123 +131 @@
   Project.View.DestRect := Bounds(0, 0, FormMain.PaintBox1.Width, FormMain.PaintBox1.Height);
   Core.AZoomAll.Execute;
+end;
+
+procedure TCore.LoadConfig;
+begin
+  with TRegistryEx.Create do
+  try
+    RootKey := RegistryContext.RootKey;
+    OpenKey(RegistryContext.Key, True);
+
+    LastColorFormat := ReadStringWithDefault('LastColorFormat', '');
+  finally
+    Free;
+  end;
+end;
+
+procedure TCore.SaveConfig;
+begin
+  with TRegistryEx.Create do
+  try
+    RootKey := RegistryContext.RootKey;
+    OpenKey(RegistryContext.Key, True);
+
+    WriteString('LastColorFormat', LastColorFormat);
+  finally
+    Free;
+  end;
 end;