Changeset 10 for trunk/Forms
- Timestamp:
- Sep 22, 2014, 3:07:02 AM (10 years ago)
- Location:
- trunk/Forms
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Forms/UFormMain.lfm
r7 r10 2 2 Left = 664 3 3 Height = 640 4 Top = 4434 Top = 382 5 5 Width = 920 6 6 Caption = 'LibrePaint' … … 8 8 ClientWidth = 920 9 9 Menu = MainMenu1 10 OnActivate = FormActivate 11 OnCreate = FormCreate 12 OnDestroy = FormDestroy 13 OnShow = FormShow 10 14 LCLVersion = '1.3' 11 15 object PaintBox1: TPaintBox … … 15 19 Width = 920 16 20 Align = alClient 21 OnMouseDown = PaintBox1MouseDown 22 OnMouseMove = PaintBox1MouseMove 23 OnMouseUp = PaintBox1MouseUp 24 OnMouseLeave = PaintBox1MouseLeave 25 OnMouseWheelDown = PaintBox1MouseWheelDown 26 OnMouseWheelUp = PaintBox1MouseWheelUp 17 27 OnPaint = PaintBox1Paint 18 28 OnResize = PaintBox1Resize … … 23 33 Top = 588 24 34 Width = 920 25 Panels = <> 35 Panels = < 36 item 37 Width = 50 38 end> 39 SimplePanel = False 26 40 end 27 41 object MainMenu1: TMainMenu … … 85 99 Action = Core.AImageFlip 86 100 end 101 object MenuItem19: TMenuItem 102 Action = Core.AImageGradient 103 end 87 104 end 88 105 end -
trunk/Forms/UFormMain.pas
r7 r10 7 7 uses 8 8 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus, 9 ExtCtrls, ComCtrls ;9 ExtCtrls, ComCtrls, types; 10 10 11 11 type … … 23 23 MenuItem17: TMenuItem; 24 24 MenuItem18: TMenuItem; 25 MenuItem19: TMenuItem; 25 26 MenuItemRecentFiles: TMenuItem; 26 27 MenuItem15: TMenuItem; … … 37 38 StatusBar1: TStatusBar; 38 39 Timer1: TTimer; 40 procedure FormActivate(Sender: TObject); 41 procedure FormCreate(Sender: TObject); 42 procedure FormDestroy(Sender: TObject); 43 procedure FormShow(Sender: TObject); 44 procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton; 45 Shift: TShiftState; X, Y: Integer); 46 procedure PaintBox1MouseLeave(Sender: TObject); 47 procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X, 48 Y: Integer); 49 procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton; 50 Shift: TShiftState; X, Y: Integer); 51 procedure PaintBox1MouseWheelDown(Sender: TObject; Shift: TShiftState; 52 MousePos: TPoint; var Handled: Boolean); 53 procedure PaintBox1MouseWheelUp(Sender: TObject; Shift: TShiftState; 54 MousePos: TPoint; var Handled: Boolean); 39 55 procedure PaintBox1Paint(Sender: TObject); 40 56 procedure PaintBox1Resize(Sender: TObject); 41 57 procedure Timer1Timer(Sender: TObject); 42 58 private 43 { private declarations } 59 TempBitmap: TBitmap; 60 StartMousePoint: TPoint; 61 StartViewPoint: TPoint; 62 MoveActive: Boolean; 63 MousePos: TPoint; 64 Activated: Boolean; 44 65 public 66 procedure UpdateStatusBar; 45 67 procedure Redraw; 46 68 end; … … 60 82 procedure TFormMain.PaintBox1Resize(Sender: TObject); 61 83 begin 62 84 Redraw; 63 85 end; 64 86 65 87 procedure TFormMain.Timer1Timer(Sender: TObject); 66 var67 Bitmap: TBitmap;68 88 begin 69 89 Timer1.Enabled := False; 70 try 71 Bitmap := TBitmap.Create; 72 Bitmap.SetSize(Core.Project.Bitmap.Size.X, Core.Project.Bitmap.Size.Y); 73 Bitmap.BeginUpdate(True); 74 Core.Project.Bitmap.PaintToCanvas(Bitmap.Canvas); 75 Bitmap.EndUpdate(False); 76 PaintBox1.Canvas.Draw(0, 0, Bitmap); 77 finally 78 Bitmap.Free; 90 PaintBox1.Repaint; 91 UpdateStatusBar; 92 end; 93 94 procedure TFormMain.UpdateStatusBar; 95 var 96 Pos: TPoint; 97 begin 98 with Core.Project do begin 99 Pos := View.DestToSrcPos(MousePos); 100 StatusBar1.Panels[0].Text := '[' + IntToStr(Pos.X) + ', ' + IntToStr(Pos.Y) + '] Zoom:' + 101 FloatToStr(Core.Project.View.Zoom); 79 102 end; 80 103 end; … … 87 110 procedure TFormMain.PaintBox1Paint(Sender: TObject); 88 111 begin 89 Redraw; 112 with Core.Project do begin 113 TempBitmap.SetSize(View.SrcRect.Right - View.SrcRect.Left, 114 View.SrcRect.Bottom - View.SrcRect.Top); 115 TempBitmap.BeginUpdate(True); 116 TempBitmap.Canvas.Brush.Color := clBlack; 117 TempBitmap.Canvas.FillRect(0, 0, TempBitmap.Width, TempBitmap.Height); 118 View.DestRect := Bounds(0, 0, PaintBox1.Width, PaintBox1.Height); 119 Bitmap.PaintToCanvas(TempBitmap.Canvas, View.SrcRect); 120 TempBitmap.EndUpdate(False); 121 PaintBox1.Canvas.StretchDraw(View.DestRect, TempBitmap); 122 //PaintBox1.Canvas.Draw(0, 0, TempBitmap); 123 end; 124 end; 125 126 procedure TFormMain.FormCreate(Sender: TObject); 127 begin 128 TempBitmap := TBitmap.Create; 129 end; 130 131 procedure TFormMain.FormActivate(Sender: TObject); 132 begin 133 if not Activated then begin 134 Activated := True; 135 Core.Init; 136 end; 137 end; 138 139 procedure TFormMain.FormDestroy(Sender: TObject); 140 begin 141 TempBitmap.Free; 142 end; 143 144 procedure TFormMain.FormShow(Sender: TObject); 145 begin 146 end; 147 148 procedure TFormMain.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton; 149 Shift: TShiftState; X, Y: Integer); 150 begin 151 if Button = mbLeft then begin 152 StartMousePoint := Point(X, Y); 153 StartViewPoint := Core.Project.View.SrcRect.TopLeft; 154 MoveActive := True; 155 end; 156 end; 157 158 procedure TFormMain.PaintBox1MouseLeave(Sender: TObject); 159 begin 160 MoveActive := False; 161 end; 162 163 procedure TFormMain.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X, 164 Y: Integer); 165 begin 166 MousePos := Point(X, Y); 167 if Assigned(Core.Project) then begin 168 if MoveActive then 169 with Core.Project do begin 170 View.SrcRect := Bounds(Trunc(StartViewPoint.X + (StartMousePoint.X - X) / View.Zoom), 171 Trunc(StartViewPoint.Y + (StartMousePoint.Y - Y) / View.Zoom), 172 View.SrcRect.Right - View.SrcRect.Left, 173 View.SrcRect.Bottom - View.SrcRect.Top); 174 Redraw; 175 end; 176 end; 177 UpdateStatusBar; 178 end; 179 180 procedure TFormMain.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton; 181 Shift: TShiftState; X, Y: Integer); 182 begin 183 MoveActive := False; 184 end; 185 186 procedure TFormMain.PaintBox1MouseWheelDown(Sender: TObject; 187 Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); 188 begin 189 Core.AZoomOut.Execute; 190 end; 191 192 procedure TFormMain.PaintBox1MouseWheelUp(Sender: TObject; Shift: TShiftState; 193 MousePos: TPoint; var Handled: Boolean); 194 begin 195 Core.AZoomIn.Execute; 90 196 end; 91 197 -
trunk/Forms/UFormNew.pas
r8 r10 66 66 67 67 // Default 68 SpinEditWidth.Value := 800;69 SpinEditHeight.Value := 600;68 SpinEditWidth.Value := 200; 69 SpinEditHeight.Value := 100; 70 70 SpinEditDPI.Value := 72; 71 71 end;
Note:
See TracChangeset
for help on using the changeset viewer.