Changeset 4 for trunk

Timestamp:

Sep 16, 2014, 11:55:35 AM (10 years ago)

Author:

chronos

Message:

• Added: Action to fill image with random image.
• Fixed: Pixel load/save to bitmap was using Move with pointers instead pointed value.

Location:

trunk

Files:

• ColorFormats/UColorRGBA8.pas (modified) (2 diffs)
• Forms/UFormMain.lfm (modified) (3 diffs)
• Forms/UFormMain.pas (modified) (1 diff)
• LibrePaint.lpi (modified) (2 diffs)
• UCore.lfm (modified) (1 diff)
• UCore.pas (modified) (3 diffs)
• UGraphic.pas (modified) (7 diffs)

trunk/ColorFormats/UColorRGBA8.pas

@@ -18 +18 @@
     function GetChannelBitWidth(Channel: TGColorChannel): Integer; override;
     function ColorToTColor(Color: TGColor): TColor; override;
+    procedure ColorFromTColor(GColor: TGColor; Color: TColor); override;
     function GetColorClass: TGColorClass; override;
   end;
@@ -66 +67 @@
 end;
 
+procedure TGColorFormatRGBA8.ColorFromTColor(GColor: TGColor; Color: TColor);
+begin
+  PByte(GColor.Data + GetChannelBytePos(ccRed))^ := Color and $ff;
+  PByte(GColor.Data + GetChannelBytePos(ccGreen))^ := (Color shr 8) and $ff;
+  PByte(GColor.Data + GetChannelBytePos(ccBlue))^ := (Color shr 16) and $ff;
+end;
+
 function TGColorFormatRGBA8.GetColorClass: TGColorClass;
 begin

trunk/Forms/UFormMain.lfm

@@ -5 +5 @@
   Width = 920
   Caption = 'LibrePaint'
-  ClientHeight = 611
+  ClientHeight = 614
   ClientWidth = 920
   Menu = MainMenu1
@@ -11 +11 @@
   object PaintBox1: TPaintBox
     Left = 0
-    Height = 611
+    Height = 614
     Top = 0
     Width = 920
@@ -35 +35 @@
         Action = Core.AImageClear
       end
+      object MenuItem6: TMenuItem
+        Action = Core.AImageRandom
+      end
     end
   end

trunk/Forms/UFormMain.pas

@@ -20 +20 @@
     MenuItem4: TMenuItem;
     MenuItem5: TMenuItem;
+    MenuItem6: TMenuItem;
     PaintBox1: TPaintBox;
     Timer1: TTimer;

trunk/LibrePaint.lpi

@@ -54 +54 @@
         <Filename Value="UProject.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="UProject"/>
       </Unit3>
       <Unit4>
@@ -62 +61 @@
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="UFormNew"/>
       </Unit4>
       <Unit5>

trunk/UCore.lfm

@@ -21 +21 @@
       OnExecute = AImageClearExecute
     end
+    object AImageRandom: TAction
+      Caption = 'Random'
+      OnExecute = AImageRandomExecute
+    end
   end
 end

trunk/UCore.pas

@@ -13 +13 @@
 
   TCore = class(TDataModule)
+    AImageRandom: TAction;
     AImageClear: TAction;
     AExit: TAction;
@@ -19 +20 @@
     procedure AExitExecute(Sender: TObject);
     procedure AImageClearExecute(Sender: TObject);
+    procedure AImageRandomExecute(Sender: TObject);
     procedure AProjectNewExecute(Sender: TObject);
     procedure DataModuleCreate(Sender: TObject);
@@ -75 +77 @@
 end;
 
+procedure TCore.AImageRandomExecute(Sender: TObject);
+begin
+  Project.Bitmap.Random;
+  FormMain.Redraw;
+end;
+
 end.
 

trunk/UGraphic.pas

@@ -25 +25 @@
     function ChannelUsed(Channel: TGColorChannel): Boolean;
     function ColorToTColor(Color: TGColor): TColor; virtual;
+    procedure ColorFromTColor(GColor: TGColor; Color: TColor); virtual;
     function GetColorClass: TGColorClass; virtual;
   end;
@@ -38 +39 @@
     function GetChannel(Channel: TGColorChannel): TGColor;
     procedure SetColorFormat(AValue: TGColorFormatClass);
-    procedure LoadData(Data: Pointer); virtual;
-    procedure SaveData(Data: Pointer); virtual;
+    procedure LoadData(BitmapData: Pointer); virtual;
+    procedure SaveData(BitmapData: Pointer); virtual;
   public
     function ToTColor: TColor;
+    procedure FromTColor(Color: TColor);
     procedure Assign(Source: TGColor); virtual;
     property Channels[Channel: TGColorChannel]: TGColor read GetChannel;
@@ -69 +71 @@
     procedure PaintToCanvas(Canvas: TCanvas);
     procedure Clear;
+    procedure Random;
     constructor Create; virtual;
     destructor Destroy; override;
@@ -164 +167 @@
 end;
 
+procedure TGColorFormat.ColorFromTColor(GColor: TGColor; Color: TColor);
+begin
+  FillChar(GColor.Data^, GetPixelSize, 0);
+end;
+
 function TGColorFormat.GetColorClass: TGColorClass;
 begin
@@ -187 +195 @@
 end;
 
-procedure TGColor.LoadData(Data: Pointer);
-var
-  F: TGColorFormat;
-begin
-  F := FColorFormat.Create;
-  Move(FData, Data, F.GetPixelSize);
-  F.Free;
-end;
-
-procedure TGColor.SaveData(Data: Pointer);
-var
-  F: TGColorFormat;
-begin
-  F := FColorFormat.Create;
-  Move(Data, FData, F.GetPixelSize);
+procedure TGColor.LoadData(BitmapData: Pointer);
+var
+  F: TGColorFormat;
+begin
+  F := FColorFormat.Create;
+  Move(BitmapData^, FData^, F.GetPixelSize);
+  F.Free;
+end;
+
+procedure TGColor.SaveData(BitmapData: Pointer);
+var
+  F: TGColorFormat;
+begin
+  F := FColorFormat.Create;
+  Move(FData^, BitmapData^, F.GetPixelSize);
   F.Free;
 end;
@@ -211 +219 @@
   F := FColorFormat.Create;
   Result := F.ColorToTColor(Self);
+  F.Free;
+end;
+
+procedure TGColor.FromTColor(Color: TColor);
+var
+  F: TGColorFormat;
+begin
+  F := FColorFormat.Create;
+  F.ColorFromTColor(Self, Color);
   F.Free;
 end;
@@ -305 +322 @@
 end;
 
+procedure TGBitmap.Random;
+var
+  X, Y: Integer;
+  Color: TGColor;
+begin
+  Color := TGColor.Create;
+  Color.Format := ColorFormat;
+  for Y := 0 to Size.Y - 1 do
+    for X := 0 to Size.X - 1 do begin
+      Color.FromTColor(System.Random($ffffff));
+      Pixels[X, Y] := Color;
+    end;
+  Color.Free;
+end;
+
 constructor TGBitmap.Create;
 begin