Changeset 33
- Timestamp:
- Jan 5, 2017, 11:48:36 PM (8 years ago)
- Location:
- trunk
- Files:
-
- 8 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Forms/UFormMain.lfm
r31 r33 36 36 Panels = < 37 37 item 38 Width = 50 38 Width = 200 39 end 40 item 41 Width = 200 42 end 43 item 44 Width = 200 39 45 end> 40 46 SimplePanel = False … … 70 76 Top = 2 71 77 Action = Core.AToolPen 78 end 79 object ToolButton4: TToolButton 80 Left = 113 81 Top = 2 82 Caption = 'ToolButton4' 83 OnClick = ToolButton4Click 72 84 end 73 85 end -
trunk/Forms/UFormMain.pas
r31 r33 50 50 ToolButton2: TToolButton; 51 51 ToolButton3: TToolButton; 52 ToolButton4: TToolButton; 52 53 procedure FormActivate(Sender: TObject); 53 54 procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); … … 70 71 procedure PaintBox1Resize(Sender: TObject); 71 72 procedure Timer1Timer(Sender: TObject); 73 procedure ToolButton4Click(Sender: TObject); 72 74 private 75 EnableDraw: Boolean; 73 76 TempBitmap: TBitmap; 74 77 StartMousePoint: TPoint; … … 109 112 end; 110 113 114 procedure TFormMain.ToolButton4Click(Sender: TObject); 115 begin 116 EnableDraw := True; 117 end; 118 111 119 procedure TFormMain.OpenRecentClick(Sender: TObject); 112 120 begin … … 127 135 StatusBar1.Panels[0].Text := '[' + IntToStr(Pos.X) + ', ' + IntToStr(Pos.Y) + '] Zoom:' + 128 136 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); 129 141 end; 130 142 end; … … 144 156 TempBitmap.Canvas.FillRect(0, 0, TempBitmap.Width, TempBitmap.Height); 145 157 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); 148 161 //TempBitmap.EndUpdate(False); 149 162 PaintBox1.Canvas.StretchDraw(View.DestRect, TempBitmap); -
trunk/Forms/UFormNew.lfm
r28 r33 8 8 ClientWidth = 497 9 9 OnClose = FormClose 10 OnCreate = FormCreate 10 11 OnShow = FormShow 11 LCLVersion = '1.6. 2.0'12 LCLVersion = '1.6.0.4' 12 13 object SpinEditWidth: TSpinEdit 13 14 Left = 168 14 Height = 2815 Height = 34 15 16 Top = 24 16 17 Width = 122 … … 21 22 object Label1: TLabel 22 23 Left = 15 23 Height = 2 024 Height = 24 24 25 Top = 26 25 Width = 4326 Width = 56 26 27 Caption = 'Width:' 27 28 ParentColor = False … … 29 30 object Label2: TLabel 30 31 Left = 15 31 Height = 2 032 Height = 24 32 33 Top = 64 33 Width = 4834 Width = 62 34 35 Caption = 'Height:' 35 36 ParentColor = False … … 37 38 object SpinEditHeight: TSpinEdit 38 39 Left = 168 39 Height = 2840 Height = 34 40 41 Top = 64 41 42 Width = 122 … … 46 47 object Label3: TLabel 47 48 Left = 15 48 Height = 2 049 Height = 24 49 50 Top = 104 50 Width = 7351 Width = 96 51 52 Caption = 'Resolution:' 52 53 ParentColor = False … … 54 55 object SpinEditDPI: TSpinEdit 55 56 Left = 168 56 Height = 2857 Height = 34 57 58 Top = 104 58 59 Width = 122 … … 63 64 object Label4: TLabel 64 65 Left = 15 65 Height = 2 066 Height = 24 66 67 Top = 167 67 Width = 8268 Width = 105 68 69 Caption = 'Color depth:' 69 70 ParentColor = False … … 71 72 object ComboBoxColorFormat: TComboBox 72 73 Left = 167 73 Height = 2874 Height = 38 74 75 Top = 157 75 76 Width = 209 76 ItemHeight = 2077 ItemHeight = 0 77 78 OnChange = SpinEditWidthChange 78 79 Style = csDropDownList … … 100 101 object Label5: TLabel 101 102 Left = 16 102 Height = 2 0103 Height = 24 103 104 Top = 224 104 Width = 1 18105 Width = 152 105 106 Caption = 'Memory required:' 106 107 ParentColor = False … … 108 109 object LabelMemRequire: TLabel 109 110 Left = 192 110 Height = 2 0111 Height = 24 111 112 Top = 224 112 Width = 1 2113 Width = 15 113 114 Caption = ' ' 114 115 ParentColor = False -
trunk/Forms/UFormNew.pas
r30 r33 7 7 uses 8 8 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Spin, 9 StdCtrls, ActnList, UFGraphics, URegistry;9 StdCtrls, ActnList, Menus, UFGraphics, URegistry; 10 10 11 11 type … … 27 27 SpinEditHeight: TSpinEdit; 28 28 procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); 29 procedure FormCreate(Sender: TObject); 29 30 procedure FormShow(Sender: TObject); 30 31 procedure SpinEditWidthChange(Sender: TObject); … … 32 33 { private declarations } 33 34 public 35 DefaultSize: TPoint; 34 36 end; 35 37 … … 50 52 ColorFormat: TColorFormat; 51 53 begin 52 ColorFormat := ColorFormatManager.Formats[ComboBoxColorFormat.ItemIndex];54 ColorFormat := TColorFormat(ColorFormatManager.Formats.Items[ComboBoxColorFormat.ItemIndex]); 53 55 LabelMemRequire.Caption := IntToStr(SpinEditWidth.Value * SpinEditHeight.Value * 54 56 ColorFormat.BitDepth div 8) + ' bytes'; … … 78 80 SpinEditHeight.Value := Core.Project.Bitmap.Size.Y; 79 81 end else begin 80 SpinEditWidth.Value := 200;81 SpinEditHeight.Value := 100;82 SpinEditWidth.Value := DefaultSize.X; 83 SpinEditHeight.Value := DefaultSize.X; 82 84 end; 83 85 SpinEditDPI.Value := 72; … … 90 92 end; 91 93 94 procedure TFormNew.FormCreate(Sender: TObject); 95 begin 96 DefaultSize := Point(600, 200); 97 end; 98 92 99 end. 93 100 -
trunk/Packages/FastGraphics/UFGraphics.pas
r31 r33 6 6 7 7 uses 8 Classes, SysUtils, Graphics, UGGraphics, UPixmapSpecialized, Contnrs;8 Classes, SysUtils, Graphics, UGGraphics, UPixmapSpecialized, Fgl; 9 9 10 10 type … … 81 81 end; 82 82 83 TColorFormats = class(TFPGObjectList<TColorFormat>) 84 end; 85 83 86 TColorFormatClass = class of TColorFormat; 84 87 … … 87 90 TColorFormatManager = class 88 91 private 89 FFormats: T ObjectList; // TList<TColorFormat>92 FFormats: TColorFormats; 90 93 function GetFormat(Index: Integer): TColorFormat; 91 94 public 92 95 constructor Create; virtual; 93 destructor Destroy; override; 96 destructor Destroy; override; 97 function FindByName(Name: string): Integer; 94 98 procedure RegisterFormat(Format: TColorFormatClass); 95 99 function FormatCount: Integer; 96 property Formats [Index: Integer]: TColorFormat read GetFormat;100 property Formats: TColorFormats read FFormats; 97 101 end; 98 102 … … 261 265 constructor TColorFormatManager.Create; 262 266 begin 263 FFormats := T ObjectList.Create;267 FFormats := TColorFormats.Create; 264 268 end; 265 269 … … 268 272 FreeAndNil(FFormats); 269 273 inherited Destroy; 274 end; 275 276 function TColorFormatManager.FindByName(Name: string): Integer; 277 var 278 I: Integer; 279 begin 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; 270 287 end; 271 288 -
trunk/Packages/FastGraphics/UGGraphics.pas
r31 r33 203 203 PixelPtrMin: PInteger; 204 204 PixelRowPtr: PInteger; 205 P: TPixelFormat;206 205 RawImage: TRawImage; 207 206 BytePerPixel: Integer; … … 218 217 for X := Rect.Left to Rect.Right - 1 do begin 219 218 if (X >= 0) and (X < FSize.X) and (Y >= 0) and (Y < FSize.Y) and 220 (PixelPtr < PixelPtrMax) and (PixelPtr > PixelPtrMin) then219 (PixelPtr < PixelPtrMax) and (PixelPtr >= PixelPtrMin) then begin 221 220 PixelPtr^ := ColorConvertFunc(Pixels[X, Y]); 221 end; 222 222 Inc(PByte(PixelPtr), BytePerPixel); 223 224 223 end; 225 224 Inc(PByte(PixelRowPtr), RawImage.Description.BytesPerLine); -
trunk/UCore.pas
r31 r33 13 13 14 14 type 15 TFloatPoint = record16 X, Y: Double;17 end;18 19 15 { TCore } 20 16 … … 67 63 public 68 64 LastColorFormat: string; 65 LastImageSize: TPoint; 69 66 Project: TProject; 70 67 RegistryContext: TRegistryContext; 71 68 procedure ProjectOpen(FileName: string); 69 procedure ProjectNew; 72 70 procedure Init; 73 71 procedure LoadConfig; … … 85 83 UFormNew, UFormMain, Forms, UColorRGBA8, UColorGray8, UColorGray1, UColorGray4, 86 84 UColorRGB565; 87 88 function FloatPoint(AX, AY: Double): TFloatPoint;89 begin90 Result.X := AX;91 Result.Y := AY;92 end;93 85 94 86 { TCore } … … 120 112 //Image.Picture.Bitmap.EndUpdate; 121 113 Image.Free; 122 AZoomAll.Execute;114 Project.View.ZoomAll(Project.Bitmap.Size); 123 115 FormMain.Redraw; 124 116 Project.FileName := FileName; 117 end; 118 119 procedure TCore.ProjectNew; 120 var 121 ColorFormatIndex: Integer; 122 begin 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); 125 132 end; 126 133 … … 130 137 LoadConfig; 131 138 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; 137 141 end; 138 142 … … 145 149 146 150 LastColorFormat := ReadStringWithDefault('LastColorFormat', ''); 151 LastImageSize.X := ReadIntegerWithDefault('LastImageSizeX', 600); 152 LastImageSize.Y := ReadIntegerWithDefault('LastImageSizeY', 400); 147 153 finally 148 154 Free; … … 158 164 159 165 WriteString('LastColorFormat', LastColorFormat); 166 WriteInteger('LastImageSizeX', LastImageSize.X); 167 WriteInteger('LastImageSizeY', LastImageSize.Y); 160 168 finally 161 169 Free; … … 165 173 procedure TCore.AFileNewExecute(Sender: TObject); 166 174 begin 175 FormNew.DefaultSize := LastImageSize; 167 176 if FormNew.ShowModal = mrOk then begin 168 177 Project.Bitmap.ColorFormat := TColorFormat.Create; … … 173 182 // Project.Bitmap.BackgroundColor.FromTColor(clBlack); 174 183 // Project.Bitmap.DPI := FormNew.SpinEditDPI.Value; 175 AZoomAll.Execute; 184 Project.View.ZoomAll(Project.Bitmap.Size); 185 FormMain.Redraw; 186 LastImageSize := Project.Bitmap.Size; 176 187 end; 177 188 end; 178 189 179 190 procedure 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; 191 begin 192 with Core.Project do 193 View.ZoomAll(Bitmap.Size); 190 194 FormMain.Redraw; 191 195 end; -
trunk/UProject.pas
r26 r33 9 9 10 10 type 11 12 { TFloatPoint } 13 14 TFloatPoint = record 15 X, Y: Double; 16 function Create(AX, AY: Double): TFloatPoint; 17 end; 11 18 12 19 { TView } … … 23 30 procedure Center(Rect: TRect); 24 31 constructor Create; 32 procedure ZoomAll(BitmapSize: TPoint); 25 33 function DestToSrcPos(Pos: TPoint): TPoint; 26 34 function SrcToDestPos(Pos: TPoint): TPoint; … … 47 55 Result := (A.Left = B.Left) and (A.Top = B.Top) and 48 56 (A.Right = B.Right) and (A.Bottom = B.Bottom); 57 end; 58 59 { TFloatPoint } 60 61 function TFloatPoint.Create(AX, AY: Double): TFloatPoint; 62 begin 63 Result.X := AX; 64 Result.Y := AY; 49 65 end; 50 66 … … 102 118 end; 103 119 120 procedure TView.ZoomAll(BitmapSize: TPoint); 121 var 122 Factor: TFloatPoint; 123 begin 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)); 129 end; 130 104 131 function TView.DestToSrcPos(Pos: TPoint): TPoint; 105 132 begin
Note:
See TracChangeset
for help on using the changeset viewer.