Changeset 33


Ignore:
Timestamp:
Jan 5, 2017, 11:48:36 PM (7 years ago)
Author:
chronos
Message:
  • Added: Remember last used image size and color format.
  • Added: Automatically create blank image.
Location:
trunk
Files:
8 edited

Legend:

Unmodified
Added
Removed

  • trunk/Forms/UFormMain.lfm

    r31 r33  
    3636    Panels = <   
    3737      item
    38         Width = 50
     38        Width = 200
     39      end   
     40      item
     41        Width = 200
     42      end   
     43      item
     44        Width = 200
    3945      end>
    4046    SimplePanel = False
    … …  
    7076      Top = 2
    7177      Action = Core.AToolPen
     78    end
     79    object ToolButton4: TToolButton
     80      Left = 113
     81      Top = 2
     82      Caption = 'ToolButton4'
     83      OnClick = ToolButton4Click
    7284    end
    7385  end

  • trunk/Forms/UFormMain.pas

    r31 r33  
    5050    ToolButton2: TToolButton;
    5151    ToolButton3: TToolButton;
     52    ToolButton4: TToolButton;
    5253    procedure FormActivate(Sender: TObject);
    5354    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    … …  
    7071    procedure PaintBox1Resize(Sender: TObject);
    7172    procedure Timer1Timer(Sender: TObject);
     73    procedure ToolButton4Click(Sender: TObject);
    7274  private
     75    EnableDraw: Boolean;
    7376    TempBitmap: TBitmap;
    7477    StartMousePoint: TPoint;
    … …  
    109112end;
    110113
     114procedure TFormMain.ToolButton4Click(Sender: TObject);
     115begin
     116  EnableDraw := True;
     117end;
     118
    111119procedure TFormMain.OpenRecentClick(Sender: TObject);
    112120begin
    … …  
    127135    StatusBar1.Panels[0].Text := '[' + IntToStr(Pos.X) + ', ' + IntToStr(Pos.Y) + '] Zoom:' +
    128136      FloatToStr(Core.Project.View.Zoom);
     137    StatusBar1.Panels[1].Text := 'Src: ' + IntToStr(View.SrcRect.Right - View.SrcRect.Left) + ', ' +
     138      IntToStr(View.SrcRect.Bottom - View.SrcRect.Top);
     139    StatusBar1.Panels[2].Text := 'Dst: ' + IntToStr(View.DestRect.Right - View.DestRect.Left) + ', ' +
     140      IntToStr(View.DestRect.Bottom - View.DestRect.Top);
    129141  end;
    130142end;
    … …  
    144156    TempBitmap.Canvas.FillRect(0, 0, TempBitmap.Width, TempBitmap.Height);
    145157    View.DestRect := Bounds(0, 0, PaintBox1.Width, PaintBox1.Height);
    146     //Bitmap.PaintToCanvas(TempBitmap.Canvas, View.SrcRect);
    147     Bitmap.PaintToBitmap(TempBitmap, View.SrcRect);
     158   // Bitmap.PaintToCanvas(TempBitmap.Canvas, View.SrcRect);
     159   // if EnableDraw then
     160      Bitmap.PaintToBitmap(TempBitmap, View.SrcRect);
    148161    //TempBitmap.EndUpdate(False);
    149162    PaintBox1.Canvas.StretchDraw(View.DestRect, TempBitmap);

  • trunk/Forms/UFormNew.lfm

    r28 r33  
    88  ClientWidth = 497
    99  OnClose = FormClose
     10  OnCreate = FormCreate
    1011  OnShow = FormShow
    11   LCLVersion = '1.6.2.0'
     12  LCLVersion = '1.6.0.4'
    1213  object SpinEditWidth: TSpinEdit
    1314    Left = 168
    14     Height = 28
     15    Height = 34
    1516    Top = 24
    1617    Width = 122
    … …  
    2122  object Label1: TLabel
    2223    Left = 15
    23     Height = 20
     24    Height = 24
    2425    Top = 26
    25     Width = 43
     26    Width = 56
    2627    Caption = 'Width:'
    2728    ParentColor = False
    … …  
    2930  object Label2: TLabel
    3031    Left = 15
    31     Height = 20
     32    Height = 24
    3233    Top = 64
    33     Width = 48
     34    Width = 62
    3435    Caption = 'Height:'
    3536    ParentColor = False
    … …  
    3738  object SpinEditHeight: TSpinEdit
    3839    Left = 168
    39     Height = 28
     40    Height = 34
    4041    Top = 64
    4142    Width = 122
    … …  
    4647  object Label3: TLabel
    4748    Left = 15
    48     Height = 20
     49    Height = 24
    4950    Top = 104
    50     Width = 73
     51    Width = 96
    5152    Caption = 'Resolution:'
    5253    ParentColor = False
    … …  
    5455  object SpinEditDPI: TSpinEdit
    5556    Left = 168
    56     Height = 28
     57    Height = 34
    5758    Top = 104
    5859    Width = 122
    … …  
    6364  object Label4: TLabel
    6465    Left = 15
    65     Height = 20
     66    Height = 24
    6667    Top = 167
    67     Width = 82
     68    Width = 105
    6869    Caption = 'Color depth:'
    6970    ParentColor = False
    … …  
    7172  object ComboBoxColorFormat: TComboBox
    7273    Left = 167
    73     Height = 28
     74    Height = 38
    7475    Top = 157
    7576    Width = 209
    76     ItemHeight = 20
     77    ItemHeight = 0
    7778    OnChange = SpinEditWidthChange
    7879    Style = csDropDownList
    … …  
    100101  object Label5: TLabel
    101102    Left = 16
    102     Height = 20
     103    Height = 24
    103104    Top = 224
    104     Width = 118
     105    Width = 152
    105106    Caption = 'Memory required:'
    106107    ParentColor = False
    … …  
    108109  object LabelMemRequire: TLabel
    109110    Left = 192
    110     Height = 20
     111    Height = 24
    111112    Top = 224
    112     Width = 12
     113    Width = 15
    113114    Caption = '   '
    114115    ParentColor = False

  • trunk/Forms/UFormNew.pas

    r30 r33  
    77uses
    88  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Spin,
    9   StdCtrls, ActnList, UFGraphics, URegistry;
     9  StdCtrls, ActnList, Menus, UFGraphics, URegistry;
    1010
    1111type
    … …  
    2727    SpinEditHeight: TSpinEdit;
    2828    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
     29    procedure FormCreate(Sender: TObject);
    2930    procedure FormShow(Sender: TObject);
    3031    procedure SpinEditWidthChange(Sender: TObject);
    … …  
    3233    { private declarations }
    3334  public
     35    DefaultSize: TPoint;
    3436  end;
    3537
    … …  
    5052  ColorFormat: TColorFormat;
    5153begin
    52   ColorFormat := ColorFormatManager.Formats[ComboBoxColorFormat.ItemIndex];
     54  ColorFormat := TColorFormat(ColorFormatManager.Formats.Items[ComboBoxColorFormat.ItemIndex]);
    5355  LabelMemRequire.Caption := IntToStr(SpinEditWidth.Value * SpinEditHeight.Value *
    5456    ColorFormat.BitDepth div 8) + ' bytes';
    … …  
    7880    SpinEditHeight.Value := Core.Project.Bitmap.Size.Y;
    7981  end else begin
    80     SpinEditWidth.Value := 200;
    81     SpinEditHeight.Value := 100;
     82    SpinEditWidth.Value := DefaultSize.X;
     83    SpinEditHeight.Value := DefaultSize.X;
    8284  end;
    8385  SpinEditDPI.Value := 72;
    … …  
    9092end;
    9193
     94procedure TFormNew.FormCreate(Sender: TObject);
     95begin
     96  DefaultSize := Point(600, 200);
     97end;
     98
    9299end.
    93100

  • trunk/Packages/FastGraphics/UFGraphics.pas

    r31 r33  
    66
    77uses
    8   Classes, SysUtils, Graphics, UGGraphics, UPixmapSpecialized, Contnrs;
     8  Classes, SysUtils, Graphics, UGGraphics, UPixmapSpecialized, Fgl;
    99
    1010type
    … …  
    8181  end;
    8282
     83  TColorFormats  = class(TFPGObjectList<TColorFormat>)
     84  end;
     85
    8386  TColorFormatClass = class of TColorFormat;
    8487
    … …  
    8790  TColorFormatManager = class
    8891  private
    89     FFormats: TObjectList; // TList<TColorFormat>
     92    FFormats: TColorFormats;
    9093    function GetFormat(Index: Integer): TColorFormat;
    9194  public
    9295    constructor Create; virtual;
    93      destructor Destroy; override;
     96    destructor Destroy; override;
     97    function FindByName(Name: string): Integer;
    9498    procedure RegisterFormat(Format: TColorFormatClass);
    9599    function FormatCount: Integer;
    96     property Formats[Index: Integer]: TColorFormat read GetFormat;
     100    property Formats: TColorFormats read FFormats;
    97101  end;
    98102
    … …  
    261265constructor TColorFormatManager.Create;
    262266begin
    263   FFormats := TObjectList.Create;
     267  FFormats := TColorFormats.Create;
    264268end;
    265269
    … …  
    268272  FreeAndNil(FFormats);
    269273  inherited Destroy;
     274end;
     275
     276function TColorFormatManager.FindByName(Name: string): Integer;
     277var
     278  I: Integer;
     279begin
     280  Result := -1;
     281  for I := 0 to FFormats.Count - 1 do begin
     282    if FFormats[I].Name = Name then begin
     283      Result := I;
     284      Break;
     285    end;
     286  end;
    270287end;
    271288

  • trunk/Packages/FastGraphics/UGGraphics.pas

    r31 r33  
    203203  PixelPtrMin: PInteger;
    204204  PixelRowPtr: PInteger;
    205   P: TPixelFormat;
    206205  RawImage: TRawImage;
    207206  BytePerPixel: Integer;
    … …  
    218217      for X := Rect.Left to Rect.Right - 1 do begin
    219218        if (X >= 0) and (X < FSize.X) and (Y >= 0) and (Y < FSize.Y) and
    220         (PixelPtr < PixelPtrMax) and (PixelPtr > PixelPtrMin) then
     219        (PixelPtr < PixelPtrMax) and (PixelPtr >= PixelPtrMin) then begin
    221220          PixelPtr^ := ColorConvertFunc(Pixels[X, Y]);
     221        end;
    222222        Inc(PByte(PixelPtr), BytePerPixel);
    223 
    224223      end;
    225224      Inc(PByte(PixelRowPtr), RawImage.Description.BytesPerLine);

  • trunk/UCore.pas

    r31 r33  
    1313
    1414type
    15   TFloatPoint = record
    16     X, Y: Double;
    17   end;
    18 
    1915  { TCore }
    2016
    … …  
    6763  public
    6864    LastColorFormat: string;
     65    LastImageSize: TPoint;
    6966    Project: TProject;
    7067    RegistryContext: TRegistryContext;
    7168    procedure ProjectOpen(FileName: string);
     69    procedure ProjectNew;
    7270    procedure Init;
    7371    procedure LoadConfig;
    … …  
    8583  UFormNew, UFormMain, Forms, UColorRGBA8, UColorGray8, UColorGray1, UColorGray4,
    8684  UColorRGB565;
    87 
    88 function FloatPoint(AX, AY: Double): TFloatPoint;
    89 begin
    90   Result.X := AX;
    91   Result.Y := AY;
    92 end;
    9385
    9486{ TCore }
    … …  
    120112  //Image.Picture.Bitmap.EndUpdate;
    121113  Image.Free;
    122   AZoomAll.Execute;
     114  Project.View.ZoomAll(Project.Bitmap.Size);
    123115  FormMain.Redraw;
    124116  Project.FileName := FileName;
     117end;
     118
     119procedure TCore.ProjectNew;
     120var
     121  ColorFormatIndex: Integer;
     122begin
     123  // Set default
     124  ColorFormatIndex := ColorFormatManager.FindByName(LastColorFormat);
     125  if ColorFormatIndex < ColorFormatManager.Formats.Count then
     126    Project.Bitmap.ColorFormat := ColorFormatManager.Formats[ColorFormatIndex]
     127    else Project.Bitmap.ColorFormat := ColorFormatManager.Formats[0];
     128  Project.Bitmap.Size := LastImageSize;
     129
     130  Project.View.DestRect := Bounds(0, 0, FormMain.PaintBox1.Width, FormMain.PaintBox1.Height);
     131  Project.View.ZoomAll(Project.Bitmap.Size);
    125132end;
    126133
    … …  
    130137  LoadConfig;
    131138
    132   // Set default
    133   Project.Bitmap.ColorFormat := ColorFormatManager.Formats[0];
    134   Project.Bitmap.Size := Point(200, 100);
    135   Project.View.DestRect := Bounds(0, 0, FormMain.PaintBox1.Width, FormMain.PaintBox1.Height);
    136   Core.AZoomAll.Execute;
     139  ProjectNew;
     140  FormMain.Redraw;
    137141end;
    138142
    … …  
    145149
    146150    LastColorFormat := ReadStringWithDefault('LastColorFormat', '');
     151    LastImageSize.X := ReadIntegerWithDefault('LastImageSizeX', 600);
     152    LastImageSize.Y := ReadIntegerWithDefault('LastImageSizeY', 400);
    147153  finally
    148154    Free;
    … …  
    158164
    159165    WriteString('LastColorFormat', LastColorFormat);
     166    WriteInteger('LastImageSizeX', LastImageSize.X);
     167    WriteInteger('LastImageSizeY', LastImageSize.Y);
    160168  finally
    161169    Free;
    … …  
    165173procedure TCore.AFileNewExecute(Sender: TObject);
    166174begin
     175  FormNew.DefaultSize := LastImageSize;
    167176  if FormNew.ShowModal = mrOk then begin
    168177    Project.Bitmap.ColorFormat := TColorFormat.Create;
    … …  
    173182//    Project.Bitmap.BackgroundColor.FromTColor(clBlack);
    174183//    Project.Bitmap.DPI := FormNew.SpinEditDPI.Value;
    175     AZoomAll.Execute;
     184    Project.View.ZoomAll(Project.Bitmap.Size);
     185    FormMain.Redraw;
     186    LastImageSize := Project.Bitmap.Size;
    176187  end;
    177188end;
    178189
    179190procedure TCore.AZoomAllExecute(Sender: TObject);
    180 var
    181   Factor: TFloatPoint;
    182 begin
    183   with Core.Project, View do begin
    184     Factor := FloatPoint((DestRect.Right - DestRect.Left) / Bitmap.Size.X,
    185       (DestRect.Bottom - DestRect.Top) / Bitmap.Size.Y);
    186     if Factor.X < Factor.Y then Zoom := Factor.X
    187       else Zoom := Factor.Y;
    188     Center(Rect(0, 0, Bitmap.Size.X, Bitmap.Size.Y));
    189   end;
     191begin
     192  with Core.Project do
     193    View.ZoomAll(Bitmap.Size);
    190194  FormMain.Redraw;
    191195end;

  • trunk/UProject.pas

    r26 r33  
    99
    1010type
     11
     12  { TFloatPoint }
     13
     14  TFloatPoint = record
     15    X, Y: Double;
     16    function Create(AX, AY: Double): TFloatPoint;
     17  end;
    1118
    1219  { TView }
    … …  
    2330    procedure Center(Rect: TRect);
    2431    constructor Create;
     32    procedure ZoomAll(BitmapSize: TPoint);
    2533    function DestToSrcPos(Pos: TPoint): TPoint;
    2634    function SrcToDestPos(Pos: TPoint): TPoint;
    … …  
    4755  Result := (A.Left = B.Left) and (A.Top = B.Top) and
    4856    (A.Right = B.Right) and (A.Bottom = B.Bottom);
     57end;
     58
     59{ TFloatPoint }
     60
     61function TFloatPoint.Create(AX, AY: Double): TFloatPoint;
     62begin
     63  Result.X := AX;
     64  Result.Y := AY;
    4965end;
    5066
    … …  
    102118end;
    103119
     120procedure TView.ZoomAll(BitmapSize: TPoint);
     121var
     122  Factor: TFloatPoint;
     123begin
     124  Factor := TFloatPoint.Create((DestRect.Right - DestRect.Left) / BitmapSize.X,
     125    (DestRect.Bottom - DestRect.Top) / BitmapSize.Y);
     126  if Factor.X < Factor.Y then Zoom := Factor.X
     127    else Zoom := Factor.Y;
     128  Center(Rect(0, 0, BitmapSize.X, BitmapSize.Y));
     129end;
     130
    104131function TView.DestToSrcPos(Pos: TPoint): TPoint;
    105132begin
Note: See TracChangeset for help on using the changeset viewer.