Changeset 4


Ignore:
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:
7 edited

Legend:

Unmodified
Added
Removed
  • trunk/ColorFormats/UColorRGBA8.pas

    r3 r4  
    1818    function GetChannelBitWidth(Channel: TGColorChannel): Integer; override;
    1919    function ColorToTColor(Color: TGColor): TColor; override;
     20    procedure ColorFromTColor(GColor: TGColor; Color: TColor); override;
    2021    function GetColorClass: TGColorClass; override;
    2122  end;
     
    6667end;
    6768
     69procedure TGColorFormatRGBA8.ColorFromTColor(GColor: TGColor; Color: TColor);
     70begin
     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;
     74end;
     75
    6876function TGColorFormatRGBA8.GetColorClass: TGColorClass;
    6977begin
  • trunk/Forms/UFormMain.lfm

    r3 r4  
    55  Width = 920
    66  Caption = 'LibrePaint'
    7   ClientHeight = 611
     7  ClientHeight = 614
    88  ClientWidth = 920
    99  Menu = MainMenu1
     
    1111  object PaintBox1: TPaintBox
    1212    Left = 0
    13     Height = 611
     13    Height = 614
    1414    Top = 0
    1515    Width = 920
     
    3535        Action = Core.AImageClear
    3636      end
     37      object MenuItem6: TMenuItem
     38        Action = Core.AImageRandom
     39      end
    3740    end
    3841  end
  • trunk/Forms/UFormMain.pas

    r3 r4  
    2020    MenuItem4: TMenuItem;
    2121    MenuItem5: TMenuItem;
     22    MenuItem6: TMenuItem;
    2223    PaintBox1: TPaintBox;
    2324    Timer1: TTimer;
  • trunk/LibrePaint.lpi

    r3 r4  
    5454        <Filename Value="UProject.pas"/>
    5555        <IsPartOfProject Value="True"/>
    56         <UnitName Value="UProject"/>
    5756      </Unit3>
    5857      <Unit4>
     
    6261        <HasResources Value="True"/>
    6362        <ResourceBaseClass Value="Form"/>
    64         <UnitName Value="UFormNew"/>
    6563      </Unit4>
    6664      <Unit5>
  • trunk/UCore.lfm

    r3 r4  
    2121      OnExecute = AImageClearExecute
    2222    end
     23    object AImageRandom: TAction
     24      Caption = 'Random'
     25      OnExecute = AImageRandomExecute
     26    end
    2327  end
    2428end
  • trunk/UCore.pas

    r3 r4  
    1313
    1414  TCore = class(TDataModule)
     15    AImageRandom: TAction;
    1516    AImageClear: TAction;
    1617    AExit: TAction;
     
    1920    procedure AExitExecute(Sender: TObject);
    2021    procedure AImageClearExecute(Sender: TObject);
     22    procedure AImageRandomExecute(Sender: TObject);
    2123    procedure AProjectNewExecute(Sender: TObject);
    2224    procedure DataModuleCreate(Sender: TObject);
     
    7577end;
    7678
     79procedure TCore.AImageRandomExecute(Sender: TObject);
     80begin
     81  Project.Bitmap.Random;
     82  FormMain.Redraw;
     83end;
     84
    7785end.
    7886
  • trunk/UGraphic.pas

    r3 r4  
    2525    function ChannelUsed(Channel: TGColorChannel): Boolean;
    2626    function ColorToTColor(Color: TGColor): TColor; virtual;
     27    procedure ColorFromTColor(GColor: TGColor; Color: TColor); virtual;
    2728    function GetColorClass: TGColorClass; virtual;
    2829  end;
     
    3839    function GetChannel(Channel: TGColorChannel): TGColor;
    3940    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;
    4243  public
    4344    function ToTColor: TColor;
     45    procedure FromTColor(Color: TColor);
    4446    procedure Assign(Source: TGColor); virtual;
    4547    property Channels[Channel: TGColorChannel]: TGColor read GetChannel;
     
    6971    procedure PaintToCanvas(Canvas: TCanvas);
    7072    procedure Clear;
     73    procedure Random;
    7174    constructor Create; virtual;
    7275    destructor Destroy; override;
     
    164167end;
    165168
     169procedure TGColorFormat.ColorFromTColor(GColor: TGColor; Color: TColor);
     170begin
     171  FillChar(GColor.Data^, GetPixelSize, 0);
     172end;
     173
    166174function TGColorFormat.GetColorClass: TGColorClass;
    167175begin
     
    187195end;
    188196
    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);
     197procedure TGColor.LoadData(BitmapData: Pointer);
     198var
     199  F: TGColorFormat;
     200begin
     201  F := FColorFormat.Create;
     202  Move(BitmapData^, FData^, F.GetPixelSize);
     203  F.Free;
     204end;
     205
     206procedure TGColor.SaveData(BitmapData: Pointer);
     207var
     208  F: TGColorFormat;
     209begin
     210  F := FColorFormat.Create;
     211  Move(FData^, BitmapData^, F.GetPixelSize);
    204212  F.Free;
    205213end;
     
    211219  F := FColorFormat.Create;
    212220  Result := F.ColorToTColor(Self);
     221  F.Free;
     222end;
     223
     224procedure TGColor.FromTColor(Color: TColor);
     225var
     226  F: TGColorFormat;
     227begin
     228  F := FColorFormat.Create;
     229  F.ColorFromTColor(Self, Color);
    213230  F.Free;
    214231end;
     
    305322end;
    306323
     324procedure TGBitmap.Random;
     325var
     326  X, Y: Integer;
     327  Color: TGColor;
     328begin
     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;
     337end;
     338
    307339constructor TGBitmap.Create;
    308340begin
Note: See TracChangeset for help on using the changeset viewer.