Changeset 4
- Timestamp:
- Sep 16, 2014, 11:55:35 AM (10 years ago)
- Location:
- trunk
- Files:
-
- 7 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/ColorFormats/UColorRGBA8.pas
r3 r4 18 18 function GetChannelBitWidth(Channel: TGColorChannel): Integer; override; 19 19 function ColorToTColor(Color: TGColor): TColor; override; 20 procedure ColorFromTColor(GColor: TGColor; Color: TColor); override; 20 21 function GetColorClass: TGColorClass; override; 21 22 end; … … 66 67 end; 67 68 69 procedure TGColorFormatRGBA8.ColorFromTColor(GColor: TGColor; Color: TColor); 70 begin 71 PByte(GColor.Data + GetChannelBytePos(ccRed))^ := Color and $ff; 72 PByte(GColor.Data + GetChannelBytePos(ccGreen))^ := (Color shr 8) and $ff; 73 PByte(GColor.Data + GetChannelBytePos(ccBlue))^ := (Color shr 16) and $ff; 74 end; 75 68 76 function TGColorFormatRGBA8.GetColorClass: TGColorClass; 69 77 begin -
trunk/Forms/UFormMain.lfm
r3 r4 5 5 Width = 920 6 6 Caption = 'LibrePaint' 7 ClientHeight = 61 17 ClientHeight = 614 8 8 ClientWidth = 920 9 9 Menu = MainMenu1 … … 11 11 object PaintBox1: TPaintBox 12 12 Left = 0 13 Height = 61 113 Height = 614 14 14 Top = 0 15 15 Width = 920 … … 35 35 Action = Core.AImageClear 36 36 end 37 object MenuItem6: TMenuItem 38 Action = Core.AImageRandom 39 end 37 40 end 38 41 end -
trunk/Forms/UFormMain.pas
r3 r4 20 20 MenuItem4: TMenuItem; 21 21 MenuItem5: TMenuItem; 22 MenuItem6: TMenuItem; 22 23 PaintBox1: TPaintBox; 23 24 Timer1: TTimer; -
trunk/LibrePaint.lpi
r3 r4 54 54 <Filename Value="UProject.pas"/> 55 55 <IsPartOfProject Value="True"/> 56 <UnitName Value="UProject"/>57 56 </Unit3> 58 57 <Unit4> … … 62 61 <HasResources Value="True"/> 63 62 <ResourceBaseClass Value="Form"/> 64 <UnitName Value="UFormNew"/>65 63 </Unit4> 66 64 <Unit5> -
trunk/UCore.lfm
r3 r4 21 21 OnExecute = AImageClearExecute 22 22 end 23 object AImageRandom: TAction 24 Caption = 'Random' 25 OnExecute = AImageRandomExecute 26 end 23 27 end 24 28 end -
trunk/UCore.pas
r3 r4 13 13 14 14 TCore = class(TDataModule) 15 AImageRandom: TAction; 15 16 AImageClear: TAction; 16 17 AExit: TAction; … … 19 20 procedure AExitExecute(Sender: TObject); 20 21 procedure AImageClearExecute(Sender: TObject); 22 procedure AImageRandomExecute(Sender: TObject); 21 23 procedure AProjectNewExecute(Sender: TObject); 22 24 procedure DataModuleCreate(Sender: TObject); … … 75 77 end; 76 78 79 procedure TCore.AImageRandomExecute(Sender: TObject); 80 begin 81 Project.Bitmap.Random; 82 FormMain.Redraw; 83 end; 84 77 85 end. 78 86 -
trunk/UGraphic.pas
r3 r4 25 25 function ChannelUsed(Channel: TGColorChannel): Boolean; 26 26 function ColorToTColor(Color: TGColor): TColor; virtual; 27 procedure ColorFromTColor(GColor: TGColor; Color: TColor); virtual; 27 28 function GetColorClass: TGColorClass; virtual; 28 29 end; … … 38 39 function GetChannel(Channel: TGColorChannel): TGColor; 39 40 procedure SetColorFormat(AValue: TGColorFormatClass); 40 procedure LoadData( Data: Pointer); virtual;41 procedure SaveData( Data: Pointer); virtual;41 procedure LoadData(BitmapData: Pointer); virtual; 42 procedure SaveData(BitmapData: Pointer); virtual; 42 43 public 43 44 function ToTColor: TColor; 45 procedure FromTColor(Color: TColor); 44 46 procedure Assign(Source: TGColor); virtual; 45 47 property Channels[Channel: TGColorChannel]: TGColor read GetChannel; … … 69 71 procedure PaintToCanvas(Canvas: TCanvas); 70 72 procedure Clear; 73 procedure Random; 71 74 constructor Create; virtual; 72 75 destructor Destroy; override; … … 164 167 end; 165 168 169 procedure TGColorFormat.ColorFromTColor(GColor: TGColor; Color: TColor); 170 begin 171 FillChar(GColor.Data^, GetPixelSize, 0); 172 end; 173 166 174 function TGColorFormat.GetColorClass: TGColorClass; 167 175 begin … … 187 195 end; 188 196 189 procedure TGColor.LoadData( Data: Pointer);190 var 191 F: TGColorFormat; 192 begin 193 F := FColorFormat.Create; 194 Move( FData, Data, F.GetPixelSize);195 F.Free; 196 end; 197 198 procedure TGColor.SaveData( Data: Pointer);199 var 200 F: TGColorFormat; 201 begin 202 F := FColorFormat.Create; 203 Move( Data, FData, F.GetPixelSize);197 procedure TGColor.LoadData(BitmapData: Pointer); 198 var 199 F: TGColorFormat; 200 begin 201 F := FColorFormat.Create; 202 Move(BitmapData^, FData^, F.GetPixelSize); 203 F.Free; 204 end; 205 206 procedure TGColor.SaveData(BitmapData: Pointer); 207 var 208 F: TGColorFormat; 209 begin 210 F := FColorFormat.Create; 211 Move(FData^, BitmapData^, F.GetPixelSize); 204 212 F.Free; 205 213 end; … … 211 219 F := FColorFormat.Create; 212 220 Result := F.ColorToTColor(Self); 221 F.Free; 222 end; 223 224 procedure TGColor.FromTColor(Color: TColor); 225 var 226 F: TGColorFormat; 227 begin 228 F := FColorFormat.Create; 229 F.ColorFromTColor(Self, Color); 213 230 F.Free; 214 231 end; … … 305 322 end; 306 323 324 procedure TGBitmap.Random; 325 var 326 X, Y: Integer; 327 Color: TGColor; 328 begin 329 Color := TGColor.Create; 330 Color.Format := ColorFormat; 331 for Y := 0 to Size.Y - 1 do 332 for X := 0 to Size.X - 1 do begin 333 Color.FromTColor(System.Random($ffffff)); 334 Pixels[X, Y] := Color; 335 end; 336 Color.Free; 337 end; 338 307 339 constructor TGBitmap.Create; 308 340 begin
Note:
See TracChangeset
for help on using the changeset viewer.