77281d3aaaf3e697f78aa7b912a5bcdd7da7ad65
[master-thesis.git] / Parasitemia / ParasitemiaUI / GUI.fs
1 module ParasitemiaUI.GUI
2
3 open System
4 open System.IO
5 open System.Linq
6 open System.Windows
7 open System.Windows.Media
8 open System.Windows.Markup
9 open System.Windows.Shapes
10 open System.Windows.Controls
11 open System.Diagnostics
12 open Microsoft.Win32 // For the common dialogs.
13
14 open Emgu.CV.WPF
15
16 open Logger
17
18 open ParasitemiaCore.Config
19 open ParasitemiaCore.Utils
20 open Types
21
22 let run (defaultConfig: Config) (fileToOpen: string option) =
23 let app = new Application()
24 let win = Views.MainWindow()
25
26 let state = State.State(defaultConfig)
27 let mutable currentScale = 1.
28 let mutable displayHealthy = false
29 let warningBelowNumberOfRBC = 1000
30
31 // Initializations.
32 let canvasCurrentImageColor = win.canvasCurrentImage.Background
33 win.menuHightlightRBC.IsChecked <- displayHealthy
34
35 // Utils.
36 let extractRBCPreview (img: Emgu.CV.Image<Emgu.CV.Structure.Bgr, byte>) (rbc: RBC) : Emgu.CV.Image<Emgu.CV.Structure.Bgr, byte> =
37 let rbcWidth = rbc.size.Width
38 let rbcHeight = rbc.size.Height
39 let x = rbc.center.X - rbcWidth / 2. |> roundInt
40 let y = rbc.center.Y - rbcHeight / 2. |> roundInt
41 let w = roundInt rbcWidth
42 let h = roundInt rbcHeight
43 img.GetSubRect(System.Drawing.Rectangle(System.Drawing.Point((if x < 0 then 0 else x), (if y < 0 then 0 else y)),
44 System.Drawing.Size((if x + w >= img.Width then img.Width - x else w),
45 (if y + h >= img.Height then img.Height - y else h))))
46
47 let setRBCFrameStyle (srcImg: SourceImage) (rbc: RBC) (frame: Views.RBCFrame) =
48 frame.Opacity <- if displayHealthy || rbc.setManually || rbc.infected then 1. else 0.
49 let color = if rbc.infected then srcImg.InfectedRBCColor else srcImg.HealthyRBCColor
50 frame.manuallyAdded.Visibility <- if rbc.setManually then Visibility.Visible else Visibility.Hidden
51 frame.manuallyAdded.Fill <- color
52 frame.border.Stroke <- color
53
54 let RBCFrameFromExisting (srcImg: SourceImage) (rbc: RBC) (frame: Views.RBCFrame) : Views.RBCFrame =
55 frame.Visibility <- Visibility.Visible
56 frame.Height <- rbc.size.Height
57 frame.Width <- rbc.size.Width
58 frame.Tag <- rbc
59 setRBCFrameStyle srcImg rbc frame
60 frame.border.StrokeThickness <- 1.
61 frame.txtRBCNumber.Text <- rbc.num.ToString()
62 frame
63
64 let updateDocumentStatus () =
65 win.txtDocumentStatus.Text <- if state.FilePath = "" then "<New document>" else state.FilePath
66
67 let statusMessageTimer = Threading.DispatcherTimer()
68 statusMessageTimer.Tick.AddHandler(fun obj args -> statusMessageTimer.Stop(); win.txtMessageStatus.Text <- "")
69 statusMessageTimer.Interval <- TimeSpan(0, 0, 2)
70 let displayStatusMessage (message: string) =
71 win.txtMessageStatus.Text <- message
72 statusMessageTimer.Stop()
73 statusMessageTimer.Start()
74
75 let highlightRBCFrame (frame: Views.RBCFrame) (highlight: bool) =
76 let rbc = frame.Tag :?> RBC
77 if highlight
78 then
79 frame.border.StrokeThickness <- 3.
80 if not rbc.infected && not rbc.setManually && not displayHealthy then frame.Opacity <- 1.
81 else
82 frame.border.StrokeThickness <- 1.
83 if not rbc.infected && not rbc.setManually && not displayHealthy then frame.Opacity <- 0.
84
85 let zoomToRBC (rbc: RBC) =
86 win.scrollViewCurrentImage.ScrollToHorizontalOffset(rbc.center.X * currentScale - win.scrollViewCurrentImage.ViewportWidth / 2. + win.borderCurrentImage.BorderThickness.Left)
87 win.scrollViewCurrentImage.ScrollToVerticalOffset(rbc.center.Y * currentScale - win.scrollViewCurrentImage.ViewportHeight / 2. + win.borderCurrentImage.BorderThickness.Top)
88
89
90 let txtImageName_TextChanged =
91 TextChangedEventHandler(fun obj args -> state.CurrentImage |> Option.iter(fun srcImg -> state.SetName srcImg win.txtImageName.Text))
92
93 let updateCurrentImageInformation () =
94 win.txtImageName.TextChanged.RemoveHandler(txtImageName_TextChanged)
95 win.txtImageInformation1.Inlines.Clear()
96 win.txtImageInformation2.Inlines.Clear()
97 win.txtImageName.Text <- ""
98
99 match state.CurrentImage with
100 | Some srcImg ->
101 win.gridImageInformation.Visibility <- Visibility.Visible
102 win.txtImageName.Text <- srcImg.name
103 win.txtImageName.TextChanged.AddHandler(txtImageName_TextChanged)
104
105 // The left part.
106 let parasitemiaStr = Utils.percentText (state.ImageParasitemia srcImg)
107 win.txtImageInformation1.Inlines.Add(Documents.Run("Parasitemia: ", FontWeight = FontWeights.Bold))
108 win.txtImageInformation1.Inlines.Add(parasitemiaStr)
109 win.txtImageInformation1.Inlines.Add(Documents.LineBreak())
110
111 win.txtImageInformation1.Inlines.Add(Documents.Run("Last analysis: ", FontWeight = FontWeights.Bold))
112 win.txtImageInformation1.Inlines.Add(Documents.Run(if srcImg.dateLastAnalysis.Ticks = 0L then "<Never>" else srcImg.dateLastAnalysis.ToLocalTime().ToString()))
113
114 // The right part part.
115 win.txtImageInformation2.Inlines.Add(Documents.Run("Added infected erythrocyte: ", FontWeight = FontWeights.Bold))
116 win.txtImageInformation2.Inlines.Add(Documents.Run((state.ImageNbManuallyChangedRBCStr srcImg true) + " " + (state.ImageManuallyChangedRBCStr srcImg true)))
117 win.txtImageInformation2.Inlines.Add(Documents.LineBreak())
118 win.txtImageInformation2.Inlines.Add(Documents.Run("Removed infected erythrocyte: ", FontWeight = FontWeights.Bold))
119 win.txtImageInformation2.Inlines.Add(Documents.Run((state.ImageNbManuallyChangedRBCStr srcImg false) + " " + (state.ImageManuallyChangedRBCStr srcImg false)))
120
121 | _ ->
122 win.gridImageInformation.Visibility <- Visibility.Hidden
123
124 let updateGlobalParasitemia () =
125 win.txtGlobalParasitemia.Inlines.Clear()
126 let total, infected = state.GlobalParasitemia
127 win.txtGlobalParasitemia.Inlines.Add(Documents.Run(Utils.percentText (total, infected), FontWeight = FontWeights.Bold))
128 if total > 0 && total < warningBelowNumberOfRBC
129 then
130 win.txtGlobalParasitemia.Inlines.Add(
131 Documents.Run(
132 sprintf " Warning: the number of erythrocytes should be above %d" warningBelowNumberOfRBC,
133 FontWeight = FontWeights.Bold,
134 Foreground = Brushes.Red))
135
136 let updateViewportPreview () =
137 for preview in win.stackPreviews.Children |> Seq.cast<Views.ImageSourcePreview> do
138 let srcImg = preview.Tag :?> SourceImage
139 if Some srcImg = state.CurrentImage then
140 preview.viewport.Visibility <- Visibility.Visible
141
142 let canvasWidth = win.canvasCurrentImage.ActualWidth * currentScale
143 let canvasHeight = win.canvasCurrentImage.ActualHeight * currentScale
144 let previewWidth = (preview.ActualWidth - preview.BorderThickness.Left - preview.BorderThickness.Right)
145 let previewHeight = (preview.ActualHeight - preview.BorderThickness.Top - preview.BorderThickness.Bottom)
146
147 let marginLeft = previewWidth * (win.scrollViewCurrentImage.HorizontalOffset - win.borderCurrentImage.BorderThickness.Left) / canvasWidth - 2.
148 let marginRight = previewWidth * (canvasWidth - (win.scrollViewCurrentImage.HorizontalOffset - win.borderCurrentImage.BorderThickness.Right) - win.scrollViewCurrentImage.ViewportWidth) / canvasWidth - 2.
149 let marginTop = previewHeight * (win.scrollViewCurrentImage.VerticalOffset - win.borderCurrentImage.BorderThickness.Top) / canvasHeight - 2.
150 let marginBottom = previewHeight * (canvasHeight - (win.scrollViewCurrentImage.VerticalOffset - win.borderCurrentImage.BorderThickness.Bottom) - win.scrollViewCurrentImage.ViewportHeight) / canvasHeight - 2.
151
152 preview.viewport.Margin <-
153 Thickness(
154 marginLeft,
155 marginTop,
156 marginRight,
157 marginBottom)
158 else
159 preview.viewport.Visibility <- Visibility.Hidden
160
161 let rec setAsInfected (srcImg: SourceImage) (rbc: RBC) (infected: bool) =
162 state.SetAsInfected rbc infected
163 win.canvasCurrentImage.Children
164 |> Seq.cast<Views.RBCFrame>
165 |> Seq.iter
166 (fun frame ->
167 if (frame.Tag :?> RBC) = rbc
168 then
169 setRBCFrameStyle srcImg rbc frame)
170 updateRBCFramesPreview ()
171 updateCurrentImageInformation ()
172 updateGlobalParasitemia ()
173
174 and RBCFrame (srcImg: SourceImage) (rbc: RBC) : Views.RBCFrame =
175 let frame = RBCFrameFromExisting srcImg rbc (Views.RBCFrame())
176 frame.SetValue(Panel.ZIndexProperty, Int32.MaxValue - rbc.num) // To be sure the
177 frame.menuRBCSetAsHealthy.Click.AddHandler(fun obj args -> setAsInfected srcImg (frame.Tag :?> RBC) false)
178 frame.menuRBCSetAsInfected.Click.AddHandler(fun obj args -> setAsInfected srcImg (frame.Tag :?> RBC) true)
179 frame.ContextMenuOpening.AddHandler(
180 fun obj args ->
181 if (frame.Tag :?> RBC).infected
182 then
183 frame.menuRBCSetAsHealthy.Visibility <- Visibility.Visible
184 frame.menuRBCSetAsInfected.Visibility <- Visibility.Collapsed
185 else
186 frame.menuRBCSetAsHealthy.Visibility <- Visibility.Collapsed
187 frame.menuRBCSetAsInfected.Visibility <- Visibility.Visible)
188
189 frame.ContextMenuClosing.AddHandler(fun obj args -> if not frame.IsMouseOver then highlightRBCFrame frame false )
190 frame.MouseEnter.AddHandler(fun obj args -> highlightRBCFrame frame true)
191 frame.MouseLeave.AddHandler(fun obj args -> if not frame.grid.ContextMenu.IsOpen then highlightRBCFrame frame false)
192 frame
193
194 and updateRBCFramesPreview () =
195 match state.CurrentImage with
196 | Some srcImg ->
197 let mutable currentPreview = 0
198 for rbc in srcImg.rbcs |> List.filter (fun rbc -> displayHealthy || rbc.infected) do
199 let previewInfected =
200 if currentPreview < win.stackRBC.Children.Count
201 then
202 RBCFrameFromExisting srcImg rbc (win.stackRBC.Children.[currentPreview] :?> Views.RBCFrame)
203 else
204 let f = RBCFrame srcImg rbc
205 f.MouseLeftButtonUp.AddHandler(fun obj args -> zoomToRBC (f.Tag :?> RBC))
206 win.stackRBC.Children.Add(f) |> ignore
207 f
208
209 currentPreview <- currentPreview + 1
210
211 previewInfected.Height <- win.stackRBC.ActualHeight
212 previewInfected.Width <- win.stackRBC.ActualHeight * rbc.size.Width / rbc.size.Height
213 previewInfected.border.Fill <- ImageBrush(BitmapSourceConvert.ToBitmapSource(extractRBCPreview srcImg.img rbc))
214
215 win.stackRBC.Children.RemoveRange(currentPreview, win.stackRBC.Children.Count - currentPreview)
216 | _ -> ()
217
218 updateViewportPreview ()
219
220 let updateRBCFramesCurrent () =
221 match state.CurrentImage with
222 | Some srcImg ->
223 let mutable currentCanvas = 0
224 for rbc in srcImg.rbcs do
225 let frame =
226 if currentCanvas < win.canvasCurrentImage.Children.Count
227 then
228 RBCFrameFromExisting srcImg rbc (win.canvasCurrentImage.Children.[currentCanvas] :?> Views.RBCFrame)
229 else
230 let f = RBCFrame srcImg rbc
231 f.Root.Opacity <- 0.7
232 win.canvasCurrentImage.Children.Add(f) |> ignore
233 f
234
235 currentCanvas <- currentCanvas + 1
236
237 Canvas.SetLeft(frame, rbc.center.X - rbc.size.Width / 2.)
238 Canvas.SetTop(frame, rbc.center.Y - rbc.size.Height / 2.)
239
240 for i in currentCanvas .. win.canvasCurrentImage.Children.Count - 1 do
241 win.canvasCurrentImage.Children.[i].Visibility <- Visibility.Hidden
242 | _ -> ()
243
244 let askDocumentPathToSave () : string option =
245 let dialog = SaveFileDialog(AddExtension = true, DefaultExt = PiaZ.extension, Filter = PiaZ.filter)
246
247 if state.FilePath <> ""
248 then
249 dialog.FileName <- FileInfo(state.FilePath).Name
250 elif state.PatientID <> ""
251 then
252 dialog.FileName <- state.PatientID + PiaZ.extension
253
254 let res = dialog.ShowDialog()
255 if res.HasValue && res.Value then
256 Some dialog.FileName
257 else
258 None
259
260 let saveCurrentDocument () =
261 try
262 if state.FilePath = ""
263 then
264 match askDocumentPathToSave () with
265 | Some filepath ->
266 state.FilePath <- filepath
267 state.Save()
268 | _ -> ()
269 else
270 state.Save()
271 updateDocumentStatus ()
272 displayStatusMessage "Document saved"
273 with
274 | :? IOException as ex ->
275 Log.Error(ex.ToString())
276 MessageBox.Show(sprintf "The document cannot be save in \"%s\"" state.FilePath, "Error saving the document", MessageBoxButton.OK, MessageBoxImage.Error) |> ignore
277
278 let saveCurrentDocumentAsNewFile () =
279 match askDocumentPathToSave () with
280 | Some filepath ->
281 state.FilePath <- filepath
282 saveCurrentDocument ()
283 | _ -> ()
284
285 // Ask the use to save the current document if neccessary.
286 let askSaveCurrent () =
287 if state.AlteredSinceLastSave
288 then
289 match MessageBox.Show("Would you like to save the current document?", "Saving the current document", MessageBoxButton.YesNo, MessageBoxImage.Question) with
290 | MessageBoxResult.Yes -> saveCurrentDocument ()
291 | _ -> ()
292
293 let updateCurrentImage () =
294 match state.CurrentImage with
295 | Some srcImg ->
296 win.imgLogos.Visibility <- Visibility.Collapsed
297
298 // Highlight the preview.
299 win.stackPreviews.Children
300 |> Seq.cast<Views.ImageSourcePreview>
301 |> Seq.iter (fun preview -> preview.border.BorderThickness <- Thickness(if preview.Tag = (srcImg :> Object) then 3. else 0.))
302
303 win.canvasCurrentImage.Height <- float srcImg.img.Height
304 win.canvasCurrentImage.Width <- float srcImg.img.Width
305 win.canvasCurrentImage.Background <- ImageBrush(BitmapSourceConvert.ToBitmapSource(srcImg.img))
306
307 updateRBCFramesCurrent ()
308 updateRBCFramesPreview ()
309
310 | None ->
311 win.imgLogos.Visibility <- Visibility.Visible
312
313 win.stackRBC.Children.Clear()
314 win.canvasCurrentImage.Children.Clear()
315 win.canvasCurrentImage.Background <- canvasCurrentImageColor
316
317 updateCurrentImageInformation ()
318
319 let setCurrentImage (srcImg: SourceImage) =
320 if state.CurrentImage.IsNone || state.CurrentImage.Value <> srcImg
321 then
322 state.CurrentImage <- Some srcImg
323 updateCurrentImage ()
324
325 let addPreview (srcImg: SourceImage) =
326 let imgCtrl = Views.ImageSourcePreview(Margin = Thickness(3.))
327
328 imgCtrl.menuRemoveImage.Click.AddHandler(fun obj args ->
329 win.stackPreviews.Children.Remove(imgCtrl)
330 let srcImg = imgCtrl.Tag :?> SourceImage
331 let currentRemoved = Some srcImg = state.CurrentImage
332 state.RemoveSourceImage srcImg
333 if currentRemoved
334 then
335 updateCurrentImage()
336
337 updateGlobalParasitemia()
338
339 // Update image numbers.
340 win.stackPreviews.Children |> Seq.cast<Views.ImageSourcePreview> |> Seq.iter (fun imgPreview -> imgPreview.txtImageNumber.Text <- (imgPreview.Tag :?> SourceImage).num.ToString()))
341
342 imgCtrl.Tag <- srcImg
343 imgCtrl.txtImageNumber.Text <- srcImg.num.ToString()
344 let width = 200
345 let height = srcImg.img.Height * width / srcImg.img.Width
346 imgCtrl.imagePreview.Source <- BitmapSourceConvert.ToBitmapSource(srcImg.img.Resize(width, height, Emgu.CV.CvEnum.Inter.Cubic))
347 win.stackPreviews.Children.Add(imgCtrl) |> ignore
348
349 // Zoom to a mouse position into the control 'imgCtrl'.
350 let zoomTo (mousePos: Point) =
351 let canvasW = win.canvasCurrentImage.ActualWidth * currentScale
352 let canvasH = win.canvasCurrentImage.ActualHeight * currentScale
353 let centerX = (mousePos.X - imgCtrl.BorderThickness.Left) / (imgCtrl.ActualWidth - imgCtrl.BorderThickness.Left) * canvasW
354 let centerY = (mousePos.Y - imgCtrl.BorderThickness.Top) / (imgCtrl.ActualHeight - imgCtrl.BorderThickness.Top) * canvasH
355 win.scrollViewCurrentImage.ScrollToHorizontalOffset(centerX - win.scrollViewCurrentImage.ViewportWidth / 2. + win.borderCurrentImage.BorderThickness.Left)
356 win.scrollViewCurrentImage.ScrollToVerticalOffset(centerY - win.scrollViewCurrentImage.ViewportHeight / 2. + win.borderCurrentImage.BorderThickness.Top)
357
358 imgCtrl.MouseLeftButtonDown.AddHandler(fun obj args ->
359 setCurrentImage (state.SourceImages |> Seq.find (fun srcImg -> (srcImg :> Object) = imgCtrl.Tag))
360 imgCtrl.UpdateLayout()
361 zoomTo (args.GetPosition(imgCtrl))
362 imgCtrl.CaptureMouse() |> ignore)
363
364 imgCtrl.MouseMove.AddHandler(fun obj args ->
365 if imgCtrl.IsMouseCaptured
366 then
367 zoomTo (args.GetPosition(imgCtrl)))
368
369 imgCtrl.MouseLeftButtonUp.AddHandler(fun obj args ->
370 if imgCtrl.IsMouseCaptured
371 then
372 imgCtrl.ReleaseMouseCapture())
373
374 let updatePreviews () =
375 win.stackPreviews.Children.Clear ()
376 for srcImg in state.SourceImages do
377 addPreview srcImg
378 updateCurrentImage ()
379
380 let updateGUI () =
381 win.txtPatient.Text <- state.PatientID
382 updatePreviews ()
383 updateGlobalParasitemia ()
384 updateDocumentStatus ()
385
386 let loadFile (filepath: string) =
387 askSaveCurrent ()
388 let previousFilePath = state.FilePath
389 try
390 state.FilePath <- filepath
391 state.Load()
392 updateGUI ()
393 with
394 | :? IOException as ex ->
395 Log.Error(ex.ToString())
396 state.FilePath <- previousFilePath
397 MessageBox.Show(sprintf "The document cannot be loaded from \"%s\"" filepath, "Error loading the document", MessageBoxButton.OK, MessageBoxImage.Error) |> ignore
398
399 let askLoadFile () =
400 let dialog = OpenFileDialog(Filter = PiaZ.filter)
401 let res = dialog.ShowDialog()
402 if res.HasValue && res.Value
403 then loadFile dialog.FileName
404
405 let newFile () =
406 askSaveCurrent ()
407 state.Reset()
408 updateGUI()
409
410 let exportResults () =
411 let extension = ".txt"
412 let dialog = SaveFileDialog(AddExtension = true, DefaultExt = extension)
413
414 if state.FilePath <> ""
415 then
416 dialog.FileName <- Path.GetFileNameWithoutExtension(state.FilePath) + extension
417 elif state.PatientID <> ""
418 then
419 dialog.FileName <- state.PatientID + extension
420
421 let res = dialog.ShowDialog()
422 if res.HasValue && res.Value then
423 try
424 Export.exportResults state dialog.FileName
425 with
426 | :? IOException as ex ->
427 Log.Error(ex.ToString())
428 MessageBox.Show(sprintf "The results cannot be exported in \"%s\"" state.FilePath, "Error exporting the files", MessageBoxButton.OK, MessageBoxImage.Error) |> ignore
429
430 let importImage () =
431 let dialog = OpenFileDialog(Filter = "Image Files|*.png;*.jpg;*.tif;*.tiff", Multiselect = true)
432 let res = dialog.ShowDialog()
433 if res.HasValue && res.Value
434 then
435 let noSourceImage = state.SourceImages.Count() = 0
436
437 for filename in dialog.FileNames do
438 try
439 let srcImg = state.AddSourceImage filename defaultConfig
440 addPreview srcImg
441 with
442 | _ as ex ->
443 Log.Error(ex.ToString())
444 MessageBox.Show(sprintf "Unable to read the image from \"%s\"" filename, "Error adding an image", MessageBoxButton.OK, MessageBoxImage.Error) |> ignore
445
446 updateGlobalParasitemia ()
447
448 if noSourceImage
449 then
450 updateCurrentImage ()
451
452 win.txtPatient.TextChanged.AddHandler(fun obj args -> state.PatientID <- win.txtPatient.Text)
453
454 win.menuExit.Click.AddHandler(fun obj args -> win.Root.Close())
455 win.menuSave.Click.AddHandler(fun obj args -> saveCurrentDocument ())
456 win.menuSaveAs.Click.AddHandler(fun obj args -> saveCurrentDocumentAsNewFile ())
457 win.menuOpen.Click.AddHandler(fun obj args -> askLoadFile ())
458 win.menuNew.Click.AddHandler(fun obj args -> newFile ())
459 win.menuExportResults.Click.AddHandler(fun obj args -> exportResults ())
460
461 win.menuAddSourceImage.Click.AddHandler(fun obj args -> importImage ())
462
463 win.menuAnalysis.SubmenuOpened.AddHandler(fun obj args -> win.menuStartAnalysis.IsEnabled <- state.SourceImages.Count() > 0)
464
465 win.menuStartAnalysis.Click.AddHandler(fun obj args ->
466 if Analysis.showWindow win.Root state
467 then
468 updateGlobalParasitemia ()
469 updateCurrentImage ())
470
471 win.menuHightlightRBC.Click.AddHandler(fun obj args ->
472 displayHealthy <- win.menuHightlightRBC.IsChecked
473 updateRBCFramesPreview ()
474 updateRBCFramesCurrent ())
475
476 win.menuAbout.Click.AddHandler(fun obj args -> About.showWindow win.Root)
477
478 win.Root.Closing.AddHandler(fun obj args -> askSaveCurrent ())
479
480 // Zoom on the current image.
481 let adjustCurrentImageBorders (deltaX: float) (deltaY: float) =
482 win.borderCurrentImage.BorderThickness <-
483 Thickness(
484 (win.scrollViewCurrentImage.ViewportWidth + deltaX) / 2.,
485 (win.scrollViewCurrentImage.ViewportHeight + deltaY) / 2.,
486 (win.scrollViewCurrentImage.ViewportWidth + deltaX) / 2.,
487 (win.scrollViewCurrentImage.ViewportHeight + deltaY) / 2.)
488
489 win.canvasCurrentImage.SizeChanged.AddHandler(fun obj args ->
490 let deltaX = args.NewSize.Width - args.PreviousSize.Width
491 let deltaY = args.NewSize.Height - args.PreviousSize.Height
492 if deltaX > 0.5 || deltaY > 0.5
493 then
494 adjustCurrentImageBorders 0.0 0.0
495 // Center the view at the center of the image initialy.
496 win.scrollViewCurrentImage.UpdateLayout()
497 win.scrollViewCurrentImage.ScrollToHorizontalOffset(win.borderCurrentImage.ActualWidth / 2. - win.scrollViewCurrentImage.ViewportWidth / 2.)
498 win.scrollViewCurrentImage.ScrollToVerticalOffset(win.borderCurrentImage.ActualHeight / 2. - win.scrollViewCurrentImage.ViewportHeight / 2.))
499
500 win.scrollViewCurrentImage.SizeChanged.AddHandler(fun obj args ->
501 let deltaX = args.NewSize.Width - args.PreviousSize.Width
502 let deltaY = args.NewSize.Height - args.PreviousSize.Height
503 adjustCurrentImageBorders deltaX deltaY
504 win.scrollViewCurrentImage.ScrollToHorizontalOffset(win.scrollViewCurrentImage.HorizontalOffset + deltaX / 8.)
505 win.scrollViewCurrentImage.ScrollToVerticalOffset(win.scrollViewCurrentImage.VerticalOffset + deltaY / 8.))
506
507 let mutable maxScale = 4.
508 let mutable minScale = 0.25
509 let currentImageScaleTransform = ScaleTransform()
510 win.canvasCurrentImage.LayoutTransform <- currentImageScaleTransform
511 win.borderCurrentImage.PreviewMouseWheel.AddHandler(fun obj args ->
512 let scaleFactor = if args.Delta > 0 then 2.0 else 0.5
513 if scaleFactor > 1. && currentScale < maxScale || scaleFactor < 1. && currentScale > minScale
514 then
515 let previousScale = currentScale
516 currentScale <-
517 let newScale = currentScale * scaleFactor
518 if newScale > maxScale then maxScale elif newScale < minScale then minScale else newScale
519 let realScaleFactor = currentScale / previousScale
520
521 let centerX = win.scrollViewCurrentImage.HorizontalOffset + win.scrollViewCurrentImage.ViewportWidth / 2. - win.borderCurrentImage.BorderThickness.Left
522 let centerY = win.scrollViewCurrentImage.VerticalOffset + win.scrollViewCurrentImage.ViewportHeight / 2. - win.borderCurrentImage.BorderThickness.Top
523
524 currentImageScaleTransform.ScaleX <- currentScale
525 currentImageScaleTransform.ScaleY <- currentScale
526
527 win.scrollViewCurrentImage.ScrollToHorizontalOffset(centerX * realScaleFactor - win.scrollViewCurrentImage.ViewportWidth / 2. + win.borderCurrentImage.BorderThickness.Left)
528 win.scrollViewCurrentImage.ScrollToVerticalOffset(centerY * realScaleFactor - win.scrollViewCurrentImage.ViewportHeight / 2. + win.borderCurrentImage.BorderThickness.Top)
529
530 args.Handled <- true)
531
532 // Pan on the current image.
533 let mutable scrollStartPosition = Point(0., 0.)
534 let mutable scrollStartOffsetX = 0.
535 let mutable scrollStartOffsetY = 0.
536 win.borderCurrentImage.PreviewMouseLeftButtonDown.AddHandler(fun obj args ->
537 scrollStartPosition <- args.GetPosition(win.scrollViewCurrentImage)
538 scrollStartOffsetX <- win.scrollViewCurrentImage.HorizontalOffset
539 scrollStartOffsetY <- win.scrollViewCurrentImage.VerticalOffset
540 win.borderCurrentImage.Cursor <- Input.Cursors.ScrollAll
541 win.borderCurrentImage.CaptureMouse() |> ignore
542 args.Handled <- true)
543
544 win.borderCurrentImage.PreviewMouseMove.AddHandler(fun obj args ->
545 if win.borderCurrentImage.IsMouseCaptured
546 then
547 let position = args.GetPosition(win.scrollViewCurrentImage)
548 let deltaX = scrollStartPosition.X - position.X
549 let deltaY = scrollStartPosition.Y - position.Y
550 win.scrollViewCurrentImage.ScrollToHorizontalOffset(deltaX + scrollStartOffsetX)
551 win.scrollViewCurrentImage.ScrollToVerticalOffset(deltaY + scrollStartOffsetY)
552
553 args.Handled <- true)
554
555 win.borderCurrentImage.PreviewMouseLeftButtonUp.AddHandler(fun obj args ->
556 if win.borderCurrentImage.IsMouseCaptured
557 then
558 win.borderCurrentImage.Cursor <- Input.Cursors.Arrow
559 win.borderCurrentImage.ReleaseMouseCapture()
560 args.Handled <- true)
561
562 // Shortcuts.
563 // Save.
564 win.Root.InputBindings.Add(
565 Input.KeyBinding(
566 FSharp.ViewModule.FunCommand((fun obj -> saveCurrentDocument ()), (fun obj -> true)),
567 Input.KeyGesture(Input.Key.S, Input.ModifierKeys.Control))) |> ignore
568
569 // Save as.
570 win.Root.InputBindings.Add(
571 Input.KeyBinding(
572 FSharp.ViewModule.FunCommand((fun obj -> saveCurrentDocumentAsNewFile ()), (fun obj -> true)),
573 Input.KeyGesture(Input.Key.S, Input.ModifierKeys.Control ||| Input.ModifierKeys.Shift))) |> ignore
574
575 // Open.
576 win.Root.InputBindings.Add(
577 Input.KeyBinding(
578 FSharp.ViewModule.FunCommand((fun obj -> askLoadFile ()), (fun obj -> true)),
579 Input.KeyGesture(Input.Key.O, Input.ModifierKeys.Control))) |> ignore
580
581 // New file.
582 win.Root.InputBindings.Add(
583 Input.KeyBinding(
584 FSharp.ViewModule.FunCommand((fun obj -> newFile ()), (fun obj -> true)),
585 Input.KeyGesture(Input.Key.N, Input.ModifierKeys.Control))) |> ignore
586
587 // Export results.
588 win.Root.InputBindings.Add(
589 Input.KeyBinding(
590 FSharp.ViewModule.FunCommand((fun obj -> exportResults ()), (fun obj -> true)),
591 Input.KeyGesture(Input.Key.E, Input.ModifierKeys.Control))) |> ignore
592
593 // Import an image.
594 win.Root.InputBindings.Add(
595 Input.KeyBinding(
596 FSharp.ViewModule.FunCommand((fun obj -> importImage ()), (fun obj -> true)),
597 Input.KeyGesture(Input.Key.A, Input.ModifierKeys.Control))) |> ignore
598
599 // Viewport preview.
600 win.scrollViewCurrentImage.ScrollChanged.AddHandler(fun obj args -> updateViewportPreview ())
601
602 updateDocumentStatus ()
603 win.gridImageInformation.Visibility <- Visibility.Hidden
604
605 win.Root.Show()
606
607 match fileToOpen with
608 | Some filepath -> loadFile filepath
609 | None -> ()
610
611 app.Run()